diff --git a/danceplant/gro.scm b/danceplant/gro.scm index e5922ca..4b0db4d 100644 --- a/danceplant/gro.scm +++ b/danceplant/gro.scm @@ -303,7 +303,7 @@ (clear) (clear-colour (vector 0 0.3 0.2)) (set-camera-transform (mmul (mtranslate (vector 0 -5 -10)) - (mrotate (vector 90 90 180)))) + (mrotate (vector 90 -90 180)))) (with-state (hint-unlit) diff --git a/danceplant/gro2.scm b/danceplant/gro2.scm index 86fbc88..d862ac5 100644 --- a/danceplant/gro2.scm +++ b/danceplant/gro2.scm @@ -305,7 +305,7 @@ (clear) ;(clear-colour (vector 0 0.5 0.4)) (set-camera-transform (mmul (mtranslate (vector 0 -5 -10)) - (mrotate (vector 90 90 180)))) + (mrotate (vector 90 -90 180)))) #;(with-state (hint-unlit) diff --git a/flatgarden/flatgarden.scm b/flatgarden/flatgarden.scm index 040cb4b..5e53430 100644 --- a/flatgarden/flatgarden.scm +++ b/flatgarden/flatgarden.scm @@ -107,14 +107,17 @@ (string->list string)) obj-list)) +(define t 0) + (define (animate obj-list) + (set! t (+ t 0.05)) (let ((c 0)) (for-each (lambda (objs) (for-each (lambda (obj) (with-primitive obj - (rotate (vector 0 0 (* 0.1 (sin (+ c (time))))))) + (rotate (vector 0 0 (* 0.05 (sin (+ (* c 0.2) (* 4 t))))))) (set! c (+ c 20))) objs)) obj-list))) @@ -132,12 +135,12 @@ (colour 1) -(for ((i (in-range 0 5))) +(for ((i (in-range 0 10))) (let ((t2 (with-state (translate (vector 0 (* 20 (crndf)) (rndf))) (build-locator)))) (set! trees (cons (ls-build t2 (ls-generate 3 "F" '(("F" "G-[-F+G+FB]+F[+F-G-FL]-F"))) (+ 10 (random 20)) 0.9) trees)))) - +(start-framedump "wind" "jpg") (every-frame (animate trees)) diff --git a/hayfever/hayfever2.scm b/hayfever/hayfever2.scm index 00eacff..db610ff 100644 --- a/hayfever/hayfever2.scm +++ b/hayfever/hayfever2.scm @@ -17,7 +17,7 @@ (define pollen-particles 300) (define max-pollen-radius 12) (define suck-pollen-radius 8) -(define deterministic #f) +(define deterministic #t) (define minimal-mode #f) (define jid "plant0000003@fo.am") (define pass "plant0000003") @@ -241,15 +241,21 @@ (when deterministic (flxseed 3) - (random-seed 11) ; 2 5 + (random-seed 1) ; 2 5 ) - (let* ((pos (vector (* (crndf) 5) 0 0.1)) + (let* ((pos (vector -4 #;(* (crndf) 5) 0 0.1)) (col (hsv->rgb (vector (rndf) 0.8 1))) (desc (list (make-random-plant 0)))) (set! my-id jid) - (set-entity my-id (make-object plant% pos col desc)))) + (set-entity my-id (make-object plant% pos col desc))) + + + (let* ((pos (vector 4 #;(* (crndf) 5) 0 0.1)) + (col (hsv->rgb (vector (rndf) 0.8 1))) + (desc (list (make-random-plant 0)))) + (set-entity "other" (make-object plant% pos col desc)))) (define/public (get-entity id) (foldl diff --git a/hex-ornament/hex-ornament.scm b/hex-ornament/hex-ornament.scm new file mode 100644 index 0000000..7e67f58 --- /dev/null +++ b/hex-ornament/hex-ornament.scm @@ -0,0 +1,389 @@ +(require scheme/class) + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +; odds and sods + +; return a version of list l with v inserted at the nth +; position and with c as a counter +(define (insert l n v c) + (cond + ((null? l) l) + ((eq? c n) (cons v (insert (cdr l) n v (+ c 1)))) + (else (cons (car l) (insert (cdr l) n v (+ c 1)))))) + +(define (list-remove l i) + (if (zero? i) + (cdr l) + (cons (car l) (list-remove (cdr l) (- i 1))))) + +(define (shuffle l) + (if (null? l) + '() + (let ((i (random (length l)))) + (cons (list-ref l i) + (shuffle (list-remove l i)))))) + +; convert a list of bools into a number, treating the +; list as a binary sequence +(define (bool-list->num l n c) + (cond + ((null? l) n) + ((car l) (bitwise-ior (arithmetic-shift 1 c) + (bool-list->num (cdr l) n (+ c 1)))) + (else (bool-list->num (cdr l) n (+ c 1))))) + +; how to find your way around a hexagon +; . +; 5 (NW) / \ 0 (NE) +; / \ +; 4 (W)| | 1 (E) +; | | +; \ / +; 3 (SW) \ / 2 (SE) +; ` + +(define NE 0) +(define E 1) +(define SE 2) +(define SW 3) +(define W 4) +(define NW 5) + +(define directions (list NE E SE SW W NW)) + +(define (rdirection d) + (cond + ((eq? d NE) SW) + ((eq? d E) W) + ((eq? d SE) NW) + ((eq? d SW) NE) + ((eq? d W) E) + ((eq? d NW) SE))) + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +; logic + +(define comb-cell% + (class object% + (field + (neighbours '(#f #f #f #f #f #f)) + (contents '()) + (connections '(#f #f #f #f #f #f)) + (visible #f) + (update-me #f)) + + (define/public (update-me?) + (let ((r update-me)) + (set! update-me #f) + r)) + + (define/public (set-visible! s) + (set! update-me #t) + (set! visible s)) + + (define/public (visible?) + visible) + + (define/public (get-neighbours) + neighbours) + + (define/public (get-neighbour d) + (list-ref neighbours d)) + + (define/public (set-neighbour! d n) + (set! neighbours (insert neighbours d n 0))) + + (define/public (get-contents) + contents) + + (define/public (get-connections) + connections) + + (define/public (no-connections?) + (equal? connections (list #f #f #f #f #f #f))) + + (define/public (set-connection! d n) + (set! update-me #t) + (set! visible #t) + (set! connections (insert connections d n 0)) + ; tell all our neighbours to become visible + (for-each + (lambda (n) + (when n (send n set-visible! #t))) + neighbours)) + + (define/public (get-connection d) + (list-ref connections d)) + + (define/public (get-connection-num) + (bool-list->num connections 0 0)) + + ; returns the first attachable neighbour found, and sets it's connection + (define (search/attach-to-neighbour l) + (cond + ((null? l) #f) + ((not (send (get-neighbour (car l)) no-connections?)) + (send (get-neighbour (car l)) set-connection! (rdirection (car l)) #t) + (car l)) + (else (search/attach-to-neighbour (cdr l))))) + + (define/public (grow) + ; only possible to grow when we are a clear cell + (when (equal? connections (list #f #f #f #f #f #f)) + (let ((dir (search/attach-to-neighbour (shuffle directions)))) + (when dir + ; it's dir is false if we have nothing around us to + ; connect to, probably shouldn't happen, haven't decided yet + (set-connection! dir #t))))) + + (super-new))) + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +(define honey-comb% + (class object% + (field + (cells '()) + (width 0) + (height 0)) + + (define/public (get-cell x y) + (list-ref cells (+ (* y height) x))) + + (define/public (init w h) + (set! width w) + (set! height h) + + ; first build the cells + (set! cells (build-list (* w h) (lambda (_) (make-object comb-cell%)))) + + ; then stitch them together like this: + + ; o o o o o o o o o o o + ; o o o o o o o o o o o + ; o o o o o o o o o o o + ; o o o o o o o o o o o + + (for ((x (in-range 0 width))) + (for ((y (in-range 0 height))) + (let ((cell (get-cell x y))) + (when (and (< x (- width 1)) (> y 0)) + (send cell set-neighbour! NE (get-cell (if (odd? y) (+ x 1) x) (- y 1)))) + (when (< x (- width 1)) + (send cell set-neighbour! E (get-cell (+ x 1) y))) + (when (and (< x (- width 1)) (< y (- height 1))) + (send cell set-neighbour! SE (get-cell (if (odd? y) (+ x 1) x) (+ y 1)))) + + (when (and (> x 0) (> y 0)) + (send cell set-neighbour! NW (get-cell (if (odd? y) x (- x 1)) (- y 1)))) + (when (> x 0) + (send cell set-neighbour! W (get-cell (- x 1) y))) + (when (and (> x 0) (< y (- height 1))) + (send cell set-neighbour! SW (get-cell (if (odd? y) x (- x 1)) (+ y 1)))))))) + + (define/public (seed x y) + + (send (get-cell x y) set-connection! SE #t) + (send (get-cell x (+ y 1)) set-connection! NW #t) + + #;(let ((seed (get-cell x y))) + ; set all directions to be connected + (for-each + (lambda (d) + (send seed set-connection! d #t)) + directions) + + (for-each + (lambda (n d) + (send n set-connection! (rdirection d) #t)) + (send seed get-neighbours) + directions))) + + (define/public (get-update-list) + (let ((i -1)) + (foldl + (lambda (cell r) + (set! i (+ i 1)) + (if (send cell update-me?) + (cons (list + (list (modulo i width) (quotient i height)) + (send cell get-connection-num)) r) + r)) + '() + cells))) + + (super-new))) + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +; graphics and interaction + +(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 cell-view% + (class object% + (field + (root 0) + (root2 0) + (t 0) + (pos '(0 0)) + (owner 0)) + + (define/public (set-owner! s) + (set! owner s)) + + (define/public (get-root) + root) + + (define/public (get-pos) + pos) + + (define/public (set-pos! s) + (set! pos s)) + + (define (build-prim code) + (let ((p (with-state + ;(hint-wire) + (parent owner) + (hint-depth-sort) + (opacity 0) + (colour (vector 0.9 1 0.5)) + (hint-unlit) + (when (odd? (cadr pos)) + (translate (vector 0.5 0 0))) + (translate (vector (car pos) (* 0.85 (cadr pos)) (* 0.001 (rndf)))) + (scale 0.57) + (rotate (vector 0 0 90)) + (build-ngon 6)))) + (with-primitive p + (update-texture code)) + p)) + + (define/public (build code) + (set! root (build-prim code)) + (set! root2 (build-prim code))) + + (define (update-texture code) + (texture (load-texture "textures/roots-ornate.png")) + (pdata-map! + (lambda (t tref) + (let ((size (/ 1 8))) + (vadd (vmul tref size) (vector (* 1 size (+ 1 (modulo code 8))) + (* size 1 (+ 1 (quotient code 8))) 0)))) + "t" "tref")) + + (define/public (new-code code) + (when (not (zero? root2)) + (destroy root2) + (with-primitive root (opacity 1))) + (set! root2 (build-prim code)) + (set! t 0)) + + (define/public (update) + (set! t (+ t 0.04)) + + (when (< t 1) + (with-primitive root + (opacity (- 1 t))) + (with-primitive root2 + (opacity t))) + + (when (> t 1) + (with-primitive root + (opacity 1)) + + (when (not (zero? root2)) + (destroy root) + (set! root root2) + (set! root2 0)))) + + (super-new))) + + +(define honey-comb-view% + (class object% + (field + (root 0) + (cells '())) ; an associative array mapping position to cell-view obs + + (define/public (init) + (set! root (build-locator))) + + (define (get-pos-from-prim p l) + (cond + ((null? l) #f) + ((eq? (send (cadr (car l)) get-root) p) (caar l)) + (else (get-pos-from-prim p (cdr l))))) + + (define/public (deal-with-input) + (if (mouse-button 1) + (get-pos-from-prim (mouse-over) cells) + #f)) + + (define/public (update update-list) + (for-each + (lambda (cell) + (send (cadr cell) update)) + cells) + (for-each + (lambda (item) + (let* + ((pos (car item)) + (code (cadr item)) + (s (assoc pos cells))) + (cond + (s (send (cadr s) new-code code)) + (else + (let ((cell (make-object cell-view%))) + (send cell set-pos! pos) + (send cell set-owner! root) + (send cell build code) + (set! cells (cons (list pos cell) cells))))))) + update-list)) + + (super-new))) + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +(clear) +(clear-colour (vector 0.5 0.2 0.1)) +(clear-texture-cache) +(show-axis 0) +(set-camera-transform (mtranslate (vector 0 0 -8))) + +(define hc (make-object honey-comb%)) +(define hcv (make-object honey-comb-view%)) + +(send hc init 100 100) + +(with-state + (translate (vector -50 -42.5 0)) + (send hcv init)) + +(send hc seed 50 50) +;(send (send hc get-cell 50 52) grow) +;(send (send hc get-cell 49 53) grow) + +(define (animate) + (let ((clicked (send hcv deal-with-input))) + (when clicked + (send (send hc get-cell (car clicked) (cadr clicked)) grow))) + (send hcv update (send hc get-update-list))) + +(every-frame (animate)) diff --git a/hex-ornament/hex.scm b/hex-ornament/hex.scm new file mode 100644 index 0000000..e6b9f83 --- /dev/null +++ b/hex-ornament/hex.scm @@ -0,0 +1,39 @@ +(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) + (vsub (vmul p 0.5) (vector 0.5 0.5 0))) + "t" "p")) + p)) + +(define (binarify n) + (pdata-index-map! + (lambda (i p) + (let ((c (arithmetic-shift 1 (inexact->exact i)))) + (when (not (zero? (bitwise-and (inexact->exact n) c))) + (let ((pos (vtransform (vmul (vadd p (pdata-ref "p" (+ i 1))) 0.5) (get-transform)))) + (with-state + (hint-none) + (hint-wire) + (translate pos) + (scale 0.1) + (build-ngon 10)))) + p)) + "p")) + +(clear) + +(for ((i (in-range 0 64))) + (with-primitive (with-state + (translate (vmul (vector (modulo i 8) (quotient i 8) 0) 2)) + (hint-none) + (hint-wire) + (hint-unlit) + (build-ngon 6)) + (binarify i))) diff --git a/hex-ornament/textures/roots-ornate.png b/hex-ornament/textures/roots-ornate.png new file mode 100644 index 0000000..592f237 Binary files /dev/null and b/hex-ornament/textures/roots-ornate.png differ diff --git a/hex-ornament/textures/roots.png b/hex-ornament/textures/roots.png new file mode 100644 index 0000000..76d79ec Binary files /dev/null and b/hex-ornament/textures/roots.png differ diff --git a/treetris/treetris.scm b/treetris/treetris.scm index db67583..335b2da 100644 --- a/treetris/treetris.scm +++ b/treetris/treetris.scm @@ -265,57 +265,57 @@ ; builds objects from a string (define (ls-build string angle branch-scale branch-col leaf-col) (with-state - (rotate (vector 0 180 0)) - (hint-depth-sort) - (for-each - (lambda (char) - (cond - ((char=? #\F char) - (with-state - (translate (vmul (crndvec) 0.01)) - (scale (vector 1.2 1 1)) - (rotate (vector 0 90 0)) - (colour branch-col) - - (with-primitive (build-ribbon 2) - ; (texture (load-texture "../textures/fade4.png")) - ; (hint-unlit) - (pdata-set! "w" 0 0.1) - (pdata-set! "w" 1 0.07) - (pdata-set! "p" 0 (vector 0 0 0.9)) - (pdata-set! "p" 1 (vector 0 0 0)))) - (translate (vector 1 0 0))) - ((char=? #\L char) - (for ((i (in-range 1 2))) + (rotate (vector 0 180 0)) + (hint-depth-sort) + (for-each + (lambda (char) + (cond + ((char=? #\F char) (with-state - (translate (vmul (srndvec) 0.3)) - (scale (* (rndf) 0.5)) - (colour leaf-col) - ; (texture (load-texture "../textures/leaf.png")) - (build-sphere 3 3))) - #;(translate (vector 1 0 0))) - ((char=? #\f char) - (translate (vector 1 0 0))) - ((char=? #\/ char) - (rotate (vector angle 0 0))) - ((char=? #\\ char) - (rotate (vector (- angle) 0 0))) - ((char=? #\+ char) - (rotate (vector 0 angle 0))) - ((char=? #\- char) - (rotate (vector 0 (- angle) 0))) - ((char=? #\^ char) - (rotate (vector 0 0 (- angle)))) - ((char=? #\& char) - (rotate (vector 0 0 angle))) - ((char=? #\| char) - (rotate (vector 0 0 180))) - ((char=? #\[ char) - (push) - (scale (vector branch-scale branch-scale branch-scale))) - ((char=? #\] char) - (pop)))) - (string->list string)))) + (translate (vmul (crndvec) 0.01)) + (scale (vector 1.2 1 1)) + (rotate (vector 0 90 0)) + (colour branch-col) + + (with-primitive (build-ribbon 2) + ; (texture (load-texture "../textures/fade4.png")) + ; (hint-unlit) + (pdata-set! "w" 0 0.1) + (pdata-set! "w" 1 0.07) + (pdata-set! "p" 0 (vector 0 0 0.9)) + (pdata-set! "p" 1 (vector 0 0 0)))) + (translate (vector 1 0 0))) + ((char=? #\L char) + (for ((i (in-range 1 2))) + (with-state + (translate (vmul (srndvec) 0.3)) + (scale (* (rndf) 0.5)) + (colour leaf-col) + ; (texture (load-texture "../textures/leaf.png")) + (build-sphere 3 3))) + #;(translate (vector 1 0 0))) + ((char=? #\f char) + (translate (vector 1 0 0))) + ((char=? #\/ char) + (rotate (vector angle 0 0))) + ((char=? #\\ char) + (rotate (vector (- angle) 0 0))) + ((char=? #\+ char) + (rotate (vector 0 angle 0))) + ((char=? #\- char) + (rotate (vector 0 (- angle) 0))) + ((char=? #\^ char) + (rotate (vector 0 0 (- angle)))) + ((char=? #\& char) + (rotate (vector 0 0 angle))) + ((char=? #\| char) + (rotate (vector 0 0 180))) + ((char=? #\[ char) + (push) + (scale (vector branch-scale branch-scale branch-scale))) + ((char=? #\] char) + (pop)))) + (string->list string)))) (define (make-plant p n) (let ((root (build-locator))) @@ -406,15 +406,14 @@ ; (hint-origin) (build-locator))) (lock-camera camera) -(set-camera-transform (mrotate (vector -90 0 0))) -;(camera-lag 0.5) +(camera-lag 0.5) (light-diffuse 0 (vector 0 0 0)) (define l (make-light 'point 'free)) (light-diffuse l (vector 1 1 1)) (light-position l (vector 10 50 20)) -(for ((i (in-range 1 100))) +(for ((i (in-range 1 30))) (with-state (rotate (vector 0 0 (random 360))) (translate (vector (+ 20 (random 5)) 0 0)) @@ -467,4 +466,62 @@ (set! tree (build-tree tree-size)) (particles-explode particles))))) -(every-frame (update)) +(define running #f) + +(define start-time (time)) + +(define intro-root (build-locator)) + +(define splash2 + (with-state + (texture (load-texture "textures/gw.png")) + (hint-unlit) +; (colour 0) + (scale (vmul (vector 3 2.25 1) 12.5)) + (translate (vector 0 0 0.9)) + ; (rotate (vector 90 0 0)) + (build-plane))) + +(define splash + (with-state + (texture (load-texture "textures/foam.png")) + (hint-unlit) +; (colour 0) + (scale (vmul (vector 3 2 1) 14)) + (translate (vector 0 0 1)) + ; (rotate (vector 90 0 0)) + (build-plane))) + + +(set-camera-transform (mtranslate (vector 0 0 -30))) + +(define splash-time 8) + +(define (animate) + (when (not running) + + (when (< (time) (+ start-time (/ splash-time 2))) + (with-primitive splash + (scale 1.001) + (colour (- 1 (/ (- (+ start-time (/ splash-time 2)) (time)) (/ splash-time 2)))))) + + (when (> (time) (+ start-time (/ splash-time 2))) + (with-primitive splash + (scale 1.001) + (opacity (- 1 (/ (- (time) (+ start-time (/ splash-time 2))) 2))))) + + (when (> (time) (+ start-time splash-time)) + (with-primitive splash (hide 1))) + + (when (or (not (zero? (length (keys-down)))) (not (zero? (length (keys-special-down))))) + (set-camera-transform (mrotate (vector -90 0 0))) + (set! running #t) + (set! next-time (flxtime)) + (with-primitive intro-root (hide 1)) + (with-primitive splash (hide 1)) + (with-primitive splash2 (hide 1)))) + + (when running (update))) + + +(every-frame (animate))