From 9cc1c0e2043eda8229f933460dd075e1d1fec2ef Mon Sep 17 00:00:00 2001 From: Dave Griffiths Date: Tue, 21 Apr 2009 09:59:14 +0100 Subject: [PATCH] more jabber --- comm/xmpp.ss | 14 ++++---- hayfever/hayfever2.scm | 78 ++++++++++++++++++++++++++---------------- hayfever/xmpp-dave.ss | 2 +- 3 files changed, 57 insertions(+), 37 deletions(-) diff --git a/comm/xmpp.ss b/comm/xmpp.ss index 3dd3e46..cc453d3 100644 --- a/comm/xmpp.ss +++ b/comm/xmpp.ss @@ -217,7 +217,7 @@ (define (run-xmpp-handler type sz) (let ((fcn (dict-ref xmpp-handlers type #f))) (when fcn (begin - (display (format "attempting to run handler ~a.~%" fcn)) + ;(display (format "attempting to run handler ~a.~%" fcn)) (fcn sz))))) ;; no real parsing yet. dispatches any received xml stanzas as sxml @@ -297,7 +297,7 @@ (define xmpp-in-port (make-parameter (current-input-port))) (define xmpp-out-port (make-parameter (current-output-port))) - (define (xmpp-send str) + (define (send str) ; (printf "sending iO: ~a ~%~%" str) (fprintf (xmpp-out-port) "~A~%" str) (flush-output (xmpp-out-port))) @@ -312,13 +312,13 @@ (xmpp-out-port out)) (file-stream-buffer-mode out 'line) (xmpp-response-handler in) - (xmpp-send (xmpp-stream host)) - (xmpp-send (xmpp-session host)) + (send (xmpp-stream host)) + (send (xmpp-session host)) ;(starttls in out) - (xmpp-send (xmpp-auth user ,pass resource)) - (xmpp-send (presence)) - (xmpp-send (presence #:status "Available")) + (send (xmpp-auth user ,pass resource)) + (send (presence)) + (send (presence #:status "Available")) ,@body (close-output-port out) (close-input-port in))))) diff --git a/hayfever/hayfever2.scm b/hayfever/hayfever2.scm index 3ae12ac..e6474f4 100644 --- a/hayfever/hayfever2.scm +++ b/hayfever/hayfever2.scm @@ -5,6 +5,21 @@ (require openssl) (require "xmpp-dave.ss") +;(require (prefix-in xmpp: (planet zzkt/xmpp))) + +(define plant2 #f) +;(set! plant2 #t) + +(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")) + +(printf "I am ~a~n" jid) ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; pixel primitive things for getting connection points @@ -185,7 +200,7 @@ (set! pollen (with-state (translate (vector 0 0 0.2)) (texture (load-texture "textures/pollen.png")) - (build-particles 1000))) + (build-particles 100))) (with-primitive pollen (pdata-map! @@ -454,10 +469,10 @@ msg)) (define/public (send-msg to msg) - (printf "~a ~a~n" 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) @@ -467,22 +482,17 @@ (kill-thread thr)) (define (run) - (printf "running xmpp~n") - (with-xmpp-session "plant0000001@fo.am" "plant0000001" - (printf "xmpp sesh~n") + (with-xmpp-session jid pass (set-xmpp-handler 'message message-handler) - - (printf "xmpp sesh~n") - (let loop () (when (not (null? outgoing)) (for-each (lambda (msg) - (printf "---- ~a~n" (cadr msg)) + (printf "----> ~a ~a~n" (car msg) (cadr msg)) (xmpp-send (message (car msg) (cadr msg)))) outgoing) (set! outgoing '())) - (sleep 2) + (sleep 0.5) (loop)))) (super-new))) @@ -493,7 +503,7 @@ (waiting #f) (wait-till 0) (jab (make-object jabberer%)) - (send-to "dave@fo.am")) + (send-to jto)) (define (stringify l) (cond @@ -530,8 +540,15 @@ (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 + (for-each (lambda (msg) (let ((command (list-ref (cadr msg) 0)) (args (cdr (cadr msg)))) @@ -543,6 +560,7 @@ ((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)) @@ -550,7 +568,7 @@ (vector (string->number (list-ref args 4)) (string->number (list-ref args 5)) (string->number (list-ref args 6))) - (stringify (eval-string (list-ref args 7)))))) + (stringify (eval-string (join-end 7 args "")))))) ((string=? command "flower") ;(printf "flower change msg recieved~n") @@ -586,13 +604,13 @@ (col (send my-plant get-col)) (desc-str (format "'~a" (send my-plant get-desc)))) - (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)) + (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) @@ -601,18 +619,18 @@ (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))) + (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)))) + (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)) @@ -623,6 +641,7 @@ (send world make-my-plant) (update-plant world)) (dispatch world)) + (super-new))) @@ -695,6 +714,7 @@ (clear-colour (vmul (vector 0.4 0.5 0.9) 0.2)) (fog (vector 0.4 0.5 0.9) 0.01 1 100) +#;( (define l (make-light 'spot 'free)) (light-diffuse 0 (vector 0 0 0)) (light-diffuse l (vector 1 1 1)) @@ -794,7 +814,7 @@ (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))) - +) ;---------------------------------------- diff --git a/hayfever/xmpp-dave.ss b/hayfever/xmpp-dave.ss index 17adcaa..37e2090 100644 --- a/hayfever/xmpp-dave.ss +++ b/hayfever/xmpp-dave.ss @@ -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)