#lang scheme/gui

;; better-draw.ss
;; Lee Spector, lspector@hampshire.edu, 20091016
;; Simple code for drawing shapes in a separate window in DrScheme.
;; Bitmaps added with the assistance of Adria Claire Matthews
;;
;; Users of original "draw.ss" note change of make-window to show-window
;; and addition of "line".
;;
;; User functions:
;; (show-window) -- creates the window
;; (clear) -- clears the drawing
;; (ellipse x y width height r g b a) -- draw ellipse; r g & b are 0-255, a is 0.0-1.0
;; (rectangle x y width height r g b a) -- draw ellipse; r g & b are 0-255, a is 0.0-1.0
;; (line x1 y1 x2 y2 width r g b a) -- draw line with width; r g & b are 0-255, a is 0.0-1.0

(define width 700)
(define height 950)

(define new-canvas% (class canvas% (super-new)
                      (define/override (on-char key)
                        (cond 
                          ((equal? (send key get-key-code) 'left) (leftdodge))
                          ((equal? (send key get-key-code) 'right) (righttdodge))
                          ((equal? (send key get-key-code) 'up) (updodge))
                          ((equal? (send key get-key-code) 'down) (downdodge))))))
                          ;((equal? (send key get-key-code) 'z) (shotweb))
                          ;((equal? (send key get-key-code) 'x) ))


(define frame (new frame% (label "Drawing Window")
                   (width width)
                   (height height)))

(define bm (make-object bitmap% width height))

(define canvas
  (new new-canvas% [parent frame]
       [paint-callback (lambda (canvas dc)
                         (send dc draw-bitmap bm 0 0))]))

(define dc (make-object bitmap-dc% bm))
(send dc clear)
(send dc set-pen (make-object pen% "BLACK" 1 'transparent)) ;; No pen
(send dc set-smoothing 'smoothed)

(define show-window
  (lambda ()
    (send frame show #t)))

(define ellipse
  (lambda (x y width height r g b a)
    (send dc set-brush (make-object brush% (make-object color% r g b) 'solid))
    (send dc set-alpha a)
    (send dc draw-ellipse x y width height)
    (send canvas refresh)))

(define rectangle
  (lambda (x y width height r g b a)
    (send dc set-brush (make-object brush% (make-object color% r g b) 'opaque))
    (send dc set-alpha a)
    (send dc draw-rectangle x y width height)
    (send canvas refresh)))

(define line
  (lambda (x1 y1 x2 y2 width r g b a)
    (let ((pen (make-object pen% "BLACK" width 'solid)))
      (send pen set-color r g b)
      (send dc set-pen pen)
      (send dc set-alpha a)
      (send dc draw-line x1 y1 x2 y2)
      (send canvas refresh))
    (send dc set-pen (make-object pen% "BLACK" 1 'transparent))))

(define clear
  (lambda ()
    (rectangle 0 0 width height 255 255 255 1.0)))

(define store null)

(define GO
  (lambda ((x 0) (y 0))
    (show-window)
    (clear)
    (char x y)))

(define char
  (lambda (x y)
    (rectangle x y 20 35 0 0 255 1.0)
    (ellipse (+ x 5) (- y 5) 10 10 255 0 0 1.0)
    (ellipse (+ x 5) (+ y 17.5) 10 10 0 128 255 1.0)
    (set! store (list x y))
    )) 

(define erase-char
  (lambda ((x (first store)) (y (second store)))
    (rectangle (- x 5) (- y 5) 60 60 255 255 255 1.0)))

(define leftdodge
  (lambda ()
    (for ((n (in-range (first store) (- (first store) 10) -1)))
      (erase-char)
      (char n (second store))
      (sleep/yield .0001))))

(define righttdodge
  (lambda ()
    (for ((n (in-range (first store) (+ (first store) 10))))
      (erase-char)
      (char n (second store))
      (sleep/yield .0001))))

(define updodge
  (lambda ()
    (for ((n (in-range (second store) (- (second store) 10) -1)))
      (erase-char)
      (char (first store) n)
      (sleep/yield .0001))))

(define downdodge
  (lambda ()
    (for ((n (in-range (second store) (+ (second store) 10))))
      (erase-char)
      (char (first store) n)
      (sleep/yield .0001))))

;(define shotweb
  ;(lambda ()