[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Tue Jan 15 14:08:19 UTC 2008
Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv18243/Drei
Modified Files:
drei-redisplay.lisp views.lisp
Log Message:
Reintroduce early support for long lines (and horizontal scrolling) in
Drei. Still doesn't deal properly with cursors, and is very eager at
scrolling back.
--- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/15 09:35:27 1.33
+++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/15 14:08:19 1.34
@@ -547,14 +547,17 @@
(funcall (drawing-options-function (stroke-drawing-options stroke)) stream view stroke
cursor-x cursor-y #'stroke-drawing-fn nil)))
-(defun draw-stroke (stream view stroke cursor-x cursor-y)
- "Draw `stroke' on `stream' with a baseline at
+(defun draw-stroke (pane view stroke cursor-x cursor-y)
+ "Draw `stroke' on `pane' with a baseline at
`cursor-y'. Drawing starts at the horizontal offset
`cursor-x'. Stroke must thus have updated dimensional
-informational. Nothing will be done unless `stroke' is dirty."
+information. Nothing will be done unless `stroke' is dirty."
(when (stroke-dirty stroke)
+ (when (> (x2 (stroke-dimensions stroke))
+ (bounding-rectangle-width pane))
+ (change-space-requirements pane :width (x2 (stroke-dimensions stroke))))
(funcall (drawing-options-function (stroke-drawing-options stroke))
- stream view stroke cursor-x cursor-y #'stroke-drawing-fn t)))
+ pane view stroke cursor-x cursor-y #'stroke-drawing-fn t)))
(defun end-line (line x1 y1 line-width line-height)
"End the addition of strokes to `line' for now, and update the
@@ -565,7 +568,7 @@
(x2 dimensions) (+ x1 line-width)
(y2 dimensions) (+ y1 line-height))))
-(defun end-line-cleaning-up (stream line line-x1 line-y1
+(defun end-line-cleaning-up (view pane line line-x1 line-y1
line-width line-height)
"End the addition of strokes to `line' for now, and update the
dimensions of `line'. Update all undisplayed lines to have no
@@ -575,6 +578,9 @@
(end-line line line-x1 line-y1 line-width line-height)
(with-accessors ((line-x1 x1) (line-y1 y1)
(line-x2 x2) (line-y2 y2)) (line-dimensions line)
+ (setf (max-line-width view)
+ (max (max-line-width view)
+ (dimensions-width (line-dimensions line))))
;; If a has a lesser height than the line, clear from the top of
;; the line stroke to the top of the stroke, to avoid artifacts
;; left over from previous redisplays.
@@ -583,7 +589,7 @@
(with-accessors ((stroke-x1 x1) (stroke-y1 y1)
(stroke-x2 x2) (stroke-y2 y2)) stroke-dimensions
(when (> line-height (dimensions-height stroke-dimensions))
- (clear-rectangle* stream stroke-x1 line-y1
+ (clear-rectangle* pane stroke-x1 line-y1
stroke-x2 stroke-y1)))))
;; Reset the dimensions of undisplayed lines.
(do-undisplayed-line-strokes (stroke line)
@@ -645,7 +651,7 @@
for stroke = (aref (line-strokes line) stroke-index)
for stroke-dimensions = (stroke-dimensions stroke)
do (draw-stroke pane view stroke (x1 stroke-dimensions) baseline)
- finally (progn (end-line-cleaning-up pane line orig-x-offset cursor-y
+ finally (progn (end-line-cleaning-up view pane line orig-x-offset cursor-y
line-width line-height)
(incf (displayed-lines-count view))
(return (values pump-state line-height)))))))
@@ -882,6 +888,54 @@
(when (> br-height (bounding-rectangle-height stream))
(change-space-requirements stream :height br-height))))
+(defmethod bounding-rectangle* ((view drei-buffer-view))
+ "Return the bounding rectangle of the visual appearance of
+`view' as four values, just as `bounding-rectangle*'. Will return
+0, 0, 0, 0 when `view' has not been redisplayed."
+ (if (zerop (displayed-lines-count view))
+ (values 0 0 0 0)
+ (let ((first-line (aref (displayed-lines view) 0))
+ (last-line (last-displayed-line view))
+ (max-x2 0))
+ (do-displayed-lines (line view)
+ (setf max-x2 (max max-x2
+ (x2 (line-dimensions line)))))
+ (values (x1 (line-dimensions first-line))
+ (y1 (line-dimensions first-line))
+ max-x2
+ (y2 (line-dimensions last-line))))))
+
+(defmethod bounding-rectangle-width ((view drei-buffer-view))
+ (multiple-value-bind (x1 y1 x2)
+ (bounding-rectangle* view)
+ (declare (ignore y1))
+ (- x2 x1)))
+
+(defun drei-bounding-rectangle* (drei-instance)
+ "Return the bounding rectangle of the visual appearance of
+`drei-instance' as four values, just as
+`bounding-rectangle*'. Takes the cursors of `drei-instance' into
+account."
+ (multiple-value-bind (x1 y1 x2 y2)
+ (view-bounding-rectangle* (view drei-instance))
+ (dolist (cursor (cursors drei-instance))
+ (multiple-value-bind (cursor-x1 cursor-y1 cursor-x2 cursor-y2)
+ (bounding-rectangle* cursor)
+ (unless (= cursor-x1 cursor-y1 cursor-x2 cursor-y2 0)
+ (setf x1 (min x1 cursor-x1)
+ y1 (min y1 cursor-y1)
+ x2 (max x2 cursor-x2)
+ y2 (max y2 cursor-y2)))))
+ (values x1 y1 x2 y2)))
+
+(defun drei-bounding-rectangle-width (drei-instance)
+ "Return the width of the bounding rectangle of `drei-instance',
+calculated by `drei-bounding-rectangle*'."
+ (multiple-value-bind (x1 y1 x2)
+ (drei-bounding-rectangle* drei-instance)
+ (declare (ignore y1))
+ (- x2 x1)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Drei area redisplay.
@@ -903,13 +957,14 @@
(height (+ ascent descent)))
(multiple-value-bind (x1 y1 x2 y2)
(call-next-method)
- (values x1 y1 (max x2 (+ x1 style-width)
- (cond ((numberp min-width)
- (+ x1 min-width))
- ;; Must be T, then.
- ((pane-viewport pane)
- (+ x1 (bounding-rectangle-width (pane-viewport-region pane))))
- (t 0)))
+ (values x1 y1
+ (max x2 (+ x1 style-width)
+ (cond ((numberp min-width)
+ (+ x1 min-width))
+ ;; Must be T, then.
+ ((pane-viewport pane)
+ (+ x1 (bounding-rectangle-width (pane-viewport-region pane))))
+ (t 0)))
(max y2 (+ y1 height)))))))
;; XXX: Full redraw for every replay, should probably use the `region'
@@ -949,25 +1004,21 @@
(defun display-drei-area (drei)
(with-accessors ((stream editor-pane) (view view)) drei
(replay drei stream)
- (with-bounding-rectangle* (dx1 dy1 dx2 dy2) drei
- (declare (ignore dx1 dy1 dy2))
- (when (point-cursor drei)
- (with-bounding-rectangle* (x1 y1 x2 y2) (point-cursor drei)
- (apply #'change-space-requirements stream (when (> x2 dx2)
- (list :width x2)))
- (when (pane-viewport stream)
- (let* ((viewport (pane-viewport stream))
- (viewport-height (bounding-rectangle-height viewport))
- (viewport-width (bounding-rectangle-width viewport))
- (viewport-region (pane-viewport-region stream)))
- ;; Scroll if point went outside the visible area.
- (when (and (active drei)
- (pane-viewport stream)
- (not (and (region-contains-position-p viewport-region x2 y2)
- (region-contains-position-p viewport-region x1 y1))))
- (scroll-extent stream
- (max 0 (- x2 viewport-width))
- (max 0 (- y2 viewport-height)))))))))))
+ (when (point-cursor drei)
+ (with-bounding-rectangle* (x1 y1 x2 y2) (point-cursor drei)
+ (when (pane-viewport stream)
+ (let* ((viewport (pane-viewport stream))
+ (viewport-height (bounding-rectangle-height viewport))
+ (viewport-width (bounding-rectangle-width viewport))
+ (viewport-region (pane-viewport-region stream)))
+ ;; Scroll if point went outside the visible area.
+ (when (and (active drei)
+ (pane-viewport stream)
+ (not (and (region-contains-position-p viewport-region x2 y2)
+ (region-contains-position-p viewport-region x1 y1))))
+ (scroll-extent stream
+ (max 0 (- x2 viewport-width))
+ (max 0 (- y2 viewport-height))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -1019,7 +1070,7 @@
has `view'."))
(defmethod fix-pane-viewport ((pane drei-pane) (view drei-view))
- (let* ((output-width (bounding-rectangle-width (stream-current-output-record pane)))
+ (let* ((output-width (bounding-rectangle-width view))
(viewport (pane-viewport pane))
(viewport-width (and viewport (bounding-rectangle-width viewport)))
(pane-width (bounding-rectangle-width pane)))
--- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/15 07:43:05 1.19
+++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/15 14:08:19 1.20
@@ -532,7 +532,12 @@
:type integer
:documentation "The number of lines in
the views `displayed-lines' array that are actually live, that
-is, used for display right now."))
+is, used for display right now.")
+ (%max-line-width :accessor max-line-width
+ :initform 0
+ :type integer
+ :documentation "The width of the longest
+displayed line in device units."))
(:metaclass modual-class)
(:documentation "A view that contains a `drei-buffer'
object. The buffer is displayed on a simple line-by-line basis,
@@ -562,13 +567,6 @@
(setf (fill-pointer string) 0)
string))
-(defmethod observer-notified ((view drei-buffer-view) (buffer drei-buffer)
- changed-region)
- (dotimes (i (displayed-lines-count view))
- (let ((line (line-information view i)))
- (when (<= (car changed-region) (line-end-offset line))
- (invalidate-line-strokes line :modified t)))))
-
(defclass drei-syntax-view (drei-buffer-view)
((%syntax :accessor syntax
:documentation "An instance of the syntax class used
More information about the Mcclim-cvs
mailing list