/[mcclim]/mcclim/recording.lisp
ViewVC logotype

Diff of /mcclim/recording.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.100 by moore, Tue Jan 20 16:07:26 2004 UTC revision 1.101 by moore, Wed Feb 11 11:08:07 2004 UTC
# Line 1443  were added." Line 1443  were added."
1443    
1444  (def-grecording draw-rectangle ((gs-line-style-mixin)  (def-grecording draw-rectangle ((gs-line-style-mixin)
1445                                  left top right bottom filled)                                  left top right bottom filled)
1446    (let ((border (graphics-state-line-style-border graphic medium)))    (let ((transform (medium-transformation medium))
1447            (border (graphics-state-line-style-border graphic medium)))
1448        (setf (values left top) (transform-position transform left top))
1449        (setf (values right bottom) (transform-position transform right bottom))
1450      (polygon-record-bounding-rectangle      (polygon-record-bounding-rectangle
1451       (vector left top left bottom right bottom right top)       (vector left top left bottom right bottom right top)
1452       t filled line-style border       t filled line-style border
# Line 1479  were added." Line 1482  were added."
1482                                center-x center-y                                center-x center-y
1483                                radius-1-dx radius-1-dy radius-2-dx radius-2-dy                                radius-1-dx radius-1-dy radius-2-dx radius-2-dy
1484                                start-angle end-angle filled)                                start-angle end-angle filled)
1485    (multiple-value-bind (min-x min-y max-x max-y)    (let ((transform (medium-transformation medium)))
1486        (bounding-rectangle* (make-ellipse* center-x center-y      (setf (values center-x center-y)
1487                                            radius-1-dx radius-1-dy            (transform-position transform center-x center-y))
1488                                            radius-2-dx radius-2-dy      (setf (values radius-1-dx radius-1-dy)
1489                                            :start-angle start-angle            (transform-distance transform radius-1-dx radius-1-dy))
1490                                            :end-angle end-angle))      (setf (values radius-2-dx radius-2-dy)
1491      (if filled            (transform-distance transform radius-2-dx radius-2-dy))
1492          (values min-x min-y max-x max-y)      (multiple-value-bind (min-x min-y max-x max-y)
1493          (let ((border (graphics-state-line-style-border graphic medium)))          (bounding-rectangle* (make-ellipse* center-x center-y
1494            (values (- min-x border)                                              radius-1-dx radius-1-dy
1495                    (- min-y border)                                              radius-2-dx radius-2-dy
1496                    (+ max-x border)                                              :start-angle start-angle
1497                    (+ max-y border))))))                                              :end-angle end-angle))
1498          (if filled
1499              (values min-x min-y max-x max-y)
1500              (let ((border (graphics-state-line-style-border graphic medium)))
1501                (values (- min-x border)
1502                        (- min-y border)
1503                        (+ max-x border)
1504                        (+ max-y border)))))))
1505    
1506  (defmethod* (setf output-record-position) :around  (defmethod* (setf output-record-position) :around
1507      (nx ny (record draw-ellipse-output-record))      (nx ny (record draw-ellipse-output-record))
# Line 1512  were added." Line 1522  were added."
1522    
1523  ;;;; Patterns  ;;;; Patterns
1524    
1525    ;;; The Spec says that "transformation only affects the position at
1526    ;;; which the pattern is drawn, not the pattern itself"
1527  (def-grecording draw-pattern (() pattern x y)  (def-grecording draw-pattern (() pattern x y)
1528    (let ((width (pattern-width pattern))    (let ((width (pattern-width pattern))
1529          (height (pattern-height pattern)))          (height (pattern-height pattern))
1530            (transform (medium-transformation medium)))
1531        (setf (values x y) (transform-position transform x y))
1532      (values x y (+ x width) (+ y height))))      (values x y (+ x width) (+ y height))))
1533    
1534  (defmethod* (setf output-record-position) :around (nx ny (record draw-pattern-output-record))  (defmethod* (setf output-record-position) :around (nx ny (record draw-pattern-output-record))
# Line 1552  were added." Line 1566  were added."
1566          (ascent (text-style-ascent text-style (sheet-medium stream)))          (ascent (text-style-ascent text-style (sheet-medium stream)))
1567          (descent (text-style-descent text-style (sheet-medium stream)))          (descent (text-style-descent text-style (sheet-medium stream)))
1568          (height (+ ascent descent))          (height (+ ascent descent))
1569            (transform (medium-transformation medium))
1570          left top right bottom)          left top right bottom)
1571       (setf (values point-x point-y)
1572             (transform-position transform point-x point-y))
1573     (ecase align-x     (ecase align-x
1574       (:left (setq left point-x       (:left (setq left point-x
1575                    right (+ point-x width)))                    right (+ point-x width)))

Legend:
Removed from v.1.100  
changed lines
  Added in v.1.101

  ViewVC Help
Powered by ViewVC 1.1.5