[gsharp-cvs] CVS gsharp
crhodes
crhodes at common-lisp.net
Sun Jun 10 08:10:03 UTC 2007
Update of /project/gsharp/cvsroot/gsharp
In directory clnet:/tmp/cvs-serv20543
Modified Files:
drawing.lisp
Log Message:
When drawing the gsharp cursor, also scroll the viewport if necessary so
that the cursor remains on the screen.
Currently this is a little ugly in UI, because of slightly nasty
discontinuities in the drawing process, and pretty ugly in the code.
FIXME commentaries are noted
--- /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/06/07 10:21:47 1.75
+++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/06/10 08:10:03 1.76
@@ -772,35 +772,54 @@
(defun draw-the-cursor (pane cursor cursor-element last-note)
(let* ((staff (car (staves (layer cursor))))
- (bar (bar cursor)))
+ (bar (bar cursor))
+ (sy (system-y-position bar))
+ (yoffset (- (gsharp-drawing::staff-yoffset staff))))
+ (let ((region (pane-viewport-region pane)))
+ (when region
+ ;; FIXME: adjusting the viewport at this point leads to ugly
+ ;; jumps in the display when going across pages, as the page
+ ;; is first laid out and drawn, then the viewport is moved.
+ ;; If we instead cleared the pane, laid out the page, adjusted
+ ;; the viewport, and finally drew the page (and cursor) then
+ ;; that jump would probably go away.
+ ;;
+ ;; FIXME: this calculation only takes account of the centre of
+ ;; the cursor. Refactor this whole DRAW-THE-CURSOR function
+ ;; so that it's easy to take account of the vertical extent of
+ ;; the cursor.
+ (unless (< (bounding-rectangle-min-y region)
+ (- sy yoffset)
+ (bounding-rectangle-max-y region))
+ (let ((maxy (- (bounding-rectangle-max-y pane) (bounding-rectangle-height region))))
+ (scroll-extent pane 0 (max 0 (min maxy
+ (- sy (floor (bounding-rectangle-height region) 2)))))))))
+
(flet ((draw-cursor (x)
- (let* ((sy (system-y-position bar))
- ;; Why (- STAFF-YOFFSET)? dunno. -- CSR, 2005-10-28
- (yoffset (- (gsharp-drawing::staff-yoffset staff))))
- (if (typep staff 'fiveline-staff)
- (let* ((clef (clef staff))
- (bottom-line (bottom-line clef))
- (lnote-offset (score-pane:staff-step (- last-note bottom-line))))
- (draw-line* pane
- x (+ sy (- (+ (score-pane:staff-step 12) yoffset)))
- x (+ sy (- (+ (score-pane:staff-step -4) yoffset)))
- :ink +yellow+)
- (draw-line* pane
- (- x 1) (+ sy (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)))
- (- x 1) (+ sy (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)))
- :ink +red+)
- (draw-line* pane
- (+ x 1) (+ sy (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)))
- (+ x 1) (+ sy (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)))
- :ink +red+))
- (progn (draw-line* pane
- (+ x 1) (+ sy (- (+ (score-pane:staff-step 2) yoffset)))
- (+ x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset)))
- :ink +red+)
- (draw-line* pane
- (- x 1) (+ sy (- (+ (score-pane:staff-step 2) yoffset)))
- (- x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset)))
- :ink +red+))))))
+ (if (typep staff 'fiveline-staff)
+ (let* ((clef (clef staff))
+ (bottom-line (bottom-line clef))
+ (lnote-offset (score-pane:staff-step (- last-note bottom-line))))
+ (draw-line* pane
+ x (+ sy (- (+ (score-pane:staff-step 12) yoffset)))
+ x (+ sy (- (+ (score-pane:staff-step -4) yoffset)))
+ :ink +yellow+)
+ (draw-line* pane
+ (- x 1) (+ sy (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)))
+ (- x 1) (+ sy (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)))
+ :ink +red+)
+ (draw-line* pane
+ (+ x 1) (+ sy (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)))
+ (+ x 1) (+ sy (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)))
+ :ink +red+))
+ (progn (draw-line* pane
+ (+ x 1) (+ sy (- (+ (score-pane:staff-step 2) yoffset)))
+ (+ x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset)))
+ :ink +red+)
+ (draw-line* pane
+ (- x 1) (+ sy (- (+ (score-pane:staff-step 2) yoffset)))
+ (- x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset)))
+ :ink +red+)))))
(score-pane:with-staff-size 6
(let* ((x (final-absolute-measure-xoffset bar))
(width (final-width bar))
More information about the Gsharp-cvs
mailing list