twig recycling and scaling works

This commit is contained in:
Dave Griffiths 2009-06-25 17:56:09 +01:00
parent 8d1b3dafda
commit 4310213545

View file

@ -1,5 +1,5 @@
;#lang scheme/base #lang scheme/base
;(require fluxus-016/drflux) (require fluxus-016/drflux)
(require scheme/class) (require scheme/class)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@ -40,6 +40,7 @@
(define branch-jitter 1) (define branch-jitter 1)
(define max-twig-points 40) (define max-twig-points 40)
(define start-twig-width 0.1) (define start-twig-width 0.1)
(define default-max-twigs 5)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; a message for sending betwixt logic and render side ; a message for sending betwixt logic and render side
@ -110,7 +111,8 @@
(points '()) ; the 3d points for this twig (points '()) ; the 3d points for this twig
(twigs '()) ; children are stored with the point number they are connected to. (twigs '()) ; children are stored with the point number they are connected to.
(ornaments '()) ; the things attached to this twig, an assoc list with point index (ornaments '()) ; the things attached to this twig, an assoc list with point index
(last-point (vector 0 0 0))) (last-point (vector 0 0 0))
(dist 1)) ; distance between points
(inherit send-message) (inherit send-message)
@ -138,11 +140,16 @@
(define/public (get-point point-index) (define/public (get-point point-index)
(list-ref points point-index)) (list-ref points point-index))
(define/public (scale a)
(set! width (* width a))
(set! dist (* dist a))
(printf "~a~n" dist))
(define/public (grow) (define/public (grow)
(when (< (length points) num-points) (when (< (length points) num-points)
(let ((new-point (if (zero? (length points)) (let ((new-point (if (zero? (length points))
(vector 0 0 0) ; first point should be at the origin (vector 0 0 0) ; first point should be at the origin
(vadd last-point dir (vmul (srndvec) twig-jitter))))) (vadd last-point (vmul dir dist) (vmul (srndvec) twig-jitter)))))
(set! last-point new-point) (set! last-point new-point)
(set! points (append points (list new-point))) (set! points (append points (list new-point)))
(send-message 'twig-grow (list (send-message 'twig-grow (list
@ -276,9 +283,10 @@
(field (field
(twigs '()) ; a assoc list map of ages to twigs (twigs '()) ; a assoc list map of ages to twigs
(age 0) ; the age of this plant (size 1) ; the age of this plant
(max-twigs 10) ; the maximum twigs allowed at any time - oldest removed first (max-twigs default-max-twigs) ; the maximum twigs allowed at any time - oldest removed first
(next-twig-id 0)) (next-twig-id 0)
(grow-amount 1.1))
(inherit send-message) (inherit send-message)
@ -327,6 +335,12 @@
(define/public (add-twig twig) (define/public (add-twig twig)
(send twig set-id! (get-next-twig-id)) (send twig set-id! (get-next-twig-id))
(set! size (* size grow-amount))
(send twig scale size)
(send-message 'grow-seed (list
(list 'pland-id id)
(list 'amount grow-amount)))
(send-message 'new-branch-twig (list (send-message 'new-branch-twig (list
(list 'plant-id id) (list 'plant-id id)
(list 'twig-id (send twig get-id)) (list 'twig-id (send twig get-id))
@ -336,6 +350,7 @@
(list 'num-points (send twig get-num-points)) (list 'num-points (send twig get-num-points))
(list 'render-type (send twig get-render-type)) (list 'render-type (send twig get-render-type))
)) ))
(set! twigs (cons-twig twig twigs max-twigs '()))) (set! twigs (cons-twig twig twigs max-twigs '())))
(define/augment (update) (define/augment (update)
@ -573,9 +588,15 @@
(define/public (set-pos! s) (define/public (set-pos! s)
(set! pos s)) (set! pos s))
(define/public (get-child-twig-ids)
child-twig-ids)
(define/public (get-root) (define/public (get-root)
(error "need to overide this")) (error "need to overide this"))
(define/public (destroy-twig)
(destroy (get-root)))
(define/public (set-parent-twig-id s) (define/public (set-parent-twig-id s)
(set! parent-twig-id s)) (set! parent-twig-id s))
@ -741,6 +762,22 @@
(send twig build) (send twig build)
(set! twigs (cons (list (send twig get-id) twig) twigs))) (set! twigs (cons (list (send twig get-id) twig) twigs)))
(define (assoc-remove k l)
(cond
((null? l) '())
((eq? (car (car l)) k)
(assoc-remove k (cdr l)))
(else
(cons (car l) (assoc-remove k (cdr l))))))
(define/public (destroy-branch-twig twig-id)
(for-each
(lambda (twig-id)
(destroy-branch-twig twig-id))
(send (get-twig twig-id) get-child-twig-ids))
(send (get-twig twig-id) destroy-twig)
(set! twigs (assoc-remove twig-id twigs)))
(define/public (add-twig parent-twig-id point-index twig) (define/public (add-twig parent-twig-id point-index twig)
(let ((ptwig (get-twig parent-twig-id))) (let ((ptwig (get-twig parent-twig-id)))
; attach to parent twig ; attach to parent twig
@ -877,6 +914,9 @@
(set! current-twig-id (send twig get-id))) (set! current-twig-id (send twig get-id)))
(send (get-plant plant-id) add-branch-twig twig)) (send (get-plant plant-id) add-branch-twig twig))
(define/public (destroy-branch-twig plant-id twig-id)
(send (get-plant plant-id) destroy-branch-twig twig-id))
(define/public (add-twig plant-id parent-twig-id point-index twig) (define/public (add-twig plant-id parent-twig-id point-index twig)
(send (get-plant plant-id) add-twig parent-twig-id point-index twig)) (send (get-plant plant-id) add-twig parent-twig-id point-index twig))
@ -912,6 +952,9 @@
(send msg get-data 'plant-id) (send msg get-data 'plant-id)
(send msg get-data 'pos)) #f)) (send msg get-data 'pos)) #f))
((eq? (send msg get-name) 'destroy-branch-twig)
(destroy-branch-twig (send msg get-data 'plant-id) (send msg get-data 'twig-id)))
((eq? (send msg get-name) 'new-branch-twig) ((eq? (send msg get-name) 'new-branch-twig)
(add-branch-twig (send msg get-data 'plant-id) (add-branch-twig (send msg get-data 'plant-id)
(cond (cond
@ -999,17 +1042,17 @@
(vtransform-rot (vector 0 0 -1) (minverse (get-camera-transform))) (vtransform-rot (vector 0 0 -1) (minverse (get-camera-transform)))
start-twig-width 20 'extruded)) start-twig-width 20 'extruded))
(set! debounce #f) (set! debounce #f)
(set! debounce-time (+ (time) 0.2))) (set! debounce-time (+ (flxtime) 0.2)))
(when (> (time) debounce-time) (when (> (flxtime) debounce-time)
(set! debounce #t)) (set! debounce #t))
(when (< tick-time (time)) (when (< tick-time (flxtime))
(set! tick-time (+ (time) tick)) (set! tick-time (+ (flxtime) tick))
(send plant1 grow) (send plant1 grow)
(send plant2 grow) (send plant2 grow)
(send gv update (time) (delta) (send gl update))) (send gv update (flxtime) (delta) (send gl update)))
(send gv update (time) (delta) '())) (send gv update (flxtime) (delta) '()))
(every-frame (animate)) (every-frame (animate))