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

Diff of /mcclim/recording.lisp

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

revision 1.71 by mikemac, Mon Apr 28 21:12:20 2003 UTC revision 1.72 by gilbert, Sun May 25 10:37:30 2003 UTC
# Line 1916  according to the flags RECORD and DRAW." Line 1916  according to the flags RECORD and DRAW."
1916  (defmethod scroll-extent :around ((stream output-recording-stream) x y)  (defmethod scroll-extent :around ((stream output-recording-stream) x y)
1917    (when (stream-drawing-p stream)    (when (stream-drawing-p stream)
1918      (call-next-method)))      (call-next-method)))
1919    
1920    ;;; ----------------------------------------------------------------------------
1921    
1922    (defmethod invoke-with-room-for-graphics (cont stream
1923                                                   &key (first-quadrant t)
1924                                                   height
1925                                                   (move-cursor t)
1926                                                   (record-type 'standard-sequence-output-record))
1927      ;; I am not sure what exactly :height should do.
1928      ;; --GB 2003-05-25
1929      (multiple-value-bind (cx cy)
1930          (stream-cursor-position stream)
1931        (let ((record
1932               (with-output-recording-options (stream :draw nil :record t)
1933                 (with-new-output-record (stream record-type)
1934                   (with-drawing-options
1935                       (stream :transformation
1936                               (if first-quadrant
1937                                   (make-scaling-transformation 1 -1)
1938                                   +identity-transformation+))
1939                     (funcall cont stream))))))
1940          (cond ((null height)
1941                 (setf (output-record-position record)
1942                       (values cx cy)))
1943                (t
1944                 (setf (output-record-position record)
1945                       (values cx (- cy (- (bounding-rectangle-height record) height))))))
1946          (with-output-recording-options (stream :draw t :record nil)
1947            (replay-output-record record stream))
1948          (cond (move-cursor
1949                 (setf (stream-cursor-position stream)
1950                       (values (bounding-rectangle-max-x record)
1951                               (bounding-rectangle-max-y record))))
1952                (t
1953                 (setf (stream-cursor-position stream)
1954                       (values cx cy)))))))
1955    

Legend:
Removed from v.1.71  
changed lines
  Added in v.1.72

  ViewVC Help
Powered by ViewVC 1.1.5