November 2005 - gsharp-cvs@common-lisp.net

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

11 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv8268 Modified Files: drawing.lisp Log Message: Fixed a rounding problem that sometimes caused the beam to extend beyond the stem. Date: Fri Nov 11 03:11:19 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.15 gsharp/drawing.lisp:1.16 --- gsharp/drawing.lisp:1.15 Thu Nov 10 23:55:45 2005 +++ gsharp/drawing.lisp Fri Nov 11 03:11:19 2005 @@ -311,9 +311,9 @@ (start-time 0)) (mapc (lambda (element) (setf (element-xpos element) - (+ x - (score-pane:staff-step (xoffset element)) - (cdr (assoc start-time time-alist)))) + (round (+ x + (score-pane:staff-step (xoffset element)) + (cdr (assoc start-time time-alist))))) (incf start-time (duration element))) (elements bar))))

1 0

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

10 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv26245 Modified Files: drawing.lisp Log Message: Multi-staff clusters in a beam group now seem to be drawn correctly. Date: Thu Nov 10 23:55:45 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.14 gsharp/drawing.lisp:1.15 --- gsharp/drawing.lisp:1.14 Thu Nov 10 23:29:15 2005 +++ gsharp/drawing.lisp Thu Nov 10 23:55:45 2005 @@ -324,19 +324,23 @@ (bot-note-pos (reduce #'min elements :key #'element-minpos))) (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up)))) +;;; the dominating note among a bunch of notes is the +;;; one that is closest to the beam, i.e. the one +;;; the one that is closest to the end of the stem that +;;; is not attached to a notehead. (defun dominating-note (notes stem-direction) (reduce (lambda (n1 n2) (let ((yoff1 (staff-yoffset (staff n1))) (yoff2 (staff-yoffset (staff n2)))) (if (eq stem-direction :up) - (if (> yoff1 yoff2) + (if (< yoff1 yoff2) n1 - (if (< yoff1 yoff2) + (if (> yoff1 yoff2) n2 (if (> (pitch n1) (pitch n2)) n1 n2))) - (if (< yoff1 yoff2) + (if (> yoff1 yoff2) n1 - (if (> yoff1 yoff2) + (if (< yoff1 yoff2) n2 (if (< (pitch n1) (pitch n2)) n1 n2)))))) notes))

1 0

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

10 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv24090 Modified Files: drawing.lisp Log Message: Added comments for some functions, slots, and variables. Renamed some locally used variables. Date: Thu Nov 10 23:29:15 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.13 gsharp/drawing.lisp:1.14 --- gsharp/drawing.lisp:1.13 Thu Nov 10 21:05:36 2005 +++ gsharp/drawing.lisp Thu Nov 10 23:29:15 2005 @@ -169,23 +169,45 @@ ;; that is not attached to a note, independent of the ;; staff on which it is located (final-stem-position :accessor final-stem-position) + ;; the yoffset of the staff relative to which the end of the + ;; stem is located (final-stem-yoffset :initform 0 :accessor final-stem-yoffset) + ;; the position, in staff steps, of the bottom not in the element. + ;; Rename this bot-note-pos or something like that (minpos :accessor element-minpos) - ;; the yoffset of the staff that contains the highest note of + ;; the yoffset of the staff that contains the top note of ;; the element + ;; Rename this top-staff-yoffset (min-yoffset :accessor element-min-yoffset) + ;; the position, in staff steps, of the top not in the element. + ;; Rename this top-note-pos or something like that (maxpos :accessor element-maxpos) - ;; the yoffset of the staff that contains the lowest note of + ;; the yoffset of the staff that contains the bottom note of ;; the element + ;; Rename this bot-staff-yoffset (max-yoffset :accessor element-max-yoffset) (xpos :accessor element-xpos))) (define-added-mixin welement () lyrics-element ((xpos :accessor element-xpos))) +;;; compute and store several important pieces of information +;;; about an element: +;;; * the position, in staff steps of the top note. +;;; Currently this is named element-maxpos. +;;; Rename it element-top-note-pos or something like that +;;; * the position, in staff steps of the bottom note. +;;; Currently this is named element-minpos. +;;; Rename it element-bot-note-pos or something like that +;;; * the y-offset of the staff containing the top note. +;;; Currently, this is called element-min-yoffset. +;;; Rename it element-top-note-staff-yoffset for instance +;;; * the y-offset of the staff containing the bottom note. +;;; Currently, this is called element-max-yoffset. +;;; Rename it element-bot-note-staff-yoffset for instance (defun compute-maxpos-minpos (element) (if (and (typep element 'cluster) (notes element)) - (let ((max-note (reduce (lambda (n1 n2) + (let ((top-note (reduce (lambda (n1 n2) (cond ((< (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) n1) @@ -197,7 +219,7 @@ n1) (t n2))) (notes element))) - (min-note (reduce (lambda (n1 n2) + (bot-note (reduce (lambda (n1 n2) (cond ((> (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) n1) @@ -209,10 +231,10 @@ n1) (t n2))) (notes element)))) - (setf (element-maxpos element) (note-position max-note) - (element-minpos element) (note-position min-note) - (element-max-yoffset element) (staff-yoffset (staff min-note)) - (element-min-yoffset element) (staff-yoffset (staff max-note)))) + (setf (element-maxpos element) (note-position top-note) + (element-minpos element) (note-position bot-note) + (element-max-yoffset element) (staff-yoffset (staff bot-note)) + (element-min-yoffset element) (staff-yoffset (staff top-note)))) (setf (element-maxpos element) 4 (element-minpos element) 4 ;; clearly wrong. should be taken from element or layer. @@ -223,18 +245,17 @@ (setf (final-stem-direction element) (if (or (eq (stem-direction element) :up) (eq (stem-direction element) :down)) (stem-direction element) - (let ((max-pos (element-maxpos element)) - (min-pos (element-minpos element))) - (if (>= (- max-pos 4) - (- 4 min-pos)) + (let ((top-note-pos (element-maxpos element)) + (bot-note-pos (element-minpos element))) + (if (>= (- top-note-pos 4) + (- 4 bot-note-pos)) :down :up))))) (defun compute-stem-length (element) - (let* ((max-pos (element-maxpos element)) - (min-pos (element-minpos element)) - ;; the uppermost note - (max-note (reduce (lambda (n1 n2) + (let* ((top-note-pos (element-maxpos element)) + (bot-note-pos (element-minpos element)) + (top-note (reduce (lambda (n1 n2) (cond ((< (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) n1) @@ -246,8 +267,7 @@ n1) (t n2))) (notes element))) - ;; the lowermost note - (min-note (reduce (lambda (n1 n2) + (bot-note (reduce (lambda (n1 n2) (cond ((> (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) n1) @@ -260,13 +280,13 @@ (t n2))) (notes element))) (length (if (eq (final-stem-direction element) :up) - (cond ((<= max-pos -3) (- 4 max-pos)) - ((<= max-pos 3) 7) - ((= max-pos 4) 6) + (cond ((<= top-note-pos -3) (- 4 top-note-pos)) + ((<= top-note-pos 3) 7) + ((= top-note-pos 4) 6) (t 5)) - (cond ((>= min-pos 11) (- min-pos 4)) - ((>= min-pos 4) 7) - ((= min-pos 3) 6) + (cond ((>= bot-note-pos 11) (- bot-note-pos 4)) + ((>= bot-note-pos 4) 7) + ((= bot-note-pos 3) 6) (t 5)))) (nb-flags (max (rbeams element) (lbeams element)))) (when (> nb-flags 0) @@ -275,11 +295,11 @@ (* 2 (max 0 (- nb-flags 2))))))) (setf (final-stem-yoffset element) (staff-yoffset (staff (if (eq (final-stem-direction element) :up) - max-note min-note)))) + top-note bot-note)))) (setf (final-stem-position element) (if (eq (final-stem-direction element) :up) - (+ max-pos length) - (- min-pos length))))) + (+ top-note-pos length) + (- bot-note-pos length))))) (defun compute-appearance (element) (when (typep element 'cluster) @@ -300,9 +320,9 @@ (defun compute-stem-directions (elements) (if (not (eq (stem-direction (car elements)) :auto)) (stem-direction (car elements)) - (let ((max-pos (reduce #'max elements :key #'element-maxpos)) - (min-pos (reduce #'min elements :key #'element-minpos))) - (if (>= (- max-pos 4) (- 4 min-pos)) :down :up)))) + (let ((top-note-pos (reduce #'max elements :key #'element-maxpos)) + (bot-note-pos (reduce #'min elements :key #'element-minpos))) + (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up)))) (defun dominating-note (notes stem-direction) (reduce (lambda (n1 n2)

1 0

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

10 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv13437 Modified Files: drawing.lisp Log Message: Fixed the display of multi-staff clusters, at least those that are not part of a beam group. After the change of the coordinate system, `max' and `min' have become ambiguous. I suggest using `top' and `bot' instead. Date: Thu Nov 10 21:05:37 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.12 gsharp/drawing.lisp:1.13 --- gsharp/drawing.lisp:1.12 Mon Oct 31 02:41:13 2005 +++ gsharp/drawing.lisp Thu Nov 10 21:05:36 2005 @@ -165,11 +165,18 @@ (define-added-mixin velement () melody-element ((final-stem-direction :accessor final-stem-direction) + ;; the position, in staff steps, of the end of the stem + ;; that is not attached to a note, independent of the + ;; staff on which it is located (final-stem-position :accessor final-stem-position) (final-stem-yoffset :initform 0 :accessor final-stem-yoffset) (minpos :accessor element-minpos) + ;; the yoffset of the staff that contains the highest note of + ;; the element (min-yoffset :accessor element-min-yoffset) (maxpos :accessor element-maxpos) + ;; the yoffset of the staff that contains the lowest note of + ;; the element (max-yoffset :accessor element-max-yoffset) (xpos :accessor element-xpos))) @@ -179,10 +186,10 @@ (defun compute-maxpos-minpos (element) (if (and (typep element 'cluster) (notes element)) (let ((max-note (reduce (lambda (n1 n2) - (cond ((> (staff-yoffset (staff n1)) + (cond ((< (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) n1) - ((< (staff-yoffset (staff n1)) + ((> (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) n2) ((> (note-position n1) @@ -191,10 +198,10 @@ (t n2))) (notes element))) (min-note (reduce (lambda (n1 n2) - (cond ((< (staff-yoffset (staff n1)) + (cond ((> (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) n1) - ((> (staff-yoffset (staff n1)) + ((< (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) n2) ((< (note-position n1) @@ -204,8 +211,8 @@ (notes element)))) (setf (element-maxpos element) (note-position max-note) (element-minpos element) (note-position min-note) - (element-max-yoffset element) (staff-yoffset (staff max-note)) - (element-min-yoffset element) (staff-yoffset (staff min-note)))) + (element-max-yoffset element) (staff-yoffset (staff min-note)) + (element-min-yoffset element) (staff-yoffset (staff max-note)))) (setf (element-maxpos element) 4 (element-minpos element) 4 ;; clearly wrong. should be taken from element or layer. @@ -226,11 +233,12 @@ (defun compute-stem-length (element) (let* ((max-pos (element-maxpos element)) (min-pos (element-minpos element)) + ;; the uppermost note (max-note (reduce (lambda (n1 n2) - (cond ((> (staff-yoffset (staff n1)) + (cond ((< (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) n1) - ((< (staff-yoffset (staff n1)) + ((> (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) n2) ((> (note-position n1) @@ -238,11 +246,12 @@ n1) (t n2))) (notes element))) + ;; the lowermost note (min-note (reduce (lambda (n1 n2) - (cond ((< (staff-yoffset (staff n1)) + (cond ((> (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) n1) - ((> (staff-yoffset (staff n1)) + ((< (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) n2) ((< (note-position n1) @@ -620,10 +629,10 @@ (unless (eq (notehead element) :whole) (if (eq direction :up) (score-pane:draw-right-stem pane x - (- min-yoffset (score-pane:staff-step min-pos)) + (- max-yoffset (score-pane:staff-step min-pos)) (- stem-yoffset (score-pane:staff-step stem-pos))) (score-pane:draw-left-stem pane x - (- max-yoffset (score-pane:staff-step max-pos)) + (- min-yoffset (score-pane:staff-step max-pos)) (- stem-yoffset (score-pane:staff-step stem-pos)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

1 0

[gsharp-cvs] CVS update: gsharp/sdl.lisp
by rstrandh＠common-lisp.net 10 Nov '05

10 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv7296 Modified Files: sdl.lisp Log Message: Make the conventions of glyph-offsets explicit. Date: Thu Nov 10 19:32:19 2005 Author: rstrandh Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.7 gsharp/sdl.lisp:1.8 --- gsharp/sdl.lisp:1.7 Tue Nov 8 06:16:14 2005 +++ gsharp/sdl.lisp Thu Nov 10 19:32:19 2005 @@ -5,7 +5,12 @@ (make-pathname :directory (pathname-directory *load-truename*)))) (defgeneric glyph (font glyph-no)) -(defgeneric glyph-offsets (font glyph-no)) +(defgeneric glyph-offsets (font glyph-no) + (:documentation "Return two values, DX and DY to be added to the reference point of +a glyph in order to obtain its upper-left corner. If (as is usually the case) +the reference point is somewhere inside the bounding box of the glyph, this +means that both the values returned are negative")) + (defgeneric staff-line-distance (font)) (defgeneric staff-line-offsets (font)) (defgeneric stem-offsets (font))

1 0

[gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp
by crhodes＠common-lisp.net 10 Nov '05

10 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv2081 Modified Files: buffer.lisp gui.lisp Log Message: rescue MAKE-LAYER: make the gui.lisp command call it with a list of one staff, and make the constructor functions &allow-other-keys. (Possibly the &a-o-k should instead be just an additional keyword argument NAME). Date: Thu Nov 10 18:37:16 2005 Author: crhodes Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.24 gsharp/buffer.lisp:1.25 --- gsharp/buffer.lisp:1.24 Mon Nov 7 21:00:52 2005 +++ gsharp/buffer.lisp Thu Nov 10 18:36:36 2005 @@ -700,9 +700,9 @@ (format stream ":staves ~W :head ~W :body ~W :tail ~W " staves head body tail))) -(defgeneric make-layer-for-staff (staff &rest args &key staves head body tail)) +(defgeneric make-layer-for-staff (staff &rest args &key staves head body tail &allow-other-keys)) -(defun make-layer (staves &rest args &key head body tail) +(defun make-layer (staves &rest args &key head body tail &allow-other-keys) (declare (type list staves) (type (or slice null) head body tail) (ignore head body tail)) @@ -721,7 +721,7 @@ #'read-melody-layer-v3 *gsharp-readtable-v3*) -(defmethod make-layer-for-staff ((staff fiveline-staff) &rest args &key staves head body tail) +(defmethod make-layer-for-staff ((staff fiveline-staff) &rest args &key staves head body tail &allow-other-keys) (declare (ignore staves head body tail)) (apply #'make-instance 'melody-layer args)) @@ -738,7 +738,7 @@ #'read-lyrics-layer-v3 *gsharp-readtable-v3*) -(defmethod make-layer-for-staff ((staff lyrics-staff) &rest args &key staves head body tail) +(defmethod make-layer-for-staff ((staff lyrics-staff) &rest args &key staves head body tail &allow-other-keys) (declare (ignore staves head body tail)) (apply #'make-instance 'lyrics-layer args)) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.40 gsharp/gui.lisp:1.41 --- gsharp/gui.lisp:1.40 Mon Nov 7 21:00:52 2005 +++ gsharp/gui.lisp Thu Nov 10 18:37:16 2005 @@ -441,7 +441,7 @@ (define-gsharp-command (com-add-layer :name t) () (let* ((name (acquire-unique-layer-name "Name of new layer")) (staff (accept 'score-pane:staff :prompt "Initial staff of new layer")) - (new-layer (make-layer staff :name name))) + (new-layer (make-layer (list staff) :name name))) (add-layer new-layer (segment (cursor *application-frame*))) (select-layer (cursor *application-frame*) new-layer)))

1 0

[gsharp-cvs] CVS update: gsharp/Scores/bach181-lyrics.gsh gsharp/Scores/bach181-lyrics.ghs
by crhodes＠common-lisp.net 10 Nov '05

10 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Scores In directory common-lisp.net:/tmp/cvs-serv1786 Added Files: bach181-lyrics.gsh Removed Files: bach181-lyrics.ghs Log Message: Rename bach181-lyrics to have a .gsh extension Date: Thu Nov 10 18:34:29 2005 Author: crhodes

1 0

[gsharp-cvs] CVS update: gsharp/score-pane.lisp gsharp/sdl.lisp
by rstrandh＠common-lisp.net 08 Nov '05

08 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv31471 Modified Files: score-pane.lisp sdl.lisp Log Message: Change the convention for staff-line-offsets so that the one going down is nonnegative and the one going up is negative. This way, they should both be added to the y-coordinate of the reference point to obtain the lower and upper edge of the staff line respectively. Date: Tue Nov 8 06:16:15 2005 Author: rstrandh Index: gsharp/score-pane.lisp diff -u gsharp/score-pane.lisp:1.16 gsharp/score-pane.lisp:1.17 --- gsharp/score-pane.lisp:1.16 Tue Nov 8 04:15:02 2005 +++ gsharp/score-pane.lisp Tue Nov 8 06:16:12 2005 @@ -304,9 +304,7 @@ (defun draw-staff-line (pane x1 staff-step x2) (multiple-value-bind (down up) (staff-line-offsets *font*) - ;; the staff line offsets are both positive, so subract - ;; the UP value from y and add the DOWN value to y. - (let ((y1 (- (- (staff-step staff-step)) up)) + (let ((y1 (+ (- (staff-step staff-step)) up)) (y2 (+ (- (staff-step staff-step)) down))) (draw-rectangle* pane x1 y1 x2 y2)))) Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.6 gsharp/sdl.lisp:1.7 --- gsharp/sdl.lisp:1.6 Tue Nov 8 04:15:02 2005 +++ gsharp/sdl.lisp Tue Nov 8 06:16:14 2005 @@ -56,7 +56,7 @@ (setf staff-line-offset-down (floor (/ staff-line-thickness 2)) staff-line-offset-up - (- staff-line-thickness staff-line-offset-down))) + (- staff-line-offset-down staff-line-thickness))) (let ((stem-thickness (round (/ staff-line-distance 11.9)))) (setf stem-offset-left (- (floor (/ stem-thickness 2))) @@ -130,14 +130,17 @@ (with-slots (x-offset y-offset) (aref (glyphs font) glyph-no) (values x-offset y-offset))) -;;; the staff line offsets are both positive integers. -;;; if the staff line has a thickness which is an even -;;; number of pixels, then the two values returned are the -;;; same. Otherwise the first value (down) is 1 smaller -;;; than the second value (up). This implies that the -;;; y-value of the reference point for a staff line is either -;;; in the middle of the staff line (if the thickness is even) -;;; or half a pixel BELOW the middle (if the thickness is odd). +;;; the DOWN staff line offset is a nonnegative integer, and the UP +;;; staff line offset is a negative integer. This way, both of them +;;; should be ADDED to a reference y value to obtain the lower and +;;; upper y coordinates of the staff line. If the staff line has a +;;; thickness which is an even number of pixels, then the two values +;;; returned have the same magnitude (but opposite signs). Otherwise +;;; the first value (DOWN) has a magnitude which is one smaller than +;;; that of the second value (UP). This implies that the y-value of the +;;; reference point for a staff line is either in the middle of the +;;; staff line (if the thickness is even) or half a pixel BELOW the +;;; middle (if the thickness is odd). (defmethod staff-line-offsets ((font font)) (with-slots (staff-line-offset-down staff-line-offset-up) font (values staff-line-offset-down staff-line-offset-up)))

1 0

[gsharp-cvs] CVS update: gsharp/score-pane.lisp gsharp/sdl.lisp
by rstrandh＠common-lisp.net 08 Nov '05

08 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv22632 Modified Files: score-pane.lisp sdl.lisp Log Message: more comments Date: Tue Nov 8 04:15:03 2005 Author: rstrandh Index: gsharp/score-pane.lisp diff -u gsharp/score-pane.lisp:1.15 gsharp/score-pane.lisp:1.16 --- gsharp/score-pane.lisp:1.15 Mon Nov 7 19:51:41 2005 +++ gsharp/score-pane.lisp Tue Nov 8 04:15:02 2005 @@ -149,6 +149,9 @@ ;;; Given a staff-step value, determine the corresponding number of ;;; pixels in the current font. The sign of the value returned is ;;; the same as that of the argument. +;;; But is that reasonable? It seems more logical to have it return +;;; the opposite sign, so that the result from staff-step is always +;;; added to some y coordinate. (defun staff-step (n) (* n (/ (staff-line-distance *font*) 2))) @@ -181,6 +184,8 @@ ;;; finally the upper glyph. ;;; It appears that this function increases the staff step in each iteration, ;;; which seems incomptible with the way draw-antialiased-glyph appears to work. +;;; This function is currently used only by the three draw-xxx-stack functions, +;;; which in turn are currently not used. (defun draw-stack (pane glyph-lower glyph-upper glyph-two x staff-step how-many) (draw-antialiased-glyph pane glyph-lower x staff-step) (loop for ss from staff-step by 2 @@ -299,8 +304,10 @@ (defun draw-staff-line (pane x1 staff-step x2) (multiple-value-bind (down up) (staff-line-offsets *font*) + ;; the staff line offsets are both positive, so subract + ;; the UP value from y and add the DOWN value to y. (let ((y1 (- (- (staff-step staff-step)) up)) - (y2 (- (- (staff-step staff-step)) down))) + (y2 (+ (- (staff-step staff-step)) down))) (draw-rectangle* pane x1 y1 x2 y2)))) (defclass staff-output-record (output-record) Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.5 gsharp/sdl.lisp:1.6 --- gsharp/sdl.lisp:1.5 Mon Aug 1 01:36:56 2005 +++ gsharp/sdl.lisp Tue Nov 8 04:15:02 2005 @@ -130,6 +130,14 @@ (with-slots (x-offset y-offset) (aref (glyphs font) glyph-no) (values x-offset y-offset))) +;;; the staff line offsets are both positive integers. +;;; if the staff line has a thickness which is an even +;;; number of pixels, then the two values returned are the +;;; same. Otherwise the first value (down) is 1 smaller +;;; than the second value (up). This implies that the +;;; y-value of the reference point for a staff line is either +;;; in the middle of the staff line (if the thickness is even) +;;; or half a pixel BELOW the middle (if the thickness is odd). (defmethod staff-line-offsets ((font font)) (with-slots (staff-line-offset-down staff-line-offset-up) font (values staff-line-offset-down staff-line-offset-up)))

1 0

[gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp gsharp/packages.lisp
by rstrandh＠common-lisp.net 07 Nov '05

07 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv22660 Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Improved on the constructors for buffer-related classes. Date: Mon Nov 7 21:00:52 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.23 gsharp/buffer.lisp:1.24 --- gsharp/buffer.lisp:1.23 Thu Nov 3 04:40:13 2005 +++ gsharp/buffer.lisp Mon Nov 7 21:00:52 2005 @@ -477,6 +477,8 @@ (defmethod print-object :after ((b bar) stream) (format stream ":elements ~W " (elements b))) +(defgeneric make-bar-for-staff (staff &rest args &key elements)) + (defmethod nb-elements ((bar bar)) (length (elements bar))) @@ -518,6 +520,10 @@ (ignore elements)) (apply #'make-instance 'melody-bar args)) +(defmethod make-bar-for-staff ((staff fiveline-staff) &rest args &key elements) + (declare (ignore elements)) + (apply #'make-instance 'melody-bar args)) + (defun read-melody-bar-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'melody-bar (read-delimited-list #\] stream t))) @@ -534,6 +540,10 @@ (ignore elements)) (apply #'make-instance 'lyrics-bar args)) +(defmethod make-bar-for-staff ((staff lyrics-staff) &rest args &key elements) + (declare (ignore elements)) + (apply #'make-instance 'lyrics-bar args)) + (defun read-lyrics-bar-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'lyrics-bar (read-delimited-list #\] stream t))) @@ -672,8 +682,15 @@ (tail :initarg :tail :accessor tail)) (:default-initargs :name "default layer")) -(defmethod initialize-instance :after ((l layer) &rest args) +(defmethod initialize-instance :after ((l layer) &rest args &key head body tail) (declare (ignore args)) + (let ((staff (car (staves l)))) + (unless head + (setf (head l) (make-slice :bars (list (make-bar-for-staff staff))))) + (unless body + (setf (body l) (make-slice :bars (list (make-bar-for-staff staff))))) + (unless tail + (setf (tail l) (make-slice :bars (list (make-bar-for-staff staff)))))) (setf (layer (head l)) l (layer (body l)) l (layer (tail l)) l)) @@ -683,25 +700,19 @@ (format stream ":staves ~W :head ~W :body ~W :tail ~W " staves head body tail))) +(defgeneric make-layer-for-staff (staff &rest args &key staves head body tail)) + +(defun make-layer (staves &rest args &key head body tail) + (declare (type list staves) + (type (or slice null) head body tail) + (ignore head body tail)) + (apply #'make-layer-for-staff (car staves) :staves staves args)) + ;;; melody layer (defclass melody-layer (layer) ((print-character :allocation :class :initform #\_))) -(defmethod make-layer (name (initial-staff fiveline-staff)) - (flet ((make-initialized-slice () - (make-slice :bars (list (make-melody-bar))))) - (let* ((head (make-initialized-slice)) - (body (make-initialized-slice)) - (tail (make-initialized-slice)) - (result (make-instance 'melody-layer - :name name :staves (list initial-staff) - :head head :body body :tail tail))) - (setf (slot-value head 'layer) result - (slot-value body 'layer) result - (slot-value tail 'layer) result) - result))) - (defun read-melody-layer-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'melody-layer (read-delimited-list #\] stream t))) @@ -710,25 +721,15 @@ #'read-melody-layer-v3 *gsharp-readtable-v3*) +(defmethod make-layer-for-staff ((staff fiveline-staff) &rest args &key staves head body tail) + (declare (ignore staves head body tail)) + (apply #'make-instance 'melody-layer args)) + ;;; lyrics layer (defclass lyrics-layer (layer) ((print-character :allocation :class :initform #\M))) -(defmethod make-layer (name (initial-staff lyrics-staff)) - (flet ((make-initialized-slice () - (make-slice :bars (list (make-lyrics-bar))))) - (let* ((head (make-initialized-slice)) - (body (make-initialized-slice)) - (tail (make-initialized-slice)) - (result (make-instance 'lyrics-layer - :name name :staves (list initial-staff) - :head head :body body :tail tail))) - (setf (slot-value head 'layer) result - (slot-value body 'layer) result - (slot-value tail 'layer) result) - result))) - (defun read-lyrics-layer-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'lyrics-layer (read-delimited-list #\] stream t))) @@ -737,6 +738,10 @@ #'read-lyrics-layer-v3 *gsharp-readtable-v3*) +(defmethod make-layer-for-staff ((staff lyrics-staff) &rest args &key staves head body tail) + (declare (ignore staves head body tail)) + (apply #'make-instance 'lyrics-layer args)) + (defmethod slices ((layer layer)) (with-slots (head body tail) layer (list head body tail))) @@ -817,7 +822,7 @@ (with-slots (layers) s (when (null layers) (assert (not (null staff))) - (push (make-layer "Default layer" staff) layers)) + (push (make-layer (list staff)) layers)) (loop for layer in layers do (setf (segment layer) s)))) @@ -864,7 +869,7 @@ (setf layers (delete layer layers :test #'eq)) ;; make sure there is one layer left (unless layers - (add-layer (make-layer "Default layer" (car (staves (buffer segment)))) + (add-layer (make-layer (staves (buffer segment))) segment))) (setf segment nil))) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.39 gsharp/gui.lisp:1.40 --- gsharp/gui.lisp:1.39 Mon Nov 7 06:23:57 2005 +++ gsharp/gui.lisp Mon Nov 7 21:00:52 2005 @@ -441,7 +441,7 @@ (define-gsharp-command (com-add-layer :name t) () (let* ((name (acquire-unique-layer-name "Name of new layer")) (staff (accept 'score-pane:staff :prompt "Initial staff of new layer")) - (new-layer (make-layer name staff))) + (new-layer (make-layer staff :name name))) (add-layer new-layer (segment (cursor *application-frame*))) (select-layer (cursor *application-frame*) new-layer))) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.25 gsharp/packages.lisp:1.26 --- gsharp/packages.lisp:1.25 Mon Nov 7 06:23:57 2005 +++ gsharp/packages.lisp Mon Nov 7 21:00:52 2005 @@ -55,8 +55,9 @@ #:lyrics-bar #:make-lyrics-bar #:layer #:lyrics-layer #:melody-layer #:bars #:nb-bars #:barno #:add-bar #:remove-bar - #:slice + #:slice #:make-slice #:segment #:slices #:sliceno + #:make-layer-for-staff #:make-bar-for-staff #:head #:body #:tail #:make-layer #:buffer #:layers #:nb-layers #:layerno #:add-layer #:remove-layer #:segment

1 0