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

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

18 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv6081 Modified Files: drawing.lisp Log Message: Pursue the effort to separate the current drawing phase into two phases. Now, the x offset of a note is relative to that of the cluster, so that the relative x offset can be computed before the x offset of the cluster is known, i.e., before line breaking. Date: Fri Nov 18 17:59:53 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.22 gsharp/drawing.lisp:1.23 --- gsharp/drawing.lisp:1.22 Fri Nov 18 03:49:43 2005 +++ gsharp/drawing.lisp Fri Nov 18 17:59:53 2005 @@ -4,7 +4,8 @@ ((yoffset :initform 0 :accessor staff-yoffset))) (define-added-mixin dnote () note - ((final-xposition :accessor final-xposition) + (;; the relative x offset of the note with respect to the cluster + (final-relative-xoffset :accessor final-relative-xoffset) (final-accidental :initform nil :accessor final-accidental) ;; nil indicates that accidental has not been placed yet (accidental-position :initform nil :accessor accidental-position))) @@ -58,6 +59,12 @@ :x1 ,x1 :x2 ,x2) :stream pane)) +;;; Return the final x offset of a note. This value is computed from +;;; the x offset of the cluster of the note and the relative x offset +;;; of the note with respect to the cluster. +(defun final-xoffset (note) + (+ (element-xpos (cluster note)) (final-relative-xoffset note))) + (defun line-cost (measures method) (reduce (lambda (x y) (combine-cost method x y)) measures :initial-value nil)) @@ -519,7 +526,7 @@ (defun draw-notes (pane notes dots notehead) (loop for note in notes do - (draw-note pane note notehead dots (final-xposition note) (note-position note)))) + (draw-note pane note notehead dots (final-xoffset note) (note-position note)))) ;;; given a group of notes (i.e. a list of notes, all displayed on the ;;; same staff, compute their final x offsets. This is a question of @@ -527,14 +534,14 @@ ;;; the stem. The head-note of the stem goes to the left of an ;;; up-stem and to the right of a down-stem. The x offset of a cluster ;;; gives the x position of the head-note. -(defun compute-final-xpositions (group x direction) +(defun compute-final-relative-xoffsets (group direction) (setf group (sort (copy-list group) (if (eq direction :up) (lambda (x y) (< (note-position x) (note-position y))) (lambda (x y) (> (note-position x) (note-position y)))))) (score-pane:with-suspended-note-offset offset ;; the first element of the group is the head-note - (setf (final-xposition (car group)) x) + (setf (final-relative-xoffset (car group)) 0) ;; OFFSET is a positive quantity that determines the ;; absolute difference between the x offset of a suspended ;; note and that of a normally positioned note. @@ -546,7 +553,7 @@ ;; if adjacent notes are just one staff step apart, ;; then one must be suspended. (dx (if (= (abs (- pos old-pos)) 1) offset 0))) - (setf (final-xposition note) (+ x dx)) + (setf (final-relative-xoffset note) dx) ;; go back to ordinary offset (when (= (abs (- pos old-pos)) 1) (setf note old-note)))))) @@ -563,7 +570,7 @@ (accidentals note))))) (defun element-has-suspended-notes (element) - (not (apply #'= (mapcar #'final-xposition (notes element))))) + (not (apply #'= (mapcar #'final-relative-xoffset (notes element))))) ;;; table of x offsets (in staff steps) of accendentals. ;;; The first index represents a notehead or a type of accidental. @@ -649,7 +656,7 @@ :notehead)) (pos2 (note-position note2)) (xpos2 (or (accidental-position note2) - (final-xposition note2)))) + (final-xoffset note2)))) (- xpos2 (* staff-step (accidental-distance acc1 pos1 acc2 pos2))))) ;;; given a note and a list of notes, compute x offset of the accidental @@ -686,7 +693,7 @@ ;; i.e., one to the right of the stem, then the accidental of the topmost ;; suspended note is placed first. (let ((first-suspended-note - (find x notes-with-accidentals :test #'/= :key #'final-xposition))) + (find x notes-with-accidentals :test #'/= :key #'final-relative-xoffset))) (when first-suspended-note (setf notes-with-accidentals (remove first-suspended-note notes-with-accidentals)) @@ -729,7 +736,7 @@ (score-pane:with-vertical-score-position (pane stem-yoffset) (draw-flags pane element x direction stem-pos))) (loop for group in groups do - (compute-final-xpositions group x direction) + (compute-final-relative-xoffsets group direction) (compute-final-accidentals group) (compute-final-accidental-positions group x direction) (draw-notes pane group (dots element) (notehead element))

1 0

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

18 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv8113 Modified Files: drawing.lisp Log Message: continue the restructuring of drawing.lisp Date: Fri Nov 18 03:49:43 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.21 gsharp/drawing.lisp:1.22 --- gsharp/drawing.lisp:1.21 Fri Nov 18 02:59:27 2005 +++ gsharp/drawing.lisp Fri Nov 18 03:49:43 2005 @@ -217,7 +217,7 @@ (t n2))) notes)) -;;; compute and store several important pieces of information +;;; Compute and store several important pieces of information ;;; about an element: ;;; * the position, in staff steps of the top note. ;;; * the position, in staff steps of the bottom note. @@ -230,7 +230,7 @@ (setf (top-note-pos element) 4 (bot-note-pos element) 4))) -;;; compute and store several important pieces of information +;;; Compute and store several important pieces of information ;;; about an element: ;;; * the y-offset of the staff containing the top note. ;;; * the y-offset of the staff containing the bottom note. @@ -244,6 +244,8 @@ (top-note-staff-yoffset element) 0 (bot-note-staff-yoffset element) 0))) +;;; Compute and store the final stem direction of an element that is +;;; not beamed together with any other elements. (defun compute-stem-direction (element) (setf (final-stem-direction element) (if (or (eq (stem-direction element) :up) (eq (stem-direction element) :down)) @@ -304,11 +306,6 @@ (+ top-note-pos length) (- bot-note-pos length))))) -(defun compute-appearance (element) - (when (typep element 'cluster) - (compute-stem-direction element) - (compute-stem-length element))) - (defun compute-element-x-positions (bar x time-alist) (let (;;(time-alist (time-alist bar)) (start-time 0)) @@ -320,12 +317,16 @@ (incf start-time (duration element))) (elements bar)))) +;;; Compute and store the final stem directions of all the elements of +;;; a beam group with at least two elements in it. (defun compute-stem-directions (elements) - (if (not (eq (stem-direction (car elements)) :auto)) - (stem-direction (car elements)) - (let ((top-note-pos (reduce #'max elements :key #'top-note-pos)) - (bot-note-pos (reduce #'min elements :key #'bot-note-pos))) - (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up)))) + (let ((stem-direction (if (not (eq (stem-direction (car elements)) :auto)) + (stem-direction (car elements)) + (let ((top-note-pos (reduce #'max elements :key #'top-note-pos)) + (bot-note-pos (reduce #'min elements :key #'bot-note-pos))) + (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up))))) + (loop for element in elements + do (setf (final-stem-direction element) stem-direction)))) ;;; the dominating note among a bunch of notes is the ;;; one that is closest to the beam, i.e. the one @@ -348,14 +349,28 @@ (if (< (pitch n1) (pitch n2)) n1 n2)))))) notes)) -(defun draw-beam-group (pane elements) +;;; Given a list of elements to be beamed together, for each element, +;;; compute the top and bottom note position, and the final stem +;;; direction. +(defun compute-positions-and-stem-direction (elements) (mapc #'compute-top-bot-pos elements) + (if (null (cdr elements)) + (let ((element (car elements))) + (when (or (typep element 'rest) (notes element)) + (when (typep element 'cluster) + (compute-stem-direction element)))) + (compute-stem-directions elements))) + +(defun draw-beam-group (pane elements) (mapc #'compute-top-bot-yoffset elements) (if (null (cdr elements)) - (when (or (typep (car elements) 'rest) (notes (car elements))) - (compute-appearance (car elements)) - (draw-element pane (car elements) (element-xpos (car elements)))) - (let* ((stem-direction (compute-stem-directions elements)) + (let ((element (car elements))) + (when (or (typep element 'rest) (notes element)) + (when (typep element 'cluster) + (compute-stem-direction element) + (compute-stem-length element)) + (draw-element pane element (element-xpos element)))) + (let* ((stem-direction (final-stem-direction (car elements))) (dominating-notes (mapcar (lambda (e) (dominating-note (notes e) stem-direction)) elements)) @@ -370,8 +385,6 @@ (/ (element-xpos element) (score-pane:staff-step 1))) elements)) (beaming (beaming-single (mapcar #'list positions x-positions) stem-direction))) - (loop for element in elements do - (setf (final-stem-direction element) stem-direction)) (destructuring-bind ((ss1 . offset1) (ss2 . offset2)) beaming (let* ((y1 (+ ss1 (* 1/2 offset1))) (y2 (+ ss2 (* 1/2 offset2))) @@ -424,7 +437,8 @@ (defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) (loop for group in (beam-groups (elements bar)) - do (draw-beam-group pane group)) + do (compute-positions-and-stem-direction group) + (draw-beam-group pane group)) (when (eq (cursor-bar *cursor*) bar) (let ((elements (elements bar))) (if (null (cursor-element *cursor*)) @@ -537,6 +551,9 @@ (when (= (abs (- pos old-pos)) 1) (setf note old-note)))))) +;;; Given a list of notes to be displayed on the same staff line, for +;;; each note, compute the accidental to be displayed as a function of +;;; the accidentals of the note and the key signature of the staff. (defun compute-final-accidentals (group) (loop for note in group do (setf (final-accidental note)

1 0

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

18 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv3504 Modified Files: drawing.lisp measure.lisp Log Message: Prepare for a separation of the functionality in drawing.lisp into two parts: 1. A part that computes stem directions and x offsets of notes and accidentals relative to the x offset of the element. These computations will be used to determine physical widths of elements. 2. A part that computes exact x and y positions, beam slants, etc. for the final drawing phase. The first part will precede the line-breaking phase, so that the line-breaking algorithm can take physical widths into account. Date: Fri Nov 18 02:59:27 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.20 gsharp/drawing.lisp:1.21 --- gsharp/drawing.lisp:1.20 Tue Nov 15 19:49:52 2005 +++ gsharp/drawing.lisp Fri Nov 18 02:59:27 2005 @@ -221,19 +221,26 @@ ;;; about an element: ;;; * the position, in staff steps of the top note. ;;; * the position, in staff steps of the bottom note. +(defun compute-top-bot-pos (element) + (if (and (typep element 'cluster) (notes element)) + (let ((top-note (top-note (notes element))) + (bot-note (bot-note (notes element)))) + (setf (top-note-pos element) (note-position top-note) + (bot-note-pos element) (note-position bot-note))) + (setf (top-note-pos element) 4 + (bot-note-pos element) 4))) + +;;; compute and store several important pieces of information +;;; about an element: ;;; * the y-offset of the staff containing the top note. ;;; * the y-offset of the staff containing the bottom note. -(defun compute-top-bot-pos-yoffset (element) +(defun compute-top-bot-yoffset (element) (if (and (typep element 'cluster) (notes element)) (let ((top-note (top-note (notes element))) (bot-note (bot-note (notes element)))) - (setf (top-note-pos element) (note-position top-note) - (bot-note-pos element) (note-position bot-note) - (bot-note-staff-yoffset element) (staff-yoffset (staff bot-note)) + (setf (bot-note-staff-yoffset element) (staff-yoffset (staff bot-note)) (top-note-staff-yoffset element) (staff-yoffset (staff top-note)))) - (setf (top-note-pos element) 4 - (bot-note-pos element) 4 - ;; clearly wrong. should be taken from element or layer. + (setf ;; clearly wrong. should be taken from element or layer. (top-note-staff-yoffset element) 0 (bot-note-staff-yoffset element) 0))) @@ -342,7 +349,8 @@ notes)) (defun draw-beam-group (pane elements) - (mapc #'compute-top-bot-pos-yoffset elements) + (mapc #'compute-top-bot-pos elements) + (mapc #'compute-top-bot-yoffset elements) (if (null (cdr elements)) (when (or (typep (car elements) 'rest) (notes (car elements))) (compute-appearance (car elements)) @@ -399,10 +407,11 @@ (defun draw-cursor (pane x) (draw-line* pane x (- (score-pane:staff-step -4)) x (- (score-pane:staff-step 12)) :ink +red+)) -(defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) - (compute-element-x-positions bar x time-alist) - (let ((elements (elements bar)) - (group '())) +;;; Given a list of the elements of a bar, return a list of beam +;;; groups, where each beam group is a list of elements that are +;;; beamed together +(defun beam-groups (elements) + (let ((group '())) (loop while (not (null elements)) do (setf group '()) (push (pop elements) group) @@ -410,7 +419,12 @@ (> (rbeams (car group)) 0) (> (lbeams (car elements)) 0)) do (push (pop elements) group)) - (draw-beam-group pane (nreverse group)))) + collect (nreverse group)))) + +(defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) + (compute-element-x-positions bar x time-alist) + (loop for group in (beam-groups (elements bar)) + do (draw-beam-group pane group)) (when (eq (cursor-bar *cursor*) bar) (let ((elements (elements bar))) (if (null (cursor-element *cursor*)) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.7 gsharp/measure.lisp:1.8 --- gsharp/measure.lisp:1.7 Thu Nov 17 01:42:42 2005 +++ gsharp/measure.lisp Fri Nov 18 02:59:27 2005 @@ -28,13 +28,13 @@ (defmethod duration :around ((element relement)) (with-slots (duration) element - (when (or (modified-p element) (null duration)) - (setf duration (call-next-method)) - (setf (modified-p element) nil)) + (when (null duration) + (setf duration (call-next-method))) duration)) (defmethod mark-modified ((element relement)) - (setf (modified-p element) t) + (setf (modified-p element) t + (slot-value element 'duration) nil) (when (bar element) (mark-modified (bar element))))

1 0

[gsharp-cvs] CVS update: gsharp/Fonts/whole_rest.mf
by crhodes＠common-lisp.net 17 Nov '05

17 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Fonts In directory common-lisp.net:/tmp/cvs-serv25553/Fonts Modified Files: whole_rest.mf Log Message: make the whole (semibreve) rest hang from the second-line down. Date: Thu Nov 17 17:27:35 2005 Author: crhodes Index: gsharp/Fonts/whole_rest.mf diff -u gsharp/Fonts/whole_rest.mf:1.1.1.1 gsharp/Fonts/whole_rest.mf:1.2 --- gsharp/Fonts/whole_rest.mf:1.1.1.1 Mon Feb 16 16:46:36 2004 +++ gsharp/Fonts/whole_rest.mf Thu Nov 17 17:27:35 2005 @@ -2,9 +2,10 @@ begin_character(whole_rest) - fill unitsquare shifted (-0.5, -1) + fill unitsquare shifted (-0.5, 0) xscaled notehead_width yscaled (0.5 * staff_line_distance) + shifted (0, 0.5 * staff_line_distance) shifted (xoffset, yoffset) scaled magnification; @@ -12,9 +13,10 @@ begin_character(whole_rest_light) - fill unitsquare shifted (-0.5, -1) + fill unitsquare shifted (-0.5, 0) xscaled notehead_width yscaled (0.5 * staff_line_distance) + shifted (0, 0.5 * staff_line_distance) shifted (xoffset, yoffset) scaled magnification;

1 0

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

17 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv21978 Modified Files: measure.lisp Log Message: Finished (?) adding comments to measure.lisp. Date: Thu Nov 17 01:42:42 2005 Author: rstrandh Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.6 gsharp/measure.lisp:1.7 --- gsharp/measure.lisp:1.6 Wed Nov 16 20:44:52 2005 +++ gsharp/measure.lisp Thu Nov 17 01:42:42 2005 @@ -349,14 +349,19 @@ (mark-modified (buffer segment)))) ;;; temporary stuff +;;; call fun on every list of measures (which make up a line) +;;; in the buffer (defun new-map-over-obseq-subsequences (fun buf) (loop with m = (obseq-interval buf (buffer-pos buf 0 0)) while m do (multiple-value-bind (left right) + ;; find the end points of the interval that contains m (obseq-interval buf m) (funcall fun (loop for mm = left then (obseq-next buf mm) collect mm until (eq mm right))) + ;; move to the next measure after the rightmost one + ;; in the current line (setf m (obseq-next buf right))))) (defun buffer-cost-method (buffer) @@ -364,6 +369,7 @@ (defmethod recompute-measures ((buffer rbuffer)) (when (modified-p buffer) + ;; for now, invalidate everything (mapc #'adjust-lowpos-highpos (segments buffer)) ;; initialize cost method from buffer-specific style parameters (setf (obseq-cost-method buffer) @@ -377,6 +383,8 @@ ;;; ;;; Cost functions +;;; As required by the obseq library, define a cost method +;;; that is passed to the cost-comparison methods. (defclass measure-cost-method (cost-method) (;; the min width is taken from the min width of the buffer (min-width :initarg :min-width :reader min-width) @@ -391,11 +399,15 @@ :spacing-style spacing-style :line-width line-width)) +;;; As required by the obseq library, define a sequence cost, i.e., in +;;; this case the cost of a sequece of measures. (defclass measure-seq-cost (seq-cost) ((min-dist :initarg :min-dist :reader min-dist) (coeff :initarg :coeff :reader coeff) (nb-measures :initarg :nb-measures :reader nb-measures))) +;;; As required by the obseq library, define a total cost, i.e., in +;;; this case the cost of a sequece of sequences of measures. (defclass measure-total-cost (total-cost) ((cost :initarg :cost :reader measure-total-cost))) @@ -406,6 +418,15 @@ (print-unreadable-object (obj stream :identity t :type t) (format stream "~D" (measure-total-cost obj)))) +;;; As required by the obseq library, this method computes the +;;; combined cost of a sequence of measures by taking the existing +;;; cost of all but the last measures and combining it with the +;;; characteristics of the last measure. The result is a sequence +;;; cost that has the sum of the coefficients of each measure in the +;;; sequence, the min of the min-dists of each measure in the +;;; sequence, and the total number of measures in the sequence. +;;; As far as Gsharp is concerned, this cost computation is +;;; commutable, so rely on Obseq to supply the symmetric method. (defmethod combine-cost ((method measure-cost-method) (seq-cost measure-seq-cost) (elem measure)) @@ -414,6 +435,17 @@ :min-dist (min (min-dist seq-cost) (measure-min-dist elem)) :nb-measures (1+ (nb-measures seq-cost)))) +;;; As required by the obseq library, this method computes the +;;; combined cost of a sequence of sequences of measures by taking the +;;; existing cost of all but the last sequences of measures and +;;; combining it with the sequence cost of the last sequence of +;;; measures. The result is a total cost that has the max of the cost +;;; of each individual sequence of measures. The reason for using the +;;; max is that we do not want for a good line to be able to +;;; compensate for the badness of another. We thus compute the score +;;; that minimizes the maximum of the badness of each line. As far as +;;; Gsharp is concerned, this cost computation is commutable, so rely +;;; on Obseq to supply the symmetric method. (defmethod combine-cost ((method measure-cost-method) (tcost measure-total-cost) (seq-cost measure-seq-cost)) @@ -428,6 +460,8 @@ :cost (measure-seq-cost method seq-cost))) +;;; As required by the obseq library, this method computes the +;;; sequence cost of a singleton sequence. (defmethod combine-cost ((method measure-cost-method) (elem measure) (whatever (eql nil))) @@ -436,11 +470,21 @@ :min-dist (measure-min-dist elem) :nb-measures 1)) +;;; As required by the obseq library, this method computes the +;;; sequence cost of a singleton sequence. (defmethod combine-cost ((method measure-cost-method) (whatever (eql nil)) (elem measure)) (combine-cost method elem nil)) +;;; The reduced width of a sequence of measures is the sum of the +;;; widths of the measures in the sequence, but ignoring the space +;;; before first timeline. If the min-dist is 0 (which I think is the +;;; case if each measure has no timelines), then the reduced width is +;;; 0, otherwise we obtain the reduced width by multiplying the sum of +;;; the coefficients of each mesure in the sequence, the min-width to +;;; use for the display, and (1/d_min)^k, where d_min is the duration +;;; of the shortest timeline, and k is the spacing style. (defmethod reduced-width ((method measure-cost-method) (seq-cost measure-seq-cost)) (if (zerop (min-dist seq-cost)) @@ -448,42 +492,54 @@ (* (coeff seq-cost) (min-width method) (expt (/ (min-dist seq-cost)) (spacing-style method))))) +;;; The natural width of a sequence of mesures is like the reduced +;;; width, except that we do not ignore the space before the first +;;; timeline in each measure. That space might be necessary to +;;; parameterize one day, but for now we just use the w_min. (defmethod natural-width ((method measure-cost-method) (seq-cost measure-seq-cost)) (+ (reduced-width method seq-cost) (* (nb-measures seq-cost) (min-width method)))) +;;; The compress factor indicates how by how much a sequence of +;;; measures must be compressed in order to fit the line width at our +;;; disposal. Values > 1 indicate that the sequence of mesures must +;;; be stretched instead of compressed. (defmethod compress-factor ((method measure-cost-method) (seq-cost measure-seq-cost)) (/ (natural-width method seq-cost) (line-width method))) +;;; As far as Gsharp is concerned, we define the cost of a sequence of +;;; measures as the max of the compress factor and its inverse. In +;;; other words, we consider it as bad to have to stretch a line by x% +;;; as it is to have to compress it by x%, and the more we have to +;;; compress or expand it, the worse it is. This way of doing it is +;;; not great. At some point, we need to severely penalize compressed +;;; lines that become too short to display without overlaps, unless +;;; the line contains a single measure, of course. (defmethod measure-seq-cost ((method measure-cost-method) (seq-cost measure-seq-cost)) (let ((c (compress-factor method seq-cost))) (max c (/ c)))) +;;; As required by the obseq library, we define a method that +;;; determines whether we can prove that adding another measure to an +;;; existing sequence is guaranteed to make the cost of the sequence +;;; higher. The obseq library uses this to radically diminish the +;;; complexity of the computation. (defmethod seq-cost-cannot-decrease ((method measure-cost-method) (seq-cost measure-seq-cost)) (>= (natural-width method seq-cost) (line-width method))) +;;; Compare the cost of two sequences of measures (defmethod cost-less ((method measure-cost-method) (c1 measure-seq-cost) (c2 measure-seq-cost)) (< (measure-seq-cost method c1) (measure-seq-cost method c2))) +;;; Compare the cost of two sequences of sequences of measures (defmethod cost-less ((method measure-cost-method) (c1 measure-total-cost) (c2 measure-total-cost)) (< (measure-total-cost c1) (measure-total-cost c2))) - -(defmethod cost-less ((method measure-cost-method) - (c1 measure-seq-cost) - (c2 measure-seq-cost)) - (< (measure-seq-cost method c1) (measure-seq-cost method c2))) - -(defmethod cost-less ((method measure-cost-method) - (c1 measure-total-cost) - (c2 measure-total-cost)) - (< (measure-total-cost c1) (measure-total-cost c2))) -

1 0

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

16 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv32077 Modified Files: measure.lisp Log Message: More comments to improve maintainability. Date: Wed Nov 16 20:44:52 2005 Author: rstrandh Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.5 gsharp/measure.lisp:1.6 --- gsharp/measure.lisp:1.5 Wed Nov 16 02:27:34 2005 +++ gsharp/measure.lisp Wed Nov 16 20:44:52 2005 @@ -125,26 +125,30 @@ ;;; ;;; Measure -;;; A measure represents the set of simultaneous bars. -;;; Define a TIMELINE of a measure to be the set of all -;;; simultaneous elements of the bars of the measure. -;;; The DURATION of a timeline is either the distance to -;;; the next closest timeline following it, or, in case -;;; it is the last timeline of the measure, the duration -;;; of the longest element of the timeline. +;;; A measure represents the set of simultaneous bars. Define a +;;; TIMELINE of a measure to be the set of all simultaneous elements +;;; of the bars of the measure. The DURATION of a timeline is either +;;; the temporal distance to the next closest timeline following it, +;;; or, in case it is the last timeline of the measure, the duration +;;; of the longest element of the timeline. (defclass measure (obseq-elem) - (;; the smallest temporal distance between either two adjacent - ;; timelines in the measure or between the last timeline - ;; and the end of the mesure. The temporal distance between - ;; the last timeline and the end of the measure is the same - ;; as the duration of the longest element of the last timeline. + (;; the smallest duration of any timeline in the measure (min-dist :initarg :min-dist :reader measure-min-dist) - ;; the coefficient of a measure is the sum of + ;; the coefficient of a measure is the sum of d_i^k where d_i + ;; is the duration of the i:th timeline, and k is the spacing style (coeff :initarg :coeff :reader measure-coeff) + ;; a list of unique rational numbers, sorted by increasing numeric value, + ;; of the start time of the time lines of the measure (start-times :initarg :start-times :reader measure-start-times) + ;; the position of a measure in the sequence of measures + ;; of a buffer is indicated by two numbers, the position + ;; of the segment to which the measure belongs within the + ;; sequence of segments of the buffer, and the position of + ;; the bars within that segment. (seg-pos :initarg :seg-pos :reader measure-seg-pos) (bar-pos :initarg :bar-pos :reader measure-bar-pos) + ;; a list of the bars that make up this measure (bars :initarg :bars :reader measure-bars))) (defun make-measure (min-dist coeff start-times seg-pos bar-pos bars) @@ -179,6 +183,8 @@ (defun adjust-lowpos-highpos (segment) (when (modified-p segment) (let ((buffer (buffer segment))) + ;; Do this better. Now, we essentially tell the obseq library + ;; that every measure in the entire buffer has been damaged. (obseq-first-undamaged-element buffer nil) (obseq-last-undamaged-element buffer nil)))) @@ -190,34 +196,63 @@ (defmethod nb-measures ((segment rsegment)) (length (measures segment))) +;;; Given a segment and a position, return the measure in that +;;; position in the sequence of measures in the segment. (defmethod measureno ((segment rsegment) position) (elt (measures segment) position)) -;;; convert a list of durations to a list of start times +;;; Convert a list of durations to a list of start times +;;; by accumulating values starting at zero. +;;; The list returned has the same length as the one passed +;;; as argument, which we obtain by treating the first element +;;; as the initial start time. Doing so makes it possible to compute +;;; the inverse of this transformation. (defun rel-abs (list) (loop with acc = 0 for elem in list collect (incf acc elem))) -;;; convert a list of start times to a list of durations +;;; Convert a list of start times to a list of durations +;;; by computing the differences beteen adjacent elements. +;;; The list returned has the same length as the one passed +;;; as argument, which we obtain by including the first +;;; element unchanged. Doing so makes it possible to compute +;;; the inverse of this transformation. (defun abs-rel (list) (loop with prev = 0 for elem in list collect (- elem prev) do (setf prev elem))) +;;; Compute the start times of the elements of the bar. The last +;;; element is the "start time" of the end of the bar. Currently, we +;;; do not handle zero-duration bars very well. For that reason, when +;;; there are no elements in the bar, we return the list of a single +;;; number 1. This is clearly wrong, so we need to figure out a +;;; better way of doing that. (defun start-times (bar) (let ((elements (elements bar))) (if elements (rel-abs (mapcar #'duration elements)) '(1)))) -;;; treat the last start time (which is really the duration of the +;;; Combine the list of start times of two bars into a single list +;;; of start times. Don't worry about duplicated elements which will +;;; be removed ultimately. +;;; Treat the last start time (which is really the duration of the ;;; bar) specially and only keep the largest one (defun combine-bars (bar1 bar2) (append (merge 'list (butlast bar1) (butlast bar2) #'<) (list (max (car (last bar1)) (car (last bar2)))))) +;;; From a list of simultaneous bars (and some other stuff), create a +;;; measure. The `other stuff' is the spacing style, which is neded +;;; in order to compute the coefficient of the measure, the position +;;; of the segment to which the bars belong in the sequence of +;;; segments of the buffer, and the position of the bars in the +;;; sequence of bars within that segment. The last two items are used +;;; to indicate the position of the measure in the sequence of all +;;; measures of the buffer. (defun compute-measure (bars spacing-style seg-pos bar-pos) (let* ((start-times (remove-duplicates (reduce #'combine-bars @@ -228,6 +263,8 @@ sum (expt duration spacing-style)))) (make-measure min-dist coeff start-times seg-pos bar-pos bars))) +;;; Compute all the measures of a segment by stepping through all the +;;; bars in parallel as long as there is at least one simultaneous bar. (defun compute-measures (segment spacing-style) (setf (slot-value segment 'measures) (loop for all-bars on (mapcar (lambda (layer) (bars (body layer))) @@ -246,11 +283,21 @@ (define-added-mixin rbuffer (obseq) buffer ((modified-p :initform t :accessor modified-p))) +;;; Given a buffer, a position of a segment in the sequence of +;;; segments of the buffer, and a position of a measure within that +;;; segment, return the corresponding measure. (defmethod buffer-pos ((buffer rbuffer) seg-pos bar-pos) (if (or (<= seg-pos -1) (>= seg-pos (nb-segments buffer))) nil (measureno (segmentno buffer seg-pos) bar-pos))) +;;; as required by the obseq library, we supply a method on this +;;; generic function. When we are given a measure other than the last +;;; one in the segment, return the next one in the segment. When we +;;; are given the last measure in a segment which is not the last one, +;;; return the first measure in the following segment. When we are +;;; given the last measure of the last segment, return nil as required +;;; by the obseq library. (defmethod obseq-next ((buf buffer) (measure measure)) (let ((seg-pos (measure-seg-pos measure)) (bar-pos (measure-bar-pos measure))) @@ -260,9 +307,19 @@ (buffer-pos buf (1+ seg-pos) 0)) (t nil)))) +;;; as required by the obseq library, we supply a method on this +;;; generic function specialized on NIL, for which the first measure +;;; of the first segment is returned. (defmethod obseq-next ((buf buffer) (measure (eql nil))) (measureno (segmentno buf 0) 0)) +;;; as required by the obseq library, we supply a method on this +;;; generic function. When we are given a measure other than the first +;;; one in the segment, return the previous one in the segment. When we +;;; are given the first measure in a segment which is not the first one, +;;; return the last measure in the preceding segment. When we are +;;; given the first measure of the first segment, return nil as required +;;; by the obseq library. (defmethod obseq-prev ((buf buffer) (measure measure)) (let ((seg-pos (measure-seg-pos measure)) (bar-pos (measure-bar-pos measure))) @@ -272,6 +329,9 @@ (1- (nb-measures (segmentno buf (1- seg-pos)))))) (t nil)))) +;;; as required by the obseq library, we supply a method on this +;;; generic function specialized on NIL, for which the last measure +;;; of the last segment is returned. (defmethod obseq-prev ((buf buffer) (measure (eql nil))) (buffer-pos buf (1- (nb-segments buf))

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/flexichain.lisp
by rstrandh＠common-lisp.net 16 Nov '05

16 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv27532 Modified Files: flexichain.lisp Log Message: Fixed a bug that made :initial-contents not work properly. Date: Wed Nov 16 19:33:10 2005 Author: rstrandh Index: gsharp/Flexichain/flexichain.lisp diff -u gsharp/Flexichain/flexichain.lisp:1.7 gsharp/Flexichain/flexichain.lisp:1.8 --- gsharp/Flexichain/flexichain.lisp:1.7 Wed Nov 16 04:06:59 2005 +++ gsharp/Flexichain/flexichain.lisp Wed Nov 16 19:33:10 2005 @@ -176,7 +176,7 @@ initial-contents fill-list))))) (with-slots (gap-start gap-end data-start) chain - (setf gap-start 2 + (setf gap-start (+ 2 (length initial-contents)) gap-end 0 data-start 1)))

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/flexirank.lisp gsharp/Flexichain/flexichain-package.lisp gsharp/Flexichain/flexichain.asd gsharp/Flexichain/flexichain.lisp
by rstrandh＠common-lisp.net 16 Nov '05

16 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv23816 Modified Files: flexichain-package.lisp flexichain.asd flexichain.lisp Added Files: flexirank.lisp Log Message: The code in the new file flexirank.lisp makes it possible for client code to define a `ranked flexichain' which is a flexichain or a cursorchain in which the elements know their position. Also removed a useless defgeneric from flexichain.lisp Date: Wed Nov 16 04:06:59 2005 Author: rstrandh Index: gsharp/Flexichain/flexichain-package.lisp diff -u gsharp/Flexichain/flexichain-package.lisp:1.3 gsharp/Flexichain/flexichain-package.lisp:1.4 --- gsharp/Flexichain/flexichain-package.lisp:1.3 Wed Mar 2 05:19:27 2005 +++ gsharp/Flexichain/flexichain-package.lisp Wed Nov 16 04:06:59 2005 @@ -36,4 +36,6 @@ #:at-beginning-p #:at-end-p #:move> #:move< #:insert #:insert-sequence - #:element< #:element> #:delete< #:delete>)) + #:element< #:element> #:delete< #:delete> + #:flexirank-mixin #:element-rank-mixin #:rank)) + Index: gsharp/Flexichain/flexichain.asd diff -u gsharp/Flexichain/flexichain.asd:1.3 gsharp/Flexichain/flexichain.asd:1.4 --- gsharp/Flexichain/flexichain.asd:1.3 Wed Mar 2 05:19:27 2005 +++ gsharp/Flexichain/flexichain.asd Wed Nov 16 04:06:59 2005 @@ -32,5 +32,6 @@ :components ((:file "flexichain-package") (:file "utilities" :depends-on ("flexichain-package")) (:file "flexichain" :depends-on ("utilities")) - (:file "flexicursor" :depends-on ("flexichain")))) + (:file "flexicursor" :depends-on ("flexichain")) + (:file "flexirank" :depends-on ("flexichain")))) Index: gsharp/Flexichain/flexichain.lisp diff -u gsharp/Flexichain/flexichain.lisp:1.6 gsharp/Flexichain/flexichain.lisp:1.7 --- gsharp/Flexichain/flexichain.lisp:1.6 Tue Dec 28 07:57:00 2004 +++ gsharp/Flexichain/flexichain.lisp Wed Nov 16 04:06:59 2005 @@ -199,9 +199,6 @@ (defmethod flexi-empty-p ((chain standard-flexichain)) (zerop (nb-elements chain))) -(defgeneric insert-object (chain position object) - (:documentation "Inserts an object at gap-start of a chain.")) - (defun position-index (chain position) "Returns the (0 indexed) index of the POSITION-th element of the CHAIN in the buffer."

1 0

[gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/measure.lisp
by rstrandh＠common-lisp.net 16 Nov '05

16 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv16112 Modified Files: buffer.lisp measure.lisp Log Message: added more comments to improve maintainability Date: Wed Nov 16 02:27:34 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.25 gsharp/buffer.lisp:1.26 --- gsharp/buffer.lisp:1.25 Thu Nov 10 18:36:36 2005 +++ gsharp/buffer.lisp Wed Nov 16 02:27:34 2005 @@ -916,7 +916,12 @@ (segments :initform '() :initarg :segments :accessor segments) (staves :initform (list (make-fiveline-staff)) :initarg :staves :accessor staves) + ;; the min width determines the preferred geographic distance after the + ;; timetlime with the shortest duration on a line. (min-width :initform *default-min-width* :initarg :min-width :accessor min-width) + ;; the spacing style of the buffer determines the how geographic distance + ;; between adjacent timelines is related to temporal distance. + ;; a value of 0 means constant spacing, a value of 1 means proportional spacing (spacing-style :initform *default-spacing-style* :initarg :spacing-style :accessor spacing-style) (right-edge :initform *default-right-edge* :initarg :right-edge :accessor right-edge) (left-offset :initform *default-left-offset* :initarg :left-offset :accessor left-offset) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.4 gsharp/measure.lisp:1.5 --- gsharp/measure.lisp:1.4 Mon Oct 31 03:16:27 2005 +++ gsharp/measure.lisp Wed Nov 16 02:27:34 2005 @@ -125,8 +125,22 @@ ;;; ;;; Measure +;;; A measure represents the set of simultaneous bars. +;;; Define a TIMELINE of a measure to be the set of all +;;; simultaneous elements of the bars of the measure. +;;; The DURATION of a timeline is either the distance to +;;; the next closest timeline following it, or, in case +;;; it is the last timeline of the measure, the duration +;;; of the longest element of the timeline. + (defclass measure (obseq-elem) - ((min-dist :initarg :min-dist :reader measure-min-dist) + (;; the smallest temporal distance between either two adjacent + ;; timelines in the measure or between the last timeline + ;; and the end of the mesure. The temporal distance between + ;; the last timeline and the end of the measure is the same + ;; as the duration of the longest element of the last timeline. + (min-dist :initarg :min-dist :reader measure-min-dist) + ;; the coefficient of a measure is the sum of (coeff :initarg :coeff :reader measure-coeff) (start-times :initarg :start-times :reader measure-start-times) (seg-pos :initarg :seg-pos :reader measure-seg-pos) @@ -304,8 +318,11 @@ ;;; Cost functions (defclass measure-cost-method (cost-method) - ((min-width :initarg :min-width :reader min-width) + (;; the min width is taken from the min width of the buffer + (min-width :initarg :min-width :reader min-width) + ;; the spaceing style is taken from the spacing style of the buffer (spacing-style :initarg :spacing-style :reader spacing-style) + ;; the amount of horizontal space available to music material (line-width :initarg :line-width :reader line-width))) (defun make-measure-cost-method (min-width spacing-style line-width)

1 0

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

15 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv21136 Modified Files: gsharp.tex Log Message: fixed minor typos in the documentation. Date: Tue Nov 15 20:14:58 2005 Author: rstrandh Index: gsharp/Doc/gsharp.tex diff -u gsharp/Doc/gsharp.tex:1.5 gsharp/Doc/gsharp.tex:1.6 --- gsharp/Doc/gsharp.tex:1.5 Tue Nov 1 18:56:51 2005 +++ gsharp/Doc/gsharp.tex Tue Nov 15 20:14:58 2005 @@ -702,7 +702,7 @@ There is a slight problem with \emph{head slices} and \emph{tail slices} which is why they are not implemented yet. While -conceptually these slices below to the segment of their +conceptually these slices belong to the segment of their corresponding layer, the layout algorithm must align them with the last measure of the previous segment and the first measure of the next segment. To make it impossible for those slices to stick out @@ -738,7 +738,7 @@ but that is not all there is to it. In fact, we also know that \emph{on a given line}, the smallest geographic distance possible (a global parameter of the score that determines denseness and that we -will call $w_min$) is assigned to the shortest temporal distance on +will call $w_{min}$) is assigned to the shortest temporal distance on that line, \emph{independently of the absolute value of that temporal distance}. The other geographic distances are adjusted accordingly. Thus, a measure can take up a lot more space on a line if other

1 0