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

Diff of /mcclim/recording.lisp

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

revision 1.141 by ahefner, Sun Apr 13 07:32:40 2008 UTC revision 1.142 by ahefner, Tue Aug 19 15:56:50 2008 UTC
# Line 1718  were added." Line 1718  were added."
1718         (if-supplied (pattern pattern)         (if-supplied (pattern pattern)
1719           (eq (slot-value record 'pattern) pattern))))           (eq (slot-value record 'pattern) pattern))))
1720    
1721    ;;;; RGB images
1722    
1723    (def-grecording draw-image-design (() image-design x y) ()
1724      (let ((width (image-width (image image-design)))
1725            (height (image-height (image image-design)))
1726            (transform (medium-transformation medium)))
1727        (setf (values x y) (transform-position transform x y))
1728        (values x y (+ x width) (+ y height))))
1729    
1730    (defmethod* (setf output-record-position) :around
1731                (nx ny (record draw-image-design-output-record))
1732      (with-standard-rectangle* (:x1 x1 :y1 y1) record
1733        (with-slots (x y) record
1734          (let ((dx (- nx x1))
1735                (dy (- ny y1)))
1736            (multiple-value-prog1 (call-next-method)
1737              (incf x dx)
1738              (incf y dy))))))
1739    
1740    (defrecord-predicate draw-image-design-output-record (x y image-design)
1741      (and (if-supplied (x coordinate)
1742             (coordinate= (slot-value record 'x) x))
1743           (if-supplied (y coordinate)
1744             (coordinate= (slot-value record 'y) y))
1745           (if-supplied (image-design rgb-image-design)
1746             (eq (slot-value record 'image-design) image-design))))
1747    
1748  ;;;; Text  ;;;; Text
1749    
1750  (def-grecording draw-text ((gs-text-style-mixin) string point-x point-y start end  (def-grecording draw-text ((gs-text-style-mixin) string point-x point-y start end

Legend:
Removed from v.1.141  
changed lines
  Added in v.1.142

  ViewVC Help
Powered by ViewVC 1.1.5