From b857ce7bcd3d69d6e1d9a3d96265a1aa9e41b67d Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Tue, 14 Jun 2016 03:49:47 -0400
Subject: [PATCH] Actually-runnable syndicate/actor big-bang example.

---
 racket/doc/big-bang.rkt.txt | 49 +++++++++++++++++++++----------------
 1 file changed, 28 insertions(+), 21 deletions(-)

diff --git a/racket/doc/big-bang.rkt.txt b/racket/doc/big-bang.rkt.txt
index 25ddb12..2cc0cc4 100644
--- a/racket/doc/big-bang.rkt.txt
+++ b/racket/doc/big-bang.rkt.txt
@@ -1,7 +1,8 @@
 #lang racket ;; -*- racket -*-
 
-(require "../main.rkt")
-(require "../big-bang.rkt")
+(require (only-in syndicate seal))
+(require syndicate/actor)
+(require syndicate/big-bang)
 
 (define (button #:background [background "grey"]
                 #:foreground [foreground "white"]
@@ -9,40 +10,46 @@
                 name x y label callback)
   (define label-image (text label font-size foreground))
   (actor (forever
-          (on (message (at-meta (mouse-event ? ? name "button-down"))) (callback))
+          (on (message (mouse-event _ _ name "button-down") #:meta-level 1) (callback))
           (assert (window name x y 0
                           (seal
                            (overlay label-image
                                     (rectangle (+ (image-width label-image) 20)
                                                (+ (image-height label-image) 20)
                                                "solid"
-                                               background))))))))
+                                               background))))
+                  #:meta-level 1))))
 
 (define (draggable-shape name orig-x orig-y image)
-  (define (move-to x y) (assert (update-window name x y image #:z 10)))
+  (define (window-at x y) (window name x y 10 (seal image)))
+  (define (mouse-left-event-type? t) (member t '("leave" "button-up")))
   (define (idle ticks x y)
-    (state [#:collect [(ticks ticks) (x x) (y y)]
-            (move-to x y)
-            (on (message (at-meta (tick-event)))
-                (define new-ticks (+ ticks 1))
-                (define displacement (* (cos (* new-ticks 10 1/180 pi)) 4))
-                (values new-ticks x (+ y displacement)))]
-      [(message (at-meta (mouse-event mx my name "button-down")))
-       (dragging mx my (- mx x) (- my y))]))
+    ;; TODO: Once "tail-calls" between `state`s are fixed, remove the
+    ;; ugly returning-of-an-immediately-called-thunk-from-the-
+    ;; termination-handlers here and in `dragging`.
+    ((state [#:collect [(ticks ticks) (x x) (y y)]
+             (assert (window-at x y) #:meta-level 1)
+             (on (message (tick-event) #:meta-level 1)
+                 (define new-ticks (+ ticks 1))
+                 (define displacement (* (cos (* new-ticks 10 1/180 pi)) 4))
+                 (values new-ticks x (+ y displacement)))]
+       [(message (mouse-event $mx $my name "button-down") #:meta-level 1)
+        (lambda () (dragging mx my (- mx x) (- my y)))])))
   (define (dragging mx my dx dy)
-    (state [#:collect [(mx mx) (my my)]
-            (move-to (- mx dx) (- my dy))
-            (on (message (at-meta (mouse-event mx my ? "drag"))) (values mx my))]
-      [(message (at-meta (mouse-event mx my ? (or "leave" "button-up"))))
-       (idle 0 (- mx dx) (- my dy))]))
+    ((state [#:collect [(mx mx) (my my)]
+             (assert (window-at (- mx dx) (- my dy)) #:meta-level 1)
+             (on (message (mouse-event $mx $my _ "drag") #:meta-level 1) (values mx my))]
+       [(message (mouse-event $mx $my _ (? mouse-left-event-type? $t)) #:meta-level 1)
+        (lambda () (idle 0 (- mx dx) (- my dy)))])))
   (actor (idle 0 orig-x orig-y)))
 
 (big-bang-dataspace #:width 640
                     #:height 480
                     (actor (forever
-                            (on (asserted (active-window $id) #:meta-level 1)
-                                (update-window 'active-window-label 300 0
-                                               (text (format "~v" id) 22 "black")))))
+                            (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"))