gsharp-cvs June 2007

gsharp-cvs@common-lisp.net

3 participants
15 discussions

[gsharp-cvs] CVS gsharp/Doc
by mjonsson 30 Jun '07

30 Jun '07

Update of /project/gsharp/cvsroot/gsharp/Doc In directory clnet:/tmp/cvs-serv8538 Modified Files: linebreak.tex plans.tex Log Message: Fixed a few typos. --- /project/gsharp/cvsroot/gsharp/Doc/linebreak.tex 2004/02/16 15:46:28 1.1.1.1 +++ /project/gsharp/cvsroot/gsharp/Doc/linebreak.tex 2007/06/30 16:50:34 1.2 @@ -85,7 +85,7 @@ Recomputing the measures of a segment is a complicated operation. First music events that occur simultaneously must be grouped together into \emph{timelines}. Then the spacing between timelines must be -computed. Such spacing is a monotonically increason function of the +computed. Such spacing is a monotonically increasing function of the temporal distance, but the function is usually not linear. Based on the spacing between timelines, measures are then grouped into @@ -134,10 +134,10 @@ The \emph{natural width} of a timeline with temporal distance $d$ to the next timeline (or to the end of the measure) in a line on which the smallest temporal distance is $d_{min}$ is defined as -$s_{min} (d / d_min) ^ k$. +$s_{min} (d / d_{min}) ^ k$. The \emph{natural width} of a measure is the sum of the natural widths -of each timeline of the measure plus $s_min$. The reason for the +of each timeline of the measure plus $s_{min}$. The reason for the additional term is that this much space must be inserted before the first timeline of the measure. @@ -178,7 +178,7 @@ The advantage of using normalized widths is twofold. First, the normalized with of a measure is independent of $d_{min}$, so it is a -property intrinsic to the measure and not dependendt on the line on +property intrinsic to the measure and not dependent on the line on which it is located. This information can be computed once and for all when a measure is recomputed by redisplay. Second, as redisplay accumulates measures into potential lines, the sum of the normalized @@ -191,7 +191,7 @@ If modification information is kept on a segment by segment basis, we typically only have to recompute the measures within a segment at each invocation of redisplay. Thus, even for arbitrarily large -scores, we are able to obtain a sequence of mesures each with its +scores, we are able to obtain a sequence of measures each with its normalized width and its $d_{min}$ in a time proportional to the size of a segment. @@ -212,7 +212,7 @@ available for music material and compute the penalty as the maximum of the compression factor and the stretch factor. -To compute the natural hieght of a page, several methods can be used. +To compute the natural height of a page, several methods can be used. The simplest is to consider a line to take up space proportional to the number of staves, lyric lines and other components, and to add the space taken up by each line to obtain the natural height of the page. @@ -350,7 +350,7 @@ operations. For all simple operations such as insertion or deletion of a single note, our computation is very fast. -\section{Conclusions and Futur Work} +\section{Conclusions and Future Work} We have described an incremental method for computing optimal line breaks in an interactive editor for musical scores. While it should --- /project/gsharp/cvsroot/gsharp/Doc/plans.tex 2006/08/02 02:47:17 1.4 +++ /project/gsharp/cvsroot/gsharp/Doc/plans.tex 2007/06/30 16:50:34 1.5 @@ -60,7 +60,7 @@ upper voice and (say) the lower staff line for the lower voice rather than, as now, having all rests inserted by default on the middle staff line. It would be nice if a layer had a default staff line for rests -so that changing hte layer automatically changes the default staff +so that changing the layer automatically changes the default staff line for rests. \subsection{Default stem direction for a layer} @@ -249,4 +249,4 @@ \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 +\end{itemize}

1 0

[gsharp-cvs] CVS gsharp/Doc
by rstrandh 30 Jun '07

30 Jun '07

Update of /project/gsharp/cvsroot/gsharp/Doc In directory clnet:/tmp/cvs-serv8726 Modified Files: accidentals.tex Log Message: Fixed some unfortunate choice of wording. --- /project/gsharp/cvsroot/gsharp/Doc/accidentals.tex 2004/02/16 15:46:22 1.1.1.1 +++ /project/gsharp/cvsroot/gsharp/Doc/accidentals.tex 2007/06/30 14:15:26 1.2 @@ -3,14 +3,14 @@ The rules of Ross essentially boil down to the following: \begin{itemize} -\item If there are no suspended notes with accidentals on the right - side of the stem, place all the accidentals in the order of the +\item If there are no suspended notes on the right side of the stem + that have accidentals, place all the accidentals in the order of the topmost one that can be placed closest to the stem. -\item If there are suspended notes with accidentals on the right side - of the stem (stem is up and there is an interval of a second), start - by placing the accidental of the topmost suspended note with an - accidental as close as possible to the stem, then place the other - notes according to the previous rule. +\item If there is at least one suspended note on the right side of the + stem (stem is up and there is an interval of a second) with an + accidental, start by placing the accidental of the topmost suspended + note with an accidental as close as possible to the stem, then place + the other notes according to the previous rule. \end{itemize} To implement this algorithm, we keep a table of smallest distances

1 0

[gsharp-cvs] CVS gsharp
by mjonsson 28 Jun '07

