From 93cbc99bad2cc6041a2c63cc5a984d6d4f12e635 Mon Sep 17 00:00:00 2001 From: leiDnedyA Date: Wed, 16 Aug 2023 11:23:05 -0400 Subject: [PATCH 1/5] added files --- .../racketscript/htdp/peer-universe.rkt | 590 ++++++++++++++++++ .../private/peer-universe/debug-tools.rkt | 20 + .../private/peer-universe/encode-decode.rkt | 88 +++ .../htdp/private/peer-universe/jscommon.rkt | 91 +++ .../htdp/private/peer-universe/server-gui.rkt | 115 ++++ .../peer-universe/universe-primitives.rkt | 95 +++ .../private/peer-universe/universe-server.rkt | 345 ++++++++++ .../htdp/private/peer-universe/util.rkt | 42 ++ .../racketscript/htdp/universe.rkt | 1 + 9 files changed, 1387 insertions(+) create mode 100644 racketscript-extras/racketscript/htdp/peer-universe.rkt create mode 100644 racketscript-extras/racketscript/htdp/private/peer-universe/debug-tools.rkt create mode 100644 racketscript-extras/racketscript/htdp/private/peer-universe/encode-decode.rkt create mode 100644 racketscript-extras/racketscript/htdp/private/peer-universe/jscommon.rkt create mode 100644 racketscript-extras/racketscript/htdp/private/peer-universe/server-gui.rkt create mode 100644 racketscript-extras/racketscript/htdp/private/peer-universe/universe-primitives.rkt create mode 100644 racketscript-extras/racketscript/htdp/private/peer-universe/universe-server.rkt create mode 100644 racketscript-extras/racketscript/htdp/private/peer-universe/util.rkt diff --git a/racketscript-extras/racketscript/htdp/peer-universe.rkt b/racketscript-extras/racketscript/htdp/peer-universe.rkt new file mode 100644 index 00000000..520fabb3 --- /dev/null +++ b/racketscript-extras/racketscript/htdp/peer-universe.rkt @@ -0,0 +1,590 @@ +#lang racketscript/base + +(require (for-syntax racketscript/base + syntax/parse) + "universe-primitives.rkt" + "jscommon.rkt" + "encode-decode.rkt" + "debug-tools.rkt" + "universe-server.rkt") + +(provide on-mouse + on-tick + on-key + on-release + on-receive + register + name + to-draw + stop-when + big-bang + + on-new + on-msg + on-disconnect + server-id + universe + + package? + make-package + + bundle? + make-bundle + mail? + make-mail + + iworld-name + iworld? + iworld=? + + key=? + mouse=?) + +(define *default-frames-per-second* 70) + +(define (make-big-bang init-world handlers dom-root) + (new (BigBang init-world handlers (if ($/binop != dom-root $/null) + dom-root #js*.document.body)))) + +(define (big-bang init-world #:dom-root [dom-root $/null] . handlers) + ($> (make-big-bang init-world handlers dom-root) + (setup) + (start))) + +(define-proto BigBang + (λ (init-world handlers dom-root) + #:with-this this + (:= #js.this.world init-world) + (:= #js.this.interval (/ 1000 *default-frames-per-second*)) + (:= #js.this.handlers handlers) + + (:= #js.this.is-universe? #false) + + (:= #js.this.dom-root dom-root) + + (:= #js.this.-active-handlers ($/obj)) + (:= #js.this.-world-change-listeners ($/array)) + (:= #js.this.-package-listeners ($/array)) + + (:= #js.this.-uses-peer #f) + (:= #js.this.-peer-name #js"client") + (:= #js.this.-server-id #js"server") + (:= #js.this.-peer $/undefined) + (:= #js.this.-conn $/undefined) + (:= #js.this.-peer-init-tasks ($/array)) + + (:= #js.this.-idle #t) + (:= #js.this.-stopped #t) + (:= #js.this.-events ($/array)) + + (define canvas (#js.document.createElement #js"canvas")) + (define ctx (#js.canvas.getContext #js"2d")) + (#js.canvas.setAttribute #js"tabindex" 1) + (#js.canvas.setAttribute #js"style" #js"outline: none") + (:= #js.this.-canvas canvas) + (:= #js.this.-context ctx)) + [setup + (λ () + #:with-this this + + (define canvas #js.this.-canvas) + + (#js.this.dom-root.appendChild canvas) + (#js.canvas.focus) + + (#js.this.register-handlers) + + (if #js.this.-uses-peer + (#js.this.init-peer-connection) + (void)) + + ;; Set canvas size as the size of first world + (define draw-handler ($ #js.this.-active-handlers #js"to-draw")) + (unless draw-handler + (error 'big-bang "to-draw handle not provided")) + (define img ($$ draw-handler.callback #js.this.world)) + (:= #js.canvas.width #js.img.width) + (:= #js.canvas.height #js.img.height) + + ;; We are reassigning using change-world so that change world + ;; callbacks gets invoked at start of big-bang + (#js.this.change-world #js.this.world) + + this)] + [register-handlers + (λ () + #:with-this this + (define active-handlers #js.this.-active-handlers) + (let loop ([handlers #js.this.handlers]) + (when (pair? handlers) + (define h ((car handlers) this)) + (#js.h.register) + (:= ($ active-handlers #js.h.name) h) + (loop (cdr handlers)))))] + [deregister-handlers + (λ () + #:with-this this + (define active-handlers #js.this.-active-handlers) + ($> (#js*.Object.keys active-handlers) + (forEach + (λ (key) + (define h ($ active-handlers key)) + (#js.h.deregister) + (:= ($ #js.active-handlers #js.h.name) *undefined*)))))] + [start + (λ () + #:with-this this + (:= #js.this.-stopped #f) + ; always draw first, in case no on-tick handler provided + (#js.this.queue-event ($/obj [type #js"to-draw"])) + (#js.this.process-events))] + [stop + (λ () + #:with-this this + (#js.this.clear-event-queue) + (set-object! this + [-stopped #t] + [-idle #t]) + (#js.this.deregister-handlers) + (#js.this.-canvas.remove) + (set-object! #js.this + [-active-handlers ($/obj)] + [handlers '()]))] + [clear-event-queue + (λ () + #:with-this this + (#js.this.-events.splice 0 #js.this.-events.length))] + [queue-event + (λ (e) + #:with-this this + (#js.this.-events.push e) + (when #js.this.-idle + (schedule-animation-frame #js.this 'process_events)))] + [change-world + (λ (handler-result) + #:with-this this + + ;; WIP: handle packages being passed as new-world + ;; see https://docs.racket-lang.org/teachpack/2htdpuniverse.html#%28part._universe._.Sending_.Messages%29 + (define new-world handler-result) + (if (package? handler-result) + (begin + (set! new-world (package-world handler-result)) + (#js.this.handle-package handler-result)) + (void)) + + (define listeners #js.this.-world-change-listeners) + (let loop ([i 0]) + (when (< i #js.listeners.length) + (define listener ($ #js.listeners i)) + (listener new-world) + (loop (add1 i)))) + (:= #js.this.world new-world))] + [add-world-change-listener + (λ (cb) + #:with-this this + (#js.this.-world-change-listeners.push cb))] + [remove-world-change-listener + (λ (cb) + #:with-this this + (define index (#js.this.-world-change-listeners.indexOf cb)) + (#js.this.-world-change-listeners.splice index 1))] + [handle-package + (λ (pkg) + #:with-this this + (define message (package-message pkg)) + (define listeners #js.this.-package-listeners) + (let loop ([i 0]) + (when (< i #js.listeners.length) + (define listener ($ #js.listeners i)) + (listener message) + (loop (add1 i)))))] + [add-package-listener + (λ (cb) + #:with-this this + (#js.this.-package-listeners.push cb))] + [remove-package-listener + (λ (cb) + #:with-this this + (define index (#js.this.-package-listeners.indexOf cb)) + (#js.this.-package-listeners.splice index 1))] + [process-events + (λ () + #:with-this this + (define events #js.this.-events) + + (:= #js.this.-idle #f) + + (let loop ([world-changed? #f]) + (cond + [(> #js.events.length 0) + (define evt (#js.events.shift)) + (define handler ($ #js.this.-active-handlers #js.evt.type)) + + (define changed? + (cond + ; raw evt must be checked 1st; bc handler will be undefined + [(equal? #js.evt.type #js"raw") + (#js.evt.invoke #js.this.world evt)] + [($/binop === handler $/undefined) + (begin (#js*.console.warn #js"WARNING: processing event w/ undefined handler.") (void))] + [handler (#js.handler.invoke #js.this.world evt)] + [else + (#js.console.warn "ignoring unknown/unregistered event type: " evt)])) + (loop (or world-changed? changed?))] + [(and world-changed? (not #js.this.-stopped)) + (#js.this.queue-event ($/obj [type #js"to-draw"])) + (loop #f)])) + + (:= #js.this.-idle #t))] + [init-peer-connection + ; Should we let users pick their own IDs? Would that be a security issue? + (λ () + #:with-this this + (define peer (new (Peer))) + (:= #js.this.-peer peer) + + (#js.peer.on #js"open" + (λ () + (define conn (#js.peer.connect (js-string #js.this.-server-id) + ($/obj [label #js.this.-peer-name]))) + (:= #js.this.-conn conn) + (define init-tasks #js.this.-peer-init-tasks) + + (define (on-conn-open) + ;; Loop through this.-peer-init-tasks[] and execute all callbacks + (let loop ([i 0]) + (when (< i #js.init-tasks.length) + (define task ($ #js.init-tasks i)) + (task peer conn) + (loop (add1 i)))) + ;; Add beforeunload and unload listeners to close the connection + (#js*.window.addEventListener #js"beforeunload" + (λ (_) + (#js.conn.close))) + (#js*.window.addEventListener #js"unload" + (λ (_) + (#js.conn.close) + )) + ) + (#js.conn.on #js"open" on-conn-open) + (#js.conn.on #js"close" (λ (_) ( + ;; TODO: implement disconnect event + #js*.console.log #js"conn closed") + (#js*.alert #js"Client has been disconnected by the server or the connection has been lost."))) + )))] + ;; cb = (peer: Peer, conn: DataConnection) => void + [add-peer-init-task + (λ (cb) + #:with-this this + ;; If peer and conn already exist, execute callback + ;; else, append callback to this.-peer-init-tasks[] + (define conn #js.this.-conn) + (define peer #js.this.-peer) + (define conn-open? + (if ($/typeof conn "undefined") + #f #js.conn.open)) + (if conn-open? + (cb peer conn) + (#js.this.-peer-init-tasks.push cb)))]) + +(define (to-draw cb) + (λ (bb) + (define on-tick-evt ($/obj [type #js"to-draw"])) + ($/obj + [name #js"to-draw"] + [register (λ () (void))] + [deregister (λ () (void))] + [callback cb] + [invoke (λ (world evt) + (define ctx #js.bb.-context) + (define img (cb #js.bb.world)) + (define height #js.img.height) + (define width #js.img.width) + + (#js.ctx.clearRect 0 0 width height) + (#js.img.render ctx (half width) (half height)) + + #f)]))) + +(define (on-tick cb rate) + (λ (bb-u) + (define on-tick-evt ($/obj [type #js"on-tick"])) + ($/obj + [name #js"on-tick"] + [register (λ () + #:with-this this + (#js.bb-u.queue-event on-tick-evt) + (if rate + (set! rate (* 1000 rate)) + (set! rate #js.bb-u.interval)))] + [deregister (λ () + #:with-this this + (define last-cb #js.this.last-cb) + (when last-cb + ;; TODO: This sometimes doesn't work, + ;; particularly with high fps, so we need to do + ;; something at event loop itself. + (#js*.window.clearTimeout last-cb)))] + [invoke (λ (state _) + #:with-this this + (if #js.bb-u.is-universe? + (#js.bb-u.change-state (cb state)) + (#js.bb-u.change-world (cb state))) + (:= #js.this.last-cb (#js*.setTimeout + (λ () + (#js.bb-u.queue-event on-tick-evt)) + rate)) + #t)]))) + +(define (on-mouse cb) + (λ (bb) + ($/obj + [name #js"on-mouse"] + [listeners ($/obj)] + [register + (λ () + #:with-this this + (define canvas #js.bb.-canvas) + (define (make-listener r-evt-name) + (λ (evt) + (define posn (canvas-posn-δ canvas evt)) + (#js.bb.queue-event ($/obj [type #js"on-mouse"] + [evt (js-string->string r-evt-name)] + [x ($ posn 'x)] + [y ($ posn 'y)])))) + + (define (register-listener evt-name r-evt-name) + (define cb (make-listener r-evt-name)) + (#js.canvas.addEventListener evt-name cb) + (:= ($ #js.this.listeners evt-name) cb)) + + (register-listener #js"mousemove" #js"move") + (register-listener #js"mousedown" #js"button-down") + (register-listener #js"mouseup" #js"button-up") + (register-listener #js"mouseout" #js"leave") + (register-listener #js"mouseover" #js"enter") + (register-listener #js"drag" #js"drag"))] + [deregister + (λ () + #:with-this this + (define (remove-listener evt-name) + (define cb ($ #js.this.listeners evt-name)) + (#js.bb.-canvas.removeEventListener evt-name cb)) + (remove-listener #js"mousemove") + (remove-listener #js"mousedown") + (remove-listener #js"mouseup") + (remove-listener #js"mouseout") + (remove-listener #js"mouseover") + (remove-listener #js"drag"))] + [invoke + (λ (world evt) + (define new-world (cb world #js.evt.x #js.evt.y #js.evt.evt)) + (#js.bb.change-world new-world) + #t)]))) + +(define-syntax-rule (-on-key-* r-evt-name evt-name) + (λ (cb) + (λ (bb) + ($/obj + [name r-evt-name] + [register + (λ () + #:with-this this + (define canvas #js.bb.-canvas) + (:= #js.this.listener + (λ (evt) + (#js.evt.preventDefault) + (#js.evt.stopPropagation) + (#js.bb.queue-event ($/obj [type r-evt-name] + [key (key-event->key-name evt)])))) + (#js.canvas.addEventListener evt-name #js.this.listener))] + [deregister + (λ () + #:with-this this + (#js.bb.-canvas.removeEventListener evt-name #js.this.listener) + (:= #js.this.listener *undefined*))] + [invoke + (λ (world evt) + (define new-world (cb world #js.evt.key)) + (#js.bb.change-world new-world) + #t)])))) + +(define on-key (-on-key-* #js"on-key" #js"keydown")) +(define on-release (-on-key-* #js"on-release" #js"keyup")) + +(define (stop-when last-world? [last-picture #f]) + (λ (bb) + ($/obj + [name #js"stop-when"] + [predicate last-world?] + [lastpicture last-picture] + [register + (λ () + #:with-this this + (#js.bb.add-world-change-listener #js.this.invoke))] + [deregister + (λ () + #:with-this this + (#js.bb.remove-world-change-listener #js.this.invoke))] + [invoke + (λ (w) + (when (last-world? w) + (#js.bb.stop) + (when last-picture + (define handler ((to-draw last-picture) bb)) + (#js.bb.queue-event + ($/obj [type #js"raw"] + [invoke #js.handler.invoke])))))]))) + +;; maps JS KeyboardEvent.key to big-bang KeyEvent +(define key-table + ($/obj [Backspace "\b"] + [Enter "\r"] + [Tab "\t"] + [ArrowLeft "left"] + [ArrowRight "right"] + [ArrowDown "down"] + [ArrowUp "up"] + [Shift "shift"] + [Control "control"] + [ControlRight "rcontrol"] + [ControlLeft "control"] + [ShiftRight "rshift"] + [ShiftLeft "shift"] + [Escape "escape"] + [Home "home"] + [End "end"] + [Insert "insert"] ; no pageup/down in big-bang? + [Delete "\u007F"] ; rubout + [Pause "pause"] + [NumLock "numlock"] + [F1 "f1"] + [F2 "f2"] + [F3 "f3"] + [F4 "f4"] + [F5 "f5"] + [F6 "f6"] + [F7 "f7"] + [F8 "f8"] + [F9 "f9"] + [F10 "f10"] + [F11 "f11"] + [F12 "f12"] + ; unsure about these big bang KeyEvents: + ;; "start" + ;; "cancel" + ;; "clear" + ;; "menu" + ;; "capital" + ;; "prior" + ;; "next" + ;; "select" + ;; "print" + ;; "execute" + ;; "snapshot" + ;; "help" + ;; "scroll" + )) + +(define (key-event->key-name e) + (define k #js.e.key) + (define code ; use .code to differentiate left/right shift, ctrl, alt + (if (or ($/binop === k #js"Shift") ($/binop === k #js"Control") ($/binop === k #js"Alt")) + #js.e.code + k)) + (let ([key-table-code ($ key-table code)]) + (if (void? key-table-code) + (js-string->string code) + key-table-code))) + +(define (canvas-posn-δ canvas evt) + (define rect (#js.canvas.getBoundingClientRect)) + ($/obj + [x (- #js.evt.clientX #js.rect.left)] + [y (- #js.evt.clientY #js.rect.top)])) + +(define (key=? k1 k2) + (equal? k1 k2)) +(define (mouse=? m1 m2) + (equal? m1 m2)) + +(define (on-receive cb) + (λ (bb) + (define on-receive-evt ($/obj [type #js"on-receive"])) + ($/obj + [name #js"on-receive"] + [register (λ () + #:with-this this + + (#js.bb.add-peer-init-task + (λ (peer conn) + (:= #js.this.conn-data-listener + (λ (data) + (#js.bb.queue-event ($/obj [type #js.on-receive-evt.type] + [msg data])))) + + (#js.conn.on #js"data" #js.this.conn-data-listener) + + (:= #js.this.package-listener + (λ (message) + #:with-this this + (#js.conn.send (encode-data message)) + 0)) + + (#js.bb.add-package-listener #js.this.package-listener))) + + 0)] + [deregister (λ () + #:with-this this + (define peer #js.bb.-peer) + (define should-destroy-peer? + (if ($/typeof peer "undefined") + #f + (not #js.peer.disconnected))) + (if should-destroy-peer? + (begin + (#js.peer.disconnect) + (#js.peer.destroy)) + (void)) + (#js.bb.remove-package-listener #js.this.package-listener) + 0)] + [invoke (λ (world evt) + #:with-this this + (#js.bb.change-world (cb world (decode-data #js.evt.msg))) + #t)]))) + +(define (register server-id) + (λ (bb) + ($/obj + [name #js"register"] + [register (λ () + #:with-this this + (:= #js.bb.-server-id server-id) + (:= #js.bb.-uses-peer #t) + 0)] + [deregister (λ () + #:with-this this + (define conn #js.bb.-conn) + (define conn-open? + (if ($/typeof conn "undefined") + #f #js.conn.open)) + (#js*.console.log conn-open?) + (if conn-open? + (#js.conn.close) + (void)) + 0)] + [invoke (λ (world evt) + #:with-this this + #t + )]))) + +(define (name name) + (λ (bb) + ($/obj + [name #js"name"] + [register (λ () + #:with-this this + (:= #js.bb.-peer-name (js-string name)) + (void))] + [deregister (λ () (void))]))) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/debug-tools.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/debug-tools.rkt new file mode 100644 index 00000000..012dcc4f --- /dev/null +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/debug-tools.rkt @@ -0,0 +1,20 @@ +#lang racketscript/base + +(require "encode-decode.rkt") + +(provide console-log-rkt-list + test-encoding) + +(define (console-log-rkt-list l) + (if (list? l) (#js*.console.log (foldl (lambda (curr res) + (#js.res.push curr) + res) + ($/array) l)) + (#js*.console.log l))) + +(define (test-encoding val) + (define result (decode-data (encode-data val))) + (#js*.console.log val) + (#js*.console.log result) + (#js*.console.log (js-string (format "val == result? : ~a" (equal? val result)))) + (void)) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/encode-decode.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/encode-decode.rkt new file mode 100644 index 00000000..a24c039c --- /dev/null +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/encode-decode.rkt @@ -0,0 +1,88 @@ +#lang racketscript/base + +(provide encode-data + decode-data) + +(require "util.rkt") + +(define DATA-TYPE-WARNING #js"racketscript/htdp/universe: Unsupported datatype being passed to/from server.") + +(define (encode-array arr) + (#js.arr.map (lambda (elem) (encode-data elem)))) + +(define (decode-array arr) + (#js.arr.map (lambda (elem) (decode-data elem)))) + +(define (encode-object obj) + (define keys (#js*.Object.keys obj)) + (#js.keys.reduce (lambda (res key) + ($/:= ($ res key) (encode-data ($ obj key))) + res) + ($/obj))) + +(define (decode-object obj) + (define keys (#js*.Object.keys obj)) + (#js.keys.reduce (lambda (res key) + ($/:= ($ res key) (decode-data ($ obj key))) + res) + ($/obj))) + +#| +('test "some_string" #js"test" {test: "test"}) + + +"test" +{ + val: "test", type: "string" +} + +'sym +{ + val: "sym", type: "symbol" +} + +|# + +(define (encode-data data) + (cond [(list? data) (foldl (lambda (curr result) + (#js.result.push (encode-data curr)) + result) + ($/array) + data)] + [(null? data) ($/obj [type #js"null"])] + [(undefined? data) ($/obj [type #js"undefined"])] + [(number? data) ($/obj [type #js"number"] + [val data])] + [(string? data) ($/obj [type #js"string"] + [val (js-string data)])] + [(symbol? data) ($/obj [type #js"symbol"] + [val (js-string (symbol->string data))])] + [(boolean? data) ($/obj [type #js"boolean"] + [val data])] + [(js-string? data) ($/obj [type #js"js-string"] + [val data])] + [(js-array? data) ($/obj [type #js"js-array"] + [val (encode-array data)])] + [(js-object? data) ($/obj [type #js"js-object"] + [val (encode-object data)])] + [else (begin + (#js*.console.warn ($/array DATA-TYPE-WARNING data)) + ($/obj [type #js"unknown"] + [val data]))])) + +(define (decode-data data) + (cond [(#js*.Array.isArray data) (#js.data.reduce (lambda (result curr) + (append result (list (decode-data curr)))) + '())] + [($/binop == #js.data.type #js"null") $/null] + [($/binop == #js.data.type #js"undefined") $/undefined] + [($/binop == #js.data.type #js"number") #js.data.val] + [($/binop == #js.data.type #js"string") (js-string->string #js.data.val)] + [($/binop == #js.data.type #js"symbol") (string->symbol (js-string->string #js.data.val))] + [($/binop == #js.data.type #js"boolean") #js.data.val] + [($/binop == #js.data.type #js"js-string") #js.data.val] + [($/binop == #js.data.type #js"js-array") (decode-array #js.data.val)] + [($/binop == #js.data.type #js"js-object") (decode-object #js.data.val)] + [($/binop == #js.data.type #js"unknown") (begin + (#js*.console.warn DATA-TYPE-WARNING) + #js.data.val)])) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/jscommon.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/jscommon.rkt new file mode 100644 index 00000000..9fad8741 --- /dev/null +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/jscommon.rkt @@ -0,0 +1,91 @@ +#lang racketscript/base + +(require (for-syntax racketscript/base + syntax/parse)) + +(provide := + *this* + *null* + *undefined* + new + define-proto + set-object! + schedule-method + schedule-animation-frame + document + console + Math + Path2D + abs + sin + cos + floor + abs+ceil + max + min + twice + half + (rename-out [field-λ λ])) + +;;----------------------------------------------------------------------------- +;; Interop helpers + +(define-syntax := (make-rename-transformer #'$/:=)) +(define-syntax new (make-rename-transformer #'$/new)) +(define-syntax *this* (make-rename-transformer #'$/this)) +(define-syntax *null* (make-rename-transformer #'$/null)) +(define-syntax *undefined* (make-rename-transformer #'$/undefined)) + +(begin-for-syntax + (define-syntax-class field + #:description "a key-value pair for object" + (pattern [name:id val:expr]))) + +(define-syntax (field-λ stx) + (syntax-parse stx + [(_ formals (~datum #:with-this) self:id body ...) + #'(λ formals + (define self *this*) + body ...)] + [(_ formals body ...) #'(λ formals body ...)])) + +(define-syntax (define-proto stx) + (syntax-parse stx + [(define-proto name:id init:expr field:field ...) + #`(begin + (define name init) + #,(when (attribute field) + #`(begin + (:= ($ name 'prototype 'field.name) field.val) ...)))])) + +(define-syntax (set-object! stx) + (syntax-parse stx + [(set-object! obj:expr f:field ...) + #`(begin (:= ($ obj 'f.name) f.val) ...)])) + + +(define-syntax-rule (schedule-method this method interval) + (let ([self this]) + (#js*.window.setTimeout (λ () + (($ self method))) + interval))) + +(define-syntax-rule (schedule-animation-frame this step) + (let ([self this]) + (#js*.window.requestAnimationFrame (λ () + (($ self step)))))) + +;;----------------------------------------------------------------------------- +;; Helper functions + +(define document #js*.window.document) +(define console #js*.window.console) +(define Math #js*.window.Math) +(define Path2D #js*.window.Path2D) +(define abs+ceil (λ (n) (abs (ceiling n)))) + +(define-syntax-rule (twice e) + (* e 2)) + +(define-syntax-rule (half e) + (/ e 2)) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/server-gui.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/server-gui.rkt new file mode 100644 index 00000000..9decba16 --- /dev/null +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/server-gui.rkt @@ -0,0 +1,115 @@ +#lang racketscript/base + +(require (for-syntax racketscript/base + syntax/parse) + "encode-decode.rkt" + "debug-tools.rkt" + "universe-primitives.rkt" + "jscommon.rkt") + +(provide server-gui) + +(define DEFAULT-DISPLAY-MODE #js"block") +(define WIDTH 500) +(define HEIGHT 300) + +(define-proto ServerLogger + (λ (root stop-callback restart-callback) + #:with-this this + + ;
+ ; Auto-scroll + ; logged text + ;
+ ; + ; + ;
+ ;
+ (:= #js.this.logs ($/array)) + (:= #js.this.autoscroll? #true) + + ;; Create elements + (:= #js.this.container (#js*.document.createElement #js"div")) + (:= #js.this.textbox (#js*.document.createElement #js"textarea")) + (:= #js.this.checkbox-div (#js*.document.createElement #js"div")) + (:= #js.this.checkbox-label (#js*.document.createElement #js"label")) + (:= #js.this.checkbox (#js*.document.createElement #js"input")) + (:= #js.this.button-div (#js*.document.createElement #js"div")) + (:= #js.this.stop-button (#js*.document.createElement #js"button")) + (:= #js.this.restart-button (#js*.document.createElement #js"button")) + + ;; Configure elements + (:= #js.this.container.style.display #js"none") + (:= #js.this.container.style.width (js-string (format "~apx" WIDTH))) + (:= #js.this.container.style.height (js-string (format "~apx" HEIGHT))) + + (:= #js.this.textbox.style.width #js"inherit") + (:= #js.this.textbox.style.height #js"inherit") + + (:= #js.this.checkbox-label.for #js"autoscroll") + (:= #js.this.checkbox-label.innerHTML #js"autoscroll with new input") + (:= #js.this.checkbox.type #js"checkbox") + (:= #js.this.checkbox.onclick (lambda () (:= #js.this.autoscroll? #js.this.checkbox.checked))) + (:= #js.this.checkbox.checked #true) + + (:= #js.this.stop-button.innerHTML #js"stop") + (:= #js.this.stop-button.style.grid-area #js"stop") + (:= #js.this.stop-button.onclick stop-callback) + (:= #js.this.restart-button.innerHTML #js"restart") + (:= #js.this.restart-button.style.grid-area #js"restart") + (:= #js.this.restart-button.onclick restart-callback) + (:= #js.this.button-div.style.width #js"100%") + (:= #js.this.button-div.style.display #js"grid") + (:= #js.this.button-div.style.gridTemplateAreas + #js"'stop restart'") + + ;; Add elements to document + (#js.this.checkbox-div.appendChild #js.this.checkbox-label) + (#js.this.checkbox-div.appendChild #js.this.checkbox) + + (#js.this.button-div.appendChild #js.this.stop-button) + (#js.this.button-div.appendChild #js.this.restart-button) + + (#js.this.container.appendChild #js.this.textbox) + (#js.this.container.appendChild #js.this.checkbox-div) + (if (and restart-callback stop-callback) + (#js.this.container.appendChild #js.this.button-div) + (void)) + (#js.root.appendChild #js.this.container) + this) + [log + (λ (text) + #:with-this this + (#js.this.logs.push (js-string text)) + (#js.this.render) + (#js*.console.log (js-string text)) + (void))] + [show + (λ () + #:with-this this + (:= #js.this.container.style.display DEFAULT-DISPLAY-MODE) + (void))] + [hide + (λ () + #:with-this this + (:= #js.this.container.style.display #js"none") + (void))] + [render + (λ () + #:with-this this + (define log-string (#js.this.logs.reduce (λ (res curr) + (if ($/binop === res #js"") + (js-string curr) + ($/+ res #js"\n\n" (js-string curr)))) + #js"")) + (:= #js.this.textbox.innerHTML log-string) + (cond [(equal? #js.this.autoscroll? #true) + (:= #js.this.textbox.scrollTop #js.this.textbox.scrollHeight)] + [else (void)]) + (void))]) + +(define (make-gui root stop-callback restart-callback) + (new (ServerLogger root stop-callback restart-callback))) + +(define (server-gui [root-element #js*.document.body] [stop-callback #false] [restart-callback #false]) + (make-gui root-element stop-callback restart-callback)) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/universe-primitives.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/universe-primitives.rkt new file mode 100644 index 00000000..0103b7eb --- /dev/null +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/universe-primitives.rkt @@ -0,0 +1,95 @@ +#lang racketscript/base + +(require ;htdp/error + racket/list) + +(provide sexp? + + make-package + package? + package-world + package-message + + make-bundle + bundle? + + make-mail + mail? + + iworld-name + iworld? + iworld=? + + ;; private + bundle-state + bundle-mails + bundle-low-to-remove + + ;; private + mail-to + mail-content + + ;; private + make-iworld + iworld-conn) + +(define (sexp? x) + (cond + [(empty? x) #true] + [(string? x) #true] + [(bytes? x) #true] + [(symbol? x) #true] + [(number? x) #true] + [(boolean? x) #true] + [(char? x) #true] + [(pair? x) (and (list? x) (andmap sexp? x))] + ; [(and (struct? x) (prefab-struct-key x)) (for/and ((i (struct->vector x))) (sexp? i))] + [else #false])) + +(struct u-package (world message)) +(define (make-package world message) + (u-package world message)) +(define (package? p) + (u-package? p)) +(define (package-world p) + (u-package-world p)) +(define (package-message p) + (u-package-message p)) + +(struct u-bundle (state mails low-to-remove)) +(define (make-bundle state mails low-to-remove) + (u-bundle state mails low-to-remove)) +(define (bundle? bundle) + (u-bundle? bundle)) +(define (bundle-state b) + (u-bundle-state b)) +(define (bundle-mails b) + (u-bundle-mails b)) +(define (bundle-low-to-remove b) + (u-bundle-low-to-remove b)) + +(struct u-mail (to content)) +(define (make-mail to content) + (u-mail to content)) +(define (mail? mail) + (u-mail? mail)) +(define (mail-to mail) + (u-mail-to mail)) +(define (mail-content mail) + (u-mail-content mail)) + +(struct u-iworld (conn name)) +;; for client code use +(define (iworld-name iworld) + (u-iworld-name iworld)) +(define (iworld? iworld) + (u-iworld? iworld)) +(define (iworld=? iw1 iw2) + (define conn1 (u-iworld-conn iw1)) + (define conn2 (u-iworld-conn iw2)) + ($/binop === conn1 conn2)) +;; not for client code use +(define (make-iworld conn name) + (u-iworld conn name)) +(define (iworld-conn iw) + (u-iworld-conn iw)) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/universe-server.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/universe-server.rkt new file mode 100644 index 00000000..bfcc7144 --- /dev/null +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/universe-server.rkt @@ -0,0 +1,345 @@ +#lang racketscript/base + +(require (for-syntax racketscript/base + syntax/parse) + "server-gui.rkt" + "encode-decode.rkt" + "debug-tools.rkt" + "universe-primitives.rkt" + "jscommon.rkt" + "util.rkt") + +; TODO: +; implement deregister for on-msg handler +; implement the following handlers +; - to-string +; - check-with +; - state + +; Variations from api: +; - no port handler +; - create clause for user to pass in +; root element for logging GUI + +; Add to logs: +; u: current universe state +; Events to log: +; - mail sending: +; "broadcast failed to ~a" iworld name +; "~s not on the list" iworld name + +(provide universe + + on-new + on-msg + on-disconnect + server-id + + ; peerjs + Peer) + +;; Adds peerjs exports (primarily Peer constructor) to window object +(define peerjs ($/require "https://cdnjs.cloudflare.com/ajax/libs/peerjs/1.4.7/peerjs.min.js" *)) + +(define Peer #js*.window.Peer) + +(define DEFAULT-UNIVERSE-ID "server") ;; Change this + +(define *default-frames-per-second* 70) + +;; Universe server +(define (make-universe init-state handlers gui-root) + (new (Universe init-state handlers (if ($/binop != gui-root $/null) + gui-root #js*.document.body)))) + +(define (universe init-state #:dom-root [gui-root $/null] . handlers) + ($> (make-universe init-state handlers gui-root) + (setup) + (start))) + +(define-proto Universe + (λ (init-state handlers gui-root) + #:with-this this + (:= #js.this.state init-state) + (:= #js.this.interval (/ 1000 *default-frames-per-second*)) + (:= #js.this.handlers handlers) + + (:= #js.this.is-universe? #true) + + (:= #js.this.gui (server-gui gui-root + ; #js.this.stop + ; (λ () ($> #js.this.stop #js.this.setup #js.this.start)) + )) ;; TODO: allow user to pass root element? & Fix stop/restart cb's + + (:= #js.this.-active-handlers ($/obj)) + (:= #js.this.-state-change-listeners ($/array)) + (:= #js.this.-message-listeners ($/array)) + + (:= #js.this.-peer $/undefined) + (:= #js.this.-peer-init-tasks ($/array)) + (:= #js.this.-active-iworlds ($/array)) + (:= #js.this.-disconnect-tasks ($/array)) + + (:= #js.this.-peer-id DEFAULT-UNIVERSE-ID) + + (:= #js.this.-idle #t) + (:= #js.this.-stopped #t) + (:= #js.this.-events ($/array))) + [setup + (λ () + #:with-this this + (#js.this.register-handlers) + (#js.this.gui.show) + + (define (log-connection conn) + (#js.this.gui.log (format "~a signed up" (js-string->string #js.conn.label)))) + (define (log-new-msg iw data) + (#js.this.gui.log (format "~a --> universe:\n<~a>" + (iworld-name iw) (msg->string (decode-data data))))) + + (#js.this.add-peer-init-task (λ (peer) + (#js.peer.on #js"connection" + log-connection))) + (#js.this.-message-listeners.push log-new-msg) + this)] + [start + (λ () + #:with-this this + (#js.this.init-peer-connection) + (#js.this.gui.log (format "a new universe is up and running with id ~s" + (js-string->string #js.this.-peer.id))) + this)] + [register-handlers + (λ () + #:with-this this + (define active-handlers #js.this.-active-handlers) + (let loop ([handlers #js.this.handlers]) + (when (pair? handlers) + (define h ((car handlers) this)) + (#js.h.register) + (:= ($ active-handlers #js.h.name) h) + (loop (cdr handlers)))))] + [deregister-handlers + (λ () + #:with-this this + (define active-handlers #js.this.-active-handlers) + ($> (#js*.Object.keys active-handlers) + (forEach + (λ (key) + (define h ($ active-handlers key)) + (#js.h.deregister) + (:= ($ #js.active-handlers #js.h.name) *undefined*)))))] + [stop + (λ () + #:with-this this + (#js.this.gui.log "stopping the universe\n----------------------------------") + (void))] + [clear-event-queue + (λ () + #:with-this this + (#js.this.-events.splice 0 #js.this.-events.length))] + [add-state-change-listener + (λ () 0)] + [remove-state-change-listener + (λ () 0)] + [queue-event + (λ (e) + #:with-this this + (#js.this.-events.push e) + (when #js.this.-idle + (schedule-animation-frame #js.this 'process_events)))] + [process-events + (λ () + #:with-this this + (define events #js.this.-events) + + (:= #js.this.-idle #f) + + (let loop ([state-changed? #f]) + (cond + [(> #js.events.length 0) + (define evt (#js.events.shift)) + (define handler ($ #js.this.-active-handlers #js.evt.type)) + (define changed? + (cond + ; raw evt must be checked 1st; bc handler will be undefined + [(equal? #js.evt.type #js"raw") + (#js.evt.invoke #js.this.state evt)] + [(not ($/typeof handler "undefined")) + (#js.handler.invoke #js.this.state evt)] + [else + (#js.console.warn "ignoring unknown/unregistered event type: " evt)])) + (loop (or state-changed? changed?))])) + + (:= #js.this.-idle #t))] + [change-state + (λ (result-bundle) + #:with-this this + + (define new-state (bundle-state result-bundle)) + (define mails (bundle-mails result-bundle)) + (define low-to-remove (bundle-low-to-remove result-bundle)) + + ;; Send all mails + (for-each (lambda (curr-mail) + (define iworld (mail-to curr-mail)) + (define conn (iworld-conn iworld)) + (#js.conn.send (encode-data (mail-content curr-mail))) + (#js.this.gui.log (format "universe --> ~a:\n<~a>" + (iworld-name iworld) + (mail-content curr-mail)))) + mails) + + ;; Remove all worlds in low-to-remove + (for-each (lambda (iw) + (define conn (iworld-conn iw)) + (define index (#js.this.-active-iworlds.indexOf iw)) + (#js.conn.close) + (if (> index -1) + (#js.this.-active-iworlds.splice index 1) + (void))) + low-to-remove) + + (define listeners #js.this.-state-change-listeners) + (let loop ([i 0]) + (when (< i #js.listeners.length) + (define listener ($ #js.listeners i)) + (listener new-state) + (loop (add1 i)))) + (:= #js.this.state new-state) + ; (#js.this.gui.log (format "~a" new-state)) + ;; Maybe implement this? + )] + [init-peer-connection + (λ (id) + #:with-this this + (define peer (new (Peer #js.this.-peer-id))) + (:= #js.this.-peer peer) + (#js.peer.on #js"open" + (λ () + (define init-tasks #js.this.-peer-init-tasks) + (let loop ([i 0]) + (when (< i #js.init-tasks.length) + (define task ($ #js.init-tasks i)) + (task peer) + (loop (add1 i)))))))] + [add-peer-init-task + (λ (cb) ;; cb = (peer: Peer) => void + #:with-this this + ;; If peer already exists, execute callback + ;; else, append callback to this.-peer-init-tasks[] + (define peer #js.this.-peer) + (define peer-started? (not ($/typeof peer "undefined"))) + + (if peer-started? + (cb peer) + (#js.this.-peer-init-tasks.push cb)))] + [pass-message ;; Passes sender iworld and message to this.-message-listeners + (λ (sender-iw data) + #:with-this this + ;; TODO: Decrypt data once encryption/decryption of racket types solved + (#js.this.-message-listeners.forEach + (λ (cb) (cb sender-iw data))))] + [handle-disconnect + (λ (iw) + #:with-this this + ;; Run all disconnect tasks, passing in the iworld of the connection being closed + (define tasks #js.this.-disconnect-tasks) + (let loop ([i 0]) + (when (< i #js.tasks.length) + (define task ($ tasks i)) + (task iw) + (loop (add1 i)))) + (#js.this.gui.log (format "~a !! closed port" (iworld-name iw))) + (void))]) + +(define (on-new cb) + (λ (u) + (define on-new-evt ($/obj [type #js"on-new"])) + ($/obj + [name #js"on-new"] + [register (λ () + #:with-this this + (define (init-task peer) + (define (handle-connection conn) + (define name "client name") + (if #js.conn.label + (set! name (js-string->string #js.conn.label)) + (void)) + (define iw (make-iworld conn name)) + (#js.u.-active-iworlds.push iw) + (#js.u.queue-event ($/obj [type #js"on-new"] + [iWorld iw])) + (#js.conn.on #js"close" + (λ () + (#js.u.handle-disconnect iw))) + (#js.conn.on #js"data" + (λ (data) (#js.u.pass-message iw data)))) + (#js.peer.on #js"connection" handle-connection)) + + (#js.u.add-peer-init-task init-task) + + (void))] + [deregister (λ () ;; TODO: implement this + #:with-this this + (void))] + [invoke (λ (state evt) + #:with-this this + (define conn (iworld-conn #js.evt.iWorld)) + (#js.conn.on #js"open" + (λ (_) + (#js.u.change-state + (cb state #js.evt.iWorld)))) + #t)]))) + +(define (on-disconnect cb) + (λ (u) + (define on-disconnect-evt ($/obj [type #js"on-disconnect"])) + ($/obj + [name #js"on-disconnect"] + [register (λ () + #:with-this this + (#js.u.-disconnect-tasks.push + (λ (iworld) + (#js.u.queue-event ($/obj [type #js"on-disconnect"] + [iWorld iworld])))) + (void))] + [deregister (λ () ; TODO: implement this? maybe? + #:with-this this + (void))] + [invoke (λ (state evt) + #:with-this this + (#js.u.change-state (cb state #js.evt.iWorld)) + (void))]))) + +(define (server-id id) + (λ (u) + ($/obj + [name #js"server-id"] + [register (λ () + #:with-this this + (:= #js.u.-peer-id (js-string id)) + (void))] + [deregister (λ () + #:with-this this + (void))]))) + +(define (on-msg cb) + (λ (u) + (define on-msg-evt ($/obj [type #js"on-msg"])) + ($/obj + [name #js"on-msg"] + [register (λ () + #:with-this this + (define (handle-msg sender data) + (#js.u.queue-event ($/obj [type #js"on-msg"] + [iWorld sender] + [msg data]))) + (#js.u.-message-listeners.push handle-msg) + (void))] + [deregister (λ () ;; TODO: implement this + #:with-this this + (void))] + [invoke (λ (state evt) + (#js.u.change-state (cb state #js.evt.iWorld (decode-data #js.evt.msg))) + #t)]))) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/util.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/util.rkt new file mode 100644 index 00000000..0ef0859e --- /dev/null +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/util.rkt @@ -0,0 +1,42 @@ +#lang racketscript/base + +(require (for-syntax racketscript/base + syntax/parse)) + +(provide format-js-str + (all-defined-out)) + +(define-syntax-rule (format-js-str fmt-str args ...) + (js-string (format fmt-str args ...))) + +(define (js-string? s) + (or ($/typeof s "string") ($/instanceof s #js*.String))) + +;; NOTE: because every racket datatype in +;; racketscript is stored as a js object, +;; ($/typeof obj ) +;; will always be true +(define (js-object? obj) + (and (not (string? obj) + (number? obj) + (boolean? obj) + (list? obj) + (symbol? obj)) + ($/typeof obj "object"))) + +(define (null? val) + ($/binop === val $/null)) + +(define (undefined? val) + ($/binop === val $/undefined)) + +(define (js-array? arr) + (#js*.Array.isArray arr)) + +(define (msg->string msg) + (cond [(undefined? msg) "undefined"] + [(js-string? msg) (js-string->string msg)] + [(or (js-object? msg) + (js-array? msg) + (null? msg)) (#js*.JSON.stringify msg)] + [else (format "~a" msg)])) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/universe.rkt b/racketscript-extras/racketscript/htdp/universe.rkt index e41d8be4..fa59ddf8 100644 --- a/racketscript-extras/racketscript/htdp/universe.rkt +++ b/racketscript-extras/racketscript/htdp/universe.rkt @@ -32,6 +32,7 @@ (:= #js.this.interval (/ 1000 *default-frames-per-second*)) (:= #js.this.handlers handlers) + (#js*.console.log #js"big bang :3") (:= #js.this.-active-handlers ($/obj)) (:= #js.this.-world-change-listeners ($/array)) From ec31420b9383de8df879fb9ac57ef9c576f94d5d Mon Sep 17 00:00:00 2001 From: leiDnedyA Date: Wed, 16 Aug 2023 11:46:36 -0400 Subject: [PATCH 2/5] added htdp/peer-universe to racketscript extras --- .gitignore | 1 + .../scribblings/peer-universe.scrbl | 73 +++++++++++++++++++ .../scribblings/racketscript.scrbl | 1 + .../racketscript/htdp/peer-universe.rkt | 10 +-- .../racketscript/htdp/universe.rkt | 1 - 5 files changed, 80 insertions(+), 6 deletions(-) create mode 100644 racketscript-doc/racketscript/scribblings/peer-universe.scrbl diff --git a/.gitignore b/.gitignore index 6b4aaf7e..cb9753a8 100644 --- a/.gitignore +++ b/.gitignore @@ -2,6 +2,7 @@ compiled/ coverage/ tmp/ js-build/ +racketscript-doc/racketscript/doc # common backups, autosaves, lock files, OS meta-files *~ diff --git a/racketscript-doc/racketscript/scribblings/peer-universe.scrbl b/racketscript-doc/racketscript/scribblings/peer-universe.scrbl new file mode 100644 index 00000000..6684201d --- /dev/null +++ b/racketscript-doc/racketscript/scribblings/peer-universe.scrbl @@ -0,0 +1,73 @@ +#lang scribble/manual +@(require (for-label racket/base + 2htdp/universe)) + +@title{Peer-Universe for RacketScript} +@author[(author+email "Ayden Diel" "aydendiel@gmail.com")] + +@defmodule[racketscript/htdp/peer-universe] +@;{ + for some reason I can't link to the 2htdp/universe docs, so I just linked to the htdp docs instead + } +Experimental implementation of Racket's @racket[2htdp/universe] library for @seclink["top" #:doc '(lib "racketscript/scribblings/racketscript.scrbl") "RacketScript"] using peer-to-peer connections. Used to create distributed programs where both the server and the clients run in the browser. + +@itemlist[@item{@secref["getting-started"]} + @item{@secref["how-it-works"]} + @item{@secref["differences"]}] + +@section[#:tag "getting-started"]{Getting Started} +Since this library is primarily an implementation of the @hyperlink["https://docs.racket-lang.org/teachpack/2htdpuniverse.html"]{2htdp/universe} API, use those docs as your main reference. These docs will contain info about how @seclink["Peer-Universe_for_RacketScript"]{peer-universe} works and how it differs from the original, but won't contain an in-depth API description. + +@margin-note*{ + See @hyperlink["https://github.com/leiDnedyA/rs-universe-server-test/blob/master/src/app.rkt"]{this example on github} for an example where the landing page has the user choose whether to start a @racket[universe] or @racket[big-bang] instance. +} + +To use the library, you need to be running a separate @racket[universe] and @racket[big-bang] instance at the same time, both in separate browser windows. You then need to pass the server's peer id (which is an optional argument for @racket[universe], and logged once the server is started) to the client's @racket[big-bang] call, and a connection will be established. + +@section[#:tag "how-it-works"]{How does it work?} + +We use @hyperlink["https://peerjs.com/"]{PeerJS} under the hood to mimic client-server behavior where both the client and server run in browser tabs. In reality everything is done with peer connections. + +@margin-note{PeerJS's @hyperlink["https://peerjs.com/peerserver"]{PeerServer Cloud Serrvice} handles all of the traffic behind the scenes so that you don't have to worry about it.} + +@section[#:tag "differences"]{Differences from the 2htdp/universe API} + +In practice, this library only differs from @hyperlink["https://docs.racket-lang.org/teachpack/2htdpuniverse.html"]{2htdp/universe} when setting up connections (plus some slight differences in dependencies). Here's everything you need to know on top of the original docs. + +@subsection{Differences for @racket[big-bang] Function} + +@italic{Original @racket[big-bang] docs.} + +Differences from the original @racket[big-bang] API include: +@nested[#:style 'inset]{@itemlist[ + @item{@racket[big-bang] takes and optional @italic{#:dom-root} keyword argument to specify a root element for the canvas that big-bang draws to.} + @item{@racket[register] takes a @racket[peer-id] argument instead of an @racket[ip-expr].} + @item{No @racket[on-pad] clause (as of now).} + @item{No @racket[record?] clause.} + @item{No @racket[close-on-stop] clause (yet).} + @item{No @racket[display-mode] clause.} + @item{No @racket[state] caluse.} + @item{No @racket[port] clause.}]} + +@defform[(register peer-id)#:contracts ([peer-id string?])]{ + Tells racket what the @racket[peer-id] of the @racket[universe] that you want your world to connect to, instead of an ip address. Because of this, racketscript-universe has no @racket[port] clauses, as they're not needed to connect via @racket[peer-id]. +} + +@margin-note{Because our peer connections are handled by one server in the cloud, clients can connect to servers on different networks as long as they know the server id.} + +@subsection{Differences for @racket[universe] Function} + +@italic{Original @racket[universe] docs.} + +@nested[#:style 'inset]{@itemlist[ + @item{The @racket[server-id] clause can be used with @racket[universe] to specify its peer id (which gets passed into the @racket[register] clause of a @racket[big-bang] call). Note that two servers should not have the same peer id, or problems will occur.} + @item{@racket[universe] takes and optional @italic{#:dom-root} keyword argument to specify a root element to insert the logging gui into.} + @item{No @racket[port] clause.} + @item{No @racket[state] clause (yet).} + @item{No @racket[to-string] clause (yet).} + @item{No @racket[check-with] clause (yet).}]} + +@defform[(server-id peer-id)#:contracts ([peer-id string?])]{ + Lets you specify the @racket[peer-id] of the @racket[universe] that you're initializing. Use this @racket[peer-id] with the @racket[register] clause in a @racket[big-bang] call to connect a client. +} + diff --git a/racketscript-doc/racketscript/scribblings/racketscript.scrbl b/racketscript-doc/racketscript/scribblings/racketscript.scrbl index 591709b8..2e9c1653 100644 --- a/racketscript-doc/racketscript/scribblings/racketscript.scrbl +++ b/racketscript-doc/racketscript/scribblings/racketscript.scrbl @@ -17,3 +17,4 @@ possible. @include-section{start.scrbl} @include-section{ffi.scrbl} +@include-section{peer-universe.scrbl} diff --git a/racketscript-extras/racketscript/htdp/peer-universe.rkt b/racketscript-extras/racketscript/htdp/peer-universe.rkt index 520fabb3..cedf4363 100644 --- a/racketscript-extras/racketscript/htdp/peer-universe.rkt +++ b/racketscript-extras/racketscript/htdp/peer-universe.rkt @@ -2,11 +2,11 @@ (require (for-syntax racketscript/base syntax/parse) - "universe-primitives.rkt" - "jscommon.rkt" - "encode-decode.rkt" - "debug-tools.rkt" - "universe-server.rkt") + "./private/peer-universe/universe-primitives.rkt" + "./private/peer-universe/jscommon.rkt" + "./private/peer-universe/encode-decode.rkt" + "./private/peer-universe/debug-tools.rkt" + "./private/peer-universe/universe-server.rkt") (provide on-mouse on-tick diff --git a/racketscript-extras/racketscript/htdp/universe.rkt b/racketscript-extras/racketscript/htdp/universe.rkt index fa59ddf8..e41d8be4 100644 --- a/racketscript-extras/racketscript/htdp/universe.rkt +++ b/racketscript-extras/racketscript/htdp/universe.rkt @@ -32,7 +32,6 @@ (:= #js.this.interval (/ 1000 *default-frames-per-second*)) (:= #js.this.handlers handlers) - (#js*.console.log #js"big bang :3") (:= #js.this.-active-handlers ($/obj)) (:= #js.this.-world-change-listeners ($/array)) From e27694b890943213022bfdad488f61aeeb5b6f9c Mon Sep 17 00:00:00 2001 From: leiDnedyA Date: Mon, 21 Aug 2023 10:59:34 -0400 Subject: [PATCH 3/5] added randomly generated funny universe ids --- .../scribblings/peer-universe.scrbl | 3 +- .../private/peer-universe/universe-server.rkt | 3 +- .../htdp/private/peer-universe/util.rkt | 87 ++++++++++++++++++- 3 files changed, 88 insertions(+), 5 deletions(-) diff --git a/racketscript-doc/racketscript/scribblings/peer-universe.scrbl b/racketscript-doc/racketscript/scribblings/peer-universe.scrbl index 6684201d..e19ebe43 100644 --- a/racketscript-doc/racketscript/scribblings/peer-universe.scrbl +++ b/racketscript-doc/racketscript/scribblings/peer-universe.scrbl @@ -60,7 +60,7 @@ Differences from the original @racket[big-bang] API include: @italic{Original @racket[universe] docs.} @nested[#:style 'inset]{@itemlist[ - @item{The @racket[server-id] clause can be used with @racket[universe] to specify its peer id (which gets passed into the @racket[register] clause of a @racket[big-bang] call). Note that two servers should not have the same peer id, or problems will occur.} + @item{The @racket[server-id] clause can be used with @racket[universe] to specify its peer id (which gets passed into the @racket[register] clause of a @racket[big-bang] call).} @item{@racket[universe] takes and optional @italic{#:dom-root} keyword argument to specify a root element to insert the logging gui into.} @item{No @racket[port] clause.} @item{No @racket[state] clause (yet).} @@ -71,3 +71,4 @@ Differences from the original @racket[big-bang] API include: Lets you specify the @racket[peer-id] of the @racket[universe] that you're initializing. Use this @racket[peer-id] with the @racket[register] clause in a @racket[big-bang] call to connect a client. } +@margin-note{If this clause is not provided, a random id will be generated and logged. Also, note that if two universes have the same peer ID, conflicts may occur when users try to join.} \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/universe-server.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/universe-server.rkt index bfcc7144..a699b927 100644 --- a/racketscript-extras/racketscript/htdp/private/peer-universe/universe-server.rkt +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/universe-server.rkt @@ -35,7 +35,6 @@ on-disconnect server-id - ; peerjs Peer) ;; Adds peerjs exports (primarily Peer constructor) to window object @@ -80,7 +79,7 @@ (:= #js.this.-active-iworlds ($/array)) (:= #js.this.-disconnect-tasks ($/array)) - (:= #js.this.-peer-id DEFAULT-UNIVERSE-ID) + (:= #js.this.-peer-id (generate-id)) (:= #js.this.-idle #t) (:= #js.this.-stopped #t) diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/util.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/util.rkt index 0ef0859e..409e87d6 100644 --- a/racketscript-extras/racketscript/htdp/private/peer-universe/util.rkt +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/util.rkt @@ -4,11 +4,93 @@ syntax/parse)) (provide format-js-str - (all-defined-out)) + generate-id + js-string? + js-object? + null? + undefined? + js-array? + msg->string) (define-syntax-rule (format-js-str fmt-str args ...) (js-string (format fmt-str args ...))) + +;; +;; Funny words courtesy of ChatGPT +;; + +(define funny-adjectives (list "bumbling" + "quizzical" + "wacky" + "zany" + "fluffy" + "bizarre" + "hilarious" + "whimsical" + "absurd" + "goofy" + "ridiculous" + "loopy" + "nutty" + "eccentric" + "silly" + "quirky" + "jovial" + "giggly" + "mirthful" + "haphazard" + "chucklesome" + "fanciful" + "droll" + "boisterous" + "offbeat" + "hysterical" + "peculiar" + "lighthearted" + "playful" + "amusing")) + +(define funny-nouns (list "goober" + "banana" + "sock-puppet" + "llama" + "rubber-chicken" + "pajamas" + "gobbledygook" + "poodle" + "bubble-wrap" + "tater-tot" + "cheeseburger" + "wiggle" + "snorkel" + "ticklemonster" + "jello" + "balloon-animal" + "slinky" + "spaghetti" + "bumblebee" + "dingleberry" + "flapdoodle" + "doohickey" + "noodle" + "gobbledygook" + "whatchamacallit" + "snickerdoodle" + "popsicle" + "gigglesnort" + "wobble" + "hootenanny" + "noodle")) + +(define (generate-id) + (define adjective (list-ref funny-adjectives + (random (length funny-adjectives)))) + (define noun (list-ref funny-nouns + (random (length funny-nouns)))) + (format "~a-~a" adjective noun)) + + (define (js-string? s) (or ($/typeof s "string") ($/instanceof s #js*.String))) @@ -39,4 +121,5 @@ [(or (js-object? msg) (js-array? msg) (null? msg)) (#js*.JSON.stringify msg)] - [else (format "~a" msg)])) \ No newline at end of file + [else (format "~a" msg)])) + From 820f306a8f797c8ff76d6c071fdb7d750cbd954c Mon Sep 17 00:00:00 2001 From: leiDnedyA Date: Mon, 21 Aug 2023 11:39:53 -0400 Subject: [PATCH 4/5] added and documented function to generate an HTML server/client start form --- .../racketscript/create-login-form.png | Bin 0 -> 11958 bytes .../scribblings/peer-universe.scrbl | 96 ++++++++++++++++-- .../racketscript/htdp/peer-universe.rkt | 7 +- .../htdp/private/peer-universe/login-form.rkt | 66 ++++++++++++ 4 files changed, 159 insertions(+), 10 deletions(-) create mode 100644 racketscript-doc/racketscript/create-login-form.png create mode 100644 racketscript-extras/racketscript/htdp/private/peer-universe/login-form.rkt diff --git a/racketscript-doc/racketscript/create-login-form.png b/racketscript-doc/racketscript/create-login-form.png new file mode 100644 index 0000000000000000000000000000000000000000..039de814c2ac2ef55a20f21cc60239269a94698c GIT binary patch literal 11958 zcmbVy1yCK|vnGT0m)%Z0Yh{WfOq+jCWcJLVpQ{wm=&Z$4Vr;5aEAHHU#Fr3N#H? zrUFaOm5+D?@?}bzgQB6q5oqF1uq0Wu%}aj)1v`qq)ik_B07ja+%u7IaBrIg8>8u+M zJ`cYA;fBKm-T^l#-GLSq`CR~(Sj?V0&&C;wSPaLTVJUXc*RYyo7;;!wA{HvPJCXPc zaR9a0H&Gak*dNhf8;RKour0;x`Tj)^hi>V9xl9cW+xM?KT3$LAY;d~FjRmtx`RrS_ z@^{R@T~MCf(MxYiR(*u{DWXLku^1EN10x;q)hrGhJw_D;4gJ8A}7jK{Z z8-B2@zpB4(%#U3!(u?CwEUdVP>WCRjcM0~e`t&M&iSg?{XkeL$U<1m|h zL4;|S^mzww#%D;n`U1QmA;(~ohx&Zk%e{eb^0*EvL5y;op>n((nu(P~<&SA$B~{#A zjbxZ87l(f86$biC=JuVf_A;GTyu@aGA>BtDMDlGY;S$KuTCWv`C?5I^L>JVf1tbwE zF#@OfKN&jC)TWdPl*gn|L}(J_>VyJY$cgrvL7!3x`5A;~*$EjAFO<`ZY#Z{OhcGtgz}M*f7{}kh9h!>^)lrw)2blt< z<<_KQD5++MC3Et(X1MSUtaH-o``!Cuv)ltm58j|Z$c!4BJ{i09rZu_^%hZfPTOPo5 z@zM+U^Tp$^ogM!$`05p>GbQzU8u+F1_4QYabtJJ?zb7s`W=#QQYXU;v$c!>$+bw8R zy&Aaua&ZDn|4;RHg>YbFTsuN`&5^(cJWLmEc#NYr_-1P(%FyrJBfA_e` zLKvOE+lwn)w|BfA={yP_yx2pXC<&ppq5C6D)f;?61(X47XS;D?K5RjVrKzH6)OS?r zTao!R`&w>LR=5+$i8=sMuRMYaks&!>H-BTLg4|t(vRu`GGPRoyXec?BXMGheW{>|J zLG7Cij>dId`;qdYDhF#1OGCy`5hAo9KI6FH&Z)ulwX$OGyYSxJ=xFGBeS$m?3HauR z)uY*E-rzry6rFXvU8Wy8YO{7;DiHO7SWzv$WpfE3kBf9!Sn? zDJ5#S+KrPs(Kzea`thiE37{|>s|cLapj3U>uSscPQOwmGXJxZ^_qgw9C2ag*WYIrN zf34X`;I&l=i2}TWHiS@$(Q-0$zw2F>=*tMLDwV0^4~Edi$zgd(^%&luclgEV3mG?5 zbGi|)h|dW2oL$_YVYXi(Mxw!W(jphN2C^ljQSSKPf2!|crR2{yRKBxZC5>!LC+Hz1 zkPRoYf5ecxb0J&_Z3;%Oix7a+OK%s*PpF5Rb`n2R!yvkAq7twJq3ey#2u^EI1hdpfM1A)wN-(k5CdG~VfA@F)!w=)kEw2}4x}OL){f^D&f7%7Svu$xe!914~ zW#TCE#}Y?`cN@w(_y4bM`{>Vx>9#maqzU(6C1Va(4dtiFZcDpgaVGC8VtprMumG3c zRh6`c%&~#!iwCWzk-8~cLjVvya`qT=@)AR;{Y2`toQmjOmc0S7LRB`8QIhbkqa_e) zE@`1=E-CumnT zG-O0j{w4X2#iea7=3_SQEAzpP0DRr-v7@@w3zO8Pe98Exj1d{#1I%UKUbHaXQZ|q( zIy$EOibJh5l+AOaFE&AeuJhr0ze>gQa1qI%DIVq+Y8Wm4KB8+>-4s}#Fo8KEaBNDK z$2mQ*#;n&`q&vx&=fgTwd&sfowDRo2zhAdG3Dyu(zh>z=;9fwmYWPg!&F&lf`zh#n{DH&h7 zd#YeyzN4)Ckq{^QwhekpH&}CgU`RVH(pg~tbNIzQ6`PNLk4t1u<~Am+#9NP)wuc<(EcWZZx3q6>ZxoNuwPKgP z^Y17_O5;$9I8s@oRhlAyEvk$XCoSmndJWHB;dSfu9$QmZq8=1Bj>WIO>Hu~8BT&CQ z$h`%~;saMvi;%t)YsNm=S#{$h>h>Z#0(dykvkgv|Y#x-nLTPkq3hgNQ0%UxVQg3$C zt+!8fH6j)4>!BC1WsqNQGfSAFRC6cK4^>SNFdW$+HLG)PX*Mlj1G|0 z{!&Lfg(fB0m5S;8<7spA31PDdz%t za3YJ~)&G=;&44BwqH07=ZJj#XTFk@Yjp|`k7DqEo2a4qkdYwC>&L@-2j^quRXUDB` z{*=gFYqnXXBI?#tX~O_*f~L*qcztQo&Sxem!%}iV4-UCC=%a49EM3NaGz}3nd`<(B zy>4WrYs}lBc*-7b+rxHa2hvy779i$YFQp#bszU?k2m*=)$NTBGzohy}xZu{hpt!+r z3NJdVN19;rX>S}hn}hbIQ8{Qb6drHEA|B!|j(AxF=+a&p{w-F~X&S#&WpnIt1X10q z^mS|`;8L(3>o>5a?|S%1kJ7h#7UMhKz6(7#X&vpjF4S?Q%$JoTY^|6?|DwY0;Ckz{=VfZfVQSXz@(4w09pjD8@WG0k^pcI2T0YW^y5i!^%;o2#SIhR86h(9;ckR1!eTs8cKJLx8E*}@mj!9LRUC3xec!$ zAfPGvs*H0lQ@wVLt4^w4)0Ar=BGbl^Vx}uuCFzj!zVmq2nb9IWYc49$mEGG!`fHLk zB&LU0F>lj6wHb$Wql1X^EigRP8#3EsD!D%G@qCA6qZgK3{I~4B zEb4D?S{V`PV9f}4S)g>+Y)jY(R8TtBdH2wJRpA zlXH$U{T8DM#WW*~kE6U)%4pA&^aDWp5b3gP8e3AZZ(wJ(u#m7UUF#URlLI4bNJQ<% z=Z1o-Ei7rHacV!m`+lNCkTz}Aq&O#T*X{VMi8so#F?bAb{in<1bLK$^P=nsb%+H}= z@3OqTHJAdy&ASFJL4_%b)O3hfQTpwaM3sgu2j4_jT=Bbu$;d?m(+f=7YjxYSKk>Ty zUIYg5v4{A7QZLOJIPS;s5g#wmC!dP%-PZgQx+|OiLv;o7)!FO89770ZD+j-yoDAs` z(P7++`Z)S&y-#&QAM`f()fA26-S&XYDsP4(-k2!{=t#uzZuqSp$qvbyMT5iwN|;_e zYsk;yDel6(R+(B~+V{(eTpm_|a^CETtc9a1cvAPRG$TF}??MXh0%PD zoa<9hN+&}YPPV-W(e35^??a|gIcal8-kF@)QaR2Nxpz|{?;HnFPiwONqQ7^3(UnP9 z;gvs$`f_+lgJ+e-{7!xmaGU0#}mP>5tLRH zCGVj36bqOpp*g-=nxW3Oln{;K<$y_p{X3CFG^%8#cisKOX}@n=-V3Ni1_SZ@TteCG zk8kx*B9w%PcAMyX7NNV(JBVoN)HO$oe&e)iJ^^s2qg)2}VdAaQ@x$eynT-mV)_re8{J$p)4BXP2S}~t#cE&xW zt!H2Q;bK}^P~dtDXtxf{TWT?9VSD2j&zn1XJ1l{_`)w|qL*L_ve(>Vu&23w9A}*OP zJ*u+dOMk4%wSn}Ey1mB*hhfFq@Jau+q@oA%n<@q~3j`H2P??de3yIf<_vPhNavfz@ zYNnpnzZJNbG(Hwq-2GL=jAXh*+i4cQq@k?T`hT)MN?333`u5c>fKEq<>+7mT3SjTA4j+WKH|jNl6e+08!V|!(UQfA&OO+Jq z)aY)XmA1KV?88g?^f&Hf2U0}_nS?I4y25ySdw&K?_0c+_Xz(6Anu81DE5c0Z0|LU5T7FSc1?KF}4eJ7ncp`|fHGpj@Q`%cv8xlvXci?+?_Fj_!wwTnwH zPz4S}|AGU=oHGd)brHf!!qmc<&2VRzB&V#P6Cw$YKb#d@xj{yG@N6(03rAB2C65|B zH-4(oZ(LWcF%E-ukP{rTi3(;R46IfRMr1_K`K-PCCSl$f9K9Mrw7uS#3Cfl`Q^TTY zoV$Cza6aW8=qP3q0+%9-D+;^3=1QUcVuUvmNMD-0)n+~*h0PPE-Klkd*t8eSPese= z9#*~KH>Nh}JbUS$o&+GLBFy}WcOHaOeB5gK?6g{Tm9 zb@2rWv|9iCZb{-CwVod$ghsuH5HA{|$4cnvR2^jMK_zXf1UqX(RasnQ+ENuPdHIO! zq7*z=0&C=)YFe*BMy5@Lg-K@50ZelIrzoezn0FT3YuhA;|EH4gu-_@WHWiWyc3(NM zZ}~wOXet?n7CJ&MA6n&&xx(->C|58voD_)RqfJ=4`sA_ceusJ%x|#Nwoak&{VIARQ zRxsJ0?scQGpSu&V|Mqp7JkWGB6h%EjuDsetXC6jR9!<}^!vx6V&01vd@bp%DV&~P3 zK}4pFk{z7P3ggb0f9ixfumrDeHEHVTYn>%ACy$Sfl%VE8-r?G~mj-3%g~caeIjK0G zB0s|Or6Q_oeJ{cPdhp^(iktb>$xlllIHh8+e;v=_QF`I6B)%~7;Rs4u^+(d zH;tLMex<{!9hFLIF0I3jk{>>s*MMGkznrn�P_BgWB;M&(}vm<~UODyLPc4rvvqA zlB3Igg;9UJI{J&}StcNVCU22SmA5Kq0|p(CFkQ&7=9wsK&14uwNqXG4Ms7 zZoPU{L%r(p+vLpD`U+BpY>%j_rT*%znjzjApK82-#|FOmr8L30zHDl$X)V8oGXo@G zwcrw$%H0LJ;B>VNR;|S^@P*B}GPTz|5x;E|nN7ku~&lM$}f zxvzNG!mF?(qxi$WqZj=vmjRsRx(a;Q8&TmDJdxFy%5l%?G#a@VgeErJF_VJY_uX@} zW7#|X7OqbZU@Qho=^7@^xbib@!&j1&t22Fukye>@3SR~%X!e2<@V7#)1X{S3`9Qq2 z-idZKLn9j!dfKGgCd#2;957UcR`PEP<4cnZ?FNh(TE*&TzYgs>dmKJ=$rHa%-`Bp( z9--)#<+8b0Pf-ax=XY5pC9ySnbX@ zV^0=Re)jzCf3CfFI$f6iI)+{OxI!uZsRoBNiLbl5fx{OThF{Lz?oWso zZ0Gz5mm#dUa*SZ0Ad}l?7&~!R>B)}9H>k1hHKA~eM;d|2?%=XlcAKsy5ic7|C2Kr@ z{Fnh$-UgaP8(4D3$U%}X$U7G%Jz!@)X=x0Tgb$T?wYh5D_5BLrx1lyRm|;-`4<(35 zyP$Rpn^JM|U9|u=E)b$$eEIz~dy_WQcT2Z^0q5I~R-p+j4U45lo;aKYTB=O3Y|v~_!8YsB zFyrnG)51nx!9hYxAej{jC_vmia#8k?pJrA04{AqgW^#oETnl8L^Zr`_mpvwvmjMxB zsISNIkdV)~Une~Aj7tCdu6}^_Zn~#K+v@P5o zFZL`*kALA*!^569VQ|@LJgnZ%ygU#R-DLlr`nxIpJ2Y)Ma!hxJz-2D1V(64KT}U-p zv8E_@k>aaF(2y&aJeU%eG%zG^6Ej$$hlp}UB{;c6{Uf;$_&`B(QPGKZS>cFgRH&L= zGucm1$|}pUkWdClpkFmD)<`KC6a)>kd3(BfYfsxJ!h>FeV~N!-vFyQ;=m&=q8a=sG~ohZNAnaE=C91&O843l$&!Ax~6yK>dBB8Zi55WfHTzwD!;Fdv^kGP^3Dr?>JUW6{JkR1Ft zjv*)ev+6rQ?B*NgM?b(i!=j%=42R`kG5@(?3O5})u~w(A2OT?5Fd95y?O1E-n{H6- z9XH8;Y#L;1kS$RQwcR;V0!#mRry*+0)5vFehvX)nTJ}OSKC|)+Kc%AvRHUqwAG+F0 z5F%neY4_fUk;?G2N5n>+TBZ>rc2_ujL61PvyPac;=nRp3DLQ7Ig2U2OsHd{UPpSVTi&YYCdnFgkwOK1X#G&a331V+$9D!bD7=I-FDF_u#~eZ4R#Ky3TcKb3KT3;deZ;q(TAV+Y1U@> zFES85!u4>w+e{5#d!?YI(<1{t2^BKBXDkpUv{;U9e*C_lHBIC>3p&U`jK@4PSS-Ux ztPJfJ;Xcv{Aih6Mhf;8%|td%>FLdbKAuEI2O9HgNax}&nn1X;o03)T zvkUXP3UZ*2Sj@pS>0+`W%-K~Z=kypv~W(F@1JNDOPqGIzaT zQ{D;mcsPEUc-ZLnzG##BRLmkLRwsAac`0p(8C}z>YyDPZ<3$cA`?d})5#;*e2Wl}u zQ*!*~%}ac&p{Y>q)y7o6kd=>~y-!T`#twPON6STLYC=swP;n2xA6272Mx8&rep>EodJ>bw*wk}Tj)kT|q*{DvnTJy3G}6;5?+ zwYdC}ct?bcZMnF|W8kx*XT*6{R|-)hmzJZGULI%79j0Zv>}%J>;4Ow_v24U~!vYp_ z5=Z+XmD{e1M@hTtfvHWdLR_<}fqp})iVodlai$q=7h*{>8_e=OTtvZvo#pGWrGTF&#YeiA-Y(r+q4X zL6^>yqMX;S|MhbbEmrbr!Kb-mABg6^wRbTDjw<&kb4M_%@MP$emP->lElc(jm5jUt zX)U9%u~enO2sG+S4_v)j8QX4o*Mk%$YT-r`$4ae2T0cNWdycJ8GH38%=fB z_?_`x9e-Y=;mygWz_feQYF_D(vSxM8HYb=eSbv%7f0j$g)p9LJ# z$VlEA!2M7dePfj{Jubt{P4(^Wg*#P4Fjsj73H)`h$H|bMNEhqf#hLtSan&)J&^XdN zw?ew*Wiq*Qz2T~EK~Z7Z>r@LW$cs9h?7hbJN`Gk=`te?xFcFC{hW^<0bXd{$)Zuou zD}Gp#+?H-iF%fdVb;8hLY;{5OFDJ9 zE6r;W2D&a4k8MiGHKhEhGN)Kik_y4*YJXiDtc_ zq|Z9fzqN!KL~8HOYI;d&Dtk^Bj?X6q9-tOgy13=AD+-i#BV2|VXg5IGfTYbk=TJC? zFOZKc^{?};HvEVlI@Lu@l2FYtk=ji9>e$BU0)aAG`4|_w`bbT@e4o<54K6iFEdWZrv_R79@#0YnFg+K1s>17Z(?-K#Ew$ z-mk8G8y#MpJUl#~KYtEaOtUTy4TU$iuy8x88MJm*AU^(sZ5wXIl7>e*2LTBQ`EB+& zI{$5GnDM`L;{UBPh3HdV)!B~*6)c6h5eyw%izXS6PJFDZf7!@{>digI*+J7kLG zswMWsgY{<7k62^5fg3pQ9ADoTp@>+*43nF=9^N^)N2pX%jHdf_1avs!BKD-*3ka%# z@xNg4J?DBx`-5S*2AkR$oK2`)qS-bb@IgR;{K-A=HYms7%^h{D5Po#;9?lyOo+z56?k{6F<|Xr2fWAz}+L=$SMQ}TeBIIlS}8=--i3Sq)M_QMI5R{ z6P*p=0tomKtDp6>v5sN5HM$z_oB`oC^nKQzDSbdPgDa*jKzk-;Ea~*iqSoHMUGG~a z_4a0*ScU~3WIU&V+Z8_R3RP+GX^X~IGQFcquaSyotS`#f#+K4h;{;y*LaOJ{I4E!b z+egZi(&trqz1Vk|>P>O%Q-Ax7k$(KPTzS3%0*{^8IjcT@uZ}#ZQ!5%aP{;VCstFp$ z5!>dWF$C14a~T?%(N_Z)RjJqx+CN3N=BHhnT7T!MgNGlYrfaph(4i+LCdl8-i}IkF zd#y7Z@Ko&v+|Hcl0B!!PE?tJp=t;!7&5=vv%jMzW1QfFudkdIOa~TSBSgmo^bdS5n zWjm$?_n}f{Bk#h4sy;7dS|YC#ad7aNk^s<4QvPMZHe930uMmgz;*~_fnXu&_W1Hix zIz@JKZY*I3Sgnh2(!}&&uH{MY;R^=F@p0o)`-K|gLlZ3T1j#wPP3`_Bvx&{2kv%5y zr*!oXby<2i2Arr3_te^MOA)2#RBCOOcy4Q>2klkJ9@k=QrNhLR?s50s#xseMCM)&F zzg%pyzDdQ7_2uP-lGx3{<v=rG}KUsaZf@bAqkfR{DL z%C*?uGK`M#U?%j@J;KsD7nfCh{x(B+w>7DU+Gm8uMZI8+$y2u=PfhT*Dqh^6+v|#7 zk!oTO{SZr~OKcV#rz3xg4kFY0u?$>h>ACt5SCYGoEH`Sy`3_MkRbyf3K8(-*Oq3S> z8!yn>HDDahItfGO0f}gCug9Nc`3JQHDa#5XM=5w!j4H0GNg6lXzcrMye9fc105OHZ zj3taT!nGlmDSMk!-^ZX}bK)UiaDzjB=)jZ}Y>GJRiGR4o&S(~+UeCxPZvY3bNi?=+VBysNQ0Qqz+cJ@Xd0nN*tt8+!B9X^d(vmSmwwJSMwqL$9c zrS%r8^PC+uymgdA{p;H)zB-oAcYgV&X$fwq=StUkgt{piRmlflcXY*;m}B>!V$Z;) zTJOZc0TL9++l4%UjiI~YcMYEU)6vz)+KWSXV=E5PhZ8k$I7n~&ukXC%##6uG%UtlA zi2B{eY_Mu=Oq+tUQ%0G-%gHC>*S?Q1G-xuwwQ$D8vBQmhe1O}bE7O|fLB>B^2wlFG zIXF%G1gCoC{_Rq#FB?mAj7MtrnF3tam7db~JFU!CLj17(=O7rot`b~pRA)ad9QlC8 zEL_mld9u{d9y%3aBM<&7qS|n3z_OW_y;hfEP;@GmRrGc8t+-1)W1!WGhS&s<_vT1# zGeEJ&-Snrvv`ht*h1;Kh3y5(!8o^T9Kh$%MByw(KWIC*2aHa>op^QA8MX@X2e4`*` zT*aW)HF)d?N$|_@4|X%%3=qd-1Bc#6yEOc*?pk%84-n@#3W{3 zO89&7V5(>E$`d}|ee!QxjN#Ui15yoJyS3{E>M^GQ*uUb2Y`?)VRtnFMw<$R|%TXqs z8a(NgzppZFXD2USu*KEL={cfm5})}F9QR2 zbC=H5PndD^uF|AODzw#)Dic4vm;+)7CE>+4y?QyQDka19y&mXK-gO9V3JPjX3vtJd zu*<`;`s=Tl_wE^gB4&pN(Qd2`?F^|&K8GOjD0p5yPFk*59UimUH07Fq=O=CQ9>tap zP2+ugP-3SFhn&bdEo0RuFtGAl-gp^U^2|2dR zxWNM2&sidsSh)=?6%mmy%BTDblE7Na-PjLRDW~Fc+IGxFQ0->Z zvAa``KAag#-EYz{KA$Yxo{F5U+6}TxGm*jYyQ4ilaAbR^6qz5 zCw5axNO@Mukh{j0gB#HBQhg-zwelK|*x=?ewh$c2eHX$Q{wmNC+9m3Anf@4PoE*8N zEG}QPi<;VZ(b4L;z;S|8v1OJ$$qW0U!g;O?eaLyndog}C$}ajGtv=0rxFzd9Fc;Hw zxTRFrw@`{_=&5UTLz{cn+PT;hu{_PV9l$02#u*hb{w65&tYZo3=NGqyz=&rZm%?>? z!`rJ0jTyC}6a2tY%o#5-+z(RT4<}?xyr1mTKPt{WLBo=KYt}1##O*~ll5tj$O-E!y znoZBWTc?xkR)*E8NiANLPz7~yEm%z+=q}5ZQbx(g#to!GhYiy`$GxbcO+Xl+r(2CH zdZ`L1HKat=ynTM`HG#(7Q(~RKk)m^JFE2t=mh;)|V^(L=&yO#zABsk46 z-_`A8gsHw8lH+;Ag7<49&Nh6aV}HAydE1eE6tejvR5ABu{v9Nm0lUsRzZfa>MiJbS zp>l&8I48N;X;R3Q@K0lB*;I`RTe`=lUvb^YJvk8G<^~m?NzOg*PQ<+vn*Xc==Jl*i z2Q;+=gpKjXEBQZ5eey>Y`*uOFdz@hCsVL&$!02QIR73S(b)g;QdmCQ>jb266Tx#~= z23=NrS2Bv|=!nQmey$@rye```xlIw_q6N4n&242afw_ljO`()%dHej0uwTYmQu?UV zLhu}-6SilQ-?})&FC>iy6VY~jw#P&!#|@ToUo&dunqABo_z!PYQJ;}dH%>2~q@mvv zY;HCp(Iu@X40@|D8Ey2w<8GAqA}2|21JhEx2I<<6T-GGcxDQJxZAeYEf5AL2uIan6 zvu3C&;alhz?lM|>6lFQy)uhsPAs-g!uaP)h~)&KZn=vgXq0dk!F2bVzo8}Yur?1 z7B!et`W83zZabUms2+I=rBVjGMrXidya}u>#M;Z>hPM%2^MXFeZ=oicZpQg5Ki3V@ zSgdxUd|r0Pt^YV??CH3O{qKp&*^mKNbXXtB8rDY&#i}MG1Pv3wMSlSMf&GvGu&!PS z0a#mXFdr3#*e17q_Zf*hY%Bz7OWJ|_5Uxm C9*gS$ literal 0 HcmV?d00001 diff --git a/racketscript-doc/racketscript/scribblings/peer-universe.scrbl b/racketscript-doc/racketscript/scribblings/peer-universe.scrbl index e19ebe43..14c66c72 100644 --- a/racketscript-doc/racketscript/scribblings/peer-universe.scrbl +++ b/racketscript-doc/racketscript/scribblings/peer-universe.scrbl @@ -1,6 +1,11 @@ #lang scribble/manual -@(require (for-label racket/base - 2htdp/universe)) +@(require (for-label racketscript/base + (except-in 2htdp/universe + register) + (only-in racketscript/htdp/peer-universe + server-id + register + create-login-form))) @title{Peer-Universe for RacketScript} @author[(author+email "Ayden Diel" "aydendiel@gmail.com")] @@ -13,16 +18,17 @@ Experimental implementation of Racket's @racket[2htdp/universe] library for @sec @itemlist[@item{@secref["getting-started"]} @item{@secref["how-it-works"]} - @item{@secref["differences"]}] + @item{@secref["differences"]} + @item{@secref["page-setup"]}] @section[#:tag "getting-started"]{Getting Started} Since this library is primarily an implementation of the @hyperlink["https://docs.racket-lang.org/teachpack/2htdpuniverse.html"]{2htdp/universe} API, use those docs as your main reference. These docs will contain info about how @seclink["Peer-Universe_for_RacketScript"]{peer-universe} works and how it differs from the original, but won't contain an in-depth API description. -@margin-note*{ - See @hyperlink["https://github.com/leiDnedyA/rs-universe-server-test/blob/master/src/app.rkt"]{this example on github} for an example where the landing page has the user choose whether to start a @racket[universe] or @racket[big-bang] instance. -} +@margin-note{I reccomend using @racket[create-login-form] to quickly and conveniently set up connections between your clients and server.} + +To use the library, run a separate @racket[universe] and @racket[big-bang] instance in separate browser windows, and then pass the server's @racket{peer-id} to the client's @racket[big-bang] call, and a connection will be established. -To use the library, you need to be running a separate @racket[universe] and @racket[big-bang] instance at the same time, both in separate browser windows. You then need to pass the server's peer id (which is an optional argument for @racket[universe], and logged once the server is started) to the client's @racket[big-bang] call, and a connection will be established. +@bold{IMPORTANT:} This library requires you use the @racket[racketscript/htdp/image] module, which implements the @seclink["image" #:doc '(lib "teachpack/teachpack.scrbl")]{htdp/image} library. Refer to the @seclink["image" #:doc '(lib "teachpack/teachpack.scrbl")]{htdp/image} docs for help using the library, but note that some features are not yet supported in the racketscript port. @section[#:tag "how-it-works"]{How does it work?} @@ -67,8 +73,82 @@ Differences from the original @racket[big-bang] API include: @item{No @racket[to-string] clause (yet).} @item{No @racket[check-with] clause (yet).}]} + +@margin-note{If the @racket[server-id] clause is not provided, a random id will be generated and logged.} + @defform[(server-id peer-id)#:contracts ([peer-id string?])]{ Lets you specify the @racket[peer-id] of the @racket[universe] that you're initializing. Use this @racket[peer-id] with the @racket[register] clause in a @racket[big-bang] call to connect a client. } -@margin-note{If this clause is not provided, a random id will be generated and logged. Also, note that if two universes have the same peer ID, conflicts may occur when users try to join.} \ No newline at end of file +@section[#:tag "page-setup"]{Starting a Server & Logging In} + +The @racket[create-login-form] function sets up some convenient boilerplate to start your app by generating this HTML form. + +Here's an example. + +@codeblock{ + ;; client.rkt + #lang racketscript/base + (require racketscript/htdp/peer-universe + racketscript/htdp/image) + (provide start-world) + + ;; + ;; define all of your event handlers here + ;; + + (define (start-world client-name server-id) + (big-bang WORLD0 + [on-tick move] + [to-draw draw] + [on-receive receive] + [register server-id] + [name client-name] + [on-key handle-key] + [stop-when stop?])) +} + +@codeblock{ + ;; server.rkt + #lang racketscript/base + (require racketscript/htdp/peer-universe) + (provide start-universe) + + ;; + ;; define all of your event handlers here + ;; + + (define (start-universe) + (universe '() + [on-new handle-new] + [on-msg handle-msg] + [on-tick handle-tick] + [on-disconnect handle-disconnect])) +} + +@codeblock{ + ;; app.rkt + #lang racketscript/base + (require racketscript/htdp/peer-universe + "./client.rkt" + "./server.rkt") + + (create-login-form start-world start-universe) +} + +@linebreak{} + +Here's what you'll see: + +@image["create-login-form.png" #:style "border: 1px solid black;"] + +The @italic{Username} and @italic{Universe's Peer ID} fields allow the user to pick their username and the @racket[peer-id] of the @racket[universe] that they want to connect to. The @italic{Join!} button calls @racket[start-world] passing in the username and @racket[peer-id], and the @italic{Start Universe} button calls @racket[start-universe]. When either button is pressed, the form is removed from the document and replaced by the UI for the @racket[universe] or @racket[big-bang] respectively. + +@defform/subs[(create-login-form bb-callback + u-callback + root) + [(bb-callback bb-callback?) + (u-callback u-callback?) + (root html-element?)]]{ + Generates an HTML form for your application that allows users to join an existing @racket[universe] server as a @racket[big-bang] client, or start a new @racket[universe] server. The @racket[root] parameter allows you to provide a parent element which peer-universe will insert your app's HTML into. By default, the page's body tag will be used. If you do provide an alternate root, I reccomend you use a div unless you know what you're doing.} + diff --git a/racketscript-extras/racketscript/htdp/peer-universe.rkt b/racketscript-extras/racketscript/htdp/peer-universe.rkt index cedf4363..73a7dbc2 100644 --- a/racketscript-extras/racketscript/htdp/peer-universe.rkt +++ b/racketscript-extras/racketscript/htdp/peer-universe.rkt @@ -6,7 +6,8 @@ "./private/peer-universe/jscommon.rkt" "./private/peer-universe/encode-decode.rkt" "./private/peer-universe/debug-tools.rkt" - "./private/peer-universe/universe-server.rkt") + "./private/peer-universe/universe-server.rkt" + "./private/peer-universe/login-form.rkt") (provide on-mouse on-tick @@ -38,7 +39,9 @@ iworld=? key=? - mouse=?) + mouse=? + + create-login-form) (define *default-frames-per-second* 70) diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/login-form.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/login-form.rkt new file mode 100644 index 00000000..d904f59d --- /dev/null +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/login-form.rkt @@ -0,0 +1,66 @@ +#lang racketscript/base + +(require (for-syntax racketscript/base + syntax/parse) + "jscommon.rkt" + "util.rkt") + +(provide create-login-form) + + +;; +;; User login UI +;; + +(define (create-login-form big-bang-callback universe-callback [root #js*.document.body]) + (define container (#js*.document.createElement #js"div")) + + (define join-form (#js*.document.createElement #js"form")) + (define name-label (#js*.document.createElement #js"label")) + (define br-1 (#js*.document.createElement #js"br")) + (define name-input (#js*.document.createElement #js"input")) + (define br-2 (#js*.document.createElement #js"br")) + (define server-id-label (#js*.document.createElement #js"label")) + (define br-3 (#js*.document.createElement #js"br")) + (define server-id-input (#js*.document.createElement #js"input")) + (define br-4 (#js*.document.createElement #js"br")) + (define form-submit (#js*.document.createElement #js"input")) + + (define hr (#js*.document.createElement #js"hr")) + (define universe-button (#js*.document.createElement #js"button")) + + (:= #js.name-label.innerHTML #js"Username") + (:= #js.server-id-label.innerHTML #js"Universe's Peer ID") + (:= #js.name-input.placeholder #js"michael1234") + (:= #js.server-id-input.placeholder (js-string (generate-id))) + (:= #js.form-submit.type #js"submit") + (:= #js.form-submit.value #js"Join!") + + (:= #js.universe-button.innerHTML #js"Start Universe") + + (for-each (λ (el) + (#js.join-form.appendChild el) + 0) + (list name-label br-1 name-input + br-2 + server-id-label br-3 server-id-input + br-4 + form-submit)) + + (:= #js.join-form.onsubmit + (λ () + (big-bang-callback (js-string->string #js.name-input.value) + (js-string->string #js.server-id-input.value) + root) + (#js.container.remove))) + + (:= #js.universe-button.onclick + (λ () + (universe-callback root) + (#js.container.remove))) + + (#js.container.appendChild join-form) + (#js.container.appendChild hr) + (#js.container.appendChild universe-button) + + (#js.root.appendChild container)) \ No newline at end of file From 2b40a18feaffa66a9b93d12b1e82ca64f078de1d Mon Sep 17 00:00:00 2001 From: leiDnedyA Date: Wed, 23 Aug 2023 11:48:18 -0400 Subject: [PATCH 5/5] polished and refactored code --- .../racketscript/htdp/peer-universe.rkt | 173 ++++++++---------- .../private/peer-universe/debug-tools.rkt | 20 -- .../private/peer-universe/encode-decode.rkt | 52 +++--- .../htdp/private/peer-universe/jscommon.rkt | 91 --------- .../htdp/private/peer-universe/login-form.rkt | 2 +- .../htdp/private/peer-universe/server-gui.rkt | 75 +++----- .../peer-universe/universe-primitives.rkt | 17 +- .../private/peer-universe/universe-server.rkt | 135 ++++++-------- .../htdp/private/peer-universe/util.rkt | 20 +- 9 files changed, 205 insertions(+), 380 deletions(-) delete mode 100644 racketscript-extras/racketscript/htdp/private/peer-universe/debug-tools.rkt delete mode 100644 racketscript-extras/racketscript/htdp/private/peer-universe/jscommon.rkt diff --git a/racketscript-extras/racketscript/htdp/peer-universe.rkt b/racketscript-extras/racketscript/htdp/peer-universe.rkt index 73a7dbc2..c92c3b93 100644 --- a/racketscript-extras/racketscript/htdp/peer-universe.rkt +++ b/racketscript-extras/racketscript/htdp/peer-universe.rkt @@ -2,10 +2,9 @@ (require (for-syntax racketscript/base syntax/parse) + "../private/jscommon.rkt" "./private/peer-universe/universe-primitives.rkt" - "./private/peer-universe/jscommon.rkt" "./private/peer-universe/encode-decode.rkt" - "./private/peer-universe/debug-tools.rkt" "./private/peer-universe/universe-server.rkt" "./private/peer-universe/login-form.rkt") @@ -46,8 +45,9 @@ (define *default-frames-per-second* 70) (define (make-big-bang init-world handlers dom-root) - (new (BigBang init-world handlers (if ($/binop != dom-root $/null) - dom-root #js*.document.body)))) + (new (BigBang init-world handlers + (if ($/binop != dom-root $/null) ;; Workaround for problem with + dom-root #js*.document.body)))) ;; default args in nested functions (define (big-bang init-world #:dom-root [dom-root $/null] . handlers) ($> (make-big-bang init-world handlers dom-root) @@ -61,6 +61,8 @@ (:= #js.this.interval (/ 1000 *default-frames-per-second*)) (:= #js.this.handlers handlers) + ;; Lets evt handlers check whether they're being passed a universe or + ;; big-bang instance, so they can adjust their behavior (:= #js.this.is-universe? #false) (:= #js.this.dom-root dom-root) @@ -69,9 +71,10 @@ (:= #js.this.-world-change-listeners ($/array)) (:= #js.this.-package-listeners ($/array)) - (:= #js.this.-uses-peer #f) - (:= #js.this.-peer-name #js"client") - (:= #js.this.-server-id #js"server") + (:= #js.this.-uses-peer #f) + (:= #js.this.-peer-name #js"client") ;; Default name + (:= #js.this.-server-id #js"server") ;; Default server + (:= #js.this.-peer $/undefined) (:= #js.this.-conn $/undefined) (:= #js.this.-peer-init-tasks ($/array)) @@ -97,9 +100,7 @@ (#js.this.register-handlers) - (if #js.this.-uses-peer - (#js.this.init-peer-connection) - (void)) + (when #js.this.-uses-peer (#js.this.init-peer-connection)) ;; Set canvas size as the size of first world (define draw-handler ($ #js.this.-active-handlers #js"to-draw")) @@ -167,15 +168,11 @@ (λ (handler-result) #:with-this this - ;; WIP: handle packages being passed as new-world - ;; see https://docs.racket-lang.org/teachpack/2htdpuniverse.html#%28part._universe._.Sending_.Messages%29 (define new-world handler-result) - (if (package? handler-result) - (begin - (set! new-world (package-world handler-result)) - (#js.this.handle-package handler-result)) - (void)) - + (when (package? handler-result) + (set! new-world (package-world handler-result)) + (#js.this.handle-package handler-result)) + (define listeners #js.this.-world-change-listeners) (let loop ([i 0]) (when (< i #js.listeners.length) @@ -241,14 +238,13 @@ (:= #js.this.-idle #t))] [init-peer-connection - ; Should we let users pick their own IDs? Would that be a security issue? (λ () #:with-this this (define peer (new (Peer))) (:= #js.this.-peer peer) (#js.peer.on #js"open" - (λ () + (λ () (define conn (#js.peer.connect (js-string #js.this.-server-id) ($/obj [label #js.this.-peer-name]))) (:= #js.this.-conn conn) @@ -261,24 +257,20 @@ (define task ($ #js.init-tasks i)) (task peer conn) (loop (add1 i)))) - ;; Add beforeunload and unload listeners to close the connection + ;; Let the server know we've disconnected when the window closes (#js*.window.addEventListener #js"beforeunload" (λ (_) (#js.conn.close))) (#js*.window.addEventListener #js"unload" (λ (_) - (#js.conn.close) - )) - ) + (#js.conn.close)))) (#js.conn.on #js"open" on-conn-open) - (#js.conn.on #js"close" (λ (_) ( - ;; TODO: implement disconnect event - #js*.console.log #js"conn closed") - (#js*.alert #js"Client has been disconnected by the server or the connection has been lost."))) - )))] - ;; cb = (peer: Peer, conn: DataConnection) => void + (#js.conn.on #js"close" + (λ (_) + (#js*.console.log #js"conn closed") + (#js*.alert #js"Client disconnected."))))))] [add-peer-init-task - (λ (cb) + (λ (cb) ;; cb: (peer: Peer, conn: DataConnection) => void #:with-this this ;; If peer and conn already exist, execute callback ;; else, append callback to this.-peer-init-tasks[] @@ -516,78 +508,69 @@ (λ (bb) (define on-receive-evt ($/obj [type #js"on-receive"])) ($/obj - [name #js"on-receive"] - [register (λ () - #:with-this this - - (#js.bb.add-peer-init-task - (λ (peer conn) - (:= #js.this.conn-data-listener - (λ (data) - (#js.bb.queue-event ($/obj [type #js.on-receive-evt.type] - [msg data])))) - - (#js.conn.on #js"data" #js.this.conn-data-listener) - - (:= #js.this.package-listener - (λ (message) - #:with-this this - (#js.conn.send (encode-data message)) - 0)) - - (#js.bb.add-package-listener #js.this.package-listener))) - - 0)] - [deregister (λ () - #:with-this this - (define peer #js.bb.-peer) - (define should-destroy-peer? - (if ($/typeof peer "undefined") - #f - (not #js.peer.disconnected))) - (if should-destroy-peer? - (begin - (#js.peer.disconnect) - (#js.peer.destroy)) - (void)) - (#js.bb.remove-package-listener #js.this.package-listener) - 0)] - [invoke (λ (world evt) - #:with-this this - (#js.bb.change-world (cb world (decode-data #js.evt.msg))) - #t)]))) + [name #js"on-receive"] + [register + (λ () + #:with-this this + (#js.bb.add-peer-init-task + (λ (peer conn) + (:= #js.this.conn-data-listener + (λ (data) + (#js.bb.queue-event ($/obj [type #js.on-receive-evt.type] + [msg data])))) + (#js.conn.on #js"data" #js.this.conn-data-listener) + (:= #js.this.package-listener + (λ (message) + #:with-this this + (#js.conn.send (encode-data message)))) + (#js.bb.add-package-listener #js.this.package-listener))))] + [deregister + (λ () + #:with-this this + (define peer #js.bb.-peer) + (define should-destroy-peer? + (if ($/typeof peer "undefined") + #f + (not #js.peer.disconnected))) + (when should-destroy-peer? + (#js.peer.disconnect) + (#js.peer.destroy)) + (#js.bb.remove-package-listener #js.this.package-listener))] + [invoke + (λ (world evt) + #:with-this this + (#js.bb.change-world (cb world (decode-data #js.evt.msg))) + #t)]))) (define (register server-id) (λ (bb) ($/obj [name #js"register"] - [register (λ () - #:with-this this - (:= #js.bb.-server-id server-id) - (:= #js.bb.-uses-peer #t) - 0)] - [deregister (λ () - #:with-this this - (define conn #js.bb.-conn) - (define conn-open? - (if ($/typeof conn "undefined") - #f #js.conn.open)) - (#js*.console.log conn-open?) - (if conn-open? - (#js.conn.close) - (void)) - 0)] - [invoke (λ (world evt) - #:with-this this - #t - )]))) + [register + (λ () + #:with-this this + (:= #js.bb.-server-id server-id) + (:= #js.bb.-uses-peer #t))] + [deregister + (λ () + #:with-this this + (define conn #js.bb.-conn) + (define conn-open? + (if ($/typeof conn "undefined") + #f #js.conn.open)) + (#js*.console.log conn-open?) + (when conn-open? (#js.conn.close)))] + [invoke + (λ (world evt) + #:with-this this + #t)]))) (define (name name) (λ (bb) ($/obj [name #js"name"] - [register (λ () - #:with-this this - (:= #js.bb.-peer-name (js-string name)) - (void))] + [register + (λ () + #:with-this this + (:= #js.bb.-peer-name (js-string name)))] [deregister (λ () (void))]))) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/debug-tools.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/debug-tools.rkt deleted file mode 100644 index 012dcc4f..00000000 --- a/racketscript-extras/racketscript/htdp/private/peer-universe/debug-tools.rkt +++ /dev/null @@ -1,20 +0,0 @@ -#lang racketscript/base - -(require "encode-decode.rkt") - -(provide console-log-rkt-list - test-encoding) - -(define (console-log-rkt-list l) - (if (list? l) (#js*.console.log (foldl (lambda (curr res) - (#js.res.push curr) - res) - ($/array) l)) - (#js*.console.log l))) - -(define (test-encoding val) - (define result (decode-data (encode-data val))) - (#js*.console.log val) - (#js*.console.log result) - (#js*.console.log (js-string (format "val == result? : ~a" (equal? val result)))) - (void)) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/encode-decode.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/encode-decode.rkt index a24c039c..9ac2dba0 100644 --- a/racketscript-extras/racketscript/htdp/private/peer-universe/encode-decode.rkt +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/encode-decode.rkt @@ -5,7 +5,31 @@ (require "util.rkt") -(define DATA-TYPE-WARNING #js"racketscript/htdp/universe: Unsupported datatype being passed to/from server.") +; +; --------------------------------------------- +; +; Encoding data to be sent via json and decoded +; by receiver into regular JS +; +; --------------------------------------------- +; +; example: +; +; 'sym +; | encoded and sent over peer connection +; V +; { +; val: "sym", type: "symbol" +; } +; | received and decoded +; V +; 'sym +; +; --------------------------------------------- +; + +(define DATA-TYPE-WARNING + #js"racketscript/htdp/universe: Unsupported datatype being passed to/from server.") (define (encode-array arr) (#js.arr.map (lambda (elem) (encode-data elem)))) @@ -23,25 +47,9 @@ (define (decode-object obj) (define keys (#js*.Object.keys obj)) (#js.keys.reduce (lambda (res key) - ($/:= ($ res key) (decode-data ($ obj key))) - res) - ($/obj))) - -#| -('test "some_string" #js"test" {test: "test"}) - - -"test" -{ - val: "test", type: "string" -} - -'sym -{ - val: "sym", type: "symbol" -} - -|# + ($/:= ($ res key) (decode-data ($ obj key))) + res) + ($/obj))) (define (encode-data data) (cond [(list? data) (foldl (lambda (curr result) @@ -68,13 +76,13 @@ [else (begin (#js*.console.warn ($/array DATA-TYPE-WARNING data)) ($/obj [type #js"unknown"] - [val data]))])) + [val data]))])) (define (decode-data data) (cond [(#js*.Array.isArray data) (#js.data.reduce (lambda (result curr) (append result (list (decode-data curr)))) '())] - [($/binop == #js.data.type #js"null") $/null] + [($/binop == #js.data.type #js"null") $/null] [($/binop == #js.data.type #js"undefined") $/undefined] [($/binop == #js.data.type #js"number") #js.data.val] [($/binop == #js.data.type #js"string") (js-string->string #js.data.val)] diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/jscommon.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/jscommon.rkt deleted file mode 100644 index 9fad8741..00000000 --- a/racketscript-extras/racketscript/htdp/private/peer-universe/jscommon.rkt +++ /dev/null @@ -1,91 +0,0 @@ -#lang racketscript/base - -(require (for-syntax racketscript/base - syntax/parse)) - -(provide := - *this* - *null* - *undefined* - new - define-proto - set-object! - schedule-method - schedule-animation-frame - document - console - Math - Path2D - abs - sin - cos - floor - abs+ceil - max - min - twice - half - (rename-out [field-λ λ])) - -;;----------------------------------------------------------------------------- -;; Interop helpers - -(define-syntax := (make-rename-transformer #'$/:=)) -(define-syntax new (make-rename-transformer #'$/new)) -(define-syntax *this* (make-rename-transformer #'$/this)) -(define-syntax *null* (make-rename-transformer #'$/null)) -(define-syntax *undefined* (make-rename-transformer #'$/undefined)) - -(begin-for-syntax - (define-syntax-class field - #:description "a key-value pair for object" - (pattern [name:id val:expr]))) - -(define-syntax (field-λ stx) - (syntax-parse stx - [(_ formals (~datum #:with-this) self:id body ...) - #'(λ formals - (define self *this*) - body ...)] - [(_ formals body ...) #'(λ formals body ...)])) - -(define-syntax (define-proto stx) - (syntax-parse stx - [(define-proto name:id init:expr field:field ...) - #`(begin - (define name init) - #,(when (attribute field) - #`(begin - (:= ($ name 'prototype 'field.name) field.val) ...)))])) - -(define-syntax (set-object! stx) - (syntax-parse stx - [(set-object! obj:expr f:field ...) - #`(begin (:= ($ obj 'f.name) f.val) ...)])) - - -(define-syntax-rule (schedule-method this method interval) - (let ([self this]) - (#js*.window.setTimeout (λ () - (($ self method))) - interval))) - -(define-syntax-rule (schedule-animation-frame this step) - (let ([self this]) - (#js*.window.requestAnimationFrame (λ () - (($ self step)))))) - -;;----------------------------------------------------------------------------- -;; Helper functions - -(define document #js*.window.document) -(define console #js*.window.console) -(define Math #js*.window.Math) -(define Path2D #js*.window.Path2D) -(define abs+ceil (λ (n) (abs (ceiling n)))) - -(define-syntax-rule (twice e) - (* e 2)) - -(define-syntax-rule (half e) - (/ e 2)) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/login-form.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/login-form.rkt index d904f59d..bffc74dd 100644 --- a/racketscript-extras/racketscript/htdp/private/peer-universe/login-form.rkt +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/login-form.rkt @@ -2,7 +2,7 @@ (require (for-syntax racketscript/base syntax/parse) - "jscommon.rkt" + "../../../private/jscommon.rkt" "util.rkt") (provide create-login-form) diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/server-gui.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/server-gui.rkt index 9decba16..6c929a72 100644 --- a/racketscript-extras/racketscript/htdp/private/peer-universe/server-gui.rkt +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/server-gui.rkt @@ -3,40 +3,31 @@ (require (for-syntax racketscript/base syntax/parse) "encode-decode.rkt" - "debug-tools.rkt" "universe-primitives.rkt" - "jscommon.rkt") + "../../../private/jscommon.rkt") (provide server-gui) -(define DEFAULT-DISPLAY-MODE #js"block") (define WIDTH 500) (define HEIGHT 300) (define-proto ServerLogger - (λ (root stop-callback restart-callback) + (λ (root) #:with-this this - ;
- ; Auto-scroll - ; logged text - ;
- ; - ; - ;
- ;
(:= #js.this.logs ($/array)) (:= #js.this.autoscroll? #true) + (:= #js.this.peer-id #js"") + ;; Create elements (:= #js.this.container (#js*.document.createElement #js"div")) (:= #js.this.textbox (#js*.document.createElement #js"textarea")) (:= #js.this.checkbox-div (#js*.document.createElement #js"div")) (:= #js.this.checkbox-label (#js*.document.createElement #js"label")) (:= #js.this.checkbox (#js*.document.createElement #js"input")) - (:= #js.this.button-div (#js*.document.createElement #js"div")) - (:= #js.this.stop-button (#js*.document.createElement #js"button")) - (:= #js.this.restart-button (#js*.document.createElement #js"button")) + (:= #js.this.id-text (#js*.document.createElement #js"em")) + (:= #js.this.id-copy-button (#js*.document.createElement #js"button")) ;; Configure elements (:= #js.this.container.style.display #js"none") @@ -52,29 +43,23 @@ (:= #js.this.checkbox.onclick (lambda () (:= #js.this.autoscroll? #js.this.checkbox.checked))) (:= #js.this.checkbox.checked #true) - (:= #js.this.stop-button.innerHTML #js"stop") - (:= #js.this.stop-button.style.grid-area #js"stop") - (:= #js.this.stop-button.onclick stop-callback) - (:= #js.this.restart-button.innerHTML #js"restart") - (:= #js.this.restart-button.style.grid-area #js"restart") - (:= #js.this.restart-button.onclick restart-callback) - (:= #js.this.button-div.style.width #js"100%") - (:= #js.this.button-div.style.display #js"grid") - (:= #js.this.button-div.style.gridTemplateAreas - #js"'stop restart'") + (:= #js.this.id-text.innerHTML #js"peer id: undefined ") + (:= #js.this.id-copy-button.innerHTML #js"copy") + (:= #js.this.id-copy-button.style.margin-left #js"5px") + + (:= #js.this.id-copy-button.onclick + (λ () + (#js*.navigator.clipboard.writeText #js.this.peer-id) + (#js*.alert #js"Copied peer ID to clipboard."))) ;; Add elements to document (#js.this.checkbox-div.appendChild #js.this.checkbox-label) (#js.this.checkbox-div.appendChild #js.this.checkbox) - (#js.this.button-div.appendChild #js.this.stop-button) - (#js.this.button-div.appendChild #js.this.restart-button) - + (#js.this.container.appendChild #js.this.id-text) + (#js.this.container.appendChild #js.this.id-copy-button) (#js.this.container.appendChild #js.this.textbox) (#js.this.container.appendChild #js.this.checkbox-div) - (if (and restart-callback stop-callback) - (#js.this.container.appendChild #js.this.button-div) - (void)) (#js.root.appendChild #js.this.container) this) [log @@ -82,18 +67,20 @@ #:with-this this (#js.this.logs.push (js-string text)) (#js.this.render) - (#js*.console.log (js-string text)) - (void))] + (#js*.console.log (js-string text)))] [show (λ () #:with-this this - (:= #js.this.container.style.display DEFAULT-DISPLAY-MODE) - (void))] + (:= #js.this.container.style.display "block"))] [hide (λ () #:with-this this - (:= #js.this.container.style.display #js"none") - (void))] + (:= #js.this.container.style.display #js"none"))] + [set-id! + (λ (new-id) + #:with-this this + (:= #js.this.peer-id new-id) + (:= #js.this.id-text.innerHTML (js-string (format "peer id: ~a " new-id))))] [render (λ () #:with-this this @@ -103,13 +90,11 @@ ($/+ res #js"\n\n" (js-string curr)))) #js"")) (:= #js.this.textbox.innerHTML log-string) - (cond [(equal? #js.this.autoscroll? #true) - (:= #js.this.textbox.scrollTop #js.this.textbox.scrollHeight)] - [else (void)]) - (void))]) + (when (equal? #js.this.autoscroll? #true) + (:= #js.this.textbox.scrollTop #js.this.textbox.scrollHeight)))]) -(define (make-gui root stop-callback restart-callback) - (new (ServerLogger root stop-callback restart-callback))) +(define (make-gui root) + (new (ServerLogger root))) -(define (server-gui [root-element #js*.document.body] [stop-callback #false] [restart-callback #false]) - (make-gui root-element stop-callback restart-callback)) \ No newline at end of file +(define (server-gui [root-element #js*.document.body]) + (make-gui root-element)) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/universe-primitives.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/universe-primitives.rkt index 0103b7eb..583f0e88 100644 --- a/racketscript-extras/racketscript/htdp/private/peer-universe/universe-primitives.rkt +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/universe-primitives.rkt @@ -3,9 +3,7 @@ (require ;htdp/error racket/list) -(provide sexp? - - make-package +(provide make-package package? package-world package-message @@ -33,19 +31,6 @@ make-iworld iworld-conn) -(define (sexp? x) - (cond - [(empty? x) #true] - [(string? x) #true] - [(bytes? x) #true] - [(symbol? x) #true] - [(number? x) #true] - [(boolean? x) #true] - [(char? x) #true] - [(pair? x) (and (list? x) (andmap sexp? x))] - ; [(and (struct? x) (prefab-struct-key x)) (for/and ((i (struct->vector x))) (sexp? i))] - [else #false])) - (struct u-package (world message)) (define (make-package world message) (u-package world message)) diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/universe-server.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/universe-server.rkt index a699b927..4e860371 100644 --- a/racketscript-extras/racketscript/htdp/private/peer-universe/universe-server.rkt +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/universe-server.rkt @@ -2,32 +2,12 @@ (require (for-syntax racketscript/base syntax/parse) + "../../../private/jscommon.rkt" "server-gui.rkt" "encode-decode.rkt" - "debug-tools.rkt" "universe-primitives.rkt" - "jscommon.rkt" "util.rkt") -; TODO: -; implement deregister for on-msg handler -; implement the following handlers -; - to-string -; - check-with -; - state - -; Variations from api: -; - no port handler -; - create clause for user to pass in -; root element for logging GUI - -; Add to logs: -; u: current universe state -; Events to log: -; - mail sending: -; "broadcast failed to ~a" iworld name -; "~s not on the list" iworld name - (provide universe on-new @@ -37,19 +17,17 @@ Peer) -;; Adds peerjs exports (primarily Peer constructor) to window object +;; Adds peerjs package exports to global window object as properties (define peerjs ($/require "https://cdnjs.cloudflare.com/ajax/libs/peerjs/1.4.7/peerjs.min.js" *)) (define Peer #js*.window.Peer) -(define DEFAULT-UNIVERSE-ID "server") ;; Change this - (define *default-frames-per-second* 70) -;; Universe server (define (make-universe init-state handlers gui-root) - (new (Universe init-state handlers (if ($/binop != gui-root $/null) - gui-root #js*.document.body)))) + (new (Universe init-state handlers + (if ($/binop != gui-root $/null) ;; Workaround for problem with + gui-root #js*.document.body)))) ;; default args in nested functions (define (universe init-state #:dom-root [gui-root $/null] . handlers) ($> (make-universe init-state handlers gui-root) @@ -63,12 +41,11 @@ (:= #js.this.interval (/ 1000 *default-frames-per-second*)) (:= #js.this.handlers handlers) + ;; Lets evt handlers check whether they're being passed a universe or + ;; big-bang instance, so they can adjust their behavior (:= #js.this.is-universe? #true) - (:= #js.this.gui (server-gui gui-root - ; #js.this.stop - ; (λ () ($> #js.this.stop #js.this.setup #js.this.start)) - )) ;; TODO: allow user to pass root element? & Fix stop/restart cb's + (:= #js.this.gui (server-gui gui-root)) (:= #js.this.-active-handlers ($/obj)) (:= #js.this.-state-change-listeners ($/array)) @@ -91,22 +68,26 @@ (#js.this.gui.show) (define (log-connection conn) - (#js.this.gui.log (format "~a signed up" (js-string->string #js.conn.label)))) + (#js.this.gui.log (format "~a signed up" + (js-string->string #js.conn.label)))) (define (log-new-msg iw data) (#js.this.gui.log (format "~a --> universe:\n<~a>" - (iworld-name iw) (msg->string (decode-data data))))) + (iworld-name iw) (msg->string (decode-data data))))) (#js.this.add-peer-init-task (λ (peer) (#js.peer.on #js"connection" log-connection))) (#js.this.-message-listeners.push log-new-msg) + this)] [start (λ () #:with-this this (#js.this.init-peer-connection) + (define peer-id (js-string->string #js.this.-peer.id)) (#js.this.gui.log (format "a new universe is up and running with id ~s" - (js-string->string #js.this.-peer.id))) + peer-id)) + (#js.this.gui.set-id! peer-id) this)] [register-handlers (λ () @@ -132,15 +113,28 @@ (λ () #:with-this this (#js.this.gui.log "stopping the universe\n----------------------------------") - (void))] + (#js.this.clear-event-queue) + (set-object! this + [-stopped #t] + [-idle #t]) + (#js.this.deregister-handlers) + (#js.this.-canvas.remove) + (set-object! #js.this + [-active-handlers ($/obj)] + [handlers '()]))] [clear-event-queue (λ () #:with-this this (#js.this.-events.splice 0 #js.this.-events.length))] [add-state-change-listener - (λ () 0)] + (λ (cb) + #:with-this this + (#js.this.-state-change-listeners.push cb))] [remove-state-change-listener - (λ () 0)] + (λ (cb) + #:with-this this + (define index (#js.this.-state-change-listeners.indexOf cb)) + (#js.this.-state-change-listeners.splice index 1))] [queue-event (λ (e) #:with-this this @@ -175,6 +169,11 @@ (λ (result-bundle) #:with-this this + ;; bundle? + ;; | + ;; V + ;; https://docs.racket-lang.org/teachpack/2htdpuniverse.html#%28def._%28%28lib._2htdp%2Funiverse..rkt%29._bundle~3f%29%29 + (define new-state (bundle-state result-bundle)) (define mails (bundle-mails result-bundle)) (define low-to-remove (bundle-low-to-remove result-bundle)) @@ -194,9 +193,7 @@ (define conn (iworld-conn iw)) (define index (#js.this.-active-iworlds.indexOf iw)) (#js.conn.close) - (if (> index -1) - (#js.this.-active-iworlds.splice index 1) - (void))) + (when (> index -1) (#js.this.-active-iworlds.splice index 1))) low-to-remove) (define listeners #js.this.-state-change-listeners) @@ -205,10 +202,7 @@ (define listener ($ #js.listeners i)) (listener new-state) (loop (add1 i)))) - (:= #js.this.state new-state) - ; (#js.this.gui.log (format "~a" new-state)) - ;; Maybe implement this? - )] + (:= #js.this.state new-state))] [init-peer-connection (λ (id) #:with-this this @@ -233,24 +227,21 @@ (if peer-started? (cb peer) (#js.this.-peer-init-tasks.push cb)))] - [pass-message ;; Passes sender iworld and message to this.-message-listeners + [pass-message ;; Passes message abd sender's iworld instance to this.-message-listeners (λ (sender-iw data) #:with-this this - ;; TODO: Decrypt data once encryption/decryption of racket types solved (#js.this.-message-listeners.forEach (λ (cb) (cb sender-iw data))))] [handle-disconnect (λ (iw) #:with-this this - ;; Run all disconnect tasks, passing in the iworld of the connection being closed (define tasks #js.this.-disconnect-tasks) (let loop ([i 0]) (when (< i #js.tasks.length) (define task ($ tasks i)) (task iw) (loop (add1 i)))) - (#js.this.gui.log (format "~a !! closed port" (iworld-name iw))) - (void))]) + (#js.this.gui.log (format "~a !! closed port" (iworld-name iw))))]) (define (on-new cb) (λ (u) @@ -262,33 +253,27 @@ (define (init-task peer) (define (handle-connection conn) (define name "client name") - (if #js.conn.label - (set! name (js-string->string #js.conn.label)) - (void)) + (when #js.conn.label + (set! name (js-string->string #js.conn.label))) (define iw (make-iworld conn name)) (#js.u.-active-iworlds.push iw) (#js.u.queue-event ($/obj [type #js"on-new"] [iWorld iw])) - (#js.conn.on #js"close" - (λ () - (#js.u.handle-disconnect iw))) - (#js.conn.on #js"data" - (λ (data) (#js.u.pass-message iw data)))) + (#js.conn.on #js"close" (λ () (#js.u.handle-disconnect iw))) + (#js.conn.on #js"data" (λ (data) (#js.u.pass-message iw data)))) + (#js.peer.on #js"connection" handle-connection)) - (#js.u.add-peer-init-task init-task) - - (void))] + (#js.u.add-peer-init-task init-task))] [deregister (λ () ;; TODO: implement this #:with-this this - (void))] + 0)] [invoke (λ (state evt) #:with-this this (define conn (iworld-conn #js.evt.iWorld)) (#js.conn.on #js"open" (λ (_) - (#js.u.change-state - (cb state #js.evt.iWorld)))) + (#js.u.change-state (cb state #js.evt.iWorld)))) #t)]))) (define (on-disconnect cb) @@ -301,27 +286,20 @@ (#js.u.-disconnect-tasks.push (λ (iworld) (#js.u.queue-event ($/obj [type #js"on-disconnect"] - [iWorld iworld])))) - (void))] - [deregister (λ () ; TODO: implement this? maybe? - #:with-this this - (void))] + [iWorld iworld])))))] + [deregister (λ () ; TODO: implement this + 0)] [invoke (λ (state evt) #:with-this this (#js.u.change-state (cb state #js.evt.iWorld)) - (void))]))) + #t)]))) (define (server-id id) (λ (u) ($/obj [name #js"server-id"] - [register (λ () - #:with-this this - (:= #js.u.-peer-id (js-string id)) - (void))] - [deregister (λ () - #:with-this this - (void))]))) + [register (λ () (:= #js.u.-peer-id (js-string id)))] + [deregister (λ () (:= #js.u.-peer-id (generate-id)))]))) (define (on-msg cb) (λ (u) @@ -334,11 +312,10 @@ (#js.u.queue-event ($/obj [type #js"on-msg"] [iWorld sender] [msg data]))) - (#js.u.-message-listeners.push handle-msg) - (void))] + (#js.u.-message-listeners.push handle-msg))] [deregister (λ () ;; TODO: implement this #:with-this this - (void))] + 0)] [invoke (λ (state evt) (#js.u.change-state (cb state #js.evt.iWorld (decode-data #js.evt.msg))) #t)]))) \ No newline at end of file diff --git a/racketscript-extras/racketscript/htdp/private/peer-universe/util.rkt b/racketscript-extras/racketscript/htdp/private/peer-universe/util.rkt index 409e87d6..d3ad49f4 100644 --- a/racketscript-extras/racketscript/htdp/private/peer-universe/util.rkt +++ b/racketscript-extras/racketscript/htdp/private/peer-universe/util.rkt @@ -84,10 +84,8 @@ "noodle")) (define (generate-id) - (define adjective (list-ref funny-adjectives - (random (length funny-adjectives)))) - (define noun (list-ref funny-nouns - (random (length funny-nouns)))) + (define adjective (list-ref funny-adjectives (random (length funny-adjectives)))) + (define noun (list-ref funny-nouns (random (length funny-nouns)))) (format "~a-~a" adjective noun)) @@ -96,14 +94,15 @@ ;; NOTE: because every racket datatype in ;; racketscript is stored as a js object, -;; ($/typeof obj ) +;; ($/typeof obj ) ;; will always be true (define (js-object? obj) (and (not (string? obj) (number? obj) (boolean? obj) (list? obj) - (symbol? obj)) + (symbol? obj) + (struct? obj)) ($/typeof obj "object"))) (define (null? val) @@ -116,10 +115,9 @@ (#js*.Array.isArray arr)) (define (msg->string msg) - (cond [(undefined? msg) "undefined"] - [(js-string? msg) (js-string->string msg)] - [(or (js-object? msg) - (js-array? msg) - (null? msg)) (#js*.JSON.stringify msg)] + (cond [(undefined? msg) "undefined"] + [(js-string? msg) (js-string->string msg)] + [(or (js-object? msg) (js-array? msg) (null? msg)) + (#js*.JSON.stringify msg)] [else (format "~a" msg)]))