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:
parent
90053d7d40
commit
333e0aa070
|
@ -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)
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user