#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 500) (define height 500) (define frame (new frame% (label "Drawing Window") (width width) (height height))) (define bm (make-object bitmap% width height)) (define canvas (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 test (lambda () (show-window) (clear) (rectangle 20 30 300 210 255 0 120 0.5) (ellipse 120 100 135 265 43 154 0 0.5) (line 0 0 width height 10 64 0 255 0.5))) (test)