gsharp-cvs January 2006

gsharp-cvs@common-lisp.net

2 participants
11 discussions

[gsharp-cvs] CVS gsharp/Doc
by rstrandh 27 Jan '06

27 Jan '06

Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp:/tmp/cvs-serv22503 Modified Files: gsharp.tex intro.tex Log Message: Starting to update the manual to reflect the code. --- /project/gsharp/cvsroot/gsharp/Doc/gsharp.tex 2005/11/15 19:14:58 1.6 +++ /project/gsharp/cvsroot/gsharp/Doc/gsharp.tex 2006/01/27 01:47:22 1.7 @@ -103,29 +103,60 @@ We have not worked on the installation procedure at all, and in fact, we have not decided exactly in what form the releases will be made -available to the public. +available to the public. For that reason, these instructions may +change in the future. + +{\gs} uses a number of programs and libraries that you need to install +before installing {\gs} itself. + + +Most importantly, you will need an implementation of {\commonlisp}. +We recommend SBCL on GNU/Linux x86 and OpenMCL on MacOS PPC. + +To install the libraries and {\gs} itself, you will need ASDF, which +comes with some {\commonlisp} implementations. If not, you will have +to install it first. + +You will need a copy of the Flexichain library which you can find on +common-lisp.net. + +You will need to download a copy of McCLIM, the free implementation of +the Common Lisp Interface Manager. Again, you will find it on +common-lisp.net. + +{\gs} uses a library on top of McCLIM called ESA (for Emacs-Style +Application). For now, the ESA library is distributed with {\gs}, but +that might change in the future, in which case you will need a copy of +it as well, again from common-lisp.net. + +If you have downloaded a \emph{tar}-file of {\gs}, you need to untar +it (using something like \texttt{tar xvf gsharp.tar}) in some +directory. If you have downloaded {\gs} from a CVS repository, you +already have the directory structure required. First make the fonts. In the \texttt{Fonts} subdirectory, type \texttt{make}. -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: +To compile and load {\gs}, you have two possibilities (as with most of +the libraries): either load the \texttt{gsharp.asd} file manually, or +put the directory in which {\gs} resides in the +\texttt{asdf:*central-registry*} list of software that can compiled +and installed using ASDF. + +Next, follow the instructions for installing ASDF, Flexichain, and +McCLIM. When you have all these libraries in a running {\lisp} image, +type: \texttt{(asdf:operate 'asdf:load-op :gsharp)} -which will compile and load all the files. To start {\gs} type +which will compile and load all the files of {\gs}. To start {\gs} type \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} -You should be seeing a main window (known as a \emph{frame}) with a -menu bar and four sub-windows, known as \emph{panes}. +When you start {\gs}, you should see a number of windows (called +\emph{panes}) that are described briefly in this section. \subsection{The score pane} \label{sec-score-pane} @@ -139,27 +170,30 @@ representation of the staff in the score pane to satisfy the request for the staff. -\subsection{The command pane} -label{sec-command-pane} +\subsection{The minibuffer} +\label{sec-minibuffer} -The pane at the bottom is a {\clim} \emph{command pane}\index{command - pane}\index{pane!command|)}. In it, you can type -commands that do not have keyboard shortcuts. - -The command pane is also where you get prompted for arguments to -various {\gs} commands. In those cases, you usually have a choice -between clicking on a visual representation of the argument you would -like to supply as mentioned in section \ref{sec-score-pane}, or to -type some textual representation of it directly at the prompt. +The pane at the bottom is called the +\emph{minibuffer}\index{minibuffer}. In it, you can type +\emph{extended commands} (invoked by the keystroke M-x) that do not +have keyboard shortcuts. + +The minibuffer is also where you get prompted for arguments to various +{\gs} commands. In those cases, you usually have a choice between +clicking on a visual representation of the argument you would like to +supply as mentioned in section \ref{sec-score-pane}, typing some +textual representation of it directly at the prompt, or using the +right mouse button to get a menu of all possibilities from which you +can select the one you want. When typing some textual representation of some existing object, such as the name of a layer or of a staff, you can usually use \emph{completion}\index{completion}, which means that you can type a unique prefix of the text and then use the \kbd{TAB} key to get {\gs} -to fill in the rest. Using completion after having issued a command -in the command pane is usually faster (provided you have some idea of -what the textual representation is) than to grab the mouse and click -on the object in the score pane. +to fill in the rest. Using completion after having been prompted for +some argument is usually faster (provided you have some idea of what +the textual representation is) than to grab the mouse and click on the +object in the score pane. \subsection{Other panes} @@ -193,7 +227,7 @@ The cursor is either before all the elements, after all the elements, or between two element. Newly created elements will be inserted immediately to the left of the cursor (which will make the newly -inserted element the \emph{current} one. +inserted element the \emph{current} one). The yellow line indicates the staff to which newly inserted elements will belong. The red lines indicate the interval of pitches that will @@ -240,7 +274,7 @@ \section{Adding a rest} A rest is another kind of element. You enter a rest by typing \kbd{,} -\command{Insert Rest}. Conceptually, every rest has a notehead as +(\command{Insert Rest}). Conceptually, every rest has a notehead as well as rbeams and lbeams in addition to augmentation dots. These are used to determine the duration and what kind of rest to display. @@ -251,7 +285,7 @@ \kbd{h} key. It is also possible to delete the next element after the cursor by -typing \kbd{Control-d} (\command{Delete Element}. +typing \kbd{Control-d} (\command{Delete Element}). In general, we speak about \emph{erasing}\index{erasing} when the material removed is to the left of the cursor, and @@ -422,11 +456,11 @@ hand'', etc. You can give a different name to an existing staff by issuing the -command \command{Rename Staff}, either from a menu or form the command -pane. This command prompts for a staff to rename and a new name for -the staff. At the prompt for the staff to rename, you have a choice -of clicking on a staff on display as indicated in section -\ref{sec-score-pane}, or typing its name in the command pane possibly +command \command{Rename Staff}, either from a menu or form the +minibuffer. This command prompts for a staff to rename and a new name +for the staff. At the prompt for the staff to rename, you have a +choice of clicking on a staff on display as indicated in section +\ref{sec-score-pane}, or typing its name in the minibuffer possibly with \emph{completion}\index{completion} as indicated in section \ref{sec-score-pane}. Renaming a staff is such an infrequent operation that there is no keyboard shortcut for it. @@ -439,7 +473,7 @@ to the score. Because adding new staves are done fairly infrequently, there is no keyboard shortcut for doing it. Instead, you have to issue one of the commands for doing this either by typing it (with -completion, see \ref{sec-command-pane}) in the command pane or using +completion, see \ref{sec-minibuffer}) in the minibuffer or using the mouse to select one from a menu. {\gs} imposes an \emph{order} on the staves of a score. This order is @@ -455,18 +489,18 @@ \command{Insert Staff Before} you would like to insert the new staff. As usual, you can either click on a visual representation of the staff in the score pane (see section \ref{sec-score-pane}) or type its name -in the command pane with completion (see section -\ref{sec-command-pane}). +in the minibuffer with completion (see section +\ref{sec-minibuffer}). Next, you are prompted for the type of the staff to create. There are currently two types of staves, namely `fiveline' and `lyrics'. At the moment, the only way to answer this question is to type it in the -command pane (again, completion is available). +minibuffer (again, completion is available). If you requested a five-line staff to be created, you will also be prompted for the type of clef you would like the staff to have. There are three possible choices `treble', `bass', and `c', which you have -to type in the command pane at the prompt. You will also be prompted +to type in the minibuffer at the prompt. You will also be prompted for a `line' number on which the clef is to be placed. Recall that the lines are numbered with even numbers starting with `0' for the bottom line of the staff. The normal place for a treble clef is thus @@ -479,14 +513,14 @@ \section{Deleting a staff} To delete an existing staff, you issue the \command{Delete Staff} -command, either from a menu or in the command pane. Deleting an +command, either from a menu or in the minibuffer. Deleting an existing staff is such an infrequent operation that no keyboard shortcut is provided. The command prompts for a staff to be deleted. As usual, you can either satisfy the request by clicking on the visual representation of a staff in the score pane (see section \ref{sec-score-pane}) or typing -a response in the command pane (see section \ref{sec-command-pane}). +a response in the minibuffer (see section \ref{sec-minibuffer}). \section{Changing the key signature} @@ -521,13 +555,13 @@ \section{Renaming an existing layer} You can rename any layer by issuing the command \command{Rename -Layer}, either in the command pane (see section -\ref{sec-command-pane}) or from a menu. +Layer}, either in the minibuffer (see section +\ref{sec-minibuffer}) or from a menu. You will first be prompted for a layer to rename. Currently the only way to satisfy this request is by typing the name of the layer to the -prompt in the command pane. Completion is possible as usual (see -section \ref{sec-command-pane}). +prompt in the minibuffer. Completion is possible as usual (see +section \ref{sec-minibuffer}). Next, you will be prompted for a new name of the layer. To satisfy the request, you type any string at the prompts. Notice that names @@ -541,12 +575,12 @@ notes, rests, etc. To change the current layer, issue the \command{Select Layer} either -from a menu or in the command pane. +from a menu or in the minibuffer. You will be prompted for a layer to be used as the current one. At the moment, the only way to satisfy this request is to type its unique -name (with completion, see \ref{sec-command-pane}) at the prompt in -the command pane. +name (with completion, see \ref{sec-minibuffer}) at the prompt in +the minibuffer. \section{Adding a new layer} @@ -565,7 +599,7 @@ \section{Deleting a layer} -To delete the current layer, you have to use the command pane (since +To delete the current layer, you have to use the minibuffer (since this is an operation that is presumably rare). The command to use is \command{Delete Layer}. You will be prompted for a layer to delete. --- /project/gsharp/cvsroot/gsharp/Doc/intro.tex 2004/02/16 15:46:26 1.1.1.1 +++ /project/gsharp/cvsroot/gsharp/Doc/intro.tex 2006/01/27 01:47:22 1.2 @@ -11,27 +11,34 @@ command to type in order for the final layout to appear; the final layout is always the one that is presented. -One of the main goal of {\gs} is to provide a program that can produce -high-quality scores. For that reason, we have put in some effort to -respect at least one set of rules of musical typography (or -\emph{engraving}\index{engraving}). But music engraving is hard and -littered with very complex rules that do not necessarily cover all -cases. For that reason, {\gs} also provides \unimp{We ultimately - intend to provide a large spectrum of ways for the user to tweak the - layout decisions, but for now, only automatic layout exists.} a -number of ways in which the user can help the layout engine make the -right decision. +One of the main goals of {\gs} is to provide a program that can +produce high-quality scores. For that reason, we have put in some +effort to respect at least one set\footnote{The rules defined in Ted +Ross' book: Teach yourself music engraving and printing} of rules of +musical typography (or \emph{engraving}\index{engraving}). But music +engraving is hard and littered with very complex rules that do not +necessarily cover all cases. For that reason, {\gs} also provides +\footnote{Only some of these features are currently implemented. We +ultimately intend to provide a large spectrum of ways for the user to +tweak the layout decisions, but for now, only automatic layout +exists.} a number of ways in which the user can help the layout engine +make the right decision. -We wanted {\gs} to be extensible at a number of level. The ordinary +We wanted {\gs} to be extensible at a number of levels. The ordinary end-user should be able to add and redefine keystrokes, to create macros, and to alter global parameters that affect the end result. The more advanced end-user should be able to write more complex -extensions. Usually, programs that permit this use a {\gs} scripting -language, which is usually different from the programming language +extensions. Usually, programs that permit this use a \emph{scripting +language}, which is usually different from the programming language that was used to implement the basic functionality of the program. {\gs} has a different approach. The entire program is written in -{\commonlisp} which both is as fast as a lower-level language and provides the -ability to dynamically replace any part of the program. +{\commonlisp} which both is as fast as a lower-level language and +provides the ability to dynamically replace any part of the program. +Advanced users and programmers can use {\commonlisp} to extend {\gs}, +to modify the standard behavior of {\gs}, and even to replace large +chunks of {\gs} to suits specific needs. We intend to provide +documentation that explains how to accomplish such adaptations at +various degrees of complexity. Since {\gs} makes extensive use of graphics and related functionality, we needed a good library for providing such functionality. While the @@ -39,7 +46,7 @@ semi-standard library available for many years and which only recently exists in a freely distributable version, namely {\clim}\index{\clim}, which stands for the Common Lisp Interface Manager. Many of the basic -functions of {\gs} are due to {\clim}, and the advances {\gs} user can +functions of {\gs} are due to {\clim}, and the advanced {\gs} user can take advantage of this fact in order to improve the program. We deliberately did not try commercial score editors so as not to be @@ -108,6 +115,14 @@ There is no upper bound on the minor release number. +Aside from releases, the CVS repository is publicly available at +common-lisp.net, and recent snapshots can be downloaded by anyone. +This is the preferable method for tracking {\gs} progress by users who +want the latest improvements and by contributors to the {\gs} code. +Users who depend on a stable {\gs} on a daily basis \footnote{which we + highly recommend against as of now (early 2006)} should not use this +method to get a recent version of {\gs}. + % ------------------------------------------ \section{Contributions} @@ -125,7 +140,11 @@ is our goal to try to keep the code at a reasonably good level. For that reason, contributors are encouraged to put some effort into the quality of the code, to make sure it compiles without warnings (as -much as possible) and to make sure it works. +much as possible) and to make sure it works. We encourage the use of +documentation strings with any externally-available functionality and +the use of comments whenever needed to explain some otherwise +hard-to-understand code. \footnote{we prefer that the code not be hard + to understand} We also accept contributions to this document. We intend to use some kind of free license for this document, probably the GNU Free @@ -138,13 +157,13 @@ The \emph{getting started} part is intended for users who look at {\gs} for the first time, and who want to know how to use the most -fundamental aspects of it, in particular the basic architecture of the -program. It is not intended to be a complete user's guide, but -instead structured around a few typical use cases encountered by -users. +fundamental aspects of it, in particular the basic externally-visible +architecture of the program. It is not intended to be a complete +user's guide, but instead structured around a few typical use cases +encountered by users. The \emph{reference manual} is the part that is most useful to the -user that has graduated beyond the first impression, and who want to +user that has graduated beyond the first impression, and who wants to know more about the features of {\gs}. The structure of this part is not meant to be pedagogical, but instead a complete enumeration of the features of {\gs} that a moderately experienced users needs to know.

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 25 Jan '06

25 Jan '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp:/tmp/cvs-serv21207 Modified Files: drawing.lisp measure.lisp Log Message: Fixed a problem that made zero-duration elements generate zero-elasticity timelines, which is not acceptable. Fixed a problem that messed up the timelines when there were two consecutive zero-duration elements. --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/01/21 23:39:16 1.56 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/01/25 00:50:56 1.57 @@ -98,7 +98,7 @@ 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)))))) + (max (expt (duration timeline) (spacing-style method)) 0.0001))))) ;;; FIXME: there should be an :around method that adds the value ;;; return by the main method to the explicit horizontal offset that --- /project/gsharp/cvsroot/gsharp/measure.lisp 2006/01/22 20:38:52 1.24 +++ /project/gsharp/cvsroot/gsharp/measure.lisp 2006/01/25 00:50:56 1.25 @@ -649,7 +649,8 @@ (flexichain:insert* timelines timeline-index timeline))) do (let ((timeline (flexichain:element* timelines timeline-index))) (push element (elements timeline)) - (setf (timeline element) timeline))))) + (setf (timeline element) timeline) + (incf timeline-index))))) (loop for bar in (measure-bars measure) do (compute-bar-timelines bar))) ;; compute the duration of each timeline except the last one

1 0

[gsharp-cvs] CVS gsharp/Fonts
by rstrandh 25 Jan '06

25 Jan '06

Update of /project/gsharp/cvsroot/gsharp/Fonts In directory common-lisp:/tmp/cvs-serv21165 Modified Files: viewer.lisp Log Message: Make the font viewer play nicely with the other CLIM applications by not having it destroy all ports before starting up. --- /project/gsharp/cvsroot/gsharp/Fonts/viewer.lisp 2005/11/14 19:59:46 1.2 +++ /project/gsharp/cvsroot/gsharp/Fonts/viewer.lisp 2006/01/25 00:47:22 1.3 @@ -119,9 +119,6 @@ (t +black+)))))))) (defun viewer () - (loop for port in climi::*all-ports* - do (destroy-port port)) - (setq climi::*all-ports* nil) (let ((frame (make-application-frame 'gf-viewer))) (run-frame-top-level frame)))

1 0

[gsharp-cvs] CVS gsharp
by CVS User rstrandh 22 Jan '06

22 Jan '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp:/tmp/cvs-serv3491 Modified Files: measure.lisp packages.lisp Log Message: The conversion to allow Gsharp to deal with elements (and thus timelines) and measures of zero duration should now be complete. Of course, there might still be some issues, since I haven't really tested it with elements of zero duration. --- /project/gsharp/cvsroot/gsharp/measure.lisp 2006/01/21 23:39:16 1.23 +++ /project/gsharp/cvsroot/gsharp/measure.lisp 2006/01/22 20:38:52 1.24 @@ -429,10 +429,10 @@ ;;; 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) + (min-dist :initarg :min-dist :accessor measure-min-dist) ;; 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) + (coeff :initarg :coeff :accessor measure-coeff) ;; 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 @@ -449,9 +449,8 @@ ;; is applied to it (elasticity-function :accessor elasticity-function))) -(defun make-measure (min-dist coeff seg-pos bar-pos bars) - (make-instance 'measure :min-dist min-dist :coeff coeff - :seg-pos seg-pos :bar-pos bar-pos :bars bars)) +(defun make-measure (seg-pos bar-pos bars) + (make-instance 'measure :seg-pos seg-pos :bar-pos bar-pos :bars bars)) (defmethod print-object ((obj measure) stream) (with-slots (min-dist coeff seg-pos bar-pos) obj @@ -487,9 +486,11 @@ (defmethod measures :before ((segment rsegment)) (when (modified-p segment) - (compute-measures segment (spacing-style (buffer-cost-method (buffer segment)))) - ;; avoid an infinite computation by using slot-value here - (mapc #'compute-timelines (slot-value segment 'measures)) + (let ((spacing-style (spacing-style (buffer-cost-method (buffer segment))))) + (compute-measures segment) + ;; avoid an infinite computation by using slot-value here + (loop for measure in (slot-value segment 'measures) + do (compute-timelines measure spacing-style))) (setf (modified-p segment) nil))) (defmethod nb-measures ((segment rsegment)) @@ -500,60 +501,7 @@ (defmethod measureno ((segment rsegment) position) (elt (measures segment) position)) -;;; 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 -;;; 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)) - '(0)))) - -;;; Combine the list of start times of two bars into a single list -;;; of start times. If any of the list contains duplicate start -;;; times, then the resulting list will contain as many duplicates -;;; as the maximum number of duplicates of the two lists. -;;; 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) - (labels ((combine (l1 l2) - (cond ((null l1) l2) - ((null l2) l1) - ((< (car l1) (car l2)) - (cons (car l1) (combine (cdr l1) l2))) - ((< (car l2) (car l1)) - (cons (car l2) (combine (cdr l2) l1))) - (t (cons (car l1) (combine (cdr l1) (cdr l2))))))) - (append (combine (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 +;;; 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 @@ -667,24 +615,15 @@ ;;; 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) +(defun compute-measure (bars seg-pos bar-pos) (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 (reduce #'combine-bars - (mapcar #'start-times bars))) - (durations (abs-rel start-times)) - ;; elements with zero duration do not intervene - ;; in the computation of the min-dist. - ;; Choose a large default value for min-dist. - (min-dist (reduce #'min (remove 0 durations) :initial-value 10000)) - (coeff (loop for duration in durations - sum (expt duration spacing-style)))) - (make-measure min-dist coeff seg-pos bar-pos bars)))) + (make-measure seg-pos bar-pos bars))) -(defun compute-timelines (measure) +(defun compute-timelines (measure spacing-style) (let ((timelines (timelines measure))) (flet ((compute-bar-timelines (bar) (loop with timeline-index = 0 @@ -701,8 +640,10 @@ (not (zerop (duration (car (elements timeline)))))))) do (incf timeline-index)) do (when (or (= timeline-index (flexichain:nb-elements timelines)) - (> (start-time (flexichain:element* timelines timeline-index)) - start-time)) + (let ((timeline (flexichain:element* timelines timeline-index))) + (or (> (start-time timeline) start-time) + (and (zerop (duration element)) + (not (zerop (duration (car (elements timeline))))))))) (let ((timeline (make-instance 'timeline :start-time start-time))) (flexichain:insert* timelines timeline-index timeline))) @@ -720,11 +661,21 @@ (unless (zerop (flexichain:nb-elements timelines)) (let ((measure-duration (reduce #'max (measure-bars measure) :key #'duration)) (last-timeline (flexichain:element* timelines (1- (flexichain:nb-elements timelines))))) - (setf (duration last-timeline) (- measure-duration (start-time last-timeline))))))) + (setf (duration last-timeline) (- measure-duration (start-time last-timeline))))) + ;; set the coefficient and the min-dist of the measure + (loop with min-dist = 10000 + for timeline-index from 0 below (flexichain:nb-elements timelines) + for duration = (duration (flexichain:element* timelines timeline-index)) + sum (expt duration spacing-style) into coeff + do (when (plusp duration) (setf min-dist (min min-dist duration))) + ;; timelines with zero duration do not intervene in the calculation + ;; of the min-dist + finally (setf (measure-coeff measure) coeff + (measure-min-dist measure) min-dist)))) ;;; 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) +(defun compute-measures (segment) (setf (slot-value segment 'measures) (loop for all-bars on (mapcar (lambda (layer) (bars (body layer))) (layers segment)) @@ -732,7 +683,7 @@ as bar-pos from 0 by 1 while (notevery #'null all-bars) collect (compute-measure - (remove nil (mapcar #'car all-bars)) spacing-style + (remove nil (mapcar #'car all-bars)) (number segment) bar-pos)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --- /project/gsharp/cvsroot/gsharp/packages.lisp 2006/01/05 19:14:45 1.40 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2006/01/22 20:38:52 1.41 @@ -124,7 +124,7 @@ (:shadowing-import-from :gsharp-numbering #:number) (:shadowing-import-from :gsharp-buffer #:rest) (:export #:mark-modified #:modified-p #:measure - #:measure-min-dist #:measure-coeff #:measure-start-times + #:measure-min-dist #:measure-coeff #:measure-bar-pos #:measure-seg-pos #:measure-bars #:measures #:nb-measures #:measureno #:recompute-measures #:measure-cost-method #:make-measure-cost-method

1 0

[gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/drawing.lisp gsharp/measure.lisp
by rstrandh＠common-lisp.net 21 Jan '06

21 Jan '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp:/tmp/cvs-serv5433 Modified Files: buffer.lisp drawing.lisp measure.lisp Log Message: Removed some dead code. Prepared Gsharp for handling timelines and measures of zero duration. This conversion is not entirely finished yet, but there is not much left. Date: Sat Jan 21 17:39:16 2006 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.28 gsharp/buffer.lisp:1.29 --- gsharp/buffer.lisp:1.28 Thu Jan 5 13:14:45 2006 +++ gsharp/buffer.lisp Sat Jan 21 17:39:16 2006 @@ -495,6 +495,14 @@ (defmethod print-object :after ((b bar) stream) (format stream ":elements ~W " (elements b))) +;;; The duration of a bar is simply the sum of durations +;;; of its elements. We might want to improve on the +;;; implementation of this method so that it uses some +;;; kind of cache, in order to avoid looping over each +;;; element and computing the duration of each one each time. +(defmethod duration ((bar bar)) + (reduce #'+ (mapcar #'duration (elements bar)))) + (defgeneric make-bar-for-staff (staff &rest args &key elements)) (defmethod nb-elements ((bar bar)) @@ -935,7 +943,7 @@ (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. + ;; timeline 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. Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.55 gsharp/drawing.lisp:1.56 --- gsharp/drawing.lisp:1.55 Tue Jan 3 08:25:46 2006 +++ gsharp/drawing.lisp Sat Jan 21 17:39:16 2006 @@ -82,37 +82,8 @@ (defun final-absolute-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)) - -(defun compute-compress-factor (measures method) - (compress-factor method (line-cost measures method))) - -(defun red-width (method coeff min-dist) - (* coeff (min-width method) (expt (/ min-dist) (spacing-style method)))) - -(defun compute-reduced-width (method coeff min-dist) - (if (zerop min-dist) 0 (red-width method coeff min-dist))) - -(defun nat-width (method coeff min-dist) - (+ (red-width method coeff min-dist) (min-width method))) - (defvar *cursor* nil) -(defun compute-min-dist (measures) - (let ((min-dists (mapcar (lambda (measure) - (reduce #'min (gsharp-measure::abs-rel - (measure-start-times measure)))) - measures))) - (reduce #'min min-dists))) - -(defun compute-widths (measures method) - (let ((compress (compute-compress-factor measures method)) - (min-dist (compute-min-dist measures))) - (loop for measure in measures - 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 @@ -316,9 +287,7 @@ finally (setf (elasticity-function measure) result))) (reduce #'add-elasticities measures :key #'elasticity-function)) -;;; eventually replace the existing compute-measure-coordinates -;;; by this one -(defun new-compute-measure-coordinates (measure x y force) +(defun compute-measure-coordinates (measure x y force) (loop with timelines = (timelines measure) for i from 0 below (flexichain:nb-elements timelines) for timeline = (flexichain:element* timelines i) @@ -330,28 +299,6 @@ (loop for bar in (measure-bars measure) do (compute-bar-coordinates bar x y (size-at-force (elasticity-function measure) force)))) -(defun compute-measure-coordinates (measure min-dist compress x y method) - (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) - compress)) - (time-alist (cons (cons 0 (/ (min-width method) compress)) - (loop for start-time in (measure-start-times measure) - and old-start-time = 0 then start-time - with coeff = 0 - do (incf coeff (expt (- start-time old-start-time) - (spacing-style method))) - collect (cons start-time - (/ (+ (min-width method) - (compute-reduced-width - method - coeff min-dist)) - compress)))))) -;; (setf (system-y-position measure) y -;; (final-absolute-measure-xoffset measure) x -;; (final-width measure) width) - (loop for bar in (measure-bars measure) do - (compute-bar-coordinates bar x y width) - (compute-element-x-positions bar x time-alist)))) - (defun draw-measure (pane measure) (loop for bar in (measure-bars measure) do (if (gsharp-cursor::cursors (slice bar)) @@ -366,21 +313,11 @@ (+ y (- (score-pane:staff-step 8))) (+ y (staff-yoffset (car (last staves)))))))) -;;; eventually remove the existing compute-system-coordinates -;;; and rename this one -(defun new-compute-system-coordinates (measures x y force) +(defun compute-system-coordinates (measures x y force) (loop for measure in measures - do (new-compute-measure-coordinates measure x y force) + do (compute-measure-coordinates measure x y force) do (incf x (size-at-force (elasticity-function measure) force)))) -(defun compute-system-coordinates (measures x y widths method) - (let ((compress (compute-compress-factor measures method)) - (min-dist (compute-min-dist measures))) - (loop for measure in measures - for width in widths do - (compute-measure-coordinates measure min-dist compress x y method) - (incf x width)))) - (defun draw-system (pane measures) (loop for measure in measures do (draw-measure pane measure))) @@ -407,7 +344,6 @@ (right-edge (right-edge buffer))) (loop for staff in staves for offset from 0 by 90 do -;; for offset downfrom 0 by 90 do (setf (staff-yoffset staff) offset)) (let ((yy y)) (gsharp-measure::new-map-over-obseq-subsequences @@ -421,25 +357,20 @@ (force (if (> (zero-force-size e-fun) (line-width method)) 0 (force-at-size e-fun (line-width method))))) - (new-compute-system-coordinates measures - (+ x (left-offset buffer) timesig-offset) yy - force) - ) - (let ((widths (compute-widths measures method))) -;; (compute-system-coordinates measures -;; (+ x (left-offset buffer) timesig-offset) yy -;; widths method) - (draw-system pane measures) - (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*))))) - (draw-staff-and-clef pane staff x right-edge) - (score-pane:with-light-glyphs pane - (draw-staff-and-clef pane staff x right-edge)))) - (incf yy 90)))) + (compute-system-coordinates measures + (+ x (left-offset buffer) timesig-offset) yy + force)) + (draw-system pane measures) + (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*))))) + (draw-staff-and-clef pane staff x right-edge) + (score-pane:with-light-glyphs pane + (draw-staff-and-clef pane staff x right-edge)))) + (incf yy 90))) buffer))))) (define-added-mixin velement () melody-element Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.22 gsharp/measure.lisp:1.23 --- gsharp/measure.lisp:1.22 Thu Jan 5 13:14:45 2006 +++ gsharp/measure.lisp Sat Jan 21 17:39:16 2006 @@ -413,7 +413,7 @@ (defclass timeline (flexichain:element-rank-mixin) ((start-time :initarg :start-time :reader start-time) (elements :initform '() :accessor elements) - (duration :initarg :duration :reader duration) + (duration :initarg :duration :accessor duration) (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 @@ -433,9 +433,6 @@ ;; 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 @@ -452,9 +449,8 @@ ;; is applied to it (elasticity-function :accessor elasticity-function))) -(defun make-measure (min-dist coeff start-times seg-pos bar-pos bars) +(defun make-measure (min-dist coeff seg-pos bar-pos bars) (make-instance 'measure :min-dist min-dist :coeff coeff - :start-times start-times :seg-pos seg-pos :bar-pos bar-pos :bars bars)) (defmethod print-object ((obj measure) stream) @@ -492,6 +488,7 @@ (defmethod measures :before ((segment rsegment)) (when (modified-p segment) (compute-measures segment (spacing-style (buffer-cost-method (buffer segment)))) + ;; avoid an infinite computation by using slot-value here (mapc #'compute-timelines (slot-value segment 'measures)) (setf (modified-p segment) nil))) @@ -536,17 +533,26 @@ (let ((elements (elements bar))) (if elements (rel-abs (mapcar #'duration elements)) - '(1)))) + '(0)))) ;;; 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. +;;; of start times. If any of the list contains duplicate start +;;; times, then the resulting list will contain as many duplicates +;;; as the maximum number of duplicates of the two lists. ;;; 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)))))) - + (labels ((combine (l1 l2) + (cond ((null l1) l2) + ((null l2) l1) + ((< (car l1) (car l2)) + (cons (car l1) (combine (cdr l1) l2))) + ((< (car l2) (car l1)) + (cons (car l2) (combine (cdr l2) l1))) + (t (cons (car l1) (combine (cdr l1) (cdr l2))))))) + (append (combine (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 @@ -654,7 +660,7 @@ 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 +;;; measure. The `other stuff' is the spacing style, which is needed ;;; 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 @@ -667,38 +673,54 @@ 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)))) + (let* ((start-times (reduce #'combine-bars + (mapcar #'start-times bars))) (durations (abs-rel start-times)) - (min-dist (reduce #'min durations)) + ;; elements with zero duration do not intervene + ;; in the computation of the min-dist. + ;; Choose a large default value for min-dist. + (min-dist (reduce #'min (remove 0 durations) :initial-value 10000)) (coeff (loop for duration in durations sum (expt duration spacing-style)))) - (make-measure min-dist coeff start-times seg-pos bar-pos bars)))) + (make-measure min-dist coeff seg-pos bar-pos bars)))) (defun compute-timelines (measure) - (let ((timelines (timelines measure)) - (durations (abs-rel (measure-start-times measure)))) - ;; create a timeline for each start time of the measure - (loop for duration in durations - and start-time = 0 then (+ start-time duration) - 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 with timeline-index = 0 - for element in (elements bar) - 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)) - do (let ((timeline (flexichain:element* timelines timeline-index))) - (push element (elements timeline)) - (setf (timeline element) timeline)))))) + (let ((timelines (timelines measure))) + (flet ((compute-bar-timelines (bar) + (loop with timeline-index = 0 + for element in (elements bar) + and start-time = 0 then (+ start-time (duration element)) + do (loop until (= timeline-index (flexichain:nb-elements timelines)) + for timeline = (flexichain:element* timelines timeline-index) + until (or (> (start-time timeline) start-time) + (and (= (start-time timeline) start-time) + (or (zerop (duration element)) + ;; either none or every element of a timline + ;; has zero duration, so we only have to test + ;; the first one. + (not (zerop (duration (car (elements timeline)))))))) + do (incf timeline-index)) + do (when (or (= timeline-index (flexichain:nb-elements timelines)) + (> (start-time (flexichain:element* timelines timeline-index)) + start-time)) + (let ((timeline (make-instance 'timeline + :start-time start-time))) + (flexichain:insert* timelines timeline-index timeline))) + do (let ((timeline (flexichain:element* timelines timeline-index))) + (push element (elements timeline)) + (setf (timeline element) timeline))))) + (loop for bar in (measure-bars measure) + do (compute-bar-timelines bar))) + ;; compute the duration of each timeline except the last one + (loop for i from 0 below (1- (flexichain:nb-elements timelines)) + do (setf (duration (flexichain:element* timelines i)) + (- (start-time (flexichain:element* timelines (1+ i))) + (start-time (flexichain:element* timelines i))))) + ;; compute the duration of the last timeline, if any + (unless (zerop (flexichain:nb-elements timelines)) + (let ((measure-duration (reduce #'max (measure-bars measure) :key #'duration)) + (last-timeline (flexichain:element* timelines (1- (flexichain:nb-elements timelines))))) + (setf (duration last-timeline) (- measure-duration (start-time last-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.

1 0

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

05 Jan '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv20699 Modified Files: buffer.lisp gui.lisp measure.lisp packages.lisp Log Message: Fixed a bug reported by Christophe Rhodes. The symptoms were that the stems were not recomputed when the clef of the staff was changed. In fact, all elements that display on a staff need to be invalidated when the clef of the staff changes. Again, I used only the CLIM Desktop to accomplish this modification. Date: Thu Jan 5 20:14:49 2006 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.27 gsharp/buffer.lisp:1.28 --- gsharp/buffer.lisp:1.27 Sun Nov 20 20:17:22 2005 +++ gsharp/buffer.lisp Thu Jan 5 20:14:45 2006 @@ -66,7 +66,7 @@ ;;; Staff (defclass staff (gsharp-object name-mixin) - () + ((buffer :initarg :buffer :accessor buffer)) (:default-initargs :name "default staff")) ;;; fiveline @@ -945,8 +945,17 @@ (left-offset :initform *default-left-offset* :initarg :left-offset :accessor left-offset) (left-margin :initform *default-left-margin* :initarg :left-margin :accessor left-margin))) +(defun set-buffer-of-staves (buffer) + (loop for staff in (staves buffer) + do (setf (buffer staff) buffer))) + +(defmethod (setf staves) :after (staves (buffer buffer)) + (declare (ignore staves)) + (set-buffer-of-staves buffer)) + (defmethod initialize-instance :after ((b buffer) &rest args) (declare (ignore args)) + (set-buffer-of-staves b) (with-slots (segments) b (when (null segments) (add-segment (make-instance 'segment :staff (car (staves b))) b 0)) @@ -1034,10 +1043,12 @@ (assert (not (null staves))) (if (eq staff (car staves)) (push newstaff (cdr staves)) - (add-staff-after newstaff staff (cdr staves)))) + (add-staff-after newstaff staff (cdr staves))) + staves) (defmethod add-staff-after-staff (staff newstaff (buffer buffer)) - (add-staff-after newstaff staff (staves buffer))) + (setf (staves buffer) + (add-staff-after newstaff staff (staves buffer)))) (defmethod rename-staff (staff-name (staff staff) (buffer buffer)) (assert (not (find-staff staff-name buffer nil)) () 'staff-already-in-buffer) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.50 gsharp/gui.lisp:1.51 --- gsharp/gui.lisp:1.50 Tue Jan 3 15:25:46 2006 +++ gsharp/gui.lisp Thu Jan 5 20:14:45 2006 @@ -1090,20 +1090,9 @@ (layer (layer (current-cursor)))) (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 ((staff (car (staves (layer (current-cursor)))))) - (loop for segment in (segments (current-buffer)) - 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)))) + (invalidate-everything-using-staff (current-buffer) 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)) @@ -1122,12 +1111,7 @@ (define-gsharp-command com-more-flats () (let ((staff (car (staves (layer (current-cursor)))))) - (loop for segment in (segments (current-buffer)) - 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)))) + (invalidate-everything-using-staff (current-buffer) 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)) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.21 gsharp/measure.lisp:1.22 --- gsharp/measure.lisp:1.21 Tue Jan 3 15:25:46 2006 +++ gsharp/measure.lisp Thu Jan 5 20:14:45 2006 @@ -13,6 +13,23 @@ (define-added-mixin rstaff () staff ((rank :accessor staff-rank))) +(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)))) + +(defun invalidate-everything-using-staff (buffer staff) + (loop for segment in (segments buffer) + 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))))) + +(defmethod (setf clef) :before (clef (staff staff)) + (invalidate-everything-using-staff (buffer staff) staff)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Note Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.39 gsharp/packages.lisp:1.40 --- gsharp/packages.lisp:1.39 Wed Jan 4 18:35:51 2006 +++ gsharp/packages.lisp Thu Jan 5 20:14:45 2006 @@ -137,7 +137,8 @@ #:group-notes-by-staff #:final-relative-note-xoffset #:final-accidental #:final-relative-accidental-xoffset #:timeline #:timelines #:elasticity - #:smallest-gap #:elasticity-function)) + #:smallest-gap #:elasticity-function + #:invalidate-everything-using-staff)) (defpackage :gsharp-postscript (:use :clim :clim-lisp)

1 0

[gsharp-cvs] CVS update: gsharp/score-pane.lisp gsharp/sdl.lisp
by rstrandh＠common-lisp.net 04 Jan '06

04 Jan '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv11873 Modified Files: score-pane.lisp sdl.lisp Log Message: Fixed the beam-drawing problem reported by Christophe Rhodes. There might still be some glitches, but the foundation is now more sound, so that future glitches should be easier to fix. Date: Wed Jan 4 20:08:13 2006 Author: rstrandh Index: gsharp/score-pane.lisp diff -u gsharp/score-pane.lisp:1.18 gsharp/score-pane.lisp:1.19 --- gsharp/score-pane.lisp:1.18 Wed Dec 7 04:38:27 2005 +++ gsharp/score-pane.lisp Wed Jan 4 20:08:12 2006 @@ -454,9 +454,11 @@ ((light-glyph-p :initarg :light-glyph-p) (thickness :initarg :thickness))) -(defun draw-horizontal-beam (medium x1 y1 x2 thickness) - (let ((y2 (- y1 thickness))) - (draw-rectangle* medium x1 y1 x2 y2))) +;;; draw a horizontal beam around the vertical reference +;;; point y. +(defun draw-horizontal-beam (medium x1 y x2) + (multiple-value-bind (down up) (beam-offsets *font*) + (draw-rectangle* medium x1 (+ y up) x2 (+ y down)))) (defvar *darker-gray-progressions*) (defvar *lighter-gray-progressions*) @@ -576,34 +578,39 @@ (draw-upward-beam medium x1 y2 y1 thickness (/ (- x2 x1) (- y2 y1)))))))))) -(defun draw-sloped-beam (medium x1 y1 x2 y2 thickness inverse-slope) - (let ((transformation (medium-transformation *pane*))) - (cond ((< y1 y2) - (when (stream-recording-p *pane*) - (multiple-value-bind (xx1 yy1) - (transform-position transformation x1 y1) - (multiple-value-bind (xx2 yy2) - (transform-position transformation x2 y2) - (stream-add-output-record - *pane* (make-instance 'downward-beam-output-record - :x1 xx1 :y1 yy1 :x2 xx2 :y2 yy2 - :light-glyph-p *light-glyph* - :thickness thickness :ink (medium-ink medium)))))) - (when (stream-drawing-p *pane*) - (draw-downward-beam medium x1 y1 y2 thickness inverse-slope))) - (t - (when (stream-recording-p *pane*) - (multiple-value-bind (xx1 yy1) - (transform-position transformation x1 y1) - (multiple-value-bind (xx2 yy2) - (transform-position transformation x2 y2) - (stream-add-output-record - *pane* (make-instance 'upward-beam-output-record - :x1 xx1 :y1 yy2 :x2 xx2 :y2 yy1 - :light-glyph-p *light-glyph* - :thickness thickness :ink (medium-ink medium)))))) - (when (stream-drawing-p *pane*) - (draw-upward-beam medium x1 y1 y2 thickness inverse-slope)))))) +;;; draw a sloped beam. The vertical reference points +;;; of the two end points are indicated by y1 and y2. +(defun draw-sloped-beam (medium x1 y1 x2 y2) + (multiple-value-bind (down up) (beam-offsets *font*) + (let ((transformation (medium-transformation *pane*)) + (inverse-slope (abs (/ (- x2 x1) (- y2 y1)))) + (thickness (- down up))) + (cond ((< y1 y2) + (when (stream-recording-p *pane*) + (multiple-value-bind (xx1 yy1) + (transform-position transformation x1 y1) + (multiple-value-bind (xx2 yy2) + (transform-position transformation x2 y2) + (stream-add-output-record + *pane* (make-instance 'downward-beam-output-record + :x1 xx1 :y1 yy1 :x2 xx2 :y2 yy2 + :light-glyph-p *light-glyph* + :thickness thickness :ink (medium-ink medium)))))) + (when (stream-drawing-p *pane*) + (draw-downward-beam medium x1 y1 y2 thickness inverse-slope))) + (t + (when (stream-recording-p *pane*) + (multiple-value-bind (xx1 yy1) + (transform-position transformation x1 y1) + (multiple-value-bind (xx2 yy2) + (transform-position transformation x2 y2) + (stream-add-output-record + *pane* (make-instance 'upward-beam-output-record + :x1 xx1 :y1 yy2 :x2 xx2 :y2 yy1 + :light-glyph-p *light-glyph* + :thickness thickness :ink (medium-ink medium)))))) + (when (stream-drawing-p *pane*) + (draw-upward-beam medium x1 y1 y2 thickness inverse-slope))))))) ;;; an offset of -1 means hang, 0 means straddle and 1 means sit (defun draw-beam (pane x1 staff-step-1 offset1 x2 staff-step-2 offset2) @@ -612,16 +619,13 @@ (multiple-value-bind (left right) (stem-offsets *font*) (let* ((xx1 (+ x1 left)) (xx2 (+ x2 right)) - (offset (round (staff-step 1/3))) + (offset (beam-hang-sit-offset *font*)) (y1 (- (+ (staff-step staff-step-1) (* offset1 offset)))) (y2 (- (+ (staff-step staff-step-2) (* offset2 offset)))) - (slope (abs (/ (- y2 y1) (- xx2 xx1)))) - (thickness (/ (staff-line-distance *font*) 2)) (medium (sheet-medium pane))) - (assert (< slope 1)) (if (= y1 y2) - (draw-horizontal-beam pane xx1 y1 xx2 thickness) - (draw-sloped-beam medium xx1 y1 xx2 y2 thickness (/ slope))))))) + (draw-horizontal-beam pane xx1 y1 xx2) + (draw-sloped-beam medium xx1 y1 xx2 y2)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.13 gsharp/sdl.lisp:1.14 --- gsharp/sdl.lisp:1.13 Wed Jan 4 18:35:51 2006 +++ gsharp/sdl.lisp Wed Jan 4 20:08:12 2006 @@ -115,7 +115,8 @@ (setf beam-offset-up (- (ceiling (/ staff-line-distance 2) 2))) (setf beam-hang-sit-offset - (/ (- (+ beam-offset-down beam-offset-up) staff-line-thickness) 2))))) + (let ((beam-thickness (- beam-offset-down beam-offset-up))) + (/ (- beam-thickness staff-line-thickness) 2)))))) (defgeneric gf-char (glyph)) (defgeneric pixmap (glyph))

1 0

[gsharp-cvs] CVS update: gsharp/packages.lisp gsharp/sdl.lisp
by rstrandh＠common-lisp.net 04 Jan '06

04 Jan '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv4829 Modified Files: packages.lisp sdl.lisp Log Message: Added new generic functions to the SDL package to deal with beam offsets for a particular font. The plan is to modify the beam-drawing functions so that they use these new generic functions, and so that they draw beams relative to the vertical reference point, just like other drawing functions. Date: Wed Jan 4 18:35:51 2006 Author: rstrandh Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.38 gsharp/packages.lisp:1.39 --- gsharp/packages.lisp:1.38 Tue Jan 3 04:10:14 2006 +++ gsharp/packages.lisp Wed Jan 4 18:35:51 2006 @@ -33,6 +33,7 @@ #:ledger-line-x-offsets #:ledger-line-y-offsets #:notehead-right-offsets #:notehead-left-offsets #:load-font #:glyph-offsets #:suspended-note-offset + #:beam-offsets #:beam-hang-sit-offset #:+glyph-whole+ #:+glyph-whole-upper+ #:+glyph-whole-lower+ #:+glyph-whole-two+ #:+glyph-half+ #:+glyph-half-upper+ #:+glyph-half-lower+ #:+glyph-half-two+ #:+glyph-filled+ #:+glyph-filled-upper+ #:+glyph-filled-lower+ #:+glyph-filled-two+ Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.12 gsharp/sdl.lisp:1.13 --- gsharp/sdl.lisp:1.12 Tue Nov 15 19:49:52 2005 +++ gsharp/sdl.lisp Wed Jan 4 18:35:51 2006 @@ -22,6 +22,15 @@ (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")) +(defgeneric beam-offsets (font) + (:documentation "return two values, both to be added to the + vertical reference point in order to obtain the + bottom and top of the beam (in that order)")) +(defgeneric beam-hang-sit-offset (font) + (:documentation "return a positive value to be added to (hang) or + subtracted from (sit) the vertical reference point + of a staff line, in order to obtain the reference + point of a hanging or sitting beam respectively")) (defclass font () ((gf-font :initarg :gf-font :reader gf-font) @@ -40,6 +49,9 @@ (notehead-right-y-offset) (notehead-left-x-offset) (notehead-left-y-offset) + (beam-offset-down) + (beam-offset-up) + (beam-hang-sit-offset :reader beam-hang-sit-offset) (glyphs :initarg :glyphs :reader glyphs))) (defmethod initialize-instance :after ((font font) &rest initargs &key &allow-other-keys) @@ -58,7 +70,10 @@ notehead-right-x-offset notehead-right-y-offset notehead-left-x-offset - notehead-left-y-offset) font + notehead-left-y-offset + beam-offset-down + beam-offset-up + beam-hang-sit-offset) font (let ((staff-line-thickness (round (/ (staff-line-distance font) 10)))) (setf staff-line-offset-down (floor (/ staff-line-thickness 2)) @@ -94,7 +109,13 @@ (setf notehead-right-y-offset (round (+ (* 0.25 staff-line-distance) yoffset))) (setf notehead-left-y-offset - (- (round (- (* 0.25 staff-line-distance) yoffset))))))) + (- (round (- (* 0.25 staff-line-distance) yoffset)))) + (setf beam-offset-down + (floor (/ staff-line-distance 2) 2)) + (setf beam-offset-up + (- (ceiling (/ staff-line-distance 2) 2))) + (setf beam-hang-sit-offset + (/ (- (+ beam-offset-down beam-offset-up) staff-line-thickness) 2))))) (defgeneric gf-char (glyph)) (defgeneric pixmap (glyph)) @@ -185,6 +206,10 @@ (defmethod suspended-note-offset ((font font)) (with-slots (notehead-left-x-offset notehead-right-x-offset) font (- notehead-right-x-offset notehead-left-x-offset))) + +(defmethod beam-offsets ((font font)) + (with-slots (beam-offset-down beam-offset-up) font + (values beam-offset-down beam-offset-up))) (defun load-font (staff-line-distance) (let* ((gf-font (parse-gf-file (merge-pathnames

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/gui.lisp gsharp/measure.lisp
by crhodes＠common-lisp.net 03 Jan '06

03 Jan '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv7778 Modified Files: drawing.lisp gui.lisp measure.lisp Log Message: Make the C clef have the right octave. (FIXME: why are there two identical NOTE-POSITION methods?) Date: Tue Jan 3 15:25:46 2006 Author: crhodes Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.54 gsharp/drawing.lisp:1.55 --- gsharp/drawing.lisp:1.54 Tue Jan 3 15:19:05 2006 +++ gsharp/drawing.lisp Tue Jan 3 15:25:46 2006 @@ -683,7 +683,7 @@ (yoffset (- (gsharp-drawing::staff-yoffset staff)))) (if (typep staff 'fiveline-staff) (let* ((clef (clef staff)) - (bottom-line (- (ecase (name clef) (:treble 32) (:bass 24) (:c 35)) + (bottom-line (- (ecase (name clef) (:treble 32) (:bass 24) (:c 28)) (lineno clef))) (lnote-offset (score-pane:staff-step (- last-note bottom-line)))) (draw-line* pane Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.49 gsharp/gui.lisp:1.50 --- gsharp/gui.lisp:1.49 Tue Jan 3 04:10:14 2006 +++ gsharp/gui.lisp Tue Jan 3 15:25:46 2006 @@ -131,7 +131,7 @@ (defmethod note-position ((note note)) (let ((clef (clef (staff note)))) (+ (- (pitch note) - (ecase (name clef) (:treble 32) (:bass 24) (:c 35))) + (ecase (name clef) (:treble 32) (:bass 24) (:c 28))) (lineno clef)))) (defmethod display-element ((frame gsharp) pane) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.20 gsharp/measure.lisp:1.21 --- gsharp/measure.lisp:1.20 Wed Dec 7 04:38:27 2005 +++ gsharp/measure.lisp Tue Jan 3 15:25:46 2006 @@ -85,7 +85,7 @@ (defmethod note-position ((note note)) (let ((clef (clef (staff note)))) (+ (- (pitch note) - (ecase (name clef) (:treble 32) (:bass 24) (:c 35))) + (ecase (name clef) (:treble 32) (:bass 24) (:c 28))) (lineno clef)))) ;;; given a list of notes, return the one that is at the top

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp
by crhodes＠common-lisp.net 03 Jan '06

03 Jan '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv7698 Modified Files: drawing.lisp Log Message: Place accidentals on the right staff line when there's a C clef. Date: Tue Jan 3 15:19:07 2006 Author: crhodes Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.53 gsharp/drawing.lisp:1.54 --- gsharp/drawing.lisp:1.53 Tue Jan 3 04:10:13 2006 +++ gsharp/drawing.lisp Tue Jan 3 15:19:05 2006 @@ -43,7 +43,7 @@ (let ((yoffset (ecase (name (clef staff)) (:bass (- (lineno (clef staff)) 4)) (:treble (+ (lineno (clef staff)) 2)) - (:c (- (lineno (clef staff))) 1)))) + (:c (- (lineno (clef staff)) 1))))) (loop for pitch in '(6 2 5 1 4 0 3) for line in '(0 3 -1 2 -2 1 -3) for x from (+ x1 10 (score-pane:staff-step 8)) by (score-pane:staff-step 2) @@ -52,7 +52,7 @@ (let ((yoffset (ecase (name (clef staff)) (:bass (lineno (clef staff))) (:treble (+ (lineno (clef staff)) 6)) - (:c (+ (lineno (clef staff))) 3)))) + (:c (+ (lineno (clef staff)) 3))))) (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 (score-pane:staff-step 8)) by (score-pane:staff-step 2.5)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

gsharp-cvs January 2006