- gsharp-cvs@common-lisp.net - mailman3.common-lisp.net

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

12 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv7403 Modified Files: drawing.lisp Log Message: Some code factoring. Date: Sat Nov 12 08:14:29 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.18 gsharp/drawing.lisp:1.19 --- gsharp/drawing.lisp:1.18 Fri Nov 11 20:19:39 2005 +++ gsharp/drawing.lisp Sat Nov 12 08:14:28 2005 @@ -187,6 +187,36 @@ (define-added-mixin welement () lyrics-element ((xpos :accessor element-xpos))) +;;; given a list of notes, return the one that is at the top +(defun top-note (notes) + (reduce (lambda (n1 n2) + (cond ((< (staff-yoffset (staff n1)) + (staff-yoffset (staff n2))) + n1) + ((> (staff-yoffset (staff n1)) + (staff-yoffset (staff n2))) + n2) + ((> (note-position n1) + (note-position n2)) + n1) + (t n2))) + notes)) + +;;; given a list of notes, return the one that is at the bottom +(defun bot-note (notes) + (reduce (lambda (n1 n2) + (cond ((> (staff-yoffset (staff n1)) + (staff-yoffset (staff n2))) + n1) + ((< (staff-yoffset (staff n1)) + (staff-yoffset (staff n2))) + n2) + ((< (note-position n1) + (note-position n2)) + n1) + (t n2))) + notes)) + ;;; compute and store several important pieces of information ;;; about an element: ;;; * the position, in staff steps of the top note. @@ -195,30 +225,8 @@ ;;; * the y-offset of the staff containing the bottom note. (defun compute-top-bot-pos-yoffset (element) (if (and (typep element 'cluster) (notes element)) - (let ((top-note (reduce (lambda (n1 n2) - (cond ((< (staff-yoffset (staff n1)) - (staff-yoffset (staff n2))) - n1) - ((> (staff-yoffset (staff n1)) - (staff-yoffset (staff n2))) - n2) - ((> (note-position n1) - (note-position n2)) - n1) - (t n2))) - (notes element))) - (bot-note (reduce (lambda (n1 n2) - (cond ((> (staff-yoffset (staff n1)) - (staff-yoffset (staff n2))) - n1) - ((< (staff-yoffset (staff n1)) - (staff-yoffset (staff n2))) - n2) - ((< (note-position n1) - (note-position n2)) - n1) - (t n2))) - (notes element)))) + (let ((top-note (top-note (notes element))) + (bot-note (bot-note (notes element)))) (setf (top-note-pos element) (note-position top-note) (bot-note-pos element) (note-position bot-note) (bot-note-staff-yoffset element) (staff-yoffset (staff bot-note))

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/sdl.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-serv19393 Modified Files: drawing.lisp sdl.lisp Log Message: added comments Date: Fri Nov 11 20:19:40 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.17 gsharp/drawing.lisp:1.18 --- gsharp/drawing.lisp:1.17 Fri Nov 11 19:47:08 2005 +++ gsharp/drawing.lisp Fri Nov 11 20:19:39 2005 @@ -485,18 +485,30 @@ (loop for note in notes do (draw-note pane note notehead dots (final-xposition note) (note-position note)))) +;;; given a group of notes (i.e. a list of notes, all displayed on the +;;; same staff, compute their final x offsets. This is a question of +;;; determining whether the note goes to the right or to the left of +;;; the stem. The head-note of the stem goes to the left of an +;;; up-stem and to the right of a down-stem. The x offset of a cluster +;;; gives the x position of the head-note. (defun compute-final-xpositions (group x direction) (setf group (sort (copy-list group) (if (eq direction :up) (lambda (x y) (< (note-position x) (note-position y))) (lambda (x y) (> (note-position x) (note-position y)))))) (score-pane:with-suspended-note-offset offset + ;; the first element of the group is the head-note (setf (final-xposition (car group)) x) + ;; OFFSET is a positive quantity that determines the + ;; absolute difference between the x offset of a suspended + ;; note and that of a normally positioned note. (when (eq direction :down) (setf offset (- offset))) (loop for note in (cdr group) and old-note = (car group) then note do (let* ((pos (note-position note)) (old-pos (note-position old-note)) + ;; if adjacent notes are just one staff step apart, + ;; then one must be suspended. (dx (if (= (abs (- pos old-pos)) 1) offset 0))) (setf (final-xposition note) (+ x dx)) ;; go back to ordinary offset @@ -612,6 +624,8 @@ (setf (accidental-position choice) (accidental-min-xpos choice notes staff-step)))))) +;;; given a list of notes, group them so that every note in the group +;;; is displayed on the same staff. Return the list of groups. (defun group-notes-by-staff (notes) (let ((groups '())) (loop while notes do Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.8 gsharp/sdl.lisp:1.9 --- gsharp/sdl.lisp:1.8 Thu Nov 10 19:32:19 2005 +++ gsharp/sdl.lisp Fri Nov 11 20:19:39 2005 @@ -19,7 +19,9 @@ (defgeneric notehead-right-offsets (font)) (defgeneric notehead-left-offsets (font)) (defgeneric bar-line-offsets (font)) -(defgeneric suspended-note-offset (font)) +(defgeneric suspended-note-offset (font) + (:documentation "the x offset of a suspended note compared to that +of a normal note. This function always returns a positive value")) (defclass font () ((gf-font :initarg :gf-font :reader gf-font)

1 0

[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-serv16724 Modified Files: drawing.lisp Log Message: Some preventive maintenance. Used `top' and `bot' instead of `max' and 'min' to refer to the extreme notes of a cluster. Date: Fri Nov 11 19:47:08 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.16 gsharp/drawing.lisp:1.17 --- gsharp/drawing.lisp:1.16 Fri Nov 11 03:11:19 2005 +++ gsharp/drawing.lisp Fri Nov 11 19:47:08 2005 @@ -172,20 +172,16 @@ ;; 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 position, in staff steps, of the bottom note in the element. + (bot-note-pos :accessor bot-note-pos) ;; the yoffset of the staff that contains the top note of ;; the element - ;; Rename this top-staff-yoffset - (min-yoffset :accessor element-min-yoffset) + (top-note-staff-yoffset :accessor top-note-staff-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) + (top-note-pos :accessor top-note-pos) ;; the yoffset of the staff that contains the bottom note of ;; the element - ;; Rename this bot-staff-yoffset - (max-yoffset :accessor element-max-yoffset) + (bot-note-staff-yoffset :accessor bot-note-staff-yoffset) (xpos :accessor element-xpos))) (define-added-mixin welement () lyrics-element @@ -194,18 +190,10 @@ ;;; 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) +(defun compute-top-bot-pos-yoffset (element) (if (and (typep element 'cluster) (notes element)) (let ((top-note (reduce (lambda (n1 n2) (cond ((< (staff-yoffset (staff n1)) @@ -231,30 +219,30 @@ n1) (t n2))) (notes element)))) - (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 + (setf (top-note-pos element) (note-position top-note) + (bot-note-pos element) (note-position bot-note) + (bot-note-staff-yoffset element) (staff-yoffset (staff bot-note)) + (top-note-staff-yoffset element) (staff-yoffset (staff top-note)))) + (setf (top-note-pos element) 4 + (bot-note-pos element) 4 ;; clearly wrong. should be taken from element or layer. - (element-min-yoffset element) 0 - (element-max-yoffset element) 0))) + (top-note-staff-yoffset element) 0 + (bot-note-staff-yoffset element) 0))) (defun compute-stem-direction (element) (setf (final-stem-direction element) (if (or (eq (stem-direction element) :up) (eq (stem-direction element) :down)) (stem-direction element) - (let ((top-note-pos (element-maxpos element)) - (bot-note-pos (element-minpos element))) + (let ((top-note-pos (top-note-pos element)) + (bot-note-pos (bot-note-pos element))) (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up))))) (defun compute-stem-length (element) - (let* ((top-note-pos (element-maxpos element)) - (bot-note-pos (element-minpos element)) + (let* ((top-note-pos (top-note-pos element)) + (bot-note-pos (bot-note-pos element)) (top-note (reduce (lambda (n1 n2) (cond ((< (staff-yoffset (staff n1)) (staff-yoffset (staff n2))) @@ -320,8 +308,8 @@ (defun compute-stem-directions (elements) (if (not (eq (stem-direction (car elements)) :auto)) (stem-direction (car elements)) - (let ((top-note-pos (reduce #'max elements :key #'element-maxpos)) - (bot-note-pos (reduce #'min elements :key #'element-minpos))) + (let ((top-note-pos (reduce #'max elements :key #'top-note-pos)) + (bot-note-pos (reduce #'min elements :key #'bot-note-pos))) (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up)))) ;;; the dominating note among a bunch of notes is the @@ -346,7 +334,7 @@ notes)) (defun draw-beam-group (pane elements) - (mapc #'compute-maxpos-minpos elements) + (mapc #'compute-top-bot-pos-yoffset elements) (if (null (cdr elements)) (when (or (typep (car elements) 'rest) (notes (car elements))) (compute-appearance (car elements)) @@ -461,11 +449,11 @@ (defun draw-ledger-lines (pane x notes) (score-pane:with-vertical-score-position (pane (staff-yoffset (staff (car notes)))) (let* ((positions (mapcar #'note-position notes)) - (max-pos (reduce #'max positions)) - (min-pos (reduce #'min positions))) - (loop for pos from 10 to max-pos by 2 + (top-note-pos (reduce #'max positions)) + (bot-note-pos (reduce #'min positions))) + (loop for pos from 10 to top-note-pos by 2 do (score-pane:draw-ledger-line pane x pos)) - (loop for pos from -2 downto min-pos by 2 + (loop for pos from -2 downto bot-note-pos by 2 do (score-pane:draw-ledger-line pane x pos))))) (defun draw-flags (pane element x direction pos) @@ -633,11 +621,7 @@ (defmethod draw-element (pane (element cluster) x &optional (flags t)) (when (notes element) - (let ((max-pos (element-maxpos element)) - (min-pos (element-minpos element)) - (max-yoffset (element-max-yoffset element)) - (min-yoffset (element-min-yoffset element)) - (direction (final-stem-direction 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)))) @@ -652,12 +636,14 @@ (draw-ledger-lines pane x group)) (unless (eq (notehead element) :whole) (if (eq direction :up) - (score-pane:draw-right-stem pane x - (- max-yoffset (score-pane:staff-step min-pos)) - (- stem-yoffset (score-pane:staff-step stem-pos))) - (score-pane:draw-left-stem pane x - (- min-yoffset (score-pane:staff-step max-pos)) - (- stem-yoffset (score-pane:staff-step stem-pos)))))))) + (score-pane:draw-right-stem + pane x + (- (bot-note-staff-yoffset element) (score-pane:staff-step (bot-note-pos element))) + (- stem-yoffset (score-pane:staff-step stem-pos))) + (score-pane:draw-left-stem + pane x + (- (top-note-staff-yoffset element) (score-pane:staff-step (top-note-pos element))) + (- stem-yoffset (score-pane:staff-step stem-pos)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[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