[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Tue Feb 12 19:22:38 UTC 2008
Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv20991/Drei
Modified Files:
drei-redisplay.lisp views.lisp
Log Message:
Changed how buffer changes are registered by the redisplay module.
--- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/11 23:05:21 1.62
+++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/12 19:22:37 1.63
@@ -272,6 +272,37 @@
do (invalidate-line-strokes line
:modified modified :cleared cleared)))
+(defun invalidate-strokes-in-region (view start-offset end-offset
+ &key modified cleared)
+ "Invalidate all the strokes of `view' that overlap the region
+`start-offset'/`end-offset' by setting their dirty-bit to
+true. If `modified' or `cleared' is true, also set their
+modified-bit to true. If `cleared' is true, inform the strokes
+that their previous output has been cleared by someone, and that
+they do not need to clear it themselves during their next
+redisplay."
+ ;; If the region is outside the visible region, no-op.
+ (when (overlaps start-offset end-offset
+ (offset (top view)) (offset (bot view)))
+ (let ((line1-index (index-of-displayed-line-containing-offset view start-offset))
+ (line2-index (index-of-displayed-line-containing-offset view end-offset)))
+ (loop for line = (line-information view line1-index)
+ when (<= start-offset
+ (line-start-offset line) (line-end-offset line)
+ end-offset)
+ ;; The entire line is within the region.
+ do (invalidate-line-strokes line :modified modified
+ :cleared cleared)
+ ;; Only part of the line is within the region.
+ else do (do-displayed-line-strokes (stroke line)
+ (when (overlaps start-offset end-offset
+ (stroke-start-offset stroke)
+ (stroke-end-offset stroke))
+ (invalidate-stroke stroke :modified modified
+ :cleared cleared)))
+ if (= line1-index line2-index) do (loop-finish)
+ else do (incf line1-index)))))
+
(defmacro do-displayed-lines ((line-sym view) &body body)
"Loop over lines on display for `view', evaluating `body' with
`line-sym' bound to the `displayed-line' object for each line."
@@ -328,10 +359,11 @@
(end-offset (stroke-end-offset stroke))))
(return stroke))))))
-(defun find-index-of-line-containing-offset (view offset)
- "Return the index of the line containing `offset'. If `offset'
-is before the displayed lines, return 0. If `offset' is after the
-displayed lines, return the index of the last line."
+(defun index-of-displayed-line-containing-offset (view offset)
+ "Return the index of the `displayed-line' object containing
+`offset'. If `offset' is before the displayed lines, return 0. If
+`offset' is after the displayed lines, return the index of the
+last line."
(with-accessors ((lines displayed-lines)) view
(cond ((< offset (line-start-offset (aref lines 0)))
0)
@@ -340,18 +372,18 @@
(t
;; Binary search for the line.
(loop with low-index = 0
- with high-index = (displayed-lines-count view)
- for middle = (floor (+ low-index high-index) 2)
- for this-line = (aref lines middle)
- for line-start = (line-start-offset this-line)
- for line-end = (line-end-offset this-line)
- do (cond ((<= line-start offset line-end)
- (loop-finish))
- ((mark> offset line-start)
- (setf low-index (1+ middle)))
- ((mark< offset line-start)
- (setf high-index middle)))
- finally (return middle))))))
+ with high-index = (displayed-lines-count view)
+ for middle = (floor (+ low-index high-index) 2)
+ for this-line = (aref lines middle)
+ for line-start = (line-start-offset this-line)
+ for line-end = (line-end-offset this-line)
+ do (cond ((<= line-start offset line-end)
+ (loop-finish))
+ ((> offset line-start)
+ (setf low-index (1+ middle)))
+ ((< offset line-start)
+ (setf high-index middle)))
+ finally (return middle))))))
(defun ensure-line-information-size (view min-size)
"Ensure that the array of lines for `view' contains at least
@@ -402,24 +434,14 @@
(let* ((stroke (line-stroke-information line (line-stroke-count line)))
(old-start-offset (stroke-start-offset stroke))
(old-end-offset (stroke-end-offset stroke))
- (old-drawing-options (stroke-drawing-options stroke))
- (changed-region (first (changed-regions view))))
+ (old-drawing-options (stroke-drawing-options stroke)))
(prog1 (stroke-pump view stroke pump-state)
(unless (and old-start-offset
(= (+ old-start-offset line-change) (stroke-start-offset stroke))
(= (+ old-end-offset line-change) (stroke-end-offset stroke))
(drawing-options-equal old-drawing-options
- (stroke-drawing-options stroke))
- (or (null changed-region)
- (not (overlaps (stroke-start-offset stroke) (stroke-end-offset stroke)
- (car changed-region) (cdr changed-region)))))
+ (stroke-drawing-options stroke)))
(invalidate-stroke stroke :modified t))
- ;; Move to the next changed region, if it is not possible for
- ;; more stroks to overlap with the current one.
- (loop while (and (first (changed-regions view))
- (>= (stroke-end-offset stroke)
- (cdr (first (changed-regions view)))))
- do (pop (changed-regions view)))
(incf (line-stroke-count line))
(setf (line-end-offset line) (stroke-end-offset stroke)))))
@@ -634,7 +656,8 @@
(do-undisplayed-line-strokes (stroke line)
(if (null (stroke-start-offset stroke))
(return)
- (setf (stroke-start-offset stroke) nil))))
+ (progn (setf (stroke-start-offset stroke) nil)
+ (invalidate-stroke stroke :modified t)))))
(defun draw-line-strokes (pane view initial-pump-state
start-offset cursor-x cursor-y
@@ -711,7 +734,8 @@
(do-undisplayed-line-strokes (stroke line)
(if (null (stroke-start-offset stroke))
(return)
- (setf (stroke-start-offset stroke) nil))))
+ (progn (setf (stroke-start-offset stroke) nil)
+ (invalidate-stroke stroke :modified t)))))
(with-bounding-rectangle* (x1 y1 x2 y2) view
(declare (ignore x2))
(when (> old-height (- y2 y1))
--- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/02/11 22:50:05 1.35
+++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/02/12 19:22:37 1.36
@@ -594,12 +594,6 @@
:type number
:documentation "The width of the longest
displayed line in device units.")
- (%changed-regions :accessor changed-regions
- :initform nil
- :documentation "A list of (start . end) conses
-of buffer offsets, delimiting the regions of the buffer that have
-changed since the last redisplay. The regions are not
-overlapping, and are sorted in ascending order.")
(lines :initform (make-instance 'standard-flexichain)
:reader lines
:documentation "The lines of the buffer, stored in a
@@ -632,8 +626,11 @@
(defmethod (setf bot) :after (new-value (view drei-buffer-view))
(invalidate-all-strokes view))
-(defmethod (setf buffer) :after (new-value (view drei-buffer-view))
- (invalidate-all-strokes view))
+(defmethod (setf buffer) :after (buffer (view drei-buffer-view))
+ (invalidate-all-strokes view)
+ (with-accessors ((top top) (bot bot)) view
+ (setf top (make-buffer-mark buffer 0 :left)
+ bot (make-buffer-mark buffer (size buffer) :right))))
(defmethod (setf syntax) :after (new-value (view drei-buffer-view))
(invalidate-all-strokes view :modified t))
@@ -657,32 +654,6 @@
(<= y1 x1 x2 y2)
(<= x1 y1 y1 x2)))
-(defun remember-changed-region (view start end)
- "Note that the buffer region delimited by the offset `start'
-and `end' has been modified."
- (labels ((worker (list)
- ;; Return a new changed-regions list. Try to extend old
- ;; regions instead of adding new ones.
- (cond ((null list)
- (list (cons start end)))
- ;; If start/end overlaps with (first list), extend
- ;; (first list)
- ((overlaps start end (car (first list)) (cdr (first list)))
- (setf (car (first list)) (min start (car (first list)))
- (cdr (first list)) (max end (cdr (first list))))
- list)
- ;; If start/end is wholly before (first list), push
- ;; on a new region.
- ((< start (car (first list)))
- (cons (cons start end) list))
- ;; If start/end is wholly before (first list), go
- ;; further down list. If at end of list, add new
- ;; element.
- ((< (cdr (first list)) end)
- (setf (rest list) (worker (rest list)))
- list))))
- (setf (changed-regions view) (worker (changed-regions view)))))
-
(defclass buffer-line ()
((%start-mark :reader start-mark
:initarg :start-mark
@@ -783,12 +754,14 @@
(defmethod observer-notified ((view drei-buffer-view) (buffer drei-buffer)
changed-region)
- ;; If something has been redisplayed, and there have been changes to
- ;; some of those lines, mark them as dirty.
- (remember-changed-region view (car changed-region) (cdr changed-region))
- ;; I suspect it's most efficient to keep this always up to date,
- ;; even for small changes.
- (update-line-data view (car changed-region) (cdr changed-region)))
+ (destructuring-bind (start-offset . end-offset) changed-region
+ ;; If something has been redisplayed, and there have been changes
+ ;; to some of those strokes, mark them as dirty.
+ (invalidate-strokes-in-region
+ view start-offset end-offset :modified t)
+ ;; I suspect it's most efficient to keep this always up to date,
+ ;; even for small changes.
+ (update-line-data view start-offset end-offset)))
;;; Exploit the stored line information.
@@ -866,21 +839,11 @@
;; We need a new syntax object of the same type as the old one, and
;; to zero out the unchanged-prefix-values.
(with-accessors ((view-syntax syntax)
- (point point) (mark mark)
(suffix-size suffix-size)
(prefix-size prefix-size)
(buffer-size buffer-size)
(bot bot) (top top)) view
- (setf point (clone-mark (point buffer))
- mark (clone-mark (point buffer) :right)
- (offset mark) 0
- view-syntax (make-syntax-for-view view (class-of view-syntax))
- prefix-size 0
- suffix-size 0
- buffer-size -1 ; For reparse even if buffer is empty.
- ;; Also set the top and bot marks.
- top (make-buffer-mark buffer 0 :left)
- bot (make-buffer-mark buffer (size buffer) :right))))
+ (setf view-syntax (make-syntax-for-view view (class-of view-syntax)))))
(defmethod (setf syntax) :after (syntax (view drei-syntax-view))
(setf (prefix-size view) 0
More information about the Mcclim-cvs
mailing list