diff --git a/hayfever/hayfever2.scm b/hayfever/hayfever2.scm
index e6474f4..95a8f6e 100644
--- a/hayfever/hayfever2.scm
+++ b/hayfever/hayfever2.scm
@@ -1,26 +1,38 @@
+;#lang scheme
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+; h a y f e v e r
+;(require fluxus-016/drflux)
(require scheme/class)
(require mzlib/string)
(require openssl)
-
(require "xmpp-dave.ss")
;(require (prefix-in xmpp: (planet zzkt/xmpp)))
(define plant2 #f)
;(set! plant2 #t)
+(define debug-jab #t)
+(define pollen-particles 300)
+(define max-pollen-radius 12)
+(define deterministic #f)
+(define minimal-mode #f)
(define jid "plant0000003@fo.am")
(define pass "plant0000003")
(define jto "plant0000002@fo.am")
(when plant2
- (set! jid "plant0000002@fo.am")
- (set! pass "plant0000002")
- (set! jto "plant0000003@fo.am"))
+ (set! jid "plant0000002@fo.am")
+ (set! pass "plant0000002")
+ (set! jto "plant0000003@fo.am"))
(printf "I am ~a~n" jid)
+(when deterministic
+ (flxseed 1)
+ (random-seed 2))
+
+
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; pixel primitive things for getting connection points
@@ -109,7 +121,10 @@
(cond
((null? children)
(let ((root (with-state
- (translate (vector 0 0.5 (* 0.1 (rndf))))
+ (translate (vector 0 0.5 (* 0.01 (rndf))))
+ (hint-none)
+ (hint-solid)
+ (hint-unlit)
(hint-depth-sort)
(texture (load-texture (string-append "textures/comp-" id ".png")))
(build-plane))))
@@ -119,7 +134,7 @@
(root (with-state
(hint-depth-sort)
(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")))
(build-plane)))
(comp (make-component root col
@@ -158,13 +173,10 @@
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; utils for building random plants
-(define (choose l)
- (list-ref l (random (length l))))
-
(define (make-random-plant depth)
(let ((num-children (cond ((> depth 2) 0)
- ((< depth 1) (choose (list 2 3)))
- (else (choose (list 0 1 2 3))))))
+ ((< depth 1) (choose (list 2 3)))
+ (else (choose (list 0 1 2 3))))))
(cond
((eq? num-children 0) (list (choose (list "11")) (list)))
((eq? num-children 1) (list "1-1" (list (make-random-plant (+ depth 1)))))
@@ -193,19 +205,19 @@
(entity-list '())
(id 0)
(pollen 0)
- (my-id 0))
+ (my-id ""))
(define/public (init)
(set! pollen (with-state
(translate (vector 0 0 0.2))
(texture (load-texture "textures/pollen.png"))
- (build-particles 100)))
+ (build-particles pollen-particles)))
(with-primitive pollen
(pdata-map!
(lambda (p)
- (vmul (srndvec) 5))
+ (vmul (vector (crndf) (crndf) 0) 5))
"p")
(pdata-map!
(lambda (c)
@@ -224,16 +236,23 @@
my-id)
(define/public (make-my-plant)
+
+ (when deterministic
+ (flxseed 3)
+ (random-seed 10) ; 2 5
+ )
+
+
(let* ((pos (vector (* (crndf) 5) 0 0.1))
(col (hsv->rgb (vector (rndf) 0.8 1)))
(desc (list (make-random-plant 0))))
- (set! my-id (length entity-list))
+ (set! my-id jid)
(set-entity my-id (make-object plant% pos col desc))))
(define/public (get-entity id)
(foldl
(lambda (entity ret)
- (if (eq? (send entity get-id) id)
+ (if (string=? (send entity get-id) id)
entity
ret))
#f
@@ -252,11 +271,22 @@
(send entity set-id! id)
(set! entity-list (cons entity entity-list)))
+
+ (define/public (destroy-all-but-me)
+ (set! entity-list
+ (filter
+ (lambda (entity)
+ (cond ((not (string=? (send entity get-id) my-id))
+ (send entity destroy-me)
+ #f)
+ (else #t)))
+ entity-list)))
+
(define/public (destroy-entity id)
(set! entity-list
(filter
(lambda (entity)
- (cond ((eq? (send entity get-id) id)
+ (cond ((string=? (send entity get-id) id)
(send entity destroy-me)
#f)
(else #t)))
@@ -280,14 +310,14 @@
(define (animate-pollen)
(pdata-map!
(lambda (p)
- (let* ((pp (vadd (vmul p 1) (vector 0 (- (time)) 0)))
+ (let* ((pp (vadd (vmul p 1) (vector 0 (- (flxtime)) 0)))
(v (cond
- ((< (vy p) 0) (vmul (vector (crndf) 1 (crndf)) 0.1))
- ((> (vmag p) 8) (vmul p -0.1))
- (else
- (vector (- (noise (vx pp) (vy pp) (vz pp)) 0.5)
- (- (noise (vx pp) (+ (vy pp) 112.3) (vz pp)) 0.5)
- (- (noise (+ (vx pp) 393.2) (vy pp) (vz pp)) 0.5))))))
+ ((< (vy p) 0) (vmul (vector (crndf) 1 (crndf)) 0.1))
+ ((> (vmag p) max-pollen-radius) (vmul p -0.1))
+ (else
+ (vector (- (noise (vx pp) (vy pp) (vz pp)) 0.5)
+ (- (noise (vx pp) (+ (vy pp) 112.3) (vz pp)) 0.5)
+ 0 #;(- (noise (+ (vx pp) 393.2) (vy pp) (vz pp)) 0.5))))))
(vadd (vadd p (vmul v 0.2))
(vmul (srndvec) 0.01))))
"p"))
@@ -302,7 +332,8 @@
(let ((c (random (pdata-size)))
(cc (vmul col 1)))
(pdata-set! "p" c (vadd (vmul (cirndvec) size)
- (vadd pos (vector 0 0 (+ 0.2 (* (rndf) 0.01))))))
+ (vadd (vector (vx pos) (vy pos) 0)
+ (vector 0 0 (+ 0.2 (* (rndf) 0.01))))))
(pdata-set! "c" c (vector (vx cc) (vy cc) (vz cc) 0.5))))))
(define/public (suck-pollen pos size)
@@ -369,7 +400,7 @@
(colour col)
(hint-unlit)
(translate pos)
- (printf "building from:~a~n" plant-desc)
+ ;(printf "building from:~a~n" plant-desc)
(set! root-component (build-component "1-1" col plant-desc))
(set! flower-list (component-leaves root-component))))
@@ -378,28 +409,28 @@
(define/public (player-update world network)
- (when (key-special-pressed 100)
+ (when (key-special-pressed-this-frame 100)
(set! current-flower (modulo (+ current-flower 1) (length flower-list))))
- (when (key-special-pressed 102)
+ (when (key-special-pressed-this-frame 102)
(set! current-flower (modulo (- current-flower 1) (length flower-list))))
; bit odd, have to go through network to tell other clients to
; spray, and need to get the id of the player plant from the world...
- (when (key-special-pressed 101)
+ (when (key-special-pressed-this-frame 101)
(send network spray world (send world get-my-id) current-flower 0))
(let ((flower (list-ref flower-list current-flower)))
(with-primitive (component-root flower)
- (when (key-special-pressed 103)
+ (when (key-special-pressed-this-frame 103)
(rotate (vector 0 0 20))
(let ((colours (suck world current-flower)))
(when (not (zero? (length colours)))
(let
((av-col (vdiv (foldl (lambda (c1 c2)
- (vadd c1 c2)) (vector 0 0 0) colours) (length colours))))
+ (vadd c1 c2)) (vector 0 0 0) colours) (length colours))))
(set-component-col! flower
(vadd (vmul (component-col flower) 0.9)
@@ -416,7 +447,7 @@
(set-component-col! flower col)
(with-primitive (component-root flower)
(colour (component-col flower)))))
-
+
(define/public (update world)
0
#;(with-primitive root
@@ -430,7 +461,7 @@
(with-primitive (component-root (list-ref flower-list flower))
(get-global-transform)))))
(send world puff-pollen pos (component-col (list-ref flower-list flower))
- 0.2 1)))
+ 0.2 10)))
(define/public (suck world flower)
(let ((pos (vtransform (vector 0 0 0)
@@ -448,201 +479,212 @@
; * renamed send to xmpp-send
(define jabberer%
- (class object%
- (field
- (incoming '())
- (outgoing '())
- (thr 0))
-
- (define/public (get-incoming)
- incoming)
-
- (define/public (clear-incoming)
- (set! incoming '()))
-
- (define/public (msg-waiting?)
- (not (null? incoming)))
-
- (define/public (get-msg)
- (let ((msg (car incoming)))
- (set! incoming (cdr incoming))
- msg))
-
- (define/public (send-msg to msg)
- (set! outgoing (cons (list to msg) outgoing)))
-
- (define (message-handler sz)
- (printf "<---- ~a ~a~n" (message-from sz) (message-body sz))
- (set! incoming (cons (list (message-from sz) (message-body sz)) incoming)))
-
- (define/public (start)
- (set! thr (thread run)))
-
- (define/public (stop)
- (kill-thread thr))
-
- (define (run)
- (with-xmpp-session jid pass
- (set-xmpp-handler 'message message-handler)
- (let loop ()
- (when (not (null? outgoing))
- (for-each
- (lambda (msg)
- (printf "----> ~a ~a~n" (car msg) (cadr msg))
+ (class object%
+ (field
+ (incoming '())
+ (outgoing '())
+ (thr 0))
+
+ (define/public (get-incoming)
+ incoming)
+
+ (define/public (clear-incoming)
+ (set! incoming '()))
+
+ (define/public (msg-waiting?)
+ (not (null? incoming)))
+
+ (define/public (get-msg)
+ (let ((msg (car incoming)))
+ (set! incoming (cdr incoming))
+ msg))
+
+ (define/public (send-msg to msg)
+ (set! outgoing (cons (list to msg) outgoing)))
+
+ (define (message-handler sz)
+ (when debug-jab (printf "rx <---- ~a ~a~n" (message-from sz) (message-body sz)))
+ (set! incoming (cons (list (message-from sz) (message-body sz)) incoming)))
+
+ (define/public (start)
+ (set! thr (thread run)))
+
+ (define/public (stop)
+ (kill-thread thr))
+
+ (define (run)
+ (with-xmpp-session jid pass
+ (set-xmpp-handler 'message message-handler)
+ (let loop ()
+ (when (not (null? outgoing))
+ (for-each
+ (lambda (msg)
+ (when debug-jab (printf "tx ----> ~a ~a~n" (car msg) (cadr msg)))
(xmpp-send (message (car msg) (cadr msg))))
- outgoing)
- (set! outgoing '()))
- (sleep 0.5)
- (loop))))
- (super-new)))
+ outgoing)
+ (set! outgoing '()))
+ (sleep 0.5)
+ (loop))))
+ (super-new)))
(define network-dispatch%
- (class object%
-
- (field
- (waiting #f)
- (wait-till 0)
- (jab (make-object jabberer%))
- (send-to jto))
-
- (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))))
- ((vector? (car l))
- (cons (car l)
- (stringify (cdr l))))
- ((list? (car l))
- (cons (stringify (car l)) (stringify (cdr l))))
- (else (error "oops"))))
-
- (define (split-string str)
- (let* ((l (string->list str))
- (cur "")
- (r (reverse (foldl
- (lambda (c l)
- (cond
- ((char=? #\ c)
- (let ((r (cons cur l)))
- (set! cur "")
- r))
- (else
- (set! cur (string-append cur (string c)))
- l)))
- '()
- l))))
- (if (not (string=? cur ""))
- (append r (list cur))
- r)))
-
- (define (join-end n l s)
- (cond
- ((null? l) s)
- ((not (zero? n)) (join-end (- n 1) (cdr l) s))
- (else
- (join-end n (cdr l) (string-append s " " (car l))))))
-
- (define (dispatch world)
- (for-each
- (lambda (msg)
- (let ((command (list-ref (cadr msg) 0))
- (args (cdr (cadr msg))))
- (cond
- ((string=? command "join-game")
- (printf "a new plant has joined the game~n")
- ; send a plant update for the new player
- (update-plant world) )
-
- ((string=? command "plant")
- (printf "add plant message recieved : ~a~n" (list-ref args 0))
- (printf "~a~n" (join-end 7 args ""))
- (send world set-entity (string->number (list-ref args 0)) (make-object plant%
- (vector (string->number (list-ref args 1))
- (string->number (list-ref args 2))
- (string->number (list-ref args 3)))
- (vector (string->number (list-ref args 4))
- (string->number (list-ref args 5))
- (string->number (list-ref args 6)))
- (stringify (eval-string (join-end 7 args ""))))))
-
- ((string=? command "flower")
- ;(printf "flower change msg recieved~n")
- (send (send world get-entity (string->number (list-ref args 0))) flower-update
- (list-ref args 1) (vector (string->number (list-ref args 2))
- (string->number (list-ref args 3))
- (string->number (list-ref args 4)))))
-
- ((string=? command "destroy-plant")
- (printf "destroy plant message recieved...~n")
- (send world destroy-entity (string->number (list-ref args 0))))
-
- ((string=? command "spray")
- ; (printf "destroy plant message recieved...~n")
- (let ((e (send world get-entity (string->number (list-ref args 0)))))
- ; it's possible to get spray events before the
- ; plant has been created...
- (when e
- (send e spray world (string->number (list-ref args 1))
- (string->number (list-ref args 2)))))))))
- (send jab get-incoming))
- (send jab clear-incoming))
-
- (define/public (join-game world)
- (send jab start)
- (send jab send-msg send-to "join-game")
- (set! wait-till (+ (time) 2))
- (set! waiting #t))
-
- (define/public (update-plant world)
- (let* ((my-plant (send world get-entity (send world get-my-id)))
- (pos (send my-plant get-pos))
- (col (send my-plant get-col))
- (desc-str (format "'~a" (send my-plant get-desc))))
+ (class object%
- (send jab send-msg send-to (string-append "plant " (number->string (send world get-my-id)) " "
- (number->string (vx pos)) " "
- (number->string (vy pos)) " "
- (number->string (vz pos)) " "
- (number->string (vx col)) " "
- (number->string (vy col)) " "
- (number->string (vz col)) " "
- desc-str))))
-
- (define/public (destroy-plant world id)
- (send jab send-msg send-to (string-append "destroy-plant " (number->string id)))
- (send world destroy-entity id))
-
- (define/public (spray world id flower type)
- (send jab send-msg send-to (string-append "spray "
- (number->string id) " "
- (number->string flower) " "
- (number->string type))) " "
- (send (send world get-entity id) spray world flower type))
-
- (define/public (flower-update world id flower col)
- (send jab send-msg send-to (string-append "flower "
- (number->string id) " "
- (number->string flower) " "
- (number->string (vx col)) " "
- (number->string (vy col)) " "
- (number->string (vz col))))
- (send (send world get-entity id) flower-update flower col))
-
-
- (define/public (update world)
- ; wait for all other players to register their plants
- (when (and waiting (< wait-till (time)))
- (set! waiting #f)
- (send world make-my-plant)
- (update-plant world))
- (dispatch world))
-
- (super-new)))
+ (field
+ (waiting #f)
+ (wait-till 0)
+ (jab (make-object jabberer%))
+ (send-to jto))
+
+ (define/public (start)
+ (send jab start))
+
+
+ (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))))
+ ((vector? (car l))
+ (cons (car l)
+ (stringify (cdr l))))
+ ((list? (car l))
+ (cons (stringify (car l)) (stringify (cdr l))))
+ (else (error "oops"))))
+
+ (define (split-string str)
+ (let* ((l (string->list str))
+ (cur "")
+ (r (reverse (foldl
+ (lambda (c l)
+ (cond
+ ((char=? #\ c)
+ (let ((r (cons cur l)))
+ (set! cur "")
+ r))
+ (else
+ (set! cur (string-append cur (string c)))
+ l)))
+ '()
+ l))))
+ (if (not (string=? cur ""))
+ (append r (list cur))
+ r)))
+
+ (define (join-end n l s)
+ (cond
+ ((null? l) s)
+ ((not (zero? n)) (join-end (- n 1) (cdr l) s))
+ (else
+ (join-end n (cdr l) (string-append s " " (car l))))))
+
+ (define (dispatch world)
+ (for-each
+ (lambda (msg)
+ (let* ((chopped (split-string (cadr msg)))
+ (command (list-ref chopped 0))
+ (args (cdr chopped)))
+ (cond
+ ((string=? command "ping")
+ (printf "pong~n"))
+
+ ((string=? command "join-game")
+ (send world destroy-all-but-me)
+ (printf "a new plant has joined the game~n")
+ ; send a plant update for the new player
+ (update-plant world) )
+
+ ((string=? command "plant")
+ (printf "add plant message recieved : ~a~n" (list-ref args 0))
+ (send world set-entity (list-ref args 0) (make-object plant%
+ (vector (string->number (list-ref args 1))
+ (string->number (list-ref args 2))
+ (string->number (list-ref args 3)))
+ (vector (string->number (list-ref args 4))
+ (string->number (list-ref args 5))
+ (string->number (list-ref args 6)))
+ (stringify (eval-string (join-end 7 args ""))))))
+
+ ((string=? command "flower")
+ ;(printf "flower change msg recieved~n")
+ (send (send world get-entity (list-ref args 0)) flower-update
+ (string->number (list-ref args 1)) (vector (string->number (list-ref args 2))
+ (string->number (list-ref args 3))
+ (string->number (list-ref args 4)))))
+
+ ((string=? command "destroy-plant")
+ (printf "destroy plant message recieved...~n")
+ (send world destroy-entity (list-ref args 0)))
+
+ ((string=? command "spray")
+ ; (printf "destroy plant message recieved...~n")
+ (let ((e (send world get-entity (list-ref args 0))))
+ ; it's possible to get spray events before the
+ ; plant has been created...
+ (when e
+ (send e spray world (string->number (list-ref args 1))
+ (string->number (list-ref args 2))))))
+ (else
+ (printf "unknown command ~a ~n" command)))))
+ (send jab get-incoming))
+ (send jab clear-incoming))
+
+ (define/public (join-game world)
+ (printf "ping~n")
+ (send jab send-msg send-to "ping")
+ (send jab send-msg send-to "join-game ")
+ (set! wait-till (+ (flxtime) 5))
+ (set! waiting #t))
+
+ (define/public (update-plant world)
+ (let* ((my-plant (send world get-entity (send world get-my-id)))
+ (pos (send my-plant get-pos))
+ (col (send my-plant get-col))
+ (desc-str (format "'~a" (send my-plant get-desc))))
+
+ (send jab send-msg send-to (string-append "plant " (send world get-my-id) " "
+ (number->string (vx pos)) " "
+ (number->string (vy pos)) " "
+ (number->string (vz pos)) " "
+ (number->string (vx col)) " "
+ (number->string (vy col)) " "
+ (number->string (vz col)) " "
+ desc-str))))
+
+ (define/public (destroy-plant world id)
+ (send jab send-msg send-to (string-append "destroy-plant " id))
+ (send world destroy-entity id))
+
+ (define/public (spray world id flower type)
+ (send jab send-msg send-to (string-append "spray "
+ id " "
+ (number->string flower) " "
+ (number->string type))) " "
+ (send (send world get-entity id) spray world flower type))
+
+ (define/public (flower-update world id flower col)
+ (send jab send-msg send-to (string-append "flower "
+ id " "
+ (number->string flower) " "
+ (number->string (vx col)) " "
+ (number->string (vy col)) " "
+ (number->string (vz col))))
+ (send (send world get-entity id) flower-update flower col))
+
+
+ (define/public (update world)
+ ; wait for all other players to register their plants
+ (when (and waiting (< wait-till (flxtime)))
+ (set! waiting #f)
+ (send world make-my-plant)
+ (update-plant world))
+ (dispatch world))
+
+ (super-new)))
@@ -685,144 +727,168 @@
(with-state
(backfacecull 0)
(hint-depth-sort)
-; (hint-unlit)
+ ; (hint-unlit)
(translate p)
(rotate (vector 0 (random 360) 0))
(scale (+ 1 (* (rndf) 1.5)))
(texture (load-texture (choose (list
- "textures/bgplant-1.png"
- "textures/bgplant-2.png"
- "textures/bgplant-3.png"
- "textures/bgplant-4.png"
- "textures/bgplant-5.png"
- "textures/bgplant-6.png"
- ))))
+ "textures/bgplant-1.png"
+ "textures/bgplant-2.png"
+ ;"textures/bgplant-3.png"
+ "textures/bgplant-4.png"
+ "textures/bgplant-5.png"
+ "textures/bgplant-6.png"
+ ))))
(let ((o (build-copy obj)))
(with-primitive o (hide 0)))
-; (load-primitive "meshes/freeplant.obj")
-))
+ ; (load-primitive "meshes/freeplant.obj")
+ ))
(define (load-model tex obj)
(with-state
(texture (load-texture (string-append "textures/" tex)))
(load-primitive (string-append "meshes/" obj))))
+
+(define (build-set)
+ (with-state
+ (let ((l (make-light 'spot 'free)))
+ (light-diffuse 0 (vector 0 0 0))
+ (light-diffuse l (vector 1 1 1))
+ (light-position l (vector 0 10 0))
+ (light-direction l (vector 0 -1 0))
+ (light-spot-angle l 55)
+ (light-spot-exponent l 1))
+ (let ((l2 (make-light 'point 'free)))
+ (light-position l2 (vector 0 20 0))
+ (light-diffuse l2 (vector 0.4 0.9 0.5)))
+
+ (with-state
+ (backfacecull 0)
+ (hint-depth-sort)
+ (hint-unlit)
+ (texture-params 0 '(wrap-s repeat wrap-t repeat))
+ (load-model "bgplant-1.png" "plant-0.obj")
+ (load-model "bgplant-1.png" "plant-1.obj")
+ (load-model "bgplant-1.png" "plant-2.obj")
+ (load-model "bgplant-1.png" "plant-3.obj")
+ (load-model "bgplant-1.png" "plant-4.obj")
+ (load-model "bgplant-1.png" "plant-5.obj")
+ (load-model "bgplant-1.png" "plant-6.obj")
+ ; (load-model "bgplant-2.png" "plant-7.obj")
+
+ )
+
+ (with-state
+ (backfacecull 0)
+ (load-model "car-base.png" "car.obj")
+ (load-model "car-base.png" "car-2.obj")
+ (load-model "telly-base.png" "telly-2.obj"))
+
+ (with-state
+ (load-model "telly-base2.png" "telly-0.obj")
+ (load-model "telly-base.png" "telly-1.obj")
+ (load-model "telly-base.png" "telly-2.obj")
+ (load-model "telly-base.png" "telly-3.obj")
+ (load-model "telly-base.png" "telly-4.obj"))
+
+
+ (with-state
+ (load-model "washer-base.png" "washer-0.obj")
+ (load-model "washer-base.png" "washer-1.obj")
+ (load-model "washer-base.png" "washer-2.obj")
+ (load-model "washer-base.png" "washer-3.obj"))
+
+ (let ((terrain (with-state
+ (texture (load-texture "textures/ground-base.png"))
+ (load-primitive "meshes/ground.obj")))
+ (flower-obj (load-primitive "meshes/freeplant.obj")))
+
+ ;(define grassmap (load-primitive "textures/set-grass.png"))
+
+ #;(define (tx->pi tx)
+ (+ (vy tx) (* (vx tx) (pixels-width))))
+
+
+ (with-primitive flower-obj
+ (pdata-map!
+ (lambda (n p)
+ (vnormalise p))
+ "n" "p")
+ (hide 1))
+
+
+ (with-state
+ (backfacecull 0)
+ (hint-depth-sort)
+ (hint-unlit)
+ (translate (vector -15 2 10))
+ (scale 15)
+ (texture (load-texture "textures/bgplant-1.png"))
+ (let ((o (build-copy flower-obj)))
+ (with-primitive o (hide 0))))
+
+
+ (with-primitive terrain
+ (poly-for-each-tri-sample
+ (lambda (indices bary)
+ (let ((tc (vadd
+ (vmul (pdata-ref "t" (list-ref indices 0)) (vx bary))
+ (vmul (pdata-ref "t" (list-ref indices 1)) (vy bary))
+ (vmul (pdata-ref "t" (list-ref indices 2)) (vz bary)))))
+ (when (zero? (random 2)) #;(> (va (with-primitive grassmap (pdata-ref "c" (tx->pi tc)))) 0.5)
+ (let ((pos (vadd
+ (vmul (pdata-ref "p" (list-ref indices 0)) (vx bary))
+ (vmul (pdata-ref "p" (list-ref indices 1)) (vy bary))
+ (vmul (pdata-ref "p" (list-ref indices 2)) (vz bary)))))
+ (when (> (vmag pos) 3)
+ (build-flower pos (vector 0 1 0) flower-obj))))))
+ 1))
+
+ (let ((shell0 (build-copy terrain)))
+
+ (with-primitive shell0
+ (pdata-copy "t" "t1")
+ (pdata-map!
+ (lambda (t)
+ (vmul t 4))
+ "t"))
+
+ (with-state
+ (multitexture 0 (load-texture "textures/shell.png"))
+ ; (multitexture 1 (load-texture "textures/ground-grassmap.png"))
+ (build-shells shell0 4 0.05 (vector 1 0.5 1)))))))
+
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(clear)
-(clear-colour (vmul (vector 0.4 0.5 0.9) 0.2))
-(fog (vector 0.4 0.5 0.9) 0.01 1 100)
+(clear-colour (vmul (vector 0.4 0.9 0.5) 0.2))
+(fog (vector 0.4 0.9 0.5) 0.01 1 100)
-#;(
-(define l (make-light 'spot 'free))
-(light-diffuse 0 (vector 0 0 0))
-(light-diffuse l (vector 1 1 1))
-(light-position l (vector 0 5 0))
-(light-direction l (vector 0 -1 0))
-(light-spot-angle l 55)
-(light-spot-exponent l 1)
+(define set-root (with-state
+ (scale 2)
+ (rotate (vector 0 -100 0))
+ (build-locator)))
-(define l2 (make-light 'point 'free))
-(light-position l2 (vector 0 10 0))
-(light-diffuse l2 (vector 0.4 0.5 0.9))
-
-(clear-texture-cache)
-(clear-geometry-cache)
-
-(with-state
- (backfacecull 0)
- (hint-depth-sort)
- (hint-unlit)
- (texture-params 0 '(wrap-s repeat wrap-t repeat))
- (load-model "bgplant-1.png" "plant-0.obj")
- (load-model "bgplant-1.png" "plant-1.obj")
- (load-model "bgplant-1.png" "plant-2.obj")
- (load-model "bgplant-1.png" "plant-3.obj")
- (load-model "bgplant-1.png" "plant-4.obj")
- (load-model "bgplant-1.png" "plant-5.obj")
- (load-model "bgplant-1.png" "plant-6.obj")
-; (load-model "bgplant-2.png" "plant-7.obj")
-
-)
-
-
-(with-state
- (backfacecull 0)
- (load-model "car-base.png" "car.obj")
- (load-model "car-base.png" "car-2.obj")
- (load-model "telly-base.png" "telly-2.obj"))
-
-(with-state
- (load-model "telly-base.png" "telly-0.obj")
- (load-model "telly-base2.png" "telly-1.obj")
- (load-model "telly-base.png" "telly-2.obj")
- (load-model "telly-base.png" "telly-3.obj")
- (load-model "telly-base.png" "telly-4.obj"))
-
-
-(with-state
- (load-model "washer-base.png" "washer-0.obj")
- (load-model "washer-base.png" "washer-1.obj")
- (load-model "washer-base.png" "washer-2.obj")
- (load-model "washer-base.png" "washer-3.obj"))
-
-(define terrain (with-state
- (texture (load-texture "textures/ground-base.png"))
- (load-primitive "meshes/ground.obj")))
-
-
-;(define grassmap (load-primitive "textures/set-grass.png"))
-
-(define (tx->pi tx)
- (+ (vy tx) (* (vx tx) (pixels-width))))
-
-(define flower-obj (load-primitive "meshes/freeplant.obj"))
-
-(with-primitive flower-obj
- (pdata-map!
- (lambda (n p)
- (vnormalise p))
- "n" "p")
- (hide 1))
-
-(with-primitive terrain
- (poly-for-each-tri-sample
- (lambda (indices bary)
- (let ((tc (vadd
- (vmul (pdata-ref "t" (list-ref indices 0)) (vx bary))
- (vmul (pdata-ref "t" (list-ref indices 1)) (vy bary))
- (vmul (pdata-ref "t" (list-ref indices 2)) (vz bary)))))
- (when (zero? (random 2)) #;(> (va (with-primitive grassmap (pdata-ref "c" (tx->pi tc)))) 0.5)
- (build-flower (vadd
- (vmul (pdata-ref "p" (list-ref indices 0)) (vx bary))
- (vmul (pdata-ref "p" (list-ref indices 1)) (vy bary))
- (vmul (pdata-ref "p" (list-ref indices 2)) (vz bary))) (vector 0 1 0)
- flower-obj))))
- 1))
-
-(define shell0 (build-copy terrain))
-
-(with-primitive shell0
- (pdata-copy "t" "t1")
- (pdata-map!
- (lambda (t)
- (vmul t 4))
- "t"))
-
-(with-state
- (multitexture 0 (load-texture "textures/shell.png"))
- ; (multitexture 1 (load-texture "textures/ground-grassmap.png"))
- (build-shells shell0 4 0.05 (vector 1 0.5 1)))
-)
-
-;----------------------------------------
+(when (not minimal-mode)
+ (with-state
+ (parent set-root)
+ (build-set)))
(hint-depth-sort)
+(define camera (build-locator))
+(with-primitive camera
+ (translate (vector 0 5 0)))
+
+(lock-camera camera)
+
(define w (make-object world% 1))
(define n (make-object network-dispatch%))
+(send n start)
+
(send n join-game w)
(define (animate)
diff --git a/hayfever/xmpp-dave.ss b/hayfever/xmpp-dave.ss
index 37e2090..1187eff 100644
--- a/hayfever/xmpp-dave.ss
+++ b/hayfever/xmpp-dave.ss
@@ -258,14 +258,14 @@
((string-ci=? test "~%~%" str))
+ ;(display (format "~%recieved: ~a ~%parsed as ~%~%" str))
""))))
;; response handler
(define (xmpp-response-handler in)
(thread (lambda ()
- (let loop ()
+ (let loop ()
(parse-xmpp-response (read-async in))
(sleep 0.1) ;; slight delay to avoid a tight loop
(loop)))))
@@ -298,7 +298,7 @@
(define xmpp-out-port (make-parameter (current-output-port)))
(define (xmpp-send str)
- (printf "sending iO: ~a ~%~%" str)
+ ;(printf "sending iO: ~a ~%~%" str)
(fprintf (xmpp-out-port) "~A~%" str) (flush-output (xmpp-out-port)))
(defmacro with-xmpp-session (jid pass . body)