first pass serialisation and network messaging

This commit is contained in:
Dave Griffiths 2009-07-13 16:01:20 +01:00
parent cb7915058c
commit e1c55a2457
10 changed files with 35 additions and 115 deletions

View file

@ -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

View file

@ -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))

View file

@ -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) '())

View file

@ -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))

View file

@ -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))

View file

@ -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)))

View file

@ -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)))

View file

@ -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))

View file

@ -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

View file

@ -83,7 +83,7 @@
;;
;;;; ; ;
(define debug? #t)
(define debug? #f)
(define debugf
(case-lambda