From 4dadad2d719650e63288ffe1f163343810a7d071 Mon Sep 17 00:00:00 2001
From: Greg Cooper <greg@cs.brown.edu>
Date: Thu, 19 Jun 2008 00:33:00 +0000
Subject: [PATCH] add support for arc-drawing to animation library

svn: r10366
---
 collects/frtime/animation.ss               | 16 ++++++++
 collects/frtime/graphics-posn-less-unit.ss | 46 ++++++++++++++++++++++
 collects/frtime/graphics-sig.ss            |  1 +
 3 files changed, 63 insertions(+)

diff --git a/collects/frtime/animation.ss b/collects/frtime/animation.ss
index 0377c09621..9896f2f395 100644
--- a/collects/frtime/animation.ss
+++ b/collects/frtime/animation.ss
@@ -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)])
diff --git a/collects/frtime/graphics-posn-less-unit.ss b/collects/frtime/graphics-posn-less-unit.ss
index 23a5daf039..84dc9c2fa3 100644
--- a/collects/frtime/graphics-posn-less-unit.ss
+++ b/collects/frtime/graphics-posn-less-unit.ss
@@ -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
diff --git a/collects/frtime/graphics-sig.ss b/collects/frtime/graphics-sig.ss
index e3d8a27add..fde1fde1d8 100644
--- a/collects/frtime/graphics-sig.ss
+++ b/collects/frtime/graphics-sig.ss
@@ -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