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

[gsharp-cvs] CVS update: gsharp/drawing.lisp
by Robert Strandh 16 Feb '04

16 Feb '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv20560 Modified Files: drawing.lisp Log Message: Fixed the annoying bug that sometimes made spacing completely wrong in the presence of dotted notes. Had to fix it twice, though, because there is code duplication in there. Some factoring would be a good idea at some point. Date: Mon Feb 16 12:38:11 2004 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.2 gsharp/drawing.lisp:1.3 --- gsharp/drawing.lisp:1.2 Mon Feb 16 11:08:00 2004 +++ gsharp/drawing.lisp Mon Feb 16 12:38:10 2004 @@ -51,11 +51,11 @@ (defun compute-widths (measures method) (let* ((compress (compute-compress-factor measures method)) - (start-times (sort (remove-duplicates - (apply #'append (mapcar #'measure-start-times - measures))) - #'<)) - (min-dist (reduce #'min (gsharp-measure::abs-rel start-times)))) + (min-dists (mapcar (lambda (measure) + (reduce #'min (gsharp-measure::abs-rel + (measure-start-times measure)))) + measures)) + (min-dist (reduce #'min min-dists))) (loop for measure in measures collect (/ (nat-width method (measure-coeff measure) min-dist) compress)))) @@ -82,11 +82,11 @@ (defun draw-system (pane measures x widths method staves draw-cursor) (let* ((compress (compute-compress-factor measures method)) - (start-times (sort (remove-duplicates - (apply #'append (mapcar #'measure-start-times - measures))) - #'<)) - (min-dist (reduce #'min (gsharp-measure::abs-rel start-times)))) + (min-dists (mapcar (lambda (measure) + (reduce #'min (gsharp-measure::abs-rel + (measure-start-times measure)))) + measures)) + (min-dist (reduce #'min min-dists))) (loop for measure in measures for width in widths do (draw-measure pane measure min-dist compress x method draw-cursor)

1 0

[gsharp-cvs] CVS update: gsharp/Scores/alundavisan.gsh gsharp/Scores/bach181.gsh gsharp/Scores/bach262.gsh gsharp/Scores/blomsteroffret.gsh gsharp/Scores/clusters.gsh gsharp/Scores/rapsoden-sjunger.gsh gsharp/Scores/smaland.gsh gsharp/Scores/tomtegubbar.gsh gsharp/Scores/vinter-adjo.gsh
by Robert Strandh 16 Feb '04

16 Feb '04

Update of /project/gsharp/cvsroot/gsharp/Scores In directory common-lisp.net:/tmp/cvs-serv24224/Scores Modified Files: alundavisan.gsh bach181.gsh bach262.gsh blomsteroffret.gsh clusters.gsh rapsoden-sjunger.gsh smaland.gsh tomtegubbar.gsh vinter-adjo.gsh Log Message: Updates since 0.2 release. Date: Mon Feb 16 11:08:02 2004 Author: rstrandh Index: gsharp/Scores/alundavisan.gsh diff -u gsharp/Scores/alundavisan.gsh:1.1.1.1 gsharp/Scores/alundavisan.gsh:1.2 --- gsharp/Scores/alundavisan.gsh:1.1.1.1 Mon Feb 16 10:46:44 2004 +++ gsharp/Scores/alundavisan.gsh Mon Feb 16 11:08:02 2004 @@ -42,4 +42,4 @@ [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :AUTO :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos 4 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos 4 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/bach181.gsh diff -u gsharp/Scores/bach181.gsh:1.1.1.1 gsharp/Scores/bach181.gsh:1.2 --- gsharp/Scores/bach181.gsh:1.1.1.1 Mon Feb 16 10:46:48 2004 +++ gsharp/Scores/bach181.gsh Mon Feb 16 11:08:02 2004 @@ -191,4 +191,4 @@ [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #3# :head :FILLED :accidentals :SHARP :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :DOWN :notes ([N :pitch 22 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 21 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :DOWN :notes ([N :pitch 22 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 21 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/bach262.gsh diff -u gsharp/Scores/bach262.gsh:1.1.1.1 gsharp/Scores/bach262.gsh:1.2 --- gsharp/Scores/bach262.gsh:1.1.1.1 Mon Feb 16 10:46:52 2004 +++ gsharp/Scores/bach262.gsh Mon Feb 16 11:08:02 2004 @@ -206,4 +206,4 @@ [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 20 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 23 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 20 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 21 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 20 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 21 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/blomsteroffret.gsh diff -u gsharp/Scores/blomsteroffret.gsh:1.1.1.1 gsharp/Scores/blomsteroffret.gsh:1.2 --- gsharp/Scores/blomsteroffret.gsh:1.1.1.1 Mon Feb 16 10:46:57 2004 +++ gsharp/Scores/blomsteroffret.gsh Mon Feb 16 11:08:02 2004 @@ -237,4 +237,4 @@ [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #3# :head :FILLED :accidentals :SHARP :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 18 :staff #3# :head :FILLED :accidentals :SHARP :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 18 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 18 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/clusters.gsh diff -u gsharp/Scores/clusters.gsh:1.1.1.1 gsharp/Scores/clusters.gsh:1.2 --- gsharp/Scores/clusters.gsh:1.1.1.1 Mon Feb 16 10:46:57 2004 +++ gsharp/Scores/clusters.gsh Mon Feb 16 11:08:02 2004 @@ -17,4 +17,4 @@ [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 33 :staff #1# :head :FILLED :accidentals :SHARP :dots 0 ] - [N :pitch 36 :staff #1# :head :FILLED :accidentals :SHARP :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [N :pitch 36 :staff #1# :head :FILLED :accidentals :SHARP :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/rapsoden-sjunger.gsh diff -u gsharp/Scores/rapsoden-sjunger.gsh:1.1.1.1 gsharp/Scores/rapsoden-sjunger.gsh:1.2 --- gsharp/Scores/rapsoden-sjunger.gsh:1.1.1.1 Mon Feb 16 10:47:05 2004 +++ gsharp/Scores/rapsoden-sjunger.gsh Mon Feb 16 11:08:02 2004 @@ -191,15 +191,14 @@ [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 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([- :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos 4 ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes NIL ] ) ] + [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 ] ) ] @@ -355,16 +354,16 @@ [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 15 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 19 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #3# :staff-pos 0 ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] + [| :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 #3# :staff-pos 0 ] [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #3# :staff-pos 0 ] ) ] - [| :elements ([- :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #3# :staff-pos 0 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [| :elements ([- :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #3# :staff-pos 0 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 :left-margin 20 ] Index: gsharp/Scores/smaland.gsh diff -u gsharp/Scores/smaland.gsh:1.1.1.1 gsharp/Scores/smaland.gsh:1.2 --- gsharp/Scores/smaland.gsh:1.1.1.1 Mon Feb 16 10:47:08 2004 +++ gsharp/Scores/smaland.gsh Mon Feb 16 11:08:02 2004 @@ -129,4 +129,4 @@ [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 2 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos 4 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos 4 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/tomtegubbar.gsh diff -u gsharp/Scores/tomtegubbar.gsh:1.1.1.1 gsharp/Scores/tomtegubbar.gsh:1.2 --- gsharp/Scores/tomtegubbar.gsh:1.1.1.1 Mon Feb 16 10:47:12 2004 +++ gsharp/Scores/tomtegubbar.gsh Mon Feb 16 11:08:02 2004 @@ -116,4 +116,4 @@ [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 27 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 28 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #3# :staff-pos 4 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #3# :staff-pos 4 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/vinter-adjo.gsh diff -u gsharp/Scores/vinter-adjo.gsh:1.1.1.1 gsharp/Scores/vinter-adjo.gsh:1.2 --- gsharp/Scores/vinter-adjo.gsh:1.1.1.1 Mon Feb 16 10:47:14 2004 +++ gsharp/Scores/vinter-adjo.gsh Mon Feb 16 11:08:02 2004 @@ -65,4 +65,4 @@ [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :DOWN :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :DOWN :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 ]

1 0

[gsharp-cvs] CVS update: gsharp/Doc/model.tex gsharp/Doc/plans.tex gsharp/Doc/release-notes.tex
by Robert Strandh 16 Feb '04

16 Feb '04

Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv24224/Doc Modified Files: model.tex plans.tex release-notes.tex Log Message: Updates since 0.2 release. Date: Mon Feb 16 11:08:02 2004 Author: rstrandh Index: gsharp/Doc/model.tex diff -u gsharp/Doc/model.tex:1.1.1.1 gsharp/Doc/model.tex:1.2 --- gsharp/Doc/model.tex:1.1.1.1 Mon Feb 16 10:46:28 2004 +++ gsharp/Doc/model.tex Mon Feb 16 11:08:01 2004 @@ -45,7 +45,7 @@ corresponding roughly to a \emph{voice} \index{voice} or a \emph{part} \index{part} of the music. -The difference between a layer and a part ({gs} does not know about +The difference between a layer and a part ({\gs} does not know about parts) is that a layer has a particular \emph{instrument} \index{instrument} assigned to it, whereas a part can have several different instruments, for instance when the same musician plays Index: gsharp/Doc/plans.tex diff -u gsharp/Doc/plans.tex:1.1.1.1 gsharp/Doc/plans.tex:1.2 --- gsharp/Doc/plans.tex:1.1.1.1 Mon Feb 16 10:46:31 2004 +++ gsharp/Doc/plans.tex Mon Feb 16 11:08:01 2004 @@ -90,8 +90,86 @@ the notes of the element. \end{itemize} +\subsection{Other minor projects} + +\begin{itemize} +\item multi-buffer, multi-frame +\item display additional information around current element (beaming + information, stem information (auto or not)), etc +\end{itemize} + \section{Major projects} +\subsection{Improved spacing algorithm} + +There are two aspects of the spacing algorithm: + +\begin{enumerate} +\item Determining how to divide a sequence of measures into pages and + lines based on the amount of space each measure will require on a + given line, +\item Rendering the page(s) actually visible by the user at any given + time. +\end{enumerate} + +We can spend relatively much time on rendering since it is supposedly +only done for a small fraction of the entire score and relatively +little time on dividing sequences of measures into pages and lines. +Also, we can accept a rough estimate of the space that a measure needs +for the purpose of dividing into pages and lines, whereas the +rendering phase needs to be very precise so as to avoid overlapping +characters. + +For rendering, we can assume that we have a bunch of \emph{lines}, +each one being a \emph{sequence of measures}. For this phase, one +idea would be to compute an \emph{elasticity function} for each +measure indicating how willing it is to stretch or compress given that +a certain force is applied to it. In fact it would indicate the width +as a function of force applied. Such a function would be piecewise +linear with rational coordinates to avoid rounding errors. The +elasticity function of a line would be the sum of the elasticity +functions of the measures of the line, again a piecewise linear +function. The combined function would then be solved for the line +length which gives a force to be applied to each measure (elementary +mechanics give that each measure in the sequence would have the same +force applied to it). To render each measure, that force would be +applied to it. + +The problem with dividing a sequence of measures into lines and pages +is that the elasticity function depends on the context. Specifically, +the \emph{natural width} (the width that the measure would take when +given a force of 0) depends on the smallest distance between two +adjacent time lines \emph{of all of the time lines in all of the +measures on a line}. This gets messy, since currently, we depend on +the cost function of a line to be combined in constant time, i.e., the +cost function of a line with a new measure added to the beginning or +to the end of it is possible to compute in constant time from the cost +function of the existing line and that of the new measure. Either I +am being to conservative here, and we can afford to spend more time +computing the cost function of a line, or else, we need to find an +approximation of the elasticity function that will combine in constant +time. This is hard to know until we have tested {\gs} on large +scores, and until we have implemented the page-breaking algorithm (as +opposed to the line-breaking algorithm that we now have). An example +of an approximation of the elasticity function would be to use the +current estimate with an additional value called \emph{additional +constant space}. The cost combination function would add the constant +spaces required by each measure as long as newly added measures have +the same smallest time-line distance (min-dist). As soon as a measure +with smaller min-dist is added to the line, the additional constant +space of the existing line is set to 0. The assumption is that the +existing line is going to have to expand as a result of the smaller +min-dist which will eliminate the need for the additional constant +space. Adding a measure with a larger min-dist than that of the +existing line would simply ignore the additional constant space of +that measure. Again, the assumption is that the new measure will have +to expand so that the additional space will not be needed. + +The additional constant spaced of a measure would be computed as if it +would be inserted into a line having the same min-dist as the measure +itself. Such space would include space for lyrics, accidentals of +complicated clusters, etc. + \subsection{Menu items with arguments} This is a {\clim} project. Currently {\clim} does not know how to @@ -141,3 +219,41 @@ \item Pages with an arbitrary number of pages, but the number must be of the form $n = ax + b$. \end{itemize} + +\subsection{Other major projects} + +\begin{itemize} +\item presentations everywhere (note heads, clusters, beam groups). +\item context menus on notes, etc +\item allow mouse-based input of new notes by making staff steps + around cursor into presentations. Move pointer to horizontal + location of cursor after interaction. +\item allow mouse-based addition and deletion of notes in existing + clusters by making staff steps around cluster into presentations +\item make sure user can use either keyboard or mouse without changing + too often +\item add new views of score, especially to manipulate staves, + brackets, braces, instruments, etc. +\item perhaps hide interactor by default and use something like M-x to + make it visible. +\item use output recording (hierarchical records) to reorganize pixmaps + and to substitute combined pixmaps. +\end{itemize} + +\section{McCLIM issues and projects} + +\begin{itemize} +\item add better system for Emacs-style commands and key + bindings +\item fix problem of input focus being retained (also a + problem for Goatee) +\item make sure gestures work as announced +\item perhaps make it possible to use something like M-x to change + input focus +\item make setf of frame-layout work +\item multiple top-level frames (as in Franz CLIM). +\item remove compilation warnings in McCLIM +\item remove dead code +\item remove reasons for remarks such as XXX:, FIXME, etc, or at least + put a name in their place +\end{itemize} \ No newline at end of file Index: gsharp/Doc/release-notes.tex diff -u gsharp/Doc/release-notes.tex:1.1.1.1 gsharp/Doc/release-notes.tex:1.2 --- gsharp/Doc/release-notes.tex:1.1.1.1 Mon Feb 16 10:46:31 2004 +++ gsharp/Doc/release-notes.tex Mon Feb 16 11:08:01 2004 @@ -1,5 +1,34 @@ \chapter{Release notes} +\section{Release 0.3 (2003-??-??)} + +\subsection{Features added from 0.2} + +\begin{itemize} +\item right edge of staff is no longer hard wired. +\item left margin is now a parameter of the buffer (and on disk). +\item x-position of first measure on line now depends on the size of + the key signature. This means that wide key signatures no longer + overlap with notes of the first measure on the line. +\item Improved MIDI generation making it no longer necessary to pad +measures with empty clusters. +\item Fixed a problem that made {\gs} crash on new versions of + McCLIM (thanks to Andy Hefner for figuring this out). +\item {\gs} can now use asdf instead of mk:defystem (thanks to + Christophe Rhodes). +\item {\gs} now runs on SBCL as well as on CMUCL (thanks to Christophe + Rhodes). +\end{itemize} + +\subsection{Bug fixes from 0.2} + +\begin{itemize} +\item last sharp sign in key signature with seven sharp signs is now + drawn. +\item fixed conformance bugs in some \texttt{loop} constructs (thanks to + Christophe Rhodes). +\end{itemize} + \section{Release 0.2 (2003-09-06)} \subsection{Features added from 0.1}

1 0

[gsharp-cvs] CVS update: gsharp/beaming.lisp gsharp/buffer.lisp gsharp/drawing.lisp gsharp/gui.lisp gsharp/measure.lisp gsharp/packages.lisp gsharp/system.lisp
by Robert Strandh 16 Feb '04

16 Feb '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv24224 Modified Files: beaming.lisp buffer.lisp drawing.lisp gui.lisp measure.lisp packages.lisp system.lisp Log Message: Updates since 0.2 release. Date: Mon Feb 16 11:08:00 2004 Author: rstrandh Index: gsharp/beaming.lisp diff -u gsharp/beaming.lisp:1.1.1.1 gsharp/beaming.lisp:1.2 --- gsharp/beaming.lisp:1.1.1.1 Mon Feb 16 10:46:06 2004 +++ gsharp/beaming.lisp Mon Feb 16 11:08:00 2004 @@ -9,10 +9,10 @@ ;;; The result of the computation is a VALID BEAMING. Such a beaming ;;; is represented as a list of two elements representing the left and -;;; the right end of the beam, respectively. Each element is a cons -;;; of two integers, the fist representing the staff line where the -;;; lower line is numbered 0, and so on in steps of two so that the -;;; upper one is numbered 8. The second of the two integers +;;; the right end of the primary beam, respectively. Each element is +;;; a cons of two integers, the fist representing the staff line where +;;; the lower line is numbered 0, and so on in steps of two so that +;;; the upper one is numbered 8. The second of the two integers ;;; represents the position of the beam with respect to the staff ;;; line, where 0 means straddle, 1 means sit and -1 means hang. This ;;; representation makes it easy to transform the constellation by Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.1.1.1 gsharp/buffer.lisp:1.2 --- gsharp/buffer.lisp:1.1.1.1 Mon Feb 16 10:46:10 2004 +++ gsharp/buffer.lisp Mon Feb 16 11:08:00 2004 @@ -815,7 +815,7 @@ (defgeneric staves (buffer)) ;;; Find a staff based on its name -(defgeneric find-staff (staff-name buffer &optional (errorp t))) +(defgeneric find-staff (staff-name buffer &optional errorp)) ;;; Add a segment to the buffer at the position given (defgeneric add-segment (segment buffer position)) @@ -826,7 +826,8 @@ (defvar *default-spacing-style* 0.4) (defvar *default-min-width* 17) (defvar *default-right-edge* 700) -(defvar *default-left-offset* 70) +(defvar *default-left-offset* 30) +(defvar *default-left-margin* 20) (defclass buffer () ((segments :initform '() :initarg :segments :accessor segments) @@ -834,12 +835,13 @@ (min-width :initform *default-min-width* :initarg :min-width :accessor min-width) (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))) + (left-offset :initform *default-left-offset* :initarg :left-offset :accessor left-offset) + (left-margin :initform *default-left-margin* :initarg :left-margin :accessor left-margin))) (defmethod print-object ((b buffer) stream) - (with-slots (staves segments min-width spacing-style right-edge left-offset) b - (format stream "[B :staves ~W :segments ~W :min-width ~W :spacing-style ~W :right-edge ~W :left-offset ~W ] " - staves segments min-width spacing-style right-edge left-offset))) + (with-slots (staves segments min-width spacing-style right-edge left-offset left-margin) b + (format stream "[B :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)) Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.1.1.1 gsharp/drawing.lisp:1.2 --- gsharp/drawing.lisp:1.1.1.1 Mon Feb 16 10:46:11 2004 +++ gsharp/drawing.lisp Mon Feb 16 11:08:00 2004 @@ -25,7 +25,7 @@ (:bass (lineno (clef staff))) (:treble (+ (lineno (clef staff)) 6)) (:c (+ (lineno (clef staff))) 3)))) - (loop for pitch in '(3 0 4 1 5 2) + (loop for pitch in '(3 0 4 1 5 2 6) for line in '(0 -3 1 -2 -5 -1 -4) for x from (+ x1 10 (staff-step 8)) by (staff-step 2.5) while (eq (aref (keysig staff) pitch) :sharp) @@ -96,28 +96,38 @@ (staff-yoffset (car (last staves))))))) (defmethod draw-buffer (pane (buffer buffer) *cursor* x y draw-cursor) - (let ((method (buffer-cost-method buffer)) - (staves (staves buffer))) - (loop for staff in staves - for offset from 0 by -90 do - (setf (staff-yoffset staff) offset)) - (with-staff-size 6 + (with-staff-size 6 + (let* ((staves (staves buffer)) + (timesig-offset (max (* (staff-step 2) + (loop for staff in staves + maximize (count :flat (keysig staff)))) + (* (staff-step 2.5) + (loop for staff in staves + maximize (count :sharp (keysig staff)))))) + (method (let ((old-method (buffer-cost-method buffer))) + (make-measure-cost-method (min-width old-method) + (spacing-style old-method) + (- (line-width old-method) timesig-offset)))) + (right-edge (right-edge buffer))) + (loop for staff in staves + for offset downfrom 0 by 90 do + (setf (staff-yoffset staff) offset)) (let ((yy y)) (gsharp-measure::new-map-over-obseq-subsequences (lambda (measures) (let ((widths (compute-widths measures method))) (with-vertical-score-position (pane yy) - (draw-system pane measures (+ x (left-offset buffer)) + (draw-system pane measures (+ x (left-offset buffer) timesig-offset) widths method staves draw-cursor) - (draw-bar-line pane (+ x 20) + (draw-bar-line pane x (staff-step 8) (staff-yoffset (car (last staves))))) (loop for staff in staves do (with-vertical-score-position (pane yy) (if (member staff (staves (layer (slice (bar *cursor*))))) - (draw-staff-and-clef pane staff (+ x 20) 700) + (draw-staff-and-clef pane staff x right-edge) (with-light-glyphs pane - (draw-staff-and-clef pane staff (+ x 20) 700)))) + (draw-staff-and-clef pane staff x right-edge)))) (decf yy 90)))) buffer))))) @@ -351,7 +361,7 @@ ;;; ;;; Cluster -(defgeneric draw-element (pane element x &optional (flags t))) +(defgeneric draw-element (pane element x &optional flags)) (defmethod note-difference ((note1 note) (note2 note)) (- (pitch note1) (pitch note2))) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.1.1.1 gsharp/gui.lisp:1.2 --- gsharp/gui.lisp:1.1.1.1 Mon Feb 16 10:46:17 2004 +++ gsharp/gui.lisp Mon Feb 16 11:08:00 2004 @@ -81,9 +81,10 @@ (add-command '(#\[) 'com-fewer-lbeams *x-command-table*) (add-command '(#\]) 'com-fewer-rbeams *x-command-table*) -(defmethod redisplay-frame-panes (frame &key force-p) - (loop for pane in (frame-panes frame) - do (redisplay-frame-pane frame pane :force-p force-p))) +(defmethod redisplay-gsharp-panes (frame &key force-p) + (loop for pane in (frame-current-panes frame) + do (when (typep pane 'score-pane) + (redisplay-frame-pane frame pane :force-p force-p)))) (defvar *gsharp-frame*) @@ -99,7 +100,7 @@ (setf *commands* *global-command-table*)) (t (format *error-output* "no command for ~a~%" key) (setf *commands* *global-command-table*))) - (redisplay-frame-panes *gsharp-frame* :force-p t)))) + (redisplay-gsharp-panes *gsharp-frame* :force-p t)))) (define-application-frame gsharp () ((buffer :initarg :buffer :accessor buffer) @@ -109,16 +110,17 @@ (:pointer-documentation t) (:panes (score (make-pane 'score-pane - :width 700 - :height 900 + :width 700 :height 900 + :name "score" :display-function 'display-score)) (state (make-pane 'score-pane - :width 50 :height 200 :display-function 'display-state)) + :width 50 :height 200 + :name "state" + :display-function 'display-state)) (element (make-pane 'score-pane - :width 50 - :height 700 - :min-height 100 - :max-height 20000 + :width 50 :height 700 + :min-height 100 :max-height 20000 + :name "element" :display-function 'display-element)) (interactor :interactor :height 100 :min-height 50 :max-height 200)) (:layouts @@ -167,10 +169,10 @@ (declare (ignore up)) (let ((x (+ xpos right))) (loop repeat (rbeams state) - for staff-step from 12 by -2 do + for staff-step downfrom 12 by 2 do (draw-beam pane x staff-step 0 (+ x 10) staff-step 0)) (loop repeat (lbeams state) - for staff-step from 12 by -2 do + for staff-step downfrom 12 by 2 do (draw-beam pane (- x 10) staff-step 0 x staff-step 0))))) (draw-right-stem pane xpos (staff-step 4) (staff-step 12)))) (with-notehead-right-offsets (right up) @@ -240,7 +242,8 @@ (recompute-measures buffer) (with-score-pane pane (flet ((draw-cursor (x) (draw-the-cursor pane x))) - (draw-buffer pane buffer (cursor *gsharp-frame*) 0 800 #'draw-cursor))))) + (draw-buffer pane buffer (cursor *gsharp-frame*) + (left-margin buffer) 800 #'draw-cursor))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -300,7 +303,7 @@ ("Segment" :menu segment-command-table) ("Layer" :menu layer-command-table) ("Slice" :menu slice-command-table) - ("Bar" :menu bar-command-table) + ("Measure" :menu measure-command-table) ("Modes" :menu modes-command-table) ("Play" :menu play-command-table))) @@ -316,7 +319,7 @@ ("Save as" :command com-save-buffer-as) ("Quit" :command com-quit))) -(define-gsharp-command com-new-buffer () +(define-gsharp-command (com-new-buffer :name t) () (let* ((buffer (make-initialized-buffer)) (cursor (make-initial-cursor buffer)) (staff (car (staves buffer))) @@ -326,7 +329,7 @@ (input-state *gsharp-frame*) input-state (staves (car (layers (car (segments buffer))))) (list staff)))) -(define-gsharp-command com-load-file ((filename 'string :prompt "File Name")) +(define-gsharp-command (com-load-file :name t) ((filename 'string :prompt "File Name")) (let* ((buffer (read-everything filename)) (staff (car (staves buffer))) (input-state (make-input-state staff)) @@ -336,14 +339,14 @@ (cursor *gsharp-frame*) cursor) (number-all (buffer *gsharp-frame*)))) -(define-gsharp-command com-save-buffer-as ((filename 'string :prompt "File Name")) +(define-gsharp-command (com-save-buffer-as :name t) ((filename 'string :prompt "File Name")) (with-open-file (stream filename :direction :output) (save-buffer-to-stream (buffer *gsharp-frame*) stream) (message "Saved buffer to ~A~%" filename))) -(define-gsharp-command com-quit () - (unix::unix-exit)) -;; (frame-exit *application-frame*)) +(define-gsharp-command (com-quit :name t) () + #+cmu (unix::unix-exit) + #+sbcl (frame-exit *application-frame*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -368,21 +371,21 @@ ("Insert After Current" :command com-insert-segment-after) ("Insert Before Current" :command com-insert-segment-before))) -(define-gsharp-command com-forward-segment () +(define-gsharp-command (com-forward-segment :name t) () (forward-segment (cursor *gsharp-frame*))) -(define-gsharp-command com-backward-segment () +(define-gsharp-command (com-backward-segment :name t) () (backward-segment (cursor *gsharp-frame*))) -(define-gsharp-command com-delete-segment () +(define-gsharp-command (com-delete-segment :name t) () (delete-segment (cursor *gsharp-frame*))) -(define-gsharp-command com-insert-segment-before () +(define-gsharp-command (com-insert-segment-before :name t) () (let ((cursor (cursor *gsharp-frame*))) (insert-segment-before (make-initialized-segment) cursor) (backward-segment cursor))) -(define-gsharp-command com-insert-segment-after () +(define-gsharp-command (com-insert-segment-after :name t) () (let ((cursor (cursor *gsharp-frame*))) (insert-segment-after (make-initialized-segment) cursor) (forward-segment cursor))) @@ -400,21 +403,21 @@ ("Insert After Current" :command com-insert-layer-after) ("Insert Before Current" :command com-insert-layer-before))) -(define-gsharp-command com-next-layer () +(define-gsharp-command (com-next-layer :name t) () (next-layer (cursor *gsharp-frame*)) (setf (staff (input-state *gsharp-frame*)) (car (staves (layer (slice (bar (cursor *gsharp-frame*)))))))) -(define-gsharp-command com-previous-layer () +(define-gsharp-command (com-previous-layer :name t) () (previous-layer (cursor *gsharp-frame*)) (setf (staff (input-state *gsharp-frame*)) (car (staves (layer (slice (bar (cursor *gsharp-frame*)))))))) -(define-gsharp-command com-delete-layer () +(define-gsharp-command (com-delete-layer :name t) () (delete-layer (cursor *gsharp-frame*))) -(define-gsharp-command com-insert-layer-before ((staff-name 'string :prompt "Staff")) +(define-gsharp-command (com-insert-layer-before :name t) ((staff-name 'string :prompt "Staff")) (let ((cursor (cursor *gsharp-frame*)) (staff (find-staff staff-name (buffer *gsharp-frame*)))) (if (not staff) @@ -426,7 +429,7 @@ (setf (staff (input-state *gsharp-frame*)) staff)))))) -(define-gsharp-command com-insert-layer-after ((staff-name 'string :prompt "Staff")) +(define-gsharp-command (com-insert-layer-after :name t) ((staff-name 'string :prompt "Staff")) (let ((cursor (cursor *gsharp-frame*)) (staff (find-staff staff-name (buffer *gsharp-frame*)))) (if (not staff) @@ -450,19 +453,19 @@ ("Body" :command com-body-slice) ("Tail" :command com-tail-slisce))) -(define-gsharp-command com-head-slice () +(define-gsharp-command (com-head-slice :name t) () (head-slice (cursor *gsharp-frame*))) -(define-gsharp-command com-body-slice () +(define-gsharp-command (com-body-slice :name t) () (body-slice (cursor *gsharp-frame*))) -(define-gsharp-command com-tail-slice () +(define-gsharp-command (com-tail-slice :name t) () (tail-slice (cursor *gsharp-frame*))) -(define-gsharp-command com-forward-slice () +(define-gsharp-command (com-forward-slice :name t) () (forward-slice (cursor *gsharp-frame*))) -(define-gsharp-command com-backward-slice () +(define-gsharp-command (com-backward-slice :name t) () (backward-slice (cursor *gsharp-frame*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -470,16 +473,15 @@ ;;; bar menu (make-command-table - 'bar-command-table + 'measure-command-table :errorp nil - :menu '(("Forward" :command com-forward-bar) - ("Backward" :command com-backward-bar) - ("Delete Current" :command com-delete-bar))) + :menu '(("Forward" :command com-forward-measure) + ("Backward" :command com-backward-measure))) -(define-gsharp-command com-forward-bar () +(define-gsharp-command (com-forward-measure :name t) () (forward-bar (cursor *gsharp-frame*))) -(define-gsharp-command com-backward-bar () +(define-gsharp-command (com-backward-measure :name t) () (backward-bar (cursor *gsharp-frame*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -491,7 +493,7 @@ :errorp nil :menu '(("Fundamental" :command com-fundamental))) -(define-gsharp-command com-fundamental () +(define-gsharp-command (com-fundamental :name t) () nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -510,52 +512,80 @@ (ecase (accidentals note) (:double-flat -2) (:flat -1) (:natural 0) (:sharp 1) (:double-sharp 2)))) -(defun track-from-slice (slice channel) +(defun measure-durations (slices) + (let ((durations (mapcar (lambda (slice) + (mapcar (lambda (bar) + (reduce #'+ (elements bar) + :key #'element-duration)) + (bars slice))) + slices))) + (loop while durations + collect (reduce #'max (mapcar #'car durations)) + do (setf durations (remove nil (mapcar #'cdr durations)))))) + +(defun events-from-element (element time channel) + (when (typep element 'cluster) + (append (mapcar (lambda (note) + (make-instance 'note-on-message + :time time + :status (+ #x90 channel) + :key (midi-pitch note) :velocity 100)) + (notes element)) + (mapcar (lambda (note) + (make-instance 'note-off-message + :time (+ time (* 128 (element-duration element))) + :status (+ #x80 channel) + :key (midi-pitch note) :velocity 100)) + (notes element))))) + +(defun events-from-bar (bar time channel) + (mapcan (lambda (element) + (prog1 (events-from-element element time channel) + (incf time (* 128 (element-duration element))))) + (elements bar))) + +(defun track-from-slice (slice channel durations) (cons (make-instance 'program-change-message :time 0 :status (+ #xc0 channel) :program 0) (let ((time 0)) - (mapcan - (lambda (bar) - (mapcan - (lambda (element) - (prog1 (when (typep element 'cluster) - (append (mapcar (lambda (note) - (make-instance 'note-on-message - :time time - :status (+ #x90 channel) - :key (midi-pitch note) :velocity 100)) - (notes element)) - (mapcar (lambda (note) - (make-instance 'note-off-message - :time (+ time (* 128 (element-duration element))) - :status (+ #x80 channel) - :key (midi-pitch note) :velocity 100)) - (notes element)))) - (incf time (* 128 (element-duration element))))) - (elements bar))) - (bars slice))))) - -(define-gsharp-command com-play-segment () + (mapcan (lambda (bar duration) + (prog1 (events-from-bar bar time channel) + (incf time (* 128 duration)))) + (bars slice) durations)))) + +(define-gsharp-command (com-play-segment :name t) () (let* ((slices (mapcar #'body (layers (car (segments (buffer *gsharp-frame*)))))) + (durations (measure-durations slices)) (tracks (loop for slice in slices for i from 0 - collect (track-from-slice slice i))) + collect (track-from-slice slice i durations))) (midifile (make-instance 'midifile :format 1 :division 25 :tracks tracks))) (write-midi-file midifile "test.mid") - (ext:run-program "timidity" '("test.mid")))) + #+cmu + (ext:run-program "timidity" '("test.mid")) + #+sbcl + (sb-ext:run-program "timidity" '("test.mid")) + #-(or cmu sbcl) + (error "write compatibility layer for RUN-PROGRAM"))) -(define-gsharp-command com-play-layer () +(define-gsharp-command (com-play-layer :name t) () (let* ((slice (body (layer (slice (bar (cursor *gsharp-frame*)))))) - (tracks (list (track-from-slice slice 0))) + (durations (measure-durations (list slice))) + (tracks (list (track-from-slice slice 0 durations))) (midifile (make-instance 'midifile :format 1 :division 25 :tracks tracks))) (write-midi-file midifile "test.mid") - (ext:run-program "timidity" '("test.mid")))) + #+cmu + (ext:run-program "timidity" '("test.mid")) + #+sbcl + (sb-ext:run-program "timidity" '("test.mid")) + #-(or cmu sbcl) + (error "write compatibility layer for RUN-PROGRAM"))) (defun run-gsharp () (loop for port in climi::*all-ports* @@ -926,7 +956,7 @@ (:up :down) (:down :auto)))) -(define-gsharp-command com-set-clef ((name '(member :treble :bass :c)) +(define-gsharp-command (com-set-clef :name t) ((name '(member :treble :bass :c)) (line '(or integer null) :prompt "Line")) (setf (clef (staff (input-state *gsharp-frame*))) (make-clef name line))) @@ -952,23 +982,23 @@ ;;; ;;; Adding, deleting, and modifying staves -(define-gsharp-command com-add-staff ((name 'string)) +(define-gsharp-command (com-add-staff :name t) ((name 'string)) (add-new-staff-to-buffer name (buffer *gsharp-frame*))) -(define-gsharp-command com-delete-staff ((name 'string)) +(define-gsharp-command (com-delete-staff :name t) ((name 'string)) (remove-staff-from-buffer name (buffer *gsharp-frame*))) -(define-gsharp-command com-rename-staff ((name 'string)) +(define-gsharp-command (com-rename-staff :name t) ((name 'string)) (let ((buffer (buffer *gsharp-frame*)) (state (input-state *gsharp-frame*))) (rename-staff name (staff state) buffer))) -(define-gsharp-command com-add-layer-staff ((name 'string)) +(define-gsharp-command (com-add-layer-staff :name t) ((name 'string)) (let ((staff (find-staff name (buffer *gsharp-frame*))) (layer (layer (slice (bar (cursor *gsharp-frame*)))))) (add-staff-to-layer staff layer))) -(define-gsharp-command com-delete-layer-staff ((name 'string)) +(define-gsharp-command (com-delete-layer-staff :name t) ((name 'string)) (let ((staff (find-staff name (buffer *gsharp-frame*))) (layer (layer (slice (bar (cursor *gsharp-frame*)))))) (remove-staff-from-layer staff layer))) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.1.1.1 gsharp/measure.lisp:1.2 --- gsharp/measure.lisp:1.1.1.1 Mon Feb 16 10:46:17 2004 +++ gsharp/measure.lisp Mon Feb 16 11:08:00 2004 @@ -295,7 +295,7 @@ (setf (obseq-cost-method buffer) (make-measure-cost-method (min-width buffer) (spacing-style buffer) - (- (right-edge buffer) (left-offset buffer)))) + (- (right-edge buffer) (left-margin buffer) (left-offset buffer)))) (obseq-solve buffer) (setf (modified-p buffer) nil))) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.1.1.1 gsharp/packages.lisp:1.2 --- gsharp/packages.lisp:1.1.1.1 Mon Feb 16 10:46:20 2004 +++ gsharp/packages.lisp Mon Feb 16 11:08:00 2004 @@ -60,7 +60,8 @@ #:remove-staff-from-layer #:stem-direction #:stem-length #:notehead-duration #:element-duration #:clef #:keysig #:staff-pos #:xoffset #:read-everything #:save-buffer-to-stream - #:min-width #:spacing-style #:right-edge #:left-offset + #:line-width #:min-width #:spacing-style #:right-edge #:left-offset + #:left-margin )) (defpackage :gsharp-numbering @@ -82,7 +83,7 @@ #:measure-min-dist #:measure-coeff #:measure-start-times #:measure-bar-pos #:measure-seg-pos #:measure-bars #:measures #:nb-measures #:measureno - #:recompute-measures #:measure-cost-method + #:recompute-measures #:measure-cost-method #:make-measure-cost-method #:buffer-cost-method #:reduced-width #:natural-width #:compress-factor #:measure-seq-cost)) Index: gsharp/system.lisp diff -u gsharp/system.lisp:1.1.1.1 gsharp/system.lisp:1.2 --- gsharp/system.lisp:1.1.1.1 Mon Feb 16 10:46:21 2004 +++ gsharp/system.lisp Mon Feb 16 11:08:00 2004 @@ -2,26 +2,40 @@ (defparameter *gsharp-directory* (directory-namestring *load-truename*)) -(defsystem :gsharp +(defmacro gsharp-defsystem ((module &key depends-on) &rest components) + `(defsystem ,module :source-pathname *gsharp-directory* - :source-extension "lisp" - :components - (:serial - "packages" - "utilities" - "gf" - "sdl" - "charmap" - "buffer" - "numbering" - "Obseq/obseq" - "measure" - "postscript" - "glyphs" - "score-pane" - "beaming" - "drawing" - "cursor" - "input-state" - "midi" - "gui")) + ,@(and depends-on `(:depends-on ,depends-on)) + :components (:serial ,@components))) + +#+asdf +(defmacro gsharp-defsystem ((module &key depends-on) &rest components) + `(asdf:defsystem ,module + ,@(and depends-on `(:depends-on ,depends-on)) + :serial t + :components (,@(loop for c in components + for p = (merge-pathnames + (parse-namestring c) + (make-pathname :type "lisp" + :defaults *gsharp-directory*)) + collect `(:file ,(pathname-name p) :pathname ,p))))) + +(gsharp-defsystem (:gsharp) + "packages" + "utilities" + "gf" + "sdl" + "charmap" + "buffer" + "numbering" + "Obseq/obseq" + "measure" + "postscript" + "glyphs" + "score-pane" + "beaming" + "drawing" + "cursor" + "input-state" + "midi" + "gui")

1 0

[gsharp-cvs] CVS update: gsharp/Obseq/obseq.x86f
by Robert Strandh 16 Feb '04

16 Feb '04

Update of /project/gsharp/cvsroot/gsharp/Obseq In directory common-lisp.net:/tmp/cvs-serv20865 Removed Files: obseq.x86f Log Message: Sorry. This made it to the repository by accident. Date: Mon Feb 16 10:51:18 2004 Author: rstrandh

1 0

[gsharp-cvs] CVS update: Module imported: gsharp
by Robert Strandh 16 Feb '04

16 Feb '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv3901 Log Message: import of 0.2 Status: Vendor Tag: strandh Release Tags: release-0-dot-2 N gsharp/INSTALL N gsharp/beaming.lisp N gsharp/buffer.lisp N gsharp/charmap.lisp N gsharp/cursor.lisp N gsharp/drawing.lisp N gsharp/gf.lisp N gsharp/glyphs.lisp N gsharp/gui.lisp N gsharp/input-state.lisp N gsharp/measure.lisp N gsharp/midi.lisp N gsharp/numbering.lisp N gsharp/packages.lisp N gsharp/postscript.lisp N gsharp/score-pane.lisp N gsharp/sdl.lisp N gsharp/system.lisp N gsharp/utilities.lisp N gsharp/Doc/Makefile N gsharp/Doc/accidentals.tex N gsharp/Doc/beaming-algo.tex N gsharp/Doc/beaming.tex N gsharp/Doc/commands.tex N gsharp/Doc/gsharp.tex N gsharp/Doc/history.tex N gsharp/Doc/intro.tex N gsharp/Doc/linebreak.tex N gsharp/Doc/model.tex N gsharp/Doc/obseq.tex N gsharp/Doc/old-beaming.tex N gsharp/Doc/plans.tex N gsharp/Doc/release-notes.tex N gsharp/Doc/spec-macros.tex N gsharp/Doc/strip-dependence N gsharp/Doc/tex-dependencies N gsharp/Fonts/Makefile N gsharp/Fonts/accents.mf N gsharp/Fonts/accidentals.mf N gsharp/Fonts/beams.mf N gsharp/Fonts/c_clef.mf N gsharp/Fonts/charmap.mf N gsharp/Fonts/clefs.mf N gsharp/Fonts/dot.mf N gsharp/Fonts/double-flat.mf N gsharp/Fonts/double-sharp.mf N gsharp/Fonts/eighth_rest.mf N gsharp/Fonts/f_clef.mf N gsharp/Fonts/flags.mf N gsharp/Fonts/flat.mf N gsharp/Fonts/g_clef.mf N gsharp/Fonts/half_rest.mf N gsharp/Fonts/macros.mf N gsharp/Fonts/natural.mf N gsharp/Fonts/noteheads.mf N gsharp/Fonts/quarter_rest.mf N gsharp/Fonts/rests.mf N gsharp/Fonts/sdl.mf N gsharp/Fonts/sharp.mf N gsharp/Fonts/whole_rest.mf N gsharp/Obseq/obseq.lisp N gsharp/Obseq/obseq.x86f N gsharp/Scores/alundavisan.gsh N gsharp/Scores/bach181.gsh N gsharp/Scores/bach262.gsh N gsharp/Scores/blomsteroffret.gsh N gsharp/Scores/clusters.gsh N gsharp/Scores/clusters2.gsh N gsharp/Scores/elise2.gsh N gsharp/Scores/rapsoden-sjunger.gsh N gsharp/Scores/smaland.gsh N gsharp/Scores/stuff.gsh N gsharp/Scores/test.gsh N gsharp/Scores/tomtegubbar.gsh N gsharp/Scores/tomtegubbar2.gsh N gsharp/Scores/vinter-adjo.gsh No conflicts created by this import Date: Mon Feb 16 10:47:23 2004 Author: rstrandh New module gsharp added

1 0