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 ;; 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") (require htdp/error "check-aux.rkt")
@ -11,6 +11,10 @@
(define (False w) #f) (define (False w) #f)
(define (True w) #t) (define (True w) #t)
;; Symbol X -> X : nat?
(define (port> tag x)
(nat> tag x "port"))
;; Symbol X -> X : boolean? ;; Symbol X -> X : boolean?
(define (bool> tag x) (define (bool> tag x)
(check-arg tag (boolean? x) "boolean" "first" x) (check-arg tag (boolean? x) "boolean" "first" x)

View File

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

View File

@ -59,7 +59,7 @@
(class* object% (start-stop<%>) (class* object% (start-stop<%>)
(inspect #f) (inspect #f)
(init-field world0) (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) (init on-receive on-draw stop-when)
;; ----------------------------------------------------------------------- ;; -----------------------------------------------------------------------
@ -114,7 +114,7 @@
(if (= n 1) (if (= n 1)
(printf FMTtry register TRIES) (printf FMTtry register TRIES)
(begin (sleep PAUSE) (try (- n 1))))))) (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) (tcp-register in out name)
(printf "... successful registered and ready to receive\n") (printf "... successful registered and ready to receive\n")
(set! *out* out) (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/launch-many-worlds.rkt" launch-many-worlds launch-many-worlds/proc)
(only-in "private/stop.rkt" make-stop-the-world) (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=?) (only-in "private/pad.rkt" pad-event? pad=?)
htdp/error htdp/error
(rename-in lang/prim (first-order->higher-order f2h))) (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")] [state DEFAULT #'#f (expr-with-check any> "expected a boolean or a string")]
;; Any -> Boolean ;; Any -> Boolean
;; -- check-with: all states should specify this predicate ;; -- 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) ; (create-world world0)
(define-keywords WldSpec AllSpec create-world (define-keywords WldSpec AllSpec create-world