suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add support for arc-drawing to animation library

Browse Source 
svn: r10366
This commit is contained in:
Greg Cooper 2008-06-19 00:33:00 +00:00
parent 6864cae36f
commit 4dadad2d71
3 changed files with 63 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/frtime/animation.ss
View File

@ -96,6 +96,8 @@
(define-struct curve (xmin xmax ymin ymax fn))
(define-struct polygon (posn-list posn color))
(define-struct solid-polygon (posn-list posn color))
(define-struct arc (pos width height start-radians end-radians color))
(define-struct solid-arc (pos width height start-radians end-radians color))
(define-struct image (pos renderer))
(define (prep-image file)
@ -144,6 +146,20 @@
(* 2 radius)
(* 2 radius)
(if (undefined? color) "black" color))))]
[($ arc pos width height start-radians end-radians color)
(let ([pos (v-n pos)]
[width (v-n width)]
[height (v-n height)]
[start-radians (v-n start-radians)]
[end-radians (v-n end-radians)])
((draw-arc pixmap) pos width height start-radians end-radians color))]
[($ solid-arc pos width height start-radians end-radians color)
(let ([pos (v-n pos)]
[width (v-n width)]
[height (v-n height)]
[start-radians (v-n start-radians)]
[end-radians (v-n end-radians)])
((draw-solid-arc pixmap) pos width height start-radians end-radians color))]
[($ image pos renderer)
(let ([renderer (v-n renderer)]
[pos (v-n pos)])

46
collects/frtime/graphics-posn-less-unit.ss
View File

@ -523,6 +523,52 @@
(define draw/clear/flip-rectangle (draw/clear/flip 'draw-rectangle))
(define draw/clear/flip-ellipse (draw/clear/flip 'draw-ellipse))
(define (draw-arc viewport)
(check-viewport 'draw-arc viewport)
(rec draw-arc-viewport
(case-lambda
[(p width height start-radians end-radians)
(draw-arc-viewport p width height (make-rgb 0 0 0))]
[(p width height start-radians end-radians color)
(check 'draw-arc
posn? p "posn"
number? width "number"
number? height "number"
number? start-radians "number"
number? end-radians "number"
(orp color? number?) color "color or index")
(let ([dc (viewport-dc viewport)]
[buffer-dc (viewport-buffer-dc viewport)])
(send dc set-pen (send mred:the-pen-list find-or-create-pen (get-color color) 1 'solid))
(send dc set-brush (send mred:the-brush-list find-or-create-brush "BLACK" 'transparent))
(send buffer-dc set-pen (send mred:the-pen-list find-or-create-pen (get-color color) 1 'solid))
(send buffer-dc set-brush (send mred:the-brush-list find-or-create-brush "BLACK" 'transparent))
(send dc draw-arc (posn-x p) (posn-y p) width height start-radians end-radians)
(send buffer-dc draw-arc (posn-x p) (posn-y p) width height start-radians end-radians))])))
(define (draw-solid-arc viewport)
(check-viewport 'draw-solid-arc viewport)
(rec draw-arc-viewport
(case-lambda
[(p width height start-radians end-radians)
(draw-arc-viewport p width height (make-rgb 0 0 0))]
[(p width height start-radians end-radians color)
(check 'draw-solid-arc
posn? p "posn"
number? width "number"
number? height "number"
number? start-radians "number"
number? end-radians "number"
(orp color? number?) color "color or index")
(let ([dc (viewport-dc viewport)]
[buffer-dc (viewport-buffer-dc viewport)])
(send dc set-pen (send mred:the-pen-list find-or-create-pen (get-color color) 1 'solid))
(send dc set-brush (send mred:the-brush-list find-or-create-brush (get-color color) 'solid))
(send buffer-dc set-pen (send mred:the-pen-list find-or-create-pen (get-color color) 1 'solid))
(send buffer-dc set-brush (send mred:the-brush-list find-or-create-brush (get-color color) 'solid))
(send dc draw-arc (posn-x p) (posn-y p) width height start-radians end-radians)
(send buffer-dc draw-arc (posn-x p) (posn-y p) width height start-radians end-radians))])))
(define (draw-rectangle viewport)
(check-viewport 'draw-rectangle viewport)
(rec draw-rectangle-viewport

1
collects/frtime/graphics-sig.ss
View File

@ -40,6 +40,7 @@
get-pixel get-color-pixel test-pixel
draw-rectangle clear-rectangle flip-rectangle
draw-arc draw-solid-arc
draw-ellipse clear-ellipse flip-ellipse
draw-polygon clear-polygon flip-polygon
draw-solid-rectangle clear-solid-rectangle flip-solid-rectangle