From 03663a2cfc366e5929a1efaabfd3bcaa4ad8b2d1 Mon Sep 17 00:00:00 2001 From: tomj <tomj> Date: Wed, 12 Feb 1997 02:08:51 +0000 Subject: [PATCH] missed this (part of smh's ellipse patch) in last commit --- clim/graphics-recording.lisp | 133 ++++++++++++++++++++++------------- 1 file changed, 85 insertions(+), 48 deletions(-) diff --git a/clim/graphics-recording.lisp b/clim/graphics-recording.lisp index 2b12c85e..507ee192 100644 --- a/clim/graphics-recording.lisp +++ b/clim/graphics-recording.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/clim/graphics-recording.lisp,v 1.28 1997/02/05 01:43:43 tomj Exp $ +;; $Header: /repo/cvs.copy/clim2/clim/graphics-recording.lisp,v 1.29 1997/02/12 02:08:51 tomj Exp $ (in-package :clim-internals) @@ -466,57 +466,94 @@ result))) +;; This revision of the ellipse functions fixes several problems: - smh 10Jan97 +;; - The bounding box and drawing calculations had different +;; notions about the y-axis sign. (The windows back end also needs to +;; be revised to agree with this fix.) +;; - angle-between-angles-p did exact comparisons, but computations +;; in radians (involving pi) are necessarily approximate. +;; But there are still bugs: +;; - X (and presumably also Windows) take start and end in skewed angles. +;; CLIM defines these arguments in non-skewed form. Thios might just be a bug +;; in the CLIM standard, but anyway, no one has ever noticed. Anyway, until +;; this is resolved the start/end angle refined position test cannot be fixed. +;; For ellipses spanning less than PI radians, the bounding box is sufficient +;; and the start/end limit checks are redundant. But for larger spans the +;; bounding-box check is ineffective, and the entire 2PI span of the ellipse +;; will be sensitive to input. + (define-graphics-recording draw-ellipse (ink line-style clipping-region) :bounding-rectangle - (multiple-value-bind (left top right bottom) - (elliptical-arc-box - center-x center-y - radius-1-dx radius-1-dy radius-2-dx radius-2-dy - start-angle end-angle - (line-style-thickness (medium-line-style medium))) - ;; Make this a bit too big because most hosts rasterize ellipses - ;; to be a shade too big on the right - (values left top (1+ right) (1+ bottom))) + (multiple-value-bind (left top right bottom) + (elliptical-arc-box center-x center-y + radius-1-dx radius-1-dy radius-2-dx radius-2-dy + start-angle end-angle + (line-style-thickness (medium-line-style medium))) + ;; Make this a bit too big because most hosts rasterize ellipses + ;; to be a shade too big on the right + (values left top (1+ right) (1+ bottom))) :refined-position-test - ((x y) - (with-slots (center-x center-y - radius-1-dx radius-1-dy radius-2-dx radius-2-dy - start-angle end-angle ink line-style) record - (and (or (null start-angle) - ;; NYI - check for within the proper angle - t) - (if (null line-style) - (point-inside-ellipse-p (- x center-x) (- y center-y) - radius-1-dx radius-1-dy radius-2-dx radius-2-dy) - (point-on-thick-ellipse-p (- x center-x) (- y center-y) - radius-1-dx radius-1-dy radius-2-dx radius-2-dy - (ceiling (line-style-thickness line-style) 2)))))) + ((x y) + (with-slots (center-x center-y + radius-1-dx radius-1-dy radius-2-dx radius-2-dy + start-angle end-angle ink line-style) record + ;; Added test for angle. -smh 26dec96 + (let ((z nil)) + (and (if (null line-style) + (point-inside-ellipse-p (- x center-x) (- y center-y) + radius-1-dx radius-1-dy radius-2-dx radius-2-dy) + (point-on-thick-ellipse-p (- x center-x) (- y center-y) + radius-1-dx radius-1-dy radius-2-dx radius-2-dy + (ceiling (line-style-thickness line-style) 2))) + ;; These start and end angle tests, although slow, are probably correct. + ;; Unfortunately, the drawing functions in both X and Windows neglect + ;; to take into accout that non-circular ellipses are define in terms of + ;; skewed angles. See you favorite Xlib manual fdor details. + ;; - smh 30Dec96 + #+never + (or (null start-angle) + (progn (setq z (phase (complex (- x center-x) (- center-y y)))) + (loop + while (<= z start-angle) + do (incf z 2pi)) + t)) + #+never + (or (null end-angle) + (loop + initially (unless z + (setq z (phase (complex (- x center-x) (- center-y y))))) + with start = (or start-angle 0) + while (<= z start) + do (incf z 2pi)) + #+never (format *trace-output* "~&[~f,~f] end ~f ~f~%" + (- x center-x) (- y center-y) end-angle z) + (<= z end-angle)))))) :highlighting-function - ((stream state) - (declare (ignore state)) - (multiple-value-bind (xoff yoff) - (convert-from-relative-to-absolute-coordinates - stream (output-record-parent record)) - (with-slots (center-x center-y - radius-1-dx radius-1-dy radius-2-dx radius-2-dy - start-angle end-angle ink line-style) record - (let ((delta 2) - (radius-1 (sqrt (+ (* radius-1-dx radius-1-dx) (* radius-1-dy radius-1-dy)))) - (radius-2 (sqrt (+ (* radius-2-dx radius-2-dx) (* radius-2-dy radius-2-dy))))) - (when line-style - (incf delta (ceiling (line-style-thickness line-style) 2))) - (let ((delta-1-dx (round (* delta radius-1-dx) radius-1)) - (delta-1-dy (round (* delta radius-1-dy) radius-1)) - (delta-2-dx (round (* delta radius-2-dx) radius-2)) - (delta-2-dy (round (* delta radius-2-dy) radius-2))) - (with-output-recording-options (stream :record nil) - (draw-ellipse-internal - stream xoff yoff - center-x center-y - (+ radius-1-dx delta-1-dx) (+ radius-1-dy delta-1-dy) - (+ radius-2-dx delta-2-dx) (+ radius-2-dy delta-2-dy) - start-angle end-angle - +flipping-ink+ +highlighting-line-style+)))))))) + ((stream state) + (declare (ignore state)) + (multiple-value-bind (xoff yoff) + (convert-from-relative-to-absolute-coordinates + stream (output-record-parent record)) + (with-slots (center-x center-y + radius-1-dx radius-1-dy radius-2-dx radius-2-dy + start-angle end-angle ink line-style) record + (let ((delta 2) + (radius-1 (sqrt (+ (* radius-1-dx radius-1-dx) (* radius-1-dy radius-1-dy)))) + (radius-2 (sqrt (+ (* radius-2-dx radius-2-dx) (* radius-2-dy radius-2-dy))))) + (when line-style + (incf delta (ceiling (line-style-thickness line-style) 2))) + (let ((delta-1-dx (round (* delta radius-1-dx) radius-1)) + (delta-1-dy (round (* delta radius-1-dy) radius-1)) + (delta-2-dx (round (* delta radius-2-dx) radius-2)) + (delta-2-dy (round (* delta radius-2-dy) radius-2))) + (with-output-recording-options (stream :record nil) + (draw-ellipse-internal + stream xoff yoff + center-x center-y + (+ radius-1-dx delta-1-dx) (+ radius-1-dy delta-1-dy) + (+ radius-2-dx delta-2-dx) (+ radius-2-dy delta-2-dy) + start-angle end-angle + +flipping-ink+ +highlighting-line-style+)))))))) (define-graphics-recording draw-bezier-curve (ink line-style clipping-region) -- GitLab