2 player working, sorted out plant types

This commit is contained in:
Dave Griffiths 2009-06-12 09:44:06 +01:00
parent e28bde30f0
commit 2e4e40a761
33 changed files with 198 additions and 166 deletions

View file

@ -1,14 +1,14 @@
;#lang scheme ;#lang scheme/base
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; hex ornament/groworld game : fluxus version ; hex ornament/groworld game : fluxus version
;(require fluxus-016/drflux.ss) ;(require fluxus-016/drflux)
(require scheme/class) (require scheme/class)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; tweakables ; tweakables
(define num-insects 50) (define num-insects 20)
(define pickup-drop-probability 10) (define pickup-drop-probability 10)
(define (vec3->vec4 v a) (define (vec3->vec4 v a)
@ -20,6 +20,11 @@
(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))
(define (type->colour type)
(cond
((string=? type "knobbly") (vector 1 0.6 0.6))
((string=? type "lollypop") (vector 0.6 0.6 1))))
;(define texpath "") ;(define texpath "")
(define texpath "textures/") (define texpath "textures/")
@ -94,16 +99,16 @@
((< depth 1) (choose (list 2 3))) ((< depth 1) (choose (list 2 3)))
(else (choose (list 0 1 2 3)))))) (else (choose (list 0 1 2 3))))))
(cond (cond
((eq? num-children 0) (list (choose (list "11")) (list))) ((eq? num-children 0) (list (choose (list "0" "1")) (list)))
((eq? num-children 1) (list "1-1" (list (make-random-plant (+ depth 1))))) ((eq? num-children 1) (list "1-0" (list (make-random-plant (+ depth 1)))))
((eq? num-children 2) (list "2-1" (list (make-random-plant (+ depth 1)) ((eq? num-children 2) (list "2-0" (list (make-random-plant (+ depth 1))
(make-random-plant (+ depth 1))))) (make-random-plant (+ depth 1)))))
((eq? num-children 3) (list "3-1" (list (make-random-plant (+ depth 1)) ((eq? num-children 3) (list "3-0" (list (make-random-plant (+ depth 1))
(make-random-plant (+ depth 1)) (make-random-plant (+ depth 1))))) (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)))))
((eq? num-children 4) (list "4-1" (list (make-random-plant (+ depth 1)) ((eq? num-children 4) (list "4-0" (list (make-random-plant (+ depth 1))
(make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1))
(make-random-plant (+ depth 1))))) (make-random-plant (+ depth 1)))))
((eq? num-children 5) (list "5-1" (list (make-random-plant (+ depth 1)) ((eq? num-children 5) (list "5-0" (list (make-random-plant (+ depth 1))
(make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1))
(make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)))))))) (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1))))))))
@ -130,15 +135,15 @@
; logic ; logic
; messages passed between the honey-comb logic and the view ; messages passed between the honey-comb logic and the view
(define-struct cell-update (pos code pickup upstream)) (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)) (define-struct plant-update (id desc pos type))
(define comb-cell% (define comb-cell%
(class object% (class object%
(field (field
(id #f) ; id of the owner plant (plant #f) ; the owner plant
(pos '()) (pos '())
(neighbours '(#f #f #f #f #f #f)) (neighbours '(#f #f #f #f #f #f))
(pickup #f) (pickup #f)
@ -147,11 +152,11 @@
(update-me #f) (update-me #f)
(upstream #f)) ; the cell we are connected to (if we are) (upstream #f)) ; the cell we are connected to (if we are)
(define/public (get-id) (define/public (get-plant)
id) plant)
(define/public (set-id! s) (define/public (set-plant! s)
(set! id s)) (set! plant s))
(define/public (update-me?) (define/public (update-me?)
(let ((r update-me)) (let ((r update-me))
@ -203,7 +208,9 @@
; tell all our neighbours to become visible ; tell all our neighbours to become visible
(for-each (for-each
(lambda (n) (lambda (n)
(when n (send n set-visible! #t))) (when n
(send n set-visible! #t)
(send n set-plant! plant)))
neighbours)) neighbours))
(define/public (get-connection d) (define/public (get-connection d)
@ -218,7 +225,7 @@
((null? l) dirs) ((null? l) dirs)
((not (send (get-neighbour (car l)) no-connections?)) ((not (send (get-neighbour (car l)) no-connections?))
(send (get-neighbour (car l)) set-connection! (rdirection (car l)) #t) (send (get-neighbour (car l)) set-connection! (rdirection (car l)) #t)
(send (get-neighbour (car l)) set-id! id) (set! plant (send (get-neighbour (car l)) get-plant))
(set! upstream (get-neighbour (car l))) (set! upstream (get-neighbour (car l)))
#;(search/attach-to-neighbour (cdr l) (cons (car l) dirs)) #;(search/attach-to-neighbour (cdr l) (cons (car l) dirs))
(car l)) (car l))
@ -277,7 +284,8 @@
(define plant% (define plant%
(class object% (class object%
(init-field (init-field
(id "default") (id "none")
(type "none")
(pos '())) ; the seed position (pos '())) ; the seed position
(field (field
@ -287,6 +295,9 @@
(define/public (get-id) (define/public (get-id)
id) id)
(define/public (get-type)
type)
(define/public (update-me?) (define/public (update-me?)
(let ((r update-me)) (let ((r update-me))
(set! update-me #f) (set! update-me #f)
@ -320,7 +331,8 @@
(if (send (cadr plant) update-me?) (if (send (cadr plant) update-me?)
(cons (make-plant-update (car plant) (cons (make-plant-update (car plant)
(send (cadr plant) get-desc) (send (cadr plant) get-desc)
(send (cadr plant) get-pos)) r) (send (cadr plant) get-pos)
(send (cadr plant) get-type)) r)
r)) r))
'() '()
plants)) plants))
@ -377,12 +389,13 @@
(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))))))))
(define/public (seed id x y) (define/public (seed id type x y)
(send garden add-plant (make-object plant% id (list x y))) (let ((plant (make-object plant% id type (list x y))))
(send garden add-plant plant)
(send (get-cell x y) set-plant! plant)
(send (get-cell x y) set-connection! SE #t) (send (get-cell x y) set-connection! SE #t)
(send (get-cell x y) set-id! id) (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)))
(send (get-cell x (+ y 1)) set-id! id))
(define/public (update time delta) (define/public (update time delta)
@ -405,14 +418,17 @@
(if l (cons l r) r))) (if l (cons l r) r)))
'() '()
insects) insects)
(foldl (foldl
(lambda (cell r) (lambda (cell r)
(if (send cell update-me?) (if (send cell update-me?)
(let ((upstream (send cell get-upstream))) (let ((upstream (send cell get-upstream))
(plant (send cell get-plant)))
(cons (make-cell-update (send cell get-pos) (cons (make-cell-update (send cell get-pos)
(send cell get-connection-num) (send cell get-connection-num)
(send cell get-pickup) (send cell get-pickup)
(if upstream (send upstream get-pos) #f)) r)) (if upstream (send upstream get-pos) #f)
(if plant (send plant get-type) #f)) r))
r)) r))
'() '()
cells) cells)
@ -432,7 +448,7 @@
(vmul (vector (sin (* a d)) (cos (* a d)) 0) -1))) (vmul (vector (sin (* a d)) (cos (* a d)) 0) -1)))
(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
(pdata-index-map! (pdata-index-map!
@ -577,14 +593,14 @@
(define connection-cache '()) (define connection-cache '())
(define (get-connection-list id) (define (get-connection-list id type)
(let ((ret (assoc id connection-cache))) (let ((ret (assoc (list id type) connection-cache)))
(cond (cond
(ret (cdr ret)) (ret (cdr ret))
(else (else
(let* ((tex (load-primitive (string-append "textures/comp-cp-" id ".png"))) (let* ((tex (load-primitive (string-append "plants/" type "/branches/comp-cp-" id ".png")))
(connections (with-primitive tex (convert-to-pos (find-centroids 0 '()))))) (connections (with-primitive tex (convert-to-pos (find-centroids 0 '())))))
(set! connection-cache (cons (cons id connections) connection-cache)) (set! connection-cache (cons (cons (list id type) connections) connection-cache))
;(printf "~a:~a~n" id (length connections)) ;(printf "~a:~a~n" id (length connections))
(destroy tex) (destroy tex)
connections))))) connections)))))
@ -595,25 +611,27 @@
(define-struct component (root (col #:mutable) children)) (define-struct component (root (col #:mutable) children))
(define (build-component id 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)))) (translate (vector 0 0.5 (* 0.01 (rndf))))
(colour col)
(hint-none) (hint-none)
(hint-solid) (hint-solid)
(hint-unlit) (hint-unlit)
(hint-depth-sort) (hint-depth-sort)
(texture (load-texture (string-append "textures/comp-" id ".png"))) (texture (load-texture (string-append "plants/" type "/leaves/comp-" id ".png")))
(build-plane)))) (build-plane))))
(make-component root col '()))) (make-component root col '())))
(else (else
(let ((connection-list (get-connection-list id)) (let ((connection-list (get-connection-list id type))
(root (with-state (root (with-state
(colour col)
(hint-depth-sort) (hint-depth-sort)
(translate (vector 0 0.5 (* 0.01 (rndf)))) (translate (vector 0 0.5 (* 0.01 (rndf))))
; (rotate (vector 0 0 90)) ; (rotate (vector 0 0 90))
(texture (load-texture (string-append "textures/comp-" id ".png"))) (texture (load-texture (string-append "plants/" type "/branches/comp-" id ".png")))
(build-plane)))) (build-plane))))
(when (not (eq? (length connection-list) (length children))) (when (not (eq? (length connection-list) (length children)))
(printf "something wrong: ~a children:~a connections:~a~n" id (length children) (length connection-list) )) (printf "something wrong: ~a children:~a connections:~a~n" id (length children) (length connection-list) ))
@ -627,7 +645,7 @@
(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)) (rotate (vector 0 0 0))
(build-component (car child) 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))
@ -663,6 +681,7 @@
(t 0) (t 0)
(pos '(0 0)) (pos '(0 0))
(owner 0) (owner 0)
(type #f) ; the plant type of the owner of the roots, if any
(upstream-pos '())) (upstream-pos '()))
(define/public (get-upstream-pos) (define/public (get-upstream-pos)
@ -686,6 +705,9 @@
(define/public (set-pos! s) (define/public (set-pos! s)
(set! pos s)) (set! pos s))
(define/public (set-type! s)
(set! type s))
(define (build-prim code) (define (build-prim code)
(let ((p (with-state (let ((p (with-state
;(hint-wire) ;(hint-wire)
@ -714,7 +736,10 @@
(set! tile2 (build-prim code))) (set! tile2 (build-prim code)))
(define (update-texture code) (define (update-texture code)
(texture (load-texture (string-append texpath "roots-ornate.png"))) ; todo: variations
(when type
(texture (load-texture (string-append "plants/" type "/roots/roots.png")))
(colour (type->colour type)))
(pdata-map! (pdata-map!
(lambda (t tref) (lambda (t tref)
(let ((size (/ 1 8))) (let ((size (/ 1 8)))
@ -956,7 +981,7 @@
(root 0) (root 0)
(desc '())) (desc '()))
(define/public (build s) (define/public (build s type)
(set! desc s) (set! desc s)
(when (not (zero? root)) (when (not (zero? root))
@ -969,7 +994,7 @@
(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.3))
(build-component "1-1" (vector 1 1 1) (list desc)))) (build-component "1-0" type (type->colour type) (list desc))))
(super-new))) (super-new)))
@ -981,11 +1006,11 @@
(field (field
(plants '())) (plants '()))
(define/public (add-plant! id desc hex) (define/public (add-plant! id desc hex type)
(let ((plant (make-object plant-view%))) (let ((plant (make-object plant-view%)))
(with-state (with-state
(parent (send hex get-root)) (parent (send hex get-root))
(send plant build desc) (send plant build desc type)
(set! plants (cons (list id plant) plants))))) (set! plants (cons (list id plant) plants)))))
(super-new))) (super-new)))
@ -1050,7 +1075,7 @@
top (- len 1) (cons lev l))))) top (- len 1) (cons lev l)))))
(define/public (build-surface) (define/public (build-surface)
(let ((s (make-surface 12 13 20 '()))) (let ((s (make-surface 10 11 20 '())))
(for ((i (in-range 1 (- (length s) 1)))) (for ((i (in-range 1 (- (length s) 1))))
(let ((x i) (y (list-ref s i)) (let ((x i) (y (list-ref s i))
(yb (list-ref s (- i 1))) (yb (list-ref s (- i 1)))
@ -1110,11 +1135,13 @@
(s (s
(send (cadr s) new-code code) (send (cadr s) new-code code)
(send (cadr s) set-pickup! (cell-update-pickup item)) (send (cadr s) set-pickup! (cell-update-pickup item))
(send (cadr s) set-upstream-pos! (cell-update-upstream item))) (send (cadr s) set-upstream-pos! (cell-update-upstream item))
(send (cadr s) set-type! (cell-update-type item)))
(else (else
(let ((cell (make-object cell-view%))) (let ((cell (make-object cell-view%)))
(send cell set-pos! pos) (send cell set-pos! pos)
(send cell set-owner! root) (send cell set-owner! root)
(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)
@ -1135,7 +1162,8 @@
(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)))))
update-list)) update-list))
(super-new))) (super-new)))
@ -1160,7 +1188,9 @@
; (translate (vector -10 -8.5 0)) ; (translate (vector -10 -8.5 0))
(send hcv init)) (send hcv init))
(send hc seed "dave@fo.am" 10 10) (send hc seed "dave@fo.am" "knobbly" 13 10)
(send hc seed "plant00002@fo.am" "lollypop" 6 10)
;(send (send hc get-cell 50 52) grow) ;(send (send hc get-cell 50 52) grow)
;(send (send hc get-cell 49 53) grow) ;(send (send hc get-cell 49 53) grow)
@ -1175,4 +1205,6 @@
(send (send hc get-cell (car clicked) (cadr clicked)) grow))) (send (send hc get-cell (car clicked) (cadr clicked)) grow)))
(send hcv update (send hc update t d) t d)) (send hcv update (send hc update t d) t d))
;(for ((i (in-range 0 10))) (animate))
(every-frame (animate)) (every-frame (animate))

View file

Before

Width:  |  Height:  |  Size: 158 KiB

After

Width:  |  Height:  |  Size: 158 KiB

View file

Before

Width:  |  Height:  |  Size: 236 KiB

After

Width:  |  Height:  |  Size: 236 KiB

View file

Before

Width:  |  Height:  |  Size: 272 KiB

After

Width:  |  Height:  |  Size: 272 KiB

View file

Before

Width:  |  Height:  |  Size: 320 KiB

After

Width:  |  Height:  |  Size: 320 KiB

View file

Before

Width:  |  Height:  |  Size: 1.9 KiB

After

Width:  |  Height:  |  Size: 1.9 KiB

View file

Before

Width:  |  Height:  |  Size: 1.9 KiB

After

Width:  |  Height:  |  Size: 1.9 KiB

View file

Before

Width:  |  Height:  |  Size: 2 KiB

After

Width:  |  Height:  |  Size: 2 KiB

View file

Before

Width:  |  Height:  |  Size: 1.9 KiB

After

Width:  |  Height:  |  Size: 1.9 KiB

View file

Before

Width:  |  Height:  |  Size: 320 KiB

After

Width:  |  Height:  |  Size: 320 KiB

View file

Before

Width:  |  Height:  |  Size: 236 KiB

After

Width:  |  Height:  |  Size: 236 KiB

View file

Before

Width:  |  Height:  |  Size: 64 KiB

After

Width:  |  Height:  |  Size: 64 KiB

View file

Before

Width:  |  Height:  |  Size: 79 KiB

After

Width:  |  Height:  |  Size: 79 KiB

View file

Before

Width:  |  Height:  |  Size: 278 KiB

After

Width:  |  Height:  |  Size: 278 KiB

View file

Before

Width:  |  Height:  |  Size: 440 KiB

After

Width:  |  Height:  |  Size: 440 KiB

View file

Before

Width:  |  Height:  |  Size: 231 KiB

After

Width:  |  Height:  |  Size: 231 KiB

View file

Before

Width:  |  Height:  |  Size: 160 KiB

After

Width:  |  Height:  |  Size: 160 KiB

View file

Before

Width:  |  Height:  |  Size: 137 KiB

After

Width:  |  Height:  |  Size: 137 KiB

View file

Before

Width:  |  Height:  |  Size: 378 KiB

After

Width:  |  Height:  |  Size: 378 KiB

View file

Before

Width:  |  Height:  |  Size: 106 KiB

After

Width:  |  Height:  |  Size: 106 KiB

View file

Before

Width:  |  Height:  |  Size: 185 KiB

After

Width:  |  Height:  |  Size: 185 KiB

View file

Before

Width:  |  Height:  |  Size: 218 KiB

After

Width:  |  Height:  |  Size: 218 KiB

View file

Before

Width:  |  Height:  |  Size: 204 KiB

After

Width:  |  Height:  |  Size: 204 KiB

View file

Before

Width:  |  Height:  |  Size: 299 KiB

After

Width:  |  Height:  |  Size: 299 KiB

View file

Before

Width:  |  Height:  |  Size: 2.2 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

View file

Before

Width:  |  Height:  |  Size: 2.7 KiB

After

Width:  |  Height:  |  Size: 2.7 KiB

View file

Before

Width:  |  Height:  |  Size: 2.8 KiB

After

Width:  |  Height:  |  Size: 2.8 KiB

View file

Before

Width:  |  Height:  |  Size: 2.8 KiB

After

Width:  |  Height:  |  Size: 2.8 KiB

View file

Before

Width:  |  Height:  |  Size: 3.1 KiB

After

Width:  |  Height:  |  Size: 3.1 KiB

View file

Before

Width:  |  Height:  |  Size: 234 KiB

After

Width:  |  Height:  |  Size: 234 KiB

View file

Before

Width:  |  Height:  |  Size: 302 KiB

After

Width:  |  Height:  |  Size: 302 KiB

View file

Before

Width:  |  Height:  |  Size: 196 KiB

After

Width:  |  Height:  |  Size: 196 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 34 KiB