Universe and world take an optional 'port' argument.

Allows universe and world programs to specify which port they want to
communicate on.  If omitted, universe and world use the default port
number.  This enables multiple universe instances to run on the same
machine.  For example:

(require 2htdp/universe 2htdp/image)

;; Run two client-server pairs
(define (run)
  (launch-many-worlds (server 8080)
                      (client 8080)
                      (server 8081)
                      (client 8081)))

;; Port -> #f
(define (server p)
  (define noop (make-bundle #f '() '()))
  (universe #f
            (port p)
            (on-new (λ (_u _iw) noop))
            (on-msg (λ (_u _iw _msg) noop))))

;; Port -> #f
(define (client p)
  (big-bang #f
            (port p)
            (on-tick values)
            (to-draw (λ (_) (empty-scene 400 400)))
            (register LOCALHOST)))
This commit is contained in:
David Van Horn 2014-05-02 14:38:15 -04:00 committed by Matthias Felleisen
parent 90053d7d40
commit 333e0aa070
4 changed files with 14 additions and 6 deletions

View File

@ -3,7 +3,7 @@
;; ---------------------------------------------------------------------------------------------------
;; provides constants and functions for specifying the shape of clauses in big-bang and universe
(provide nat> nat? proc> bool> num> ip> string> symbol> string-or-symbol> any> K False True)
(provide port> nat> nat? proc> bool> num> ip> string> symbol> string-or-symbol> any> K False True)
(require htdp/error "check-aux.rkt")
@ -11,6 +11,10 @@
(define (False w) #f)
(define (True w) #t)
;; Symbol X -> X : nat?
(define (port> tag x)
(nat> tag x "port"))
;; Symbol X -> X : boolean?
(define (bool> tag x)
(check-arg tag (boolean? x) "boolean" "first" x)

View File

@ -58,6 +58,7 @@
universe0 ;; the initial state of the universe
on-new ;; Universe World -> Result
on-msg ;; Universe World Message -> Result
port ;; Number
;; tick ;; Universe -> Result
(state #f) ;; Boolean
(on-disconnect ;; Universe World -> Result
@ -157,7 +158,7 @@
;;; WHERE
(define tcp-listener
(with-handlers ((exn:fail:network? (lambda (x) (stop! x))))
(tcp-listen SQPORT 4 #t)))
(tcp-listen port 4 #t)))
;; (list IPort OPort) -> Void
(define (add-iworld in-out)
(define in (first in-out))

View File

@ -59,7 +59,7 @@
(class* object% (start-stop<%>)
(inspect #f)
(init-field world0)
(init-field name state register check-with on-key on-release on-pad on-mouse record?)
(init-field name state register port check-with on-key on-release on-pad on-mouse record?)
(init on-receive on-draw stop-when)
;; -----------------------------------------------------------------------
@ -114,7 +114,7 @@
(if (= n 1)
(printf FMTtry register TRIES)
(begin (sleep PAUSE) (try (- n 1)))))))
(define-values (in out) (tcp-connect register SQPORT))
(define-values (in out) (tcp-connect register port))
(tcp-register in out name)
(printf "... successful registered and ready to receive\n")
(set! *out* out)

View File

@ -27,7 +27,7 @@
;;
(only-in "private/launch-many-worlds.rkt" launch-many-worlds launch-many-worlds/proc)
(only-in "private/stop.rkt" make-stop-the-world)
(only-in "private/check-aux.rkt" sexp?)
(only-in "private/check-aux.rkt" sexp? SQPORT)
(only-in "private/pad.rkt" pad-event? pad=?)
htdp/error
(rename-in lang/prim (first-order->higher-order f2h)))
@ -74,7 +74,10 @@
[state DEFAULT #'#f (expr-with-check any> "expected a boolean or a string")]
;; Any -> Boolean
;; -- check-with: all states should specify this predicate
[check-with DEFAULT #'True (function-with-arity 1)])
[check-with DEFAULT #'True (function-with-arity 1)]
;; Natural
;; -- port: specify the port to use
[port DEFAULT #'SQPORT (expr-with-check port> "expected a port number")])
; (create-world world0)
(define-keywords WldSpec AllSpec create-world