X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=jars.git;a=blobdiff_plain;f=wish.scm;fp=wish.scm;h=0000000000000000000000000000000000000000;hp=b06e1d81a0dd108aad9b9d224171abc5f8ac5c75;hb=28a3308e193e60e376fe9f171513ef541bb08385;hpb=0dd1d148e53122a31f3cd6f4f440f43e03ba80c5

diff --git a/wish.scm b/wish.scm
deleted file mode 100644
index b06e1d8..0000000
--- a/wish.scm
+++ /dev/null
@@ -1,59 +0,0 @@
-;; 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 palette)
-    (let-values (((in out id) (process (conc "wish -geometry " w "x" h))))
-      (with-output-to-port out
-        (lambda ()
-          (print "wm title . \"MARS Visualizer\"")
-          (print "frame .fb -borderwidth 10")
-          (print "pack .fb -side top")
-          (let loop ((remaining-palette palette))
-            (unless (null? remaining-palette)
-              (let ((name (caar remaining-palette))
-                    (col (cdar remaining-palette)))
-                (print "label .fb.l" name " -text " name " -fg " col)
-                (print "pack .fb.l" name " -side left"))
-              (loop (cdr remaining-palette))))
-          (print "frame .fc -relief sunken -borderwidth 2")
-          (print "pack .fc -side bottom")
-          (print "canvas .fc.c -width " w " -height " h " -bg black")
-          (print "pack .fc.c")
-          (print "image create photo core -width " w " -height " h " -palette 256/256/256")
-          (print ".fc.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)))