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

Diff of /mcclim/recording.lisp

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

revision 1.115 by hefner1, Thu Oct 14 06:30:11 2004 UTC revision 1.116 by tmoore, Wed Feb 2 11:33:58 2005 UTC
# Line 2190  according to the flags RECORD and DRAW." Line 2190  according to the flags RECORD and DRAW."
2190      (call-next-method)))      (call-next-method)))
2191    
2192  ;;; ----------------------------------------------------------------------------  ;;; ----------------------------------------------------------------------------
2193    ;;; Complicated, underspecified...
2194    ;;;
2195    ;;; From examining old Genera documentation, I believe that
2196    ;;; with-room-for-graphics is supposed to set the medium transformation to
2197    ;;; give the desired coordinate system; i.e., it doesn't preserve any
2198    ;;; rotation, scaling or translation in the current medium transformation.
2199  (defmethod invoke-with-room-for-graphics (cont stream  (defmethod invoke-with-room-for-graphics (cont stream
2200                                                 &key (first-quadrant t)                                            &key (first-quadrant t)
2201                                                 height                                            height
2202                                                 (move-cursor t)                                            (move-cursor t)
2203                                                 (record-type 'standard-sequence-output-record))                                            (record-type
2204                                               'standard-sequence-output-record))
2205    ;; I am not sure what exactly :height should do.    ;; I am not sure what exactly :height should do.
2206    ;; --GB 2003-05-25    ;; --GB 2003-05-25
2207    ;; The current behavior is consistent with 'classic' CLIM    ;; The current behavior is consistent with 'classic' CLIM
2208    ;; --Hefner 2004-06-19    ;; --Hefner 2004-06-19
2209      ;; Don't know if it still is :)
2210      ;; -- Moore 2005-01-26
2211    (multiple-value-bind (cx cy)    (multiple-value-bind (cx cy)
2212        (stream-cursor-position stream)        (stream-cursor-position stream)
2213      (let ((record      (with-sheet-medium (medium stream)
2214             (with-output-recording-options (stream :draw nil :record t)        (letf (((medium-transformation medium)
2215               (with-new-output-record (stream record-type)                (if first-quadrant
2216                 (with-drawing-options                    (make-scaling-transformation 1 -1)
2217                     (stream :transformation                    +identity-transformation+)))
2218                             (if first-quadrant          (let ((record (with-output-to-output-record (stream record-type)
2219                                 (make-scaling-transformation 1 -1)                          (funcall cont stream))))
2220                                 +identity-transformation+))            ;; Bounding  rectangle is in sheet coordinates!
2221                   (funcall cont stream))))))            (with-bounding-rectangle* (x1 y1 x2 y2)
2222        (cond ((null height)                record
2223               (setf (output-record-position record)              (declare (ignore x2))
2224                     (values cx cy)))              (if first-quadrant
2225              (t                  (setf (output-record-position record)
2226               (setf (output-record-position record)                        (values (max cx (+ cx x1))
2227                     (values cx                                (if height
2228                             (- cy (- (bounding-rectangle-height record) height))))))                                    (max cy (+ cy (- height (- y2 y1))))
2229        (with-output-recording-options (stream :draw t :record nil)                                    cy)))
2230          (replay-output-record record stream))                  (setf (output-record-position record)
2231        (cond (move-cursor                        (values (max cx (+ cx x1)) (max cy (+ cy y1)))))
2232               (setf (stream-cursor-position stream)              (when (stream-recording-p stream)
2233                     (values (bounding-rectangle-max-x record)                (stream-add-output-record stream record))
2234                             (bounding-rectangle-max-y record))))              (when (stream-drawing-p stream)
2235              (t                (replay record stream))
2236               (setf (stream-cursor-position stream)              (if move-cursor
2237                     (values cx cy)))))))                  (let ((record-height (- y2 y1)))
2238                      (setf (stream-cursor-position stream)
2239                            (values cx
2240                                    (if first-quadrant
2241                                        (+ cy (max (- y1)
2242                                                   (or height 0)
2243                                                   record-height))
2244                                        (+ cy (max (or height 0)
2245                                                   record-height))))))
2246                    (setf (stream-cursor-position stream) (values cx cy)))
2247                record))))))
2248    
2249    
2250    
2251  (defmethod repaint-sheet ((sheet output-recording-stream) region)  (defmethod repaint-sheet ((sheet output-recording-stream) region)

Legend:
Removed from v.1.115  
changed lines
  Added in v.1.116

  ViewVC Help
Powered by ViewVC 1.1.5