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

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

15 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv19808 Modified Files: drawing.lisp sdl.lisp Log Message: Added more comments in an attempt to improve maintainability. Plus, it helps me understand what I meant when I initially wrote the code. Date: Tue Nov 15 19:49:52 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.19 gsharp/drawing.lisp:1.20 --- gsharp/drawing.lisp:1.19 Sat Nov 12 08:14:28 2005 +++ gsharp/drawing.lisp Tue Nov 15 19:49:52 2005 @@ -534,6 +534,16 @@ (defun element-has-suspended-notes (element) (not (apply #'= (mapcar #'final-xposition (notes element))))) +;;; table of x offsets (in staff steps) of accendentals. +;;; The first index represents a notehead or a type of accidental. +;;; The second index represents a type of accidentsl. +;;; The third index is a vertical distance, measured in difference +;;; in staff steps between the two. +;;; The table entry gives how much the accidental represented by +;;; the second parameter must be positioned to the left of the +;;; first one. +;;; Entries in the table are offset by 5 in the last dimension +;;; so that vertical distances between -5 and 5 can be represented (defparameter *accidental-offset* ;;; -5 -4 -3 -2 -1 0 1 2 3 4 5 #3A((( 0 0 0 3.5 3.5 3.5 3.5 3.5 3.5 1 0) ; notehead - dbl flat @@ -567,6 +577,11 @@ ( 0 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 0) ; dbl sharp - sharp ( 0 0 0 2.8 2.8 2.8 2.8 2.8 0 0 0)))) ; dbl sharp - dbl sharp +;;; given 1) a type of accidental 2) its position (in staff steps) 3) +;;; a type of accidental or a type of notehead, and 4) its position, +;;; return the x offset of the first accidental, i.e., how many staff +;;; steps to the left that it must be moved in order to avoid overlap +;;; with the second one. (defun accidental-distance (acc1 pos1 acc2 pos2) (let ((dist (- pos2 pos1))) (if (> (abs dist) 5) @@ -587,6 +602,13 @@ (:double-sharp 4)) (+ dist 5))))) +;;; given two notes (where the first one has an accidental, and the +;;; second one may or may not have an accidental) and the conversion +;;; factor between staff steps and x positions, compute the x offset +;;; of the accidental of the first note. If the second note has +;;; an accidental, but that has not been given a final x offset, then +;;; use the x offset of the notehead instead. +;;; (this funtction should probably be renamed accidental-xoffset) (defun accidental-xpos (note1 note2 staff-step) (let* ((acc1 (final-accidental note1)) (pos1 (note-position note1)) @@ -599,9 +621,18 @@ (final-xposition note2)))) (- xpos2 (* staff-step (accidental-distance acc1 pos1 acc2 pos2))))) +;;; given a note and a list of notes, compute x offset of the accidental +;;; of the note as required by each of the notes in the list. In order +;;; for the accidental of the note not to overlap any of the others, +;;; we must use the minimum of all the x offsets thus computed. +;;; (this function shoudl probably be renamed accidental-min-xoffset) (defun accidental-min-xpos (note1 notes staff-step) (reduce #'min notes :key (lambda (note) (accidental-xpos note1 note staff-step)))) +;;; given a list of notes that have accidentals to place, and a list of +;;; notes that either have no accidentals or with already-placed accidentals, +;;; compute the note in the first list that can be placed as far to the right +;;; as possible. (defun best-accidental (notes-with-accidentals notes staff-step) (reduce (lambda (note1 note2) (if (>= (accidental-min-xpos note1 notes staff-step) (accidental-min-xpos note2 notes staff-step)) @@ -609,14 +640,20 @@ note2)) notes-with-accidentals)) +;;; for each note in a list of notes, if it has an accidental, compute +;;; the position of that accidental and store it in the note. (defun compute-final-accidental-positions (notes x final-stem-direction) (let* ((staff-step (score-pane:staff-step 1)) + ;; sort the notes from top to bottom (notes (sort (copy-list notes) (lambda (x y) (> (note-position x) (note-position y))))) (notes-with-accidentals (remove-if-not #'final-accidental notes))) ;; initially, no accidental has been placed (loop for note in notes do (setf (accidental-position note) nil)) (when (eq final-stem-direction :up) + ;; when the stem direction is :up and there is a suspended note + ;; i.e., one to the right of the stem, then the accidental of the topmost + ;; suspended note is placed first. (let ((first-suspended-note (find x notes-with-accidentals :test #'/= :key #'final-xposition))) (when first-suspended-note @@ -641,6 +678,16 @@ (setf notes (remove (staff (car notes)) notes :test #'eq :key #'staff))) groups)) +;;; 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)) (when (notes element) (let ((direction (final-stem-direction element)) Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.11 gsharp/sdl.lisp:1.12 --- gsharp/sdl.lisp:1.11 Mon Nov 14 23:52:13 2005 +++ gsharp/sdl.lisp Tue Nov 15 19:49:52 2005 @@ -110,6 +110,9 @@ (declare (ignore initargs)) (with-slots (gf-char x-offset y-offset) glyph (setf x-offset (floor (gf-char-min-m gf-char) 4) + ;; adding 1 to gv-char-max-n is necessary because + ;; of a discrepancy between the GF documentation + ;; and the GF file format y-offset (- (ceiling (1+ (gf-char-max-n gf-char)) 4))))) (defmethod glyph ((font font) glyph-no) @@ -117,6 +120,9 @@ (let ((left (floor (gf-char-min-m gf-char) 4)) (right (ceiling (1+ (gf-char-max-m gf-char)) 4)) (down (floor (gf-char-min-n gf-char) 4)) + ;; adding 1 to gv-char-max-n is necessary because + ;; of a discrepancy between the GF documentation + ;; and the GF file format (up (ceiling (1+ (gf-char-max-n gf-char)) 4)) (matrix (gf-char-matrix gf-char))) (unless pixmap

1 0

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

14 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv28082 Modified Files: sdl.lisp Log Message: re-inserted a `1+' to compensate for the fact that GF's max-n is off by 1. Date: Mon Nov 14 23:52:14 2005 Author: rstrandh Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.10 gsharp/sdl.lisp:1.11 --- gsharp/sdl.lisp:1.10 Mon Nov 14 22:51:26 2005 +++ gsharp/sdl.lisp Mon Nov 14 23:52:13 2005 @@ -110,7 +110,7 @@ (declare (ignore initargs)) (with-slots (gf-char x-offset y-offset) glyph (setf x-offset (floor (gf-char-min-m gf-char) 4) - y-offset (- (ceiling (gf-char-max-n gf-char) 4))))) + y-offset (- (ceiling (1+ (gf-char-max-n gf-char)) 4))))) (defmethod glyph ((font font) glyph-no) (with-slots (gf-char pixmap) (aref (glyphs font) glyph-no)

1 0

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

14 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv23570 Modified Files: sdl.lisp Log Message: Fixed off-by-one-pixel but in pixmap drawing. Date: Mon Nov 14 22:51:26 2005 Author: rstrandh Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.9 gsharp/sdl.lisp:1.10 --- gsharp/sdl.lisp:1.9 Fri Nov 11 20:19:39 2005 +++ gsharp/sdl.lisp Mon Nov 14 22:51:26 2005 @@ -110,7 +110,7 @@ (declare (ignore initargs)) (with-slots (gf-char x-offset y-offset) glyph (setf x-offset (floor (gf-char-min-m gf-char) 4) - y-offset (- (floor (1+ (gf-char-max-n gf-char)) 4))))) + y-offset (- (ceiling (gf-char-max-n gf-char) 4))))) (defmethod glyph ((font font) glyph-no) (with-slots (gf-char pixmap) (aref (glyphs font) glyph-no)

1 0

[gsharp-cvs] CVS update: gsharp/esa.lisp
by crhodes＠common-lisp.net 14 Nov '05

14 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv19149 Modified Files: esa.lisp Log Message: Sync esa with climacs; M-x now works properly again. Date: Mon Nov 14 21:49:35 2005 Author: crhodes Index: gsharp/esa.lisp diff -u gsharp/esa.lisp:1.10 gsharp/esa.lisp:1.11 --- gsharp/esa.lisp:1.10 Mon Nov 14 15:27:32 2005 +++ gsharp/esa.lisp Mon Nov 14 21:49:34 2005 @@ -379,8 +379,7 @@ () (let ((item (handler-case (accept - `(command :command-table - ,(command-table (car (windows *application-frame*)))) + `(command :command-table ,(find-applicable-command-table *application-frame*)) :prompt "Extended Command") (error () (progn (beep) (display-message "No such command")

1 0

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

14 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv16937 Modified Files: gui.lisp Log Message: Fixed prompt bug in com-delete-staff-from-layer. (thanks to Robert J. Macomber) Date: Mon Nov 14 21:26:34 2005 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.42 gsharp/gui.lisp:1.43 --- gsharp/gui.lisp:1.42 Mon Nov 14 15:27:32 2005 +++ gsharp/gui.lisp Mon Nov 14 21:26:14 2005 @@ -1072,7 +1072,7 @@ ;;; FIXME restrict to staves that are actually in the layer. (define-gsharp-command (com-delete-staff-from-layer :name t) () - (let ((staff (accept 'score-pane:staff :prompt "Add staff to layer")) + (let ((staff (accept 'score-pane:staff :prompt "Delete staff from layer")) (layer (layer (cursor *application-frame*)))) (remove-staff-from-layer staff layer)))

1 0

[gsharp-cvs] CVS update: gsharp/Fonts/viewer.lisp
by rstrandh＠common-lisp.net 14 Nov '05

14 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Fonts In directory common-lisp.net:/tmp/cvs-serv14746 Modified Files: viewer.lisp Log Message: make the viewer slightly more CL-compliant Date: Mon Nov 14 20:59:46 2005 Author: rstrandh Index: gsharp/Fonts/viewer.lisp diff -u gsharp/Fonts/viewer.lisp:1.1 gsharp/Fonts/viewer.lisp:1.2 --- gsharp/Fonts/viewer.lisp:1.1 Thu Mar 25 07:50:26 2004 +++ gsharp/Fonts/viewer.lisp Mon Nov 14 20:59:46 2005 @@ -39,7 +39,7 @@ :initial-element 16 :element-type '(unsigned-byte 8)))) (unless (aref vector index) (loop for r from 0 below height - for y from (gf-char-max-n char) by -1 do + for y downfrom (gf-char-max-n char) by 1 do (loop for c from 0 below width for x from (gf-char-min-m char) do (decf (aref glyph

1 0

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

14 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv22545 Modified Files: esa.lisp gui.lisp packages.lisp Log Message: Sync esa with climacs. Implement FIND-APPLICABLE-COMMAND-TABLE. Date: Mon Nov 14 15:27:32 2005 Author: crhodes Index: gsharp/esa.lisp diff -u gsharp/esa.lisp:1.9 gsharp/esa.lisp:1.10 --- gsharp/esa.lisp:1.9 Thu Nov 3 15:59:23 2005 +++ gsharp/esa.lisp Mon Nov 14 15:27:32 2005 @@ -215,7 +215,7 @@ ('menu-item) (object) (with-input-context - (`(command :command-table ,(command-table (car (windows frame))))) + (`(command :command-table ,command-table)) (object) (let ((gestures '())) (multiple-value-bind (numarg numargp) @@ -263,6 +263,11 @@ (car command) command))) +(defgeneric find-applicable-command-table (frame)) + +(defmethod find-applicable-command-table ((frame esa-frame-mixin)) + (command-table (car (windows frame)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Top level @@ -281,12 +286,12 @@ do (restart-case (progn (handler-case - (progn + (let ((command-table (find-applicable-command-table frame))) ;; for presentation-to-command-translators, ;; which are searched for in ;; (frame-command-table *application-frame*) - (setf (frame-command-table frame) (command-table (car (windows frame)))) - (process-gestures-or-command frame (command-table (car (windows frame))))) + (setf (frame-command-table frame) command-table) + (process-gestures-or-command frame command-table)) (abort-gesture () (display-message "Quit"))) (redisplay-frame-panes frame)) (return-to-esa () nil)))))) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.41 gsharp/gui.lisp:1.42 --- gsharp/gui.lisp:1.41 Thu Nov 10 18:37:16 2005 +++ gsharp/gui.lisp Mon Nov 14 15:27:32 2005 @@ -423,12 +423,12 @@ (declare (ignore string)) (if success layer (error 'no-such-layer)))) -(defmethod select-layer :after (cursor (layer layer)) - (typecase layer - (lyrics-layer (setf (command-table (first (windows *application-frame*))) - (find-command-table 'total-lyrics-table))) - (melody-layer (setf (command-table (first (windows *application-frame*))) - (find-command-table 'total-melody-table))))) +(defmethod find-applicable-command-table ((frame gsharp)) + (let* ((layer (layer (cursor *application-frame*)))) + ;; F-A-C-T-WITH-LAYER? + (typecase layer + (lyrics-layer (find-command-table 'total-lyrics-table)) + (melody-layer (find-command-table 'total-melody-table))))) (define-gsharp-command (com-select-layer :name t) () (let ((selected-layer (accept 'layer :prompt "Select layer"))) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.26 gsharp/packages.lisp:1.27 --- gsharp/packages.lisp:1.26 Mon Nov 7 21:00:52 2005 +++ gsharp/packages.lisp Mon Nov 14 15:27:32 2005 @@ -138,7 +138,8 @@ #:esa-top-level #:simple-command-loop #:global-esa-table #:keyboard-macro-table #:help-table - #:set-key)) + #:set-key + #:find-applicable-command-table)) (defpackage :score-pane (:use :clim :clim-extensions :clim-lisp :sdl :esa)

1 0

[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