[mcclim-devel] clipping regions, replay, handle-repaint
Christophe Rhodes
csr21 at cam.ac.uk
Sun May 28 13:54:06 EDT 2006
Christophe Rhodes <csr21 at cam.ac.uk> writes:
> Comments?
Here's an implementation of a more minimal, less invasive change.
SET-MEDIUM-GRAPHICS-STATE goes away and is replaced by :AROUND methods
on REPLAY-OUTPUT-RECORD the various graphics state mixin types, which
use WITH-DRAWING-OPTIONS to bind dynamically the various bits of
graphics state that they need. The uses of SET-MEDIUM-GRAPHICS-STATE
in incremental-redisplay then boil down to setting the stream cursor
position; the uses of MEDIUM-GRAPHICS-STATE there actually should just
retrieve the cursor position, but I haven't altered that in the source.
-------------- next part --------------
Index: recording.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/recording.lisp,v
retrieving revision 1.126
diff -u -r1.126 recording.lisp
--- recording.lisp 5 May 2006 10:24:02 -0000 1.126
+++ recording.lisp 28 May 2006 16:53:10 -0000
@@ -470,16 +470,13 @@
;; Is there a better value to bind to baseline?
((slot-value stream 'baseline) (slot-value stream 'baseline)))
(with-sheet-medium (medium stream)
- (let ((medium-state (make-instance 'complete-medium-state
- :medium medium))
- (transformation (medium-transformation medium)))
+ (let ((transformation (medium-transformation medium)))
(unwind-protect
(progn
(setf (medium-transformation medium)
+identity-transformation+)
(replay-output-record record stream region))
- (setf (medium-transformation medium) transformation)
- (set-medium-graphics-state medium-state medium))))))))
+ (setf (medium-transformation medium) transformation))))))))
(defmethod replay-output-record ((record compound-output-record) stream
&optional region (x-offset 0) (y-offset 0))
@@ -1025,17 +1022,6 @@
(:documentation "Stores those parts of the medium/stream graphics state
that need to be restored when drawing an output record"))
-(defgeneric set-medium-graphics-state (state medium)
- (:documentation "Sets the MEDIUM graphics state from STATE"))
-
-(defmethod set-medium-graphics-state (state medium)
- (declare (ignore medium))
- state)
-
-(defmethod set-medium-graphics-state (state (stream output-recording-stream))
- (with-sheet-medium (medium stream)
- (set-medium-graphics-state state medium)))
-
(defclass gs-ink-mixin (graphics-state)
((ink :initarg :ink :accessor graphics-state-ink)))
@@ -1046,8 +1032,10 @@
(when (and medium (not (slot-boundp obj 'ink)))
(setf (slot-value obj 'ink) (medium-ink medium))))
-(defmethod set-medium-graphics-state :after ((state gs-ink-mixin) medium)
- (setf (medium-ink medium) (graphics-state-ink state)))
+(defmethod replay-output-record :around
+ ((record gs-ink-mixin) stream &optional region x-offset y-offset)
+ (with-drawing-options (stream :ink (graphics-state-ink record))
+ (call-next-method)))
(defrecord-predicate gs-ink-mixin (ink)
(if-supplied (ink)
@@ -1057,7 +1045,6 @@
((clip :initarg :clipping-region :accessor graphics-state-clip
:documentation "Clipping region in stream coordinates.")))
-
(defmethod initialize-instance :after ((obj gs-clip-mixin)
&key (stream nil)
(medium (when stream
@@ -1073,31 +1060,10 @@
(setq clip (transform-region (medium-transformation medium)
clip-region))))))
-(defmethod set-medium-graphics-state :after ((state gs-clip-mixin) medium)
- ;;
- ;; This definition is kind of wrong. When output records are about to
- ;; be replayed only a certain region of the stream should be affected.[1]
- ;; Therefore I disabled this code, since this way only breaks the
- ;; [not very frequent case] that the output record actually contains
- ;; a clipping region different from +everywhere+, while having it in
- ;; breaks redisplay of streams in just about every case.
- ;;
- ;; Most notably Closure is affected by this, as it does the equivalent of
- ;; (draw-rectangle* medium 0 0 800 200 :ink +white+ :filled t)
- ;; (draw-text* medium "Hello" 100 100)
- ;;
- ;; Having this code in a redisplay on the region
- ;; (make-rectangle* 0 0 50 50) fills the drawing pane with a white
- ;; rectangle obscuring the text.
- ;;
- ;; [1] it is of course debatable where this extra clipping because
- ;; of redisplay should come from. Should replay-output-record set it
- ;; up? Should handle-repaint do so?
- ;;
- ;; --GB 2003-03-14
- (declare (ignore medium))
- #+nil
- (setf (medium-clipping-region medium) (graphics-state-clip state)))
+(defmethod replay-output-record :around
+ ((record gs-clip-mixin) stream &optional region x-offset y-offset)
+ (with-drawing-options (stream :clipping-region (graphics-state-clip record))
+ (call-next-method)))
(defrecord-predicate gs-clip-mixin ((:clipping-region clip))
(if-supplied (clip)
@@ -1123,8 +1089,10 @@
(unless (slot-boundp obj 'line-style)
(setf (slot-value obj 'line-style) (medium-line-style medium)))))
-(defmethod set-medium-graphics-state :after ((state gs-line-style-mixin) medium)
- (setf (medium-line-style medium) (graphics-state-line-style state)))
+(defmethod replay-output-record :around
+ ((record gs-line-style-mixin) stream &optional region x-offset y-offset)
+ (with-drawing-options (stream :line-style (graphics-state-line-style record))
+ (call-next-method)))
(defrecord-predicate gs-line-style-mixin (line-style)
(if-supplied (line-style)
@@ -1147,8 +1115,10 @@
(unless (slot-boundp obj 'text-style)
(setf (slot-value obj 'text-style) (medium-text-style medium)))))
-(defmethod set-medium-graphics-state :after ((state gs-text-style-mixin) medium)
- (setf (medium-text-style medium) (graphics-state-text-style state)))
+(defmethod replay-output-record :around
+ ((record gs-text-style-mixin) stream &optional region x-offset y-offset)
+ (with-drawing-options (stream :text-style (graphics-state-text-style record))
+ (call-next-method)))
(defrecord-predicate gs-text-style-mixin (text-style)
(if-supplied (text-style)
@@ -1187,17 +1157,6 @@
(record2 standard-displayed-output-record))
(region-equal record record2))
-;;; This is an around method so that more specific before methods can be
-;;; defined for the various mixin classes, that modify the state after it has
-;;; been set in the graphics state.
-
-(defmethod replay-output-record :around
- ((record standard-displayed-output-record) stream
- &optional region x-offset y-offset)
- (declare (ignore region x-offset y-offset))
- (set-medium-graphics-state record stream)
- (call-next-method))
-
(defclass coord-seq-mixin ()
((coord-seq :accessor coord-seq :initarg :coord-seq))
(:documentation "Mixin class that implements methods for records that contain
@@ -1851,8 +1810,15 @@
substring
(setf (stream-cursor-position stream)
(values start-x start-y))
- (set-medium-graphics-state substring medium)
- (stream-write-output stream string nil)))
+ ;; FIXME: a bit of an abstraction inversion. Should
+ ;; the styled strings here not simply be output
+ ;; records? Then we could just replay them and all
+ ;; would be well. -- CSR, 20060528.
+ (with-drawing-options (stream
+ :ink (graphics-state-ink substring)
+ :clipping-region (graphics-state-clip substring)
+ :text-style (graphics-state-text-style substring))
+ (stream-write-output stream string nil))))
(when wrapped ; FIXME
(draw-rectangle* medium
(+ wrapped 0) start-y
Index: incremental-redisplay.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp,v
retrieving revision 1.63
diff -u -r1.63 incremental-redisplay.lisp
--- incremental-redisplay.lisp 5 May 2006 10:24:02 -0000 1.63
+++ incremental-redisplay.lisp 28 May 2006 16:53:10 -0000
@@ -325,7 +325,7 @@
(or (not y-supplied-p)
(coordinate= (slot-value state 'cursor-y) cursor-y))))
-(defmethod set-medium-graphics-state :after
+(defmethod set-medium-cursor-position
((state updating-stream-state) (stream updating-output-stream-mixin))
(setf (stream-cursor-position stream)
(values (cursor-x state) (cursor-y state))))
@@ -931,7 +931,7 @@
record
nil)
(add-output-record record (stream-current-output-record stream))
- (set-medium-graphics-state (end-graphics-state record) stream)
+ (set-medium-cursor-position (end-graphics-state record) stream)
(setf (parent-cache record) parent-cache) )) ))))
record)))
@@ -989,7 +989,7 @@
(unwind-protect
(progn
(letf (((do-note-output-record stream) nil))
- (set-medium-graphics-state (start-graphics-state record) stream)
+ (set-medium-cursor-position (start-graphics-state record) stream)
(compute-new-output-records record stream)
(when *dump-updating-output*
(dump-updating record :both *trace-output*)))
@@ -1006,7 +1006,7 @@
(incremental-redisplay stream nil erases moves draws
erase-overlapping move-overlapping))
(delete-stale-updating-output record))
- (set-medium-graphics-state current-graphics-state stream)))))
+ (set-medium-cursor-position current-graphics-state stream)))))
(defun erase-rectangle (stream bounding)
(with-bounding-rectangle* (x1 y1 x2 y2)
-------------- next part --------------
Then GSharp, which specializes DISPLAYED-OUTPUT-RECORD (a specified
class, unlike STANDARD-DISPLAYED-OUTPUT-RECORD, where all of these
changes have been occurring) can itself remember the bits of medium
state it needs (ink and clipping-region), and then the effect of the
graphics state of each output record is dynamically contained to its
own replay, and not any other records'.
-------------- next part --------------
Index: score-pane.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/score-pane.lisp,v
retrieving revision 1.22
diff -u -r1.22 score-pane.lisp
--- score-pane.lisp 2 Mar 2006 09:21:34 -0000 1.22
+++ score-pane.lisp 28 May 2006 16:34:59 -0000
@@ -453,6 +453,7 @@
(defclass beam-output-record (score-output-record)
((light-glyph-p :initarg :light-glyph-p)
+ (clipping-region :initarg :clipping-region)
(thickness :initarg :thickness)))
;;; draw a horizontal beam around the vertical reference
@@ -553,14 +554,15 @@
(x-offset 0) (y-offset 0))
(declare (ignore x-offset y-offset region))
(with-bounding-rectangle* (x1 y1 x2 y2) record
- (with-slots (thickness ink light-glyph-p) record
+ (with-slots (thickness ink clipping-region light-glyph-p) record
(let ((medium (sheet-medium stream)))
(let ((*light-glyph* light-glyph-p))
- (with-drawing-options (medium :ink ink)
+ (with-drawing-options
+ (medium :ink ink :clipping-region clipping-region)
(let ((*lighter-gray-progressions* (lighter-gray-progressions stream))
(*darker-gray-progressions* (darker-gray-progressions stream)))
- (draw-downward-beam medium x1 y1 y2 thickness
- (/ (- x2 x1) (- y2 y1))))))))))
+ (draw-downward-beam medium x1 y1 y2 thickness
+ (/ (- x2 x1) (- y2 y1))))))))))
(defclass upward-beam-output-record (beam-output-record)
())
@@ -570,10 +572,11 @@
(x-offset 0) (y-offset 0))
(declare (ignore x-offset y-offset region))
(with-bounding-rectangle* (x1 y1 x2 y2) record
- (with-slots (thickness ink light-glyph-p) record
+ (with-slots (thickness ink clipping-region light-glyph-p) record
(let ((medium (sheet-medium stream)))
(let ((*light-glyph* light-glyph-p))
- (with-drawing-options (medium :ink ink)
+ (with-drawing-options
+ (medium :ink ink :clipping-region clipping-region)
(let ((*lighter-gray-progressions* (lighter-gray-progressions stream))
(*darker-gray-progressions* (darker-gray-progressions stream)))
(draw-upward-beam medium x1 y2 y1 thickness
@@ -596,7 +599,8 @@
*pane* (make-instance 'downward-beam-output-record
:x1 xx1 :y1 yy1 :x2 xx2 :y2 yy2
:light-glyph-p *light-glyph*
- :thickness thickness :ink (medium-ink medium))))))
+ :thickness thickness :ink (medium-ink medium)
+ :clipping-region (medium-clipping-region medium))))))
(when (stream-drawing-p *pane*)
(draw-downward-beam medium x1 y1 y2 thickness inverse-slope)))
(t
@@ -609,7 +613,9 @@
*pane* (make-instance 'upward-beam-output-record
:x1 xx1 :y1 yy2 :x2 xx2 :y2 yy1
:light-glyph-p *light-glyph*
- :thickness thickness :ink (medium-ink medium))))))
+ :thickness thickness
+ :ink (medium-ink medium)
+ :clipping-region (medium-clipping-region medium))))))
(when (stream-drawing-p *pane*)
(draw-upward-beam medium x1 y1 y2 thickness inverse-slope)))))))
-------------- next part --------------
And all this lets me put up screenshots like
<http://www-jcsu.jesus.cam.ac.uk/~csr21/gsharp-with-working-repaint.png>.
I have tested a couple of other applications with this (the Address
Book still works!) and nothing seems terribly amiss. I'd like a
sanity check, though, and maybe consideration of whether having
analogues to displayed-output-record-ink would make sense. (I think
it would, and in fact I think that with this change the various bits
of graphics state /are/ attached to the output record).
Cheers,
Christophe
More information about the mcclim-devel
mailing list