FoAM/groworld
12
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

removed junk

Browse source
This commit is contained in:
Dave Griffiths 2009-06-19 17:23:40 +01:00
parent 1489bd4b10
commit d5f08b881b
3 changed files with 10 additions and 127 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
fpp/cam-dir.scm~
View file

@ -1,10 +0,0 @@
(clear)
(show-axis 1)
(clear-colour 0.5)
(hint-wire)
(define p (build-ribbon 2))
(every-frame
(with-primitive p
(pdata-set! "p" 1
(vtransform-rot (vector 0 0 1) (minverse (get-camera-transform))))))

21
fpp/fpp.scm
View file

@ -16,7 +16,7 @@
(define twig% (define twig%
(class object% (class object%
(init-field (init-field
(size 10) (size 100)
(radius 1) (radius 1)
(speed 0.2)) (speed 0.2))
(field (field
@ -29,24 +29,22 @@
(define/public (build pos dir) (define/public (build pos dir)
(with-primitive root (with-primitive root
(translate pos) (translate pos)
(if dir (concat (maim (vector 0 0 1) dir)) (if dir (concat (maim dir (vector 0 0 1)))
(rotate (vmul (crndvec) 20))))) (rotate (vmul (crndvec) 20)))))
(define/public (update) (define/public (update)
(when (and (< age size) (< next-ring-time (time))) (when (and (< age size) (< next-ring-time (time)))
(set! next-ring-time (+ (time) speed)) (set! next-ring-time (+ (time) speed))
(with-state (with-state
(parent root) (parent root)
;(hint-none) (hint-none)
; (hint-wire) (hint-wire)
(backfacecull 0) (backfacecull 0)
(let* ((s (- size age)) (let* ((s (- size age))
(sr (* radius (/ s size))) (sr (* radius (/ s size)))
(er (* radius (/ (+ s 1) size)))) (er (* radius (/ (- s 1) size))))
(translate (vector 0 0 age)) (translate (vector 0 0 age))
(when (zero? (random 20)) (when (zero? (random 10))
(with-state (with-state
(identity) (identity)
(set! child-twigs (cons (set! child-twigs (cons
@ -73,7 +71,7 @@
(debounce-time 0)) (debounce-time 0))
(define/public (add-twig dir) (define/public (add-twig dir)
(let ((t (make-object twig% 100 1 0.01))) (let ((t (make-object twig% 20 1 0.1)))
(set! twigs (cons (with-state (set! twigs (cons (with-state
(colour (vector 0.3 0.8 0.4)) (colour (vector 0.3 0.8 0.4))
(send t build (vector 0 0 0) dir) t) twigs)))) (send t build (vector 0 0 0) dir) t) twigs))))
@ -100,7 +98,8 @@
(clear) (clear)
(show-axis 1) (show-axis 1)
(clear-colour (vector 0.2 0.5 0.3)) (clear-colour (vector 0.2 0.5 0.3))
(fog (vector 0.2 0.5 0.3) 0.1 1 100)
(define s (make-object seed%)) (define s (make-object seed%))
(every-frame (send s update)) (every-frame (send s update))

106
fpp/fpp.scm~
View file

@ -1,106 +0,0 @@
(require scheme/class)
(define (build-ring n sr er)
(let ((p (build-polygons (+ (* n 2) 2) 'triangle-strip)))
(with-primitive p
(pdata-index-map!
(lambda (i p)
(let ((a (* (/ (quotient i 2) n) (* 2 3.141)))
(s (if (odd? i) sr er)))
(vector (* (cos a) s) (* (sin a) s) (if (odd? i) 0 1))))
"p")
(recalc-normals 1))
p))
(define twig%
(class object%
(init-field
(size 10)
(radius 1)
(speed 0.2))
(field
(root (build-locator))
(child-twigs '())
(age 0)
(tx (mident))
(next-ring-time 0))
(define/public (build pos dir)
(with-primitive root
(translate pos)
(if dir (concat (maim (vector 0 0 1) dir))
(rotate (vmul (crndvec) 20)))))
(define/public (update)
(when (and (< age size) (< next-ring-time (time)))
(set! next-ring-time (+ (time) speed))
(with-state
(parent root)
;(hint-none)
;(hint-wire)
(backfacecull 0)
(let* ((s (- size age))
(sr (* radius (/ s size)))
(er (* radius (/ (+ s 1) size))))
(translate (vector 0 0 age))
(when (zero? (random 20))
(with-state
(identity)
(set! child-twigs (cons
(make-object twig% (/ size 2) sr speed) child-twigs))
(send (car child-twigs) build (vector 0 0 age) #f)))
(build-ring 5 sr er)))
(set! age (+ age 1)))
(for-each
(lambda (child)
(send child update))
child-twigs))
(super-new)))
(define seed%
(class object%
(field
(twigs '())
(debounce #t)
(debounce-time 0))
(define/public (add-twig dir)
(let ((t (make-object twig% 100 1 0.01)))
(set! twigs (cons (with-state
(colour (vector 0.3 0.8 0.4))
(send t build (vector 0 0 0) dir) t) twigs))))
(define/public (update)
(when (and debounce (key-pressed " "))
(add-twig (vtransform-rot (vector 0 0 1) (minverse (get-camera-transform))))
(set! debounce #f)
(set! debounce-time (+ (time) 1)))
(when (> (time) debounce-time)
(set! debounce #t))
(for-each
(lambda (twig)
(send twig update))
twigs))
(super-new)))
(clear)
(show-axis 1)
(clear-colour (vector 0.2 0.5 0.3))
(define s (make-object seed%))
(every-frame (send s update))