gsharp-cvs December 2005

gsharp-cvs@common-lisp.net

1 participants
11 discussions

[gsharp-cvs] CVS update: gsharp/clim-patches.lisp gsharp/beaming.lisp gsharp/drawing.lisp gsharp/gsharp.asd gsharp/measure.lisp gsharp/score-pane.lisp
by rstrandh＠common-lisp.net 07 Dec '05

07 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv24600 Modified Files: beaming.lisp drawing.lisp gsharp.asd measure.lisp score-pane.lisp Added Files: clim-patches.lisp Log Message: Gsharp can now do multiple beams, partial beams and fractional beams. There are still some quirks, however: * there is an off-by-one-pixel error that sometimes makes the beam not attach to one of its stems; * I am still using the algorithm for a single beam to compute the beaming, even when there are multiple beams. Also fixed a bug that did not set the modified-p flag on an element when the stem direction was explicitly altered as a result of a user interaction. Date: Wed Dec 7 04:38:27 2005 Author: rstrandh Index: gsharp/beaming.lisp diff -u gsharp/beaming.lisp:1.2 gsharp/beaming.lisp:1.3 --- gsharp/beaming.lisp:1.2 Mon Feb 16 17:08:00 2004 +++ gsharp/beaming.lisp Wed Dec 7 04:38:27 2005 @@ -3,9 +3,9 @@ ;;; The beaming function takes a list of the form: ;;; ((p1 x1) (p2 x2) ... (pn xn)) ;;; where p1 through pn are staff positions (bottom line is 0, -;;; increas upwards by 1 for each half staff step) and x1 through xn +;;; increas upwards by 1 for each staff step) and x1 through xn ;;; are x positions for the clusters given in the same unit as the -;;; positions, i.e., half staff steps +;;; positions, i.e., staff steps ;;; The result of the computation is a VALID BEAMING. Such a beaming ;;; is represented as a list of two elements representing the left and @@ -18,11 +18,13 @@ ;;; representation makes it easy to transform the constellation by ;;; reflection. -;;; Take two notes and compute the beam slant and beam position for the -;;; beam connecting them. A position of zero means the bottom of the -;;; staff. Positive integers count up 1/2 space so that C on a staff -;;; with a G-clef gets to have number -2. Negative numbers go the other -;;; way. This procedure assumes that pos2 >= pos1. +;;; Take two vertical positions and compute the beam slant and beam +;;; position for the beam connecting them. A position of zero means +;;; the bottom of the staff. Positive integers count up 1/2 space so +;;; that C on a staff with a G-clef gets to have number -2. Negative +;;; numbers go the other way. This function assumes that pos2 >= pos1, +;;; and that the two notes are sufficiently far apart that the slant +;;; is going to be acceptably small. (defun beaming-single-stemsup-rising-twonotes (pos1 pos2) (let ((d (- pos2 pos1)) (s1 (+ pos2 1)) @@ -96,11 +98,19 @@ (t `((,s5 . -1) (,s7 . 0)))))))) (defun reflect-pos (pos) - (list (- 8 (car pos)) (cadr pos))) + (destructuring-bind (p x b) pos + (list (- 8 p) x b))) (defun reflect-bpos (pos) (cons (- 8 (car pos)) (- (cdr pos)))) +;;; take two points of the form (pos x b), where pos is a vertical +;;; position (in staff-steps), x is a horizontal position (also in +;;; staff-steps), and b is the number of beams at that position and +;;; compute a valid beaming for the two points. To do so, first call +;;; the function passed as an argument on the two vertical positions. +;;; If the slant thus obtained is too high, repeat with a slightly +;;; higher vertical position of the first point. (defun beaming-two-points (p1 p2 fun) (let* ((beaming (funcall fun (car p1) (car p2))) (left (car beaming)) @@ -114,8 +124,18 @@ (progn (incf (car p1)) (beaming-two-points p1 p2 fun)) beaming))) -;;; main entry +;;; main entry +;;; Take a list of the form ((p1 x1 b1) (p2 x2 b2) ... (pn xn bn)), +;;; (where pi is a vertical position, xi is a horizontal position +;;; (both measured in staff-steps), and bi is the number of stems at +;;; that position), a stem direction, and a function to compute a +;;; valid slant of two notes sufficiently far apart, compute a valid +;;; beaming. First reflect the positions vertically and horizontally +;;; until the last note is higher than the first and the stems are up. +;;; Then compute a valid beaming using only the first and last +;;; elements of the list. Finally, move the beaming up vertically +;;; until each stem it as least 2.5 staff steps long. (defun beaming-general (positions stem-direction fun) (let* ((first (car positions)) (last (car (last positions))) @@ -130,12 +150,11 @@ (right (cadr beaming)) (y1 (+ (car left) (* 0.5 (cdr left)))) (y2 (+ (car right) (* 0.5 (cdr right)))) + (slope (/ (- y2 y1) (- x2 x1))) (minstem (reduce #'min positions :key (lambda (pos) - (- (+ y1 (* (- (cadr pos) x1) - (/ (- y2 y1) - (- x2 x1)))) - (car pos))))) + (destructuring-bind (p x b) pos + (- (+ y1 (* (- x x1) slope)) p (* 2 (1- b))))))) (increment (* 2 (ceiling (/ (max 0 (- 5 minstem)) 2))))) `((,(+ (car left) increment) . ,(cdr left)) (,(+ (car right) increment) . ,(cdr right)))))))) Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.51 gsharp/drawing.lisp:1.52 --- gsharp/drawing.lisp:1.51 Tue Dec 6 17:36:03 2005 +++ gsharp/drawing.lisp Wed Dec 7 04:38:27 2005 @@ -578,7 +578,12 @@ (x-positions (mapcar (lambda (element) (/ (final-absolute-element-xoffset element) (score-pane:staff-step 1))) elements)) - (beaming (beaming-single (mapcar #'list positions x-positions) stem-direction))) + (nb-beams (mapcar (lambda (element) + (max (lbeams element) (rbeams element))) + elements)) + (beaming (beaming-single (mapcar #'list positions x-positions nb-beams) stem-direction)) + (max-nb-beams (reduce #'max nb-beams)) + (min-nb-beams (reduce #'min nb-beams))) (destructuring-bind ((ss1 . offset1) (ss2 . offset2)) beaming (let* ((y1 (+ ss1 (* 1/2 offset1))) (y2 (+ ss2 (* 1/2 offset2))) @@ -600,14 +605,72 @@ (if (eq stem-direction :up) (score-pane:with-notehead-right-offsets (right up) (declare (ignore up)) - (score-pane:draw-beam pane - (+ (final-absolute-element-xoffset (car elements)) right) ss1 offset1 - (+ (final-absolute-element-xoffset (car (last elements))) right) ss2 offset2)) + (loop repeat min-nb-beams + for ss from 0 by 2 + for offset from 0 + do (score-pane:draw-beam pane + (+ (final-absolute-element-xoffset (car elements)) right) (- ss1 ss) (+ offset1 offset) + (+ (final-absolute-element-xoffset (car (last elements))) right) (- ss2 ss) (+ offset2 offset))) + (let ((region +nowhere+)) + (loop for beams from (1+ min-nb-beams) to max-nb-beams + for ss from (* 2 min-nb-beams) by 2 + for offset from min-nb-beams + do (loop for (e1 e2) on elements + do (when (not (null e2)) + (cond ((and (>= (rbeams e1) beams) (>= (lbeams e2) beams)) + (setf region + (region-union region + (make-rectangle* (+ (final-absolute-element-xoffset e1) right) -10000 + (+ (final-absolute-element-xoffset e2) right) 10000)))) + ((>= (rbeams e1) beams) + (setf region + (region-union region + (make-rectangle* (+ (final-absolute-element-xoffset e1) right) -10000 + (+ (final-absolute-element-xoffset e1) right (score-pane:staff-step 2)) 10000)))) + ((>= (lbeams e2) beams) + (setf region + (region-union region + (make-rectangle* (+ (final-absolute-element-xoffset e2) right (score-pane:staff-step -2)) -10000 + (+ (final-absolute-element-xoffset e2) right) 10000)))) + (t nil)))) + (with-drawing-options (pane :clipping-region region) + (score-pane:draw-beam pane + (+ (final-absolute-element-xoffset (car elements)) right) (- ss1 ss) (+ offset1 offset) + (+ (final-absolute-element-xoffset (car (last elements))) right) (- ss2 ss) (+ offset2 offset)))))) (score-pane:with-notehead-left-offsets (left down) (declare (ignore down)) - (score-pane:draw-beam pane - (+ (final-absolute-element-xoffset (car elements)) left) ss1 offset1 - (+ (final-absolute-element-xoffset (car (last elements))) left) ss2 offset2)))) + (loop repeat min-nb-beams + for ss from 0 by 2 + for offset from 0 + do (score-pane:draw-beam pane + (+ (final-absolute-element-xoffset (car elements)) left) (+ ss1 ss) (- offset1 offset) + (+ (final-absolute-element-xoffset (car (last elements))) left) (+ ss2 ss) (- offset2 offset))) + (let ((region +nowhere+)) + (loop for beams from (1+ min-nb-beams) to max-nb-beams + for ss from (* 2 min-nb-beams) by 2 + for offset from min-nb-beams + do (loop for (e1 e2) on elements + do (when (not (null e2)) + (cond ((and (>= (rbeams e1) beams) (>= (lbeams e2) beams)) + (setf region + (region-union region + (make-rectangle* (+ (final-absolute-element-xoffset e1) left) -10000 + (+ (final-absolute-element-xoffset e2) left) 10000)))) + ((>= (rbeams e1) beams) + (setf region + (region-union region + (make-rectangle* (+ (final-absolute-element-xoffset e1) left) -10000 + (+ (final-absolute-element-xoffset e1) left (score-pane:staff-step 2)) 10000)))) + ((>= (lbeams e2) beams) + (setf region + (region-union region + (make-rectangle* (+ (final-absolute-element-xoffset e2) left (score-pane:staff-step -2)) -10000 + (+ (final-absolute-element-xoffset e2) left) 10000)))) + (t nil)))) + (with-drawing-options (pane :clipping-region region) + (score-pane:draw-beam pane + (+ (final-absolute-element-xoffset (car elements)) left) (+ ss1 ss) (- offset1 offset) + (+ (final-absolute-element-xoffset (car (last elements))) left) (+ ss2 ss) (- offset2 offset)))))))) (loop for element in elements do (draw-element pane element nil)))))) Index: gsharp/gsharp.asd diff -u gsharp/gsharp.asd:1.4 gsharp/gsharp.asd:1.5 --- gsharp/gsharp.asd:1.4 Tue Nov 29 20:37:39 2005 +++ gsharp/gsharp.asd Wed Dec 7 04:38:27 2005 @@ -22,6 +22,7 @@ (gsharp-defsystem (:gsharp :depends-on (:mcclim :flexichain)) "packages" + "clim-patches" "esa" "utilities" "gf" Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.19 gsharp/measure.lisp:1.20 --- gsharp/measure.lisp:1.19 Tue Nov 29 20:37:40 2005 +++ gsharp/measure.lisp Wed Dec 7 04:38:27 2005 @@ -78,6 +78,10 @@ (declare (ignore dots)) (mark-modified element)) +(defmethod (setf stem-direction) :after (direction (element relement)) + (declare (ignore direction)) + (mark-modified element)) + (defmethod note-position ((note note)) (let ((clef (clef (staff note)))) (+ (- (pitch note) Index: gsharp/score-pane.lisp diff -u gsharp/score-pane.lisp:1.17 gsharp/score-pane.lisp:1.18 --- gsharp/score-pane.lisp:1.17 Tue Nov 8 06:16:12 2005 +++ gsharp/score-pane.lisp Wed Dec 7 04:38:27 2005 @@ -612,8 +612,9 @@ (multiple-value-bind (left right) (stem-offsets *font*) (let* ((xx1 (+ x1 left)) (xx2 (+ x2 right)) - (y1 (- (floor (staff-step (+ staff-step-1 (* 1/2 offset1)))))) - (y2 (- (floor (staff-step (+ staff-step-2 (* 1/2 offset2)))))) + (offset (round (staff-step 1/3))) + (y1 (- (+ (staff-step staff-step-1) (* offset1 offset)))) + (y2 (- (+ (staff-step staff-step-2) (* offset2 offset)))) (slope (abs (/ (- y2 y1) (- xx2 xx1)))) (thickness (/ (staff-line-distance *font*) 2)) (medium (sheet-medium pane)))

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp
by rstrandh＠common-lisp.net 06 Dec '05

06 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv6462 Modified Files: drawing.lisp Log Message: Improved the calculation of the left and right bulge for clusters with suspended notes. Date: Tue Dec 6 17:36:03 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.50 gsharp/drawing.lisp:1.51 --- gsharp/drawing.lisp:1.50 Mon Dec 5 06:53:30 2005 +++ gsharp/drawing.lisp Tue Dec 6 17:36:03 2005 @@ -161,9 +161,13 @@ (/ (text-size pane (map 'string 'code-char (text element))) 2))) (defmethod left-bulge ((element cluster) pane) - (+ (- (loop for note in (notes element) - when (final-accidental note) - minimize (final-relative-accidental-xoffset note))) + (+ (max (- (loop for note in (notes element) + when (final-accidental note) + minimize (final-relative-accidental-xoffset note))) + (if (and (eq (final-stem-direction element) :down) + (element-has-suspended-notes element)) + (score-pane:staff-step 3) + (score-pane:staff-step 0))) (score-pane:staff-step 2))) (defmethod right-bulge ((element element) pane) @@ -174,7 +178,10 @@ (/ (text-size pane (map 'string 'code-char (text element))) 2))) (defmethod right-bulge ((element cluster) pane) - (score-pane:staff-step 2)) + (if (and (eq (final-stem-direction element) :up) + (element-has-suspended-notes element)) + (score-pane:staff-step 5) + (score-pane:staff-step 2))) ;;; As it turns out, the spacing algorithm would be very complicated ;;; if we were to take into account exactly how elements with

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp
by rstrandh＠common-lisp.net 05 Dec '05

