stones, sky, schematic roots
|
@ -1,21 +1,29 @@
|
||||||
;#lang scheme/base
|
#lang scheme/base
|
||||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||||
; hex ornament/groworld game : fluxus version
|
; hex ornament/groworld game : fluxus version
|
||||||
|
|
||||||
;(require fluxus-016/drflux)
|
(require fluxus-016/drflux)
|
||||||
(require scheme/class)
|
(require scheme/class)
|
||||||
|
|
||||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||||
; tweakables
|
; tweakables
|
||||||
|
|
||||||
(define num-insects 20)
|
(define hex-width 40)
|
||||||
|
(define hex-height 40)
|
||||||
|
|
||||||
|
(define num-insects 50)
|
||||||
(define pickup-drop-probability 10)
|
(define pickup-drop-probability 10)
|
||||||
|
|
||||||
|
(define surface-start 34)
|
||||||
|
(define surface-upper 39)
|
||||||
|
(define surface-lower 30)
|
||||||
|
|
||||||
(define (vec3->vec4 v a)
|
(define (vec3->vec4 v a)
|
||||||
(vector (vx v) (vy v) (vz v) a))
|
(vector (vx v) (vy v) (vz v) a))
|
||||||
|
|
||||||
(define (bg-colour) (vector 0.9 0.8 0.7))
|
(define (bg-colour) (vmul (vector 0.9 0.8 0.7) 0.2))
|
||||||
(define (worm-colour) (hsv->rgb (vector 0.1 (rndf) 0.5)))
|
(define (sky-colour) (vector 0.7 0.8 1))
|
||||||
|
(define (worm-colour) (hsv->rgb (vector 0.1 (rndf) 1)))
|
||||||
(define (root-colour) (vector 0.6 0.5 0.5))
|
(define (root-colour) (vector 0.6 0.5 0.5))
|
||||||
(define (pickup-colour) (hsv->rgb (vector 0.1 (rndf) 1)))
|
(define (pickup-colour) (hsv->rgb (vector 0.1 (rndf) 1)))
|
||||||
(define (absorb-colour) (vec3->vec4 (hsv->rgb (vector (rndf) 0.2 (+ 0.6 (rndf)))) 0.2))
|
(define (absorb-colour) (vec3->vec4 (hsv->rgb (vector (rndf) 0.2 (+ 0.6 (rndf)))) 0.2))
|
||||||
|
@ -23,7 +31,9 @@
|
||||||
(define (type->colour type)
|
(define (type->colour type)
|
||||||
(cond
|
(cond
|
||||||
((string=? type "knobbly") (vector 1 0.6 0.6))
|
((string=? type "knobbly") (vector 1 0.6 0.6))
|
||||||
((string=? type "lollypop") (vector 0.6 0.6 1))))
|
((string=? type "lollypop") (vector 0.6 0.6 1))
|
||||||
|
((string=? type "nik") (vector 0.6 1 0.6))
|
||||||
|
(else (vector 1 1 1))))
|
||||||
|
|
||||||
;(define texpath "")
|
;(define texpath "")
|
||||||
(define texpath "textures/")
|
(define texpath "textures/")
|
||||||
|
@ -115,9 +125,9 @@
|
||||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||||
; how this works
|
; how this works
|
||||||
;
|
;
|
||||||
; logic side view side
|
; logic side rendering side
|
||||||
; ---------- ---------
|
; ---------- --------------
|
||||||
; * no fluxus code | * no game code
|
; (no fluxus code allowed) | (no game code allowed)
|
||||||
; |
|
; |
|
||||||
; comb-cell | comb-cell-view
|
; comb-cell | comb-cell-view
|
||||||
; \ | /
|
; \ | /
|
||||||
|
@ -126,8 +136,8 @@
|
||||||
; honey-comb ===========> honey-comb-view
|
; honey-comb ===========> honey-comb-view
|
||||||
; / | \
|
; / | \
|
||||||
; garden | garden-view
|
; garden | garden-view
|
||||||
;
|
; / | \
|
||||||
;
|
; plant | plant-view
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
||||||
|
@ -135,10 +145,12 @@
|
||||||
; logic
|
; logic
|
||||||
|
|
||||||
; messages passed between the honey-comb logic and the view
|
; messages passed between the honey-comb logic and the view
|
||||||
|
(define-struct init-update (surface-pos-list))
|
||||||
(define-struct cell-update (pos code pickup upstream type))
|
(define-struct cell-update (pos code pickup upstream type))
|
||||||
(define-struct insect-update (id pos dir t))
|
(define-struct insect-update (id pos dir t))
|
||||||
(define-struct absorb-event (cell-pos type))
|
(define-struct absorb-event (cell-pos type))
|
||||||
(define-struct plant-update (id desc pos type))
|
(define-struct plant-update (id desc pos type))
|
||||||
|
(define-struct controller-update (grow-pos))
|
||||||
|
|
||||||
(define comb-cell%
|
(define comb-cell%
|
||||||
(class object%
|
(class object%
|
||||||
|
@ -348,7 +360,9 @@
|
||||||
(width 0)
|
(width 0)
|
||||||
(height 0)
|
(height 0)
|
||||||
(insects '())
|
(insects '())
|
||||||
(garden (make-object garden%)))
|
(garden (make-object garden%))
|
||||||
|
(surface-cells '())
|
||||||
|
(first-time #t))
|
||||||
|
|
||||||
(define/public (get-cell x y)
|
(define/public (get-cell x y)
|
||||||
(list-ref cells (+ (* y height) x)))
|
(list-ref cells (+ (* y height) x)))
|
||||||
|
@ -386,31 +400,52 @@
|
||||||
(when (> x 0)
|
(when (> x 0)
|
||||||
(send cell set-neighbour! W (get-cell (- x 1) y)))
|
(send cell set-neighbour! W (get-cell (- x 1) y)))
|
||||||
(when (and (> x 0) (< y (- height 1)))
|
(when (and (> x 0) (< y (- height 1)))
|
||||||
(send cell set-neighbour! SW (get-cell (if (odd? y) x (- x 1)) (+ y 1))))))))
|
(send cell set-neighbour! SW (get-cell (if (odd? y) x (- x 1)) (+ y 1)))))))
|
||||||
|
(set! surface-cells (calc-surface-cells 0 surface-start surface-upper surface-lower '())))
|
||||||
|
|
||||||
|
; we need to calculate the surface cells here, as we have the information
|
||||||
|
; to calculate an unbroken line of hexes
|
||||||
|
(define/public (calc-surface-cells x y upper lower l)
|
||||||
|
; calculate the surface hexes
|
||||||
|
(let* ((direction (choose (cond
|
||||||
|
((> y (- upper 1)) (list E NE))
|
||||||
|
((< y lower) (list E SE))
|
||||||
|
(else (list SE E NE)))))
|
||||||
|
(next-cell (send (get-cell x y) get-neighbour direction)))
|
||||||
|
(cond ((not next-cell) l)
|
||||||
|
(else
|
||||||
|
(let ((pos (send next-cell get-pos)))
|
||||||
|
(calc-surface-cells (car pos) (cadr pos) upper lower
|
||||||
|
(cons (list (list x y) direction) l)))))))
|
||||||
|
|
||||||
(define/public (seed id type x y)
|
(define/public (seed id type i)
|
||||||
(let ((plant (make-object plant% id type (list x y))))
|
(let* ((x (car (car (list-ref surface-cells i))))
|
||||||
|
(y (cadr (car (list-ref surface-cells i))))
|
||||||
|
(plant (make-object plant% id type (list x y))))
|
||||||
(send garden add-plant plant)
|
(send garden add-plant plant)
|
||||||
(send (get-cell x y) set-plant! plant)
|
(send (get-cell x (- y 1)) set-plant! plant)
|
||||||
(send (get-cell x y) set-connection! SE #t)
|
(send (get-cell x (- y 1)) set-connection! SE #t)
|
||||||
(send (get-cell x (+ y 1)) set-plant! plant)
|
#;(send (get-cell x (- y 1)) set-plant! plant)
|
||||||
(send (get-cell x (+ y 1)) set-connection! NW #t)))
|
#;(send (get-cell x (- y 1)) set-connection! NW #t)))
|
||||||
|
|
||||||
(define/public (update time delta)
|
(define/public (update time delta)
|
||||||
|
|
||||||
(append
|
(append
|
||||||
|
|
||||||
; look for pickups over roots
|
; first frame, send the cells that represent the surface, so they can be drawn
|
||||||
(foldl
|
(cond (first-time (set! first-time #f) (list (make-init-update surface-cells)))
|
||||||
(lambda (cell r)
|
(else '()))
|
||||||
(let ((pickup (send cell get-pickup)))
|
|
||||||
(cond ((and (not (send cell no-connections?)) pickup)
|
; look for pickups over roots
|
||||||
(send cell set-pickup! #f)
|
(foldl
|
||||||
(cons (make-absorb-event (send cell get-pos) pickup) r))
|
(lambda (cell r)
|
||||||
(else r))))
|
(let ((pickup (send cell get-pickup)))
|
||||||
'()
|
(cond ((and (not (send cell no-connections?)) pickup)
|
||||||
cells)
|
(send cell set-pickup! #f)
|
||||||
|
(cons (make-absorb-event (send cell get-pos) pickup) r))
|
||||||
|
(else r))))
|
||||||
|
'()
|
||||||
|
cells)
|
||||||
|
|
||||||
(foldl
|
(foldl
|
||||||
(lambda (insect r)
|
(lambda (insect r)
|
||||||
|
@ -447,26 +482,6 @@
|
||||||
(let ((a (* 2 1.141 60)))
|
(let ((a (* 2 1.141 60)))
|
||||||
(vmul (vector (sin (* a d)) (cos (* a d)) 0) -1)))
|
(vmul (vector (sin (* a d)) (cos (* a d)) 0) -1)))
|
||||||
|
|
||||||
|
|
||||||
#;(define (build-ngon n)
|
|
||||||
(let ((p (build-polygons n 'polygon)))
|
|
||||||
(with-primitive p
|
|
||||||
(pdata-index-map!
|
|
||||||
(lambda (i p)
|
|
||||||
(let ((a (* (/ i n) (* 2 3.141))))
|
|
||||||
(vector (cos a) (sin a) 0)))
|
|
||||||
"p")
|
|
||||||
(pdata-map!
|
|
||||||
(lambda (t p)
|
|
||||||
(let ((p (vtransform p (mmul
|
|
||||||
(mrotate (vector 0 0 -90))
|
|
||||||
(mscale (vector -1 1 1))))))
|
|
||||||
(vsub (vmul p 0.45) (vector 0.5 0.5 0))))
|
|
||||||
"t" "p")
|
|
||||||
(pdata-copy "t" "tref")
|
|
||||||
(pdata-map! (lambda (n) (vector 0 0 1)) "n"))
|
|
||||||
p))
|
|
||||||
|
|
||||||
(define (build-ngon n)
|
(define (build-ngon n)
|
||||||
(let ((p (build-polygons n 'polygon)))
|
(let ((p (build-polygons n 'polygon)))
|
||||||
(with-primitive p
|
(with-primitive p
|
||||||
|
@ -486,6 +501,18 @@
|
||||||
(pdata-map! (lambda (n) (vector 0 0 1)) "n"))
|
(pdata-map! (lambda (n) (vector 0 0 1)) "n"))
|
||||||
p))
|
p))
|
||||||
|
|
||||||
|
(define (build-hex x y root)
|
||||||
|
(with-state
|
||||||
|
;(hint-wire)
|
||||||
|
(parent root)
|
||||||
|
(hint-unlit)
|
||||||
|
(when (odd? y)
|
||||||
|
(translate (vector 0.5 0 0)))
|
||||||
|
(translate (vector x (* 0.85 y) (* 0.001 (rndf))))
|
||||||
|
(scale (vector 0.58 0.57 1))
|
||||||
|
(rotate (vector 0 0 90))
|
||||||
|
(build-ngon 6)))
|
||||||
|
|
||||||
; slow implementation of hermite curves for animation
|
; slow implementation of hermite curves for animation
|
||||||
(define (hermite s p1 p2 t1 t2)
|
(define (hermite s p1 p2 t1 t2)
|
||||||
; the bernstein polynomials
|
; the bernstein polynomials
|
||||||
|
@ -612,44 +639,42 @@
|
||||||
(define-struct component (root (col #:mutable) children))
|
(define-struct component (root (col #:mutable) children))
|
||||||
|
|
||||||
(define (build-component id type col children)
|
(define (build-component id type col children)
|
||||||
(cond
|
(cond
|
||||||
((null? children)
|
((null? children)
|
||||||
(let ((root (with-state
|
(let ((root (with-state
|
||||||
(translate (vector 0 0.5 (* 0.01 (rndf))))
|
(colour col)
|
||||||
(colour col)
|
(hint-unlit)
|
||||||
(hint-none)
|
(hint-depth-sort)
|
||||||
(hint-solid)
|
(translate (vector 0 0.5 0))
|
||||||
(hint-unlit)
|
(texture (load-texture (string-append "plants/" type "/leaves/comp-" id ".png")))
|
||||||
(hint-depth-sort)
|
(build-plane))))
|
||||||
(texture (load-texture (string-append "plants/" type "/leaves/comp-" id ".png")))
|
(make-component root col '())))
|
||||||
(build-plane))))
|
(else
|
||||||
(make-component root col '())))
|
(let ((connection-list (get-connection-list id type))
|
||||||
(else
|
(root (with-state
|
||||||
(let ((connection-list (get-connection-list id type))
|
(colour col)
|
||||||
(root (with-state
|
(hint-unlit)
|
||||||
(colour col)
|
(hint-depth-sort)
|
||||||
(hint-depth-sort)
|
(translate (vector 0 0.5 0))
|
||||||
(translate (vector 0 0.5 (* 0.01 (rndf))))
|
(texture (load-texture (string-append "plants/" type "/branches/comp-" id ".png")))
|
||||||
; (rotate (vector 0 0 90))
|
(build-plane))))
|
||||||
(texture (load-texture (string-append "plants/" type "/branches/comp-" id ".png")))
|
(when (not (eq? (length connection-list) (length children)))
|
||||||
(build-plane))))
|
(printf "something wrong: ~a children:~a connections:~a~n" id (length children) (length connection-list) ))
|
||||||
(when (not (eq? (length connection-list) (length children)))
|
|
||||||
(printf "something wrong: ~a children:~a connections:~a~n" id (length children) (length connection-list) ))
|
|
||||||
|
|
||||||
(let ((comp (make-component root col
|
(let ((comp (make-component root col
|
||||||
(map
|
(map
|
||||||
(lambda (child connection)
|
(lambda (child connection)
|
||||||
(with-state
|
(with-state
|
||||||
(parent root)
|
(parent root)
|
||||||
(translate (vadd connection (vector 0 0 (* 0.01 (rndf)))))
|
(translate (vadd connection (vector 0 0 (* 0.001 (rndf)))))
|
||||||
(rotate (vector 0 0 (2dvec->angle
|
(rotate (vector 0 0 (2dvec->angle
|
||||||
(vx connection) (- (vy connection) 0.5))))
|
(vx connection) (- (vy connection) 0.5))))
|
||||||
(rotate (vector 0 0 0))
|
;(scale 0.9)
|
||||||
(build-component (car child) type col (cadr child))))
|
(build-component (car child) type col (cadr child))))
|
||||||
children
|
children
|
||||||
connection-list))))
|
connection-list))))
|
||||||
(with-primitive root (apply-transform))
|
(with-primitive root (apply-transform))
|
||||||
comp)))))
|
comp)))))
|
||||||
|
|
||||||
(define (random-leaf component)
|
(define (random-leaf component)
|
||||||
(cond
|
(cond
|
||||||
|
@ -677,6 +702,7 @@
|
||||||
(root 0)
|
(root 0)
|
||||||
(tile1 0)
|
(tile1 0)
|
||||||
(tile2 0)
|
(tile2 0)
|
||||||
|
(bgtile 0)
|
||||||
(pickup-root 0)
|
(pickup-root 0)
|
||||||
(t 0)
|
(t 0)
|
||||||
(pos '(0 0))
|
(pos '(0 0))
|
||||||
|
@ -709,19 +735,12 @@
|
||||||
(set! type s))
|
(set! type s))
|
||||||
|
|
||||||
(define (build-prim code)
|
(define (build-prim code)
|
||||||
(let ((p (with-state
|
(let ((p (build-hex 0 0 root)))
|
||||||
;(hint-wire)
|
|
||||||
(parent root)
|
|
||||||
(hint-depth-sort)
|
|
||||||
(opacity 0)
|
|
||||||
(colour (root-colour))
|
|
||||||
(hint-unlit)
|
|
||||||
(translate (vector 0 0 (* 0.001 (rndf))))
|
|
||||||
(scale 0.57)
|
|
||||||
(rotate (vector 0 0 90))
|
|
||||||
(build-ngon 6))))
|
|
||||||
(with-primitive p
|
(with-primitive p
|
||||||
(update-texture code))
|
(hint-depth-sort)
|
||||||
|
(colour (root-colour))
|
||||||
|
(opacity 0)
|
||||||
|
(update-texture code))
|
||||||
p))
|
p))
|
||||||
|
|
||||||
(define/public (build code)
|
(define/public (build code)
|
||||||
|
@ -732,6 +751,22 @@
|
||||||
(translate (vector (car pos) (* 0.85 (cadr pos)) 0))
|
(translate (vector (car pos) (* 0.85 (cadr pos)) 0))
|
||||||
(build-locator)))
|
(build-locator)))
|
||||||
|
|
||||||
|
(when (zero? bgtile)
|
||||||
|
(set! bgtile (build-hex 0 0 root))
|
||||||
|
(with-primitive bgtile
|
||||||
|
(hint-depth-sort)
|
||||||
|
(texture (load-texture (string-append texpath "stones.png")))
|
||||||
|
(translate (vector 0 0 -0.1))
|
||||||
|
(rotate (vector 0 0 (* (random 6) 60))))
|
||||||
|
(let ((code (random 4)))
|
||||||
|
(with-primitive bgtile
|
||||||
|
(pdata-map!
|
||||||
|
(lambda (t)
|
||||||
|
(let ((size (/ 1 2)))
|
||||||
|
(vadd (vmul t size) (vector (* 1 size (+ 1 (modulo code 2)))
|
||||||
|
(* size 1 (+ 1 (quotient code 2))) 0))))
|
||||||
|
"t"))))
|
||||||
|
|
||||||
(set! tile1 (build-prim code))
|
(set! tile1 (build-prim code))
|
||||||
(set! tile2 (build-prim code)))
|
(set! tile2 (build-prim code)))
|
||||||
|
|
||||||
|
@ -993,7 +1028,7 @@
|
||||||
(with-state
|
(with-state
|
||||||
(parent root)
|
(parent root)
|
||||||
(hint-depth-sort)
|
(hint-depth-sort)
|
||||||
(translate (vector 0.2 0.3 0.3))
|
(translate (vector 0.2 0.3 0.1))
|
||||||
(build-component "1-0" type (type->colour type) (list desc))))
|
(build-component "1-0" type (type->colour type) (list desc))))
|
||||||
|
|
||||||
|
|
||||||
|
@ -1036,22 +1071,21 @@
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (insect)
|
(lambda (insect)
|
||||||
(send (cadr insect) build))
|
(send (cadr insect) build))
|
||||||
insects))
|
insects)))
|
||||||
(build-surface))
|
|
||||||
|
|
||||||
(define (get-pos-from-prim p l)
|
(define (get-pos-from-prim-impl p l)
|
||||||
(cond
|
(cond
|
||||||
((null? l) #f)
|
((null? l) #f)
|
||||||
((eq? (send (cadr (car l)) get-tile) p) (caar l))
|
((eq? (send (cadr (car l)) get-tile) p) (caar l))
|
||||||
(else (get-pos-from-prim p (cdr l)))))
|
(else (get-pos-from-prim-impl p (cdr l)))))
|
||||||
|
|
||||||
|
(define/public (get-pos-from-prim p)
|
||||||
|
(get-pos-from-prim-impl p cells))
|
||||||
|
|
||||||
(define/public (get-cell-from-pos pos)
|
(define/public (get-cell-from-pos pos)
|
||||||
(cadr (assoc pos cells)))
|
(cadr (assoc pos cells)))
|
||||||
|
|
||||||
(define/public (deal-with-input)
|
|
||||||
(if (mouse-button 1)
|
|
||||||
(get-pos-from-prim (mouse-over) cells)
|
|
||||||
#f))
|
|
||||||
|
|
||||||
(define/public (add-absorb! s)
|
(define/public (add-absorb! s)
|
||||||
(set! absorb-list (cons s absorb-list)))
|
(set! absorb-list (cons s absorb-list)))
|
||||||
|
@ -1063,47 +1097,41 @@
|
||||||
(vadd (vmul t size)
|
(vadd (vmul t size)
|
||||||
(vector (* size (+ x 1)) (* size (+ y 1)) 0))))
|
(vector (* size (+ x 1)) (* size (+ y 1)) 0))))
|
||||||
"t")
|
"t")
|
||||||
(texture (load-texture (string-append texpath "surface2.png"))))
|
(texture (load-texture (string-append texpath "surface3.png"))))
|
||||||
|
|
||||||
(define (make-surface lev top len l)
|
(define (surface-contains? pos l)
|
||||||
(cond
|
(cond
|
||||||
((zero? len) l)
|
((null? l) #f)
|
||||||
(else (make-surface
|
((equal? (car (car l)) pos) #t)
|
||||||
(if (zero? (random 2))
|
(else (surface-contains? pos (cdr l)))))
|
||||||
(if (< lev top) (+ lev 1) lev)
|
|
||||||
(if (> lev (- top 1)) (- lev 1) lev))
|
|
||||||
top (- len 1) (cons lev l)))))
|
|
||||||
|
|
||||||
(define/public (build-surface)
|
|
||||||
(let ((s (make-surface 10 11 20 '())))
|
|
||||||
(for ((i (in-range 1 (- (length s) 1))))
|
|
||||||
(let ((x i) (y (list-ref s i))
|
|
||||||
(yb (list-ref s (- i 1)))
|
|
||||||
(ya (list-ref s (+ i 1))))
|
|
||||||
|
|
||||||
(let ((p (with-state
|
|
||||||
(parent root)
|
|
||||||
(hint-unlit)
|
|
||||||
(when (odd? y)
|
|
||||||
(translate (vector 0.5 0 0)))
|
|
||||||
(translate (vector x (* 0.85 y) (* 0.001 (rndf))))
|
|
||||||
(scale 0.57)
|
|
||||||
(rotate (vector 0 0 90))
|
|
||||||
(build-ngon 6))))
|
|
||||||
(with-primitive p
|
|
||||||
(surface-texture
|
|
||||||
(cond
|
|
||||||
((> yb y) 0)
|
|
||||||
((< yb y) 2)
|
|
||||||
(else 1))
|
|
||||||
(cond
|
|
||||||
((> ya y) 0)
|
|
||||||
((< ya y) 2)
|
|
||||||
(else 1)))))))))
|
|
||||||
|
|
||||||
|
(define/public (build-surface l)
|
||||||
|
(let ((s (reverse l)))
|
||||||
|
(for ((i (in-range 1 (- (length s) 1))))
|
||||||
|
(let ((x (caar (list-ref s i)))
|
||||||
|
(y (cadr (car (list-ref s i))))
|
||||||
|
(d (car (cdr (list-ref s i))))
|
||||||
|
(ld (car (cdr (list-ref s (- i 1))))))
|
||||||
|
(let ((p (with-state
|
||||||
|
(colour (sky-colour))
|
||||||
|
(build-hex x y root))))
|
||||||
|
(with-primitive p
|
||||||
|
(surface-texture
|
||||||
|
(cond
|
||||||
|
((eq? ld NE) 0)
|
||||||
|
((eq? ld E) 1)
|
||||||
|
((eq? ld SE) 2))
|
||||||
|
(cond
|
||||||
|
((eq? d NE) 2)
|
||||||
|
((eq? d E) 1)
|
||||||
|
((eq? d SE) 0)))))
|
||||||
|
(for ((i (in-range (+ y 1) (+ surface-upper 1))))
|
||||||
|
(when (not (surface-contains? (list x i) s))
|
||||||
|
(with-state
|
||||||
|
(colour (sky-colour))
|
||||||
|
(build-hex x i root))))))))
|
||||||
|
|
||||||
(define/public (update update-list time delta)
|
(define/public (update update-list time delta)
|
||||||
|
|
||||||
; do the per-frame update on all the things
|
; do the per-frame update on all the things
|
||||||
(set! absorb-list
|
(set! absorb-list
|
||||||
(filter
|
(filter
|
||||||
|
@ -1144,6 +1172,7 @@
|
||||||
(send cell set-type! (cell-update-type item))
|
(send cell set-type! (cell-update-type item))
|
||||||
(send cell build code)
|
(send cell build code)
|
||||||
(set! cells (cons (list pos cell) cells)))))))
|
(set! cells (cons (list pos cell) cells)))))))
|
||||||
|
|
||||||
((insect-update? item)
|
((insect-update? item)
|
||||||
(let* ((pos (insect-update-pos item))
|
(let* ((pos (insect-update-pos item))
|
||||||
(c (assoc pos cells))
|
(c (assoc pos cells))
|
||||||
|
@ -1153,57 +1182,91 @@
|
||||||
(cadr c)
|
(cadr c)
|
||||||
(insect-update-dir item)
|
(insect-update-dir item)
|
||||||
(insect-update-t item)))))
|
(insect-update-t item)))))
|
||||||
|
|
||||||
((absorb-event? item)
|
((absorb-event? item)
|
||||||
(let ((a (make-object absorb-view%)))
|
(let ((a (make-object absorb-view%)))
|
||||||
(send a set-cell! (get-cell-from-pos (absorb-event-cell-pos item)))
|
(send a set-cell! (get-cell-from-pos (absorb-event-cell-pos item)))
|
||||||
(send a build root)
|
(send a build root)
|
||||||
(add-absorb! a)))
|
(add-absorb! a)))
|
||||||
|
|
||||||
((plant-update? item)
|
((plant-update? item)
|
||||||
(send garden add-plant!
|
(send garden add-plant!
|
||||||
(plant-update-id item)
|
(plant-update-id item)
|
||||||
(plant-update-desc item)
|
(plant-update-desc item)
|
||||||
(get-cell-from-pos (plant-update-pos item))
|
(get-cell-from-pos (plant-update-pos item))
|
||||||
(plant-update-type item)))))
|
(plant-update-type item)))
|
||||||
|
|
||||||
|
((init-update? item)
|
||||||
|
(build-surface (init-update-surface-pos-list item)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
update-list))
|
update-list))
|
||||||
|
|
||||||
(super-new)))
|
(super-new)))
|
||||||
|
|
||||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||||
|
|
||||||
|
(define controller%
|
||||||
|
(class object%
|
||||||
|
(field
|
||||||
|
(camera-pos (vector -13 -27 -5)))
|
||||||
|
|
||||||
|
(define/public (update)
|
||||||
|
(when (key-pressed "a")
|
||||||
|
(set! camera-pos (vadd camera-pos (vector 0.1 0 0))))
|
||||||
|
(when (key-pressed "d")
|
||||||
|
(set! camera-pos (vadd camera-pos (vector -0.1 0 0))))
|
||||||
|
(when (key-pressed "s")
|
||||||
|
(set! camera-pos (vadd camera-pos (vector 0 0.1 0))))
|
||||||
|
(when (key-pressed "w")
|
||||||
|
(set! camera-pos (vadd camera-pos (vector 0 -0.1 0))))
|
||||||
|
(when (key-pressed "z")
|
||||||
|
(set! camera-pos (vadd camera-pos (vector 0 0 0.1))))
|
||||||
|
(when (key-pressed "x")
|
||||||
|
(set! camera-pos (vadd camera-pos (vector 0 0 -0.1))))
|
||||||
|
(set-camera-transform (mtranslate camera-pos))
|
||||||
|
(if (mouse-button 1)
|
||||||
|
(mouse-over)
|
||||||
|
0))
|
||||||
|
|
||||||
|
(super-new)))
|
||||||
|
|
||||||
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||||
|
|
||||||
(clear)
|
(clear)
|
||||||
(clear-colour (bg-colour))
|
(clear-colour (bg-colour))
|
||||||
(clear-texture-cache)
|
|
||||||
(show-axis 0)
|
|
||||||
(set-camera-transform (mtranslate (vector -10 -7 -8)))
|
|
||||||
|
|
||||||
(define hc (make-object honey-comb%))
|
(define hc (make-object honey-comb%))
|
||||||
(define hcv (make-object honey-comb-view%))
|
(define hcv (make-object honey-comb-view%))
|
||||||
(define g (make-object garden%))
|
(define g (make-object garden%))
|
||||||
|
(define con (make-object controller%))
|
||||||
|
|
||||||
(send hc init 20 20)
|
(send hc init hex-width hex-height)
|
||||||
|
(send hcv init)
|
||||||
|
|
||||||
|
(send hc seed "dave@fo.am" "knobbly" 45)
|
||||||
|
(send hc seed "plant00002@fo.am" "lollypop" 30)
|
||||||
|
(send hc seed "plant00003@fo.am" "nik" 15)
|
||||||
|
|
||||||
(with-state
|
(with-state
|
||||||
; (translate (vector -50 -42.5 0))
|
(colour (sky-colour))
|
||||||
; (translate (vector -10 -8.5 0))
|
(hint-unlit)
|
||||||
(send hcv init))
|
(translate (vector 0 (- surface-upper 0.6) 0))
|
||||||
|
(scale (vector 100 10 1))
|
||||||
(send hc seed "dave@fo.am" "knobbly" 13 10)
|
(build-plane))
|
||||||
(send hc seed "plant00002@fo.am" "lollypop" 6 10)
|
|
||||||
|
|
||||||
;(send (send hc get-cell 50 52) grow)
|
|
||||||
;(send (send hc get-cell 49 53) grow)
|
|
||||||
|
|
||||||
(define t 0)
|
(define t 0)
|
||||||
(define d 0.04)
|
(define d 0.04)
|
||||||
|
|
||||||
(define (animate)
|
(define (animate)
|
||||||
; (set! d (delta))
|
; (set! d (delta))
|
||||||
(set! t (+ t d))
|
(set! t (+ t d))
|
||||||
(let ((clicked (send hcv deal-with-input)))
|
(let ((clicked (send con update)))
|
||||||
(when clicked
|
(when (not (zero? clicked))
|
||||||
(send (send hc get-cell (car clicked) (cadr clicked)) grow)))
|
(let ((pos (send hcv get-pos-from-prim clicked)))
|
||||||
(send hcv update (send hc update t d) t d))
|
(when pos
|
||||||
|
(send (send hc get-cell (car pos) (cadr pos)) grow)))))
|
||||||
|
(send hcv update (send hc update t d) t d))
|
||||||
|
|
||||||
|
|
||||||
;(for ((i (in-range 0 10))) (animate))
|
;(for ((i (in-range 0 10))) (animate))
|
||||||
|
|
Before Width: | Height: | Size: 378 KiB After Width: | Height: | Size: 376 KiB |
Before Width: | Height: | Size: 196 KiB After Width: | Height: | Size: 196 KiB |
BIN
hex-ornament/plants/nik/branches/comp-1-0.png
Normal file
After Width: | Height: | Size: 312 KiB |
BIN
hex-ornament/plants/nik/branches/comp-2-0.png
Normal file
After Width: | Height: | Size: 47 KiB |
BIN
hex-ornament/plants/nik/branches/comp-2-1.png
Normal file
After Width: | Height: | Size: 40 KiB |
BIN
hex-ornament/plants/nik/branches/comp-2-2.png
Normal file
After Width: | Height: | Size: 11 KiB |
BIN
hex-ornament/plants/nik/branches/comp-2-3.png
Normal file
After Width: | Height: | Size: 21 KiB |
BIN
hex-ornament/plants/nik/branches/comp-2-4.png
Normal file
After Width: | Height: | Size: 7.2 KiB |
BIN
hex-ornament/plants/nik/branches/comp-2-5.png
Normal file
After Width: | Height: | Size: 113 KiB |
BIN
hex-ornament/plants/nik/branches/comp-3-0.png
Normal file
After Width: | Height: | Size: 74 KiB |
BIN
hex-ornament/plants/nik/branches/comp-7-0.png
Normal file
After Width: | Height: | Size: 81 KiB |
BIN
hex-ornament/plants/nik/branches/comp-cp-1-0.png
Normal file
After Width: | Height: | Size: 1.5 KiB |
BIN
hex-ornament/plants/nik/branches/comp-cp-2-0.png
Normal file
After Width: | Height: | Size: 924 B |
BIN
hex-ornament/plants/nik/branches/comp-cp-2-1.png
Normal file
After Width: | Height: | Size: 971 B |
BIN
hex-ornament/plants/nik/branches/comp-cp-2-2.png
Normal file
After Width: | Height: | Size: 739 B |
BIN
hex-ornament/plants/nik/branches/comp-cp-2-3.png
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
hex-ornament/plants/nik/branches/comp-cp-2-4.png
Normal file
After Width: | Height: | Size: 498 B |
BIN
hex-ornament/plants/nik/branches/comp-cp-2-5.png
Normal file
After Width: | Height: | Size: 1.1 KiB |
BIN
hex-ornament/plants/nik/branches/comp-cp-3-0.png
Normal file
After Width: | Height: | Size: 3.1 KiB |
BIN
hex-ornament/plants/nik/branches/comp-cp-7-0.png
Normal file
After Width: | Height: | Size: 2.4 KiB |
BIN
hex-ornament/plants/nik/leaves/comp-0.png
Normal file
After Width: | Height: | Size: 4.7 KiB |
BIN
hex-ornament/plants/nik/leaves/comp-1.png
Normal file
After Width: | Height: | Size: 5.3 KiB |
BIN
hex-ornament/plants/nik/leaves/comp-2.png
Normal file
After Width: | Height: | Size: 11 KiB |
BIN
hex-ornament/plants/nik/leaves/comp-3.png
Normal file
After Width: | Height: | Size: 4.6 KiB |
BIN
hex-ornament/plants/nik/leaves/comp-4.png
Normal file
After Width: | Height: | Size: 16 KiB |
BIN
hex-ornament/plants/nik/leaves/comp-5.png
Normal file
After Width: | Height: | Size: 2.6 KiB |
BIN
hex-ornament/plants/nik/leaves/comp-6.png
Normal file
After Width: | Height: | Size: 28 KiB |
BIN
hex-ornament/plants/nik/leaves/comp-7.png
Normal file
After Width: | Height: | Size: 30 KiB |
BIN
hex-ornament/plants/nik/roots/roots.png
Normal file
After Width: | Height: | Size: 416 KiB |
BIN
hex-ornament/textures/stones.png
Normal file
After Width: | Height: | Size: 41 KiB |
Before Width: | Height: | Size: 62 KiB After Width: | Height: | Size: 62 KiB |
Before Width: | Height: | Size: 16 KiB After Width: | Height: | Size: 11 KiB |
BIN
hex-ornament/textures/surface3.png
Normal file
After Width: | Height: | Size: 29 KiB |
Before Width: | Height: | Size: 8.9 KiB After Width: | Height: | Size: 14 KiB |