+++ /dev/null
-;; 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)))