Permalink
Browse files

send world's name to universe properly, Closes PR 12857

  • Loading branch information...
mfelleisen committed Jun 23, 2012
1 parent 4306cc2 commit 48e07fb2aba05999fb441097cbbfc46a21138d9b
@@ -131,7 +131,7 @@
x))))
;; InPort OutPort (X -> Y) -> (U Y Void)
-;; process a registration from a potential client, invoke k if it is okay
+;; process a registration from a potential client, invoke k on name if it is okay
(define (tcp-process-registration in out k)
(define next (tcp-receive in))
(match next
@@ -140,9 +140,9 @@
(k name)]))
;; InPort OutPort (U #f String) -> Void
-;; register with the server
+;; register with the server, send the given name or make up a symbol
(define (tcp-register in out name)
- (define msg `(REGISTER ((name ,(if name name (symbol->string (gensym 'world)))))))
+ (define msg `(REGISTER ((name ,(if name name (gensym 'world))))))
(tcp-send out msg)
(define ackn (tcp-receive in))
(unless (equal? ackn '(OKAY))
@@ -251,9 +251,7 @@
;; IPort OPort Sexp -> IWorld
(define (create-iworld i o info)
- (if (string? info)
- (make-iworld i o info "info field not available")
- (make-iworld i o (symbol->string (gensym 'iworld)) "info field not available")))
+ (make-iworld i o info "info field not available"))
;; Player S-exp -> Void
(define (iworld-send p sexp)
@@ -1,9 +1,31 @@
#lang racket
+
+;; created in response to pr 12857
+;; make sure the name of a world is transmitted to the server
+
+(require rackunit)
(require 2htdp/universe)
(require 2htdp/image)
-(big-bang '*
- (name 'jimbob)
- (on-tick (λ (w) w) 1/3 2)
- (to-draw (λ (w) (empty-scene 200 200))))
+(define NAME 'ian-johnson)
+
+(define c (make-custodian))
+
+(define-values (_ n)
+ (parameterize ((current-custodian c))
+ (launch-many-worlds
+ ;; --- world:
+ (big-bang 10
+ (on-tick sub1)
+ (to-draw (lambda (w) (empty-scene 200 200)))
+ (name NAME)
+ (register LOCALHOST))
+ ;; --- universe:
+ (universe #f
+ (on-new (lambda (u w) (make-bundle (iworld-name w) '() '())))
+ (on-msg (lambda (u w m) (make-bundle u '() '())))
+ (on-tick (lambda (u) (make-bundle u '() '())) 1 1)))))
+
+(check-equal? n NAME)
+(custodian-shutdown-all c)
@@ -1,4 +1,4 @@
-#lang racket/load
+#lang racket
(module shared racket/base
(require 2htdp/universe 2htdp/image)
@@ -7,25 +7,26 @@
(provide s s-t (all-from-out 2htdp/universe 2htdp/image)))
(module client racket
- (require 'shared)
+ (require (submod ".." shared))
;; Color -> Boolean
(define (client c)
(define count 0)
(big-bang #true
(to-draw (lambda (w) (text (if w "hello world" "good bye") 22 c)))
(register LOCALHOST)
+ #;
(stop-when (lambda (w) (> count 3)))
(on-receive
(lambda (w msg)
(set! count (+ count 1))
;; send out a prefabed struct to the server
(make-package (not w) (s count))))))
- (launch-many-worlds (client 'blue) (client 'red)))
+ (provide client))
(module server racket
- (require 'shared)
+ (require (submod ".." shared))
(define (server)
(universe '()
@@ -41,8 +42,12 @@
(displayln (s-t msg))
(make-bundle state '() '())))))
- (thread server))
+
+ (provide server))
-(require 'server)
+(module run racket/base
+ (require (submod ".." client) (submod ".." server) (submod ".." shared))
+
+ (launch-many-worlds (client 'blue) (client 'red) (server)))
-(require 'client)
+(require (submod "." run))

0 comments on commit 48e07fb

Please sign in to comment.