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

Diff of /mcclim/recording.lisp

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

revision 1.72 by gilbert, Sun May 25 10:37:30 2003 UTC revision 1.73 by gilbert, Wed May 28 18:59:52 2003 UTC
# Line 560  recording stream. If it is T, *STANDARD- Line 560  recording stream. If it is T, *STANDARD-
560                                      stream state)                                      stream state)
561    ;; XXX DC    ;; XXX DC
562    ;; XXX Disable recording?    ;; XXX Disable recording?
563    (letf (((medium-transformation stream) +identity-transformation+))    (with-identity-transformation (stream)
564      (multiple-value-bind (x1 y1 x2 y2)      (multiple-value-bind (x1 y1 x2 y2)
565          (output-record-hit-detection-rectangle* record)          (output-record-hit-detection-rectangle* record)
566        (ecase state        (ecase state
# Line 1032  were added." Line 1032  were added."
1032     sequences of coordinates."))     sequences of coordinates."))
1033    
1034  (defun coord-seq-bounds (coord-seq border)  (defun coord-seq-bounds (coord-seq border)
1035      (setf border (ceiling border))
1036    (let* ((min-x (elt coord-seq 0))    (let* ((min-x (elt coord-seq 0))
1037           (min-y (elt coord-seq 1))           (min-y (elt coord-seq 1))
1038           (max-x min-x)           (max-x min-x)
# Line 1041  were added." Line 1042  were added."
1042        (minf min-y y)        (minf min-y y)
1043        (maxf max-x x)        (maxf max-x x)
1044        (maxf max-y y))        (maxf max-y y))
1045      (values (- min-x border) (- min-y border)      (values (floor (- min-x border))
1046              (+ max-x border) (+ max-y border))))              (floor (- min-y border))
1047                (ceiling (+ max-x border))
1048  (defmethod initialize-instance :after ((record coord-seq-mixin) &key)              (ceiling (+ max-y border)))))
   (let ((medium (sheet-medium (slot-value record 'stream))))  
     (with-slots (coord-seq)  
         record  
       (setf coord-seq  
             (transform-position-sequence 'vector  
                                          (medium-transformation medium)  
                                          coord-seq)))))  
1049    
1050  ;;; x1, y1 slots must exist in class...  ;;; x1, y1 slots must exist in class...
1051    
# Line 1106  were added." Line 1100  were added."
1100           (with-sheet-medium (medium stream)           (with-sheet-medium (medium stream)
1101             (when (stream-recording-p stream)             (when (stream-recording-p stream)
1102               (let ((record (make-instance ',class-name               (let ((record (make-instance ',class-name
1103                               :stream stream                                            :stream stream
1104                               ,@arg-list)))                                            ,@arg-list)))
1105                 (stream-add-output-record stream record)))                 (stream-add-output-record stream record)))
1106             (when (stream-drawing-p stream)             (when (stream-drawing-p stream)
1107               (call-next-method))))               (with-identity-transformation (medium)
1108                   (,method-name medium ,@args)))))
1109         (defmethod replay-output-record ((record ,class-name) stream         (defmethod replay-output-record ((record ,class-name) stream
1110                                          &optional (region +everywhere+)                                          &optional (region +everywhere+)
1111                                          (x-offset 0) (y-offset 0))                                          (x-offset 0) (y-offset 0))

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

  ViewVC Help
Powered by ViewVC 1.1.5