Update of /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms
In directory clnet:/tmp/cvs-serv23182
Modified Files:
medium.lisp utils.lisp
Log Message:
fix calculation of start and end points for MEDIUM-DRAW-ELLIPSE* (and thus
MEDIUM-DRAW-CIRCLE*)
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/09/30 21:12:50 1.9
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/10/01 01:10:35 1.10
@@ -295,6 +295,78 @@
(gfg:draw-rectangle gc rect)))))))))
(add-medium-to-render medium)))
+(defun compute-quad-point (center-x height angle)
+ (let* ((opp-len (/ height 2))
+ (hyp-len (/ opp-len (sin angle)))
+ (adj-len (sqrt (- (expt hyp-len 2) (expt opp-len 2)))))
+ (gfs:make-point :x (floor (+ center-x adj-len))
+ :y (floor opp-len))))
+
+(defun compute-arc-point (center-x center-y width height radians)
+ (let ((angle (radians->degrees radians)))
+ (multiple-value-bind (count remainder)
+ (floor angle 360)
+ (if (> count 0)
+ (compute-arc-point center-x center-y width height remainder)
+ (cond
+ ((= angle 270)
+ (gfs:make-point :x (floor center-x)
+ :y (+ (floor center-y) (floor height 2))))
+ ((> angle 270)
+ (compute-quad-point center-x height (- angle 270)))
+ ((= angle 180)
+ (gfs:make-point :x (- (floor center-x) (floor width 2))
+ :y (floor center-y)))
+ ((> angle 180)
+ (compute-quad-point center-x height (- angle 180)))
+ ((= angle 90)
+ (gfs:make-point :x (floor center-x)
+ :y (- (floor center-y) (floor height 2))))
+ ((> angle 90)
+ (compute-quad-point center-x height(- angle 90)))
+ ((= angle 0)
+ (gfs:make-point :x (+ (floor center-x) (floor width 2))
+ :y (floor center-y)))
+ (t
+ (compute-quad-point center-x height angle)))))))
+
+(defmethod medium-draw-ellipse* ((medium graphic-forms-medium)
+ center-x center-y
+ radius-1-dx radius-1-dy
+ radius-2-dx radius-2-dy
+ start-angle end-angle
+ filled)
+ (unless (or (= radius-2-dx radius-1-dy 0)
+ (= radius-1-dx radius-2-dy 0))
+ (error "MEDIUM-DRAW-ELLIPSE* not for non axis-aligned ellipses."))
+ (when (target-of medium)
+ (gfw:with-graphics-context (gc (target-of medium))
+ (let ((color (ink-to-color medium (medium-ink medium))))
+ (if filled
+ (setf (gfg:background-color gc) color))
+ (setf (gfg:foreground-color gc) color))
+ (climi::with-transformed-position
+ ((sheet-native-transformation (medium-sheet medium))
+ center-x center-y)
+ (let* ((width (abs (+ radius-1-dx radius-2-dx)))
+ (height (abs (+ radius-1-dy radius-2-dy)))
+ (min-x (floor (- center-x width)))
+ (min-y (floor (- center-y height)))
+ (max-x (floor (+ center-x width)))
+ (max-y (floor (+ center-y height)))
+ (rect (coordinates->rectangle min-x min-y max-x max-y))
+ (start-pnt (compute-arc-point center-x center-y
+ width height
+ start-angle))
+ (end-pnt (compute-arc-point center-x center-y
+ width height
+ end-angle)))
+ (if filled
+ (gfg:draw-filled-pie-wedge gc rect start-pnt end-pnt)
+ (gfg:draw-arc gc rect start-pnt end-pnt)))))
+ (add-medium-to-render medium)))
+
+#|
;; FIXME: completely untested. Not sure we're even using the right GFG h
;; functions. Are start-point and end-point right?
(defmethod medium-draw-ellipse* ((medium graphic-forms-medium) center-x center-y
@@ -320,19 +392,16 @@
(max-y (floor (+ center-y radius-dy)))
(rect (coordinates->rectangle min-x min-y max-x max-y))
(start-point
- (gfs:make-point :x (floor
- (* (cos start-angle) radius-dx))
- :y (floor
- (* (sin start-angle) radius-dy))))
+ (gfs:make-point :x (floor (* (cos start-angle) radius-dx))
+ :y (floor (* (sin start-angle) radius-dy))))
(end-point
- (gfs:make-point :x (floor
- (* (cos end-angle) radius-dx))
- :y (floor
- (* (sin end-angle) radius-dy)))))
+ (gfs:make-point :x (floor (* (cos end-angle) radius-dx))
+ :y (floor (* (sin end-angle) radius-dy)))))
(if filled
(gfg:draw-filled-pie-wedge gc rect start-point end-point)
- (gfg:draw-pie-wedge gc rect start-point end-point)))))
+ (gfg:draw-arc gc rect start-point end-point)))))
(add-medium-to-render medium)))
+|#
;; FIXME: completely untested.
(defmethod medium-draw-circle* ((medium graphic-forms-medium)
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/utils.lisp 2007/09/09 03:47:08 1.3
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/utils.lisp 2007/10/01 01:10:35 1.4
@@ -44,3 +44,7 @@
(loop for i from 0 below (length seq) by 2
collect (gfs:make-point :x (floor (elt seq i))
:y (floor (elt seq (+ i 1))))))
+
+(declaim (inline radians->degrees))
+(defun radians->degrees (rads)
+ (floor (* rads 180) pi))
