From 5b8c2977f958f1b8c7906cf9388e2db742ea0105 Mon Sep 17 00:00:00 2001
From: Matthias Felleisen <matthias@racket-lang.org>
Date: Sat, 21 Feb 2009 16:45:13 +0000
Subject: [PATCH] added separate naming facilty

svn: r13770
---
 collects/2htdp/private/world.ss | 35 +++++++++++++--------------------
 collects/2htdp/universe.ss      |  6 +++++-
 2 files changed, 19 insertions(+), 22 deletions(-)

diff --git a/collects/2htdp/private/world.ss b/collects/2htdp/private/world.ss
index 4e29a5882d..b94a99ef97 100644
--- a/collects/2htdp/private/world.ss
+++ b/collects/2htdp/private/world.ss
@@ -49,8 +49,10 @@
     (class* object% (start-stop<%>)
       (inspect #f)
       (init-field
-       world0 ;; World
-       (tick K))      ;; (U (World -> World) (list (World -> World) Nat))
+       world0            ;; World
+       (name #f)         ;; (U #f Symbol)
+       (register #f)     ;; (U #f IP)
+       (tick K))         ;; (U (World -> World) (list (World -> World) Nat))
       
       (init
        (on-key K)        ;; World KeyEvent -> World 
@@ -59,8 +61,7 @@
        (on-draw #f)      ;; (U #f (World -> Scene) (list (World -> Scene) Nat Nat))
        (stop-when False) ;; World -> Boolean 
        (record? #f)      ;; Boolean 
-       (register #f))    ;; (U #f String (list String Symbol))
-      
+       )
       ;; -----------------------------------------------------------------------
       (field (world  world0))
       
@@ -79,39 +80,31 @@
       
       ;; -----------------------------------------------------------------------
       (field [*out* #f] ;; (U #f OutputPort), where to send messages to 
-             [*rec* (make-custodian)] ;; Custodian, monitor traffic
-             [host  (cond
-                      [(string? register) register]
-                      [(pair? register) (car register)]
-                      [else register])]
-             [name  (cond
-                      [(string? register) (gensym 'world)]
-                      [(pair? register) (second register)]
-                      [else register])])
+             [*rec* (make-custodian)]) ;; Custodian, monitor traffic)
       
       (define/private (register-with-host)
         (define FMTtry "unable to register with ~a after ~s tries")
         (define FMTcom "unable to register with ~a due to protocol problems")
         ;; try to register with the server n times 
-        (define (register n)
-          (printf "trying to register with ~a ...\n" host)
+        (define (do-register n)
+          (printf "trying to register with ~a ...\n" register)
           (with-handlers ((tcp-eof? 
                            (lambda (x) 
-                             (error 'register FMTcom host)))
+                             (error 'register FMTcom register)))
                           (exn:fail:network? 
                            (lambda (x)
                              (if (= n 1) 
-                                 (error 'register FMTtry host TRIES)
+                                 (error 'register FMTtry register TRIES)
                                  (begin (sleep PAUSE)
-                                        (register (- n 1)))))))
-            (define-values (in out) (tcp-connect host SQPORT))
+                                        (do-register (- n 1)))))))
+            (define-values (in out) (tcp-connect register SQPORT))
             (tcp-send out `(REGISTER ,(if name name (gensym 'world))))
             (if (eq? (tcp-receive in) 'okay) 
                 (values in out)
                 (raise tcp-eof))))
         ;; --- now register, obtain connection, and spawn a thread for receiving
         (parameterize ([current-custodian *rec*])
-          (define-values (in out) (register TRIES))
+          (define-values (in out) (do-register TRIES))
           (define dis (text "the universe disappeared" 11 'red))
           (define (RECEIVE)
             (sync 
@@ -271,7 +264,7 @@
       
       (define/public (start!)
         (when draw (show-canvas))
-        (when host (register-with-host)))
+        (when register (register-with-host)))
       
       (define/public (stop! w)
         (set! live #f)
diff --git a/collects/2htdp/universe.ss b/collects/2htdp/universe.ss
index d26ef51db2..d4d4d80981 100644
--- a/collects/2htdp/universe.ss
+++ b/collects/2htdp/universe.ss
@@ -117,8 +117,12 @@
               (lambda (p)
                 (syntax-case p ()
                   [(host) #`(ip> #,tag host)]
-                  [(ip name) #`(list (ip> #,tag ip) (symbol> #,tag name))]
                   [_ (err tag p)])))]
+  [name (lambda (tag)
+          (lambda (p)
+            (syntax-case p ()
+              [(n) #`(symbol> #,tag n)]
+              [_ (err tag p)])))]
   [record? (lambda (tag)
              (lambda (p)
                (syntax-case p ()