-;; 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)))