; So that MacGambit style graphics works without modification on Dr. Scheme,
; this file was created.  All functions should work identically.
; One slight variation is that MacGambit scales down everything by 2,
; but this file does not.  Therefore everything is twice as large.

; Load the information about drawing
(require-library "graphics.ss" "graphics")

;; Teachpackified by Danny Yoo (dyoo@hkn.eecs.berkeley.edu)
;; April 24, 2001

;; (dyoo) Notes: Oh my gosh, the DrScheme people need MUCH better
;; documentation on Units, and especially on extending the graphics
;; unit.  Anyway, I've converted this to be a teachpack, to make life
;; easier on the students.

;; Any unit that implements gambit-graphics^ needs to define the
;; following things:
(define-signature gambit-graphics^
  (clear-graphics
   position-pen
   draw-line-to
   draw-line
   draw-point
   clear-point
   graphics-text
   set-rgb-color))


(define gambit-impl@
  (unit/sig gambit-graphics^
	    (import graphics^)
	    (rename (-draw-line draw-line))  ;; Let's stuff our own
					     ;; version of draw-line
					     ;; in our exports.


					; *current-color* is the
					; current color of the pen.
					; We start with black
	    (define *current-color* (make-rgb 0 0 0))

					; *drawing-window* is the
					; drawing window.  We do not
					; want to create it until it
					; is actually accessed.
	    (define *drawing-window* #f)
					; WINDOW-SIZE is the size of
					; the coordinate system.
					; MacGambit is set to -200 to
					; 200.
	    (define WINDOW-SIZE 200)
					; SCALE-FACTOR is how much to
					; shrink the coordinate
					; system.  MacGambit is set to
					; 2 unless you click the zoom
					; box
	    (define SCALE-FACTOR 1)

					; *pen-posn* is the current
					; position of the pen.  We
					; start at (0,0)
	    (define *pen-posn* (make-posn 0 0))

					; MacGambit has a coordinate
					; system that is +/-, and so
					; we need to adjust the
					; positions
	    (define (make-mg-posn x y)
	      (make-posn (/ (+ WINDOW-SIZE x) SCALE-FACTOR)
			 (/ (- WINDOW-SIZE y) SCALE-FACTOR)))
					; *drawing-window* can not be
					; accessed directly, as it may
					; not be created yet Call
					; get-drawing-window instead.
					; It creates the window if it
					; doesn't exist.
	    (define (get-drawing-window)
	      (if (not *drawing-window*)
		  (begin (open-graphics)
			 (set! *drawing-window*
			       (open-viewport "* Drawing *"
					      (/ (* WINDOW-SIZE 2) 
						 SCALE-FACTOR)
					      (/ (* WINDOW-SIZE 2)
						 SCALE-FACTOR)))))
	      *drawing-window*)

					; The following functions are
					; the implementation of
					; MacGambit graphics

 	    (define (clear-graphics)
 	      ((clear-viewport (get-drawing-window))))

	    (define (position-pen x y)
	      (set! *pen-posn* (make-mg-posn x y))
	      *pen-posn*)

	    (define (draw-line-to x y)
		  ((draw-line (get-drawing-window))
		   *pen-posn* (make-mg-posn x y) *current-color*)
		  (position-pen x y))

	    ;; Note: we use unit/sig's renaming feature to avoid
	    ;; conflicts with the original draw-line function in the
	    ;; graphics unit.
	    (define (-draw-line x1 y1 x2 y2)
	      (position-pen x1 y1)
	      (draw-line-to x2 y2))

	    (define (draw-point x y)
	      ((draw-pixel (get-drawing-window)) (make-mg-posn x y) *current-color*))

	    (define (clear-point x y)
	      ((clear-pixel (get-drawing-window)) (make-mg-posn x y) *current-color*))


	    (define (graphics-text string x y)
	      ((draw-string (get-drawing-window))
	       (make-mg-posn x y) string *current-color*))

	    (define (set-rgb-color red green blue)
	      (set! *current-color* (make-rgb red green blue)))
))


;; This last expression will feed this information to the teachpack
;; exporting system.
(compound-unit/sig
 (import (PLT : plt:userspace^))
 (link (GRAPHICS : graphics^ ((require-library "graphicr.ss" "graphics")
			      (PLT : mzlib:file^)
			      (PLT : mred^)))
       (GAMBITLIKE : gambit-graphics^ (gambit-impl@ GRAPHICS)))
 (export (open GAMBITLIKE)))