vis.scm

   1 ;; Visualization experiments
   2
   3 (import (chicken io)
   4         (chicken process)
   5         (chicken port)
   6         (chicken string))
   7
   8 ;; Generic Wish interface
   9
  10 (define wish-in '())
  11 (define wish-out '())
  12
  13 (define (wish-startup w h)
  14   (let-values (((in-port out-port id) (process (conc "wish -geometry " w "x" h))))
  15     (set! wish-in in-port)
  16     (set! wish-out out-port)))
  17
  18 (define (wish-shutdown)
  19   (wish% "destroy .")
  20   (close-input-port wish-in)
  21   (close-output-port wish-out))
  22
  23 (define (wish% . args)
  24   (with-output-to-port wish-out
  25     (lambda ()
  26       (apply print args))))
  27
  28 ;; High-level visualization commands
  29
  30 (define (visualizer-open w h)
  31   (wish-startup w h)
  32   (wish% "canvas .c -width " w " -height " h " -bg black")
  33   (wish% "pack .c")
  34   (wish% "image create photo core -width " w " -height " h " -palette 256/256/256")
  35   (wish% ".c create image 0 0 -anchor nw -image core"))
  36
  37 (define (set-pixel x y col)
  38   (wish% "core put " col " -to " x " " y))
  39
  40 (define (visualizer-close)
  41   (wish-shutdown))
  42
  43 ;; Test code
  44
  45 (visualizer-open 640 480)
  46 (set-pixel 10 10 "red")
  47 (sleep 3)
  48 (visualizer-close)