From junrue at common-lisp.net Mon Oct 1 01:10:38 2007 From: junrue at common-lisp.net (junrue) Date: Sun, 30 Sep 2007 21:10:38 -0400 (EDT) Subject: [mcclim-cvs] CVS mcclim/Backends/Graphic-Forms Message-ID: <20071001011038.62E74240C7@common-lisp.net> 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)) From junrue at common-lisp.net Mon Oct 1 01:12:15 2007 From: junrue at common-lisp.net (junrue) Date: Sun, 30 Sep 2007 21:12:15 -0400 (EDT) Subject: [mcclim-cvs] CVS mcclim/Backends/Graphic-Forms Message-ID: <20071001011215.EB2152400C@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms In directory clnet:/tmp/cvs-serv23469 Modified Files: medium.lisp Log Message: oops, forgot to remove old ellipse code --- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/10/01 01:10:35 1.10 +++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/10/01 01:12:15 1.11 @@ -366,44 +366,6 @@ (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 - 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* ((radius-dx (abs (+ radius-1-dx radius-2-dx))) - (radius-dy (abs (+ radius-1-dy radius-2-dy))) - (min-x (floor (- center-x radius-dx))) - (min-y (floor (- center-y radius-dy))) - (max-x (floor (+ center-x radius-dx))) - (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)))) - (end-point - (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-arc gc rect start-point end-point))))) - (add-medium-to-render medium))) -|# - -;; FIXME: completely untested. (defmethod medium-draw-circle* ((medium graphic-forms-medium) center-x center-y radius start-angle end-angle filled) From junrue at common-lisp.net Mon Oct 1 01:19:34 2007 From: junrue at common-lisp.net (junrue) Date: Sun, 30 Sep 2007 21:19:34 -0400 (EDT) Subject: [mcclim-cvs] CVS mcclim/Backends/Graphic-Forms Message-ID: <20071001011934.9F4042E200@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms In directory clnet:/tmp/cvs-serv23798 Modified Files: medium.lisp Log Message: fix dumb mistake in COMPUTE-ARC-POINT where I handle the angle > 360 case --- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/10/01 01:12:15 1.11 +++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/10/01 01:19:34 1.12 @@ -307,28 +307,28 @@ (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))))))) + (setf angle 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 From rgoldman at common-lisp.net Sun Oct 7 18:10:50 2007 From: rgoldman at common-lisp.net (rgoldman) Date: Sun, 7 Oct 2007 14:10:50 -0400 (EDT) Subject: [mcclim-cvs] CVS mcclim/Experimental/new-dag-layout Message-ID: <20071007181050.C698643233@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Experimental/new-dag-layout In directory clnet:/tmp/cvs-serv22841/new-dag-layout Log Message: Directory /project/mcclim/cvsroot/mcclim/Experimental/new-dag-layout added to the repository From thenriksen at common-lisp.net Fri Oct 26 17:01:15 2007 From: thenriksen at common-lisp.net (thenriksen) Date: Fri, 26 Oct 2007 13:01:15 -0400 (EDT) Subject: [mcclim-cvs] CVS mcclim Message-ID: <20071026170115.F121649087@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv13759 Modified Files: text-editor-gadget.lisp Log Message: Restored value-changed-callback to workingness for text-field gadgets. --- /project/mcclim/cvsroot/mcclim/text-editor-gadget.lisp 2007/08/21 22:09:01 1.9 +++ /project/mcclim/cvsroot/mcclim/text-editor-gadget.lisp 2007/10/26 17:01:15 1.10 @@ -361,14 +361,15 @@ &key id client armed-callback disarmed-callback activation-gestures activate-callback - value) + value value-changed-callback) ;; Make an editor substrate object for the gadget. (let ((substrate (make-text-field-substrate object :id id :client client :armed-callback armed-callback :disarmed-callback disarmed-callback :activation-gestures activation-gestures :activate-callback activate-callback - :value value))) + :value value + :value-changed-callback value-changed-callback))) (setf (substrate object) substrate) (sheet-adopt-child object substrate)))