diff --git a/racket/syndicate/big-bang.rkt b/racket/syndicate/big-bang.rkt index ed7ddbd..b289743 100644 --- a/racket/syndicate/big-bang.rkt +++ b/racket/syndicate/big-bang.rkt @@ -157,23 +157,27 @@ (stop-when bb-halted?) extra-clause ...)) -(define-syntax-rule (big-bang-dataspace** width height boot-actions extra-clause ...) - (if (and width height) - (big-bang-dataspace* boot-actions (to-draw render width height) extra-clause ...) - (big-bang-dataspace* boot-actions (to-draw render) extra-clause ...))) +(define-syntax-rule (big-bang-dataspace** width height exit? boot-actions extra-clause ...) + (begin + (if (and width height) + (big-bang-dataspace* boot-actions (to-draw render width height) extra-clause ...) + (big-bang-dataspace* boot-actions (to-draw render) extra-clause ...)) + (when exit? (exit 0)))) -(define (big-bang-dataspace #:width [width #f] - #:height [height #f] - . boot-actions) - (big-bang-dataspace** width height boot-actions)) +(define ((big-bang-dataspace #:width [width #f] + #:height [height #f] + #:exit? [exit? #t]) + . boot-actions) + (big-bang-dataspace** width height exit? boot-actions)) -(define (big-bang-dataspace/universe #:width [width #f] - #:height [height #f] - #:register [ip LOCALHOST] - #:port [port-number SQPORT] - #:name [world-name (gensym 'syndicate)] - . boot-actions) - (big-bang-dataspace** width height boot-actions +(define ((big-bang-dataspace/universe #:width [width #f] + #:height [height #f] + #:exit? [exit? #t] + #:register [ip LOCALHOST] + #:port [port-number SQPORT] + #:name [world-name (gensym 'syndicate)]) + . boot-actions) + (big-bang-dataspace** width height exit? boot-actions (on-receive (lambda (b sexps) (inject b (for/list ((m sexps)) (message (from-server m)))))) (register ip) diff --git a/racket/syndicate/examples/actor/big-bang.rkt b/racket/syndicate/examples/actor/big-bang.rkt index 73348f9..5da11cd 100644 --- a/racket/syndicate/examples/actor/big-bang.rkt +++ b/racket/syndicate/examples/actor/big-bang.rkt @@ -1,8 +1,7 @@ -#lang racket ;; -*- racket -*- +#lang syndicate/actor -(require (only-in syndicate seal)) -(require syndicate/actor) (require syndicate/big-bang) +(require racket/math) (define (button #:background [background "grey"] #:foreground [foreground "white"] @@ -41,16 +40,17 @@ (idle 0 (- mx dx) (- my dy))))) (actor (idle 0 orig-x orig-y))) -(big-bang-dataspace #:width 640 - #:height 480 - (actor (forever - (during (active-window $id) #:meta-level 1 - (assert (window 'active-window-label 300 0 0 - (seal (text (format "~v" id) 22 "black"))) - #:meta-level 1)))) - (button #:background "red" 'stop-button 0 0 "Exit" - (lambda () (assert! 'stop #:meta-level 1))) - (draggable-shape 'c1 50 50 (circle 30 "solid" "orange")) - (draggable-shape 's1 100 100 (star 40 "solid" "firebrick"))) +(actor (forever + (during (active-window $id) #:meta-level 1 + (assert (window 'active-window-label 300 0 0 + (seal (text (format "~v" id) 22 "black"))) + #:meta-level 1)))) +(button #:background "red" 'stop-button 0 0 "Exit" + (lambda () (assert! 'stop #:meta-level 1))) +(draggable-shape 'c1 50 50 (circle 30 "solid" "orange")) +(draggable-shape 's1 100 100 (star 40 "solid" "firebrick")) -(exit 0) +(module+ main + (current-ground-dataspace + (big-bang-dataspace #:width 640 + #:height 480))) diff --git a/racket/syndicate/examples/big-bang.rkt b/racket/syndicate/examples/big-bang.rkt index a47d426..4db2fb8 100644 --- a/racket/syndicate/examples/big-bang.rkt +++ b/racket/syndicate/examples/big-bang.rkt @@ -1,7 +1,7 @@ -#lang racket +#lang syndicate -(require "../main.rkt") (require "../big-bang.rkt") +(require racket/math) (define (button #:background [background "grey"] #:foreground [foreground "white"] @@ -50,21 +50,22 @@ (mouse-sub name) (move-to orig-x orig-y)))) -(big-bang-dataspace #:width 640 - #:height 480 - (spawn (lambda (e s) - (match e - [(? patch? p) - (define-values (in out) - (patch-project/set/single p (at-meta (?! (active-window ?))))) - (transition s (update-window 'active-window-label 300 0 - (text (format "~v" in) 22 "black")))] - [_ #f])) - (void) - (sub (active-window ?) #:meta-level 1)) - (button #:background "red" 'stop-button 0 0 "Exit" - (lambda () (assert 'stop #:meta-level 1))) - (draggable-shape 'c1 50 50 (circle 30 "solid" "orange")) - (draggable-shape 's1 100 100 (star 40 "solid" "firebrick"))) +(spawn (lambda (e s) + (match e + [(? patch? p) + (define-values (in out) + (patch-project/set/single p (at-meta (?! (active-window ?))))) + (transition s (update-window 'active-window-label 300 0 + (text (format "~v" in) 22 "black")))] + [_ #f])) + (void) + (sub (active-window ?) #:meta-level 1)) +(button #:background "red" 'stop-button 0 0 "Exit" + (lambda () (assert 'stop #:meta-level 1))) +(draggable-shape 'c1 50 50 (circle 30 "solid" "orange")) +(draggable-shape 's1 100 100 (star 40 "solid" "firebrick")) -(exit 0) +(module+ main + (current-ground-dataspace + (big-bang-dataspace #:width 640 + #:height 480))) diff --git a/racket/syndicate/lang.rkt b/racket/syndicate/lang.rkt index d40f02d..3c311a2 100644 --- a/racket/syndicate/lang.rkt +++ b/racket/syndicate/lang.rkt @@ -9,6 +9,7 @@ (provide (rename-out [module-begin #%module-begin]) activate require/activate + current-ground-dataspace (except-out (all-from-out racket/base) #%module-begin) (all-from-out racket/match) (all-from-out "main.rkt") @@ -30,6 +31,8 @@ (require module-path ...) (activate module-path ...))])) +(define current-ground-dataspace (make-parameter #f)) + (define-syntax (module-begin stx) (unless (eq? (syntax-local-context) 'module-begin) (raise-syntax-error #f "allowed only around a module body" stx)) @@ -47,10 +50,12 @@ (when (not activated?) (set! activated? #t) boot-actions))) + (module+ main + (current-ground-dataspace run-ground)) #,@(reverse final-forms) (module+ main (require (submod ".." syndicate-main)) - (run-ground (activate!)))))) + ((current-ground-dataspace) (activate!)))))) ;;(pretty-print (syntax->datum final-stx)) final-stx) (syntax-case (local-expand (car forms)