From: plugd <plugd@thelambdalab.xyz>
Date: Sat, 16 Nov 2019 21:52:46 +0000 (+0100)
Subject: Vis is now module.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=872b5d3c7e9bd01466a343336c61f51a837e278f;p=jars.git

Vis is now module.
---

diff --git a/vis.scm b/vis.scm
index 6ae005b..d8a45a5 100644
--- a/vis.scm
+++ b/vis.scm
@@ -1,48 +1,47 @@
-;; Visualization experiments
-
-(import (chicken io)
-        (chicken process)
-        (chicken port)
-        (chicken string))
-
-;; Generic Wish interface
-
-(define wish-in '())
-(define wish-out '())
-
-(define (wish-startup w h)
-  (let-values (((in-port out-port id) (process (conc "wish -geometry " w "x" h))))
-    (set! wish-in in-port)
-    (set! wish-out out-port)))
-
-(define (wish-shutdown)
-  (wish% "destroy .")
-  (close-input-port wish-in)
-  (close-output-port wish-out))
-
-(define (wish% . args)
-  (with-output-to-port wish-out
-    (lambda ()
-      (apply print args))))
-
-;; High-level visualization commands
-
-(define (visualizer-open w h)
-  (wish-startup w h)
-  (wish% "canvas .c -width " w " -height " h " -bg black")
-  (wish% "pack .c")
-  (wish% "image create photo core -width " w " -height " h " -palette 256/256/256")
-  (wish% ".c create image 0 0 -anchor nw -image core"))
-
-(define (set-pixel x y col)
-  (wish% "core put " col " -to " x " " y))
-
-(define (visualizer-close)
-  (wish-shutdown))
-
-;; Test code
-
-(visualizer-open 640 480)
-(set-pixel 10 10 "red")
-(sleep 3)
-(visualizer-close)
+;; Wish visualization module
+
+(module wish
+    (make-wish
+     destroy-wish
+     set-wish-pixel)
+
+  (import scheme
+          (chicken base)
+          (chicken io)
+          (chicken process)
+          (chicken port)
+          (chicken string))
+
+  (define (make-wish w h)
+    (let-values (((in out id) (process (conc "wish -geometry " w "x" h))))
+      (with-output-to-port out
+        (lambda ()
+          (print "canvas .c -width " w " -height " h " -bg black")
+          (print "pack .c")
+          (print "image create photo core -width " w " -height " h " -palette 256/256/256")
+          (print ".c create image 0 0 -anchor nw -image core")))
+      (cons in out)))
+
+  (define (wish-in wish) (car wish))
+  (define (wish-out wish) (cdr wish))
+
+  (define (wish% wish . args)
+    (with-output-to-port (wish-out wish)
+      (lambda ()
+        (apply print args))))
+
+  (define (destroy-wish wish)
+    (wish% wish "destroy .")
+    (close-input-port (wish-in wish))
+    (close-output-port (wish-out wish)))
+
+  (define (set-wish-pixel wish x y col)
+    (wish% wish "core put " col " -to " x " " y)))
+
+
+  ;; ;; Test code
+
+  ;; (let ((w (make-wish 640 480)))
+  ;;   (set-wish-pixel w 10 10 "red")
+  ;;   (sleep 3)
+  ;;   (destroy-wish w)))