;; This file contains a Chez-Scheme-specific definition of the show procedure
;; for use with section 9.4 (An Application: Computer Graphics) of
;; Concrete Abstractions: An Introduction to Computer Science Using Scheme
;; by Max Hailperin, Barbara Kaiser, and Karl Knight.
;;
;; This version has been tested with Petite Chez Scheme version 6.0a with
;; SWL version 0.9u.
;;
;; Revision 1.1 as of 1999/06/16 01:00:01

(define swl-show
  (if (top-level-bound? 'swl-show)  ; protect against repeated loading
      swl-show
      show))

(define show
  (let ((x-coord (lambda (point) (exact->inexact (x-coord point))))
        (counter 0))
    (lambda (image)
      (let ((w (inexact->exact (round (width image))))
	    (h (inexact->exact (round (height image)))))
        (set! counter (add1 counter))
        (let* ((title (string-append "Show" (number->string counter)))
               (top (create <toplevel> with (title: title)))
               (win (create <canvas> top with (width: w) (height: h)
                            (background-color:
                             (make <rgb> 255 255 255))))
               (y-coord (lambda (point) (- h
                                           (exact->inexact (y-coord point))))))
          (swl-show win)
	  (draw-on image
		   (lambda (op)		; the drawing medium
		     (cond ((equal? op 'draw-line)
			    (lambda (point0 point1)
			      (create <line> win
                                      (x-coord point0)
                                      (y-coord point0)
                                      (x-coord point1)
                                      (y-coord point1))))
			   ((equal? op 'draw-filled-triangle)
			    (lambda (point0 point1 point2)
			      (create <polygon> win
                                      (x-coord point0)
                                      (y-coord point0)
                                      (x-coord point1)
                                      (y-coord point1)
                                      (x-coord point2)
                                      (y-coord point2))))
			   (else (error "unknown operation on drawing medium"
					op)))))
	  title)))))