28 Jun '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv14891 Modified Files: modes.lisp Log Message: mcclim bug workaround in key bindings for microsharper/microflatter --- /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/28 13:56:53 1.25 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/28 14:36:14 1.26 @@ -84,8 +84,10 @@ (set-key 'com-sharper 'cluster-table '((#\#))) (set-key 'com-flatter 'cluster-table '(#\@)) -(set-key 'com-microsharper 'cluster-table '((#\# :control :shift))) -(set-key 'com-microflatter 'cluster-table '((#\@ :control :shift))) +(set-key 'com-microsharper 'cluster-table '((#\# :control))) +(set-key 'com-microsharper 'cluster-table '((#\# :control :shift))) ;; mcclim bug workaround +(set-key 'com-microflatter 'cluster-table '((#\@ :control))) +(set-key 'com-microflatter 'cluster-table '((#\@ :control :shift))) ;; mcclim bug workaround (set-key 'com-add-note-c 'cluster-table '(#\C)) (set-key 'com-add-note-d 'cluster-table '(#\D)) (set-key 'com-add-note-e 'cluster-table '(#\E))

1 0

[gsharp-cvs] CVS gsharp
by mjonsson 28 Jun '07

28 Jun '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv27753 Modified Files: buffer.lisp gui.lisp modes.lisp Log Message: Completed implementation of quartertone playback for regular temperaments. Fixed keybinding bug for microsharper. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/21 11:14:25 1.47 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/28 13:56:53 1.48 @@ -317,35 +317,44 @@ ;;; irregular temperaments. (defclass regular-temperament (tuning) ((octave-cents :initform 1200 :initarg :octave-cents :accessor octave-cents) - (fifth-cents :initform 700 :initarg :fifth-cents :accessor fifth-cents)) - ;; TODO: Add cent sizes of various microtonal accidentals, perhaps in an alist? - ) + (fifth-cents :initform 700 :initarg :fifth-cents :accessor fifth-cents) + (quartertone-cents :initform 50 :initarg :quartertone-cents :accessor quartertone-cents) + ;; TODO: Add cent sizes of various microtonal accidentals, perhaps in an alist? + )) (defmethod print-gsharp-object progn ((tuning regular-temperament) stream) (format stream "~_:octave-cents ~W ~_:fifth-cents ~W " (octave-cents tuning) (fifth-cents tuning))) (defmethod note-cents ((note note) (tuning regular-temperament)) - (let ((octave-cents (octave-cents tuning)) - (fifth-cents (fifth-cents tuning))) - (multiple-value-bind (octave pitch) (floor (pitch note) 7) - (+ (* octave-cents (1+ octave)) - (ecase pitch - (0 0) - (1 (+ (* -1 octave-cents) (* 2 fifth-cents))) - (2 (+ (* -2 octave-cents) (* 4 fifth-cents))) - (3 (- octave-cents fifth-cents)) - (4 fifth-cents) - (5 (+ (* -1 octave-cents) (* 3 fifth-cents))) - (6 (+ (* -2 octave-cents) (* 5 fifth-cents)))) - (* (ecase (accidentals note) - (:double-flat -2) - (:flat -1) - (:natural 0) - (:sharp 1) - (:double-sharp 2)) - (- (* 7 fifth-cents) - (* 4 octave-cents))))))) + (let ((octaves 1) + (fifths 0) + (sharps 0) ;; short for 7 fifths up and 4 octaves down + (quartertones 0)) + (incf octaves (floor (pitch note) 7)) + (ecase (mod (pitch note) 7) + (0 (progn)) + (1 (progn (incf octaves -1) (incf fifths 2))) + (2 (progn (incf octaves -2) (incf fifths 4))) + (3 (progn (incf octaves 1) (incf fifths -1))) + (4 (progn (incf fifths 1))) + (5 (progn (incf octaves -1) (incf fifths 3))) + (6 (progn (incf octaves -2) (incf fifths 5)))) + (ecase (accidentals note) + (:double-flat (incf sharps -2)) + (:sesquiflat (incf sharps -1) (incf quartertones -1)) + (:flat (incf sharps -1)) + (:semiflat (incf quartertones -1)) + (:natural) + (:semisharp (incf quartertones 1)) + (:sharp (incf sharps 1)) + (:sesquisharp (incf sharps 1) (incf quartertones 1)) + (:double-sharp (incf sharps 2))) + (incf octaves (* -4 sharps)) + (incf fifths (* 7 sharps)) + (+ (* octaves (octave-cents tuning)) + (* fifths (fifth-cents tuning)) + (* quartertones (quartertone-cents tuning))))) ;;; TODO: (defclass irregular-temperament ...) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/21 11:14:25 1.78 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/28 13:56:53 1.79 @@ -366,12 +366,14 @@ (define-gsharp-command (com-set-segment-tuning-regular-temperament :name t) ((octave-cents 'cl:number :prompt "Octave size in cents") - (fifth-cents 'cl:number :prompt "Fifth size in cents")) + (fifth-cents 'cl:number :prompt "Fifth size in cents") + (quartertone-cents 'cl:number :prompt "Quartertone size in cents")) ;; TODO: prompt for sizes of various microtonal accidentals (let ((segment (segment (current-cursor)))) (setf (tuning segment) (make-instance 'regular-temperament :octave-cents octave-cents - :fifth-cents fifth-cents)))) + :fifth-cents fifth-cents + :quartertone-cents quartertone-cents)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/21 11:14:27 1.24 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/28 13:56:53 1.25 @@ -84,7 +84,7 @@ (set-key 'com-sharper 'cluster-table '((#\#))) (set-key 'com-flatter 'cluster-table '(#\@)) -(set-key 'com-microsharper 'cluster-table '((#\# :control))) +(set-key 'com-microsharper 'cluster-table '((#\# :control :shift))) (set-key 'com-microflatter 'cluster-table '((#\@ :control :shift))) (set-key 'com-add-note-c 'cluster-table '(#\C)) (set-key 'com-add-note-d 'cluster-table '(#\D))

1 0

[gsharp-cvs] CVS gsharp
by mjonsson 28 Jun '07

28 Jun '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv6037 Modified Files: play.lisp Log Message: Fixed redundancies in play.lisp pointed out by Stas Boukarev --- /project/gsharp/cvsroot/gsharp/play.lisp 2007/06/19 10:01:37 1.8 +++ /project/gsharp/cvsroot/gsharp/play.lisp 2007/06/28 12:58:17 1.9 @@ -1,5 +1,9 @@ (in-package :gsharp-play) +(defparameter *midi-temp-file* "/tmp/timidity.mid") +(defparameter *midi-player* "timidity") +(defparameter *midi-player-arguments* '()) + (defvar *tuning*) (defvar *tempo*) @@ -73,6 +77,28 @@ (incf time (* *tempo* duration)))) (bars slice) durations)))) +(defun play-tracks (tracks) + (let ((midifile (make-instance 'midifile + :format 1 + :division 25 + :tracks tracks))) + (write-midi-file midifile *midi-temp-file*) + #+cmu + (ext:run-program *midi-player* + (append *midi-player-arguments* + (list *midi-temp-file*))) + #+sbcl + (sb-ext:run-program *midi-player* + (append *midi-player-arguments* + (list *midi-temp-file*)) + :search t) + #+clisp + (ext:run-program *midi-player* + :arguments (append *midi-player-arguments* + (list *midi-temp-file*))) + #-(or cmu sbcl clisp) + (error "write compatibility layer for RUN-PROGRAM"))) + (defun play-segment (segment) (let* ((slices (mapcar #'body (layers segment))) (durations (measure-durations slices)) @@ -80,31 +106,13 @@ (*tuning* (gsharp-buffer:tuning segment)) (tracks (loop for slice in slices for i from 0 - collect (track-from-slice slice i durations))) - (midifile (make-instance 'midifile - :format 1 - :division 25 - :tracks tracks))) - (write-midi-file midifile "/tmp/test.mid") - #+cmu - (ext:run-program "timidity" '("/tmp/test.mid")) - #+sbcl - (sb-ext:run-program "timidity" '("/tmp/test.mid") :search t) - #-(or cmu sbcl) - (error "write compatibility layer for RUN-PROGRAM"))) + collect (track-from-slice slice i durations)))) + (play-tracks tracks))) (defun play-layer (layer) (let* ((slice (body layer)) (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 "/tmp/test.mid") - #+cmu - (ext:run-program "timidity" '("/tmp/test.mid")) - #+sbcl - (sb-ext:run-program "timidity" '("/tmp/test.mid") :search t) - #-(or cmu sbcl) - (error "write compatibility layer for RUN-PROGRAM"))) + (*tempo* (tempo (segment layer))) + (*tuning* (gsharp-buffer:tuning (segment layer))) + (tracks (list (track-from-slice slice 0 durations)))) + (play-tracks tracks))) \ No newline at end of file

1 0

[gsharp-cvs] CVS gsharp
by crhodes 21 Jun '07

21 Jun '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv28358 Modified Files: buffer.lisp gui.lisp measure.lisp modes.lisp sdl.lisp Log Message: Support for semi/sesqui sharp/flat. * don't declare the type of the accidentals slot any more; we can put that back in a little, after we work out a declarative way of defining all properties of accidentals. * microsharpen and microflatten commands and functions; define sharpen and flatten in terms of those (and knowing which accidentals are the tonal ones). Keybindings for the commands. * a more declarative table-based system for kerning accidentals, along with the ability to specify a per-glyph default (and a default default). Choose a sensible default default; also alter the :sharp/:sharp table when +4 steps away, as the previous value was colliding a little too much. * support for playing the semi accidentals in equal temperament. No support in linear temperament, as I don't know what they mean. * glyphs defined with a little too much liberal cut'n'paste. Some FIXMEs note the essential differences between the related glyphs. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/18 15:18:17 1.46 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/21 11:14:25 1.47 @@ -219,8 +219,10 @@ (head :initform nil :initarg :head :reader head :type (or (member :whole :half :filled) null)) (accidentals :initform :natural :initarg :accidentals :reader accidentals - :type (member :natural :flat :double-flat - :sharp :double-sharp)) + ;; FIXME: we want :TYPE ACCIDENTAL here but need to + ;; sort out order of definition for that to be useful. + #+nil #+nil + :type (member :natural :flat :double-flat :sharp :double-sharp)) (dots :initform nil :initarg :dots :reader dots :type (or (integer 0 3) null)) (%tie-right :initform nil :initarg :tie-right :accessor tie-right) @@ -230,8 +232,9 @@ (declare (type (integer 0 127) pitch) (type staff staff) (type (or (member :whole :half :filled) null) head) - (type (member :natural :flat :double-flat - :sharp :double-sharp) + ;; FIXME: :TYPE ACCIDENTAL + #+nil #+nil + (type (member :natural :flat :double-flat :sharp :double-sharp) accidentals) (type (or (integer 0 3) null) dots) (ignore head accidentals dots)) @@ -300,9 +303,13 @@ (ecase pitch (0 0) (1 200) (2 400) (3 500) (4 700) (5 900) (6 1100)) (ecase (accidentals note) (:double-flat -200) + (:sesquiflat -150) (:flat -100) + (:semiflat -50) (:natural 0) + (:semisharp 50) (:sharp 100) + (:sesquisharp 150) (:double-sharp 200))))) ;;; regular temperaments are temperaments that --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/18 15:18:17 1.77 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/21 11:14:25 1.78 @@ -822,17 +822,61 @@ (add-note element new-note) (setf *current-note* new-note)))) +(defmacro define-microtonal-accidentals (&rest microaccidentals) + `(progn + (setf (symbol-plist 'microsharpen) + ',(loop for (a b) on microaccidentals + if b collect a and collect b + else collect a and collect a)) + (setf (symbol-plist 'microflatten) + ',(loop for (a b) on (reverse microaccidentals) + if b collect a and collect b + else collect a and collect a)) + (deftype accidental () '(member ,@microaccidentals)) + (defun microsharpen (accidental) + (or (getf (symbol-plist 'microsharpen) accidental) + (error 'type-error :datum accidental :expected-type 'microaccidental))) + (defun microflatten (accidental) + (or (getf (symbol-plist 'microflatten) accidental) + (error 'type-error :datum accidental :expected-type 'microaccidental))))) + +(defmacro define-accidentals (&rest accidentals) + `(progn + (deftype accidental () '(member ,@accidentals)) + (defun sharpen (accidental) + (do ((a (microsharpen accidental) (microsharpen a)) + (olda accidental a)) + ((or (eq a olda) (member a ',accidentals)) a))) + (defun flatten (accidental) + (do ((a (microflatten accidental) (microflatten a)) + (olda accidental a)) + ((or (eq a olda) (member a ',accidentals)) a))))) + +(define-microtonal-accidentals :double-flat :sesquiflat :flat :semiflat + :natural + :semisharp :sharp :sesquisharp :double-sharp) + +(define-accidentals :double-flat :flat :natural :sharp :double-sharp) + (define-gsharp-command com-sharper () (let* ((cluster (cur-cluster)) (note (cur-note)) (new-note (make-note (pitch note) (staff note) :head (head note) - :accidentals (ecase (accidentals note) - (:double-sharp :double-sharp) - (:sharp :double-sharp) - (:natural :sharp) - (:flat :natural) - (:double-flat :flat)) + :accidentals (sharpen (accidentals note)) + :dots (dots note)))) + (remove-note note) + (add-note cluster new-note) + (setf *current-note* new-note))) + +(define-gsharp-command com-microsharper () + ;; FIXME: what are CUR-CLUSTER and CUR-NOTE and how do they relate + ;; to CURRENT-CLUSTER &c? + (let* ((cluster (cur-cluster)) + (note (cur-note)) + (new-note (make-note (pitch note) (staff note) + :head (head note) + :accidentals (microsharpen (accidentals note)) :dots (dots note)))) (remove-note note) (add-note cluster new-note) @@ -843,12 +887,18 @@ (note (cur-note)) (new-note (make-note (pitch note) (staff note) :head (head note) - :accidentals (ecase (accidentals note) - (:double-sharp :sharp) - (:sharp :natural) - (:natural :flat) - (:flat :double-flat) - (:double-flat :double-flat)) + :accidentals (flatten (accidentals note)) + :dots (dots note)))) + (remove-note note) + (add-note cluster new-note) + (setf *current-note* new-note))) + +(define-gsharp-command com-microflatter () + (let* ((cluster (cur-cluster)) + (note (cur-note)) + (new-note (make-note (pitch note) (staff note) + :head (head note) + :accidentals (microflatten (accidentals note)) :dots (dots note)))) (remove-note note) (add-note cluster new-note) --- /project/gsharp/cvsroot/gsharp/measure.lisp 2006/06/21 16:31:54 1.32 +++ /project/gsharp/cvsroot/gsharp/measure.lisp 2007/06/21 11:14:25 1.33 @@ -248,48 +248,57 @@ nil (accidentals note))))) -;;; table of x offsets (in staff steps) of accendentals. -;;; The first index represents a notehead or a type of accidental. -;;; The second index represents a type of accidentsl. -;;; The third index is a vertical distance, measured in difference -;;; in staff steps between the two. -;;; The table entry gives how much the accidental represented by -;;; the second parameter must be positioned to the left of the -;;; first one. -;;; Entries in the table are offset by 5 in the last dimension -;;; so that vertical distances between -5 and 5 can be represented -(defparameter *accidental-offset* - ;;; -5 -4 -3 -2 -1 0 1 2 3 4 5 - #3A((( 0 0 0 3.5 3.5 3.5 3.5 3.5 3.5 1 0) ; notehead - dbl flat - ( 0 0 0 3.5 3.5 3.5 3.5 3.5 3.5 1 0) ; notehead - flat - ( 0 3.5 3.5 3.5 3.5 3.5 3.5 3.5 1 1 0) ; notehead - natural - ( 0 3.5 3.5 3.5 3.5 3.5 3.5 3.5 1 1 0) ; notehead - sharp - ( 0 0 0 3.5 3.5 3.5 3.5 3.5 0 0 0)) ; notehead - dbl sharp - (( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) ; dbl flat - dbl flat - ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) ; dbl flat - flat - ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) ; dbl flat - natural - ( 4 4 4 4 4 4 4 4 4 3.5 0) ; dbl flat - sharp - ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 0 0 0)) ; dbl flat - dbl sharp - (( 2 2 2 2 2 2 2 2 1.5 1 0) ; flat - dbl flat - ( 2 2 2 2 2 2 2 2 1.5 1 0) ; flat - flat - ( 2 2 2 2 2 2 2 2 1.5 1 0) ; flat - natural - ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 1.5 0) ; flat - sharp - ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 0 0 0)) ; flat - dbl sharp - (( 2 2 2 2 2 2 2 2 2 1.5 1.5) ; natural - dbl flat - ( 2 2 2 2 2 2 2 2 2 1.5 1.5) ; natural - flat - ( 2 2 2 2 2 2 2 2 2 1.5 1.5) ; natural - natural - ( 2 2 2 2 2 2 2 2 2 2 2) ; natural - sharp - ( 2 2 2 2 2 2 2 2 1 1 1)) ; natural - dbl sharp - (( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) ; sharp - dbl flat - ( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) ; sharp - flat - ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) ; sharp - natural - ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 2.0) ; sharp - sharp - ( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 0 0)) ; sharp - dbl sharp - (( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) ; dbl sharp - dbl flat - ( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) ; dbl sharp - flat - ( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) ; dbl sharp - natural - ( 0 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 0) ; dbl sharp - sharp - ( 0 0 0 2.8 2.8 2.8 2.8 2.8 0 0 0)))) ; dbl sharp - dbl sharp +(defmacro define-accidental-kerning (left right table) + `(let ((plist (getf (symbol-plist 'accidental-kerning) ',right))) + (setf (getf (symbol-plist 'accidental-kerning) ',right) + (cons (cons ',left ',table) + (remove ',left plist :key #'car))))) +(defmacro define-default-accidental-kerning (right table) + `(define-accidental-kerning default ,right ,table)) + +(macrolet ((define-kernings (&rest args) + `(progn ,@(loop for (left right table) on args by #'cdddr + collect `(define-accidental-kerning ,left ,right ,table))))) + (define-kernings + :double-flat :notehead #( 0 0 0 3.5 3.5 3.5 3.5 3.5 3.5 1 0) + :flat :notehead #( 0 0 0 3.5 3.5 3.5 3.5 3.5 3.5 1 0) + :natural :notehead #( 0 3.5 3.5 3.5 3.5 3.5 3.5 3.5 1 1 0) + :sharp :notehead #( 0 3.5 3.5 3.5 3.5 3.5 3.5 3.5 1 1 0) + :double-sharp :notehead #( 0 0 0 3.5 3.5 3.5 3.5 3.5 0 0 0) + + :double-flat :double-flat #(3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) + :flat :double-flat #(3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) + :natural :double-flat #(3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) + :sharp :double-flat #( 4 4 4 4 4 4 4 4 4 3.5 0) + :double-sharp :double-flat #(3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 0 0 0) + + :double-flat :flat #( 2 2 2 2 2 2 2 2 1.5 1 0) + :flat :flat #( 2 2 2 2 2 2 2 2 1.5 1 0) + :natural :flat #( 2 2 2 2 2 2 2 2 1.5 1 0) + :sharp :flat #(2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 1.5 0) + :double-sharp :flat #(2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 0 0 0) + + :double-flat :natural #( 2 2 2 2 2 2 2 2 2 1.5 1.5) + :flat :natural #( 2 2 2 2 2 2 2 2 2 1.5 1.5) + :natural :natural #( 2 2 2 2 2 2 2 2 2 1.5 1.5) + :sharp :natural #( 2 2 2 2 2 2 2 2 2 2 2) + :double-sharp :natural #( 2 2 2 2 2 2 2 2 1 1 1) + + :double-flat :sharp #( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) + :flat :sharp #( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) + :natural :sharp #(2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) + :sharp :sharp #(2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0) + :double-sharp :sharp #( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 0 0) + + :double-flat :double-sharp #( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) + :flat :double-sharp #( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) + :natural :double-sharp #( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) + :sharp :double-sharp #( 0 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 0) + :double-sharp :double-sharp #( 0 0 0 2.8 2.8 2.8 2.8 2.8 0 0 0) + )) + +(defvar *default-accidental-kerning* + #(4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0)) ;;; given 1) a type of accidental 2) its position (in staff steps) 3) ;;; a type of accidental or a type of notehead, and 4) its position, @@ -297,24 +306,16 @@ ;;; steps to the left that it must be moved in order to avoid overlap ;;; with the second one. (defun accidental-distance (acc1 pos1 acc2 pos2) - (let ((dist (- pos2 pos1))) - (if (> (abs dist) 5) - 0 - (aref *accidental-offset* - (ecase acc2 - (:notehead 0) - (:double-flat 1) - (:flat 2) - (:natural 3) - (:sharp 4) - (:double-sharp 5)) - (ecase acc1 - (:double-flat 0) - (:flat 1) - (:natural 2) - (:sharp 3) - (:double-sharp 4)) - (+ dist 5))))) + (let* ((dist (- pos2 pos1)) + (right-info (getf (symbol-plist 'accidental-kerning) acc2)) + (left-right-info (cdr (assoc acc1 right-info))) + (default-right-info (cdr (assoc 'default right-info)))) + (cond + ((> (abs dist) 5) 0) + ((or (not right-info) (and (not left-right-info) (not default-right-info))) + (aref *default-accidental-kerning* (+ dist 5))) + ((not left-right-info) (aref default-right-info (+ dist 5))) + (t (aref left-right-info (+ dist 5)))))) ;;; given two notes (where the first one has an accidental, and the ;;; second one may or may not have an accidental) and the conversion --- /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/10 08:15:29 1.23 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/21 11:14:27 1.24 @@ -84,6 +84,8 @@ (set-key 'com-sharper 'cluster-table '((#\#))) (set-key 'com-flatter 'cluster-table '(#\@)) +(set-key 'com-microsharper 'cluster-table '((#\# :control))) +(set-key 'com-microflatter 'cluster-table '((#\@ :control :shift))) (set-key 'com-add-note-c 'cluster-table '(#\C)) (set-key 'com-add-note-d 'cluster-table '(#\D)) (set-key 'com-add-note-e 'cluster-table '(#\E)) --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/06/07 22:40:26 1.31 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2007/06/21 11:14:27 1.32 @@ -1009,6 +1009,56 @@ ;;; ;;; Accidentals +(defmethod compute-design ((font font) (shape (eql :semisharp))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + stem-thickness + yoffset) font + (let* (;; A factor that determines the space between the vertical + ;; bars and the outer edge of the character as a fraction of + ;; the staff line distance + (edge-distance-multiplier 0.2) + ;; A factor that determines the height of the thin part as a + ;; fraction of the staff line distance + (height-multiplier 2.5) + ;; A factor that determines the width of the hole as a fraction of the + ;; staff line distance. + (hole-width-multiplier 0.33) + (hole-width (round (* hole-width-multiplier sld))) + ;; Hope that half a pixel will not be visible and will not influence + ;; the required distance to the noteheads. + ;; + ;; FIXME: this is the only real difference between the + ;; :semisharp and :sesquisharp glyph calculations, and the + ;; :sharp glyph. Find a way to unify the glyph + ;; computations in a proper metafonty way. + (xoffset (if (oddp hole-width) 0.5 0.5)) + (edge-distance (* edge-distance-multiplier sld)) + (width (+ hole-width (* 2 stem-thickness) (* 2 edge-distance))) + ;; FIXME: this leads to a blurry glyph at most sizes: + ;; choose a coordinate which lies on a pixel boundary in + ;; preference. + (xleft (* -0.25 width)) + (xright (- xleft)) + (yleft (* -0.15 width)) + (yright (- yleft)) + ;; The path for the thick part symmetric around (0, 0) + (thickpart (mf (complex xleft yleft) -- (complex xright yright))) + ;; Determine the y coordinate of the previous path at the + ;; cross point of the thin part. Use congruent triangles. + (ythin (/ (* (- xright edge-distance) yright) xright)) + (height (* height-multiplier sld)) + ;; The path for the thin part symmetric around (0, 0) + (thinpart (mf (complex 0 (* 0.5 height)) -- (complex 0 (* -0.5 height))))) + (clim:region-union + (with-pen (rotate (scale +razor+ (* 0.4 sld)) (/ pi 2)) + (clim:region-union (draw-path (translate thickpart + (complex xoffset (+ yoffset (* 0.5 sld))))) + (draw-path (translate thickpart + (complex xoffset (+ yoffset (* -0.5 sld))))))) + (with-pen (scale +razor+ stem-thickness) + (draw-path (translate thinpart (complex xoffset yoffset)))))))) + (defmethod compute-design ((font font) (shape (eql :sharp))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness) @@ -1060,6 +1110,58 @@ (* 0.5 stem-thickness)) (+ yoffset ythin)))))))))) +(defmethod compute-design ((font font) (shape (eql :sesquisharp))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + stem-thickness + yoffset) font + (let* (;; A factor that determines the space between the vertical + ;; bars and the outer edge of the character as a fraction of + ;; the staff line distance + (edge-distance-multiplier 0.2) + ;; A factor that determines the height of the thin part as a + ;; fraction of the staff line distance + (height-multiplier 2.5) + ;; A factor that determines the width of the hole as a fraction of the + ;; staff line distance. + (hole-width-multiplier 0.33) + (hole-width (round (* hole-width-multiplier sld))) + ;; Hope that half a pixel will not be visible and will not + ;; influence the required distance to the noteheads. + ;; + ;; FIXME: see note in :semisharp glyph at this point + (xoffset (if (oddp hole-width) 0.5 0.5)) + (edge-distance (* edge-distance-multiplier sld)) + (width (+ hole-width (* 2 stem-thickness) (* 2 edge-distance))) + (xleft (* -0.75 width)) + (xright (- xleft)) + (yleft (* -0.15 width)) + (yright (- yleft)) + ;; The path for the thick part symmetric around (0, 0) + (thickpart (mf (complex xleft yleft) -- (complex xright yright))) + ;; Determine the y coordinate of the previous path at the + ;; cross point of the thin part. Use congruent triangles. + (ythin (/ (* (- xright edge-distance) yright) xright)) + (height (* height-multiplier sld)) + ;; The path for the thin part symmetric around (0, 0) + (thinpart (mf (complex 0 (* 0.5 height)) -- (complex 0 (* -0.5 height))))) + (clim:region-union + (with-pen (rotate (scale +razor+ (* 0.4 sld)) (/ pi 2)) + (clim:region-union (draw-path (translate thickpart + (complex xoffset (+ yoffset (* 0.5 sld))))) + (draw-path (translate thickpart + (complex xoffset (+ yoffset (* -0.5 sld))))))) + (with-pen (scale +razor+ stem-thickness) + (clim:region-union + (clim:region-union + (draw-path (translate thinpart + (complex (- xoffset hole-width (* 1 stem-thickness)) + (- yoffset ythin)))) + (draw-path (translate thinpart (complex (- xoffset (* 0 stem-thickness)) yoffset)))) + (draw-path (translate thinpart + (complex (+ xoffset hole-width (* 1 stem-thickness)) + (+ yoffset ythin)))))))))) + (defmethod compute-design ((font font) (shape (eql :double-sharp))) (with-slots ((sld staff-line-distance) xoffset yoffset) font (flet ((c (x y) (complex x y))) @@ -1075,13 +1177,38 @@ (translate (rotate leg (* pi 1.0)) (c xoffset yoffset)) (translate (rotate leg (* pi 1.5)) (c xoffset yoffset)))))))) +(defmethod compute-design ((font font) (shape (eql :semiflat))) + (with-slots ((sld staff-line-distance) stem-thickness) font + (flet ((c (x y) (complex x y))) + (let* ((outer (xyscale (translate (rotate +half-circle+ pi) #c(-0.5 0)) + (* 1 sld) (* 1 sld))) + ;; FIXME: 1.2 here (and in the :sesquiflat glyph, below) + ;; represents the difference in width between the + ;; :semiflat bulge and the regular :flat bulge. Find a + ;; way to share code between the glyphs. + (inner (xyscale (translate (rotate +half-circle+ pi) #c(-0.6 0)) + (* 0.75 sld) (* (/ 0.75 1.2) sld))) + (middle (mf (climi::path-end outer) -- (climi::path-end inner))) + (finish (mf (climi::path-start inner) -- (climi::path-start outer))) + (combined (climi::close-path + (reduce #'clim:region-union + (list outer middle (climi::reverse-path inner) finish))))) + (clim:region-union (translate (rotate (slant combined 0.6) (- (/ pi 2))) + (c (round (- (* -0.2 sld) stem-thickness)) (* -0.5 sld))) + (with-pen (scale +razor+ stem-thickness) + (draw-path (mf (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness)) + (* 1.5 sld)) + -- + (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness)) + (* -0.5 sld)))))))))) + (defmethod compute-design ((font font) (shape (eql :flat))) (with-slots ((sld staff-line-distance) stem-thickness) font (flet ((c (x y) (complex x y))) (let* ((outer (xyscale (translate +half-circle+ #c(-0.5 0)) sld (* 1.2 sld))) (inner (scale (translate +half-circle+ #c(-0.6 0)) - (* 0.8 sld))) + (* 0.75 sld))) (middle (mf (climi::path-end outer) -- (climi::path-end inner))) (finish (mf (climi::path-start inner) -- (climi::path-start outer))) (combined (climi::close-path @@ -1096,6 +1223,38 @@ (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness)) (* -0.5 sld)))))))))) +(defmethod compute-design ((font font) (shape (eql :sesquiflat))) + (with-slots ((sld staff-line-distance) stem-thickness) font + (flet ((c (x y) (complex x y))) + (let* ((outer (xyscale (translate (rotate +half-circle+ pi) #c(-0.5 0)) + (* 1 sld) (* 1 sld))) + (inner (xyscale (translate (rotate +half-circle+ pi) #c(-0.6 0)) + (* 0.75 sld) (* (/ 0.75 1.2) sld))) + (middle (mf (climi::path-end outer) -- (climi::path-end inner))) + (finish (mf (climi::path-start inner) -- (climi::path-start outer))) + (combined (climi::close-path + (reduce #'clim:region-union + (list outer middle (climi::reverse-path inner) finish)))) + (outer1 (xyscale (translate +half-circle+ #c(-0.5 0)) + sld (* 1.2 sld))) + (inner1 (scale (translate +half-circle+ #c(-0.6 0)) + (* 0.75 sld))) + (middle1 (mf (climi::path-end outer1) -- (climi::path-end inner1))) + (finish1 (mf (climi::path-start inner1) -- (climi::path-start outer1))) + (combined1 (climi::close-path + (reduce #'clim:region-union + (list outer1 middle1 (climi::reverse-path inner1) finish1))))) + (clim:region-union (clim:region-union (translate (rotate (slant combined (* 0.6 1.2)) (- (/ pi 2))) + (c (round (- (* -0.2 sld) stem-thickness)) (* -0.5 sld))) + (translate (rotate (slant combined1 -0.6) (- (/ pi 2))) + (c (round (* -0.2 sld)) (* -0.5 sld)))) + (with-pen (scale +razor+ stem-thickness) + (draw-path (mf (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness)) + (* 1.5 sld)) + -- + (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness)) + (* -0.5 sld)))))))))) + (defmethod compute-design ((font font) (shape (eql :double-flat))) (with-slots ((sld staff-line-distance) stem-thickness) font (flet ((c (x y) (complex x y)))

1 0

[gsharp-cvs] CVS gsharp
by crhodes 19 Jun '07

19 Jun '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv6155 Modified Files: play.lisp Log Message: a above middle c is 69, not 67. --- /project/gsharp/cvsroot/gsharp/play.lisp 2007/06/18 15:18:17 1.7 +++ /project/gsharp/cvsroot/gsharp/play.lisp 2007/06/19 10:01:37 1.8 @@ -4,7 +4,7 @@ (defvar *tempo*) (defun midi-pitch (note) - (round (+ (+ 6700 ; a above middle c, 440 Hz + (round (+ (+ 6900 ; a above middle c, 440 Hz (* 1200 (log (/ (master-pitch-freq *tuning*) 440) 2))) (- (note-cents note *tuning*) (note-cents (master-pitch-note *tuning*) *tuning*)))

1 0

[gsharp-cvs] CVS gsharp
by mjonsson 18 Jun '07

18 Jun '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv18370 Modified Files: buffer.lisp gui.lisp packages.lisp play.lisp Log Message: Added support for regular temperaments --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/15 16:26:14 1.45 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/18 15:18:17 1.46 @@ -260,6 +260,89 @@ (defun note-equal (note1 note2) (= (pitch note1) (pitch note2))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Tuning (support for microtonal and historical tunings/temperaments) + +;;; FIXME: add name-mixin also? +(defclass tuning (gsharp-object) + ((master-pitch-note :initform (make-instance 'note :pitch 33 ; a above middle c + :staff (make-instance 'staff)) + :initarg :master-pitch-note + :type note + :accessor master-pitch-note) + (master-pitch-freq :initform 440 + :initarg :master-pitch-freq + :accessor master-pitch-freq))) + +(defmethod print-gsharp-object progn ((tuning tuning) stream) + (format stream "~_:master-pitch-note ~W ~_:master-pitch-freq ~W " + (master-pitch-note tuning) (master-pitch-freq tuning))) + +;;; Returns how a note should be tuned in a given tuning +;;; in terms of a cent value. +(defgeneric note-cents (note tuning)) + +;;; 12-edo is provided for efficiency only. It is a +;;; special case of a regular temperament. Perhaps it +;;; should be removed? +(defclass 12-edo (tuning) + ()) + +(defmethod print-gsharp-object progn ((tuning 12-edo) stream) + ;; no parameters to save + ) + +(defmethod note-cents ((note note) (tuning 12-edo)) + (multiple-value-bind (octave pitch) (floor (pitch note) 7) + (+ (* 1200 (1+ octave)) + (ecase pitch (0 0) (1 200) (2 400) (3 500) (4 700) (5 900) (6 1100)) + (ecase (accidentals note) + (:double-flat -200) + (:flat -100) + (:natural 0) + (:sharp 100) + (:double-sharp 200))))) + +;;; regular temperaments are temperaments that +;;; retain their interval sizes regardless of modulation, as opposed to +;;; irregular temperaments. +(defclass regular-temperament (tuning) + ((octave-cents :initform 1200 :initarg :octave-cents :accessor octave-cents) + (fifth-cents :initform 700 :initarg :fifth-cents :accessor fifth-cents)) + ;; TODO: Add cent sizes of various microtonal accidentals, perhaps in an alist? + ) + +(defmethod print-gsharp-object progn ((tuning regular-temperament) stream) + (format stream "~_:octave-cents ~W ~_:fifth-cents ~W " + (octave-cents tuning) (fifth-cents tuning))) + +(defmethod note-cents ((note note) (tuning regular-temperament)) + (let ((octave-cents (octave-cents tuning)) + (fifth-cents (fifth-cents tuning))) + (multiple-value-bind (octave pitch) (floor (pitch note) 7) + (+ (* octave-cents (1+ octave)) + (ecase pitch + (0 0) + (1 (+ (* -1 octave-cents) (* 2 fifth-cents))) + (2 (+ (* -2 octave-cents) (* 4 fifth-cents))) + (3 (- octave-cents fifth-cents)) + (4 fifth-cents) + (5 (+ (* -1 octave-cents) (* 3 fifth-cents))) + (6 (+ (* -2 octave-cents) (* 5 fifth-cents)))) + (* (ecase (accidentals note) + (:double-flat -2) + (:flat -1) + (:natural 0) + (:sharp 1) + (:double-sharp 2)) + (- (* 7 fifth-cents) + (* 4 octave-cents))))))) + +;;; TODO: (defclass irregular-temperament ...) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Element @@ -987,7 +1070,9 @@ ((print-character :allocation :class :initform #\S) (buffer :initform nil :initarg :buffer :accessor buffer) (layers :initform '() :initarg :layers :accessor layers) - (tempo :initform 128 :initarg :tempo :accessor tempo))) + (tempo :initform 128 :initarg :tempo :accessor tempo) + (tuning :initform (make-instance '12-edo) + :initarg :tuning :accessor tuning))) (defmethod initialize-instance :after ((s segment) &rest args &key staff) (declare (ignore args)) @@ -999,7 +1084,8 @@ do (setf (segment layer) s)))) (defmethod print-gsharp-object progn ((s segment) stream) - (format stream "~_:layers ~W ~_:tempo ~W " (layers s) (tempo s))) + (format stream "~_:layers ~W ~_:tempo ~W ~_:tuning ~W " + (layers s) (tempo s) (tuning s))) (defun read-segment-v3 (stream char n) (declare (ignore char n)) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/10 08:15:28 1.76 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/18 15:18:17 1.77 @@ -364,6 +364,15 @@ (let ((segment (segment (current-cursor)))) (setf (tempo segment) tempo))) +(define-gsharp-command (com-set-segment-tuning-regular-temperament :name t) + ((octave-cents 'cl:number :prompt "Octave size in cents") + (fifth-cents 'cl:number :prompt "Fifth size in cents")) + ;; TODO: prompt for sizes of various microtonal accidentals + (let ((segment (segment (current-cursor)))) + (setf (tuning segment) (make-instance 'regular-temperament + :octave-cents octave-cents + :fifth-cents fifth-cents)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; layer menu --- /project/gsharp/cvsroot/gsharp/packages.lisp 2007/01/31 15:25:04 1.59 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2007/06/18 15:18:17 1.60 @@ -94,7 +94,9 @@ #:right-edge #:left-offset #:left-margin #:text #:append-char #:erase-char #:tie-right #:tie-left - #:needs-saving)) + #:needs-saving + #:tuning #:master-pitch-note #:master-pitch-freq + #:note-cents #:12-edo #:regular-temperament)) (defpackage :gsharp-numbering (:use :gsharp-utilities :gsharp-buffer :clim-lisp) --- /project/gsharp/cvsroot/gsharp/play.lisp 2007/06/15 16:26:14 1.6 +++ /project/gsharp/cvsroot/gsharp/play.lisp 2007/06/18 15:18:17 1.7 @@ -1,16 +1,17 @@ (in-package :gsharp-play) +(defvar *tuning*) +(defvar *tempo*) + (defun midi-pitch (note) - (+ (* 12 (+ (floor (pitch note) 7) 1)) - (ecase (mod (pitch note) 7) (0 0) (1 2) (2 4) (3 5) (4 7) (5 9) (6 11)) - (ecase (accidentals note) - (:double-flat -2) - (:flat -1) - (:natural 0) - (:sharp 1) - (:double-sharp 2)))) + (round (+ (+ 6700 ; a above middle c, 440 Hz + (* 1200 (log (/ (master-pitch-freq *tuning*) 440) 2))) + (- (note-cents note *tuning*) + (note-cents (master-pitch-note *tuning*) *tuning*))) + 100)) -(defvar *tempo*) +(defun cents-adjustment (note) + (nth-value 1 (midi-pitch note))) (defun measure-durations (slices) (let ((durations (mapcar (lambda (slice) @@ -18,19 +19,40 @@ (bars slice))) slices))) (loop while durations - collect (reduce #'max (mapcar #'car durations)) + collect (reduce #'max durations :key #'car) do (setf durations (remove nil (mapcar #'cdr durations)))))) +(defun average (list &key (key #'identity)) + (let ((sum 0) + (count 0)) + (dolist (elem list) + (incf count) + (incf sum (funcall key elem))) + (/ sum count))) + (defun events-from-element (element time channel) (when (typep element 'cluster) - (append (mapcar (lambda (note) + (append (list + (make-instance 'pitch-bend-message + :time time + :status (+ #xE0 channel) + :value (+ 8192 ;; middle of pitch-bend controller + (round + (* 4096/100 ;; 4096 points per 100 cents + ;; midi can only do per-channel pitch bend, + ;; not per-note pitch bend, so as a sad + ;; compromise we average the pitch bends + ;; of all notes in the cluster + (average (notes element) + :key #'cents-adjustment)))))) + (mapcar (lambda (note) (make-instance 'note-on-message - :time time + :time time :status (+ #x90 channel) :key (midi-pitch note) :velocity 100)) (remove-if #'tie-left (notes element))) - (mapcar (lambda (note) - (make-instance 'note-off-message + (mapcar (lambda (note) + (make-instance 'note-off-message :time (+ time (* *tempo* (duration element))) :status (+ #x80 channel) :key (midi-pitch note) :velocity 100)) @@ -55,6 +77,7 @@ (let* ((slices (mapcar #'body (layers segment))) (durations (measure-durations slices)) (*tempo* (tempo segment)) + (*tuning* (gsharp-buffer:tuning segment)) (tracks (loop for slice in slices for i from 0 collect (track-from-slice slice i durations))) @@ -85,4 +108,3 @@ (sb-ext:run-program "timidity" '("/tmp/test.mid") :search t) #-(or cmu sbcl) (error "write compatibility layer for RUN-PROGRAM"))) -

1 0

[gsharp-cvs] CVS gsharp
by mjonsson 15 Jun '07

15 Jun '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv27451 Modified Files: buffer.lisp play.lisp Log Message: Changed test.mid to /tmp/test.mid in play.lisp, removed code duplication calculating durations of bars --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/06 13:16:02 1.44 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/15 16:26:14 1.45 @@ -646,7 +646,7 @@ ;;; 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)))) + (reduce #'+ (elements bar) :key #'duration)) (defgeneric make-bar-for-staff (staff &rest args &key elements)) --- /project/gsharp/cvsroot/gsharp/play.lisp 2006/03/02 09:29:44 1.5 +++ /project/gsharp/cvsroot/gsharp/play.lisp 2007/06/15 16:26:14 1.6 @@ -14,9 +14,7 @@ (defun measure-durations (slices) (let ((durations (mapcar (lambda (slice) - (mapcar (lambda (bar) - (reduce #'+ (elements bar) - :key #'duration)) + (mapcar #'duration (bars slice))) slices))) (loop while durations @@ -80,11 +78,11 @@ :format 1 :division 25 :tracks tracks))) - (write-midi-file midifile "test.mid") + (write-midi-file midifile "/tmp/test.mid") #+cmu - (ext:run-program "timidity" '("test.mid")) + (ext:run-program "timidity" '("/tmp/test.mid")) #+sbcl - (sb-ext:run-program "timidity" '("test.mid") :search t) + (sb-ext:run-program "timidity" '("/tmp/test.mid") :search t) #-(or cmu sbcl) (error "write compatibility layer for RUN-PROGRAM")))

1 0

[gsharp-cvs] CVS gsharp
by crhodes 10 Jun '07

10 Jun '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv21208 Modified Files: gui.lisp modes.lisp Log Message: select-layer-by-layout commands and keybindings (C-down and C-up for now) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/07 09:26:04 1.75 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/10 08:15:28 1.76 @@ -1108,6 +1108,38 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; selecting layers based on layout (next/previous staff) + +;;; FIXME: numeric argument handling again +(define-gsharp-command (com-previous-staff :name t) + () + (let ((staff (car (staves (layer (current-cursor)))))) + (loop for (prev curr) on (staves (current-buffer)) + if (eq curr staff) + do (let ((layers (layers (segment (current-cursor))))) + (dolist (layer layers) + (when (member prev (staves layer)) + (select-layer (current-cursor) layer) + (do () + ((eq prev (car (staves layer)))) + (com-rotate-staves)) + (return-from com-previous-staff))))))) +(define-gsharp-command (com-next-staff :name t) + () + (let ((staff (car (staves (layer (current-cursor)))))) + (loop for (curr next) on (staves (current-buffer)) + if (eq curr staff) + do (let ((layers (layers (segment (current-cursor))))) + (dolist (layer layers) + (when (member next (staves layer)) + (select-layer (current-cursor) layer) + (do () + ((eq next (car (staves layer)))) + (com-rotate-staves)) + (return-from com-next-staff))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; delete commands (defun go-to-beginning-of-bar (cursor) --- /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/07 09:26:05 1.22 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/10 08:15:29 1.23 @@ -17,6 +17,10 @@ (set-key 'com-end-of-line 'global-gsharp-table '((#\e :control))) (set-key 'com-beginning-of-line 'global-gsharp-table '((#\a :control))) +;;; FIXME: implement numeric arg handling +(set-key 'com-previous-staff 'global-gsharp-table '((:up :control))) +(set-key 'com-next-staff 'global-gsharp-table '((:down :control))) + (set-key 'com-insert-barline 'global-gsharp-table '(#\|)) (set-key 'com-end-of-score 'global-gsharp-table '((#\> :shift :meta)))

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 June 2007