CLIM mail archive


RE: circle-segments

    Date:     Fri, 13 Dec 91 16:45:42 GMT
    From: Ralf Nikolai <>

    ;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
	  #'(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)))))))))

Main Index | Thread Index