X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=jars.git;a=blobdiff_plain;f=vis.scm;fp=vis.scm;h=0000000000000000000000000000000000000000;hp=d8a45a5d0aa6aa82dcec34625d19174f2d4806b8;hb=80272dcf66d5e333302fa310c4c346d6af5d503c;hpb=402486b539f041dc0b8b56933cbeeb637ed7cd92 diff --git a/vis.scm b/vis.scm deleted file mode 100644 index d8a45a5..0000000 --- a/vis.scm +++ /dev/null @@ -1,47 +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) - (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)))