This commit is contained in:
Dave Griffiths 2009-03-12 11:51:02 +00:00
parent 0767f878b6
commit 4fc0ca5daf
31 changed files with 185 additions and 26 deletions

View file

@ -140,15 +140,15 @@
(let ((num-children (if (> depth 3) 0 (choose (list 0 1 2 3)))))
(cond
((eq? num-children 0) (list (choose (list "2" "3" "4" "5" "6" "7" "8" "9" "10")) (list)))
((eq? num-children 1) (list "1-0" (list (make-random-plant (+ depth 1)))))
((eq? num-children 2) (list "2-0" (list (make-random-plant (+ depth 1))
((eq? num-children 1) (list "1-1" (list (make-random-plant (+ depth 1)))))
((eq? num-children 2) (list "2-1" (list (make-random-plant (+ depth 1))
(make-random-plant (+ depth 1)))))
((eq? num-children 3) (list "3-0" (list (make-random-plant (+ depth 1))
((eq? num-children 3) (list "3-1" (list (make-random-plant (+ depth 1))
(make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)))))
((eq? num-children 4) (list "4-0" (list (make-random-plant (+ depth 1))
((eq? num-children 4) (list "4-1" (list (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-0" (list (make-random-plant (+ depth 1))
((eq? num-children 5) (list "5-1" (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))))))))
@ -275,9 +275,10 @@
(define/public (puff-pollen pos col size np)
(with-primitive pollen
(for ((i (in-range 0 np)))
(let ((c (random (pdata-size))))
(let ((c (random (pdata-size)))
(cc (vadd col (vmul (grndvec) 0.2))))
(pdata-set! "p" c (vadd (vmul (cirndvec) size) pos))
(pdata-set! "c" c (vadd col (vmul (grndvec) 0.2)))))))
(pdata-set! "c" c (vector (vx cc) (vy cc) (vz cc) 0.5))))))
(super-new)
(init)))
@ -345,21 +346,21 @@
(define network-dispatch%
(class object%
(define (stringify l)
(cond
((null? l) l)
((symbol? (car l))
(cons (symbol->string (car l))
(stringify (cdr l))))
((number? (car l))
(cons (number->string (car l))
(stringify (cdr l))))
((list? (car l))
(cons (stringify (car l)) (stringify (cdr l))))
(else (error "oops"))))
(define (stringify l)
(cond
((null? l) l)
((symbol? (car l))
(cons (symbol->string (car l))
(stringify (cdr l))))
((number? (car l))
(cons (number->string (car l))
(stringify (cdr l))))
((list? (car l))
(cons (stringify (car l)) (stringify (cdr l))))
(else (error "oops"))))
(define/public (dispatch world)
(cond
((osc-msg "/add-plant")
@ -367,7 +368,7 @@
(send world add-entity (make-object plant%
(vector (osc 0) (osc 1) (osc 2))
(vector (osc 3) (osc 4) (osc 5))
(stringify (eval-string (osc 6))))))
(stringify (eval-string (osc 6))))))
((osc-msg "/destroy-plant")
(printf "destroy plant message recieved...~n")
(send world destroy-entity (osc 0)))
@ -377,11 +378,11 @@
(define/public (add-plant world)
(printf "sending add plant...~n")
(let* ((pos (vector (* (crndf) 5) 2 1))
(col (rndvec))
(desc (list (make-random-plant 0)))
(desc-str (format "'~a" desc)))
(col (rndvec))
(desc (list (make-random-plant 0)))
(desc-str (format "'~a" desc)))
(printf "sending:~a~n" desc-str)
(osc-send "/add-plant" "ffffffs" (list (vx pos) (vy pos) (vz pos)
(vx col) (vy col) (vz col) desc-str))

158
pluggable/pluggable.scm Normal file
View file

@ -0,0 +1,158 @@
; converts a 2D vector into an angle, with some dodgy dave maths
(define (2dvec->angle x y)
(let ((q (/ 3.141 2)))
(when (zero? y) (set! y 0.0001))
(cond
((>= y 0)
(fmod (* (+ q q q (- q (atan (/ x y)))) 57.2957795) 360))
(else
(fmod (* (+ q (- q (atan (/ x y)))) 57.2957795) 360)))))
(define (i->pos i)
(vector (modulo i (pixels-width))
(quotient i (pixels-width)) 0))
(define (pos->i pos)
(+ (* (round (vy pos)) (pixels-width)) (round (vx pos))))
(define (pixels-ref name pos)
(pdata-ref name (pos->i pos)))
(define (pixels-set! name pos s)
(pdata-set! name (pos->i pos) s))
(define (search i)
(cond
((eq? i (pdata-size)) i)
((< (vr (pdata-ref "c" i)) 0.5) i)
(else (search (+ i 1)))))
(define (flood pos tc av)
(define (rec-flood pos)
(pixels-set! "c" pos (vector 1 0 1))
(set! tc (+ tc 1))
(set! av (vadd av pos))
(when (< (vr (pixels-ref "c" (vadd pos (vector -1 0 0)))) 0.5)
(rec-flood (vadd pos (vector -1 0 0))))
(when (< (vr (pixels-ref "c" (vadd pos (vector 1 0 0)))) 0.5)
(rec-flood (vadd pos (vector 1 0 0))))
(when (< (vr (pixels-ref "c" (vadd pos (vector 0 1 0)))) 0.5)
(rec-flood (vadd pos (vector 0 1 0))))
(when (< (vr (pixels-ref "c" (vadd pos (vector 0 -1 0)))) 0.5)
(rec-flood (vadd pos (vector 0 -1 0)))))
(rec-flood pos)
(vmul av (/ 1 tc)))
(define (find-centroids pos l)
(let ((i (search pos)))
(cond ((eq? i (pdata-size)) l)
(else
(find-centroids i
(cons (flood (i->pos i) 0 (vector 0 0 0)) l))))))
(define (convert-to-pos l)
(map
(lambda (cp)
(vector (- (- (/ (vx cp) (pixels-width)) 0.5))
(- 1 (/ (vy cp) (pixels-height))) 0))
l))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define connection-cache '())
(define (get-connection-list id)
(let ((ret (assoc id connection-cache)))
(cond
(ret (cdr ret))
(else
(let* ((tex (load-primitive (string-append "textures/comp-cp-" id ".png")))
(connections (with-primitive tex (convert-to-pos (find-centroids 0 '())))))
(set! connection-cache (cons (cons id connections) connection-cache))
(destroy tex)
connections)))))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define-struct component (root children))
(define (build-component id children)
(cond
((null? children)
(let ((root (with-state
(translate (vector 0 0.5 0))
(rotate (vector 0 0 180))
(hint-ignore-depth)
(texture (load-texture (string-append "textures/comp-" id ".png")))
(build-plane))))
(with-primitive root (apply-transform))
(make-component root '())))
(else
(let* ((connection-list (get-connection-list id))
(root (with-state
(translate (vector 0 0.5 0))
(rotate (vector 0 0 180))
(texture (load-texture (string-append "textures/comp-" id ".png")))
(build-plane)))
(comp (make-component root
(map
(lambda (child connection)
(with-state
(hint-ignore-depth)
(parent root)
(translate (vector 0 0 -0.01))
(printf "~a~n" connection)
(translate connection)
(scale 0.8)
(rotate (vector 0 0 (2dvec->angle
(vx connection) (- (vy connection) 0.5))))
(rotate (vector 0 0 0))
(build-component (car child) (cadr child))))
children
connection-list))))
(with-primitive root (apply-transform))
comp))))
(define (component-print component)
(printf "~a~n" (component-children component)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define (choose l)
(list-ref l (random (length l))))
(define (make-random-plant depth)
(let ((num-children (if (> depth 10) 0 (choose (list 0 1 2 3)))))
(cond
((eq? num-children 0) (list (choose (list "0" "0")) (list)))
((eq? num-children 1) (list "1-1" (list (make-random-plant (+ depth 1)))))
((eq? num-children 2) (list "2-1" (list (make-random-plant (+ depth 1))
(make-random-plant (+ depth 1)))))
((eq? num-children 3) (list (string-append "3-" (choose (list "1" "2")))
(list (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))
(make-random-plant (+ depth 1)) (make-random-plant (+ depth 1))
(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))))))))
(clear)
(clear-colour (vector 1 1 1))
(clear-geometry-cache)
(clear-texture-cache)
(hint-unlit)
;(opacity 0.5)
(define p (make-random-plant 0))
(display p) (newline)
(define c (build-component "1-1" (list p)))

Binary file not shown.

After

Width:  |  Height:  |  Size: 234 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 106 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 158 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 302 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 34 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 185 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 236 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 320 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 218 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 272 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 307 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 236 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 204 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 79 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 299 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 278 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 440 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 231 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 160 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 137 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.1 KiB