CLIM mail archive
[Prev][Next][Index][Thread]
RE: circle-segments
Date: Fri, 13 Dec 91 16:45:42 GMT
From: Ralf Nikolai <nicolai@gate.fzi.de>
;Hello CLIMer,
;I have some troubles with the drawing-circle function. It works well, if
;I want to draw full circles, not specifying start- and end-angle. If I
;give values to these keywords the debugger always tells me:
;Trap: The function CLIM-UTILS::NYI is undefined.
Here are a couple of patches to clim 1.0 that should offer some
relief until the vendors catch up with the developers. It still
contains a couple of NYI calls, but those cases do not occur for
circles (only generalized ellipses).
Here is a fix that make all of the platforms work somewhat better:
(in-package :clim-utils)
(defun elliptical-arc-box (center-x center-y radius-1-dx radius-1-dy radius-2-dx radius-2-dy
theta-1 theta-2 thickness)
(let* ((filled (null thickness))
(thickness (or thickness 0))
(lthickness (floor thickness 2))
(rthickness (- thickness lthickness)))
(when (null theta-1)
(return-from elliptical-arc-box
(let ((dx (+ (abs radius-1-dx) (abs radius-2-dx)))
(dy (+ (abs radius-1-dy) (abs radius-2-dy))))
(fix-rectangle (- center-x dx lthickness) (- center-y dy lthickness)
(+ center-x dx rthickness) (+ center-y dy rthickness)))))
(setq theta-1 (mod theta-1 2pi)
theta-2 (mod theta-2 2pi))
;;--- Fix the NYI stuff some year
(let* ((x-radius (cond ((zerop radius-1-dx) radius-2-dx)
((zerop radius-2-dx) radius-1-dx)
(t (nyi))))
(y-radius (cond ((zerop radius-1-dy) radius-2-dy)
((zerop radius-2-dy) radius-1-dy)
(t (nyi))))
(x1 (+ center-x (* x-radius (cos theta-1))))
(y1 (+ center-y (* y-radius (sin theta-1))))
(x2 (+ center-x (* x-radius (cos theta-2))))
(y2 (+ center-y (* y-radius (sin theta-2))))
(left (min x1 x2))
(top (min y1 y2))
(right (max x1 x2))
(bottom (max y1 y2)))
(when (angle-between-angles-p pi-single-float theta-1 theta-2)
(minf left (- center-x x-radius)))
(when (angle-between-angles-p (* pi-single-float 3/2) theta-1 theta-2)
(minf top (- center-y y-radius)))
(when (angle-between-angles-p 0 theta-1 theta-2)
(maxf right (+ center-x x-radius)))
(when (angle-between-angles-p pi/2 theta-1 theta-2)
(maxf bottom (+ center-y y-radius)))
(when filled
(minf left center-x)
(minf top center-y)
(maxf right center-x)
(maxf bottom center-y))
(fix-rectangle (- left lthickness) (- top lthickness)
(+ right rthickness) (+ bottom rthickness)))))
Here is a fix that makes Genera work a little better:
(in-package :clim)
(defmethod draw-ellipse-internal ((stream sheet-implementation-mixin) x-offset y-offset
center-x center-y
radius-1-dx radius-1-dy radius-2-dx radius-2-dy
start-angle end-angle ink line-style)
(when (window-drawing-possible stream)
(round-points center-x center-y radius-1-dx radius-1-dy radius-2-dx radius-2-dy)
(translate-positions x-offset y-offset center-x center-y)
(when (and start-angle
(= start-angle 0.0)
(= end-angle 2pi))
;; GRAPHICS:DRAW-CIRCLE draws nothing when given single-precision 2PI
(setq end-angle graphics:2pi))
(multiple-value-bind (pre-stretch-angle x-radius y-radius axis-rotate-angle)
(2x2-singular-value-decomposition radius-1-dx radius-2-dx
radius-1-dy radius-2-dy)
(declare (ignore pre-stretch-angle))
(setq x-radius (abs x-radius) y-radius (abs y-radius))
(if (and (= x-radius y-radius) (null start-angle))
;; It's a complete circle
(with-appropriate-drawing-state stream ink line-style
#'(lambda (window alu)
(declare (sys:downward-function))
(if (null line-style)
(funcall window :draw-filled-in-circle center-x center-y x-radius alu)
(funcall window :draw-circle center-x center-y x-radius alu)))
#'(lambda (window)
(declare (sys:downward-function))
(funcall (flavor:generic graphics:draw-ellipse) window
center-x center-y x-radius y-radius
:filled (null line-style))))
;; For general ellipse, let Genera do all the work
(with-appropriate-drawing-state stream ink line-style
nil
#'(lambda (window)
(declare (sys:downward-function))
(graphics:saving-graphics-transform (window)
(graphics:graphics-translate center-x center-y :stream window)
(when (/= axis-rotate-angle 0)
(graphics:graphics-rotate axis-rotate-angle :stream window))
(funcall (flavor:generic graphics:draw-ellipse) window
0 0 x-radius y-radius
:start-angle (or start-angle 0)
:end-angle (or end-angle graphics:2pi)
:filled (null line-style)))))))))
0,,
Main Index |
Thread Index