Relocated the demos...

svn: r130

collects/mztake/demos/misc/exception-test.ss

@@ -0,0 +1,13 @@
+(require (lib "mztake.ss" "mztake"))
+
+; tests catching of anonymously threaded exceptions
+
+exceptions
+
+(debug-process p ("exception.ss"))
+
+(printf-b "exception.ss exited? ~a" (process:exited? p))
+;; Prints out a behavior that tells you whether the debug-process is still running...
+
+(process:exceptions p)
+(start/resume p)

collects/mztake/demos/misc/exception.ss

@@ -0,0 +1,6 @@
+(module exception mzscheme
+  (thread (lambda () (raise 'first-raise)))
+  ;(require (lib "match.ss"))
+  ;(match )
+  ;(printf "dd~a" (random 100))
+  )

collects/mztake/demos/misc/higher-order-test.ss

@@ -0,0 +1,16 @@
+;tests higher order annotation and redefinition of bindings
+
+(debug-process p ("higher-order.ss" [x-before-let 3 29 bind 'x]
+                                    [x-in-let     4 25 bind 'x]
+                                    [x-after-let  5 11 bind 'x]))
+
+(printf-b "Number of times x updates, should be 12: ~a"
+          (count-e (merge-e x-before-let
+                            x-in-let
+                            x-after-let)))
+
+(printf-b "x before let, should be (2 4 6 7): ~a"  (history-b 10 x-before-let))
+(printf-b "x in let, should be (6 10 14 16): ~a"   (history-b 10 x-in-let))
+(printf-b "x after let, should be (5 9 13 15): ~a" (history-b 10 x-after-let))
+
+(start/resume p)

collects/mztake/demos/misc/higher-order.ss

@@ -0,0 +1,6 @@
+(module higher-order mzscheme
+  (map (lambda (x)
+         (let* ([x (* 2 (+ 1 x))]
+                [x (sub1 x)])
+           x))
+       '(2 4 6 7)))

collects/mztake/demos/montecarlo/montecarlo-test.ss

@@ -0,0 +1,25 @@
+(require (lib "graphics.ss" "graphics"))
+
+(open-graphics)
+(define window (open-viewport "Debugger" 400 400))
+
+(debug-process p ("montecarlo.ss" [x/y/pi-trace 12 18 bind '(x y pi)]))
+
+(define x/y/pi (hold x/y/pi-trace))
+
+(define x (+ 200 (first x/y/pi)))
+(define y (+ 200 (second x/y/pi)))
+(define current-pi (third x/y/pi))
+
+(printf-b "total: ~a" (count-b x))
+(printf-b "current pi: ~a" current-pi)
+; more negative the better ...down to -14
+(printf-b "log error: ~a" (log (abs (- current-pi 3.1415926))))
+
+((changes (list x y))
+ . ==> .
+ (lambda (x/y)
+   ((draw-solid-ellipse window) (make-posn (first x/y) (second x/y))
+                                3 3 "blue")))
+
+(start/resume p)

collects/mztake/demos/montecarlo/montecarlo.ss

@@ -0,0 +1,13 @@
+(module montecarlo mzscheme
+  (random-seed 846259386) ; specially chosen because it isn't terribly erratic
+  
+  (define (run)
+    (let loop ([hits 1]
+               [total 1])
+      (let* ([x (- (random 400) 200)]
+             [y (- (random 400) 200)]
+             [length (sqrt (+ (* x x) (* y y)))]
+             [pi (* 4. (/ hits total))])
+      (cond [(length . <= . 200) (loop (add1 hits) (add1 total))]
+            [else (loop hits (add1 total))]))))
+  (run))

collects/mztake/demos/random/random-Xs-test.ss

@@ -0,0 +1,39 @@
+(require (lib "graphics.ss" "graphics")
+         (lifted mzscheme
+                 make-hash-table
+                 hash-table-put!
+                 hash-table-get))
+#|
+    "Lifted" is explained in FrTime's own documentation (plt/collects/frtime/doc.txt)
+    Quickly put, lifting extends the functions listed above so they can take FrTime time-varying
+    values (such as MzTake traces) as arguments. 
+|#
+
+
+(open-graphics)
+(define window (open-viewport "Debugger" 600 500))
+
+(debug-process p ("random-Xs.ss" [x-trace 4 6 bind 'x]))
+
+(define x (hold x-trace))
+
+(define valcount (make-hash-table))
+
+((changes x) . ==> . (lambda (x)
+                       (hash-table-put! valcount x (add1 (hash-table-get valcount x (lambda () 0))))
+                       ((draw-solid-ellipse window) (make-posn (* x 3)
+                                                               (- 500 (* 3 (hash-table-get valcount x (lambda () 1)))))
+                                                    4 4 "blue")))
+
+(define runtime (process:runtime/milliseconds p))
+(printf-b "~a millisecs per event" (truncate (runtime . / . (add1 (count-e (changes x))))))
+
+(printf-b "x: ~a" x)
+(printf-b "count: ~a" (count-e (changes x)))
+
+(let ([cnt (count-e (changes x))])
+  (when (= 13000 cnt)
+    ; pause on next breakpoint
+    (pause p)))
+
+(start/resume p)

collects/mztake/demos/random/random-Xs.ss

@@ -0,0 +1,5 @@
+(module |random-Xs| mzscheme
+  (define (run)
+    (let loop ([x (random 200)])
+      (loop (random 200))))
+  (run))

collects/mztake/demos/sine/sine-test.ss

@@ -0,0 +1,61 @@
+#| * The program being debugged (in the file "sine.ss") is a module that runs an infinite loop,
+     binding "x" to a moment in time [-200,200], and "sin-x" to the sin(x) ... over and over.
+     This MzTake script plots the value of x over time, in sync with the execution of "sine.ss".
+|#
+
+(require (lib "animation.ss" "frtime")) ;; needed for display-shapes
+
+
+(debug-process p ("sine.ss" [sin/x-trace 5 8 bind '(sin-x x)]))
+#| * Create a process to debug for sine.ss
+
+   * Add a tracepoint at line 5, column 8; in the program,
+     this is right after the let values are bound, ->(if (x ...)
+
+   * At this tracepoint, define "sin/x-trace" to a FrTime eventstream that
+     recieves events containing a list of two elements:
+       * The (lexically-scoped) current values of the variables `sin-x' and `x' are
+         sent as a list every time the code at line 5, column 8, is reached.
+|#
+
+(printf-b "runtime elapsed: ~a" (process:runtime/seconds p))
+;; Prints how long the program has been running, in seconds
+
+
+(printf-b "sine.ss exited? ~a" (process:exited? p))
+;; Prints out a behavior that tells you whether the debug-process is still running...
+
+
+(define sin/x (hold sin/x-trace))
+;; "sin/x" now is a FrTime behavior that holds the current value of the list (sin-x x)
+
+
+(define sin-x (+ 200 (first sin/x)))
+(define x     (+ 200 (second sin/x)))
+;; "x" and "sin-x" are the current values of (x + 200) and (sin(x) + 200)
+
+
+(printf-b "x: ~a" x)
+(printf-b "sin(x): ~a" sin-x)
+;; Print the current values of x and sin-x
+
+
+(display-shapes
+ (list* (make-line (make-posn 0 200) (make-posn 400 200) "gray")
+        (make-line (make-posn 200 0) (make-posn 200 400) "gray")
+        ;;      draw horizontal and vertical gray lines
+        
+        (history-b 50 (changes (make-circle
+                                (make-posn x sin-x)
+                                5 ; diameter
+                                (if (< 200 sin-x)
+                                    (if (< 200 x) "blue" "darkblue")     ; Quadrants 3 and 4
+                                    (if (< 200 x) "red" "darkred"))))))) ;           1 and 2
+#|         * Make a circle at position (x, sin-x) with diameter 5 pixels, and a color based on the coords.
+           * Everytime this value (the circle) changes (when the values of x and sin-x change)
+             * Keep a history (as a FIFO list) of (up to) the last 50 circles that were created.
+             * Pass this list to the display-shapes function, which will redraw everytime this list changes. 
+|#
+
+(start/resume p)
+;; Start the process for sine.ss

collects/mztake/demos/sine/sine.ss

@@ -0,0 +1,8 @@
+(module sine mzscheme
+  (define (run)
+    (let loop ([x -200])
+      (let ([sin-x (* 100 (sin (/ x 20.0)))])
+        (if (x . <= . 200)
+            (loop (add1 x))
+            (loop -200)))))
+  (run))