From e1c55a245798376b3dfceb4a566c4677f106e663 Mon Sep 17 00:00:00 2001 From: Dave Griffiths Date: Mon, 13 Jul 2009 16:01:20 +0100 Subject: [PATCH] first pass serialisation and network messaging --- plant-eyes/controller.ss | 2 +- plant-eyes/jabberer.ss | 7 ++++-- plant-eyes/list-utils.ss | 2 ++ plant-eyes/logic.ss | 3 ++- plant-eyes/message.ss | 11 ++++----- plant-eyes/ornament-view.ss | 41 ------------------------------- plant-eyes/pickup-view.ss | 49 ------------------------------------- plant-eyes/plant-eyes.scm | 31 +++++++++++++---------- plant-eyes/view.ss | 2 +- plant-eyes/xmpp.ss | 2 +- 10 files changed, 35 insertions(+), 115 deletions(-) delete mode 100644 plant-eyes/ornament-view.ss delete mode 100644 plant-eyes/pickup-view.ss diff --git a/plant-eyes/controller.ss b/plant-eyes/controller.ss index 143726e..6c82b3d 100644 --- a/plant-eyes/controller.ss +++ b/plant-eyes/controller.ss @@ -1,5 +1,5 @@ #lang scheme/base -(require scheme/class fluxus-016/drflux "logic.ss" "view.ss") +(require scheme/class fluxus-016/fluxus "logic.ss" "view.ss") (provide (all-defined-out)) ; reads input events and tells the logic side what to do diff --git a/plant-eyes/jabberer.ss b/plant-eyes/jabberer.ss index d17827a..64146f8 100644 --- a/plant-eyes/jabberer.ss +++ b/plant-eyes/jabberer.ss @@ -1,11 +1,12 @@ #lang scheme/base -(require scheme/class fluxus-016/drflux openssl (prefix-in xmpp: "xmpp.ss")) +(require scheme/class openssl (prefix-in xmpp: "xmpp.ss")) (provide (all-defined-out)) ; a class which wraps the xmpp in a thread and allows messages to be picked up ; and sent by the game (define debug-netloop #f) +(define debug-jab #f) (define jabberer% (class object% @@ -41,7 +42,9 @@ (set! incoming (cons (list (xmpp:message-from sz) (xmpp:message-body sz)) incoming))) (define/public (start) - (set! thr (thread run))) + (xmpp:add-to-roster jid "plant0000003@fo.am" "plant0000003" "plants@fo.am") + (xmpp:add-to-roster jid "plant0000001@fo.am" "plant0000001" "plants@fo.am") + (set! thr (thread run))) (define/public (stop) (kill-thread thr)) diff --git a/plant-eyes/list-utils.ss b/plant-eyes/list-utils.ss index 11f30f1..59bd821 100644 --- a/plant-eyes/list-utils.ss +++ b/plant-eyes/list-utils.ss @@ -1,6 +1,8 @@ #lang scheme/base (provide (all-defined-out)) +; just some stuff which is probably defined in standard schemish somewhere + (define (assoc-remove k l) (cond ((null? l) '()) diff --git a/plant-eyes/logic.ss b/plant-eyes/logic.ss index ace2883..c44b6e6 100644 --- a/plant-eyes/logic.ss +++ b/plant-eyes/logic.ss @@ -1,5 +1,5 @@ #lang scheme -(require scheme/class fluxus-016/drflux "message.ss" "list-utils.ss") +(require scheme/class fluxus-016/fluxus "message.ss" "list-utils.ss") (provide (all-defined-out)) (define branch-probability 6) ; as in one in branch-probability chance @@ -458,6 +458,7 @@ (set! plants (cons plant plants))) (define/public (add-plant plant) + (printf "new-plant added~n") (send-message 'new-plant (list (list 'plant-id (send plant get-id)) (list 'pos (send plant get-pos)) diff --git a/plant-eyes/message.ss b/plant-eyes/message.ss index abf7e6a..b1a9f25 100644 --- a/plant-eyes/message.ss +++ b/plant-eyes/message.ss @@ -4,8 +4,7 @@ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; a message for sending betwixt logic and view side -(define message% - (class object% +(define-serializable-class* message% object% () (init-field (name 'none) ; a symbol denoting the type of the message (data '())) ; should be an assoc list map of name to values, eg: @@ -13,12 +12,12 @@ ; shouldn't put logic objects in here - 'raw' data only (define/public (get-name) - name) - + name) + (define/public (get-data arg-name) (cadr (assoc arg-name data))) (define/public (print) (printf "msg: ~a ~a~n" name data)) - - (super-new))) + + (super-new)) diff --git a/plant-eyes/ornament-view.ss b/plant-eyes/ornament-view.ss deleted file mode 100644 index d419f59..0000000 --- a/plant-eyes/ornament-view.ss +++ /dev/null @@ -1,41 +0,0 @@ -#lang scheme -#lang scheme/base - -(require scheme/class fluxus-016/drflux "common.ss" "message.ss" "list-utils.ss") -(provide (all-defined-out)) - -(define ornament-view% - (class object% - (init-field - (pos (vector 0 0 0)) - (property 'none) - (time 0)) - - (field - (rot (vmul (rndvec) 360)) - (root (with-state - (translate pos) - (rotate rot) - (scale 0.01) - (cond - ((eq? property 'wiggle) -; (opacity 1) - (hint-depth-sort) - (colour (vector 0.5 0.0 0.0)) - (load-primitive "meshes/wiggle.obj")) - ((eq? property 'leaf) - (colour (vector 0.8 1 0.6)) - (texture (load-texture "textures/leaf2.png")) - (load-primitive "meshes/leaf.obj")) - (else (error "")))))) - - (define/public (update t d) - (when (< time 1) - (with-primitive root - (identity) - (translate pos) - (rotate rot) - (scale (* 0.2 time))) - (set! time (+ time (* 0.1 d))))) - - (super-new))) \ No newline at end of file diff --git a/plant-eyes/pickup-view.ss b/plant-eyes/pickup-view.ss deleted file mode 100644 index e5910f3..0000000 --- a/plant-eyes/pickup-view.ss +++ /dev/null @@ -1,49 +0,0 @@ -#lang scheme/base -(require scheme/class fluxus-016/drflux "common.ss" "message.ss" "list-utils.ss") -(provide (all-defined-out)) - -(define pickup-view% - (class object% - (init-field - (id -1) - (type 'none) - (pos (vector 0 0 0))) - - (field - (rot (vmul (rndvec) 360)) - (root (with-state - (translate pos) - (rotate rot) - (colour (pickup-colour)) - (scale 0.3) - (texture - (cond - ((eq? type 'wiggle) (load-texture "textures/wiggle.png")) - ((eq? type 'leaf) (load-texture "textures/leaf.png")) - ((eq? type 'curly) (load-texture "textures/curl.png")))) - (load-primitive "meshes/pickup.obj"))) - (from pos) - (destination (vector 0 0 0)) - (speed 0.05) - (t -1)) - - (define/public (pick-up) - (destroy root)) - - (define/public (move-to s) - (set! t 0) - (set! from pos) - (set! destination s)) - - (define/public (update t d) - (with-primitive root - (rotate (vector (* d 10) 0 0))) - #;(when (and (>= t 0) (< t 1)) - (set! pos (vadd pos (vmul (vsub destination from) speed))) - (with-primitive root - (identity) - (translate pos) - (rotate rot)) - (set! t (+ t speed)))) - - (super-new))) diff --git a/plant-eyes/plant-eyes.scm b/plant-eyes/plant-eyes.scm index 9838344..1d43d60 100644 --- a/plant-eyes/plant-eyes.scm +++ b/plant-eyes/plant-eyes.scm @@ -1,6 +1,6 @@ -#lang scheme/base -(require fluxus-016/drflux) -(require scheme/class "logic.ss" "view.ss" "controller.ss") +;#lang scheme/base +;(require fluxus-016/drflux) +(require scheme/class "logic.ss" "view.ss" "controller.ss" "client.ss") (require "jabberer.ss") ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -26,6 +26,9 @@ ; at any point, and have them automatically collected up and dispatched to ; the view ; +; * these messages are also converted to xmpp messages and sent out over the +; network +; ; * line segments are computed in the logic side, and can be represented any ; way by the view - maybe the players plant will be geometry and everyone ; elses will be ribbons (stoopid LOD) @@ -33,6 +36,9 @@ ; * in the same way, the line segments can be created in any way by the logic ; side - eg. lsystem, or different methods per plant (or per twig even) +(define jid "plant0000002@fo.am") +(define pass "plant0000002") + (define logic-tick 0.5) ; time between logic updates (clear) @@ -40,20 +46,17 @@ (define gl (make-object game-logic%)) (define gv (make-object game-view%)) (define c (make-object controller% gv)) +(define cl (make-object client% jid pass)) (send c setup) (send gv setup) (send gl setup) +(send cl setup) -(define plant1 (make-object plant-logic% "dave@fo.am" (vector 0 0 0))) -(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 0 0 90))) +(define plant1 (make-object plant-logic% jid (vector 0 0 0))) (send c set-player-plant plant1) - (send gl add-plant plant1) -(send gl add-plant plant2) - -(send plant2 add-twig (make-object twig-logic% (vector 0 0 0) 0 plant2 'root (vector 0 -1 0) start-twig-width 10 'ribbon)) (define tick-time 0) @@ -68,12 +71,14 @@ (when (< tick-time (pe-time)) (set! tick-time (+ (pe-time) logic-tick)) (send plant1 grow (vmul (send c get-fwd) -1)) - (send plant2 grow (vector 0 -1 0)) - (send gv update (pe-time) (pe-delta) (send gl update))) - + (let ((messages (send gl update))) + ; pass the messages to the network client + (send gv update (pe-time) (pe-delta) (send cl update messages gl)))) ; and the game view + (send gv update (pe-time) (pe-delta) '()) (send c update) - (pt-update)) + (pt-update) + (sleep 0.01)) #;(for ((i (in-range 0 10000))) (animate)) diff --git a/plant-eyes/view.ss b/plant-eyes/view.ss index 0992e57..c1cf534 100644 --- a/plant-eyes/view.ss +++ b/plant-eyes/view.ss @@ -1,5 +1,5 @@ #lang scheme/base -(require scheme/class fluxus-016/drflux "message.ss" "list-utils.ss") +(require scheme/class fluxus-016/fluxus "message.ss" "list-utils.ss") (provide (all-defined-out)) ; the fluxus code to make things look the way they do diff --git a/plant-eyes/xmpp.ss b/plant-eyes/xmpp.ss index df4cfe4..0cc7718 100644 --- a/plant-eyes/xmpp.ss +++ b/plant-eyes/xmpp.ss @@ -83,7 +83,7 @@ ;; ;;;; ; ; - (define debug? #t) + (define debug? #f) (define debugf (case-lambda