Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv20781
Modified Files: bezier.lisp Log Message: In bezier area/curve convolution, don't put the area (pen) down quite so often: reduces redundant areas in unions from draw-path in gsharp.
(Also rename convlute -> convolve)
--- /project/mcclim/cvsroot/mcclim/bezier.lisp 2007/07/11 15:26:20 1.2 +++ /project/mcclim/cvsroot/mcclim/bezier.lisp 2007/07/17 06:36:01 1.3 @@ -568,7 +568,13 @@ (add-points p1 left) (add-points p0 left)) (make-line-segment (add-points p0 left) (add-points p0 right)))))))
-(defun convolute-polygon-and-segment (area polygon segment) +(defun area-at-point (area point) + (let ((transformation + (make-translation-transformation (point-x point) (point-y point)))) + (transform-region transformation area))) + +(defun convolve-polygon-and-segment (area polygon segment first) + (declare (optimize debug)) (let* ((points (polygon-points polygon)) (sides (loop for (p0 p1) on (append (last points) points) until (null p1) @@ -576,24 +582,20 @@ (split-points (find-split-points sides segment)) (segments (split-segment segment split-points))) (loop for segment in segments - append (list (let* ((p (slot-value segment 'p0)) - (transformation (make-translation-transformation - (point-x p) (point-y p)))) - (transform-region transformation area)) - (convert-primitive-segment-to-bezier-area (polygon-points polygon) - segment) - (let* ((p (slot-value segment 'p3)) - (transformation (make-translation-transformation - (point-x p) (point-y p)))) - (transform-region transformation area)))))) + if first collect (area-at-point area (slot-value segment 'p0)) + collect (convert-primitive-segment-to-bezier-area + (polygon-points polygon) segment) + collect (area-at-point area (slot-value segment 'p3)))))
-(defgeneric convolute-regions (area path)) +(defgeneric convolve-regions (area path))
-(defmethod convolute-regions ((area bezier-area) (path bezier-curve)) +(defmethod convolve-regions ((area bezier-area) (path bezier-curve)) (let ((polygon (polygonalize area))) - (make-instance 'bezier-union - :areas (loop for segment in (%segments path) - append (convolute-polygon-and-segment area polygon segment))))) + (make-instance + 'bezier-union :areas + (loop for segment in (%segments path) + for first = t then nil + append (convolve-polygon-and-segment area polygon segment first)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -793,6 +795,7 @@ (defmethod medium-draw-bezier-design* (medium design) (render-through-pixmap design medium))
+#| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Test cases @@ -806,3 +809,4 @@ (defparameter *r4* (make-bezier-curve* '(100 100 120 150 160 160 170 160)))
(defparameter *r5* (convolute-regions *r2* *r4*)) +|#