05 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv10527 Modified Files: drawing.lisp Log Message: The spacing algorithm now takes into account the left bulge of the first element of each bar of the measure. Check the new behavior by loading Scores/spacetest.gsh and observe how lyrics are spaced. Date: Mon Dec 5 06:53:30 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.49 gsharp/drawing.lisp:1.50 --- gsharp/drawing.lisp:1.49 Mon Dec 5 06:33:24 2005 +++ gsharp/drawing.lisp Mon Dec 5 06:53:30 2005 @@ -288,10 +288,16 @@ ;;; measure). These values, together with an elasticity function at ;;; the beginning of a measure, are used to compute the total ;;; elasticity function of a measure. -(defun compute-elasticity-functions (measures method) +(defun compute-elasticity-functions (measures method pane) (loop for measure in measures do (setf (prefix-elasticity-function measure) - (make-elementary-elasticity (min-width method) 0.0001)) + (let ((prefix-width + (max (min-width method) + (if (zerop (flexichain:nb-elements (timelines measure))) + 0 + (loop for element in (elements (flexichain:element* (timelines measure) 0)) + maximize (left-bulge element pane)))))) + (make-elementary-elasticity prefix-width 0.0001))) do (loop with result = (prefix-elasticity-function measure) with timelines = (timelines measure) for i from 0 below (flexichain:nb-elements timelines) @@ -401,7 +407,7 @@ (lambda (measures) (compute-elasticities measures method) (compute-gaps measures method pane) - (let* ((e-fun (compute-elasticity-functions measures method)) + (let* ((e-fun (compute-elasticity-functions measures method pane)) ;; FIXME: it would be much better to compress the system ;; proportionally, so that every smallest gap gets shrunk ;; by the same percentage

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp
by rstrandh＠common-lisp.net 05 Dec '05

05 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv9353 Modified Files: drawing.lisp Log Message: Improved the bulge computation for clusters. Date: Mon Dec 5 06:33:25 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.48 gsharp/drawing.lisp:1.49 --- gsharp/drawing.lisp:1.48 Mon Dec 5 05:00:13 2005 +++ gsharp/drawing.lisp Mon Dec 5 06:33:24 2005 @@ -160,12 +160,21 @@ (+ (score-pane:staff-step 0.5) (/ (text-size pane (map 'string 'code-char (text element))) 2))) +(defmethod left-bulge ((element cluster) pane) + (+ (- (loop for note in (notes element) + when (final-accidental note) + minimize (final-relative-accidental-xoffset note))) + (score-pane:staff-step 2))) + (defmethod right-bulge ((element element) pane) (score-pane:staff-step 1)) (defmethod right-bulge ((element lyrics-element) pane) (+ (score-pane:staff-step 0.5) (/ (text-size pane (map 'string 'code-char (text element))) 2))) + +(defmethod right-bulge ((element cluster) pane) + (score-pane:staff-step 2)) ;;; As it turns out, the spacing algorithm would be very complicated ;;; if we were to take into account exactly how elements with

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp
by rstrandh＠common-lisp.net 05 Dec '05

05 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv1250 Modified Files: drawing.lisp Log Message: Implemented the new spacing algorithm. To see the difference, load Scores/spacetest.gsh and compare the result to that of the old algorithm. There are still some problems: * We do not yet take into account the left bulge of the first element on a bar; * The left-bulge and right-bulge methods on a cluster do not yet take into account the offsets of accidentals (though this is no worse than it was with the old algorithm); * If a measure has a single timeline, we should position it in the middle of the measure. I think I will leave the code for the old algorithm in there for a while in case I discover some fundamental flaw with the new one. The new one does look reasonable on rapsoden-sjunger.gsh though. Date: Mon Dec 5 05:00:13 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.47 gsharp/drawing.lisp:1.48 --- gsharp/drawing.lisp:1.47 Mon Dec 5 04:27:26 2005 +++ gsharp/drawing.lisp Mon Dec 5 05:00:13 2005 @@ -296,7 +296,7 @@ ;;; eventually replace the existing compute-measure-coordinates ;;; by this one -(defun new-compute-measure-coordinates (measure x force) +(defun new-compute-measure-coordinates (measure x y force) (loop with timelines = (timelines measure) for i from 0 below (flexichain:nb-elements timelines) for timeline = (flexichain:element* timelines i) @@ -306,7 +306,7 @@ do (loop for element in (elements timeline) do (setf (final-absolute-element-xoffset element) xx))) (loop for bar in (measure-bars measure) - do (compute-bar-coordinates bar x (size-at-force (elasticity-function measure) force)))) + do (compute-bar-coordinates bar x y (size-at-force (elasticity-function measure) force)))) (defun compute-measure-coordinates (measure min-dist compress x y method) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) @@ -323,9 +323,9 @@ method coeff min-dist)) compress)))))) - (setf (system-y-position measure) y - (final-absolute-measure-xoffset measure) x - (final-width measure) width) +;; (setf (system-y-position measure) y +;; (final-absolute-measure-xoffset measure) x +;; (final-width measure) width) (loop for bar in (measure-bars measure) do (compute-bar-coordinates bar x y width) (compute-element-x-positions bar x time-alist)))) @@ -335,19 +335,20 @@ (if (gsharp-cursor::cursors (slice bar)) (draw-bar pane bar) (score-pane:with-light-glyphs pane (draw-bar pane bar)))) - (let ((x (final-absolute-measure-xoffset measure)) - (y (system-y-position measure)) - (width (final-width measure)) - (staves (staves (buffer (segment (layer (slice (car (measure-bars measure))))))))) - (score-pane:draw-bar-line pane (+ x width) - (+ y (- (score-pane:staff-step 8))) - (+ y (staff-yoffset (car (last staves))))))) + (let ((first-bar (car (measure-bars measure)))) + (let ((x (final-absolute-measure-xoffset first-bar)) + (y (system-y-position first-bar)) + (width (final-width first-bar)) + (staves (staves (buffer (segment (layer (slice first-bar))))))) + (score-pane:draw-bar-line pane (+ x width) + (+ y (- (score-pane:staff-step 8))) + (+ y (staff-yoffset (car (last staves)))))))) ;;; eventually remove the existing compute-system-coordinates ;;; and rename this one -(defun new-compute-system-coordinates (measures x force) +(defun new-compute-system-coordinates (measures x y force) (loop for measure in measures - do (new-compute-measure-coordinates measure x force) + do (new-compute-measure-coordinates measure x y force) do (incf x (size-at-force (elasticity-function measure) force)))) (defun compute-system-coordinates (measures x y widths method) @@ -398,11 +399,14 @@ (force (if (> (zero-force-size e-fun) (line-width method)) 0 (force-at-size e-fun (line-width method))))) - nil) + (new-compute-system-coordinates measures + (+ x (left-offset buffer) timesig-offset) yy + force) + ) (let ((widths (compute-widths measures method))) - (compute-system-coordinates measures - (+ x (left-offset buffer) timesig-offset) yy - widths method) +;; (compute-system-coordinates measures +;; (+ x (left-offset buffer) timesig-offset) yy +;; widths method) (draw-system pane measures) (score-pane:draw-bar-line pane x (+ yy (- (score-pane:staff-step 8)))

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/gui.lisp
by rstrandh＠common-lisp.net 05 Dec '05

05 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv31254 Modified Files: drawing.lisp gui.lisp Log Message: Final (?) step in separating coordinate computation and drawing. Date: Mon Dec 5 04:27:27 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.46 gsharp/drawing.lisp:1.47 --- gsharp/drawing.lisp:1.46 Mon Dec 5 03:59:21 2005 +++ gsharp/drawing.lisp Mon Dec 5 04:27:26 2005 @@ -294,9 +294,9 @@ finally (setf (elasticity-function measure) result))) (reduce #'add-elasticities measures :key #'elasticity-function)) -;;; eventually remove the existing draw-measure and rename this -;;; to draw-measure -(defun new-draw-measure (pane measure x force) +;;; eventually replace the existing compute-measure-coordinates +;;; by this one +(defun new-compute-measure-coordinates (measure x force) (loop with timelines = (timelines measure) for i from 0 below (flexichain:nb-elements timelines) for timeline = (flexichain:element* timelines i) @@ -306,9 +306,7 @@ do (loop for element in (elements timeline) do (setf (final-absolute-element-xoffset element) xx))) (loop for bar in (measure-bars measure) - do (if (gsharp-cursor::cursors (slice bar)) - (new-draw-bar pane bar) - (score-pane:with-light-glyphs pane (new-draw-bar pane bar))))) + do (compute-bar-coordinates bar x (size-at-force (elasticity-function measure) force)))) (defun compute-measure-coordinates (measure min-dist compress x y method) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) @@ -345,15 +343,12 @@ (+ y (- (score-pane:staff-step 8))) (+ y (staff-yoffset (car (last staves))))))) -;;; eventually remove the existing draw-system and rename this -;;; to draw-system -(defun new-draw-system (pane measures x force staves) +;;; eventually remove the existing compute-system-coordinates +;;; and rename this one +(defun new-compute-system-coordinates (measures x force) (loop for measure in measures - do (new-draw-measure pane measure x force) - do (incf x (size-at-force (elasticity-function measure) force)) - do (score-pane:draw-bar-line pane x - (- (score-pane:staff-step 8)) - (staff-yoffset (car (last staves)))))) + do (new-compute-measure-coordinates measure x force) + do (incf x (size-at-force (elasticity-function measure) force)))) (defun compute-system-coordinates (measures x y widths method) (let ((compress (compute-compress-factor measures method)) @@ -589,8 +584,6 @@ (+ (final-absolute-element-xoffset (car (last elements))) left) ss2 offset2)))) (loop for element in elements do (draw-element pane element nil)))))) - -(defgeneric new-draw-bar (pane bar)) (defun draw-the-cursor (pane cursor-element last-note) (let* ((cursor (cursor *application-frame*)) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.47 gsharp/gui.lisp:1.48 --- gsharp/gui.lisp:1.47 Thu Dec 1 02:54:10 2005 +++ gsharp/gui.lisp Mon Dec 5 04:27:26 2005 @@ -803,7 +803,8 @@ do (forward-element (cursor *application-frame*)))) (define-gsharp-command com-backward-element ((count 'integer :prompt "Number of Elements")) - (backward-element (cursor *application-frame*))) + (loop repeat count + do (backward-element (cursor *application-frame*)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp
by rstrandh＠common-lisp.net 05 Dec '05

05 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv29015 Modified Files: drawing.lisp Log Message: More separation between coordinate calculation and drawing Date: Mon Dec 5 03:59:22 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.45 gsharp/drawing.lisp:1.46 --- gsharp/drawing.lisp:1.45 Mon Dec 5 03:29:44 2005 +++ gsharp/drawing.lisp Mon Dec 5 03:59:21 2005 @@ -1,15 +1,17 @@ (in-package :gsharp-drawing) -(define-added-mixin dbar () bar +(defclass x-y-width-mixin () (;; indicates the absolute y position of the system to which the - ;; bar belongs + ;; object belongs (system-y-position :accessor system-y-position) - ;; the absolute x position of the bar - (final-absolute-bar-xoffset :accessor final-absolute-bar-xoffset) - ;; + ;; the absolute x position of the object + (final-absolute-measure-xoffset :accessor final-absolute-measure-xoffset) (final-width :accessor final-width))) -(define-added-mixin dmeasure () measure +(define-added-mixin dbar (x-y-width-mixin) bar + ()) + +(define-added-mixin dmeasure (x-y-width-mixin) measure (;; an elasticity function that describes how the space right after ;; the initial barline of the measure behaves as a function of the ;; force that is applied to it. @@ -323,6 +325,9 @@ method coeff min-dist)) compress)))))) + (setf (system-y-position measure) y + (final-absolute-measure-xoffset measure) x + (final-width measure) width) (loop for bar in (measure-bars measure) do (compute-bar-coordinates bar x y width) (compute-element-x-positions bar x time-alist)))) @@ -331,7 +336,14 @@ (loop for bar in (measure-bars measure) do (if (gsharp-cursor::cursors (slice bar)) (draw-bar pane bar) - (score-pane:with-light-glyphs pane (draw-bar pane bar))))) + (score-pane:with-light-glyphs pane (draw-bar pane bar)))) + (let ((x (final-absolute-measure-xoffset measure)) + (y (system-y-position measure)) + (width (final-width measure)) + (staves (staves (buffer (segment (layer (slice (car (measure-bars measure))))))))) + (score-pane:draw-bar-line pane (+ x width) + (+ y (- (score-pane:staff-step 8))) + (+ y (staff-yoffset (car (last staves))))))) ;;; eventually remove the existing draw-system and rename this ;;; to draw-system @@ -343,18 +355,17 @@ (- (score-pane:staff-step 8)) (staff-yoffset (car (last staves)))))) - -(defun draw-system (pane measures x y widths method staves) +(defun compute-system-coordinates (measures x y widths method) (let ((compress (compute-compress-factor measures method)) (min-dist (compute-min-dist measures))) (loop for measure in measures for width in widths do (compute-measure-coordinates measure min-dist compress x y method) - (draw-measure pane measure) - (incf x width) - (score-pane:draw-bar-line pane x - (+ y (- (score-pane:staff-step 8))) - (+ y (staff-yoffset (car (last staves)))))))) + (incf x width)))) + +(defun draw-system (pane measures) + (loop for measure in measures do + (draw-measure pane measure))) (defmethod draw-buffer (pane (buffer buffer) *cursor* x y) (score-pane:with-staff-size 6 @@ -394,9 +405,10 @@ (force-at-size e-fun (line-width method))))) nil) (let ((widths (compute-widths measures method))) - (draw-system pane measures - (+ x (left-offset buffer) timesig-offset) yy - widths method staves) + (compute-system-coordinates measures + (+ x (left-offset buffer) timesig-offset) yy + widths method) + (draw-system pane measures) (score-pane:draw-bar-line pane x (+ yy (- (score-pane:staff-step 8))) (+ yy (staff-yoffset (car (last staves))))) @@ -614,7 +626,7 @@ (- x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset))) :ink +red+)))))) (score-pane:with-staff-size 6 - (let* ((x (final-absolute-bar-xoffset bar)) + (let* ((x (final-absolute-measure-xoffset bar)) (width (final-width bar)) (elements (elements bar))) (if (null cursor-element) @@ -629,7 +641,7 @@ (defun compute-bar-coordinates (bar x y width) (setf (system-y-position bar) y - (final-absolute-bar-xoffset bar) x + (final-absolute-measure-xoffset bar) x (final-width bar) width)) (defmethod draw-bar (pane (bar melody-bar))

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp
by rstrandh＠common-lisp.net 05 Dec '05

05 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv26804 Modified Files: drawing.lisp Log Message: Another small step toward separating coordinate computation and drawing Date: Mon Dec 5 03:29:44 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.44 gsharp/drawing.lisp:1.45 --- gsharp/drawing.lisp:1.44 Mon Dec 5 03:16:31 2005 +++ gsharp/drawing.lisp Mon Dec 5 03:29:44 2005 @@ -308,7 +308,7 @@ (new-draw-bar pane bar) (score-pane:with-light-glyphs pane (new-draw-bar pane bar))))) -(defun draw-measure (pane measure min-dist compress x y method) +(defun compute-measure-coordinates (measure min-dist compress x y method) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) compress)) (time-alist (cons (cons 0 (/ (min-width method) compress)) @@ -324,10 +324,14 @@ coeff min-dist)) compress)))))) (loop for bar in (measure-bars measure) do - (compute-element-x-positions bar x time-alist) - (if (gsharp-cursor::cursors (slice bar)) - (draw-bar pane bar x y width) - (score-pane:with-light-glyphs pane (draw-bar pane bar x y width)))))) + (compute-bar-coordinates bar x y width) + (compute-element-x-positions bar x time-alist)))) + +(defun draw-measure (pane measure) + (loop for bar in (measure-bars measure) do + (if (gsharp-cursor::cursors (slice bar)) + (draw-bar pane bar) + (score-pane:with-light-glyphs pane (draw-bar pane bar))))) ;;; eventually remove the existing draw-system and rename this ;;; to draw-system @@ -345,7 +349,8 @@ (min-dist (compute-min-dist measures))) (loop for measure in measures for width in widths do - (draw-measure pane measure min-dist compress x y method) + (compute-measure-coordinates measure min-dist compress x y method) + (draw-measure pane measure) (incf x width) (score-pane:draw-bar-line pane x (+ y (- (score-pane:staff-step 8))) @@ -622,19 +627,20 @@ (when (eq element cursor-element) (draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2)))))))))) -(defmethod draw-bar (pane (bar melody-bar) x y width) +(defun compute-bar-coordinates (bar x y width) (setf (system-y-position bar) y (final-absolute-bar-xoffset bar) x - (final-width bar) width) - (score-pane:with-vertical-score-position (pane y) + (final-width bar) width)) + +(defmethod draw-bar (pane (bar melody-bar)) + (score-pane:with-vertical-score-position + (pane (system-y-position bar)) (loop for group in (beam-groups (elements bar)) do (draw-beam-group pane group)))) -(defmethod draw-bar (pane (bar lyrics-bar) x y width) - (setf (system-y-position bar) y - (final-absolute-bar-xoffset bar) x - (final-width bar) width) - (score-pane:with-vertical-score-position (pane y) +(defmethod draw-bar (pane (bar lyrics-bar)) + (score-pane:with-vertical-score-position + (pane (system-y-position bar)) (let ((elements (elements bar))) (loop for element in elements do (draw-element pane element)))))

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp
by rstrandh＠common-lisp.net 05 Dec '05

05 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv26001 Modified Files: drawing.lisp Log Message: A step toward the separation of the code for assigning x and y coordinates to all objects and the code for drawing those objects. Date: Mon Dec 5 03:16:32 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.43 gsharp/drawing.lisp:1.44 --- gsharp/drawing.lisp:1.43 Thu Dec 1 02:54:10 2005 +++ gsharp/drawing.lisp Mon Dec 5 03:16:31 2005 @@ -324,9 +324,10 @@ coeff min-dist)) compress)))))) (loop for bar in (measure-bars measure) do + (compute-element-x-positions bar x time-alist) (if (gsharp-cursor::cursors (slice bar)) - (draw-bar pane bar x y width time-alist) - (score-pane:with-light-glyphs pane (draw-bar pane bar x y width time-alist)))))) + (draw-bar pane bar x y width) + (score-pane:with-light-glyphs pane (draw-bar pane bar x y width)))))) ;;; eventually remove the existing draw-system and rename this ;;; to draw-system @@ -486,8 +487,7 @@ (- bot-note-pos length))))) (defun compute-element-x-positions (bar x time-alist) - (let (;;(time-alist (time-alist bar)) - (start-time 0)) + (let ((start-time 0)) (mapc (lambda (element) (setf (final-absolute-element-xoffset element) (round (+ x @@ -524,7 +524,7 @@ (when (or (typep element 'rest) (notes element)) (when (non-empty-cluster-p element) (compute-stem-length element)) - (draw-element pane element (final-absolute-element-xoffset element)))) + (draw-element pane element))) (let* ((stem-direction (final-stem-direction (car elements))) (dominating-notes (loop for element in elements @@ -571,7 +571,7 @@ (+ (final-absolute-element-xoffset (car elements)) left) ss1 offset1 (+ (final-absolute-element-xoffset (car (last elements))) left) ss2 offset2)))) (loop for element in elements do - (draw-element pane element (final-absolute-element-xoffset element) nil)))))) + (draw-element pane element nil)))))) (defgeneric new-draw-bar (pane bar)) @@ -622,8 +622,7 @@ (when (eq element cursor-element) (draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2)))))))))) -(defmethod draw-bar (pane (bar melody-bar) x y width time-alist) - (compute-element-x-positions bar x time-alist) +(defmethod draw-bar (pane (bar melody-bar) x y width) (setf (system-y-position bar) y (final-absolute-bar-xoffset bar) x (final-width bar) width) @@ -631,21 +630,20 @@ (loop for group in (beam-groups (elements bar)) do (draw-beam-group pane group)))) -(defmethod draw-bar (pane (bar lyrics-bar) x y width time-alist) - (compute-element-x-positions bar x time-alist) +(defmethod draw-bar (pane (bar lyrics-bar) x y width) (setf (system-y-position bar) y (final-absolute-bar-xoffset bar) x (final-width bar) width) (score-pane:with-vertical-score-position (pane y) (let ((elements (elements bar))) (loop for element in elements - do (draw-element pane element (final-absolute-element-xoffset element)))))) + do (draw-element pane element))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Cluster -(defgeneric draw-element (pane element x &optional flags)) +(defgeneric draw-element (pane element &optional flags)) (defmethod note-difference ((note1 note) (note2 note)) (- (pitch note1) (pitch note2))) @@ -695,19 +693,16 @@ ;;; draw a cluster. The stem direction and the stem position have ;;; already been computed. ;;; 1. Group notes by staff. -;;; 2. Determine which notes in each group go to the left and which notes -;;; go to the right of the stem. -;;; 3. Determine which notes in each group should be displayed with an accidental. -;;; 4. Compute the x offset of each accidental to be displayed. -;;; 5. Draw the notes in each group -;;; 6. If necessary, draw ledger lines for notes in a group -;;; 7. Draw the stem, if any -(defmethod draw-element (pane (element cluster) x &optional (flags t)) +;;; 2. Draw the notes in each group +;;; 3. If necessary, draw ledger lines for notes in a group +;;; 4. Draw the stem, if any +(defmethod draw-element (pane (element cluster) &optional (flags t)) (unless (null (notes element)) (let ((direction (final-stem-direction element)) (stem-pos (final-stem-position element)) (stem-yoffset (final-stem-yoffset element)) - (groups (group-notes-by-staff (notes element)))) + (groups (group-notes-by-staff (notes element))) + (x (final-absolute-element-xoffset element))) (when flags (score-pane:with-vertical-score-position (pane stem-yoffset) (draw-flags pane element x direction stem-pos))) @@ -729,19 +724,21 @@ ;;; ;;; Rest -(defmethod draw-element (pane (element rest) x &optional (flags t)) +(defmethod draw-element (pane (element rest) &optional (flags t)) (declare (ignore flags)) - (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) - (score-pane:draw-rest pane (undotted-duration element) x (staff-pos element)) - (draw-dots pane (dots element) x (1+ (staff-pos element))))) + (let ((x (final-absolute-element-xoffset element))) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) + (score-pane:draw-rest pane (undotted-duration element) x (staff-pos element)) + (draw-dots pane (dots element) x (1+ (staff-pos element)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Lyrics element -(defmethod draw-element (pane (element lyrics-element) x &optional (flags t)) +(defmethod draw-element (pane (element lyrics-element) &optional (flags t)) (declare (ignore flags)) - (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) - (with-text-family (pane :serif) - (draw-text* pane (map 'string 'code-char (text element)) - x 0 :align-x :center)))) + (let ((x (final-absolute-element-xoffset element))) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) + (with-text-family (pane :serif) + (draw-text* pane (map 'string 'code-char (text element)) + x 0 :align-x :center)))))

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/gui.lisp gsharp/packages.lisp
by rstrandh＠common-lisp.net 01 Dec '05

01 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv12638 Modified Files: drawing.lisp gui.lisp packages.lisp Log Message: Removed the cursor-drawing code from the score-drawing functions. Instead we now store the x and y positions and the width of each bar. Cursor drawing is now implemented as looking up those stored values and draing the cursor based on them. Date: Thu Dec 1 02:54:11 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.42 gsharp/drawing.lisp:1.43 --- gsharp/drawing.lisp:1.42 Wed Nov 30 23:23:51 2005 +++ gsharp/drawing.lisp Thu Dec 1 02:54:10 2005 @@ -1,5 +1,14 @@ (in-package :gsharp-drawing) +(define-added-mixin dbar () bar + (;; indicates the absolute y position of the system to which the + ;; bar belongs + (system-y-position :accessor system-y-position) + ;; the absolute x position of the bar + (final-absolute-bar-xoffset :accessor final-absolute-bar-xoffset) + ;; + (final-width :accessor final-width))) + (define-added-mixin dmeasure () measure (;; an elasticity function that describes how the space right after ;; the initial barline of the measure behaves as a function of the @@ -285,7 +294,7 @@ ;;; eventually remove the existing draw-measure and rename this ;;; to draw-measure -(defun new-draw-measure (pane measure x force draw-cursor) +(defun new-draw-measure (pane measure x force) (loop with timelines = (timelines measure) for i from 0 below (flexichain:nb-elements timelines) for timeline = (flexichain:element* timelines i) @@ -296,10 +305,10 @@ do (setf (final-absolute-element-xoffset element) xx))) (loop for bar in (measure-bars measure) do (if (gsharp-cursor::cursors (slice bar)) - (new-draw-bar pane bar draw-cursor) - (score-pane:with-light-glyphs pane (new-draw-bar pane bar draw-cursor))))) + (new-draw-bar pane bar) + (score-pane:with-light-glyphs pane (new-draw-bar pane bar))))) -(defun draw-measure (pane measure min-dist compress x y method draw-cursor) +(defun draw-measure (pane measure min-dist compress x y method) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) compress)) (time-alist (cons (cons 0 (/ (min-width method) compress)) @@ -316,32 +325,32 @@ compress)))))) (loop for bar in (measure-bars measure) do (if (gsharp-cursor::cursors (slice bar)) - (draw-bar pane bar x y width time-alist draw-cursor) - (score-pane:with-light-glyphs pane (draw-bar pane bar x y width time-alist draw-cursor)))))) + (draw-bar pane bar x y width time-alist) + (score-pane:with-light-glyphs pane (draw-bar pane bar x y width time-alist)))))) ;;; eventually remove the existing draw-system and rename this ;;; to draw-system -(defun new-draw-system (pane measures x force staves draw-cursor) +(defun new-draw-system (pane measures x force staves) (loop for measure in measures - do (new-draw-measure pane measure x force draw-cursor) + do (new-draw-measure pane measure x force) do (incf x (size-at-force (elasticity-function measure) force)) do (score-pane:draw-bar-line pane x (- (score-pane:staff-step 8)) (staff-yoffset (car (last staves)))))) -(defun draw-system (pane measures x y widths method staves draw-cursor) +(defun draw-system (pane measures x y widths method staves) (let ((compress (compute-compress-factor measures method)) (min-dist (compute-min-dist measures))) (loop for measure in measures for width in widths do - (draw-measure pane measure min-dist compress x y method draw-cursor) + (draw-measure pane measure min-dist compress x y method) (incf x width) (score-pane:draw-bar-line pane x (+ y (- (score-pane:staff-step 8))) (+ y (staff-yoffset (car (last staves)))))))) -(defmethod draw-buffer (pane (buffer buffer) *cursor* x y draw-cursor) +(defmethod draw-buffer (pane (buffer buffer) *cursor* x y) (score-pane:with-staff-size 6 (let* ((staves (staves buffer)) (timesig-offset (max (* (score-pane:staff-step 2) @@ -381,7 +390,7 @@ (let ((widths (compute-widths measures method))) (draw-system pane measures (+ x (left-offset buffer) timesig-offset) yy - widths method staves draw-cursor) + widths method staves) (score-pane:draw-bar-line pane x (+ yy (- (score-pane:staff-step 8))) (+ yy (staff-yoffset (car (last staves))))) @@ -564,44 +573,73 @@ (loop for element in elements do (draw-element pane element (final-absolute-element-xoffset element) nil)))))) -(defun draw-cursor (pane x) - (draw-line* pane x (- (score-pane:staff-step -4)) x (- (score-pane:staff-step 12)) :ink +red+)) +(defgeneric new-draw-bar (pane bar)) -(defgeneric new-draw-bar (pane bar draw-cursor)) +(defun draw-the-cursor (pane cursor-element last-note) + (let* ((cursor (cursor *application-frame*)) + (staff (car (staves (layer cursor)))) + (bar (bar cursor))) + (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 (- (ecase (name clef) (:treble 32) (:bass 24) (:c 35)) + (lineno 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-bar-xoffset bar)) + (width (final-width bar)) + (elements (elements bar))) + (if (null cursor-element) + (draw-cursor (/ (+ (if (null elements) + x + (final-absolute-element-xoffset (car (last elements)))) + x width) 2)) + (loop for element in elements + and xx = x then (final-absolute-element-xoffset element) do + (when (eq element cursor-element) + (draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2)))))))))) -(defmethod draw-bar (pane (bar melody-bar) x y width time-alist draw-cursor) +(defmethod draw-bar (pane (bar melody-bar) x y width time-alist) (compute-element-x-positions bar x time-alist) + (setf (system-y-position bar) y + (final-absolute-bar-xoffset bar) x + (final-width bar) width) (score-pane:with-vertical-score-position (pane y) (loop for group in (beam-groups (elements bar)) - do (draw-beam-group pane group)) - (when (eq (cursor-bar *cursor*) bar) - (let ((elements (elements bar))) - (if (null (cursor-element *cursor*)) - (funcall draw-cursor (/ (+ (if (null elements) - x - (final-absolute-element-xoffset (car (last elements)))) - x width) 2)) - (loop for element in elements - and xx = x then (final-absolute-element-xoffset element) do - (when (eq (cursor-element *cursor*) element) - (funcall draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2))))))))) + do (draw-beam-group pane group)))) -(defmethod draw-bar (pane (bar lyrics-bar) x y width time-alist draw-cursor) +(defmethod draw-bar (pane (bar lyrics-bar) x y width time-alist) (compute-element-x-positions bar x time-alist) + (setf (system-y-position bar) y + (final-absolute-bar-xoffset bar) x + (final-width bar) width) (score-pane:with-vertical-score-position (pane y) (let ((elements (elements bar))) (loop for element in elements - do (draw-element pane element (final-absolute-element-xoffset element))) - (when (eq (cursor-bar *cursor*) bar) - (if (null (cursor-element *cursor*)) - (funcall draw-cursor (/ (+ (if (null elements) - x - (final-absolute-element-xoffset (car (last elements)))) - x width) 2)) - (loop for element in elements - and xx = x then (final-absolute-element-xoffset element) do - (when (eq (cursor-element *cursor*) element) - (funcall draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2))))))))) + do (draw-element pane element (final-absolute-element-xoffset element)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.46 gsharp/gui.lisp:1.47 --- gsharp/gui.lisp:1.46 Thu Dec 1 01:19:39 2005 +++ gsharp/gui.lisp Thu Dec 1 02:54:10 2005 @@ -103,44 +103,13 @@ for dx from (+ right 5) by 5 do (score-pane:draw-dot pane (+ xpos dx) 4))))))))) -(defun draw-the-cursor (pane x) - (let* ((state (input-state *application-frame*)) - (staff (car (staves (layer (cursor *application-frame*))))) - ;; 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 (- (ecase (name clef) (:treble 32) (:bass 24) (:c 35)) - (lineno clef))) - (lnote-offset (score-pane:staff-step (- (last-note state) bottom-line)))) - (draw-line* pane - x (- (+ (score-pane:staff-step 12) yoffset)) - x (- (+ (score-pane:staff-step -4) yoffset)) - :ink +yellow+) - (draw-line* pane - (- x 1) (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)) - (- x 1) (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)) - :ink +red+) - (draw-line* pane - (+ x 1) (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)) - (+ x 1) (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)) - :ink +red+)) - (progn (draw-line* pane - (+ x 1) (- (+ (score-pane:staff-step 2) yoffset)) - (+ x 1) (- (+ (score-pane:staff-step -2) yoffset)) - :ink +red+) - (draw-line* pane - (- x 1) (- (+ (score-pane:staff-step 2) yoffset)) - (- x 1) (- (+ (score-pane:staff-step -2) yoffset)) - :ink +red+))))) - (defmethod display-score ((frame gsharp) pane) (let* ((buffer (buffer frame))) (recompute-measures buffer) (score-pane:with-score-pane pane - (flet ((draw-cursor (x) (draw-the-cursor pane x))) - (draw-buffer pane buffer (cursor *application-frame*) - (left-margin buffer) 100 #'draw-cursor))))) + (draw-buffer pane buffer (cursor *application-frame*) + (left-margin buffer) 100) + (gsharp-drawing::draw-the-cursor pane (cursor-element (cursor *application-frame*)) (last-note (input-state *application-frame*)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.36 gsharp/packages.lisp:1.37 --- gsharp/packages.lisp:1.36 Tue Nov 29 20:37:40 2005 +++ gsharp/packages.lisp Thu Dec 1 02:54:10 2005 @@ -196,7 +196,7 @@ (:use :clim :clim-lisp :gsharp-buffer :gsharp-measure :gsharp-cursor :gsharp-utilities :sdl :gsharp-beaming :obseq) (:shadowing-import-from :gsharp-buffer #:rest) - (:export #:draw-buffer)) + (:export #:draw-buffer #:draw-the-cursor)) (defpackage :midi (:use :common-lisp)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

gsharp-cvs December 2005