[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