From rstrandh at common-lisp.net Tue Nov 1 00:23:29 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 1 Nov 2005 01:23:29 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp gsharp/packages.lisp Message-ID: <20051101002329.EB93188545@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv29573 Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Removed the function MAKE-INITIALIZED-SEGMENT Date: Tue Nov 1 01:23:27 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.18 gsharp/buffer.lisp:1.19 --- gsharp/buffer.lisp:1.18 Mon Oct 31 22:16:03 2005 +++ gsharp/buffer.lisp Tue Nov 1 01:23:26 2005 @@ -745,19 +745,18 @@ (buffer :initform nil :initarg :buffer :accessor buffer) (layers :initform '() :initarg :layers :accessor layers))) -(defmethod initialize-instance :after ((s segment) &rest args) +(defmethod initialize-instance :after ((s segment) &rest args &key staff) (declare (ignore args)) - (loop for layer in (layers s) - do (setf (segment layer) s))) + (with-slots (layers) s + (when (null layers) + (assert (not (null staff))) + (push (make-layer "Default layer" staff) layers)) + (loop for layer in layers + do (setf (segment layer) s)))) (defmethod print-object :after ((s segment) stream) (format stream ":layers ~W " (layers s))) -(defun make-initialized-segment (staff) - (let ((segment (make-instance 'segment))) - (add-layer (make-layer "Default layer" staff) segment) - segment)) - (defun read-segment-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'segment (read-delimited-list #\] stream t))) @@ -861,12 +860,9 @@ (format stream ":staves ~W :segments ~W :min-width ~W :spacing-style ~W :right-edge ~W :left-offset ~W :left-margin ~W " staves segments min-width spacing-style right-edge left-offset left-margin))) -(defun make-empty-buffer () - (make-instance 'buffer)) - (defun make-initialized-buffer () - (let ((buffer (make-empty-buffer))) - (add-segment (make-initialized-segment (car (staves buffer))) buffer 0) + (let ((buffer (make-instance 'buffer))) + (add-segment (make-instance 'segment :staff (car (staves buffer))) buffer 0) buffer)) (defun read-buffer-v3 (stream char n) @@ -911,7 +907,7 @@ (setf segments (delete segment segments :test #'eq)) ;; make sure there is one segment left (unless segments - (add-segment (make-initialized-segment (car (staves buffer))) buffer 0))) + (add-segment (make-instance 'segment :staff (car (staves buffer))) buffer 0))) (setf buffer nil))) (define-condition staff-already-in-buffer (gsharp-condition) () Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.34 gsharp/gui.lisp:1.35 --- gsharp/gui.lisp:1.34 Mon Oct 31 22:16:04 2005 +++ gsharp/gui.lisp Tue Nov 1 01:23:26 2005 @@ -367,13 +367,13 @@ (define-gsharp-command (com-insert-segment-before :name t) () (let ((cursor (cursor *application-frame*))) - (insert-segment-before (make-initialized-segment (car (staves (buffer *application-frame*)))) + (insert-segment-before (make-instance 'segment :staff (car (staves (buffer *application-frame*)))) cursor) (backward-segment cursor))) (define-gsharp-command (com-insert-segment-after :name t) () (let ((cursor (cursor *application-frame*))) - (insert-segment-after (make-initialized-segment (car (staves (buffer *application-frame*)))) + (insert-segment-after (make-instance 'segment :staff (car (staves (buffer *application-frame*)))) cursor) (forward-segment cursor))) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.20 gsharp/packages.lisp:1.21 --- gsharp/packages.lisp:1.20 Mon Oct 31 22:16:04 2005 +++ gsharp/packages.lisp Tue Nov 1 01:23:26 2005 @@ -55,10 +55,9 @@ #:slice #:segment #:slices #:sliceno #:head #:body #:tail #:make-layer #:buffer - #:make-empty-buffer #:make-initialized-buffer + #:make-initialized-buffer #:layers #:nb-layers #:layerno #:add-layer #:remove-layer #:segment - #:make-initialized-segment #:segments #:nb-segments #:segmentno #:staves #:find-staff #:add-segment #:remove-segment #:add-staff-before-staff #:add-staff-after-staff From crhodes at common-lisp.net Tue Nov 1 09:50:17 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Tue, 1 Nov 2005 10:50:17 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/esa.lisp Message-ID: <20051101095017.C76F68815C@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv5196 Modified Files: esa.lisp Log Message: Make menus work. Basically copy the body of McCLIM's READ-FRAME-COMMAND :AROUND method into the ESA toplevel Date: Tue Nov 1 10:50:16 2005 Author: crhodes Index: gsharp/esa.lisp diff -u gsharp/esa.lisp:1.7 gsharp/esa.lisp:1.8 --- gsharp/esa.lisp:1.7 Sat Oct 29 00:16:37 2005 +++ gsharp/esa.lisp Tue Nov 1 10:50:16 2005 @@ -212,7 +212,7 @@ (defun process-gestures-or-command (frame command-table) (with-input-context - (`(command :command-table ,(command-table (car (windows frame))))) + (`(or menu-item (command :command-table ,(command-table (car (windows frame)))))) (object) (let ((gestures '())) (multiple-value-bind (numarg numargp) @@ -234,7 +234,18 @@ (execute-frame-command frame command) (return))) (t nil)))))) - (t + (menu-item + (let ((command (command-menu-item-value object))) + (unless (listp command) + (setq command (list command))) + (when (and (typep (frame-standard-input frame) 'interactor-pane) + (member *unsupplied-argument-marker* command :test #'eq)) + (setq command + (command-line-read-remaining-arguments-for-partial-command + (frame-command-table frame) (frame-standard-input frame) + command 0))) + (execute-frame-command frame command))) + (command (execute-frame-command frame object)))) (defmethod redisplay-frame-panes :around ((frame esa-frame-mixin) &key force-p) From rstrandh at common-lisp.net Tue Nov 1 17:19:53 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 1 Nov 2005 18:19:53 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/gsharp.asd gsharp/system.lisp Message-ID: <20051101171953.CEF478857A@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv5400 Added Files: gsharp.asd Removed Files: system.lisp Log Message: Replacing system.lisp with gsharp.asd Date: Tue Nov 1 18:19:52 2005 Author: rstrandh From rstrandh at common-lisp.net Tue Nov 1 17:37:01 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 1 Nov 2005 18:37:01 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/INSTALL Message-ID: <20051101173701.B0B1C8857A@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv6921 Modified Files: INSTALL Log Message: Updated INSTALL instructions Date: Tue Nov 1 18:37:01 2005 Author: rstrandh Index: gsharp/INSTALL diff -u gsharp/INSTALL:1.1.1.1 gsharp/INSTALL:1.2 --- gsharp/INSTALL:1.1.1.1 Mon Feb 16 16:46:05 2004 +++ gsharp/INSTALL Tue Nov 1 18:37:01 2005 @@ -1,12 +1,13 @@ -;;; Load the system definition file +;;; Load the gsharp.asd file or make sure the directory in which it +;;; lives is in the asdf:*central-registry* list of directories -(load "system.lisp") +(load "gsharp.asd") ;;; Compile and load the system -(operate-on-system :gsharp :compile) -(operate-on-system :gsharp :load) +(asdf:operate 'asdf:load-op :gsharp) ;;; Run Gsharp -(gsharp::run-gsharp) +(gsharp::gsharp) + From rstrandh at common-lisp.net Tue Nov 1 17:56:52 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 1 Nov 2005 18:56:52 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Doc/gsharp.tex Message-ID: <20051101175652.A2875880D6@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv7647 Modified Files: gsharp.tex Log Message: Updated install instructions to conform to reality. Date: Tue Nov 1 18:56:52 2005 Author: rstrandh Index: gsharp/Doc/gsharp.tex diff -u gsharp/Doc/gsharp.tex:1.4 gsharp/Doc/gsharp.tex:1.5 --- gsharp/Doc/gsharp.tex:1.4 Sat Jul 24 08:41:54 2004 +++ gsharp/Doc/gsharp.tex Tue Nov 1 18:56:51 2005 @@ -105,16 +105,22 @@ we have not decided exactly in what form the releases will be made available to the public. -For now, you have to use CMUCL (perhaps SBCL will work as well, but it -has not been tested) with a core image that contains {\clim} and -MK:DEFSYSTEM. Start {\lisp}, load the file \texttt{system.lisp} into -the running {\lisp} image and then type: +First make the fonts. In the \texttt{Fonts} subdirectory, type +\texttt{make}. -\texttt{(operate-on-system :gsharp :compile)} +For now, you have to use a Lisp system that runs McCLIM comfortably +(SBCL, CMUCL, OpenMCL) with a core image that contains {\clim} and +ASDF. Start {\lisp}, load the file \texttt{gsharp.asd} into +the running {\lisp} image and then type: + +\texttt{(asdf:operate 'asdf:load-op :gsharp)} which will compile and load all the files. To start {\gs} type -\texttt{(gsharp::run-gsharp)} +\texttt{(gsharp::gsharp)} + +Instead of loading the ASDF file manually, you could put it in a +directory that is in the list \texttt{asdf:*central-registry*}. \section{The different editing panes} From rstrandh at common-lisp.net Tue Nov 1 17:58:27 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 1 Nov 2005 18:58:27 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/INSTALL Message-ID: <20051101175827.42C6B880D6@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv7682 Modified Files: INSTALL Log Message: Added font compilation to INSTALL instructions Date: Tue Nov 1 18:58:26 2005 Author: rstrandh Index: gsharp/INSTALL diff -u gsharp/INSTALL:1.2 gsharp/INSTALL:1.3 --- gsharp/INSTALL:1.2 Tue Nov 1 18:37:01 2005 +++ gsharp/INSTALL Tue Nov 1 18:58:26 2005 @@ -1,3 +1,9 @@ +;;; Compile the fonts + +$ (cd Fonts; make) + +;;; Start the lisp system + ;;; Load the gsharp.asd file or make sure the directory in which it ;;; lives is in the asdf:*central-registry* list of directories From rstrandh at common-lisp.net Tue Nov 1 18:08:03 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 1 Nov 2005 19:08:03 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp gsharp/packages.lisp Message-ID: <20051101180803.388FB880D6@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv8373 Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Removed MAKE-INITIALIZED-BUFFER Date: Tue Nov 1 19:08:02 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.19 gsharp/buffer.lisp:1.20 --- gsharp/buffer.lisp:1.19 Tue Nov 1 01:23:26 2005 +++ gsharp/buffer.lisp Tue Nov 1 19:08:02 2005 @@ -852,18 +852,16 @@ (defmethod initialize-instance :after ((b buffer) &rest args) (declare (ignore args)) - (loop for segment in (segments b) - do (setf (buffer segment) b))) + (with-slots (segments) b + (when (null segments) + (add-segment (make-instance 'segment :staff (car (staves b))) b 0)) + (loop for segment in segments + do (setf (buffer segment) b)))) (defmethod print-object :after ((b buffer) stream) (with-slots (staves segments min-width spacing-style right-edge left-offset left-margin) b (format stream ":staves ~W :segments ~W :min-width ~W :spacing-style ~W :right-edge ~W :left-offset ~W :left-margin ~W " staves segments min-width spacing-style right-edge left-offset left-margin))) - -(defun make-initialized-buffer () - (let ((buffer (make-instance 'buffer))) - (add-segment (make-instance 'segment :staff (car (staves buffer))) buffer 0) - buffer)) (defun read-buffer-v3 (stream char n) (declare (ignore char n)) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.35 gsharp/gui.lisp:1.36 --- gsharp/gui.lisp:1.35 Tue Nov 1 01:23:26 2005 +++ gsharp/gui.lisp Tue Nov 1 19:08:02 2005 @@ -218,7 +218,7 @@ ("Quit" :command com-quit))) (define-gsharp-command (com-new-buffer :name t) () - (let* ((buffer (make-initialized-buffer)) + (let* ((buffer (make-instance 'buffer)) (cursor (make-initial-cursor buffer)) (staff (car (staves buffer))) (input-state (make-input-state))) @@ -541,7 +541,7 @@ (defun gsharp (&key new-process (process-name "Gsharp") (width 900) (height 600)) "Start a Gsharp session" - (let* ((buffer (make-initialized-buffer)) + (let* ((buffer (make-instance 'buffer)) (staff (car (staves buffer))) (input-state (make-input-state)) (cursor (make-initial-cursor buffer))) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.21 gsharp/packages.lisp:1.22 --- gsharp/packages.lisp:1.21 Tue Nov 1 01:23:26 2005 +++ gsharp/packages.lisp Tue Nov 1 19:08:02 2005 @@ -55,7 +55,6 @@ #:slice #:segment #:slices #:sliceno #:head #:body #:tail #:make-layer #:buffer - #:make-initialized-buffer #:layers #:nb-layers #:layerno #:add-layer #:remove-layer #:segment #:segments #:nb-segments #:segmentno #:staves From rstrandh at common-lisp.net Wed Nov 2 05:01:18 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 2 Nov 2005 06:01:18 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp gsharp/packages.lisp Message-ID: <20051102050118.DCCCE885A6@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv22023 Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Put back some of the constructor functions. Added more documentation about buffer protocols. Date: Wed Nov 2 06:01:11 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.20 gsharp/buffer.lisp:1.21 --- gsharp/buffer.lisp:1.20 Tue Nov 1 19:08:02 2005 +++ gsharp/buffer.lisp Wed Nov 2 06:01:10 2005 @@ -38,18 +38,18 @@ (lineno :reader lineno :initarg :lineno :type (or (integer 2 6) null)))) -(defmethod initialize-instance :after ((c clef) &rest args) - (declare (ignore args)) - (with-slots (lineno name) c - (check-type name (member :treble :bass :c :percussion)) - (unless (slot-boundp c 'lineno) - (setf lineno - (ecase name +(defun make-clef (name &key lineno) + (declare (type (member :treble :bass :c :percussion) name) + (type (or (integer 2 6) null) lineno)) + (when (null lineno) + (setf lineno + (ecase name (:treble 2) (:bass 6) (:c 4) - (:percussion 3)))))) - + (:percussion 3)))) + (make-instance 'clef :name name :lineno lineno)) + (defmethod print-object :after ((c clef) stream) (format stream ":lineno ~W " (lineno c))) @@ -75,12 +75,14 @@ (defclass fiveline-staff (staff) ((print-character :allocation :class :initform #\=) - (clef :accessor clef :initarg :clef :initform (make-instance 'clef :name :treble)) + (clef :accessor clef :initarg :clef :initform (make-clef :treble)) (keysig :accessor keysig :initarg :keysig - :initform (make-array 7 :initial-element :natural))) - (:default-initargs - :name "default staff")) + :initform (make-array 7 :initial-element :natural)))) +(defun make-fiveline-staff (&rest args &key name clef keysig) + (declare (ignore name clef keysig)) + (apply #'make-instance 'fiveline-staff args)) + (defmethod print-object :after ((s fiveline-staff) stream) (format stream ":clef ~W :keysig ~W " (clef s) (keysig s))) @@ -97,6 +99,10 @@ (defclass lyrics-staff (staff) ((print-character :allocation :class :initform #\L))) +(defun make-lyrics-staff (&rest args &key name) + (declare (ignore name)) + (apply #'make-instance 'lyrics-staff args)) + (defun read-lyrics-staff-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'lyrics-staff (read-delimited-list #\] stream t))) @@ -152,15 +158,26 @@ (defclass note (gsharp-object) ((print-character :allocation :class :initform #\N) (cluster :initform nil :initarg :cluster :accessor cluster) - (pitch :initarg :pitch :reader pitch :type (integer 0 128)) - (staff :initarg :staff :reader staff :type (or staff null)) + (pitch :initarg :pitch :reader pitch :type (integer 0 127)) + (staff :initarg :staff :reader staff :type staff) (head :initform nil :initarg :head :reader head :type (or (member :whole :half :filled) null)) (accidentals :initform :natural :initarg :accidentals :reader accidentals :type (member :natural :flat :double-flat :sharp :double-sharp)) (dots :initform nil :initarg :dots :reader dots - :type (or integer null)))) + :type (or (integer 0 3) null)))) + +(defun make-note (pitch staff &rest args &key head (accidentals :natural) dots) + (declare (type (integer 0 127) pitch) + (type staff staff) + (type (or (member :whole :half :filled) null) head) + (type (member :natural :flat :double-flat + :sharp :double-sharp) + accidentals) + (type (or (integer 0 3) null) dots) + (ignore head accidentals dots)) + (apply #'make-instance 'note :pitch pitch :staff staff args)) (defmethod print-object :after ((n note) stream) (with-slots (pitch staff head accidentals dots) n @@ -214,10 +231,10 @@ (defclass element (gsharp-object) ((bar :initform nil :initarg :bar :accessor bar) - (notehead :initarg :notehead :accessor notehead) - (rbeams :initarg :rbeams :accessor rbeams) - (lbeams :initarg :lbeams :accessor lbeams) - (dots :initarg :dots :accessor dots) + (notehead :initform :whole :initarg :notehead :accessor notehead) + (rbeams :initform 0 :initarg :rbeams :accessor rbeams) + (lbeams :initform 0 :initarg :lbeams :accessor lbeams) + (dots :initform 0 :initarg :dots :accessor dots) (xoffset :initform 0 :initarg :xoffset :accessor xoffset))) (defmethod print-object :after ((e element) stream) @@ -270,14 +287,26 @@ (defclass cluster (melody-element) ((print-character :allocation :class :initform #\%) (notes :initform '() :initarg :notes :accessor notes) - (stem-direction :initarg :stem-direction :accessor stem-direction) - (stem-length :initform nil :initarg :stem-length :accessor stem-length))) + (stem-direction :initform :auto :initarg :stem-direction :accessor stem-direction))) (defmethod initialize-instance :after ((c cluster) &rest args) (declare (ignore args)) (loop for note in (notes c) do (setf (cluster note) c))) +(defun make-cluster (&rest args + &key (notehead :filled) (lbeams 0) (rbeams 0) (dots 0) + (xoffset 0) notes (stem-direction :auto)) + (declare (type (member :whole :half :filled) notehead) + (type (integer 0 5) lbeams) + (type (integer 0 5) rbeams) + (type (integer 0 3) dots) + (type number xoffset) + (type list notes) + (type (member :up :down :auto) stem-direction) + (ignore notehead lbeams rbeams dots xoffset notes stem-direction)) + (apply #'make-instance 'cluster args)) + (defmethod print-object :after ((c cluster) stream) (with-slots (stem-direction notes) c (format stream ":stem-direction ~W :notes ~W " stem-direction notes))) @@ -332,6 +361,20 @@ (staff :initarg :staff :reader staff) (staff-pos :initarg :staff-pos :initform 4 :reader staff-pos))) +(defun make-rest (staff &rest args + &key (staff-pos 4) (notehead :filled) (lbeams 0) (rbeams 0) + (dots 0) (xoffset 0)) + (declare (type staff staff) + (type integer staff-pos) + (type (member :whole :half :filled) notehead) + (type (integer 0 5) lbeams) + (type (integer 0 5) rbeams) + (type (integer 0 3) dots) + (type number xoffset) + (ignore staff-pos notehead lbeams rbeams dots xoffset)) + (apply #'make-instance 'rest + :staff staff args)) + (defmethod print-object :after ((s rest) stream) (with-slots (staff staff-pos) s (format stream ":staff ~W :staff-pos ~W " staff staff-pos))) @@ -842,7 +885,7 @@ (defclass buffer (gsharp-object) ((print-character :allocation :class :initform #\B) (segments :initform '() :initarg :segments :accessor segments) - (staves :initform (list (make-instance 'fiveline-staff)) + (staves :initform (list (make-fiveline-staff)) :initarg :staves :accessor staves) (min-width :initform *default-min-width* :initarg :min-width :accessor min-width) (spacing-style :initform *default-spacing-style* :initarg :spacing-style :accessor spacing-style) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.36 gsharp/gui.lisp:1.37 --- gsharp/gui.lisp:1.36 Tue Nov 1 19:08:02 2005 +++ gsharp/gui.lisp Wed Nov 2 06:01:10 2005 @@ -165,9 +165,8 @@ (lbeams (lbeams cluster)) (dots (dots cluster)) (notes (notes cluster)) - (stem-direction (stem-direction cluster)) - (stem-length (stem-length cluster))) - (declare (ignore stem-direction stem-length notehead lbeams rbeams dots)) + (stem-direction (stem-direction cluster))) + (declare (ignore stem-direction notehead lbeams rbeams dots)) (loop for note in notes do (draw-ellipse* pane xpos (* 15 (note-position note)) 7 0 0 7) (score-pane:draw-accidental pane (accidentals note) @@ -564,12 +563,12 @@ (defun insert-cluster () (let* ((state (input-state *application-frame*)) (cursor (cursor *application-frame*)) - (cluster (make-instance 'cluster - :rbeams (if (eq (notehead state) :filled) (rbeams state) 0) - :lbeams (if (eq (notehead state) :filled) (lbeams state) 0) - :dots (dots state) - :notehead (notehead state) - :stem-direction (stem-direction state)))) + (cluster (make-cluster + :notehead (notehead state) + :lbeams (if (eq (notehead state) :filled) (lbeams state) 0) + :rbeams (if (eq (notehead state) :filled) (rbeams state) 0) + :dots (dots state) + :stem-direction (stem-direction state)))) (insert-element cluster cursor) (forward-element cursor) cluster)) @@ -580,9 +579,7 @@ (defun insert-note (pitch cluster) (let* ((state (input-state *application-frame*)) (staff (car (staves (layer (slice (bar cluster)))))) - (note (make-instance 'note - :pitch pitch - :staff staff + (note (make-note pitch staff :head (notehead state) :accidentals (aref (keysig staff) (mod pitch 7)) :dots (dots state)))) @@ -627,12 +624,11 @@ (define-gsharp-command com-insert-rest () (let* ((state (input-state *application-frame*)) (cursor (cursor *application-frame*)) - (rest (make-instance 'rest + (rest (make-rest (car (staves (layer (cursor *application-frame*)))) :rbeams (if (eq (notehead state) :filled) (rbeams state) 0) :lbeams (if (eq (notehead state) :filled) (lbeams state) 0) :dots (dots state) - :notehead (notehead state) - :staff (car (staves (layer (cursor *application-frame*))))))) + :notehead (notehead state)))) (insert-element rest cursor) (forward-element cursor) rest)) @@ -735,9 +731,7 @@ (let ((element (cur-element))) (if (typep element 'cluster) (let* ((note (cur-note)) - (new-note (make-instance 'note - :pitch (1- (pitch note)) - :staff (staff note) + (new-note (make-note (1- (pitch note)) (staff note) :head (head note) :accidentals (accidentals note) :dots (dots note)))) @@ -753,10 +747,10 @@ (cursor (cursor *application-frame*))) (backward-element cursor) (delete-element cursor) - (insert-element (make-instance 'rest + (insert-element (make-rest staff + :staff-pos (- staff-pos 2) :notehead notehead :dots dots - :rbeams rbeams :lbeams lbeams - :staff staff :staff-pos (- staff-pos 2)) + :rbeams rbeams :lbeams lbeams) cursor) (forward-element cursor))))) @@ -764,9 +758,7 @@ (let ((element (cur-element))) (if (typep element 'cluster) (let* ((note (cur-note)) - (new-note (make-instance 'note - :pitch (1+ (pitch note)) - :staff (staff note) + (new-note (make-note (1+ (pitch note)) (staff note) :head (head note) :accidentals (accidentals note) :dots (dots note)))) @@ -782,19 +774,17 @@ (cursor (cursor *application-frame*))) (backward-element cursor) (delete-element cursor) - (insert-element (make-instance 'rest + (insert-element (make-rest staff + :staff-pos (+ staff-pos 2) :notehead notehead :dots dots - :rbeams rbeams :lbeams lbeams - :staff staff :staff-pos (+ staff-pos 2)) + :rbeams rbeams :lbeams lbeams) cursor) (forward-element cursor))))) (define-gsharp-command com-sharper () (let* ((cluster (cur-cluster)) (note (cur-note)) - (new-note (make-instance 'note - :pitch (pitch note) - :staff (staff note) + (new-note (make-note (pitch note) (staff note) :head (head note) :accidentals (ecase (accidentals note) (:double-sharp :double-sharp) @@ -810,9 +800,7 @@ (define-gsharp-command com-flatter () (let* ((cluster (cur-cluster)) (note (cur-note)) - (new-note (make-instance 'note - :pitch (pitch note) - :staff (staff note) + (new-note (make-note (pitch note) (staff note) :head (head note) :accidentals (ecase (accidentals note) (:double-sharp :sharp) @@ -925,7 +913,7 @@ (let ((staff (accept 'score-pane:fiveline-staff :prompt "Set clef of staff")) (type (accept 'clef-type :prompt "Type of clef")) (line (accept 'integer :prompt "Line of clef"))) - (setf (clef staff) (make-instance 'clef :name type :lineno line)))) + (setf (clef staff) (make-clef type :lineno line)))) (define-gsharp-command com-higher () (incf (last-note (input-state *application-frame*)) 7)) @@ -1054,9 +1042,9 @@ (ecase (accept 'staff-type :prompt "Type") (:fiveline (let* ((clef-name (accept 'clef-type :prompt "Clef type of new staff")) (line (accept 'integer :prompt "Line of clef")) - (clef (make-instance 'clef :name clef-name :lineno line))) - (make-instance 'fiveline-staff :name name :clef clef))) - (:lyrics (make-instance 'lyrics-staff :name name))))) + (clef (make-clef clef-name :lineno line))) + (make-fiveline-staff :name name :clef clef))) + (:lyrics (make-lyrics-staff :name name))))) (define-gsharp-command (com-insert-staff-before :name t) () (add-staff-before-staff (accept 'score-pane:staff :prompt "Insert staff before staff") Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.22 gsharp/packages.lisp:1.23 --- gsharp/packages.lisp:1.22 Tue Nov 1 19:08:02 2005 +++ gsharp/packages.lisp Wed Nov 2 06:01:10 2005 @@ -36,16 +36,18 @@ (defpackage :gsharp-buffer (:use :common-lisp :gsharp-utilities) (:shadow #:rest) - (:export #:clef #:name #:lineno - #:staff #:fiveline-staff - #:lyrics-staff + (:export #:clef #:name #:lineno #:make-clef + #:staff #:fiveline-staff #:make-fiveline-staff + #:lyrics-staff #:make-lyrics-staff #:gsharp-condition - #:pitch #:accidentals #:dots #:note + #:pitch #:accidentals #:dots #:note #:make-note #:note-less #:note-equal #:bar #:notehead #:rbeams #:lbeams #:dots #:element #:melody-element #:notes - #:add-note #:find-note #:remove-note #:cluster - #:rest #:lyrics-element + #:add-note #:find-note #:remove-note + #:cluster #:make-cluster + #:rest #:make-rest + #:lyrics-element #:make-lyrics-element #:slice #:elements #:nb-elements #:elementno #:add-element #:remove-element #:bar #:make-bar @@ -64,7 +66,7 @@ #:rename-staff #:add-staff-to-layer #:remove-staff-from-layer - #:stem-direction #:stem-length #:undotted-duration #:duration + #:stem-direction #:undotted-duration #:duration #:clef #:keysig #:staff-pos #:xoffset #:read-everything #:save-buffer-to-stream #:line-width #:min-width #:spacing-style #:right-edge #:left-offset #:left-margin #:text #:append-char #:erase-char From rstrandh at common-lisp.net Wed Nov 2 05:01:21 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 2 Nov 2005 06:01:21 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Doc/buffer.tex Message-ID: <20051102050121.00006885A6@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv22023/Doc Modified Files: buffer.tex Log Message: Put back some of the constructor functions. Added more documentation about buffer protocols. Date: Wed Nov 2 06:01:18 2005 Author: rstrandh Index: gsharp/Doc/buffer.tex diff -u gsharp/Doc/buffer.tex:1.5 gsharp/Doc/buffer.tex:1.6 --- gsharp/Doc/buffer.tex:1.5 Mon Oct 31 19:23:47 2005 +++ gsharp/Doc/buffer.tex Wed Nov 2 06:01:18 2005 @@ -39,10 +39,6 @@ \Defclass {clef} -\Definitarg {:name} - -\Definitarg {:lineno} - \Defun {make-clef} {name \optional (lineno \cl{nil})} Create a clef with the name and line numbers given. Line numbers @@ -80,41 +76,24 @@ The protocol class for all staves. -\Definitarg {:name} +\Defclass {fiveline-staff} -This initarg indicates the name of the staff to be used. The name of -a staff must be unique and usually has some relationship to the -instruments(s) displayed on it. Examples of staff names would be -``1st violin'', ``soprano \& alto'', etc. The default value for this -initarg is \lispobj{"default staff"}. +This class is a subclass of \lispobj{staff}, and is used to represent an +ordinary five-line staff for displaying notes. \Defgeneric {name} {staff} Return the name of the staff. With \lispobj{setf}, change the name of the staff. -\Defclass {fiveline-staff} - -This class is a subclass of \lispobj{staff}, and is used to represent an -ordinary five-line staff for displaying notes. - -\Definitarg {:clef} - -This value must always be supplied, and must be an instance of the -class \lispobj{clef}. The clef of a five-line staff indicates where -on the staff notes are to be displayed. - -\Definitarg {:keysig} - -This initarg is used to represent the key signature of the staff. The -value is a vector with seven elements, where each element corresponds -to a note of the scale (C, D, E, F, G, A, B), and is a keyword -(\lispobj{:natural}, \lispobj{:sharp}, or \lispobj{:flat}) indicating -whether staff positions corresponding to that note of the scale should -be altered. The default value for this initarg is a vector with seven -elements, each begin the object \lispobj{:natural}. +\Defun {make-fiveline-staff} {\key name clef keysig} -\Defun {make-fiveline-staff} {name \optional (clef \lispobj(make-clef :treble))} +Make a five-line staff with the name, the clef, and the key signature +indicated. The default value of the \lispobj{name} argument is the +string \lispobj{"default staff"}. The default value for the +\lispobj{clef} argument is a newly created treble clef. The default +argument for the key signature is a key signature with no +alterations. \Defgeneric {clef} {fiveline-staff} @@ -131,6 +110,11 @@ This class is a subclass of \lispobj{staff}, and is used to represent a staff for displaying lyrics. +\Defun {make-lyrics-staff} (\key name) + +Make a lyrics staff with the name indicated. The default value of the +\lispobj{name} argument is the string \lispobj{"default staff"}. + %------------------------------------------------------------------- \subsection{External representation} @@ -171,22 +155,101 @@ The protocol class for notes. +\Defun {make-note} (pitch staff \rest args \key head accidentals dots) + +Create a note as indicated. The pitch represents the pitch of the +note without any accidentals, and is an integer between 0 and 127, +where 0 indicates a C in the lowest octave. The staff is an instance +of the class \lispobj{staff} and indicates what staff the note is to +be displayed on. + +The \lispobj{head} argument indicates what kind of note-head is wanted +in the form of one of the keywords \lispobj{:whole}, \lispobj{:half}, +and \lispobj{:filled}, or nil, where nil means that the note-head is +taken from the cluster to which the note belongs. + +The \lispobj{accidentals} argument indicates which, if any, +accidentals the note should have, and is one of the keywords +\lispobj{:natural}, \lispobj{:flat}, \lispobj{:double-flat}, +\lispobj{:sharp}, or \lispobj{:double-sharp}. The default value is +\lispobj{:natural} meaning that this note does not have any +accidentals. + +The \lispobj{dots} argument indicates how many dots follow this note. +It is an integer between 0 and 3 or nil, where nil means that the +number of dots is taken from the cluster to which the note belongs. %------------------------------------------------------------------- \subsection{External representation} A note is printed (by \lispobj{print-object} -\Definitarg{:cluster} +%=================================================================== +\section{The cluster protocol} + +%------------------------------------------------------------------- +\subsection{Description} -This initarg determines the cluster to which the note belongs. The -default value for this initarg is \lispobj{nil} indicating that the -note currently does not belong to any cluster. +A cluster is a roughly the same as a chord, in that it is a collection +of notes that share a stem (unless the note heads are whole note +heads, in which case there is no stem at all). + +%------------------------------------------------------------------- +\subsection{Protocol classes and functions} -\Definitarg{:pitch} +\Defclass{cluster} + +\Defun {make-cluster} {&key (notehead :filled) (lbeams 0) (rbeams 0) + (dots 0) (xoffset 0) notes (stem-direction :auto))} + +Create a cluster. + +The \lispobj{notehead} argument indicates the basic timing unit to be +used for this cluster and is one of the keywords \lispobj{:whole}, +\lispobj{:half}, and \lispobj{:filled}. A value of \lispobj{:whole} +gives a \emph{basic duration} of $1$, a value of \lispobj{:half} gives $1 +\over 2$ and \lispobj{:filled} gives $1 \over 4$. + +The \lispobj{lbeams} argument indicates by how many beams this cluster +ties to the cluster immediately to its left. It must be an integer +between $0$ and $5$ inclusive. + +The \lispobj{rbeams} argument indicates by how many beams this cluster +ties to the cluster immediately to its right. It must be an integer +between $0$ and $5$ inclusive. + +When the \lispobj{notehead} argument is \lispobj{:filled}, the +\emph{basic duration} ($1 \over 4$) is divided by $2^n$ where $n$ is the max +of the values of \lispobj{lbeams} and \lispobj{rbeams}, giving the +\emph{beamed duration} of the cluster. + +The \lispobj{dots} arguments indicates how many dots should follow +notes of this cluster by default. It must be an integer between $0$ +and $3$ inclusive. The number of dots determines how the \emph{final +duration} for the cluster is obtained from its \emph{beamed duration}. +When the value is $0$, the final duration is the same as the beamed +duration. When the value is $1$, the final duration is the beamed +duration multiplied by $3 \over 2$. When the value is $2$, the final +duration is the beamed duration multiplied by $7 \over 4$. When the +value is $3$, the final duration is the beamed duration multiplied by +$15 \over 8$. + +The \lispobj{xoffset} arguments indicates by how much to the right of +its nominal position this cluster should be displayed. The unit is in +\emph{staff-steps}. + +The \lispobj{notes} argument is a list of initial notes for this +cluster. + +The \lispobj{stem-direction} argument indicates the direction to be +used for the stem of this cluster. The value is one of the keywords +\lispobj{:up}, \lispobj{:down} and \lispobj{:auto}, where +\lispobj{:auto} means that the direction is determined by the layout +algorithm. The values \lispobj{:up} and \lispobj{:down} are typically +used when two voices share a staff, and one voice has all the stems up +and the other has all the stems down. + +%------------------------------------------------------------------- +\subsection{External representation} -This initarg is mandatory, and determines the pitch of the note. -A pitch is indicated as an integer between 0 and 127, where 0 means a -C in the lowest octave possible. -\Definitarg{:staff} \ No newline at end of file From rstrandh at common-lisp.net Wed Nov 2 05:52:30 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 2 Nov 2005 06:52:30 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Doc/buffer.tex Message-ID: <20051102055230.34CB5885A6@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv26451 Modified Files: buffer.tex Log Message: Fixed a minor problem preventing compilation Date: Wed Nov 2 06:52:29 2005 Author: rstrandh Index: gsharp/Doc/buffer.tex diff -u gsharp/Doc/buffer.tex:1.6 gsharp/Doc/buffer.tex:1.7 --- gsharp/Doc/buffer.tex:1.6 Wed Nov 2 06:01:18 2005 +++ gsharp/Doc/buffer.tex Wed Nov 2 06:52:29 2005 @@ -199,7 +199,7 @@ \Defclass{cluster} -\Defun {make-cluster} {&key (notehead :filled) (lbeams 0) (rbeams 0) +\Defun {make-cluster} {\key (notehead :filled) (lbeams 0) (rbeams 0) (dots 0) (xoffset 0) notes (stem-direction :auto))} Create a cluster. From rstrandh at common-lisp.net Wed Nov 2 19:28:10 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 2 Nov 2005 20:28:10 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp gsharp/packages.lisp Message-ID: <20051102192810.AE3CA8815C@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv19750 Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Put back some more constructors. Two things need to be fixed ultimately: * Clefs should not be named objects. Instead, the exact type should probably be identified by subclassing * There is not compelling reason for bars to be subclassed. The distinction between melody and lyrics (and percussion, ultimately) is enough to enforce at the level of the layer. Date: Wed Nov 2 20:28:09 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.21 gsharp/buffer.lisp:1.22 --- gsharp/buffer.lisp:1.21 Wed Nov 2 06:01:10 2005 +++ gsharp/buffer.lisp Wed Nov 2 20:28:08 2005 @@ -406,6 +406,19 @@ (setf text (make-array length :adjustable t :element-type 'fixnum :fill-pointer length :initial-contents text)))))) +(defun make-lyrics-element (staff &rest args + &key (notehead :filled) (lbeams 0) (rbeams 0) + (dots 0) (xoffset 0)) + (declare (type staff staff) + (type (member :whole :half :filled) notehead) + (type (integer 0 5) lbeams) + (type (integer 0 5) rbeams) + (type (integer 0 3) dots) + (type number xoffset) + (ignore notehead lbeams rbeams dots xoffset)) + (apply #'make-instance 'lyrics-element + :staff staff args)) + (defmethod print-object :after ((elem lyrics-element) stream) (with-slots (staff text) elem (format stream ":staff ~W :text ~W " staff text))) @@ -500,6 +513,9 @@ (defclass melody-bar (bar) ((print-character :allocation :class :initform #\|))) +(defun make-melody-bar () + (make-instance 'melody-bar)) + (defun read-melody-bar-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'melody-bar (read-delimited-list #\] stream t))) @@ -511,6 +527,9 @@ (defclass lyrics-bar (bar) ((print-character :allocation :class :initform #\C))) +(defun make-lyrics-bar () + (make-instance 'lyrics-bar)) + (defun read-lyrics-bar-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'lyrics-bar (read-delimited-list #\] stream t))) @@ -594,7 +613,7 @@ (setf bars (delete bar bars :test #'eq)) (unless bars ;; make sure there is one bar left - (add-bar (make-instance 'melody-bar) slice 0))) + (add-bar (make-melody-bar) slice 0))) (setf slice nil))) (defmethod remove-bar ((bar lyrics-bar)) @@ -604,7 +623,7 @@ (setf bars (delete bar bars :test #'eq)) (unless bars ;; make sure there is one bar left - (add-bar (make-instance 'lyrics-bar) slice 0))) + (add-bar (make-lyrics-bar) slice 0))) (setf slice nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -663,7 +682,7 @@ (defmethod make-layer (name (initial-staff fiveline-staff)) (flet ((make-initialized-slice () (let ((slice (make-instance 'slice))) - (add-bar (make-instance 'melody-bar) slice 0) + (add-bar (make-melody-bar) slice 0) slice))) (let* ((head (make-initialized-slice)) (body (make-initialized-slice)) @@ -692,7 +711,7 @@ (defmethod make-layer (name (initial-staff lyrics-staff)) (flet ((make-initialized-slice () (let ((slice (make-instance 'slice))) - (add-bar (make-instance 'lyrics-bar) slice 0) + (add-bar (make-lyrics-bar) slice 0) slice))) (let* ((head (make-initialized-slice)) (body (make-initialized-slice)) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.37 gsharp/gui.lisp:1.38 --- gsharp/gui.lisp:1.37 Wed Nov 2 06:01:10 2005 +++ gsharp/gui.lisp Wed Nov 2 20:28:09 2005 @@ -1118,12 +1118,11 @@ (defun insert-lyrics-element () (let* ((state (input-state *application-frame*)) (cursor (cursor *application-frame*)) - (element (make-instance 'lyrics-element + (element (make-lyrics-element (car (staves (layer (cursor *application-frame*)))) :rbeams (if (eq (notehead state) :filled) (rbeams state) 0) :lbeams (if (eq (notehead state) :filled) (lbeams state) 0) :dots (dots state) - :notehead (notehead state) - :staff (car (staves (layer (cursor *application-frame*))))))) + :notehead (notehead state)))) (insert-element element cursor) (forward-element cursor) element)) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.23 gsharp/packages.lisp:1.24 --- gsharp/packages.lisp:1.23 Wed Nov 2 06:01:10 2005 +++ gsharp/packages.lisp Wed Nov 2 20:28:09 2005 @@ -51,7 +51,8 @@ #:slice #:elements #:nb-elements #:elementno #:add-element #:remove-element #:bar #:make-bar - #:melody-bar #:lyrics-bar + #:melody-bar #:make-melody-bar + #:lyrics-bar #:make-lyrics-bar #:layer #:lyrics-layer #:melody-layer #:bars #:nb-bars #:barno #:add-bar #:remove-bar #:slice From rstrandh at common-lisp.net Thu Nov 3 03:40:15 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Thu, 3 Nov 2005 04:40:15 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/numbering.lisp Message-ID: <20051103034015.5ECD788574@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv24392 Modified Files: buffer.lisp numbering.lisp Log Message: More constructors added. Date: Thu Nov 3 04:40:14 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.22 gsharp/buffer.lisp:1.23 --- gsharp/buffer.lisp:1.22 Wed Nov 2 20:28:08 2005 +++ gsharp/buffer.lisp Thu Nov 3 04:40:13 2005 @@ -513,8 +513,10 @@ (defclass melody-bar (bar) ((print-character :allocation :class :initform #\|))) -(defun make-melody-bar () - (make-instance 'melody-bar)) +(defun make-melody-bar (&rest args &key elements) + (declare (type list elements) + (ignore elements)) + (apply #'make-instance 'melody-bar args)) (defun read-melody-bar-v3 (stream char n) (declare (ignore char n)) @@ -527,8 +529,10 @@ (defclass lyrics-bar (bar) ((print-character :allocation :class :initform #\C))) -(defun make-lyrics-bar () - (make-instance 'lyrics-bar)) +(defun make-lyrics-bar (&rest args &key elements) + (declare (type list elements) + (ignore elements)) + (apply #'make-instance 'lyrics-bar args)) (defun read-lyrics-bar-v3 (stream char n) (declare (ignore char n)) @@ -570,6 +574,11 @@ (loop for bar in (bars s) do (setf (slice bar) s))) +(defun make-slice (&rest args &key bars) + (declare (type list bars) + (ignore bars)) + (apply #'make-instance 'slice args)) + (defmethod print-object :after ((s slice) stream) (format stream ":bars ~W " (bars s))) @@ -681,9 +690,7 @@ (defmethod make-layer (name (initial-staff fiveline-staff)) (flet ((make-initialized-slice () - (let ((slice (make-instance 'slice))) - (add-bar (make-melody-bar) slice 0) - slice))) + (make-slice :bars (list (make-melody-bar))))) (let* ((head (make-initialized-slice)) (body (make-initialized-slice)) (tail (make-initialized-slice)) @@ -710,9 +717,7 @@ (defmethod make-layer (name (initial-staff lyrics-staff)) (flet ((make-initialized-slice () - (let ((slice (make-instance 'slice))) - (add-bar (make-lyrics-bar) slice 0) - slice))) + (make-slice :bars (list (make-lyrics-bar))))) (let* ((head (make-initialized-slice)) (body (make-initialized-slice)) (tail (make-initialized-slice)) Index: gsharp/numbering.lisp diff -u gsharp/numbering.lisp:1.4 gsharp/numbering.lisp:1.5 --- gsharp/numbering.lisp:1.4 Sun Aug 15 17:49:41 2004 +++ gsharp/numbering.lisp Thu Nov 3 04:40:13 2005 @@ -57,6 +57,10 @@ (number-elements (bars slice)) (mapc #'number-all (bars slice))) +(defmethod initialize-instance :after ((slice nslice) &rest args) + (declare (ignore args)) + (number-elements (bars slice))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Layer From rstrandh at common-lisp.net Thu Nov 3 03:40:16 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Thu, 3 Nov 2005 04:40:16 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Doc/buffer.tex Message-ID: <20051103034016.2B59788576@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv24392/Doc Modified Files: buffer.tex Log Message: More constructors added. Date: Thu Nov 3 04:40:15 2005 Author: rstrandh Index: gsharp/Doc/buffer.tex diff -u gsharp/Doc/buffer.tex:1.7 gsharp/Doc/buffer.tex:1.8 --- gsharp/Doc/buffer.tex:1.7 Wed Nov 2 06:52:29 2005 +++ gsharp/Doc/buffer.tex Thu Nov 3 04:40:15 2005 @@ -249,6 +249,54 @@ used when two voices share a staff, and one voice has all the stems up and the other has all the stems down. +\Defun {make-rest} {staff \key (staff-pos 4) (notehead :filled) (lbeams 0) (rbeams 0) + (dots 0) (xoffset 0)} + +\Defun {make-lyrics-element} {staff \key (notehead :filled) (lbeams 0) (rbeams 0) + (dots 0) (xoffset 0)} + +%------------------------------------------------------------------- +\subsection{External representation} + + +%=================================================================== +\section{The bar protocol} + +%------------------------------------------------------------------- +\subsection{Description} + + +%------------------------------------------------------------------- +\subsection{Protocol classes and functions} + +\Defclass{bar} + +\Defclass{melody-bar} + +\Defun {make-melody-bar} {\key elements} + +\Defclass{lyrics-bar} + +\Defun {make-lyrics-bar} {\key elements} + +%------------------------------------------------------------------- +\subsection{External representation} + + +%=================================================================== +\section{The slice protocol} + +%------------------------------------------------------------------- +\subsection{Description} + + +%------------------------------------------------------------------- +\subsection{Protocol classes and functions} + +\Defclass{slice} + +\Defun {make-slice} {\key bars} + %------------------------------------------------------------------- \subsection{External representation} From crhodes at common-lisp.net Thu Nov 3 14:59:24 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Thu, 3 Nov 2005 15:59:24 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/esa.lisp Message-ID: <20051103145924.587DA88588@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv8429 Modified Files: esa.lisp Log Message: Sync esa with climacs. Date: Thu Nov 3 15:59:23 2005 Author: crhodes Index: gsharp/esa.lisp diff -u gsharp/esa.lisp:1.8 gsharp/esa.lisp:1.9 --- gsharp/esa.lisp:1.8 Tue Nov 1 10:50:16 2005 +++ gsharp/esa.lisp Thu Nov 3 15:59:23 2005 @@ -212,8 +212,11 @@ (defun process-gestures-or-command (frame command-table) (with-input-context - (`(or menu-item (command :command-table ,(command-table (car (windows frame)))))) + ('menu-item) (object) + (with-input-context + (`(command :command-table ,(command-table (car (windows frame))))) + (object) (let ((gestures '())) (multiple-value-bind (numarg numargp) (read-numeric-argument :stream *standard-input*) @@ -234,19 +237,19 @@ (execute-frame-command frame command) (return))) (t nil)))))) - (menu-item - (let ((command (command-menu-item-value object))) - (unless (listp command) - (setq command (list command))) - (when (and (typep (frame-standard-input frame) 'interactor-pane) - (member *unsupplied-argument-marker* command :test #'eq)) - (setq command - (command-line-read-remaining-arguments-for-partial-command - (frame-command-table frame) (frame-standard-input frame) - command 0))) - (execute-frame-command frame command))) (command - (execute-frame-command frame object)))) + (execute-frame-command frame object))) + (menu-item + (let ((command (command-menu-item-value object))) + (unless (listp command) + (setq command (list command))) + (when (and (typep (frame-standard-input frame) 'interactor-pane) + (member *unsupplied-argument-marker* command :test #'eq)) + (setq command + (command-line-read-remaining-arguments-for-partial-command + (frame-command-table frame) (frame-standard-input frame) + command 0))) + (execute-frame-command frame command))))) (defmethod redisplay-frame-panes :around ((frame esa-frame-mixin) &key force-p) (declare (ignore force-p)) @@ -278,7 +281,12 @@ do (restart-case (progn (handler-case - (process-gestures-or-command frame (command-table (car (windows frame)))) + (progn + ;; 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))))) (abort-gesture () (display-message "Quit"))) (redisplay-frame-panes frame)) (return-to-esa () nil)))))) From rstrandh at common-lisp.net Mon Nov 7 05:24:00 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 7 Nov 2005 06:24:00 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp gsharp/numbering.lisp gsharp/packages.lisp Message-ID: <20051107052400.47A18880D6@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv25048 Modified Files: gui.lisp numbering.lisp packages.lisp Log Message: remove the numbering stuff in favor of just calling POSITION each time. We are likely going to change the representation of sequences from lists to something more elaborate anyway (where it matters), so the numbering will not be relevant in the future. Date: Mon Nov 7 06:23:58 2005 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.38 gsharp/gui.lisp:1.39 --- gsharp/gui.lisp:1.38 Wed Nov 2 20:28:09 2005 +++ gsharp/gui.lisp Mon Nov 7 06:23:57 2005 @@ -317,7 +317,6 @@ (setf (buffer *application-frame*) buffer (input-state *application-frame*) input-state (cursor *application-frame*) cursor) - (number-all (buffer *application-frame*)) (select-layer cursor (car (layers (segment (cursor *application-frame*))))))) (define-gsharp-command (com-save-buffer-as :name t) () Index: gsharp/numbering.lisp diff -u gsharp/numbering.lisp:1.5 gsharp/numbering.lisp:1.6 --- gsharp/numbering.lisp:1.5 Thu Nov 3 04:40:13 2005 +++ gsharp/numbering.lisp Mon Nov 7 06:23:57 2005 @@ -1,123 +1,20 @@ (in-package :gsharp-numbering) -(defmacro defnclass (name base slots) - `(progn - (define-added-mixin ,name ,() ,base - ((number :accessor number) - , at slots)))) +(defmethod number ((element element)) + (position element (elements (bar element)))) -(defun number-elements (list) - (loop for elem in list - and i from 0 - do (setf (number elem) i))) +(defmethod number ((bar bar)) + (position bar (bars (slice bar)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Element +(defmethod number ((slice slice)) + (let ((layer (layer slice))) + (cond ((eq slice (head layer)) 0) + ((eq slice (body layer)) 1) + ((eq slice (tail layer)) 2)))) -(defnclass nelement element - ()) +(defmethod number ((layer layer)) + (position layer (layers (segment layer)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Bar +(defmethod number ((segment segment)) + (position segment (segments (buffer segment)))) -(defnclass nbar bar - ()) - -(defmethod add-element :after ((element nelement) (bar bar) position) - (declare (ignore position)) - (number-elements (elements bar))) - -(defmethod remove-element :around ((element nelement)) - (let ((bar (bar element))) - (call-next-method) - (number-elements (elements bar)))) - -(defmethod number-all ((bar bar)) - (number-elements (elements bar))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Slice - -(defnclass nslice slice - ()) - -(defmethod add-bar :after ((bar nbar) (slice slice) position) - (declare (ignore position)) - (number-elements (bars slice))) - -(defmethod remove-bar :around ((bar nbar)) - (let ((slice (slice bar))) - (call-next-method) - (number-elements (bars slice)))) - -(defmethod number-all ((slice slice)) - (number-elements (bars slice)) - (mapc #'number-all (bars slice))) - -(defmethod initialize-instance :after ((slice nslice) &rest args) - (declare (ignore args)) - (number-elements (bars slice))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Layer - -(defnclass nlayer layer - ()) - -(defmethod initialize-instance :after ((layer nlayer) &rest args) - (declare (ignore args)) - (setf (number (head layer)) 0 - (number (body layer)) 1 - (number (tail layer)) 2)) - -(defmethod number-all ((layer layer)) - (number-all (head layer)) - (number-all (body layer)) - (number-all (tail layer))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Segment - -(defnclass nsegment segment - ()) - -(defmethod add-layer :after ((layer nlayer) (segment segment)) - (number-elements (layers segment))) - -(defmethod remove-layer :around ((layer nlayer)) - (let ((segment (segment layer))) - (call-next-method) - (number-elements (layers segment)))) - -(defmethod number-all ((segment segment)) - (number-elements (layers segment)) - (mapc #'number-all (layers segment))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Buffer - -(defnclass nbuffer buffer - ()) - -(defmethod initialize-instance :after ((buffer nbuffer) &rest args) - (declare (ignore args)) - (number-elements (segments buffer))) - -(defmethod add-segment :after ((segment nsegment) (buffer buffer) position) - (declare (ignore position)) - (number-elements (segments buffer))) - -(defmethod remove-segment :around ((segment nsegment)) - (let ((buffer (buffer segment))) - (call-next-method) - (number-elements (segments buffer)))) - -(defmethod number-all ((buffer buffer)) - (number-elements (segments buffer)) - (mapc #'number-all (segments buffer))) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.24 gsharp/packages.lisp:1.25 --- gsharp/packages.lisp:1.24 Wed Nov 2 20:28:09 2005 +++ gsharp/packages.lisp Mon Nov 7 06:23:57 2005 @@ -77,7 +77,7 @@ (:use :gsharp-utilities :gsharp-buffer :clim-lisp) (:shadowing-import-from :gsharp-buffer #:rest) (:shadow #:number) - (:export #:number #:number-all)) + (:export #:number)) (defpackage :obseq (:use :common-lisp) From rstrandh at common-lisp.net Mon Nov 7 18:51:41 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 7 Nov 2005 19:51:41 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/score-pane.lisp Message-ID: <20051107185141.0984588545@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv18103 Modified Files: score-pane.lisp Log Message: Added comments as I re-learn what various functions do and are supposed to do. Date: Mon Nov 7 19:51:41 2005 Author: rstrandh Index: gsharp/score-pane.lisp diff -u gsharp/score-pane.lisp:1.14 gsharp/score-pane.lisp:1.15 --- gsharp/score-pane.lisp:1.14 Fri Oct 28 19:19:50 2005 +++ gsharp/score-pane.lisp Mon Nov 7 19:51:41 2005 @@ -18,12 +18,19 @@ (defparameter *font* nil) (defparameter *fonts* (make-array 100 :initial-element nil)) +;;; Map integer levels of white, represented by the number of white pixels in +;;; a 4x4 pixel grid, to CLIM inks. (defparameter *gray-levels* (loop with result = (make-array '(17)) for i from 0 to 16 do (setf (aref result i) (make-gray-color (/ i 16))) finally (return result))) +;;; Given a pane and a matrix representing a glyph in a font, return a server-side +;;; pixmap that corresponds to that matrix for that pane. Create pixmaps +;;; on demand to avoid initial delays and too many pixmaps in the server. +;;; The elements of the matrix are integers from 0 to 16 inclusive, representing how +;;; many pixels are white in a 4x4 grid. (defun pane-pixmap (pane matrix) (or (gethash matrix (pane-pixmaps pane)) (let* ((dimensions (array-dimensions matrix)) @@ -138,9 +145,23 @@ ;;; ;;; drawing functions +;;; A staff step is half of the distance between two staff lines. +;;; 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. (defun staff-step (n) (* n (/ (staff-line-distance *font*) 2))) +;;; Given a pane, a glyph number, an x position (measured in pixels) +;;; and a y position (measured in staff steps), draw the glyph +;;; at the position in the pane. +;;; The font is organized so that the normal glyph is immediately +;;; followed by a light version of the glyph. Hence, we add 1 +;;; to the glyph number if a light version is desired. +;;; It appears that the resulting y-coordinate (in pixels) has the +;;; same sign as the staff-step argument, which suggests that this +;;; function must be called with a negated staff-step. It might be +;;; better to have this function do the negation. (defun draw-antialiased-glyph (pane glyph-no x staff-step) (let* ((extra (if *light-glyph* 1 0)) (matrix (glyph *font* (+ glyph-no extra))) @@ -152,6 +173,14 @@ (y1 (+ (staff-step staff-step) dy))) (draw-pixmap* pane pixmap x1 y1))))) +;;; Given a pane, an x position (measured in pixels) a y position +;;; (measured in staff steps), a glyph to draw a the bottom of the stack +;;; a glyph to draw at the top of the stack, a glyph to draws in the middle +;;; of the stack, and the number of elements of the stack, draw the stack +;;; by first drawing the lower glyph, then the intermediate glyphs, and +;;; 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. (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 @@ -159,14 +188,20 @@ (draw-antialiased-glyph pane glyph-two x ss)) (draw-antialiased-glyph pane glyph-upper x (+ staff-step (* 2 (1- how-many))))) +;;; Draw a stack of whole-note noteheads +;;; This function is currently not used. (defun draw-whole-stack (pane x staff-step how-many) (draw-stack pane +glyph-whole-lower+ +glyph-whole-upper+ +glyph-whole-two+ x staff-step how-many)) +;;; draw a stack of half-note noteheads +;;; This function is currently not used. (defun draw-half-stack (pane x staff-step how-many) (draw-stack pane +glyph-half-lower+ +glyph-half-upper+ +glyph-half-two+ x staff-step how-many)) +;;; draw a stack of filled noteheads. +;;; This function is currently not used. (defun draw-filled-stack (pane x staff-step how-many) (draw-stack pane +glyph-filled-lower+ +glyph-filled-upper+ +glyph-filled-two+ x staff-step how-many)) From rstrandh at common-lisp.net Mon Nov 7 20:00:54 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 7 Nov 2005 21:00:54 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp gsharp/packages.lisp Message-ID: <20051107200054.6346D88545@common-lisp.net> 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 From rstrandh at common-lisp.net Tue Nov 8 03:15:05 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 8 Nov 2005 04:15:05 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/score-pane.lisp gsharp/sdl.lisp Message-ID: <20051108031505.9CEBB88555@common-lisp.net> 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))) From rstrandh at common-lisp.net Tue Nov 8 05:16:16 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 8 Nov 2005 06:16:16 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/score-pane.lisp gsharp/sdl.lisp Message-ID: <20051108051616.5950D88555@common-lisp.net> 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))) From crhodes at common-lisp.net Thu Nov 10 17:34:32 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Thu, 10 Nov 2005 18:34:32 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Scores/bach181-lyrics.gsh gsharp/Scores/bach181-lyrics.ghs Message-ID: <20051110173432.62FE688556@common-lisp.net> 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 From crhodes at common-lisp.net Thu Nov 10 17:37:24 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Thu, 10 Nov 2005 18:37:24 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp Message-ID: <20051110173724.D081288599@common-lisp.net> 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))) From rstrandh at common-lisp.net Thu Nov 10 18:32:21 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Thu, 10 Nov 2005 19:32:21 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/sdl.lisp Message-ID: <20051110183221.C6A1588556@common-lisp.net> 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)) From rstrandh at common-lisp.net Thu Nov 10 20:05:37 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Thu, 10 Nov 2005 21:05:37 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051110200537.92BA188556@common-lisp.net> 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)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From rstrandh at common-lisp.net Thu Nov 10 22:29:16 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Thu, 10 Nov 2005 23:29:16 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051110222916.31A0688556@common-lisp.net> 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) From rstrandh at common-lisp.net Thu Nov 10 22:55:45 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Thu, 10 Nov 2005 23:55:45 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051110225545.E59DC88556@common-lisp.net> 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)) From rstrandh at common-lisp.net Fri Nov 11 02:11:20 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 11 Nov 2005 03:11:20 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051111021120.85E9F88556@common-lisp.net> 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)))) From rstrandh at common-lisp.net Fri Nov 11 18:47:09 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 11 Nov 2005 19:47:09 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051111184709.B8DF588556@common-lisp.net> 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)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; From rstrandh at common-lisp.net Fri Nov 11 19:19:41 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 11 Nov 2005 20:19:41 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/sdl.lisp Message-ID: <20051111191941.491F788556@common-lisp.net> 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) From rstrandh at common-lisp.net Sat Nov 12 07:14:29 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Sat, 12 Nov 2005 08:14:29 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051112071429.2735588568@common-lisp.net> 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)) From crhodes at common-lisp.net Mon Nov 14 14:27:33 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Mon, 14 Nov 2005 15:27:33 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/esa.lisp gsharp/gui.lisp gsharp/packages.lisp Message-ID: <20051114142733.DEEAC88574@common-lisp.net> 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) From rstrandh at common-lisp.net Mon Nov 14 19:59:47 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 14 Nov 2005 20:59:47 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Fonts/viewer.lisp Message-ID: <20051114195947.30314880D6@common-lisp.net> 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 From rstrandh at common-lisp.net Mon Nov 14 20:26:34 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 14 Nov 2005 21:26:34 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp Message-ID: <20051114202634.D329888555@common-lisp.net> 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))) From crhodes at common-lisp.net Mon Nov 14 20:49:35 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Mon, 14 Nov 2005 21:49:35 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/esa.lisp Message-ID: <20051114204935.A854188545@common-lisp.net> 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") From rstrandh at common-lisp.net Mon Nov 14 21:51:27 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 14 Nov 2005 22:51:27 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/sdl.lisp Message-ID: <20051114215127.8EE5388545@common-lisp.net> 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) From rstrandh at common-lisp.net Mon Nov 14 22:52:14 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 14 Nov 2005 23:52:14 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/sdl.lisp Message-ID: <20051114225214.A316E88545@common-lisp.net> 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) From rstrandh at common-lisp.net Tue Nov 15 18:49:53 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 15 Nov 2005 19:49:53 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/sdl.lisp Message-ID: <20051115184953.6773A880D5@common-lisp.net> 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 From rstrandh at common-lisp.net Tue Nov 15 19:14:59 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 15 Nov 2005 20:14:59 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Doc/gsharp.tex Message-ID: <20051115191459.3C433880D5@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv21136 Modified Files: gsharp.tex Log Message: fixed minor typos in the documentation. Date: Tue Nov 15 20:14:58 2005 Author: rstrandh Index: gsharp/Doc/gsharp.tex diff -u gsharp/Doc/gsharp.tex:1.5 gsharp/Doc/gsharp.tex:1.6 --- gsharp/Doc/gsharp.tex:1.5 Tue Nov 1 18:56:51 2005 +++ gsharp/Doc/gsharp.tex Tue Nov 15 20:14:58 2005 @@ -702,7 +702,7 @@ There is a slight problem with \emph{head slices} and \emph{tail slices} which is why they are not implemented yet. While -conceptually these slices below to the segment of their +conceptually these slices belong to the segment of their corresponding layer, the layout algorithm must align them with the last measure of the previous segment and the first measure of the next segment. To make it impossible for those slices to stick out @@ -738,7 +738,7 @@ but that is not all there is to it. In fact, we also know that \emph{on a given line}, the smallest geographic distance possible (a global parameter of the score that determines denseness and that we -will call $w_min$) is assigned to the shortest temporal distance on +will call $w_{min}$) is assigned to the shortest temporal distance on that line, \emph{independently of the absolute value of that temporal distance}. The other geographic distances are adjusted accordingly. Thus, a measure can take up a lot more space on a line if other From rstrandh at common-lisp.net Wed Nov 16 01:27:35 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 16 Nov 2005 02:27:35 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/measure.lisp Message-ID: <20051116012735.9B459880D7@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv16112 Modified Files: buffer.lisp measure.lisp Log Message: added more comments to improve maintainability Date: Wed Nov 16 02:27:34 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.25 gsharp/buffer.lisp:1.26 --- gsharp/buffer.lisp:1.25 Thu Nov 10 18:36:36 2005 +++ gsharp/buffer.lisp Wed Nov 16 02:27:34 2005 @@ -916,7 +916,12 @@ (segments :initform '() :initarg :segments :accessor segments) (staves :initform (list (make-fiveline-staff)) :initarg :staves :accessor staves) + ;; the min width determines the preferred geographic distance after the + ;; timetlime with the shortest duration on a line. (min-width :initform *default-min-width* :initarg :min-width :accessor min-width) + ;; the spacing style of the buffer determines the how geographic distance + ;; between adjacent timelines is related to temporal distance. + ;; a value of 0 means constant spacing, a value of 1 means proportional spacing (spacing-style :initform *default-spacing-style* :initarg :spacing-style :accessor spacing-style) (right-edge :initform *default-right-edge* :initarg :right-edge :accessor right-edge) (left-offset :initform *default-left-offset* :initarg :left-offset :accessor left-offset) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.4 gsharp/measure.lisp:1.5 --- gsharp/measure.lisp:1.4 Mon Oct 31 03:16:27 2005 +++ gsharp/measure.lisp Wed Nov 16 02:27:34 2005 @@ -125,8 +125,22 @@ ;;; ;;; Measure +;;; A measure represents the set of simultaneous bars. +;;; Define a TIMELINE of a measure to be the set of all +;;; simultaneous elements of the bars of the measure. +;;; The DURATION of a timeline is either the distance to +;;; the next closest timeline following it, or, in case +;;; it is the last timeline of the measure, the duration +;;; of the longest element of the timeline. + (defclass measure (obseq-elem) - ((min-dist :initarg :min-dist :reader measure-min-dist) + (;; the smallest temporal distance between either two adjacent + ;; timelines in the measure or between the last timeline + ;; and the end of the mesure. The temporal distance between + ;; the last timeline and the end of the measure is the same + ;; as the duration of the longest element of the last timeline. + (min-dist :initarg :min-dist :reader measure-min-dist) + ;; the coefficient of a measure is the sum of (coeff :initarg :coeff :reader measure-coeff) (start-times :initarg :start-times :reader measure-start-times) (seg-pos :initarg :seg-pos :reader measure-seg-pos) @@ -304,8 +318,11 @@ ;;; Cost functions (defclass measure-cost-method (cost-method) - ((min-width :initarg :min-width :reader min-width) + (;; the min width is taken from the min width of the buffer + (min-width :initarg :min-width :reader min-width) + ;; the spaceing style is taken from the spacing style of the buffer (spacing-style :initarg :spacing-style :reader spacing-style) + ;; the amount of horizontal space available to music material (line-width :initarg :line-width :reader line-width))) (defun make-measure-cost-method (min-width spacing-style line-width) From rstrandh at common-lisp.net Wed Nov 16 03:07:02 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 16 Nov 2005 04:07:02 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Flexichain/flexirank.lisp gsharp/Flexichain/flexichain-package.lisp gsharp/Flexichain/flexichain.asd gsharp/Flexichain/flexichain.lisp Message-ID: <20051116030702.B9224885A4@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv23816 Modified Files: flexichain-package.lisp flexichain.asd flexichain.lisp Added Files: flexirank.lisp Log Message: The code in the new file flexirank.lisp makes it possible for client code to define a `ranked flexichain' which is a flexichain or a cursorchain in which the elements know their position. Also removed a useless defgeneric from flexichain.lisp Date: Wed Nov 16 04:06:59 2005 Author: rstrandh Index: gsharp/Flexichain/flexichain-package.lisp diff -u gsharp/Flexichain/flexichain-package.lisp:1.3 gsharp/Flexichain/flexichain-package.lisp:1.4 --- gsharp/Flexichain/flexichain-package.lisp:1.3 Wed Mar 2 05:19:27 2005 +++ gsharp/Flexichain/flexichain-package.lisp Wed Nov 16 04:06:59 2005 @@ -36,4 +36,6 @@ #:at-beginning-p #:at-end-p #:move> #:move< #:insert #:insert-sequence - #:element< #:element> #:delete< #:delete>)) + #:element< #:element> #:delete< #:delete> + #:flexirank-mixin #:element-rank-mixin #:rank)) + Index: gsharp/Flexichain/flexichain.asd diff -u gsharp/Flexichain/flexichain.asd:1.3 gsharp/Flexichain/flexichain.asd:1.4 --- gsharp/Flexichain/flexichain.asd:1.3 Wed Mar 2 05:19:27 2005 +++ gsharp/Flexichain/flexichain.asd Wed Nov 16 04:06:59 2005 @@ -32,5 +32,6 @@ :components ((:file "flexichain-package") (:file "utilities" :depends-on ("flexichain-package")) (:file "flexichain" :depends-on ("utilities")) - (:file "flexicursor" :depends-on ("flexichain")))) + (:file "flexicursor" :depends-on ("flexichain")) + (:file "flexirank" :depends-on ("flexichain")))) Index: gsharp/Flexichain/flexichain.lisp diff -u gsharp/Flexichain/flexichain.lisp:1.6 gsharp/Flexichain/flexichain.lisp:1.7 --- gsharp/Flexichain/flexichain.lisp:1.6 Tue Dec 28 07:57:00 2004 +++ gsharp/Flexichain/flexichain.lisp Wed Nov 16 04:06:59 2005 @@ -199,9 +199,6 @@ (defmethod flexi-empty-p ((chain standard-flexichain)) (zerop (nb-elements chain))) -(defgeneric insert-object (chain position object) - (:documentation "Inserts an object at gap-start of a chain.")) - (defun position-index (chain position) "Returns the (0 indexed) index of the POSITION-th element of the CHAIN in the buffer." From rstrandh at common-lisp.net Wed Nov 16 18:33:11 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 16 Nov 2005 19:33:11 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Flexichain/flexichain.lisp Message-ID: <20051116183311.B8BD8880D7@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv27532 Modified Files: flexichain.lisp Log Message: Fixed a bug that made :initial-contents not work properly. Date: Wed Nov 16 19:33:10 2005 Author: rstrandh Index: gsharp/Flexichain/flexichain.lisp diff -u gsharp/Flexichain/flexichain.lisp:1.7 gsharp/Flexichain/flexichain.lisp:1.8 --- gsharp/Flexichain/flexichain.lisp:1.7 Wed Nov 16 04:06:59 2005 +++ gsharp/Flexichain/flexichain.lisp Wed Nov 16 19:33:10 2005 @@ -176,7 +176,7 @@ initial-contents fill-list))))) (with-slots (gap-start gap-end data-start) chain - (setf gap-start 2 + (setf gap-start (+ 2 (length initial-contents)) gap-end 0 data-start 1))) From rstrandh at common-lisp.net Wed Nov 16 19:44:53 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 16 Nov 2005 20:44:53 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/measure.lisp Message-ID: <20051116194453.527D3880D7@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv32077 Modified Files: measure.lisp Log Message: More comments to improve maintainability. Date: Wed Nov 16 20:44:52 2005 Author: rstrandh Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.5 gsharp/measure.lisp:1.6 --- gsharp/measure.lisp:1.5 Wed Nov 16 02:27:34 2005 +++ gsharp/measure.lisp Wed Nov 16 20:44:52 2005 @@ -125,26 +125,30 @@ ;;; ;;; Measure -;;; A measure represents the set of simultaneous bars. -;;; Define a TIMELINE of a measure to be the set of all -;;; simultaneous elements of the bars of the measure. -;;; The DURATION of a timeline is either the distance to -;;; the next closest timeline following it, or, in case -;;; it is the last timeline of the measure, the duration -;;; of the longest element of the timeline. +;;; A measure represents the set of simultaneous bars. Define a +;;; TIMELINE of a measure to be the set of all simultaneous elements +;;; of the bars of the measure. The DURATION of a timeline is either +;;; the temporal distance to the next closest timeline following it, +;;; or, in case it is the last timeline of the measure, the duration +;;; of the longest element of the timeline. (defclass measure (obseq-elem) - (;; the smallest temporal distance between either two adjacent - ;; timelines in the measure or between the last timeline - ;; and the end of the mesure. The temporal distance between - ;; the last timeline and the end of the measure is the same - ;; as the duration of the longest element of the last timeline. + (;; the smallest duration of any timeline in the measure (min-dist :initarg :min-dist :reader measure-min-dist) - ;; the coefficient of a measure is the sum of + ;; the coefficient of a measure is the sum of d_i^k where d_i + ;; is the duration of the i:th timeline, and k is the spacing style (coeff :initarg :coeff :reader measure-coeff) + ;; a list of unique rational numbers, sorted by increasing numeric value, + ;; of the start time of the time lines of the measure (start-times :initarg :start-times :reader measure-start-times) + ;; the position of a measure in the sequence of measures + ;; of a buffer is indicated by two numbers, the position + ;; of the segment to which the measure belongs within the + ;; sequence of segments of the buffer, and the position of + ;; the bars within that segment. (seg-pos :initarg :seg-pos :reader measure-seg-pos) (bar-pos :initarg :bar-pos :reader measure-bar-pos) + ;; a list of the bars that make up this measure (bars :initarg :bars :reader measure-bars))) (defun make-measure (min-dist coeff start-times seg-pos bar-pos bars) @@ -179,6 +183,8 @@ (defun adjust-lowpos-highpos (segment) (when (modified-p segment) (let ((buffer (buffer segment))) + ;; Do this better. Now, we essentially tell the obseq library + ;; that every measure in the entire buffer has been damaged. (obseq-first-undamaged-element buffer nil) (obseq-last-undamaged-element buffer nil)))) @@ -190,34 +196,63 @@ (defmethod nb-measures ((segment rsegment)) (length (measures segment))) +;;; Given a segment and a position, return the measure in that +;;; position in the sequence of measures in the segment. (defmethod measureno ((segment rsegment) position) (elt (measures segment) position)) -;;; convert a list of durations to a list of start times +;;; Convert a list of durations to a list of start times +;;; by accumulating values starting at zero. +;;; The list returned has the same length as the one passed +;;; as argument, which we obtain by treating the first element +;;; as the initial start time. Doing so makes it possible to compute +;;; the inverse of this transformation. (defun rel-abs (list) (loop with acc = 0 for elem in list collect (incf acc elem))) -;;; convert a list of start times to a list of durations +;;; Convert a list of start times to a list of durations +;;; by computing the differences beteen adjacent elements. +;;; The list returned has the same length as the one passed +;;; as argument, which we obtain by including the first +;;; element unchanged. Doing so makes it possible to compute +;;; the inverse of this transformation. (defun abs-rel (list) (loop with prev = 0 for elem in list collect (- elem prev) do (setf prev elem))) +;;; Compute the start times of the elements of the bar. The last +;;; element is the "start time" of the end of the bar. Currently, we +;;; do not handle zero-duration bars very well. For that reason, when +;;; there are no elements in the bar, we return the list of a single +;;; number 1. This is clearly wrong, so we need to figure out a +;;; better way of doing that. (defun start-times (bar) (let ((elements (elements bar))) (if elements (rel-abs (mapcar #'duration elements)) '(1)))) -;;; treat the last start time (which is really the duration of the +;;; Combine the list of start times of two bars into a single list +;;; of start times. Don't worry about duplicated elements which will +;;; be removed ultimately. +;;; Treat the last start time (which is really the duration of the ;;; bar) specially and only keep the largest one (defun combine-bars (bar1 bar2) (append (merge 'list (butlast bar1) (butlast bar2) #'<) (list (max (car (last bar1)) (car (last bar2)))))) +;;; From a list of simultaneous bars (and some other stuff), create a +;;; measure. The `other stuff' is the spacing style, which is neded +;;; in order to compute the coefficient of the measure, the position +;;; of the segment to which the bars belong in the sequence of +;;; segments of the buffer, and the position of the bars in the +;;; sequence of bars within that segment. The last two items are used +;;; to indicate the position of the measure in the sequence of all +;;; measures of the buffer. (defun compute-measure (bars spacing-style seg-pos bar-pos) (let* ((start-times (remove-duplicates (reduce #'combine-bars @@ -228,6 +263,8 @@ sum (expt duration spacing-style)))) (make-measure min-dist coeff start-times seg-pos bar-pos bars))) +;;; Compute all the measures of a segment by stepping through all the +;;; bars in parallel as long as there is at least one simultaneous bar. (defun compute-measures (segment spacing-style) (setf (slot-value segment 'measures) (loop for all-bars on (mapcar (lambda (layer) (bars (body layer))) @@ -246,11 +283,21 @@ (define-added-mixin rbuffer (obseq) buffer ((modified-p :initform t :accessor modified-p))) +;;; Given a buffer, a position of a segment in the sequence of +;;; segments of the buffer, and a position of a measure within that +;;; segment, return the corresponding measure. (defmethod buffer-pos ((buffer rbuffer) seg-pos bar-pos) (if (or (<= seg-pos -1) (>= seg-pos (nb-segments buffer))) nil (measureno (segmentno buffer seg-pos) bar-pos))) +;;; as required by the obseq library, we supply a method on this +;;; generic function. When we are given a measure other than the last +;;; one in the segment, return the next one in the segment. When we +;;; are given the last measure in a segment which is not the last one, +;;; return the first measure in the following segment. When we are +;;; given the last measure of the last segment, return nil as required +;;; by the obseq library. (defmethod obseq-next ((buf buffer) (measure measure)) (let ((seg-pos (measure-seg-pos measure)) (bar-pos (measure-bar-pos measure))) @@ -260,9 +307,19 @@ (buffer-pos buf (1+ seg-pos) 0)) (t nil)))) +;;; as required by the obseq library, we supply a method on this +;;; generic function specialized on NIL, for which the first measure +;;; of the first segment is returned. (defmethod obseq-next ((buf buffer) (measure (eql nil))) (measureno (segmentno buf 0) 0)) +;;; as required by the obseq library, we supply a method on this +;;; generic function. When we are given a measure other than the first +;;; one in the segment, return the previous one in the segment. When we +;;; are given the first measure in a segment which is not the first one, +;;; return the last measure in the preceding segment. When we are +;;; given the first measure of the first segment, return nil as required +;;; by the obseq library. (defmethod obseq-prev ((buf buffer) (measure measure)) (let ((seg-pos (measure-seg-pos measure)) (bar-pos (measure-bar-pos measure))) @@ -272,6 +329,9 @@ (1- (nb-measures (segmentno buf (1- seg-pos)))))) (t nil)))) +;;; as required by the obseq library, we supply a method on this +;;; generic function specialized on NIL, for which the last measure +;;; of the last segment is returned. (defmethod obseq-prev ((buf buffer) (measure (eql nil))) (buffer-pos buf (1- (nb-segments buf)) From rstrandh at common-lisp.net Thu Nov 17 00:42:43 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Thu, 17 Nov 2005 01:42:43 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/measure.lisp Message-ID: <20051117004243.B0A25880D7@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv21978 Modified Files: measure.lisp Log Message: Finished (?) adding comments to measure.lisp. Date: Thu Nov 17 01:42:42 2005 Author: rstrandh Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.6 gsharp/measure.lisp:1.7 --- gsharp/measure.lisp:1.6 Wed Nov 16 20:44:52 2005 +++ gsharp/measure.lisp Thu Nov 17 01:42:42 2005 @@ -349,14 +349,19 @@ (mark-modified (buffer segment)))) ;;; temporary stuff +;;; call fun on every list of measures (which make up a line) +;;; in the buffer (defun new-map-over-obseq-subsequences (fun buf) (loop with m = (obseq-interval buf (buffer-pos buf 0 0)) while m do (multiple-value-bind (left right) + ;; find the end points of the interval that contains m (obseq-interval buf m) (funcall fun (loop for mm = left then (obseq-next buf mm) collect mm until (eq mm right))) + ;; move to the next measure after the rightmost one + ;; in the current line (setf m (obseq-next buf right))))) (defun buffer-cost-method (buffer) @@ -364,6 +369,7 @@ (defmethod recompute-measures ((buffer rbuffer)) (when (modified-p buffer) + ;; for now, invalidate everything (mapc #'adjust-lowpos-highpos (segments buffer)) ;; initialize cost method from buffer-specific style parameters (setf (obseq-cost-method buffer) @@ -377,6 +383,8 @@ ;;; ;;; Cost functions +;;; As required by the obseq library, define a cost method +;;; that is passed to the cost-comparison methods. (defclass measure-cost-method (cost-method) (;; the min width is taken from the min width of the buffer (min-width :initarg :min-width :reader min-width) @@ -391,11 +399,15 @@ :spacing-style spacing-style :line-width line-width)) +;;; As required by the obseq library, define a sequence cost, i.e., in +;;; this case the cost of a sequece of measures. (defclass measure-seq-cost (seq-cost) ((min-dist :initarg :min-dist :reader min-dist) (coeff :initarg :coeff :reader coeff) (nb-measures :initarg :nb-measures :reader nb-measures))) +;;; As required by the obseq library, define a total cost, i.e., in +;;; this case the cost of a sequece of sequences of measures. (defclass measure-total-cost (total-cost) ((cost :initarg :cost :reader measure-total-cost))) @@ -406,6 +418,15 @@ (print-unreadable-object (obj stream :identity t :type t) (format stream "~D" (measure-total-cost obj)))) +;;; As required by the obseq library, this method computes the +;;; combined cost of a sequence of measures by taking the existing +;;; cost of all but the last measures and combining it with the +;;; characteristics of the last measure. The result is a sequence +;;; cost that has the sum of the coefficients of each measure in the +;;; sequence, the min of the min-dists of each measure in the +;;; sequence, and the total number of measures in the sequence. +;;; As far as Gsharp is concerned, this cost computation is +;;; commutable, so rely on Obseq to supply the symmetric method. (defmethod combine-cost ((method measure-cost-method) (seq-cost measure-seq-cost) (elem measure)) @@ -414,6 +435,17 @@ :min-dist (min (min-dist seq-cost) (measure-min-dist elem)) :nb-measures (1+ (nb-measures seq-cost)))) +;;; As required by the obseq library, this method computes the +;;; combined cost of a sequence of sequences of measures by taking the +;;; existing cost of all but the last sequences of measures and +;;; combining it with the sequence cost of the last sequence of +;;; measures. The result is a total cost that has the max of the cost +;;; of each individual sequence of measures. The reason for using the +;;; max is that we do not want for a good line to be able to +;;; compensate for the badness of another. We thus compute the score +;;; that minimizes the maximum of the badness of each line. As far as +;;; Gsharp is concerned, this cost computation is commutable, so rely +;;; on Obseq to supply the symmetric method. (defmethod combine-cost ((method measure-cost-method) (tcost measure-total-cost) (seq-cost measure-seq-cost)) @@ -428,6 +460,8 @@ :cost (measure-seq-cost method seq-cost))) +;;; As required by the obseq library, this method computes the +;;; sequence cost of a singleton sequence. (defmethod combine-cost ((method measure-cost-method) (elem measure) (whatever (eql nil))) @@ -436,11 +470,21 @@ :min-dist (measure-min-dist elem) :nb-measures 1)) +;;; As required by the obseq library, this method computes the +;;; sequence cost of a singleton sequence. (defmethod combine-cost ((method measure-cost-method) (whatever (eql nil)) (elem measure)) (combine-cost method elem nil)) +;;; The reduced width of a sequence of measures is the sum of the +;;; widths of the measures in the sequence, but ignoring the space +;;; before first timeline. If the min-dist is 0 (which I think is the +;;; case if each measure has no timelines), then the reduced width is +;;; 0, otherwise we obtain the reduced width by multiplying the sum of +;;; the coefficients of each mesure in the sequence, the min-width to +;;; use for the display, and (1/d_min)^k, where d_min is the duration +;;; of the shortest timeline, and k is the spacing style. (defmethod reduced-width ((method measure-cost-method) (seq-cost measure-seq-cost)) (if (zerop (min-dist seq-cost)) @@ -448,42 +492,54 @@ (* (coeff seq-cost) (min-width method) (expt (/ (min-dist seq-cost)) (spacing-style method))))) +;;; The natural width of a sequence of mesures is like the reduced +;;; width, except that we do not ignore the space before the first +;;; timeline in each measure. That space might be necessary to +;;; parameterize one day, but for now we just use the w_min. (defmethod natural-width ((method measure-cost-method) (seq-cost measure-seq-cost)) (+ (reduced-width method seq-cost) (* (nb-measures seq-cost) (min-width method)))) +;;; The compress factor indicates how by how much a sequence of +;;; measures must be compressed in order to fit the line width at our +;;; disposal. Values > 1 indicate that the sequence of mesures must +;;; be stretched instead of compressed. (defmethod compress-factor ((method measure-cost-method) (seq-cost measure-seq-cost)) (/ (natural-width method seq-cost) (line-width method))) +;;; As far as Gsharp is concerned, we define the cost of a sequence of +;;; measures as the max of the compress factor and its inverse. In +;;; other words, we consider it as bad to have to stretch a line by x% +;;; as it is to have to compress it by x%, and the more we have to +;;; compress or expand it, the worse it is. This way of doing it is +;;; not great. At some point, we need to severely penalize compressed +;;; lines that become too short to display without overlaps, unless +;;; the line contains a single measure, of course. (defmethod measure-seq-cost ((method measure-cost-method) (seq-cost measure-seq-cost)) (let ((c (compress-factor method seq-cost))) (max c (/ c)))) +;;; As required by the obseq library, we define a method that +;;; determines whether we can prove that adding another measure to an +;;; existing sequence is guaranteed to make the cost of the sequence +;;; higher. The obseq library uses this to radically diminish the +;;; complexity of the computation. (defmethod seq-cost-cannot-decrease ((method measure-cost-method) (seq-cost measure-seq-cost)) (>= (natural-width method seq-cost) (line-width method))) +;;; Compare the cost of two sequences of measures (defmethod cost-less ((method measure-cost-method) (c1 measure-seq-cost) (c2 measure-seq-cost)) (< (measure-seq-cost method c1) (measure-seq-cost method c2))) +;;; Compare the cost of two sequences of sequences of measures (defmethod cost-less ((method measure-cost-method) (c1 measure-total-cost) (c2 measure-total-cost)) (< (measure-total-cost c1) (measure-total-cost c2))) - -(defmethod cost-less ((method measure-cost-method) - (c1 measure-seq-cost) - (c2 measure-seq-cost)) - (< (measure-seq-cost method c1) (measure-seq-cost method c2))) - -(defmethod cost-less ((method measure-cost-method) - (c1 measure-total-cost) - (c2 measure-total-cost)) - (< (measure-total-cost c1) (measure-total-cost c2))) - From crhodes at common-lisp.net Thu Nov 17 16:27:36 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Thu, 17 Nov 2005 17:27:36 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Fonts/whole_rest.mf Message-ID: <20051117162736.32650880D5@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Fonts In directory common-lisp.net:/tmp/cvs-serv25553/Fonts Modified Files: whole_rest.mf Log Message: make the whole (semibreve) rest hang from the second-line down. Date: Thu Nov 17 17:27:35 2005 Author: crhodes Index: gsharp/Fonts/whole_rest.mf diff -u gsharp/Fonts/whole_rest.mf:1.1.1.1 gsharp/Fonts/whole_rest.mf:1.2 --- gsharp/Fonts/whole_rest.mf:1.1.1.1 Mon Feb 16 16:46:36 2004 +++ gsharp/Fonts/whole_rest.mf Thu Nov 17 17:27:35 2005 @@ -2,9 +2,10 @@ begin_character(whole_rest) - fill unitsquare shifted (-0.5, -1) + fill unitsquare shifted (-0.5, 0) xscaled notehead_width yscaled (0.5 * staff_line_distance) + shifted (0, 0.5 * staff_line_distance) shifted (xoffset, yoffset) scaled magnification; @@ -12,9 +13,10 @@ begin_character(whole_rest_light) - fill unitsquare shifted (-0.5, -1) + fill unitsquare shifted (-0.5, 0) xscaled notehead_width yscaled (0.5 * staff_line_distance) + shifted (0, 0.5 * staff_line_distance) shifted (xoffset, yoffset) scaled magnification; From rstrandh at common-lisp.net Fri Nov 18 01:59:28 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 18 Nov 2005 02:59:28 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/measure.lisp Message-ID: <20051118015928.94E87880D5@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv3504 Modified Files: drawing.lisp measure.lisp Log Message: Prepare for a separation of the functionality in drawing.lisp into two parts: 1. A part that computes stem directions and x offsets of notes and accidentals relative to the x offset of the element. These computations will be used to determine physical widths of elements. 2. A part that computes exact x and y positions, beam slants, etc. for the final drawing phase. The first part will precede the line-breaking phase, so that the line-breaking algorithm can take physical widths into account. Date: Fri Nov 18 02:59:27 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.20 gsharp/drawing.lisp:1.21 --- gsharp/drawing.lisp:1.20 Tue Nov 15 19:49:52 2005 +++ gsharp/drawing.lisp Fri Nov 18 02:59:27 2005 @@ -221,19 +221,26 @@ ;;; about an element: ;;; * the position, in staff steps of the top note. ;;; * the position, in staff steps of the bottom note. +(defun compute-top-bot-pos (element) + (if (and (typep element 'cluster) (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))) + (setf (top-note-pos element) 4 + (bot-note-pos element) 4))) + +;;; compute and store several important pieces of information +;;; about an element: ;;; * the y-offset of the staff containing the top note. ;;; * the y-offset of the staff containing the bottom note. -(defun compute-top-bot-pos-yoffset (element) +(defun compute-top-bot-yoffset (element) (if (and (typep element 'cluster) (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)) + (setf (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. + (setf ;; clearly wrong. should be taken from element or layer. (top-note-staff-yoffset element) 0 (bot-note-staff-yoffset element) 0))) @@ -342,7 +349,8 @@ notes)) (defun draw-beam-group (pane elements) - (mapc #'compute-top-bot-pos-yoffset elements) + (mapc #'compute-top-bot-pos elements) + (mapc #'compute-top-bot-yoffset elements) (if (null (cdr elements)) (when (or (typep (car elements) 'rest) (notes (car elements))) (compute-appearance (car elements)) @@ -399,10 +407,11 @@ (defun draw-cursor (pane x) (draw-line* pane x (- (score-pane:staff-step -4)) x (- (score-pane:staff-step 12)) :ink +red+)) -(defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) - (compute-element-x-positions bar x time-alist) - (let ((elements (elements bar)) - (group '())) +;;; Given a list of the elements of a bar, return a list of beam +;;; groups, where each beam group is a list of elements that are +;;; beamed together +(defun beam-groups (elements) + (let ((group '())) (loop while (not (null elements)) do (setf group '()) (push (pop elements) group) @@ -410,7 +419,12 @@ (> (rbeams (car group)) 0) (> (lbeams (car elements)) 0)) do (push (pop elements) group)) - (draw-beam-group pane (nreverse group)))) + collect (nreverse group)))) + +(defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) + (compute-element-x-positions bar x time-alist) + (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*)) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.7 gsharp/measure.lisp:1.8 --- gsharp/measure.lisp:1.7 Thu Nov 17 01:42:42 2005 +++ gsharp/measure.lisp Fri Nov 18 02:59:27 2005 @@ -28,13 +28,13 @@ (defmethod duration :around ((element relement)) (with-slots (duration) element - (when (or (modified-p element) (null duration)) - (setf duration (call-next-method)) - (setf (modified-p element) nil)) + (when (null duration) + (setf duration (call-next-method))) duration)) (defmethod mark-modified ((element relement)) - (setf (modified-p element) t) + (setf (modified-p element) t + (slot-value element 'duration) nil) (when (bar element) (mark-modified (bar element)))) From rstrandh at common-lisp.net Fri Nov 18 02:49:44 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 18 Nov 2005 03:49:44 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051118024944.4ACD6880D5@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv8113 Modified Files: drawing.lisp Log Message: continue the restructuring of drawing.lisp Date: Fri Nov 18 03:49:43 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.21 gsharp/drawing.lisp:1.22 --- gsharp/drawing.lisp:1.21 Fri Nov 18 02:59:27 2005 +++ gsharp/drawing.lisp Fri Nov 18 03:49:43 2005 @@ -217,7 +217,7 @@ (t n2))) notes)) -;;; compute and store several important pieces of information +;;; Compute and store several important pieces of information ;;; about an element: ;;; * the position, in staff steps of the top note. ;;; * the position, in staff steps of the bottom note. @@ -230,7 +230,7 @@ (setf (top-note-pos element) 4 (bot-note-pos element) 4))) -;;; compute and store several important pieces of information +;;; Compute and store several important pieces of information ;;; about an element: ;;; * the y-offset of the staff containing the top note. ;;; * the y-offset of the staff containing the bottom note. @@ -244,6 +244,8 @@ (top-note-staff-yoffset element) 0 (bot-note-staff-yoffset element) 0))) +;;; Compute and store the final stem direction of an element that is +;;; not beamed together with any other elements. (defun compute-stem-direction (element) (setf (final-stem-direction element) (if (or (eq (stem-direction element) :up) (eq (stem-direction element) :down)) @@ -304,11 +306,6 @@ (+ top-note-pos length) (- bot-note-pos length))))) -(defun compute-appearance (element) - (when (typep element 'cluster) - (compute-stem-direction element) - (compute-stem-length element))) - (defun compute-element-x-positions (bar x time-alist) (let (;;(time-alist (time-alist bar)) (start-time 0)) @@ -320,12 +317,16 @@ (incf start-time (duration element))) (elements bar)))) +;;; Compute and store the final stem directions of all the elements of +;;; a beam group with at least two elements in it. (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 #'top-note-pos)) - (bot-note-pos (reduce #'min elements :key #'bot-note-pos))) - (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up)))) + (let ((stem-direction (if (not (eq (stem-direction (car elements)) :auto)) + (stem-direction (car elements)) + (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))))) + (loop for element in elements + do (setf (final-stem-direction element) stem-direction)))) ;;; the dominating note among a bunch of notes is the ;;; one that is closest to the beam, i.e. the one @@ -348,14 +349,28 @@ (if (< (pitch n1) (pitch n2)) n1 n2)))))) notes)) -(defun draw-beam-group (pane elements) +;;; Given a list of elements to be beamed together, for each element, +;;; compute the top and bottom note position, and the final stem +;;; direction. +(defun compute-positions-and-stem-direction (elements) (mapc #'compute-top-bot-pos elements) + (if (null (cdr elements)) + (let ((element (car elements))) + (when (or (typep element 'rest) (notes element)) + (when (typep element 'cluster) + (compute-stem-direction element)))) + (compute-stem-directions elements))) + +(defun draw-beam-group (pane elements) (mapc #'compute-top-bot-yoffset elements) (if (null (cdr elements)) - (when (or (typep (car elements) 'rest) (notes (car elements))) - (compute-appearance (car elements)) - (draw-element pane (car elements) (element-xpos (car elements)))) - (let* ((stem-direction (compute-stem-directions elements)) + (let ((element (car elements))) + (when (or (typep element 'rest) (notes element)) + (when (typep element 'cluster) + (compute-stem-direction element) + (compute-stem-length element)) + (draw-element pane element (element-xpos element)))) + (let* ((stem-direction (final-stem-direction (car elements))) (dominating-notes (mapcar (lambda (e) (dominating-note (notes e) stem-direction)) elements)) @@ -370,8 +385,6 @@ (/ (element-xpos element) (score-pane:staff-step 1))) elements)) (beaming (beaming-single (mapcar #'list positions x-positions) stem-direction))) - (loop for element in elements do - (setf (final-stem-direction element) stem-direction)) (destructuring-bind ((ss1 . offset1) (ss2 . offset2)) beaming (let* ((y1 (+ ss1 (* 1/2 offset1))) (y2 (+ ss2 (* 1/2 offset2))) @@ -424,7 +437,8 @@ (defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) (loop for group in (beam-groups (elements bar)) - do (draw-beam-group pane group)) + do (compute-positions-and-stem-direction group) + (draw-beam-group pane group)) (when (eq (cursor-bar *cursor*) bar) (let ((elements (elements bar))) (if (null (cursor-element *cursor*)) @@ -537,6 +551,9 @@ (when (= (abs (- pos old-pos)) 1) (setf note old-note)))))) +;;; Given a list of notes to be displayed on the same staff line, for +;;; each note, compute the accidental to be displayed as a function of +;;; the accidentals of the note and the key signature of the staff. (defun compute-final-accidentals (group) (loop for note in group do (setf (final-accidental note) From rstrandh at common-lisp.net Fri Nov 18 16:59:54 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 18 Nov 2005 17:59:54 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051118165954.3A2C688554@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv6081 Modified Files: drawing.lisp Log Message: Pursue the effort to separate the current drawing phase into two phases. Now, the x offset of a note is relative to that of the cluster, so that the relative x offset can be computed before the x offset of the cluster is known, i.e., before line breaking. Date: Fri Nov 18 17:59:53 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.22 gsharp/drawing.lisp:1.23 --- gsharp/drawing.lisp:1.22 Fri Nov 18 03:49:43 2005 +++ gsharp/drawing.lisp Fri Nov 18 17:59:53 2005 @@ -4,7 +4,8 @@ ((yoffset :initform 0 :accessor staff-yoffset))) (define-added-mixin dnote () note - ((final-xposition :accessor final-xposition) + (;; the relative x offset of the note with respect to the cluster + (final-relative-xoffset :accessor final-relative-xoffset) (final-accidental :initform nil :accessor final-accidental) ;; nil indicates that accidental has not been placed yet (accidental-position :initform nil :accessor accidental-position))) @@ -58,6 +59,12 @@ :x1 ,x1 :x2 ,x2) :stream pane)) +;;; Return the final x offset of a note. This value is computed from +;;; the x offset of the cluster of the note and the relative x offset +;;; of the note with respect to the cluster. +(defun final-xoffset (note) + (+ (element-xpos (cluster note)) (final-relative-xoffset note))) + (defun line-cost (measures method) (reduce (lambda (x y) (combine-cost method x y)) measures :initial-value nil)) @@ -519,7 +526,7 @@ (defun draw-notes (pane notes dots notehead) (loop for note in notes do - (draw-note pane note notehead dots (final-xposition note) (note-position note)))) + (draw-note pane note notehead dots (final-xoffset 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 @@ -527,14 +534,14 @@ ;;; 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) +(defun compute-final-relative-xoffsets (group 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) + (setf (final-relative-xoffset (car group)) 0) ;; 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. @@ -546,7 +553,7 @@ ;; 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)) + (setf (final-relative-xoffset note) dx) ;; go back to ordinary offset (when (= (abs (- pos old-pos)) 1) (setf note old-note)))))) @@ -563,7 +570,7 @@ (accidentals note))))) (defun element-has-suspended-notes (element) - (not (apply #'= (mapcar #'final-xposition (notes element))))) + (not (apply #'= (mapcar #'final-relative-xoffset (notes element))))) ;;; table of x offsets (in staff steps) of accendentals. ;;; The first index represents a notehead or a type of accidental. @@ -649,7 +656,7 @@ :notehead)) (pos2 (note-position note2)) (xpos2 (or (accidental-position note2) - (final-xposition note2)))) + (final-xoffset note2)))) (- xpos2 (* staff-step (accidental-distance acc1 pos1 acc2 pos2))))) ;;; given a note and a list of notes, compute x offset of the accidental @@ -686,7 +693,7 @@ ;; 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))) + (find x notes-with-accidentals :test #'/= :key #'final-relative-xoffset))) (when first-suspended-note (setf notes-with-accidentals (remove first-suspended-note notes-with-accidentals)) @@ -729,7 +736,7 @@ (score-pane:with-vertical-score-position (pane stem-yoffset) (draw-flags pane element x direction stem-pos))) (loop for group in groups do - (compute-final-xpositions group x direction) + (compute-final-relative-xoffsets group direction) (compute-final-accidentals group) (compute-final-accidental-positions group x direction) (draw-notes pane group (dots element) (notehead element)) From rstrandh at common-lisp.net Fri Nov 18 17:36:38 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 18 Nov 2005 18:36:38 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051118173638.9E44288554@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv9841 Modified Files: drawing.lisp Log Message: renaming, mostly. Date: Fri Nov 18 18:36:37 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.23 gsharp/drawing.lisp:1.24 --- gsharp/drawing.lisp:1.23 Fri Nov 18 17:59:53 2005 +++ gsharp/drawing.lisp Fri Nov 18 18:36:36 2005 @@ -62,9 +62,16 @@ ;;; Return the final x offset of a note. This value is computed from ;;; the x offset of the cluster of the note and the relative x offset ;;; of the note with respect to the cluster. -(defun final-xoffset (note) +(defun final-note-xoffset (note) (+ (element-xpos (cluster note)) (final-relative-xoffset note))) +;;; Return the final x offset of the accidental of a note. This value +;;; is computed from the x offset of the cluster of the note and the +;;; relative x offset of the accidental of the note with respect to +;;; the cluster. +(defun final-accidental-xoffset (note) + (+ (element-xpos (cluster note)) (accidental-position note))) + (defun line-cost (measures method) (reduce (lambda (x y) (combine-cost method x y)) measures :initial-value nil)) @@ -526,7 +533,7 @@ (defun draw-notes (pane notes dots notehead) (loop for note in notes do - (draw-note pane note notehead dots (final-xoffset note) (note-position note)))) + (draw-note pane note notehead dots (final-note-xoffset 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 @@ -646,8 +653,7 @@ ;;; 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) +(defun accidental-xoffset (note1 note2 staff-step) (let* ((acc1 (final-accidental note1)) (pos1 (note-position note1)) (acc2 (if (and (final-accidental note2) @@ -656,24 +662,23 @@ :notehead)) (pos2 (note-position note2)) (xpos2 (or (accidental-position note2) - (final-xoffset note2)))) + (final-note-xoffset 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)))) +(defun accidental-min-xoffset (note1 notes staff-step) + (reduce #'min notes :key (lambda (note) (accidental-xoffset 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)) + (reduce (lambda (note1 note2) (if (>= (accidental-min-xoffset note1 notes staff-step) + (accidental-min-xoffset note2 notes staff-step)) note1 note2)) notes-with-accidentals)) @@ -698,14 +703,14 @@ (setf notes-with-accidentals (remove first-suspended-note notes-with-accidentals)) (setf (accidental-position first-suspended-note) - (accidental-min-xpos first-suspended-note notes staff-step))))) + (accidental-min-xoffset first-suspended-note notes staff-step))))) ;; place remaining accidentals (loop while notes-with-accidentals do (let ((choice (best-accidental notes-with-accidentals notes staff-step))) (setf notes-with-accidentals (remove choice notes-with-accidentals)) (setf (accidental-position choice) - (accidental-min-xpos choice notes staff-step)))))) + (accidental-min-xoffset 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. From rstrandh at common-lisp.net Fri Nov 18 17:53:41 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 18 Nov 2005 18:53:41 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051118175341.B2D2788554@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv11018 Modified Files: drawing.lisp Log Message: Accidentals are now placed relative to the cluster. Also, more renaming to improve maintainability. Date: Fri Nov 18 18:53:41 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.24 gsharp/drawing.lisp:1.25 --- gsharp/drawing.lisp:1.24 Fri Nov 18 18:36:36 2005 +++ gsharp/drawing.lisp Fri Nov 18 18:53:40 2005 @@ -5,10 +5,13 @@ (define-added-mixin dnote () note (;; the relative x offset of the note with respect to the cluster - (final-relative-xoffset :accessor final-relative-xoffset) + (final-relative-note-xoffset :accessor final-relative-note-xoffset) (final-accidental :initform nil :accessor final-accidental) - ;; nil indicates that accidental has not been placed yet - (accidental-position :initform nil :accessor accidental-position))) + ;; The relative x offset of the accidental of the note with respect + ;; to the cluster. A value of nil indicates that accidental has + ;; not been placed yet + (final-relative-accidental-xoffset :initform nil + :accessor final-relative-accidental-xoffset))) (define-presentation-method present (object (type score-pane:clef) stream (view textual-view) &key) @@ -59,18 +62,18 @@ :x1 ,x1 :x2 ,x2) :stream pane)) -;;; Return the final x offset of a note. This value is computed from -;;; the x offset of the cluster of the note and the relative x offset -;;; of the note with respect to the cluster. -(defun final-note-xoffset (note) - (+ (element-xpos (cluster note)) (final-relative-xoffset note))) - -;;; Return the final x offset of the accidental of a note. This value -;;; is computed from the x offset of the cluster of the note and the -;;; relative x offset of the accidental of the note with respect to -;;; the cluster. -(defun final-accidental-xoffset (note) - (+ (element-xpos (cluster note)) (accidental-position note))) +;;; Return the final absolute x offset of a note. This value is +;;; computed from the x offset of the cluster of the note and the +;;; relative x offset of the note with respect to the cluster. +(defun final-absolute-note-xoffset (note) + (+ (element-xpos (cluster note)) (final-relative-note-xoffset note))) + +;;; Return the final absolute x offset of the accidental of a note. +;;; This value is computed from the x offset of the cluster of the +;;; note and the relative x offset of the accidental of the note with +;;; respect to the cluster. +(defun final-absolute-accidental-xoffset (note) + (+ (element-xpos (cluster note)) (final-relative-accidental-xoffset note))) (defun line-cost (measures method) (reduce (lambda (x y) (combine-cost method x y)) measures :initial-value nil)) @@ -528,12 +531,12 @@ (score-pane:with-vertical-score-position (pane (staff-yoffset (staff note))) (score-pane:draw-notehead pane notehead x pos) (when (final-accidental note) - (score-pane:draw-accidental pane (final-accidental note) (accidental-position note) pos)) + (score-pane:draw-accidental pane (final-accidental note) (final-absolute-accidental-xoffset note) pos)) (draw-dots pane nb-dots x pos))) (defun draw-notes (pane notes dots notehead) (loop for note in notes do - (draw-note pane note notehead dots (final-note-xoffset note) (note-position note)))) + (draw-note pane note notehead dots (final-absolute-note-xoffset 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 @@ -541,14 +544,14 @@ ;;; 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-relative-xoffsets (group direction) +(defun compute-final-relative-note-xoffsets (group 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-relative-xoffset (car group)) 0) + (setf (final-relative-note-xoffset (car group)) 0) ;; 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. @@ -560,7 +563,7 @@ ;; 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-relative-xoffset note) dx) + (setf (final-relative-note-xoffset note) dx) ;; go back to ordinary offset (when (= (abs (- pos old-pos)) 1) (setf note old-note)))))) @@ -577,7 +580,7 @@ (accidentals note))))) (defun element-has-suspended-notes (element) - (not (apply #'= (mapcar #'final-relative-xoffset (notes element))))) + (not (apply #'= (mapcar #'final-relative-note-xoffset (notes element))))) ;;; table of x offsets (in staff steps) of accendentals. ;;; The first index represents a notehead or a type of accidental. @@ -653,16 +656,16 @@ ;;; 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. -(defun accidental-xoffset (note1 note2 staff-step) +(defun accidental-relative-xoffset (note1 note2 staff-step) (let* ((acc1 (final-accidental note1)) (pos1 (note-position note1)) (acc2 (if (and (final-accidental note2) - (accidental-position note2)) + (final-relative-accidental-xoffset note2)) (final-accidental note2) :notehead)) (pos2 (note-position note2)) - (xpos2 (or (accidental-position note2) - (final-note-xoffset note2)))) + (xpos2 (or (final-relative-accidental-xoffset note2) + (final-relative-note-xoffset note2)))) (- xpos2 (* staff-step (accidental-distance acc1 pos1 acc2 pos2))))) ;;; given a note and a list of notes, compute x offset of the accidental @@ -670,7 +673,7 @@ ;;; 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. (defun accidental-min-xoffset (note1 notes staff-step) - (reduce #'min notes :key (lambda (note) (accidental-xoffset note1 note staff-step)))) + (reduce #'min notes :key (lambda (note) (accidental-relative-xoffset 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, @@ -684,32 +687,32 @@ 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) +;;; the final relative x offset of that accidental and store it in the note. +(defun compute-final-relative-accidental-xoffset (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)) + (loop for note in notes do (setf (final-relative-accidental-xoffset 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-relative-xoffset))) + (find x notes-with-accidentals :test #'/= :key #'final-relative-note-xoffset))) (when first-suspended-note (setf notes-with-accidentals (remove first-suspended-note notes-with-accidentals)) - (setf (accidental-position first-suspended-note) + (setf (final-relative-accidental-xoffset first-suspended-note) (accidental-min-xoffset first-suspended-note notes staff-step))))) ;; place remaining accidentals (loop while notes-with-accidentals do (let ((choice (best-accidental notes-with-accidentals notes staff-step))) (setf notes-with-accidentals (remove choice notes-with-accidentals)) - (setf (accidental-position choice) + (setf (final-relative-accidental-xoffset choice) (accidental-min-xoffset choice notes staff-step)))))) ;;; given a list of notes, group them so that every note in the group @@ -741,9 +744,9 @@ (score-pane:with-vertical-score-position (pane stem-yoffset) (draw-flags pane element x direction stem-pos))) (loop for group in groups do - (compute-final-relative-xoffsets group direction) + (compute-final-relative-note-xoffsets group direction) (compute-final-accidentals group) - (compute-final-accidental-positions group x direction) + (compute-final-relative-accidental-xoffset group x direction) (draw-notes pane group (dots element) (notehead element)) (draw-ledger-lines pane x group)) (unless (eq (notehead element) :whole) From rstrandh at common-lisp.net Fri Nov 18 19:41:44 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 18 Nov 2005 20:41:44 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051118194144.EABEF88554@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv18752 Modified Files: drawing.lisp Log Message: mostly renaming Date: Fri Nov 18 20:41:44 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.25 gsharp/drawing.lisp:1.26 --- gsharp/drawing.lisp:1.25 Fri Nov 18 18:53:40 2005 +++ gsharp/drawing.lisp Fri Nov 18 20:41:44 2005 @@ -66,14 +66,14 @@ ;;; computed from the x offset of the cluster of the note and the ;;; relative x offset of the note with respect to the cluster. (defun final-absolute-note-xoffset (note) - (+ (element-xpos (cluster note)) (final-relative-note-xoffset note))) + (+ (final-absolute-element-xoffset (cluster note)) (final-relative-note-xoffset note))) ;;; Return the final absolute x offset of the accidental of a note. ;;; This value is computed from the x offset of the cluster of the ;;; note and the relative x offset of the accidental of the note with ;;; respect to the cluster. (defun final-absolute-accidental-xoffset (note) - (+ (element-xpos (cluster note)) (final-relative-accidental-xoffset note))) + (+ (final-absolute-element-xoffset (cluster note)) (final-relative-accidental-xoffset note))) (defun line-cost (measures method) (reduce (lambda (x y) (combine-cost method x y)) measures :initial-value nil)) @@ -199,10 +199,10 @@ ;; the yoffset of the staff that contains the bottom note of ;; the element (bot-note-staff-yoffset :accessor bot-note-staff-yoffset) - (xpos :accessor element-xpos))) + (final-absolute-xoffset :accessor final-absolute-element-xoffset))) (define-added-mixin welement () lyrics-element - ((xpos :accessor element-xpos))) + ((final-absolute-xoffset :accessor final-absolute-element-xoffset))) ;;; given a list of notes, return the one that is at the top (defun top-note (notes) @@ -263,7 +263,7 @@ ;;; Compute and store the final stem direction of an element that is ;;; not beamed together with any other elements. -(defun compute-stem-direction (element) +(defun compute-final-stem-direction (element) (setf (final-stem-direction element) (if (or (eq (stem-direction element) :up) (eq (stem-direction element) :down)) (stem-direction element) @@ -327,7 +327,7 @@ (let (;;(time-alist (time-alist bar)) (start-time 0)) (mapc (lambda (element) - (setf (element-xpos element) + (setf (final-absolute-element-xoffset element) (round (+ x (score-pane:staff-step (xoffset element)) (cdr (assoc start-time time-alist))))) @@ -336,7 +336,7 @@ ;;; Compute and store the final stem directions of all the elements of ;;; a beam group with at least two elements in it. -(defun compute-stem-directions (elements) +(defun compute-final-stem-directions (elements) (let ((stem-direction (if (not (eq (stem-direction (car elements)) :auto)) (stem-direction (car elements)) (let ((top-note-pos (reduce #'max elements :key #'top-note-pos)) @@ -375,8 +375,8 @@ (let ((element (car elements))) (when (or (typep element 'rest) (notes element)) (when (typep element 'cluster) - (compute-stem-direction element)))) - (compute-stem-directions elements))) + (compute-final-stem-direction element)))) + (compute-final-stem-directions elements))) (defun draw-beam-group (pane elements) (mapc #'compute-top-bot-yoffset elements) @@ -384,9 +384,9 @@ (let ((element (car elements))) (when (or (typep element 'rest) (notes element)) (when (typep element 'cluster) - (compute-stem-direction element) + (compute-final-stem-direction element) (compute-stem-length element)) - (draw-element pane element (element-xpos element)))) + (draw-element pane element (final-absolute-element-xoffset element)))) (let* ((stem-direction (final-stem-direction (car elements))) (dominating-notes (mapcar (lambda (e) (dominating-note (notes e) stem-direction)) @@ -399,24 +399,24 @@ (if (eq stem-direction :up) -1000 1000))) dominating-notes)) (x-positions (mapcar (lambda (element) - (/ (element-xpos element) (score-pane:staff-step 1))) + (/ (final-absolute-element-xoffset element) (score-pane:staff-step 1))) elements)) (beaming (beaming-single (mapcar #'list positions x-positions) stem-direction))) (destructuring-bind ((ss1 . offset1) (ss2 . offset2)) beaming (let* ((y1 (+ ss1 (* 1/2 offset1))) (y2 (+ ss2 (* 1/2 offset2))) - (x1 (element-xpos (car elements))) - (x2 (element-xpos (car (last elements)))) + (x1 (final-absolute-element-xoffset (car elements))) + (x2 (final-absolute-element-xoffset (car (last elements)))) (slope (/ (- y2 y1) (- x2 x1)))) (if (eq stem-direction :up) (loop for element in elements do (setf (final-stem-position element) - (+ y1 (* slope (- (element-xpos element) x1)))) + (+ y1 (* slope (- (final-absolute-element-xoffset element) x1)))) (setf (final-stem-yoffset element) (staff-yoffset dominating-staff))) (loop for element in elements do (setf (final-stem-position element) - (+ y1 (* slope (- (element-xpos element) x1)))) + (+ y1 (* slope (- (final-absolute-element-xoffset element) x1)))) (setf (final-stem-yoffset element) (staff-yoffset dominating-staff))))) (score-pane:with-vertical-score-position (pane (staff-yoffset dominating-staff)) @@ -424,15 +424,15 @@ (score-pane:with-notehead-right-offsets (right up) (declare (ignore up)) (score-pane:draw-beam pane - (+ (element-xpos (car elements)) right) ss1 offset1 - (+ (element-xpos (car (last elements))) right) ss2 offset2)) + (+ (final-absolute-element-xoffset (car elements)) right) ss1 offset1 + (+ (final-absolute-element-xoffset (car (last elements))) right) ss2 offset2)) (score-pane:with-notehead-left-offsets (left down) (declare (ignore down)) (score-pane:draw-beam pane - (+ (element-xpos (car elements)) left) ss1 offset1 - (+ (element-xpos (car (last elements))) left) ss2 offset2)))) + (+ (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 (element-xpos element) nil)))))) + (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+)) @@ -461,28 +461,28 @@ (if (null (cursor-element *cursor*)) (funcall draw-cursor (/ (+ (if (null elements) x - (element-xpos (car (last elements)))) + (final-absolute-element-xoffset (car (last elements)))) x width) 2)) (loop for element in elements - and xx = x then (element-xpos element) do + and xx = x then (final-absolute-element-xoffset element) do (when (eq (cursor-element *cursor*) element) - (funcall draw-cursor (/ (+ xx (element-xpos element)) 2)))))))) + (funcall draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2)))))))) (defmethod draw-bar (pane (bar lyrics-bar) x width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) (let ((elements (elements bar))) (loop for element in elements - do (draw-element pane element (element-xpos element))) + 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 - (element-xpos (car (last elements)))) + (final-absolute-element-xoffset (car (last elements)))) x width) 2)) (loop for element in elements - and xx = x then (element-xpos element) do + and xx = x then (final-absolute-element-xoffset element) do (when (eq (cursor-element *cursor*) element) - (funcall draw-cursor (/ (+ xx (element-xpos element)) 2)))))))) + (funcall draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; From rstrandh at common-lisp.net Sat Nov 19 05:16:29 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Sat, 19 Nov 2005 06:16:29 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/measure.lisp gsharp/packages.lisp Message-ID: <20051119051629.DDDFB88554@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv30117 Modified Files: drawing.lisp measure.lisp packages.lisp Log Message: Started moving code from drawing.lisp to measure.lisp in order to prepare for computing physical widths earlier. Date: Sat Nov 19 06:16:28 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.26 gsharp/drawing.lisp:1.27 --- gsharp/drawing.lisp:1.26 Fri Nov 18 20:41:44 2005 +++ gsharp/drawing.lisp Sat Nov 19 06:16:28 2005 @@ -204,36 +204,6 @@ (define-added-mixin welement () lyrics-element ((final-absolute-xoffset :accessor final-absolute-element-xoffset))) -;;; 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. @@ -492,12 +462,6 @@ (defmethod note-difference ((note1 note) (note2 note)) (- (pitch note1) (pitch note2))) - -(defmethod note-position ((note note)) - (let ((clef (clef (staff note)))) - (+ (- (pitch note) - (ecase (name clef) (:treble 32) (:bass 24) (:c 35))) - (lineno clef)))) (defun draw-ledger-lines (pane x notes) (score-pane:with-vertical-score-position (pane (staff-yoffset (staff (car notes)))) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.8 gsharp/measure.lisp:1.9 --- gsharp/measure.lisp:1.8 Fri Nov 18 02:59:27 2005 +++ gsharp/measure.lisp Sat Nov 19 06:16:28 2005 @@ -8,6 +8,13 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Staff + +(define-added-mixin rstaff () staff + ((rank :accessor staff-rank))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; Note (defrclass rnote note @@ -54,6 +61,42 @@ (declare (ignore dots)) (mark-modified element)) +(defmethod note-position ((note note)) + (let ((clef (clef (staff note)))) + (+ (- (pitch note) + (ecase (name clef) (:treble 32) (:bass 24) (:c 35))) + (lineno clef)))) + +;;; given a list of notes, return the one that is at the top +(defun top-note (notes) + (reduce (lambda (n1 n2) + (cond ((< (staff-rank (staff n1)) + (staff-rank (staff n2))) + n1) + ((> (staff-rank (staff n1)) + (staff-rank (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-rank (staff n1)) + (staff-rank (staff n2))) + n1) + ((< (staff-rank (staff n1)) + (staff-rank (staff n2))) + n2) + ((< (note-position n1) + (note-position n2)) + n1) + (t n2))) + notes)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Cluster @@ -369,6 +412,10 @@ (defmethod recompute-measures ((buffer rbuffer)) (when (modified-p buffer) + ;; number the staves + (loop for staff in (staves buffer) + for i from 0 + do (setf (staff-rank staff) i)) ;; for now, invalidate everything (mapc #'adjust-lowpos-highpos (segments buffer)) ;; initialize cost method from buffer-specific style parameters Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.27 gsharp/packages.lisp:1.28 --- gsharp/packages.lisp:1.27 Mon Nov 14 15:27:32 2005 +++ gsharp/packages.lisp Sat Nov 19 06:16:28 2005 @@ -100,7 +100,9 @@ #:recompute-measures #:measure-cost-method #:make-measure-cost-method #:buffer-cost-method #:reduced-width #:natural-width #:compress-factor - #:measure-seq-cost)) + #:measure-seq-cost + #:note-position + #:top-note #:bot-note)) (defpackage :gsharp-postscript (:use :clim :clim-lisp) From rstrandh at common-lisp.net Sat Nov 19 21:59:26 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Sat, 19 Nov 2005 22:59:26 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051119215926.EFB75880D7@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv6376 Modified Files: drawing.lisp Log Message: Be more precise when computing beam groups. It is now possible to have a rest or an empty cluster in the middle of a beam group. Date: Sat Nov 19 22:59:26 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.27 gsharp/drawing.lisp:1.28 --- gsharp/drawing.lisp:1.27 Sat Nov 19 06:16:28 2005 +++ gsharp/drawing.lisp Sat Nov 19 22:59:25 2005 @@ -214,8 +214,9 @@ (bot-note (bot-note (notes element)))) (setf (top-note-pos element) (note-position top-note) (bot-note-pos element) (note-position bot-note))) - (setf (top-note-pos element) 4 - (bot-note-pos element) 4))) +;; (setf (top-note-pos element) 4 +;; (bot-note-pos element) 4) + )) ;;; Compute and store several important pieces of information ;;; about an element: @@ -304,13 +305,24 @@ (incf start-time (duration element))) (elements bar)))) +;;; Return true if and only if the element is a non-empty cluster +(defun non-empty-custer-p (element) + (and (typep element 'cluster) + (not (null (notes element))))) + ;;; Compute and store the final stem directions of all the elements of ;;; a beam group with at least two elements in it. (defun compute-final-stem-directions (elements) (let ((stem-direction (if (not (eq (stem-direction (car elements)) :auto)) (stem-direction (car elements)) - (let ((top-note-pos (reduce #'max elements :key #'top-note-pos)) - (bot-note-pos (reduce #'min elements :key #'bot-note-pos))) + (let ((top-note-pos + (loop for element in elements + when (non-empty-custer-p element) + maximize (top-note-pos element))) + (bot-note-pos + (loop for element in elements + when (non-empty-custer-p element) + minimize (top-note-pos element)))) (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up))))) (loop for element in elements do (setf (final-stem-direction element) stem-direction)))) @@ -359,8 +371,9 @@ (draw-element pane element (final-absolute-element-xoffset element)))) (let* ((stem-direction (final-stem-direction (car elements))) (dominating-notes - (mapcar (lambda (e) (dominating-note (notes e) stem-direction)) - elements)) + (loop for element in elements + when (non-empty-custer-p element) + collect (dominating-note (notes element) stem-direction))) (dominating-staff (staff (dominating-note dominating-notes stem-direction))) (positions (mapcar (lambda (n) @@ -408,17 +421,35 @@ (draw-line* pane x (- (score-pane:staff-step -4)) x (- (score-pane:staff-step 12)) :ink +red+)) ;;; Given a list of the elements of a bar, return a list of beam -;;; groups, where each beam group is a list of elements that are -;;; beamed together +;;; groups. A beam group is defined to be either a singleton list or +;;; a list with more than one element. In the case of a singleton, +;;; the element is either a non-cluster, an empty cluster, a cluster +;;; that does not beam to the right, or a cluster that does beam to +;;; the right, but either it is the last cluster in the bar, or the +;;; first following cluster in the bar does not beam to the left. In +;;; the case of a list with more than one element, the first element +;;; is a cluster that beams to the right, the last element is a +;;; cluster that beams to the left, and all other clusters in the list +;;; beam both to the left and to the right. Notice that in the last +;;; case, elements other than the first and the last can be +;;; non-clusters, or empty clusters. (defun beam-groups (elements) (let ((group '())) - (loop while (not (null elements)) do - (setf group '()) - (push (pop elements) group) - (loop while (and (not (null elements)) - (> (rbeams (car group)) 0) - (> (lbeams (car elements)) 0)) - do (push (pop elements) group)) + (loop until (null elements) do + (setf group (list (car elements)) + elements (cdr elements)) + (when (and (non-empty-custer-p (car group)) + (plusp (rbeams (car group)))) + (loop while (and (not (null elements)) + (or (not (typep (car elements) 'cluster)) + (null (notes (car elements))) + (plusp (lbeams (car elements))))) + do (push (pop elements) group) + until (and (non-empty-custer-p (car group)) + (zerop (rbeams (car group))))) + ;; pop off trailing unbeamable objects + (loop until (non-empty-custer-p (car group)) + do (push (pop group) elements))) collect (nreverse group)))) (defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) From rstrandh at common-lisp.net Sat Nov 19 23:00:00 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Sun, 20 Nov 2005 00:00:00 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051119230000.7D50E880D7@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv10771 Modified Files: drawing.lisp Log Message: Moved final stem direction and final top- and bottom positions to a cluster mixin. Renamed some parameters to correspond to a more specific type. Added asserts for documentation and to simplify debugging. Fixed spelling errors, most of which were caused by automatic completion. Date: Sat Nov 19 23:59:59 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.28 gsharp/drawing.lisp:1.29 --- gsharp/drawing.lisp:1.28 Sat Nov 19 22:59:25 2005 +++ gsharp/drawing.lisp Sat Nov 19 23:59:59 2005 @@ -181,42 +181,41 @@ buffer))))) (define-added-mixin velement () melody-element - ((final-stem-direction :accessor final-stem-direction) - ;; the position, in staff steps, of the end of the stem + (;; 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) ;; 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 note in the element. - (bot-note-pos :accessor bot-note-pos) ;; the yoffset of the staff that contains the top note of ;; the element (top-note-staff-yoffset :accessor top-note-staff-yoffset) - ;; the position, in staff steps, of the top not in the element. - (top-note-pos :accessor top-note-pos) ;; the yoffset of the staff that contains the bottom note of ;; the element (bot-note-staff-yoffset :accessor bot-note-staff-yoffset) (final-absolute-xoffset :accessor final-absolute-element-xoffset))) +(define-added-mixin vcluster () cluster + ((final-stem-direction :accessor final-stem-direction) + ;; the position, in staff steps, of the top not in the element. + (top-note-pos :accessor top-note-pos) + ;; the position, in staff steps, of the bottom note in the element. + (bot-note-pos :accessor bot-note-pos))) + (define-added-mixin welement () lyrics-element ((final-absolute-xoffset :accessor final-absolute-element-xoffset))) -;;; Compute and store several important pieces of information -;;; about an element: +;;; Compute and store some important information about a non-empty +;;; cluster: ;;; * the position, in staff steps of the top note. ;;; * the position, in staff steps of the bottom note. -(defun compute-top-bot-pos (element) - (if (and (typep element 'cluster) (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))) -;; (setf (top-note-pos element) 4 -;; (bot-note-pos element) 4) - )) +(defun compute-top-bot-pos (cluster) + (assert (non-empty-cluster-p cluster)) + (let ((top-note (top-note (notes cluster))) + (bot-note (bot-note (notes cluster)))) + (setf (top-note-pos cluster) (note-position top-note) + (bot-note-pos cluster) (note-position bot-note)))) ;;; Compute and store several important pieces of information ;;; about an element: @@ -232,14 +231,15 @@ (top-note-staff-yoffset element) 0 (bot-note-staff-yoffset element) 0))) -;;; Compute and store the final stem direction of an element that is -;;; not beamed together with any other elements. -(defun compute-final-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 (top-note-pos element)) - (bot-note-pos (bot-note-pos element))) +;;; Given a non-empty cluster that is not beamed together with any +;;; other clusters, compute and store its final stem direction. +(defun compute-final-stem-direction (cluster) + (assert (non-empty-cluster-p cluster)) + (setf (final-stem-direction cluster) + (if (or (eq (stem-direction cluster) :up) (eq (stem-direction cluster) :down)) + (stem-direction cluster) + (let ((top-note-pos (top-note-pos cluster)) + (bot-note-pos (bot-note-pos cluster))) (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down @@ -306,25 +306,27 @@ (elements bar)))) ;;; Return true if and only if the element is a non-empty cluster -(defun non-empty-custer-p (element) +(defun non-empty-cluster-p (element) (and (typep element 'cluster) (not (null (notes element))))) -;;; Compute and store the final stem directions of all the elements of -;;; a beam group with at least two elements in it. +;;; Given a beam group containing at least two nonempty clusters, +;;; compute and store the final stem directions of all the non-empty +;;; clusters in the group (defun compute-final-stem-directions (elements) (let ((stem-direction (if (not (eq (stem-direction (car elements)) :auto)) (stem-direction (car elements)) (let ((top-note-pos (loop for element in elements - when (non-empty-custer-p element) + when (non-empty-cluster-p element) maximize (top-note-pos element))) (bot-note-pos (loop for element in elements - when (non-empty-custer-p element) + when (non-empty-cluster-p element) minimize (top-note-pos element)))) (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up))))) (loop for element in elements + when (non-empty-cluster-p element) do (setf (final-stem-direction element) stem-direction)))) ;;; the dominating note among a bunch of notes is the @@ -348,16 +350,16 @@ (if (< (pitch n1) (pitch n2)) n1 n2)))))) notes)) -;;; Given a list of elements to be beamed together, for each element, -;;; compute the top and bottom note position, and the final stem -;;; direction. +;;; Given a beam group, for each nonempty element, compute the top and +;;; bottom note position, and the final stem direction. (defun compute-positions-and-stem-direction (elements) - (mapc #'compute-top-bot-pos elements) + (loop for element in elements + when (non-empty-cluster-p element) + do (compute-top-bot-pos element)) (if (null (cdr elements)) (let ((element (car elements))) - (when (or (typep element 'rest) (notes element)) - (when (typep element 'cluster) - (compute-final-stem-direction element)))) + (when (non-empty-cluster-p element) + (compute-final-stem-direction element))) (compute-final-stem-directions elements))) (defun draw-beam-group (pane elements) @@ -365,14 +367,14 @@ (if (null (cdr elements)) (let ((element (car elements))) (when (or (typep element 'rest) (notes element)) - (when (typep element 'cluster) + (when (non-empty-cluster-p element) (compute-final-stem-direction element) (compute-stem-length element)) (draw-element pane element (final-absolute-element-xoffset element)))) (let* ((stem-direction (final-stem-direction (car elements))) (dominating-notes (loop for element in elements - when (non-empty-custer-p element) + when (non-empty-cluster-p element) collect (dominating-note (notes element) stem-direction))) (dominating-staff (staff (dominating-note dominating-notes stem-direction))) @@ -438,17 +440,17 @@ (loop until (null elements) do (setf group (list (car elements)) elements (cdr elements)) - (when (and (non-empty-custer-p (car group)) + (when (and (non-empty-cluster-p (car group)) (plusp (rbeams (car group)))) (loop while (and (not (null elements)) (or (not (typep (car elements) 'cluster)) (null (notes (car elements))) (plusp (lbeams (car elements))))) do (push (pop elements) group) - until (and (non-empty-custer-p (car group)) + until (and (non-empty-cluster-p (car group)) (zerop (rbeams (car group))))) ;; pop off trailing unbeamable objects - (loop until (non-empty-custer-p (car group)) + (loop until (non-empty-cluster-p (car group)) do (push (pop group) elements))) collect (nreverse group)))) @@ -730,7 +732,7 @@ ;;; 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) + (unless (null (notes element)) (let ((direction (final-stem-direction element)) (stem-pos (final-stem-position element)) (stem-yoffset (final-stem-yoffset element)) From rstrandh at common-lisp.net Sun Nov 20 19:17:24 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Sun, 20 Nov 2005 20:17:24 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp gsharp/packages.lisp Message-ID: <20051120191724.3977C88554@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv3313 Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Patch to allow the current note to be deleted. (thanks to Robert J. Macomber) Date: Sun Nov 20 20:17:22 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.26 gsharp/buffer.lisp:1.27 --- gsharp/buffer.lisp:1.26 Wed Nov 16 02:27:34 2005 +++ gsharp/buffer.lisp Sun Nov 20 20:17:22 2005 @@ -352,6 +352,24 @@ (setf notes (delete note notes :test #'eq))) (setf cluster nil))) +(defun lower-bound (bound list &key (test #'<)) + "Return the `largest' element in the sorted list LIST such that +\(TEST element BOUND) is true." + (let ((last nil)) + (dolist (item list) + (unless (funcall test item bound) + (return-from lower-bound last)) + (setf last item)) + last)) + +(defmethod cluster-lower-bound ((cluster cluster) (bound note)) + (with-slots (notes) cluster + (lower-bound bound notes :test #'note-less))) + +(defmethod cluster-upper-bound ((cluster cluster) (bound note)) + (with-slots (notes) cluster + (lower-bound bound (reverse notes) :test (complement #'note-less)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Rest Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.43 gsharp/gui.lisp:1.44 --- gsharp/gui.lisp:1.43 Mon Nov 14 21:26:14 2005 +++ gsharp/gui.lisp Sun Nov 20 20:17:22 2005 @@ -812,6 +812,19 @@ (add-note cluster new-note) (setf *current-note* new-note))) +(define-gsharp-command com-remove-current-note () + (let ((cluster (cur-cluster)) + (note (cur-note))) + (when note + (remove-note note) + ;; try to set current-note to the highest note lower than the + ;; removed note. If that fails, to the lowest note higher than + ;; it. + (setf *current-note* (or (cluster-lower-bound cluster note) + (cluster-upper-bound cluster note))) + (unless *current-note* + (com-erase-element))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; motion by element Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.28 gsharp/packages.lisp:1.29 --- gsharp/packages.lisp:1.28 Sat Nov 19 06:16:28 2005 +++ gsharp/packages.lisp Sun Nov 20 20:17:22 2005 @@ -45,6 +45,7 @@ #:notehead #:rbeams #:lbeams #:dots #:element #:melody-element #:notes #:add-note #:find-note #:remove-note + #:cluster-upper-bound #:cluster-lower-bound #:cluster #:make-cluster #:rest #:make-rest #:lyrics-element #:make-lyrics-element From rstrandh at common-lisp.net Mon Nov 21 00:45:23 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 21 Nov 2005 01:45:23 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/measure.lisp gsharp/packages.lisp Message-ID: <20051121004523.8C75C88554@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv27569 Modified Files: drawing.lisp measure.lisp packages.lisp Log Message: Moved some more code from drawing.lisp to measure.lisp Date: Mon Nov 21 01:45:22 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.29 gsharp/drawing.lisp:1.30 --- gsharp/drawing.lisp:1.29 Sat Nov 19 23:59:59 2005 +++ gsharp/drawing.lisp Mon Nov 21 01:45:14 2005 @@ -197,26 +197,11 @@ (final-absolute-xoffset :accessor final-absolute-element-xoffset))) (define-added-mixin vcluster () cluster - ((final-stem-direction :accessor final-stem-direction) - ;; the position, in staff steps, of the top not in the element. - (top-note-pos :accessor top-note-pos) - ;; the position, in staff steps, of the bottom note in the element. - (bot-note-pos :accessor bot-note-pos))) + ((final-stem-direction :accessor final-stem-direction))) (define-added-mixin welement () lyrics-element ((final-absolute-xoffset :accessor final-absolute-element-xoffset))) -;;; Compute and store some important information about a non-empty -;;; cluster: -;;; * the position, in staff steps of the top note. -;;; * the position, in staff steps of the bottom note. -(defun compute-top-bot-pos (cluster) - (assert (non-empty-cluster-p cluster)) - (let ((top-note (top-note (notes cluster))) - (bot-note (bot-note (notes cluster)))) - (setf (top-note-pos cluster) (note-position top-note) - (bot-note-pos cluster) (note-position bot-note)))) - ;;; Compute and store several important pieces of information ;;; about an element: ;;; * the y-offset of the staff containing the top note. @@ -305,11 +290,6 @@ (incf start-time (duration element))) (elements bar)))) -;;; Return true if and only if the element is a non-empty cluster -(defun non-empty-cluster-p (element) - (and (typep element 'cluster) - (not (null (notes element))))) - ;;; Given a beam group containing at least two nonempty clusters, ;;; compute and store the final stem directions of all the non-empty ;;; clusters in the group @@ -353,9 +333,9 @@ ;;; Given a beam group, for each nonempty element, compute the top and ;;; bottom note position, and the final stem direction. (defun compute-positions-and-stem-direction (elements) - (loop for element in elements - when (non-empty-cluster-p element) - do (compute-top-bot-pos element)) +;; (loop for element in elements +;; when (non-empty-cluster-p element) +;; do (compute-top-bot-pos element)) (if (null (cdr elements)) (let ((element (car elements))) (when (non-empty-cluster-p element) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.9 gsharp/measure.lisp:1.10 --- gsharp/measure.lisp:1.9 Sat Nov 19 06:16:28 2005 +++ gsharp/measure.lisp Mon Nov 21 01:45:18 2005 @@ -101,6 +101,26 @@ ;;; ;;; Cluster +(define-added-mixin rcluster () cluster + (;; the position, in staff steps, of the top not in the element. + (top-note-pos :accessor top-note-pos) + ;; the position, in staff steps, of the bottom note in the element. + (bot-note-pos :accessor bot-note-pos))) + +;;; Return true if and only if the element is a non-empty cluster +(defun non-empty-cluster-p (element) + (and (typep element 'cluster) + (not (null (notes element))))) + +;;; Compute and store some important information about a non-empty +;;; cluster: +;;; * the position, in staff steps of the top note. +;;; * the position, in staff steps of the bottom note. +(defun compute-top-bot-pos (cluster) + (assert (non-empty-cluster-p cluster)) + (setf (top-note-pos cluster) (note-position (top-note (notes cluster))) + (bot-note-pos cluster) (note-position (bot-note (notes cluster))))) + (defmethod add-note :after ((element relement) (note note)) (mark-modified element)) @@ -288,6 +308,23 @@ (append (merge 'list (butlast bar1) (butlast bar2) #'<) (list (max (car (last bar1)) (car (last bar2)))))) +;;; compute some important parameters of an element +(defgeneric compute-element-parameters (element)) + +(defmethod compute-element-parameters (element) + nil) + +(defmethod compute-element-parameters ((element cluster)) + (when (non-empty-cluster-p element) + (compute-top-bot-pos element))) + +;;; compute some important parameters of a bar +(defun compute-bar-parameters (bar) + (loop for element in (elements bar) + do (when (modified-p element) + (compute-element-parameters element) + (setf (modified-p element) nil)))) + ;;; From a list of simultaneous bars (and some other stuff), create a ;;; measure. The `other stuff' is the spacing style, which is neded ;;; in order to compute the coefficient of the measure, the position @@ -297,6 +334,10 @@ ;;; to indicate the position of the measure in the sequence of all ;;; measures of the buffer. (defun compute-measure (bars spacing-style seg-pos bar-pos) + (loop for bar in bars + do (when (modified-p bar) + (compute-bar-parameters bar) + (setf (modified-p bar) nil))) (let* ((start-times (remove-duplicates (reduce #'combine-bars (mapcar #'start-times bars)))) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.29 gsharp/packages.lisp:1.30 --- gsharp/packages.lisp:1.29 Sun Nov 20 20:17:22 2005 +++ gsharp/packages.lisp Mon Nov 21 01:45:18 2005 @@ -102,8 +102,8 @@ #:buffer-cost-method #:reduced-width #:natural-width #:compress-factor #:measure-seq-cost - #:note-position - #:top-note #:bot-note)) + #:note-position #:non-empty-cluster-p + #:top-note #:bot-note #:top-note-pos #:bot-note-pos)) (defpackage :gsharp-postscript (:use :clim :clim-lisp) From rstrandh at common-lisp.net Mon Nov 21 02:11:10 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 21 Nov 2005 03:11:10 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/measure.lisp gsharp/packages.lisp Message-ID: <20051121021110.72B048855F@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv1737 Modified Files: drawing.lisp measure.lisp packages.lisp Log Message: moved computation of final stem direction from drawing.lisp to measure.lisp Date: Mon Nov 21 03:11:09 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.30 gsharp/drawing.lisp:1.31 --- gsharp/drawing.lisp:1.30 Mon Nov 21 01:45:14 2005 +++ gsharp/drawing.lisp Mon Nov 21 03:11:08 2005 @@ -196,9 +196,6 @@ (bot-note-staff-yoffset :accessor bot-note-staff-yoffset) (final-absolute-xoffset :accessor final-absolute-element-xoffset))) -(define-added-mixin vcluster () cluster - ((final-stem-direction :accessor final-stem-direction))) - (define-added-mixin welement () lyrics-element ((final-absolute-xoffset :accessor final-absolute-element-xoffset))) @@ -216,20 +213,6 @@ (top-note-staff-yoffset element) 0 (bot-note-staff-yoffset element) 0))) -;;; Given a non-empty cluster that is not beamed together with any -;;; other clusters, compute and store its final stem direction. -(defun compute-final-stem-direction (cluster) - (assert (non-empty-cluster-p cluster)) - (setf (final-stem-direction cluster) - (if (or (eq (stem-direction cluster) :up) (eq (stem-direction cluster) :down)) - (stem-direction cluster) - (let ((top-note-pos (top-note-pos cluster)) - (bot-note-pos (bot-note-pos cluster))) - (if (>= (- top-note-pos 4) - (- 4 bot-note-pos)) - :down - :up))))) - (defun compute-stem-length (element) (let* ((top-note-pos (top-note-pos element)) (bot-note-pos (bot-note-pos element)) @@ -290,25 +273,6 @@ (incf start-time (duration element))) (elements bar)))) -;;; Given a beam group containing at least two nonempty clusters, -;;; compute and store the final stem directions of all the non-empty -;;; clusters in the group -(defun compute-final-stem-directions (elements) - (let ((stem-direction (if (not (eq (stem-direction (car elements)) :auto)) - (stem-direction (car elements)) - (let ((top-note-pos - (loop for element in elements - when (non-empty-cluster-p element) - maximize (top-note-pos element))) - (bot-note-pos - (loop for element in elements - when (non-empty-cluster-p element) - minimize (top-note-pos element)))) - (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up))))) - (loop for element in elements - when (non-empty-cluster-p element) - do (setf (final-stem-direction element) stem-direction)))) - ;;; 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 @@ -330,25 +294,12 @@ (if (< (pitch n1) (pitch n2)) n1 n2)))))) notes)) -;;; Given a beam group, for each nonempty element, compute the top and -;;; bottom note position, and the final stem direction. -(defun compute-positions-and-stem-direction (elements) -;; (loop for element in elements -;; when (non-empty-cluster-p element) -;; do (compute-top-bot-pos element)) - (if (null (cdr elements)) - (let ((element (car elements))) - (when (non-empty-cluster-p element) - (compute-final-stem-direction element))) - (compute-final-stem-directions elements))) - (defun draw-beam-group (pane elements) (mapc #'compute-top-bot-yoffset elements) (if (null (cdr elements)) (let ((element (car elements))) (when (or (typep element 'rest) (notes element)) (when (non-empty-cluster-p element) - (compute-final-stem-direction element) (compute-stem-length element)) (draw-element pane element (final-absolute-element-xoffset element)))) (let* ((stem-direction (final-stem-direction (car elements))) @@ -402,43 +353,10 @@ (defun draw-cursor (pane x) (draw-line* pane x (- (score-pane:staff-step -4)) x (- (score-pane:staff-step 12)) :ink +red+)) -;;; Given a list of the elements of a bar, return a list of beam -;;; groups. A beam group is defined to be either a singleton list or -;;; a list with more than one element. In the case of a singleton, -;;; the element is either a non-cluster, an empty cluster, a cluster -;;; that does not beam to the right, or a cluster that does beam to -;;; the right, but either it is the last cluster in the bar, or the -;;; first following cluster in the bar does not beam to the left. In -;;; the case of a list with more than one element, the first element -;;; is a cluster that beams to the right, the last element is a -;;; cluster that beams to the left, and all other clusters in the list -;;; beam both to the left and to the right. Notice that in the last -;;; case, elements other than the first and the last can be -;;; non-clusters, or empty clusters. -(defun beam-groups (elements) - (let ((group '())) - (loop until (null elements) do - (setf group (list (car elements)) - elements (cdr elements)) - (when (and (non-empty-cluster-p (car group)) - (plusp (rbeams (car group)))) - (loop while (and (not (null elements)) - (or (not (typep (car elements) 'cluster)) - (null (notes (car elements))) - (plusp (lbeams (car elements))))) - do (push (pop elements) group) - until (and (non-empty-cluster-p (car group)) - (zerop (rbeams (car group))))) - ;; pop off trailing unbeamable objects - (loop until (non-empty-cluster-p (car group)) - do (push (pop group) elements))) - collect (nreverse group)))) - (defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) (loop for group in (beam-groups (elements bar)) - do (compute-positions-and-stem-direction group) - (draw-beam-group pane group)) + do (draw-beam-group pane group)) (when (eq (cursor-bar *cursor*) bar) (let ((elements (elements bar))) (if (null (cursor-element *cursor*)) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.10 gsharp/measure.lisp:1.11 --- gsharp/measure.lisp:1.10 Mon Nov 21 01:45:18 2005 +++ gsharp/measure.lisp Mon Nov 21 03:11:08 2005 @@ -102,7 +102,8 @@ ;;; Cluster (define-added-mixin rcluster () cluster - (;; the position, in staff steps, of the top not in the element. + ((final-stem-direction :accessor final-stem-direction) + ;; the position, in staff steps, of the top not in the element. (top-note-pos :accessor top-note-pos) ;; the position, in staff steps, of the bottom note in the element. (bot-note-pos :accessor bot-note-pos))) @@ -128,6 +129,39 @@ (when (cluster note) (mark-modified (cluster note)))) +;;; Given a non-empty cluster that is not beamed together with any +;;; other clusters, compute and store its final stem direction. +(defun compute-final-stem-direction (cluster) + (assert (non-empty-cluster-p cluster)) + (setf (final-stem-direction cluster) + (if (or (eq (stem-direction cluster) :up) (eq (stem-direction cluster) :down)) + (stem-direction cluster) + (let ((top-note-pos (top-note-pos cluster)) + (bot-note-pos (bot-note-pos cluster))) + (if (>= (- top-note-pos 4) + (- 4 bot-note-pos)) + :down + :up))))) + +;;; Given a beam group containing at least two nonempty clusters, +;;; compute and store the final stem directions of all the non-empty +;;; clusters in the group +(defun compute-final-stem-directions (elements) + (let ((stem-direction (if (not (eq (stem-direction (car elements)) :auto)) + (stem-direction (car elements)) + (let ((top-note-pos + (loop for element in elements + when (non-empty-cluster-p element) + maximize (top-note-pos element))) + (bot-note-pos + (loop for element in elements + when (non-empty-cluster-p element) + minimize (top-note-pos element)))) + (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up))))) + (loop for element in elements + when (non-empty-cluster-p element) + do (setf (final-stem-direction element) stem-direction)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Rest @@ -318,12 +352,60 @@ (when (non-empty-cluster-p element) (compute-top-bot-pos element))) +(defun compute-beam-group-parameters (elements) + (let ((any-element-modified nil)) + (loop for element in elements + do (when (modified-p element) + (compute-element-parameters element) + (setf any-element-modified t) + (setf (modified-p element) nil))) + (when any-element-modified + (if (null (cdr elements)) + (when (non-empty-cluster-p (car elements)) + (compute-final-stem-direction (car elements))) + (compute-final-stem-directions elements))))) + +;;; Given a list of the elements of a bar, return a list of beam +;;; groups. A beam group is defined to be either a singleton list or +;;; a list with more than one element. In the case of a singleton, +;;; the element is either a non-cluster, an empty cluster, a cluster +;;; that does not beam to the right, or a cluster that does beam to +;;; the right, but either it is the last cluster in the bar, or the +;;; first following cluster in the bar does not beam to the left. In +;;; the case of a list with more than one element, the first element +;;; is a cluster that beams to the right, the last element is a +;;; cluster that beams to the left, and all other clusters in the list +;;; beam both to the left and to the right. Notice that in the last +;;; case, elements other than the first and the last can be +;;; non-clusters, or empty clusters. +(defun beam-groups (elements) + (let ((group '())) + (loop until (null elements) do + (setf group (list (car elements)) + elements (cdr elements)) + (when (and (non-empty-cluster-p (car group)) + (plusp (rbeams (car group)))) + (loop while (and (not (null elements)) + (or (not (typep (car elements) 'cluster)) + (null (notes (car elements))) + (plusp (lbeams (car elements))))) + do (push (pop elements) group) + until (and (non-empty-cluster-p (car group)) + (zerop (rbeams (car group))))) + ;; pop off trailing unbeamable objects + (loop until (non-empty-cluster-p (car group)) + do (push (pop group) elements))) + collect (nreverse group)))) + ;;; compute some important parameters of a bar -(defun compute-bar-parameters (bar) - (loop for element in (elements bar) - do (when (modified-p element) - (compute-element-parameters element) - (setf (modified-p element) nil)))) +(defgeneric compute-bar-parameters (bar)) + +(defmethod compute-bar-parameter (bar) + nil) + +(defmethod compute-bar-parameters ((bar melody-bar)) + (loop for group in (beam-groups (elements bar)) + do (compute-beam-group-parameters group))) ;;; From a list of simultaneous bars (and some other stuff), create a ;;; measure. The `other stuff' is the spacing style, which is neded Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.30 gsharp/packages.lisp:1.31 --- gsharp/packages.lisp:1.30 Mon Nov 21 01:45:18 2005 +++ gsharp/packages.lisp Mon Nov 21 03:11:08 2005 @@ -103,7 +103,8 @@ #:reduced-width #:natural-width #:compress-factor #:measure-seq-cost #:note-position #:non-empty-cluster-p - #:top-note #:bot-note #:top-note-pos #:bot-note-pos)) + #:top-note #:bot-note #:top-note-pos #:bot-note-pos + #:beam-groups #:final-stem-direction)) (defpackage :gsharp-postscript (:use :clim :clim-lisp) From rstrandh at common-lisp.net Mon Nov 21 20:37:46 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 21 Nov 2005 21:37:46 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/gsharp.asd gsharp/measure.lisp gsharp/packages.lisp Message-ID: <20051121203746.E477888556@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv20469 Modified Files: drawing.lisp gsharp.asd measure.lisp packages.lisp Log Message: moved the computation of relative x offsets of notes from drawing.lisp to measure.lisp. This required some reorganization of packages.lisp and gsharp.asd as well. Date: Mon Nov 21 21:37:45 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.31 gsharp/drawing.lisp:1.32 --- gsharp/drawing.lisp:1.31 Mon Nov 21 03:11:08 2005 +++ gsharp/drawing.lisp Mon Nov 21 21:37:45 2005 @@ -4,9 +4,7 @@ ((yoffset :initform 0 :accessor staff-yoffset))) (define-added-mixin dnote () note - (;; the relative x offset of the note with respect to the cluster - (final-relative-note-xoffset :accessor final-relative-note-xoffset) - (final-accidental :initform nil :accessor final-accidental) + ((final-accidental :initform nil :accessor final-accidental) ;; The relative x offset of the accidental of the note with respect ;; to the cluster. A value of nil indicates that accidental has ;; not been placed yet @@ -433,36 +431,6 @@ (loop for note in notes do (draw-note pane note notehead dots (final-absolute-note-xoffset 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-relative-note-xoffsets (group 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-relative-note-xoffset (car group)) 0) - ;; 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-relative-note-xoffset note) dx) - ;; go back to ordinary offset - (when (= (abs (- pos old-pos)) 1) - (setf note old-note)))))) - ;;; Given a list of notes to be displayed on the same staff line, for ;;; each note, compute the accidental to be displayed as a function of ;;; the accidentals of the note and the key signature of the staff. @@ -610,15 +578,6 @@ (setf (final-relative-accidental-xoffset choice) (accidental-min-xoffset 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 - (push (remove (staff (car notes)) notes :test-not #'eq :key #'staff) groups) - (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. @@ -639,7 +598,6 @@ (score-pane:with-vertical-score-position (pane stem-yoffset) (draw-flags pane element x direction stem-pos))) (loop for group in groups do - (compute-final-relative-note-xoffsets group direction) (compute-final-accidentals group) (compute-final-relative-accidental-xoffset group x direction) (draw-notes pane group (dots element) (notehead element)) Index: gsharp/gsharp.asd diff -u gsharp/gsharp.asd:1.1 gsharp/gsharp.asd:1.2 --- gsharp/gsharp.asd:1.1 Tue Nov 1 18:19:51 2005 +++ gsharp/gsharp.asd Mon Nov 21 21:37:45 2005 @@ -27,13 +27,13 @@ "gf" "sdl" "charmap" + "score-pane" "buffer" "numbering" "Obseq/obseq" "measure" "postscript" "glyphs" - "score-pane" "beaming" "drawing" "cursor" Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.11 gsharp/measure.lisp:1.12 --- gsharp/measure.lisp:1.11 Mon Nov 21 03:11:08 2005 +++ gsharp/measure.lisp Mon Nov 21 21:37:45 2005 @@ -18,7 +18,17 @@ ;;; Note (defrclass rnote note - ()) + (;; the relative x offset of the note with respect to the cluster + (final-relative-note-xoffset :accessor final-relative-note-xoffset))) + +;;; 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 + (push (remove (staff (car notes)) notes :test-not #'eq :key #'staff) groups) + (setf notes (remove (staff (car notes)) notes :test #'eq :key #'staff))) + groups)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -342,6 +352,39 @@ (append (merge 'list (butlast bar1) (butlast bar2) #'<) (list (max (car (last bar1)) (car (last bar2)))))) +;;; 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-relative-note-xoffsets (group 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-relative-note-xoffset (car group)) 0) + ;; 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-relative-note-xoffset note) dx) + ;; go back to ordinary offset + (when (= (abs (- pos old-pos)) 1) + (setf note old-note)))))) + +(defun compute-staff-group-parameters (staff-group stem-direction) + (compute-final-relative-note-xoffsets staff-group stem-direction)) + ;;; compute some important parameters of an element (defgeneric compute-element-parameters (element)) @@ -350,20 +393,26 @@ (defmethod compute-element-parameters ((element cluster)) (when (non-empty-cluster-p element) - (compute-top-bot-pos element))) + (compute-top-bot-pos element) + (loop for staff-group in (group-notes-by-staff (notes element)) + do (compute-staff-group-parameters staff-group (final-stem-direction element))))) (defun compute-beam-group-parameters (elements) (let ((any-element-modified nil)) (loop for element in elements do (when (modified-p element) - (compute-element-parameters element) - (setf any-element-modified t) - (setf (modified-p element) nil))) + (when (non-empty-cluster-p element) + (compute-top-bot-pos element)) + (setf any-element-modified t))) (when any-element-modified (if (null (cdr elements)) (when (non-empty-cluster-p (car elements)) (compute-final-stem-direction (car elements))) - (compute-final-stem-directions elements))))) + (compute-final-stem-directions elements))) + (loop for element in elements + do (when (modified-p element) + (compute-element-parameters element) + (setf (modified-p element) nil))))) ;;; Given a list of the elements of a bar, return a list of beam ;;; groups. A beam group is defined to be either a singleton list or @@ -416,18 +465,19 @@ ;;; to indicate the position of the measure in the sequence of all ;;; measures of the buffer. (defun compute-measure (bars spacing-style seg-pos bar-pos) - (loop for bar in bars - do (when (modified-p bar) - (compute-bar-parameters bar) - (setf (modified-p bar) nil))) - (let* ((start-times (remove-duplicates - (reduce #'combine-bars - (mapcar #'start-times bars)))) - (durations (abs-rel start-times)) - (min-dist (reduce #'min durations)) - (coeff (loop for duration in durations - sum (expt duration spacing-style)))) - (make-measure min-dist coeff start-times seg-pos bar-pos bars))) + (score-pane:with-staff-size 6 + (loop for bar in bars + do (when (modified-p bar) + (compute-bar-parameters bar) + (setf (modified-p bar) nil))) + (let* ((start-times (remove-duplicates + (reduce #'combine-bars + (mapcar #'start-times bars)))) + (durations (abs-rel start-times)) + (min-dist (reduce #'min durations)) + (coeff (loop for duration in durations + sum (expt duration spacing-style)))) + (make-measure min-dist coeff start-times seg-pos bar-pos bars)))) ;;; Compute all the measures of a segment by stepping through all the ;;; bars in parallel as long as there is at least one simultaneous bar. Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.31 gsharp/packages.lisp:1.32 --- gsharp/packages.lisp:1.31 Mon Nov 21 03:11:08 2005 +++ gsharp/packages.lisp Mon Nov 21 21:37:45 2005 @@ -1,3 +1,16 @@ +(defpackage :esa + (:use :clim-lisp :clim) + (:export #:minibuffer-pane #:display-message + #:esa-pane-mixin #:previous-command + #:info-pane #:master-pane + #:esa-frame-mixin #:windows #:recordingp #:executingp + #:*numeric-argument-p* #:*current-gesture* + #:esa-top-level #:simple-command-loop + #:global-esa-table #:keyboard-macro-table + #:help-table + #:set-key + #:find-applicable-command-table)) + (defpackage :gsharp-utilities (:shadow built-in-class) (:use :clim-lisp :clim-mop) @@ -33,6 +46,20 @@ #:+glyph-flags-up-two+ #:+glyph-flags-up-three+ #:+glyph-flags-up-four+ #:+glyph-flags-up-five+)) +(defpackage :score-pane + (:use :clim :clim-extensions :clim-lisp :sdl :esa) + (:shadow #:rest) + (:export #:draw-fiveline-staff #:draw-lyrics-staff + #:draw-stem #:draw-right-stem #:draw-left-stem + #:draw-ledger-line #:draw-bar-line #:draw-beam #:staff-step + #:draw-notehead #:draw-accidental #:draw-clef #:draw-rest #:draw-dot + #:draw-flags-up #:draw-flags-down + #:with-score-pane #:with-vertical-score-position + #:with-staff-size #:with-notehead-right-offsets + #:with-suspended-note-offset + #:with-notehead-left-offsets #:with-light-glyphs #:score-pane + #:clef #:staff #:fiveline-staff #:lyrics-staff #:notehead)) + (defpackage :gsharp-buffer (:use :common-lisp :gsharp-utilities) (:shadow #:rest) @@ -104,7 +131,8 @@ #:measure-seq-cost #:note-position #:non-empty-cluster-p #:top-note #:bot-note #:top-note-pos #:bot-note-pos - #:beam-groups #:final-stem-direction)) + #:beam-groups #:final-stem-direction + #:group-notes-by-staff #:final-relative-note-xoffset)) (defpackage :gsharp-postscript (:use :clim :clim-lisp) @@ -131,33 +159,6 @@ #:8th-flag-down #:extend-flag-down #:whole-rest #:half-rest #:quarter-rest #:8th-rest #:16th-rest #:32nd-rest #:64th-rest #:128th-rest #:measure-rest #:double-whole-rest)) - -(defpackage :esa - (:use :clim-lisp :clim) - (:export #:minibuffer-pane #:display-message - #:esa-pane-mixin #:previous-command - #:info-pane #:master-pane - #:esa-frame-mixin #:windows #:recordingp #:executingp - #:*numeric-argument-p* #:*current-gesture* - #:esa-top-level #:simple-command-loop - #:global-esa-table #:keyboard-macro-table - #:help-table - #:set-key - #:find-applicable-command-table)) - -(defpackage :score-pane - (:use :clim :clim-extensions :clim-lisp :sdl :esa) - (:shadow #:rest) - (:export #:draw-fiveline-staff #:draw-lyrics-staff - #:draw-stem #:draw-right-stem #:draw-left-stem - #:draw-ledger-line #:draw-bar-line #:draw-beam #:staff-step - #:draw-notehead #:draw-accidental #:draw-clef #:draw-rest #:draw-dot - #:draw-flags-up #:draw-flags-down - #:with-score-pane #:with-vertical-score-position - #:with-staff-size #:with-notehead-right-offsets - #:with-suspended-note-offset - #:with-notehead-left-offsets #:with-light-glyphs #:score-pane - #:clef #:staff #:fiveline-staff #:lyrics-staff #:notehead)) (defpackage :gsharp-beaming (:use :common-lisp) From rstrandh at common-lisp.net Mon Nov 21 22:18:39 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 21 Nov 2005 23:18:39 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/measure.lisp gsharp/packages.lisp Message-ID: <20051121221839.5C6BD88545@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv28766 Modified Files: drawing.lisp measure.lisp packages.lisp Log Message: moved the computation of the final accidental (determine whether one should be displayed or not according to the key signature) from drawing.lisp to measure.lisp. Date: Mon Nov 21 23:18:38 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.32 gsharp/drawing.lisp:1.33 --- gsharp/drawing.lisp:1.32 Mon Nov 21 21:37:45 2005 +++ gsharp/drawing.lisp Mon Nov 21 23:18:37 2005 @@ -4,8 +4,7 @@ ((yoffset :initform 0 :accessor staff-yoffset))) (define-added-mixin dnote () note - ((final-accidental :initform nil :accessor final-accidental) - ;; The relative x offset of the accidental of the note with respect + (;; The relative x offset of the accidental of the note with respect ;; to the cluster. A value of nil indicates that accidental has ;; not been placed yet (final-relative-accidental-xoffset :initform nil @@ -431,17 +430,6 @@ (loop for note in notes do (draw-note pane note notehead dots (final-absolute-note-xoffset note) (note-position note)))) -;;; Given a list of notes to be displayed on the same staff line, for -;;; each note, compute the accidental to be displayed as a function of -;;; the accidentals of the note and the key signature of the staff. -(defun compute-final-accidentals (group) - (loop for note in group do - (setf (final-accidental note) - (if (eq (accidentals note) - (aref (keysig (staff note)) (mod (pitch note) 7))) - nil - (accidentals note))))) - (defun element-has-suspended-notes (element) (not (apply #'= (mapcar #'final-relative-note-xoffset (notes element))))) @@ -598,7 +586,6 @@ (score-pane:with-vertical-score-position (pane stem-yoffset) (draw-flags pane element x direction stem-pos))) (loop for group in groups do - (compute-final-accidentals group) (compute-final-relative-accidental-xoffset group x direction) (draw-notes pane group (dots element) (notehead element)) (draw-ledger-lines pane x group)) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.12 gsharp/measure.lisp:1.13 --- gsharp/measure.lisp:1.12 Mon Nov 21 21:37:45 2005 +++ gsharp/measure.lisp Mon Nov 21 23:18:37 2005 @@ -18,7 +18,8 @@ ;;; Note (defrclass rnote note - (;; the relative x offset of the note with respect to the cluster + ((final-accidental :initform nil :accessor final-accidental) + ;; the relative x offset of the note with respect to the cluster (final-relative-note-xoffset :accessor final-relative-note-xoffset))) ;;; given a list of notes, group them so that every note in the group @@ -172,6 +173,17 @@ when (non-empty-cluster-p element) do (setf (final-stem-direction element) stem-direction)))) +;;; Given a list of notes to be displayed on the same staff line, for +;;; each note, compute the accidental to be displayed as a function of +;;; the accidentals of the note and the key signature of the staff. +(defun compute-final-accidentals (group) + (loop for note in group do + (setf (final-accidental note) + (if (eq (accidentals note) + (aref (keysig (staff note)) (mod (pitch note) 7))) + nil + (accidentals note))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Rest @@ -383,7 +395,8 @@ (setf note old-note)))))) (defun compute-staff-group-parameters (staff-group stem-direction) - (compute-final-relative-note-xoffsets staff-group stem-direction)) + (compute-final-relative-note-xoffsets staff-group stem-direction) + (compute-final-accidentals staff-group)) ;;; compute some important parameters of an element (defgeneric compute-element-parameters (element)) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.32 gsharp/packages.lisp:1.33 --- gsharp/packages.lisp:1.32 Mon Nov 21 21:37:45 2005 +++ gsharp/packages.lisp Mon Nov 21 23:18:37 2005 @@ -132,7 +132,8 @@ #:note-position #:non-empty-cluster-p #:top-note #:bot-note #:top-note-pos #:bot-note-pos #:beam-groups #:final-stem-direction - #:group-notes-by-staff #:final-relative-note-xoffset)) + #:group-notes-by-staff #:final-relative-note-xoffset + #:final-accidental)) (defpackage :gsharp-postscript (:use :clim :clim-lisp) From rstrandh at common-lisp.net Mon Nov 21 22:40:50 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 21 Nov 2005 23:40:50 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/measure.lisp gsharp/packages.lisp Message-ID: <20051121224050.2BB1388545@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv30080 Modified Files: drawing.lisp measure.lisp packages.lisp Log Message: Move the computation of final relative accidental x offsets from drawing.lisp to measure.lisp. Date: Mon Nov 21 23:40:49 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.33 gsharp/drawing.lisp:1.34 --- gsharp/drawing.lisp:1.33 Mon Nov 21 23:18:37 2005 +++ gsharp/drawing.lisp Mon Nov 21 23:40:48 2005 @@ -3,13 +3,6 @@ (define-added-mixin dstaff () staff ((yoffset :initform 0 :accessor staff-yoffset))) -(define-added-mixin dnote () note - (;; The relative x offset of the accidental of the note with respect - ;; to the cluster. A value of nil indicates that accidental has - ;; not been placed yet - (final-relative-accidental-xoffset :initform nil - :accessor final-relative-accidental-xoffset))) - (define-presentation-method present (object (type score-pane:clef) stream (view textual-view) &key) (format stream "[~a clef on staff step ~a]" (name object) (lineno object))) @@ -433,139 +426,6 @@ (defun element-has-suspended-notes (element) (not (apply #'= (mapcar #'final-relative-note-xoffset (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 - ( 0 0 0 3.5 3.5 3.5 3.5 3.5 3.5 1 0) ; notehead - flat - ( 0 3.5 3.5 3.5 3.5 3.5 3.5 3.5 1 1 0) ; notehead - natural - ( 0 3.5 3.5 3.5 3.5 3.5 3.5 3.5 1 1 0) ; notehead - sharp - ( 0 0 0 3.5 3.5 3.5 3.5 3.5 0 0 0)) ; notehead - dbl sharp - (( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) ; dbl flat - dbl flat - ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) ; dbl flat - flat - ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) ; dbl flat - natural - ( 4 4 4 4 4 4 4 4 4 3.5 0) ; dbl flat - sharp - ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 0 0 0)) ; dbl flat - dbl sharp - (( 2 2 2 2 2 2 2 2 1.5 1 0) ; flat - dbl flat - ( 2 2 2 2 2 2 2 2 1.5 1 0) ; flat - flat - ( 2 2 2 2 2 2 2 2 1.5 1 0) ; flat - natural - ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 1.5 0) ; flat - sharp - ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 0 0 0)) ; flat - dbl sharp - (( 2 2 2 2 2 2 2 2 2 1.5 1.5) ; natural - dbl flat - ( 2 2 2 2 2 2 2 2 2 1.5 1.5) ; natural - flat - ( 2 2 2 2 2 2 2 2 2 1.5 1.5) ; natural - natural - ( 2 2 2 2 2 2 2 2 2 2 2) ; natural - sharp - ( 2 2 2 2 2 2 2 2 1 1 1)) ; natural - dbl sharp - (( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) ; sharp - dbl flat - ( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) ; sharp - flat - ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) ; sharp - natural - ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 2.0) ; sharp - sharp - ( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 0 0)) ; sharp - dbl sharp - (( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) ; dbl sharp - dbl flat - ( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) ; dbl sharp - flat - ( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) ; dbl sharp - natural - ( 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) - 0 - (aref *accidental-offset* - (ecase acc2 - (:notehead 0) - (:double-flat 1) - (:flat 2) - (:natural 3) - (:sharp 4) - (:double-sharp 5)) - (ecase acc1 - (:double-flat 0) - (:flat 1) - (:natural 2) - (:sharp 3) - (: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. -(defun accidental-relative-xoffset (note1 note2 staff-step) - (let* ((acc1 (final-accidental note1)) - (pos1 (note-position note1)) - (acc2 (if (and (final-accidental note2) - (final-relative-accidental-xoffset note2)) - (final-accidental note2) - :notehead)) - (pos2 (note-position note2)) - (xpos2 (or (final-relative-accidental-xoffset note2) - (final-relative-note-xoffset 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. -(defun accidental-min-xoffset (note1 notes staff-step) - (reduce #'min notes :key (lambda (note) (accidental-relative-xoffset 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-xoffset note1 notes staff-step) - (accidental-min-xoffset note2 notes staff-step)) - note1 - note2)) - notes-with-accidentals)) - -;;; for each note in a list of notes, if it has an accidental, compute -;;; the final relative x offset of that accidental and store it in the note. -(defun compute-final-relative-accidental-xoffset (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 (final-relative-accidental-xoffset 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-relative-note-xoffset))) - (when first-suspended-note - (setf notes-with-accidentals - (remove first-suspended-note notes-with-accidentals)) - (setf (final-relative-accidental-xoffset first-suspended-note) - (accidental-min-xoffset first-suspended-note notes staff-step))))) - ;; place remaining accidentals - (loop while notes-with-accidentals - do (let ((choice (best-accidental notes-with-accidentals notes staff-step))) - (setf notes-with-accidentals - (remove choice notes-with-accidentals)) - (setf (final-relative-accidental-xoffset choice) - (accidental-min-xoffset choice notes staff-step)))))) - ;;; draw a cluster. The stem direction and the stem position have ;;; already been computed. ;;; 1. Group notes by staff. @@ -586,7 +446,6 @@ (score-pane:with-vertical-score-position (pane stem-yoffset) (draw-flags pane element x direction stem-pos))) (loop for group in groups do - (compute-final-relative-accidental-xoffset group x direction) (draw-notes pane group (dots element) (notehead element)) (draw-ledger-lines pane x group)) (unless (eq (notehead element) :whole) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.13 gsharp/measure.lisp:1.14 --- gsharp/measure.lisp:1.13 Mon Nov 21 23:18:37 2005 +++ gsharp/measure.lisp Mon Nov 21 23:40:48 2005 @@ -18,7 +18,12 @@ ;;; Note (defrclass rnote note - ((final-accidental :initform nil :accessor final-accidental) + (;; The relative x offset of the accidental of the note with respect + ;; to the cluster. A value of nil indicates that accidental has + ;; not been placed yet + (final-relative-accidental-xoffset :initform nil + :accessor final-relative-accidental-xoffset) + (final-accidental :initform nil :accessor final-accidental) ;; the relative x offset of the note with respect to the cluster (final-relative-note-xoffset :accessor final-relative-note-xoffset))) @@ -184,6 +189,139 @@ nil (accidentals note))))) +;;; 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 + ( 0 0 0 3.5 3.5 3.5 3.5 3.5 3.5 1 0) ; notehead - flat + ( 0 3.5 3.5 3.5 3.5 3.5 3.5 3.5 1 1 0) ; notehead - natural + ( 0 3.5 3.5 3.5 3.5 3.5 3.5 3.5 1 1 0) ; notehead - sharp + ( 0 0 0 3.5 3.5 3.5 3.5 3.5 0 0 0)) ; notehead - dbl sharp + (( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) ; dbl flat - dbl flat + ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) ; dbl flat - flat + ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) ; dbl flat - natural + ( 4 4 4 4 4 4 4 4 4 3.5 0) ; dbl flat - sharp + ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 0 0 0)) ; dbl flat - dbl sharp + (( 2 2 2 2 2 2 2 2 1.5 1 0) ; flat - dbl flat + ( 2 2 2 2 2 2 2 2 1.5 1 0) ; flat - flat + ( 2 2 2 2 2 2 2 2 1.5 1 0) ; flat - natural + ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 1.5 0) ; flat - sharp + ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 0 0 0)) ; flat - dbl sharp + (( 2 2 2 2 2 2 2 2 2 1.5 1.5) ; natural - dbl flat + ( 2 2 2 2 2 2 2 2 2 1.5 1.5) ; natural - flat + ( 2 2 2 2 2 2 2 2 2 1.5 1.5) ; natural - natural + ( 2 2 2 2 2 2 2 2 2 2 2) ; natural - sharp + ( 2 2 2 2 2 2 2 2 1 1 1)) ; natural - dbl sharp + (( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) ; sharp - dbl flat + ( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) ; sharp - flat + ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) ; sharp - natural + ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 2.0) ; sharp - sharp + ( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 0 0)) ; sharp - dbl sharp + (( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) ; dbl sharp - dbl flat + ( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) ; dbl sharp - flat + ( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) ; dbl sharp - natural + ( 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) + 0 + (aref *accidental-offset* + (ecase acc2 + (:notehead 0) + (:double-flat 1) + (:flat 2) + (:natural 3) + (:sharp 4) + (:double-sharp 5)) + (ecase acc1 + (:double-flat 0) + (:flat 1) + (:natural 2) + (:sharp 3) + (: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. +(defun accidental-relative-xoffset (note1 note2 staff-step) + (let* ((acc1 (final-accidental note1)) + (pos1 (note-position note1)) + (acc2 (if (and (final-accidental note2) + (final-relative-accidental-xoffset note2)) + (final-accidental note2) + :notehead)) + (pos2 (note-position note2)) + (xpos2 (or (final-relative-accidental-xoffset note2) + (final-relative-note-xoffset 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. +(defun accidental-min-xoffset (note1 notes staff-step) + (reduce #'min notes :key (lambda (note) (accidental-relative-xoffset 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-xoffset note1 notes staff-step) + (accidental-min-xoffset note2 notes staff-step)) + note1 + note2)) + notes-with-accidentals)) + +;;; for each note in a list of notes, if it has an accidental, compute +;;; the final relative x offset of that accidental and store it in the note. +(defun compute-final-relative-accidental-xoffset (notes 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 (final-relative-accidental-xoffset 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 0 notes-with-accidentals :test #'/= :key #'final-relative-note-xoffset))) + (when first-suspended-note + (setf notes-with-accidentals + (remove first-suspended-note notes-with-accidentals)) + (setf (final-relative-accidental-xoffset first-suspended-note) + (accidental-min-xoffset first-suspended-note notes staff-step))))) + ;; place remaining accidentals + (loop while notes-with-accidentals + do (let ((choice (best-accidental notes-with-accidentals notes staff-step))) + (setf notes-with-accidentals + (remove choice notes-with-accidentals)) + (setf (final-relative-accidental-xoffset choice) + (accidental-min-xoffset choice notes staff-step)))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Rest @@ -396,7 +534,8 @@ (defun compute-staff-group-parameters (staff-group stem-direction) (compute-final-relative-note-xoffsets staff-group stem-direction) - (compute-final-accidentals staff-group)) + (compute-final-accidentals staff-group) + (compute-final-relative-accidental-xoffset staff-group stem-direction)) ;;; compute some important parameters of an element (defgeneric compute-element-parameters (element)) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.33 gsharp/packages.lisp:1.34 --- gsharp/packages.lisp:1.33 Mon Nov 21 23:18:37 2005 +++ gsharp/packages.lisp Mon Nov 21 23:40:48 2005 @@ -133,7 +133,7 @@ #:top-note #:bot-note #:top-note-pos #:bot-note-pos #:beam-groups #:final-stem-direction #:group-notes-by-staff #:final-relative-note-xoffset - #:final-accidental)) + #:final-accidental #:final-relative-accidental-xoffset)) (defpackage :gsharp-postscript (:use :clim :clim-lisp) From crhodes at common-lisp.net Mon Nov 21 12:19:45 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Mon, 21 Nov 2005 13:19:45 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Scores/rapsoden-sjunger.gsh Message-ID: <20051121121945.AE64D88545@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Scores In directory common-lisp.net:/tmp/cvs-serv16314 Modified Files: rapsoden-sjunger.gsh Log Message: Adjust rapsoden-sjunger to cope with the new semibreve rest. (Make some other minor changes to rest vertical positions: I don't know whether the original positions were meant to reflect some notated score, but the ones I've put in look better to me...) Date: Mon Nov 21 13:19:44 2005 Author: crhodes Index: gsharp/Scores/rapsoden-sjunger.gsh diff -u gsharp/Scores/rapsoden-sjunger.gsh:1.3 gsharp/Scores/rapsoden-sjunger.gsh:1.4 --- gsharp/Scores/rapsoden-sjunger.gsh:1.3 Thu Aug 5 07:54:36 2004 +++ gsharp/Scores/rapsoden-sjunger.gsh Mon Nov 21 13:19:44 2005 @@ -1,369 +1,3 @@ G#V3 -[B :staves (#1=[= :name "two" :clef [K :name :TREBLE :lineno 2 ] :keysig #(:FLAT - :FLAT - :FLAT - :NATURAL - :FLAT - :FLAT - :FLAT) ] - #2=[= :name "one" :clef [K :name :BASS :lineno 6 ] :keysig #(:FLAT - :FLAT - :FLAT - :NATURAL - :FLAT - :FLAT - :FLAT) ] ) :segments ([S :layers ([_ :name "one" :staves (#1#) :head [/ :bars ([| :elements NIL ] ) ] :body [/ :bars ([| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :xoffset 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :xoffset 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 35 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 35 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :xoffset 0 :stem-direction :UP :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 41 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 39 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 39 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 41 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 43 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 45 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 44 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 43 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 41 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 41 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 35 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 42 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 41 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 35 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 42 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 35 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 39 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 36 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 41 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 39 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 39 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 39 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 26 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 25 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 23 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :xoffset 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] - [_ :name "two" :staves (#1#) :head [/ :bars ([| :elements NIL ] ) ] :body [/ :bars ([| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos 0 ] ) ] - [| :elements ([- :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos 0 ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -4 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 27 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -4 ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos 0 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -2 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -2 ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos 0 ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -4 ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -2 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -4 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -6 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 28 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -12 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #1# :head :HALF :accidentals :FLAT :dots 0 ] - [N :pitch 27 :staff #1# :head :HALF :accidentals :FLAT :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -4 ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -6 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 28 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -6 ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -4 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] - [_ :name "three" :staves (#2#) :head [/ :bars ([| :elements NIL ] ) ] :body [/ :bars ([| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :xoffset 0 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 29 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 31 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 30 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 29 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :xoffset 0 :stem-direction :UP :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 28 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 28 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :xoffset 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 21 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 17 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 17 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 16 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 14 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 13 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 16 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 21 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 17 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 21 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 21 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :AUTO :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 13 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 17 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 21 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 14 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 16 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 21 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 14 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 17 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 4 ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 16 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :xoffset 0 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :xoffset 0 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] - [_ :name "four" :staves (#2#) :head [/ :bars ([| :elements NIL ] ) ] :body [/ :bars ([| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 2 ] ) ] - [| :elements ([- :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 4 ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 0 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 16 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 0 ] ) ] - [| :elements ([- :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 0 ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 2 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 2 ] ) ] - [| :elements ([- :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 0 ] ) ] - [| :elements ([- :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 0 ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 0 ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset -3 :stem-direction :AUTO :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 0 ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset -3 :stem-direction :AUTO :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 0 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] - [N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 0 ] ) ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements NIL ] - [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 0 ] - [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 0 ] ) ] - [| :elements ([- :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #2# :staff-pos 0 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 :left-margin 20 ] +[B :staves (#1=[= :name "two" :clef [K :name :TREBLE :lineno 2 ] :keysig #(:FLAT :FLAT :FLAT :NATURAL :FLAT :FLAT :FLAT) ] #2=[= :name "one" :clef [K :name :BASS :lineno 6 ] :keysig #(:FLAT :FLAT :FLAT :NATURAL :FLAT :FLAT :FLAT) ] ) :segments ([S :layers ([_ :name "one" :staves (#1#) :head [/ :bars ([| :elements NIL ] ) ] :body [/ :bars ([| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 35 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 35 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :UP :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 41 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 39 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :AUTO :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 39 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :AUTO :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 41 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 43 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 45 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 44 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 43 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :AUTO :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 41 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :AUTO :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 41 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 35 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 42 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 41 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 35 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 42 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 35 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 39 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 36 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 41 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 39 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 40 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 39 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 39 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 38 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 37 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 36 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 26 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 25 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([N :pitch 23 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 33 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] [_ :name "two" :staves (#1#) :head [/ :bars ([| :elements NIL ] ) ] :body [/ :bars ([| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos 0 ] ) ] [| :elements ([- :xoffset 0 :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -2 ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -4 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 27 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -4 ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos 0 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 34 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 32 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -2 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -2 ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos 0 ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -4 ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -2 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -4 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -6 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 28 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements NIL ] [| :elements NIL ] [| :elements NIL ] [| :elements NIL ] [| :elements NIL ] [| :elements NIL ] [| :elements NIL ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -12 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #1# :head :HALF :accidentals :FLAT :dots 0 ] [N :pitch 27 :staff #1# :head :HALF :accidentals :FLAT :dots 0 ] ) ] [- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -4 ] ) ] [| :elements ([% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 30 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -6 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 28 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -6 ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos -4 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] [_ :name "three" :staves (#2#) :head [/ :bars ([| :elements NIL ] ) ] :body [/ :bars ([| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 29 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 31 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 30 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 29 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :UP :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 28 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 28 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 21 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 17 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 17 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 16 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 14 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 13 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 16 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 21 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 17 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 21 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 21 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 13 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 17 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 21 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 14 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 16 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 21 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 14 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 17 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :staff #2# :staff-pos 4 ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 16 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 18 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 27 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 22 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :DOWN :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :UP :notes ([N :pitch 24 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :UP :notes ([N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] [_ :name "four" :staves (#2#) :head [/ :bars ([| :elements NIL ] ) ] :body [/ :bars ([| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] ) ] [| :elements ([- :xoffset 0 :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 16 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 20 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] ) ] [| :elements ([- :xoffset 0 :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 23 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] ) ] [| :elements ([- :xoffset 0 :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] ) ] [| :elements ([- :xoffset 0 :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] [% :xoffset -3 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] [% :xoffset -3 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 25 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 15 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] ) ] [| :elements NIL ] [| :elements NIL ] [| :elements NIL ] [| :elements NIL ] [| :elements NIL ] [| :elements NIL ] [| :elements NIL ] [| :elements NIL ] [| :elements NIL ] [| :elements ([- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] [% :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #2# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [- :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] ) ] [| :elements ([- :xoffset 0 :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :staff #2# :staff-pos 0 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 :left-margin 20 ] From rstrandh at common-lisp.net Sat Nov 26 21:30:46 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Sat, 26 Nov 2005 22:30:46 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp Message-ID: <20051126213046.57C3D880D5@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv11943 Modified Files: gui.lisp Log Message: Invalidated elements of layers using a staff that has its key signature altered. Date: Sat Nov 26 22:30:43 2005 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.44 gsharp/gui.lisp:1.45 --- gsharp/gui.lisp:1.44 Sun Nov 20 20:17:22 2005 +++ gsharp/gui.lisp Sat Nov 26 22:30:13 2005 @@ -1089,39 +1089,59 @@ (layer (layer (cursor *application-frame*)))) (remove-staff-from-layer staff layer))) +(defun invalidate-slice-using-staff (slice staff) + (declare (ignore staff)) ; maybe use this later + (loop for bar in (bars slice) + do (loop for element in (elements bar) + do (mark-modified element)))) + (define-gsharp-command com-more-sharps () - (let ((keysig (keysig (car (staves (layer (cursor *application-frame*))))))) - (cond ((eq (aref keysig 3) :flat) (setf (aref keysig 3) :natural)) - ((eq (aref keysig 0) :flat) (setf (aref keysig 0) :natural)) - ((eq (aref keysig 4) :flat) (setf (aref keysig 4) :natural)) - ((eq (aref keysig 1) :flat) (setf (aref keysig 1) :natural)) - ((eq (aref keysig 5) :flat) (setf (aref keysig 5) :natural)) - ((eq (aref keysig 2) :flat) (setf (aref keysig 2) :natural)) - ((eq (aref keysig 6) :flat) (setf (aref keysig 6) :natural)) - ((eq (aref keysig 3) :natural) (setf (aref keysig 3) :sharp)) - ((eq (aref keysig 0) :natural) (setf (aref keysig 0) :sharp)) - ((eq (aref keysig 4) :natural) (setf (aref keysig 4) :sharp)) - ((eq (aref keysig 1) :natural) (setf (aref keysig 1) :sharp)) - ((eq (aref keysig 5) :natural) (setf (aref keysig 5) :sharp)) - ((eq (aref keysig 2) :natural) (setf (aref keysig 2) :sharp)) - ((eq (aref keysig 6) :natural) (setf (aref keysig 6) :sharp))))) + (let ((staff (car (staves (layer (cursor *application-frame*)))))) + (loop for segment in (segments (buffer *application-frame*)) + do (loop for layer in (layers segment) + do (when (member staff (staves layer)) + (invalidate-slice-using-staff (head layer) staff) + (invalidate-slice-using-staff (body layer) staff) + (invalidate-slice-using-staff (tail layer) staff)))) + (let ((keysig (keysig staff))) + (cond ((eq (aref keysig 3) :flat) (setf (aref keysig 3) :natural)) + ((eq (aref keysig 0) :flat) (setf (aref keysig 0) :natural)) + ((eq (aref keysig 4) :flat) (setf (aref keysig 4) :natural)) + ((eq (aref keysig 1) :flat) (setf (aref keysig 1) :natural)) + ((eq (aref keysig 5) :flat) (setf (aref keysig 5) :natural)) + ((eq (aref keysig 2) :flat) (setf (aref keysig 2) :natural)) + ((eq (aref keysig 6) :flat) (setf (aref keysig 6) :natural)) + ((eq (aref keysig 3) :natural) (setf (aref keysig 3) :sharp)) + ((eq (aref keysig 0) :natural) (setf (aref keysig 0) :sharp)) + ((eq (aref keysig 4) :natural) (setf (aref keysig 4) :sharp)) + ((eq (aref keysig 1) :natural) (setf (aref keysig 1) :sharp)) + ((eq (aref keysig 5) :natural) (setf (aref keysig 5) :sharp)) + ((eq (aref keysig 2) :natural) (setf (aref keysig 2) :sharp)) + ((eq (aref keysig 6) :natural) (setf (aref keysig 6) :sharp)))))) (define-gsharp-command com-more-flats () - (let ((keysig (keysig (car (staves (layer (cursor *application-frame*))))))) - (cond ((eq (aref keysig 6) :sharp) (setf (aref keysig 6) :natural)) - ((eq (aref keysig 2) :sharp) (setf (aref keysig 2) :natural)) - ((eq (aref keysig 5) :sharp) (setf (aref keysig 5) :natural)) - ((eq (aref keysig 1) :sharp) (setf (aref keysig 1) :natural)) - ((eq (aref keysig 4) :sharp) (setf (aref keysig 4) :natural)) - ((eq (aref keysig 0) :sharp) (setf (aref keysig 0) :natural)) - ((eq (aref keysig 3) :sharp) (setf (aref keysig 3) :natural)) - ((eq (aref keysig 6) :natural) (setf (aref keysig 6) :flat)) - ((eq (aref keysig 2) :natural) (setf (aref keysig 2) :flat)) - ((eq (aref keysig 5) :natural) (setf (aref keysig 5) :flat)) - ((eq (aref keysig 1) :natural) (setf (aref keysig 1) :flat)) - ((eq (aref keysig 4) :natural) (setf (aref keysig 4) :flat)) - ((eq (aref keysig 0) :natural) (setf (aref keysig 0) :flat)) - ((eq (aref keysig 3) :natural) (setf (aref keysig 3) :flat))))) + (let ((staff (car (staves (layer (cursor *application-frame*)))))) + (loop for segment in (segments (buffer *application-frame*)) + do (loop for layer in (layers segment) + do (when (member staff (staves layer)) + (invalidate-slice-using-staff (head layer) staff) + (invalidate-slice-using-staff (body layer) staff) + (invalidate-slice-using-staff (tail layer) staff)))) + (let ((keysig (keysig staff))) + (cond ((eq (aref keysig 6) :sharp) (setf (aref keysig 6) :natural)) + ((eq (aref keysig 2) :sharp) (setf (aref keysig 2) :natural)) + ((eq (aref keysig 5) :sharp) (setf (aref keysig 5) :natural)) + ((eq (aref keysig 1) :sharp) (setf (aref keysig 1) :natural)) + ((eq (aref keysig 4) :sharp) (setf (aref keysig 4) :natural)) + ((eq (aref keysig 0) :sharp) (setf (aref keysig 0) :natural)) + ((eq (aref keysig 3) :sharp) (setf (aref keysig 3) :natural)) + ((eq (aref keysig 6) :natural) (setf (aref keysig 6) :flat)) + ((eq (aref keysig 2) :natural) (setf (aref keysig 2) :flat)) + ((eq (aref keysig 5) :natural) (setf (aref keysig 5) :flat)) + ((eq (aref keysig 1) :natural) (setf (aref keysig 1) :flat)) + ((eq (aref keysig 4) :natural) (setf (aref keysig 4) :flat)) + ((eq (aref keysig 0) :natural) (setf (aref keysig 0) :flat)) + ((eq (aref keysig 3) :natural) (setf (aref keysig 3) :flat)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; From rstrandh at common-lisp.net Sun Nov 27 23:44:02 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 28 Nov 2005 00:44:02 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Flexichain/flexichain-package.lisp gsharp/Flexichain/flexichain.asd gsharp/Flexichain/flexirank.lisp Message-ID: <20051127234402.39F2588554@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv32139 Modified Files: flexichain-package.lisp flexichain.asd flexirank.lisp Log Message: Added two more functions (flexi-next and flexi-prev) to flexirank. Date: Mon Nov 28 00:44:00 2005 Author: rstrandh Index: gsharp/Flexichain/flexichain-package.lisp diff -u gsharp/Flexichain/flexichain-package.lisp:1.4 gsharp/Flexichain/flexichain-package.lisp:1.5 --- gsharp/Flexichain/flexichain-package.lisp:1.4 Wed Nov 16 04:06:59 2005 +++ gsharp/Flexichain/flexichain-package.lisp Mon Nov 28 00:43:50 2005 @@ -37,5 +37,6 @@ #:move> #:move< #:insert #:insert-sequence #:element< #:element> #:delete< #:delete> - #:flexirank-mixin #:element-rank-mixin #:rank)) + #:flexirank-mixin #:element-rank-mixin #:rank + #:flexi-next #:flexi-prev)) Index: gsharp/Flexichain/flexichain.asd diff -u gsharp/Flexichain/flexichain.asd:1.4 gsharp/Flexichain/flexichain.asd:1.5 --- gsharp/Flexichain/flexichain.asd:1.4 Wed Nov 16 04:06:59 2005 +++ gsharp/Flexichain/flexichain.asd Mon Nov 28 00:43:50 2005 @@ -27,11 +27,11 @@ ;; The tester is not included, for it depends on clim. The stupid ;; implementation has also been left out, since it seems mostly useful ;; for testing. -(defsystem flexichain +(defsystem :flexichain :name "flexichain" :components ((:file "flexichain-package") (:file "utilities" :depends-on ("flexichain-package")) - (:file "flexichain" :depends-on ("utilities")) + (:file "flexichain" :depends-on ("utilities" "flexichain-package")) (:file "flexicursor" :depends-on ("flexichain")) (:file "flexirank" :depends-on ("flexichain")))) Index: gsharp/Flexichain/flexirank.lisp diff -u gsharp/Flexichain/flexirank.lisp:1.1 gsharp/Flexichain/flexirank.lisp:1.2 --- gsharp/Flexichain/flexirank.lisp:1.1 Wed Nov 16 04:06:59 2005 +++ gsharp/Flexichain/flexirank.lisp Mon Nov 28 00:43:50 2005 @@ -28,6 +28,8 @@ ;;; generic function rank. (defgeneric rank (element)) +(defgeneric flexi-next (element)) +(defgeneric flexi-prev (element)) (defclass element-rank-mixin () ((index :accessor index) @@ -35,6 +37,17 @@ (defmethod rank ((element element-rank-mixin)) (index-position (chain element) (index element))) + +(defmethod flexi-next ((element element-rank-mixin)) + (let ((new-rank (1+ (rank element))) + (chain (chain element))) + (assert (< new-rank (nb-elements chain))) + (element* chain new-rank))) + +(defmethod flexi-prev ((element element-rank-mixin)) + (let ((new-rank (1- (rank element)))) + (assert (not (minusp new-rank))) + (element* (chain element) new-rank))) ;;; this class must be mixed into a flexichain that contains ranked elements (defclass flexirank-mixin () ()) From rstrandh at common-lisp.net Mon Nov 28 00:25:59 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 28 Nov 2005 01:25:59 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Flexichain/flexirank.lisp Message-ID: <20051128002559.E4E7A88554@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv2937 Modified Files: flexirank.lisp Log Message: Fixed a bug in the flexirank code. Or, rather, compensated for a quirk in flexichain.lisp that calls move-elements on sentinels. The best way would be to avoid this quirk, but I am not willing to modify the basic flexichain code right now. Date: Mon Nov 28 01:25:59 2005 Author: rstrandh Index: gsharp/Flexichain/flexirank.lisp diff -u gsharp/Flexichain/flexirank.lisp:1.2 gsharp/Flexichain/flexirank.lisp:1.3 --- gsharp/Flexichain/flexirank.lisp:1.2 Mon Nov 28 00:43:50 2005 +++ gsharp/Flexichain/flexirank.lisp Mon Nov 28 01:25:59 2005 @@ -52,10 +52,12 @@ ;;; this class must be mixed into a flexichain that contains ranked elements (defclass flexirank-mixin () ()) -(defmethod move-elements :after ((chain flexirank-mixin) to from start1 start2 end2) +(defmethod move-elements :before ((chain flexirank-mixin) to from start1 start2 end2) (loop for old from start2 below end2 for new from start1 - do (setf (index (aref from old)) new))) + do (let ((element (aref from old))) + (when (typep element 'element-rank-mixin) + (setf (index element) new))))) (defmethod insert* :after ((chain flexirank-mixin) position (object element-rank-mixin)) (setf (index object) (position-index chain position) From rstrandh at common-lisp.net Mon Nov 28 02:32:07 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 28 Nov 2005 03:32:07 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/gsharp.asd gsharp/measure.lisp Message-ID: <20051128023207.C07AA88554@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv12520 Modified Files: gsharp.asd measure.lisp Log Message: Added explicit timelines which will be used for a better spacing algorithm. Date: Mon Nov 28 03:32:06 2005 Author: rstrandh Index: gsharp/gsharp.asd diff -u gsharp/gsharp.asd:1.2 gsharp/gsharp.asd:1.3 --- gsharp/gsharp.asd:1.2 Mon Nov 21 21:37:45 2005 +++ gsharp/gsharp.asd Mon Nov 28 03:32:06 2005 @@ -20,7 +20,7 @@ :defaults *gsharp-directory*)) collect `(:file ,(pathname-name p) :pathname ,p)))))) -(gsharp-defsystem (:gsharp :depends-on (:mcclim)) +(gsharp-defsystem (:gsharp :depends-on (:mcclim :flexichain)) "packages" "esa" "utilities" Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.14 gsharp/measure.lisp:1.15 --- gsharp/measure.lisp:1.14 Mon Nov 21 23:40:48 2005 +++ gsharp/measure.lisp Mon Nov 28 03:32:06 2005 @@ -47,7 +47,8 @@ ;;; modification to the element have taken place in the meantime. (defrclass relement element - ((duration :initform nil))) + ((duration :initform nil) + (timeline :accessor timeline))) (defmethod duration :around ((element relement)) (with-slots (duration) element @@ -380,15 +381,28 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -;;; Measure +;;; Timeline + +;;; A timeline of a measure is the set of all simultaneous elements of +;;; the bars of the meausure. The duration of a timeline is either +;;; the temporal distance between it and the next closest timeline +;;; following it, or, in case it is the last timeline of the measure, +;;; the duration of the longest element of the timeline. + +(defclass timeline (flexichain:element-rank-mixin) + ((start-time :initarg :start-time :reader start-time) + (elements :initform '() :accessor elements) + (duration :initarg :duration :reader duration) + (elasticity :accessor elasticity))) + +(defclass ranked-flexichain (flexichain:standard-flexichain flexichain:flexirank-mixin) + ()) -;;; A measure represents the set of simultaneous bars. Define a -;;; TIMELINE of a measure to be the set of all simultaneous elements -;;; of the bars of the measure. The DURATION of a timeline is either -;;; the temporal distance to the next closest timeline following it, -;;; or, in case it is the last timeline of the measure, the duration -;;; of the longest element of the timeline. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Measure +;;; A measure represents the set of simultaneous bars. (defclass measure (obseq-elem) (;; the smallest duration of any timeline in the measure (min-dist :initarg :min-dist :reader measure-min-dist) @@ -406,7 +420,9 @@ (seg-pos :initarg :seg-pos :reader measure-seg-pos) (bar-pos :initarg :bar-pos :reader measure-bar-pos) ;; a list of the bars that make up this measure - (bars :initarg :bars :reader measure-bars))) + (bars :initarg :bars :reader measure-bars) + ;; the first timeline of the measure, or NIL of there are not timelines + (timelines :initform (make-instance 'ranked-flexichain) :reader timelines))) (defun make-measure (min-dist coeff start-times seg-pos bar-pos bars) (make-instance 'measure :min-dist min-dist :coeff coeff @@ -448,6 +464,7 @@ (defmethod measures :before ((segment rsegment)) (when (modified-p segment) (compute-measures segment (spacing-style (buffer-cost-method (buffer segment)))) + (mapc #'compute-timelines (measures segment)) (setf (modified-p segment) nil))) (defmethod nb-measures ((segment rsegment)) @@ -630,6 +647,30 @@ (coeff (loop for duration in durations sum (expt duration spacing-style)))) (make-measure min-dist coeff start-times seg-pos bar-pos bars)))) + +(defun compute-timelines (measure) + (let ((timelines (timelines measure)) + (start-times (measure-start-times measure))) + ;; create a timeline for each start time of the measure + (loop for start-time in start-times + for duration in (abs-rel start-times) + for i from 0 + do (let ((timeline (make-instance 'timeline + :start-time start-time + :duration duration))) + (flexichain:insert* timelines i timeline))) + ;; link each timeline to its elements and each element of a + ;; timeline to the timeline + (loop for bar in (measure-bars measure) + do (loop for element in (elements bar) + for start-time = 0 then (+ start-time (duration element)) + for timeline-index from 0 + do (loop while (< (start-time (flexichain:element* timelines timeline-index)) + start-time) + do (incf timeline-index)) + do (let ((timeline (flexichain:element* timelines timeline-index))) + (push element (elements timeline)) + (setf (timeline element) timeline)))))) ;;; Compute all the measures of a segment by stepping through all the ;;; bars in parallel as long as there is at least one simultaneous bar. From rstrandh at common-lisp.net Mon Nov 28 04:25:36 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 28 Nov 2005 05:25:36 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/measure.lisp gsharp/packages.lisp Message-ID: <20051128042536.9CC7688554@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv20060 Modified Files: drawing.lisp measure.lisp packages.lisp Log Message: More code towards a better spacing algorithm Date: Mon Nov 28 05:25:35 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.34 gsharp/drawing.lisp:1.35 --- gsharp/drawing.lisp:1.34 Mon Nov 21 23:40:48 2005 +++ gsharp/drawing.lisp Mon Nov 28 05:25:34 2005 @@ -96,6 +96,41 @@ collect (/ (nat-width method (measure-coeff measure) min-dist) compress)))) +(defun compute-elasticities (measures method) + (loop for measure in measures + do (loop with timelines = (timelines measure) + for i from 0 below (flexichain:nb-elements timelines) + for timeline = (flexichain:element* timelines i) + do (setf (elasticity timeline) + (expt (duration timeline) (spacing-style method)))))) + +(defgeneric left-bulge (element pane)) +(defgeneric right-bulge (element pane)) + +(defmethod left-bulge ((element element) pane) + 0) + +(defmethod right-bulge ((element element) pane) + 0) + +(defun compute-gaps (measures method pane) + (declare (ignore method)) + (loop for measure in measures + do (loop for bar in (measure-bars measure) + do (loop for (e1 e2) on (elements bar) + for t1 = (timeline e1) + do (cond ((null e2) + (when (flexichain:flexi-last-p t1) + (setf (smallest-gap t1) + (max (smallest-gap t1) + (right-bulge e1 pane))))) + ((eq (flexichain:flexi-next t1) + (timeline e2)) + (setf (smallest-gap t1) + (max (smallest-gap t1) + (+ (right-bulge e1 pane) + (left-bulge e2 pane)))))))))) + (defun draw-measure (pane measure min-dist compress x method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) compress)) @@ -154,6 +189,8 @@ (let ((yy y)) (gsharp-measure::new-map-over-obseq-subsequences (lambda (measures) + (compute-elasticities measures method) + (compute-gaps measures method pane) (let ((widths (compute-widths measures method))) (score-pane:with-vertical-score-position (pane yy) (draw-system pane measures (+ x (left-offset buffer) timesig-offset) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.15 gsharp/measure.lisp:1.16 --- gsharp/measure.lisp:1.15 Mon Nov 28 03:32:06 2005 +++ gsharp/measure.lisp Mon Nov 28 05:25:34 2005 @@ -48,7 +48,7 @@ (defrclass relement element ((duration :initform nil) - (timeline :accessor timeline))) + (timeline :accessor timeline))) (defmethod duration :around ((element relement)) (with-slots (duration) element @@ -393,7 +393,10 @@ ((start-time :initarg :start-time :reader start-time) (elements :initform '() :accessor elements) (duration :initarg :duration :reader duration) - (elasticity :accessor elasticity))) + (elasticity :accessor elasticity) + ;; the minimum x offset from this timeline to the next, or, if this + ;; is the last timeline, from this one to the end of the measure + (smallest-gap :initform 0 :accessor smallest-gap))) (defclass ranked-flexichain (flexichain:standard-flexichain flexichain:flexirank-mixin) ()) @@ -464,7 +467,7 @@ (defmethod measures :before ((segment rsegment)) (when (modified-p segment) (compute-measures segment (spacing-style (buffer-cost-method (buffer segment)))) - (mapc #'compute-timelines (measures segment)) + (mapc #'compute-timelines (slot-value segment 'measures)) (setf (modified-p segment) nil))) (defmethod nb-measures ((segment rsegment)) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.34 gsharp/packages.lisp:1.35 --- gsharp/packages.lisp:1.34 Mon Nov 21 23:40:48 2005 +++ gsharp/packages.lisp Mon Nov 28 05:25:34 2005 @@ -133,7 +133,9 @@ #:top-note #:bot-note #:top-note-pos #:bot-note-pos #:beam-groups #:final-stem-direction #:group-notes-by-staff #:final-relative-note-xoffset - #:final-accidental #:final-relative-accidental-xoffset)) + #:final-accidental #:final-relative-accidental-xoffset + #:timeline #:timelines #:elasticity + #:smallest-gap)) (defpackage :gsharp-postscript (:use :clim :clim-lisp) From rstrandh at common-lisp.net Mon Nov 28 19:34:56 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 28 Nov 2005 20:34:56 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/elasticity.lisp Message-ID: <20051128193456.437AB880D7@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv23128 Added Files: elasticity.lisp Log Message: New file containing code for managing elasticity functions. It is not yet used in Gsharp, but it soon will be. Date: Mon Nov 28 20:34:18 2005 Author: rstrandh From rstrandh at common-lisp.net Mon Nov 28 21:27:05 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 28 Nov 2005 22:27:05 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Flexichain/flexichain-package.lisp gsharp/Flexichain/flexirank.lisp Message-ID: <20051128212705.7E2DF880D7@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv31819 Modified Files: flexichain-package.lisp flexirank.lisp Log Message: added flexi-first-p and flexi-last-p to flexirank.lisp Date: Mon Nov 28 22:27:03 2005 Author: rstrandh Index: gsharp/Flexichain/flexichain-package.lisp diff -u gsharp/Flexichain/flexichain-package.lisp:1.5 gsharp/Flexichain/flexichain-package.lisp:1.6 --- gsharp/Flexichain/flexichain-package.lisp:1.5 Mon Nov 28 00:43:50 2005 +++ gsharp/Flexichain/flexichain-package.lisp Mon Nov 28 22:27:02 2005 @@ -38,5 +38,6 @@ #:insert #:insert-sequence #:element< #:element> #:delete< #:delete> #:flexirank-mixin #:element-rank-mixin #:rank + #:flexi-first-p #:flexi-last-p #:flexi-next #:flexi-prev)) Index: gsharp/Flexichain/flexirank.lisp diff -u gsharp/Flexichain/flexirank.lisp:1.3 gsharp/Flexichain/flexirank.lisp:1.4 --- gsharp/Flexichain/flexirank.lisp:1.3 Mon Nov 28 01:25:59 2005 +++ gsharp/Flexichain/flexirank.lisp Mon Nov 28 22:27:02 2005 @@ -28,6 +28,8 @@ ;;; generic function rank. (defgeneric rank (element)) +(defgeneric flexi-first-p (element)) +(defgeneric flexi-last-p (element)) (defgeneric flexi-next (element)) (defgeneric flexi-prev (element)) @@ -38,16 +40,19 @@ (defmethod rank ((element element-rank-mixin)) (index-position (chain element) (index element))) +(defmethod flexi-first-p ((element element-rank-mixin)) + (zerop (rank element))) + +(defmethod flexi-last-p ((element element-rank-mixin)) + (= (rank element) (1- (nb-elements (chain element))))) + (defmethod flexi-next ((element element-rank-mixin)) - (let ((new-rank (1+ (rank element))) - (chain (chain element))) - (assert (< new-rank (nb-elements chain))) - (element* chain new-rank))) + (assert (not (flexi-last-p element))) + (element* (chain element) (1+ (rank element)))) (defmethod flexi-prev ((element element-rank-mixin)) - (let ((new-rank (1- (rank element)))) - (assert (not (minusp new-rank))) - (element* (chain element) new-rank))) + (assert (not (flexi-first-p element))) + (element* (chain element) (1- (rank element)))) ;;; this class must be mixed into a flexichain that contains ranked elements (defclass flexirank-mixin () ()) From rstrandh at common-lisp.net Tue Nov 29 03:05:26 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 29 Nov 2005 04:05:26 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051129030526.665E8880D7@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv25450 Modified Files: drawing.lisp Log Message: More code towards a better spacing algorithm. Date: Tue Nov 29 04:05:25 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.35 gsharp/drawing.lisp:1.36 --- gsharp/drawing.lisp:1.35 Mon Nov 28 05:25:34 2005 +++ gsharp/drawing.lisp Tue Nov 29 04:05:24 2005 @@ -108,28 +108,87 @@ (defgeneric right-bulge (element pane)) (defmethod left-bulge ((element element) pane) - 0) + (score-pane:staff-step 1)) (defmethod right-bulge ((element element) pane) - 0) + (score-pane:staff-step 1)) -(defun compute-gaps (measures method pane) +(defun compute-gaps-adjacent-timelines (bars method pane) + (declare (ignore method)) + (loop for bar in bars + do (loop for (e1 e2) on (elements bar) + for t1 = (timeline e1) + do (cond ((null e2) + (when (flexichain:flexi-last-p t1) + (setf (smallest-gap t1) + (max (smallest-gap t1) + (right-bulge e1 pane))))) + ((eq (flexichain:flexi-next t1) + (timeline e2)) + (setf (smallest-gap t1) + (max (smallest-gap t1) + (+ (right-bulge e1 pane) + (left-bulge e2 pane))))))))) + +(defun compute-gaps-separated-timelines (bars method pane) (declare (ignore method)) + (flet ((handle-timelines (timelines element-gap) + (let ((sum-gap (reduce #'+ timelines :key #'smallest-gap)) + (sum-elasticity (reduce #'+ timelines :key #'elasticity))) + (unless (> sum-gap element-gap) + (if (zerop sum-elasticity) + (loop for timeline = (find (/ element-gap (length timelines)) + timelines + :key #'smallest-gap + :test #'<) + until (null timeline) + do (decf element-gap (smallest-gap timeline)) + do (setf timelines (remove timeline timelines :test #'eq)) + finally (let ((gap (/ element-gap (length timelines)))) + (loop for timeline in timelines + do (setf (smallest-gap timeline) gap)))) + (loop for timeline = (let ((gap/elasticity (/ element-gap sum-elasticity))) + (find-if (lambda (timeline) + (> (smallest-gap timeline) + (* (elasticity timeline) gap/elasticity))) + timelines)) + until (null timeline) + do (decf element-gap (smallest-gap timeline)) + do (decf sum-elasticity (elasticity timeline)) + do (setf timelines (remove timeline timelines :test #'eq)) + finally (let ((gap/elasticity (/ element-gap sum-elasticity))) + (loop for timeline in timelines + do (setf (smallest-gap timeline) + (* (elasticity timeline) gap/elasticity)))))))))) + (loop for bar in bars + do (loop for (e1 e2) on (elements bar) + for t1 = (timeline e1) + do (cond ((null e2) + (unless (flexichain:flexi-last-p t1) + (let ((timelines (loop for tl = t1 then (flexichain:flexi-next tl) + collect tl + until (flexichain:flexi-last-p tl)))) + (handle-timelines timelines (right-bulge e1 pane))))) + ((not (eq (flexichain:flexi-next t1) + (timeline e2))) + (let ((timelines (loop for tl = t1 then (flexichain:flexi-next tl) + until (eq tl (timeline e2)) + collect tl))) + (handle-timelines timelines (+ (right-bulge e1 pane) + (left-bulge e2 pane)))))))))) + +(defun compute-gaps (measures method pane) (loop for measure in measures - do (loop for bar in (measure-bars measure) - do (loop for (e1 e2) on (elements bar) - for t1 = (timeline e1) - do (cond ((null e2) - (when (flexichain:flexi-last-p t1) - (setf (smallest-gap t1) - (max (smallest-gap t1) - (right-bulge e1 pane))))) - ((eq (flexichain:flexi-next t1) - (timeline e2)) - (setf (smallest-gap t1) - (max (smallest-gap t1) - (+ (right-bulge e1 pane) - (left-bulge e2 pane)))))))))) + ;; initially, look only at adjacent elements whose + ;; corrsponding timelines are also adjacent, and at the last + ;; element of a bar, provided that its timeline is also the + ;; last one in the measure + do (compute-gaps-adjacent-timelines (measure-bars measure) method pane) + + ;; then look at adjacent elements whose corresponding + ;; timelines are NOT adjacent, or the last element of a bar + ;; whose corresponding timeline is not the last one in the meaure + do (compute-gaps-separated-timelines (measure-bars measure) method pane))) (defun draw-measure (pane measure min-dist compress x method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) From rstrandh at common-lisp.net Tue Nov 29 04:22:22 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 29 Nov 2005 05:22:22 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/measure.lisp Message-ID: <20051129042222.85BAB880D7@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv30924 Modified Files: drawing.lisp measure.lisp Log Message: Improved the computation of the bulge of a lyrics element. This improvement will allow me to test that the gaps between elements is calculated correctly. Also fixed a spelling error (was compute-bar-parameter, should be compute-bar-parameters) that made Gsharp fail on a score with lyrics. Date: Tue Nov 29 05:22:21 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.36 gsharp/drawing.lisp:1.37 --- gsharp/drawing.lisp:1.36 Tue Nov 29 04:05:24 2005 +++ gsharp/drawing.lisp Tue Nov 29 05:22:20 2005 @@ -110,8 +110,16 @@ (defmethod left-bulge ((element element) pane) (score-pane:staff-step 1)) +(defmethod left-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 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))) (defun compute-gaps-adjacent-timelines (bars method pane) (declare (ignore method)) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.16 gsharp/measure.lisp:1.17 --- gsharp/measure.lisp:1.16 Mon Nov 28 05:25:34 2005 +++ gsharp/measure.lisp Tue Nov 29 05:22:20 2005 @@ -621,7 +621,7 @@ ;;; compute some important parameters of a bar (defgeneric compute-bar-parameters (bar)) -(defmethod compute-bar-parameter (bar) +(defmethod compute-bar-parameters (bar) nil) (defmethod compute-bar-parameters ((bar melody-bar)) From rstrandh at common-lisp.net Tue Nov 29 18:05:05 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 29 Nov 2005 19:05:05 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/measure.lisp Message-ID: <20051129180505.BC2988858C@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv28565 Modified Files: measure.lisp Log Message: Fixed a bug in the code for creating the timelines. The calculation of the start times of the timelines was wrong. Date: Tue Nov 29 19:05:04 2005 Author: rstrandh Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.17 gsharp/measure.lisp:1.18 --- gsharp/measure.lisp:1.17 Tue Nov 29 05:22:20 2005 +++ gsharp/measure.lisp Tue Nov 29 19:05:03 2005 @@ -653,10 +653,10 @@ (defun compute-timelines (measure) (let ((timelines (timelines measure)) - (start-times (measure-start-times measure))) + (durations (abs-rel (measure-start-times measure)))) ;; create a timeline for each start time of the measure - (loop for start-time in start-times - for duration in (abs-rel start-times) + (loop for duration in durations + for start-time = 0 then (+ start-time duration) for i from 0 do (let ((timeline (make-instance 'timeline :start-time start-time @@ -665,15 +665,15 @@ ;; link each timeline to its elements and each element of a ;; timeline to the timeline (loop for bar in (measure-bars measure) - do (loop for element in (elements bar) + do (loop with timeline-index = 0 + for element in (elements bar) for start-time = 0 then (+ start-time (duration element)) - for timeline-index from 0 do (loop while (< (start-time (flexichain:element* timelines timeline-index)) start-time) - do (incf timeline-index)) + do (incf timeline-index)) do (let ((timeline (flexichain:element* timelines timeline-index))) - (push element (elements timeline)) - (setf (timeline element) timeline)))))) + (push element (elements timeline)) + (setf (timeline element) timeline)))))) ;;; Compute all the measures of a segment by stepping through all the ;;; bars in parallel as long as there is at least one simultaneous bar. From rstrandh at common-lisp.net Tue Nov 29 19:37:41 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 29 Nov 2005 20:37:41 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/gsharp.asd gsharp/measure.lisp gsharp/packages.lisp Message-ID: <20051129193741.8672B885A4@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv2766 Modified Files: gsharp.asd measure.lisp packages.lisp Log Message: Fixed a bug in the computation of the timelines. Added elasticity.lisp to gsharp.asd. Prepared the MEASURE class for holding an elasticity function. Date: Tue Nov 29 20:37:40 2005 Author: rstrandh Index: gsharp/gsharp.asd diff -u gsharp/gsharp.asd:1.3 gsharp/gsharp.asd:1.4 --- gsharp/gsharp.asd:1.3 Mon Nov 28 03:32:06 2005 +++ gsharp/gsharp.asd Tue Nov 29 20:37:39 2005 @@ -35,6 +35,7 @@ "postscript" "glyphs" "beaming" + "elasticity" "drawing" "cursor" "input-state" Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.18 gsharp/measure.lisp:1.19 --- gsharp/measure.lisp:1.18 Tue Nov 29 19:05:03 2005 +++ gsharp/measure.lisp Tue Nov 29 20:37:40 2005 @@ -424,8 +424,12 @@ (bar-pos :initarg :bar-pos :reader measure-bar-pos) ;; a list of the bars that make up this measure (bars :initarg :bars :reader measure-bars) - ;; the first timeline of the measure, or NIL of there are not timelines - (timelines :initform (make-instance 'ranked-flexichain) :reader timelines))) + ;; a ranked flexichain of timelines + (timelines :initform (make-instance 'ranked-flexichain) :reader timelines) + ;; a convex piecewise-linear function that determines the + ;; horizontal size of the measure as a function of the "force" that + ;; is applied to it + (elasticity-function :accessor elasticity-function))) (defun make-measure (min-dist coeff start-times seg-pos bar-pos bars) (make-instance 'measure :min-dist min-dist :coeff coeff @@ -656,7 +660,7 @@ (durations (abs-rel (measure-start-times measure)))) ;; create a timeline for each start time of the measure (loop for duration in durations - for start-time = 0 then (+ start-time duration) + and start-time = 0 then (+ start-time duration) for i from 0 do (let ((timeline (make-instance 'timeline :start-time start-time @@ -667,7 +671,7 @@ (loop for bar in (measure-bars measure) do (loop with timeline-index = 0 for element in (elements bar) - for start-time = 0 then (+ start-time (duration element)) + and start-time = 0 then (+ start-time (duration element)) do (loop while (< (start-time (flexichain:element* timelines timeline-index)) start-time) do (incf timeline-index)) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.35 gsharp/packages.lisp:1.36 --- gsharp/packages.lisp:1.35 Mon Nov 28 05:25:34 2005 +++ gsharp/packages.lisp Tue Nov 29 20:37:40 2005 @@ -135,7 +135,7 @@ #:group-notes-by-staff #:final-relative-note-xoffset #:final-accidental #:final-relative-accidental-xoffset #:timeline #:timelines #:elasticity - #:smallest-gap)) + #:smallest-gap #:elasticity-function)) (defpackage :gsharp-postscript (:use :clim :clim-lisp) From rstrandh at common-lisp.net Tue Nov 29 20:34:45 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 29 Nov 2005 21:34:45 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Scores/spacetest.gsh Message-ID: <20051129203445.999318859E@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Scores In directory common-lisp.net:/tmp/cvs-serv7153 Added Files: spacetest.gsh Log Message: Score to test the new spacing algorithm (which is not completely implemented yet). Date: Tue Nov 29 21:34:44 2005 Author: rstrandh From rstrandh at common-lisp.net Wed Nov 30 00:23:29 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 30 Nov 2005 01:23:29 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/elasticity.lisp Message-ID: <20051130002329.1C5728859E@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv24865 Modified Files: drawing.lisp elasticity.lisp Log Message: Fixed a few bugs in the elasticity library. Added computation of elasticity functions for each measure. Date: Wed Nov 30 01:23:03 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.37 gsharp/drawing.lisp:1.38 --- gsharp/drawing.lisp:1.37 Tue Nov 29 05:22:20 2005 +++ gsharp/drawing.lisp Wed Nov 30 01:22:54 2005 @@ -198,6 +198,18 @@ ;; whose corresponding timeline is not the last one in the meaure do (compute-gaps-separated-timelines (measure-bars measure) method pane))) +(defun compute-elasticity-functions (measures method) + (loop for measure in measures + do (loop with result = (make-elementary-elasticity (min-width method) 0.0001) + with timelines = (timelines measure) + for i from 0 below (flexichain:nb-elements timelines) + for timeline = (flexichain:element* timelines i) + do (setf result + (add-elasticities + result + (make-elementary-elasticity (smallest-gap timeline) (elasticity timeline)))) + finally (setf (elasticity-function measure) result)))) + (defun draw-measure (pane measure min-dist compress x method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) compress)) @@ -258,6 +270,7 @@ (lambda (measures) (compute-elasticities measures method) (compute-gaps measures method pane) + (compute-elasticity-functions measures method) (let ((widths (compute-widths measures method))) (score-pane:with-vertical-score-position (pane yy) (draw-system pane measures (+ x (left-offset buffer) timesig-offset) Index: gsharp/elasticity.lisp diff -u gsharp/elasticity.lisp:1.1 gsharp/elasticity.lisp:1.2 --- gsharp/elasticity.lisp:1.1 Mon Nov 28 20:34:17 2005 +++ gsharp/elasticity.lisp Wed Nov 30 01:22:54 2005 @@ -56,6 +56,11 @@ ((zero-force-size :initarg :zero-force-size :reader zero-force-size) (elements :initform '() :initarg :elements :reader elements))) +(defmethod print-object ((e elasticity) stream) + (print-unreadable-object (e stream :type t :identity t) + (format stream "zero-size: ~a elements:~s" + (zero-force-size e) (elements e)))) + (defun make-zero-elasticity (size) "create an elasticity function that is constant for all values of the force" @@ -67,38 +72,41 @@ have a size smaller than the zero-force-size given" (make-instance 'elasticity :zero-force-size zero-force-size - :elements `(,(/ zero-force-size slope) . ,slope))) + :elements `((,(/ zero-force-size slope) . ,slope)))) (defmethod add-elasticities ((e1 elasticity) (e2 elasticity)) (let ((l1 (elements e1)) (l2 (elements e2)) (s1 0) (s2 0) - (result (list (+ (zero-force-size e1) (zero-force-size e2))))) + (zero-force-size (+ (zero-force-size e1) (zero-force-size e2))) + (elements '())) (loop until (and (null l1) (null l2)) do (cond ((null l1) (setf s2 (cdar l2)) - (push (cons (caar l2) (+ s1 s2)) result) + (push (cons (caar l2) (+ s1 s2)) elements) (pop l2)) ((null l2) (setf s1 (cdar l1)) - (push (cons (caar l1) (+ s1 s2)) result) + (push (cons (caar l1) (+ s1 s2)) elements) (pop l1)) - ((< 0.99999 (/ (caar l1) (caar l2)) 1.00001) + ((< 0.99999 (/ (+ (caar l1) 0.00001) (+ (caar l2) .00001)) 1.00001) (setf s1 (cdar l1) s2 (cdar l2)) - (push (cons (/ (+ (caar l1) (caar l2)) 2) (+ s1 s2)) result) + (push (cons (/ (+ (caar l1) (caar l2)) 2) (+ s1 s2)) elements) (pop l1) (pop l2)) ((< (caar l1) (caar l2)) (setf s1 (cdar l1)) - (push (cons (caar l1) (+ s1 s2)) result) + (push (cons (caar l1) (+ s1 s2)) elements) (pop l1)) (t (setf s2 (cdar l2)) - (push (cons (caar l2) (+ s1 s2)) result) + (push (cons (caar l2) (+ s1 s2)) elements) (pop l2)))) - (make-instance 'elasticity :elements (nreverse result)))) + (make-instance 'elasticity + :zero-force-size zero-force-size + :elements (nreverse elements)))) (defmethod force-at-size ((e elasticity) size) (let ((l (elements e)) From rstrandh at common-lisp.net Wed Nov 30 02:37:06 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 30 Nov 2005 03:37:06 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/elasticity.lisp Message-ID: <20051130023706.D03388859E@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv2660 Modified Files: drawing.lisp elasticity.lisp Log Message: Added comutation to determine what force needs to be applied to a line to stretch it to the available line width. Date: Wed Nov 30 03:37:06 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.38 gsharp/drawing.lisp:1.39 --- gsharp/drawing.lisp:1.38 Wed Nov 30 01:22:54 2005 +++ gsharp/drawing.lisp Wed Nov 30 03:37:05 2005 @@ -208,7 +208,8 @@ (add-elasticities result (make-elementary-elasticity (smallest-gap timeline) (elasticity timeline)))) - finally (setf (elasticity-function measure) result)))) + finally (setf (elasticity-function measure) result))) + (reduce #'add-elasticities measures :key #'elasticity-function)) (defun draw-measure (pane measure min-dist compress x method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) @@ -270,7 +271,11 @@ (lambda (measures) (compute-elasticities measures method) (compute-gaps measures method pane) - (compute-elasticity-functions measures method) + (let* ((e-fun (compute-elasticity-functions measures method)) + (force (if (> (zero-force-size e-fun) (line-width method)) + 0 + (force-at-size e-fun (line-width method))))) + nil) (let ((widths (compute-widths measures method))) (score-pane:with-vertical-score-position (pane yy) (draw-system pane measures (+ x (left-offset buffer) timesig-offset) Index: gsharp/elasticity.lisp diff -u gsharp/elasticity.lisp:1.2 gsharp/elasticity.lisp:1.3 --- gsharp/elasticity.lisp:1.2 Wed Nov 30 01:22:54 2005 +++ gsharp/elasticity.lisp Wed Nov 30 03:37:05 2005 @@ -52,6 +52,9 @@ required to obtain that size. The size must be larger than the size at zero force, as reported by zero-force-size")) +(defgeneric size-at-force (elasticity force) + (:documentation "for a given force, return the size at that force")) + (defclass elasticity () ((zero-force-size :initarg :zero-force-size :reader zero-force-size) (elements :initform '() :initarg :elements :reader elements))) @@ -124,10 +127,15 @@ do (pop l)) (+ current-force (/ (- size current-size) current-slope))))) - - - - - - - +(defmethod size-at-force ((e elasticity) force) + (let ((l (elements e)) + (current-size (zero-force-size e))) + (let ((current-force 0) + (current-slope 0)) + (loop until (or (null l) + (>= (caar l) force)) + do (incf current-size (* current-slope (- (caar l) current-force))) + do (setf current-force (caar l) + current-slope (cdar l)) + do (pop l)) + (+ current-size (* (- force current-force) current-slope))))) \ No newline at end of file From rstrandh at common-lisp.net Wed Nov 30 05:52:48 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 30 Nov 2005 06:52:48 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051130055248.BD7A088554@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv17460 Modified Files: drawing.lisp Log Message: Added comments and documentation strings to explain a bit more about the new spacing algorithm. Date: Wed Nov 30 06:52:47 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.39 gsharp/drawing.lisp:1.40 --- gsharp/drawing.lisp:1.39 Wed Nov 30 03:37:05 2005 +++ gsharp/drawing.lisp Wed Nov 30 06:52:47 2005 @@ -96,6 +96,14 @@ collect (/ (nat-width method (measure-coeff measure) min-dist) compress)))) +;;; Compute the elasticity of each timeline in each measure of the +;;; measures of a system (line) by taking its duration to the power of +;;; the spaceing style. This metric is arbitrarily normalized to the +;;; duration of a whole note, which means that the force to apply to a +;;; line is not comparable between two different lines. All we know +;;; is that timelines with the same elasticity will grow and shrink in +;;; parallel, and that proportions between two timelines of different +;;; durations will be preserved. (defun compute-elasticities (measures method) (loop for measure in measures do (loop with timelines = (timelines measure) @@ -104,8 +112,29 @@ do (setf (elasticity timeline) (expt (duration timeline) (spacing-style method)))))) -(defgeneric left-bulge (element pane)) -(defgeneric right-bulge (element pane)) +;;; FIXME: there should be an :around method that adds the value +;;; return by the main method to the explicit horizontal offset that +;;; the user wants to impose on an element, and the existence of this +;;; around method should be documented. +;;; FIXME: we should probably also allow for the user to introduce +;;; explicit (positive or negative) bulges that will be added in by +;;; the :around method, thus allowing the user to explicitly move two +;;; adjacent elements further apart, or to bring them closer together. +(defgeneric left-bulge (element pane) + (:documentation "The amount by which an element sticks out to the +left of the center of its timeline")) + +;;; FIXME: there should be an :around method that adds the value +;;; return by the main method to the explicit horizontal offset that +;;; the user wants to impose on an element, and the existence of this +;;; around method should be documented. +;;; FIXME: we should probably also allow for the user to introduce +;;; explicit (positive or negative) bulges that will be added in by +;;; the :around method, thus allowing the user to explicitly move two +;;; adjacent elements further apart, or to bring them closer together. +(defgeneric right-bulge (element pane) + (:documentation "The amount by which an element sticks out to the +right of the center of its timeline")) (defmethod left-bulge ((element element) pane) (score-pane:staff-step 1)) @@ -121,6 +150,15 @@ (+ (score-pane:staff-step 0.5) (/ (text-size pane (map 'string 'code-char (text element))) 2))) +;;; As it turns out, the spacing algorithm would be very complicated +;;; if we were to take into account exactly how elements with +;;; arbitrarily many timelines between them might influence the +;;; overall layout. Instead we apprixmate by obtaining a closest gap +;;; only between adjacent timelines as follows: first, we consider +;;; adjacent elements whose timelines are also adjacent (and there is +;;; a special case for the last element of a layer), and set the +;;; smallest gap between the timelines to the closest possible +;;; distance between the two elements... (defun compute-gaps-adjacent-timelines (bars method pane) (declare (ignore method)) (loop for bar in bars @@ -138,6 +176,27 @@ (+ (right-bulge e1 pane) (left-bulge e2 pane))))))))) +;;; ... Then we consider adjacent elements whose timelines are +;;; separated by at least one other timeline. If the sum of the +;;; distances between individual timelines is greater than or equal to +;;; the closest distance between the adjacent elements (which is +;;; likely if we are talking melody), then there is nothing to do, +;;; since the individual distances are more restrictive than that +;;; imposed by the adjacent elements. If not, we try to distribute +;;; the closest distance between the two adjacent elements over the +;;; individual timelines proportionally to the elasticity of the +;;; timlines. If in doing so, we find that some timeline already has +;;; a smallest gap that is larger than the fraction of the closest +;;; distance between adjacent elements that we attribute to it, then +;;; that smallest gap is subtracted from the distance we need to +;;; distribute, the timeline is removed from consideration, and we +;;; start over. This process must terminate (or else, the sum of the +;;; closest gaps must have been larger than the distance to distribute +;;; in the first place) with at least one timeline to distribute over. +;;; There is a special case here, which occurs when all the +;;; elasticites of the timelines to be considered is zero. In this +;;; case, instead of distributing proportionally to the elasticities +;;; of individual timelies, we distribute evenly between the timelines. (defun compute-gaps-separated-timelines (bars method pane) (declare (ignore method)) (flet ((handle-timelines (timelines element-gap) @@ -198,6 +257,11 @@ ;; whose corresponding timeline is not the last one in the meaure do (compute-gaps-separated-timelines (measure-bars measure) method pane))) +;;; When this function is called, each timeline has an elasticity and +;;; a smallest gap to the next adjacent timline (or to the end of the +;;; 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) (loop for measure in measures do (loop with result = (make-elementary-elasticity (min-width method) 0.0001) @@ -272,8 +336,11 @@ (compute-elasticities measures method) (compute-gaps measures method pane) (let* ((e-fun (compute-elasticity-functions measures method)) + ;; FIXME: it would be much better to compress the system + ;; proportionally, so that every smallest gap gets shrunk + ;; by the same percentage (force (if (> (zero-force-size e-fun) (line-width method)) - 0 + 0 (force-at-size e-fun (line-width method))))) nil) (let ((widths (compute-widths measures method))) From rstrandh at common-lisp.net Wed Nov 30 18:06:02 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 30 Nov 2005 19:06:02 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051130180602.83A8388579@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv9432 Modified Files: drawing.lisp Log Message: More code that will eventually replace the existing spacing algorithm and the code for the final drawing. Date: Wed Nov 30 19:06:01 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.40 gsharp/drawing.lisp:1.41 --- gsharp/drawing.lisp:1.40 Wed Nov 30 06:52:47 2005 +++ gsharp/drawing.lisp Wed Nov 30 19:06:00 2005 @@ -1,5 +1,11 @@ (in-package :gsharp-drawing) +(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 + ;; force that is applied to it. + (prefix-elasticity-function :accessor prefix-elasticity-function))) + (define-added-mixin dstaff () staff ((yoffset :initform 0 :accessor staff-yoffset))) @@ -264,7 +270,9 @@ ;;; elasticity function of a measure. (defun compute-elasticity-functions (measures method) (loop for measure in measures - do (loop with result = (make-elementary-elasticity (min-width method) 0.0001) + do (setf (prefix-elasticity-function measure) + (make-elementary-elasticity (min-width method) 0.0001)) + do (loop with result = (prefix-elasticity-function measure) with timelines = (timelines measure) for i from 0 below (flexichain:nb-elements timelines) for timeline = (flexichain:element* timelines i) @@ -275,6 +283,22 @@ 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 draw-cursor) + (loop with timelines = (timelines measure) + for i from 0 below (flexichain:nb-elements timelines) + for timeline = (flexichain:element* timelines i) + and xx = (+ x (size-at-force (prefix-elasticity-function measure) force)) + then (+ xx (max (smallest-gap timeline) + (* force (elasticity timeline)))) + 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 draw-cursor) + (score-pane:with-light-glyphs pane (new-draw-bar pane bar draw-cursor))))) + (defun draw-measure (pane measure min-dist compress x method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) compress)) @@ -295,6 +319,17 @@ (draw-bar pane bar x width time-alist draw-cursor) (score-pane:with-light-glyphs pane (draw-bar pane bar x width time-alist draw-cursor)))))) +;;; eventually remove the existing draw-system and rename this +;;; to draw-system +(defun new-draw-system (pane measures x force staves draw-cursor) + (loop for measure in measures + do (new-draw-measure pane measure x force draw-cursor) + 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 widths method staves draw-cursor) (let ((compress (compute-compress-factor measures method)) (min-dist (compute-min-dist measures))) @@ -531,6 +566,8 @@ (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 draw-cursor)) (defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) From rstrandh at common-lisp.net Wed Nov 30 22:23:58 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 30 Nov 2005 23:23:58 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: <20051130222358.D34E388579@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv29032 Modified Files: drawing.lisp Log Message: Attempting to get rid of with-vertical-score-position so that the cursor can ultimately be drawn independently of the systems. Date: Wed Nov 30 23:23:54 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.41 gsharp/drawing.lisp:1.42 --- gsharp/drawing.lisp:1.41 Wed Nov 30 19:06:00 2005 +++ gsharp/drawing.lisp Wed Nov 30 23:23:51 2005 @@ -299,7 +299,7 @@ (new-draw-bar pane bar draw-cursor) (score-pane:with-light-glyphs pane (new-draw-bar pane bar draw-cursor))))) -(defun draw-measure (pane measure min-dist compress x method draw-cursor) +(defun draw-measure (pane measure min-dist compress x y method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) compress)) (time-alist (cons (cons 0 (/ (min-width method) compress)) @@ -316,8 +316,8 @@ compress)))))) (loop for bar in (measure-bars measure) do (if (gsharp-cursor::cursors (slice bar)) - (draw-bar pane bar x width time-alist draw-cursor) - (score-pane:with-light-glyphs pane (draw-bar pane bar x width time-alist draw-cursor)))))) + (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)))))) ;;; eventually remove the existing draw-system and rename this ;;; to draw-system @@ -330,16 +330,16 @@ (staff-yoffset (car (last staves)))))) -(defun draw-system (pane measures x widths method staves draw-cursor) +(defun draw-system (pane measures x y widths method staves draw-cursor) (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 method draw-cursor) + (draw-measure pane measure min-dist compress x y method draw-cursor) (incf x width) (score-pane:draw-bar-line pane x - (- (score-pane:staff-step 8)) - (staff-yoffset (car (last staves))))))) + (+ y (- (score-pane:staff-step 8))) + (+ y (staff-yoffset (car (last staves)))))))) (defmethod draw-buffer (pane (buffer buffer) *cursor* x y draw-cursor) (score-pane:with-staff-size 6 @@ -379,12 +379,12 @@ (force-at-size e-fun (line-width method))))) nil) (let ((widths (compute-widths measures method))) - (score-pane:with-vertical-score-position (pane yy) - (draw-system pane measures (+ x (left-offset buffer) timesig-offset) - widths method staves draw-cursor) - (score-pane:draw-bar-line pane x - (- (score-pane:staff-step 8)) - (staff-yoffset (car (last staves))))) + (draw-system pane measures + (+ x (left-offset buffer) timesig-offset) yy + widths method staves draw-cursor) + (score-pane:draw-bar-line pane x + (+ yy (- (score-pane:staff-step 8))) + (+ yy (staff-yoffset (car (last staves))))) (loop for staff in staves do (score-pane:with-vertical-score-position (pane yy) (if (member staff (staves (layer (slice (bar *cursor*))))) @@ -569,37 +569,39 @@ (defgeneric new-draw-bar (pane bar draw-cursor)) -(defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) +(defmethod draw-bar (pane (bar melody-bar) x y width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) - (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)))))))) + (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))))))))) -(defmethod draw-bar (pane (bar lyrics-bar) x width time-alist draw-cursor) +(defmethod draw-bar (pane (bar lyrics-bar) x y width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) - (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)))))))) + (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))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;