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

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

30 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv29032 Modified Files: drawing.lisp Log Message: Attempting to get rid of with-vertical-score-position so that the cursor can ultimately be drawn independently of the systems. Date: Wed Nov 30 23:23:54 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.41 gsharp/drawing.lisp:1.42 --- gsharp/drawing.lisp:1.41 Wed Nov 30 19:06:00 2005 +++ gsharp/drawing.lisp Wed Nov 30 23:23:51 2005 @@ -299,7 +299,7 @@ (new-draw-bar pane bar draw-cursor) (score-pane:with-light-glyphs pane (new-draw-bar pane bar draw-cursor))))) -(defun draw-measure (pane measure min-dist compress x method draw-cursor) +(defun draw-measure (pane measure min-dist compress x y method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) compress)) (time-alist (cons (cons 0 (/ (min-width method) compress)) @@ -316,8 +316,8 @@ compress)))))) (loop for bar in (measure-bars measure) do (if (gsharp-cursor::cursors (slice bar)) - (draw-bar pane bar x width time-alist draw-cursor) - (score-pane:with-light-glyphs pane (draw-bar pane bar x width time-alist draw-cursor)))))) + (draw-bar pane bar x y width time-alist draw-cursor) + (score-pane:with-light-glyphs pane (draw-bar pane bar x y width time-alist draw-cursor)))))) ;;; eventually remove the existing draw-system and rename this ;;; to draw-system @@ -330,16 +330,16 @@ (staff-yoffset (car (last staves)))))) -(defun draw-system (pane measures x widths method staves draw-cursor) +(defun draw-system (pane measures x y widths method staves draw-cursor) (let ((compress (compute-compress-factor measures method)) (min-dist (compute-min-dist measures))) (loop for measure in measures for width in widths do - (draw-measure pane measure min-dist compress x method draw-cursor) + (draw-measure pane measure min-dist compress x y method draw-cursor) (incf x width) (score-pane:draw-bar-line pane x - (- (score-pane:staff-step 8)) - (staff-yoffset (car (last staves))))))) + (+ y (- (score-pane:staff-step 8))) + (+ y (staff-yoffset (car (last staves)))))))) (defmethod draw-buffer (pane (buffer buffer) *cursor* x y draw-cursor) (score-pane:with-staff-size 6 @@ -379,12 +379,12 @@ (force-at-size e-fun (line-width method))))) nil) (let ((widths (compute-widths measures method))) - (score-pane:with-vertical-score-position (pane yy) - (draw-system pane measures (+ x (left-offset buffer) timesig-offset) - widths method staves draw-cursor) - (score-pane:draw-bar-line pane x - (- (score-pane:staff-step 8)) - (staff-yoffset (car (last staves))))) + (draw-system pane measures + (+ x (left-offset buffer) timesig-offset) yy + widths method staves draw-cursor) + (score-pane:draw-bar-line pane x + (+ yy (- (score-pane:staff-step 8))) + (+ yy (staff-yoffset (car (last staves))))) (loop for staff in staves do (score-pane:with-vertical-score-position (pane yy) (if (member staff (staves (layer (slice (bar *cursor*))))) @@ -569,37 +569,39 @@ (defgeneric new-draw-bar (pane bar draw-cursor)) -(defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) +(defmethod draw-bar (pane (bar melody-bar) x y width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) - (loop for group in (beam-groups (elements bar)) - do (draw-beam-group pane group)) - (when (eq (cursor-bar *cursor*) bar) - (let ((elements (elements bar))) - (if (null (cursor-element *cursor*)) - (funcall draw-cursor (/ (+ (if (null elements) - x - (final-absolute-element-xoffset (car (last elements)))) - x width) 2)) - (loop for element in elements - and xx = x then (final-absolute-element-xoffset element) do - (when (eq (cursor-element *cursor*) element) - (funcall draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2)))))))) + (score-pane:with-vertical-score-position (pane y) + (loop for group in (beam-groups (elements bar)) + do (draw-beam-group pane group)) + (when (eq (cursor-bar *cursor*) bar) + (let ((elements (elements bar))) + (if (null (cursor-element *cursor*)) + (funcall draw-cursor (/ (+ (if (null elements) + x + (final-absolute-element-xoffset (car (last elements)))) + x width) 2)) + (loop for element in elements + and xx = x then (final-absolute-element-xoffset element) do + (when (eq (cursor-element *cursor*) element) + (funcall draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2))))))))) -(defmethod draw-bar (pane (bar lyrics-bar) x width time-alist draw-cursor) +(defmethod draw-bar (pane (bar lyrics-bar) x y width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) - (let ((elements (elements bar))) - (loop for element in elements - do (draw-element pane element (final-absolute-element-xoffset element))) - (when (eq (cursor-bar *cursor*) bar) - (if (null (cursor-element *cursor*)) - (funcall draw-cursor (/ (+ (if (null elements) - x - (final-absolute-element-xoffset (car (last elements)))) - x width) 2)) - (loop for element in elements - and xx = x then (final-absolute-element-xoffset element) do - (when (eq (cursor-element *cursor*) element) - (funcall draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2)))))))) + (score-pane:with-vertical-score-position (pane y) + (let ((elements (elements bar))) + (loop for element in elements + do (draw-element pane element (final-absolute-element-xoffset element))) + (when (eq (cursor-bar *cursor*) bar) + (if (null (cursor-element *cursor*)) + (funcall draw-cursor (/ (+ (if (null elements) + x + (final-absolute-element-xoffset (car (last elements)))) + x width) 2)) + (loop for element in elements + and xx = x then (final-absolute-element-xoffset element) do + (when (eq (cursor-element *cursor*) element) + (funcall draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

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

30 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv9432 Modified Files: drawing.lisp Log Message: More code that will eventually replace the existing spacing algorithm and the code for the final drawing. Date: Wed Nov 30 19:06:01 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.40 gsharp/drawing.lisp:1.41 --- gsharp/drawing.lisp:1.40 Wed Nov 30 06:52:47 2005 +++ gsharp/drawing.lisp Wed Nov 30 19:06:00 2005 @@ -1,5 +1,11 @@ (in-package :gsharp-drawing) +(define-added-mixin dmeasure () measure + (;; an elasticity function that describes how the space right after + ;; the initial barline of the measure behaves as a function of the + ;; force that is applied to it. + (prefix-elasticity-function :accessor prefix-elasticity-function))) + (define-added-mixin dstaff () staff ((yoffset :initform 0 :accessor staff-yoffset))) @@ -264,7 +270,9 @@ ;;; elasticity function of a measure. (defun compute-elasticity-functions (measures method) (loop for measure in measures - do (loop with result = (make-elementary-elasticity (min-width method) 0.0001) + do (setf (prefix-elasticity-function measure) + (make-elementary-elasticity (min-width method) 0.0001)) + do (loop with result = (prefix-elasticity-function measure) with timelines = (timelines measure) for i from 0 below (flexichain:nb-elements timelines) for timeline = (flexichain:element* timelines i) @@ -275,6 +283,22 @@ finally (setf (elasticity-function measure) result))) (reduce #'add-elasticities measures :key #'elasticity-function)) +;;; eventually remove the existing draw-measure and rename this +;;; to draw-measure +(defun new-draw-measure (pane measure x force draw-cursor) + (loop with timelines = (timelines measure) + for i from 0 below (flexichain:nb-elements timelines) + for timeline = (flexichain:element* timelines i) + and xx = (+ x (size-at-force (prefix-elasticity-function measure) force)) + then (+ xx (max (smallest-gap timeline) + (* force (elasticity timeline)))) + do (loop for element in (elements timeline) + do (setf (final-absolute-element-xoffset element) xx))) + (loop for bar in (measure-bars measure) + do (if (gsharp-cursor::cursors (slice bar)) + (new-draw-bar pane bar draw-cursor) + (score-pane:with-light-glyphs pane (new-draw-bar pane bar draw-cursor))))) + (defun draw-measure (pane measure min-dist compress x method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) compress)) @@ -295,6 +319,17 @@ (draw-bar pane bar x width time-alist draw-cursor) (score-pane:with-light-glyphs pane (draw-bar pane bar x width time-alist draw-cursor)))))) +;;; eventually remove the existing draw-system and rename this +;;; to draw-system +(defun new-draw-system (pane measures x force staves draw-cursor) + (loop for measure in measures + do (new-draw-measure pane measure x force draw-cursor) + do (incf x (size-at-force (elasticity-function measure) force)) + do (score-pane:draw-bar-line pane x + (- (score-pane:staff-step 8)) + (staff-yoffset (car (last staves)))))) + + (defun draw-system (pane measures x widths method staves draw-cursor) (let ((compress (compute-compress-factor measures method)) (min-dist (compute-min-dist measures))) @@ -531,6 +566,8 @@ (defun draw-cursor (pane x) (draw-line* pane x (- (score-pane:staff-step -4)) x (- (score-pane:staff-step 12)) :ink +red+)) + +(defgeneric new-draw-bar (pane bar draw-cursor)) (defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) (compute-element-x-positions bar x time-alist)

1 0

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

30 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv17460 Modified Files: drawing.lisp Log Message: Added comments and documentation strings to explain a bit more about the new spacing algorithm. Date: Wed Nov 30 06:52:47 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.39 gsharp/drawing.lisp:1.40 --- gsharp/drawing.lisp:1.39 Wed Nov 30 03:37:05 2005 +++ gsharp/drawing.lisp Wed Nov 30 06:52:47 2005 @@ -96,6 +96,14 @@ collect (/ (nat-width method (measure-coeff measure) min-dist) compress)))) +;;; Compute the elasticity of each timeline in each measure of the +;;; measures of a system (line) by taking its duration to the power of +;;; the spaceing style. This metric is arbitrarily normalized to the +;;; duration of a whole note, which means that the force to apply to a +;;; line is not comparable between two different lines. All we know +;;; is that timelines with the same elasticity will grow and shrink in +;;; parallel, and that proportions between two timelines of different +;;; durations will be preserved. (defun compute-elasticities (measures method) (loop for measure in measures do (loop with timelines = (timelines measure) @@ -104,8 +112,29 @@ do (setf (elasticity timeline) (expt (duration timeline) (spacing-style method)))))) -(defgeneric left-bulge (element pane)) -(defgeneric right-bulge (element pane)) +;;; FIXME: there should be an :around method that adds the value +;;; return by the main method to the explicit horizontal offset that +;;; the user wants to impose on an element, and the existence of this +;;; around method should be documented. +;;; FIXME: we should probably also allow for the user to introduce +;;; explicit (positive or negative) bulges that will be added in by +;;; the :around method, thus allowing the user to explicitly move two +;;; adjacent elements further apart, or to bring them closer together. +(defgeneric left-bulge (element pane) + (:documentation "The amount by which an element sticks out to the +left of the center of its timeline")) + +;;; FIXME: there should be an :around method that adds the value +;;; return by the main method to the explicit horizontal offset that +;;; the user wants to impose on an element, and the existence of this +;;; around method should be documented. +;;; FIXME: we should probably also allow for the user to introduce +;;; explicit (positive or negative) bulges that will be added in by +;;; the :around method, thus allowing the user to explicitly move two +;;; adjacent elements further apart, or to bring them closer together. +(defgeneric right-bulge (element pane) + (:documentation "The amount by which an element sticks out to the +right of the center of its timeline")) (defmethod left-bulge ((element element) pane) (score-pane:staff-step 1)) @@ -121,6 +150,15 @@ (+ (score-pane:staff-step 0.5) (/ (text-size pane (map 'string 'code-char (text element))) 2))) +;;; As it turns out, the spacing algorithm would be very complicated +;;; if we were to take into account exactly how elements with +;;; arbitrarily many timelines between them might influence the +;;; overall layout. Instead we apprixmate by obtaining a closest gap +;;; only between adjacent timelines as follows: first, we consider +;;; adjacent elements whose timelines are also adjacent (and there is +;;; a special case for the last element of a layer), and set the +;;; smallest gap between the timelines to the closest possible +;;; distance between the two elements... (defun compute-gaps-adjacent-timelines (bars method pane) (declare (ignore method)) (loop for bar in bars @@ -138,6 +176,27 @@ (+ (right-bulge e1 pane) (left-bulge e2 pane))))))))) +;;; ... Then we consider adjacent elements whose timelines are +;;; separated by at least one other timeline. If the sum of the +;;; distances between individual timelines is greater than or equal to +;;; the closest distance between the adjacent elements (which is +;;; likely if we are talking melody), then there is nothing to do, +;;; since the individual distances are more restrictive than that +;;; imposed by the adjacent elements. If not, we try to distribute +;;; the closest distance between the two adjacent elements over the +;;; individual timelines proportionally to the elasticity of the +;;; timlines. If in doing so, we find that some timeline already has +;;; a smallest gap that is larger than the fraction of the closest +;;; distance between adjacent elements that we attribute to it, then +;;; that smallest gap is subtracted from the distance we need to +;;; distribute, the timeline is removed from consideration, and we +;;; start over. This process must terminate (or else, the sum of the +;;; closest gaps must have been larger than the distance to distribute +;;; in the first place) with at least one timeline to distribute over. +;;; There is a special case here, which occurs when all the +;;; elasticites of the timelines to be considered is zero. In this +;;; case, instead of distributing proportionally to the elasticities +;;; of individual timelies, we distribute evenly between the timelines. (defun compute-gaps-separated-timelines (bars method pane) (declare (ignore method)) (flet ((handle-timelines (timelines element-gap) @@ -198,6 +257,11 @@ ;; whose corresponding timeline is not the last one in the meaure do (compute-gaps-separated-timelines (measure-bars measure) method pane))) +;;; When this function is called, each timeline has an elasticity and +;;; a smallest gap to the next adjacent timline (or to the end of the +;;; measure). These values, together with an elasticity function at +;;; the beginning of a measure, are used to compute the total +;;; elasticity function of a measure. (defun compute-elasticity-functions (measures method) (loop for measure in measures do (loop with result = (make-elementary-elasticity (min-width method) 0.0001) @@ -272,8 +336,11 @@ (compute-elasticities measures method) (compute-gaps measures method pane) (let* ((e-fun (compute-elasticity-functions measures method)) + ;; FIXME: it would be much better to compress the system + ;; proportionally, so that every smallest gap gets shrunk + ;; by the same percentage (force (if (> (zero-force-size e-fun) (line-width method)) - 0 + 0 (force-at-size e-fun (line-width method))))) nil) (let ((widths (compute-widths measures method)))

1 0

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

30 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv2660 Modified Files: drawing.lisp elasticity.lisp Log Message: Added comutation to determine what force needs to be applied to a line to stretch it to the available line width. Date: Wed Nov 30 03:37:06 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.38 gsharp/drawing.lisp:1.39 --- gsharp/drawing.lisp:1.38 Wed Nov 30 01:22:54 2005 +++ gsharp/drawing.lisp Wed Nov 30 03:37:05 2005 @@ -208,7 +208,8 @@ (add-elasticities result (make-elementary-elasticity (smallest-gap timeline) (elasticity timeline)))) - finally (setf (elasticity-function measure) result)))) + finally (setf (elasticity-function measure) result))) + (reduce #'add-elasticities measures :key #'elasticity-function)) (defun draw-measure (pane measure min-dist compress x method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) @@ -270,7 +271,11 @@ (lambda (measures) (compute-elasticities measures method) (compute-gaps measures method pane) - (compute-elasticity-functions measures method) + (let* ((e-fun (compute-elasticity-functions measures method)) + (force (if (> (zero-force-size e-fun) (line-width method)) + 0 + (force-at-size e-fun (line-width method))))) + nil) (let ((widths (compute-widths measures method))) (score-pane:with-vertical-score-position (pane yy) (draw-system pane measures (+ x (left-offset buffer) timesig-offset) Index: gsharp/elasticity.lisp diff -u gsharp/elasticity.lisp:1.2 gsharp/elasticity.lisp:1.3 --- gsharp/elasticity.lisp:1.2 Wed Nov 30 01:22:54 2005 +++ gsharp/elasticity.lisp Wed Nov 30 03:37:05 2005 @@ -52,6 +52,9 @@ required to obtain that size. The size must be larger than the size at zero force, as reported by zero-force-size")) +(defgeneric size-at-force (elasticity force) + (:documentation "for a given force, return the size at that force")) + (defclass elasticity () ((zero-force-size :initarg :zero-force-size :reader zero-force-size) (elements :initform '() :initarg :elements :reader elements))) @@ -124,10 +127,15 @@ do (pop l)) (+ current-force (/ (- size current-size) current-slope))))) - - - - - - - +(defmethod size-at-force ((e elasticity) force) + (let ((l (elements e)) + (current-size (zero-force-size e))) + (let ((current-force 0) + (current-slope 0)) + (loop until (or (null l) + (>= (caar l) force)) + do (incf current-size (* current-slope (- (caar l) current-force))) + do (setf current-force (caar l) + current-slope (cdar l)) + do (pop l)) + (+ current-size (* (- force current-force) current-slope))))) \ No newline at end of file

1 0

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

30 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv24865 Modified Files: drawing.lisp elasticity.lisp Log Message: Fixed a few bugs in the elasticity library. Added computation of elasticity functions for each measure. Date: Wed Nov 30 01:23:03 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.37 gsharp/drawing.lisp:1.38 --- gsharp/drawing.lisp:1.37 Tue Nov 29 05:22:20 2005 +++ gsharp/drawing.lisp Wed Nov 30 01:22:54 2005 @@ -198,6 +198,18 @@ ;; whose corresponding timeline is not the last one in the meaure do (compute-gaps-separated-timelines (measure-bars measure) method pane))) +(defun compute-elasticity-functions (measures method) + (loop for measure in measures + do (loop with result = (make-elementary-elasticity (min-width method) 0.0001) + with timelines = (timelines measure) + for i from 0 below (flexichain:nb-elements timelines) + for timeline = (flexichain:element* timelines i) + do (setf result + (add-elasticities + result + (make-elementary-elasticity (smallest-gap timeline) (elasticity timeline)))) + finally (setf (elasticity-function measure) result)))) + (defun draw-measure (pane measure min-dist compress x method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) compress)) @@ -258,6 +270,7 @@ (lambda (measures) (compute-elasticities measures method) (compute-gaps measures method pane) + (compute-elasticity-functions measures method) (let ((widths (compute-widths measures method))) (score-pane:with-vertical-score-position (pane yy) (draw-system pane measures (+ x (left-offset buffer) timesig-offset) Index: gsharp/elasticity.lisp diff -u gsharp/elasticity.lisp:1.1 gsharp/elasticity.lisp:1.2 --- gsharp/elasticity.lisp:1.1 Mon Nov 28 20:34:17 2005 +++ gsharp/elasticity.lisp Wed Nov 30 01:22:54 2005 @@ -56,6 +56,11 @@ ((zero-force-size :initarg :zero-force-size :reader zero-force-size) (elements :initform '() :initarg :elements :reader elements))) +(defmethod print-object ((e elasticity) stream) + (print-unreadable-object (e stream :type t :identity t) + (format stream "zero-size: ~a elements:~s" + (zero-force-size e) (elements e)))) + (defun make-zero-elasticity (size) "create an elasticity function that is constant for all values of the force" @@ -67,38 +72,41 @@ have a size smaller than the zero-force-size given" (make-instance 'elasticity :zero-force-size zero-force-size - :elements `(,(/ zero-force-size slope) . ,slope))) + :elements `((,(/ zero-force-size slope) . ,slope)))) (defmethod add-elasticities ((e1 elasticity) (e2 elasticity)) (let ((l1 (elements e1)) (l2 (elements e2)) (s1 0) (s2 0) - (result (list (+ (zero-force-size e1) (zero-force-size e2))))) + (zero-force-size (+ (zero-force-size e1) (zero-force-size e2))) + (elements '())) (loop until (and (null l1) (null l2)) do (cond ((null l1) (setf s2 (cdar l2)) - (push (cons (caar l2) (+ s1 s2)) result) + (push (cons (caar l2) (+ s1 s2)) elements) (pop l2)) ((null l2) (setf s1 (cdar l1)) - (push (cons (caar l1) (+ s1 s2)) result) + (push (cons (caar l1) (+ s1 s2)) elements) (pop l1)) - ((< 0.99999 (/ (caar l1) (caar l2)) 1.00001) + ((< 0.99999 (/ (+ (caar l1) 0.00001) (+ (caar l2) .00001)) 1.00001) (setf s1 (cdar l1) s2 (cdar l2)) - (push (cons (/ (+ (caar l1) (caar l2)) 2) (+ s1 s2)) result) + (push (cons (/ (+ (caar l1) (caar l2)) 2) (+ s1 s2)) elements) (pop l1) (pop l2)) ((< (caar l1) (caar l2)) (setf s1 (cdar l1)) - (push (cons (caar l1) (+ s1 s2)) result) + (push (cons (caar l1) (+ s1 s2)) elements) (pop l1)) (t (setf s2 (cdar l2)) - (push (cons (caar l2) (+ s1 s2)) result) + (push (cons (caar l2) (+ s1 s2)) elements) (pop l2)))) - (make-instance 'elasticity :elements (nreverse result)))) + (make-instance 'elasticity + :zero-force-size zero-force-size + :elements (nreverse elements)))) (defmethod force-at-size ((e elasticity) size) (let ((l (elements e))

1 0

[gsharp-cvs] CVS update: gsharp/Scores/spacetest.gsh
by rstrandh＠common-lisp.net 29 Nov '05

29 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Scores In directory common-lisp.net:/tmp/cvs-serv7153 Added Files: spacetest.gsh Log Message: Score to test the new spacing algorithm (which is not completely implemented yet). Date: Tue Nov 29 21:34:44 2005 Author: rstrandh

1 0

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

29 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv2766 Modified Files: gsharp.asd measure.lisp packages.lisp Log Message: Fixed a bug in the computation of the timelines. Added elasticity.lisp to gsharp.asd. Prepared the MEASURE class for holding an elasticity function. Date: Tue Nov 29 20:37:40 2005 Author: rstrandh Index: gsharp/gsharp.asd diff -u gsharp/gsharp.asd:1.3 gsharp/gsharp.asd:1.4 --- gsharp/gsharp.asd:1.3 Mon Nov 28 03:32:06 2005 +++ gsharp/gsharp.asd Tue Nov 29 20:37:39 2005 @@ -35,6 +35,7 @@ "postscript" "glyphs" "beaming" + "elasticity" "drawing" "cursor" "input-state" Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.18 gsharp/measure.lisp:1.19 --- gsharp/measure.lisp:1.18 Tue Nov 29 19:05:03 2005 +++ gsharp/measure.lisp Tue Nov 29 20:37:40 2005 @@ -424,8 +424,12 @@ (bar-pos :initarg :bar-pos :reader measure-bar-pos) ;; a list of the bars that make up this measure (bars :initarg :bars :reader measure-bars) - ;; the first timeline of the measure, or NIL of there are not timelines - (timelines :initform (make-instance 'ranked-flexichain) :reader timelines))) + ;; a ranked flexichain of timelines + (timelines :initform (make-instance 'ranked-flexichain) :reader timelines) + ;; a convex piecewise-linear function that determines the + ;; horizontal size of the measure as a function of the "force" that + ;; is applied to it + (elasticity-function :accessor elasticity-function))) (defun make-measure (min-dist coeff start-times seg-pos bar-pos bars) (make-instance 'measure :min-dist min-dist :coeff coeff @@ -656,7 +660,7 @@ (durations (abs-rel (measure-start-times measure)))) ;; create a timeline for each start time of the measure (loop for duration in durations - for start-time = 0 then (+ start-time duration) + and start-time = 0 then (+ start-time duration) for i from 0 do (let ((timeline (make-instance 'timeline :start-time start-time @@ -667,7 +671,7 @@ (loop for bar in (measure-bars measure) do (loop with timeline-index = 0 for element in (elements bar) - for start-time = 0 then (+ start-time (duration element)) + and start-time = 0 then (+ start-time (duration element)) do (loop while (< (start-time (flexichain:element* timelines timeline-index)) start-time) do (incf timeline-index)) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.35 gsharp/packages.lisp:1.36 --- gsharp/packages.lisp:1.35 Mon Nov 28 05:25:34 2005 +++ gsharp/packages.lisp Tue Nov 29 20:37:40 2005 @@ -135,7 +135,7 @@ #:group-notes-by-staff #:final-relative-note-xoffset #:final-accidental #:final-relative-accidental-xoffset #:timeline #:timelines #:elasticity - #:smallest-gap)) + #:smallest-gap #:elasticity-function)) (defpackage :gsharp-postscript (:use :clim :clim-lisp)

1 0

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

29 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv28565 Modified Files: measure.lisp Log Message: Fixed a bug in the code for creating the timelines. The calculation of the start times of the timelines was wrong. Date: Tue Nov 29 19:05:04 2005 Author: rstrandh Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.17 gsharp/measure.lisp:1.18 --- gsharp/measure.lisp:1.17 Tue Nov 29 05:22:20 2005 +++ gsharp/measure.lisp Tue Nov 29 19:05:03 2005 @@ -653,10 +653,10 @@ (defun compute-timelines (measure) (let ((timelines (timelines measure)) - (start-times (measure-start-times measure))) + (durations (abs-rel (measure-start-times measure)))) ;; create a timeline for each start time of the measure - (loop for start-time in start-times - for duration in (abs-rel start-times) + (loop for duration in durations + for start-time = 0 then (+ start-time duration) for i from 0 do (let ((timeline (make-instance 'timeline :start-time start-time @@ -665,15 +665,15 @@ ;; link each timeline to its elements and each element of a ;; timeline to the timeline (loop for bar in (measure-bars measure) - do (loop for element in (elements bar) + do (loop with timeline-index = 0 + for element in (elements bar) for start-time = 0 then (+ start-time (duration element)) - for timeline-index from 0 do (loop while (< (start-time (flexichain:element* timelines timeline-index)) start-time) - do (incf timeline-index)) + do (incf timeline-index)) do (let ((timeline (flexichain:element* timelines timeline-index))) - (push element (elements timeline)) - (setf (timeline element) timeline)))))) + (push element (elements timeline)) + (setf (timeline element) timeline)))))) ;;; Compute all the measures of a segment by stepping through all the ;;; bars in parallel as long as there is at least one simultaneous bar.

1 0

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

29 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv30924 Modified Files: drawing.lisp measure.lisp Log Message: Improved the computation of the bulge of a lyrics element. This improvement will allow me to test that the gaps between elements is calculated correctly. Also fixed a spelling error (was compute-bar-parameter, should be compute-bar-parameters) that made Gsharp fail on a score with lyrics. Date: Tue Nov 29 05:22:21 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.36 gsharp/drawing.lisp:1.37 --- gsharp/drawing.lisp:1.36 Tue Nov 29 04:05:24 2005 +++ gsharp/drawing.lisp Tue Nov 29 05:22:20 2005 @@ -110,8 +110,16 @@ (defmethod left-bulge ((element element) pane) (score-pane:staff-step 1)) +(defmethod left-bulge ((element lyrics-element) pane) + (+ (score-pane:staff-step 0.5) + (/ (text-size pane (map 'string 'code-char (text element))) 2))) + (defmethod right-bulge ((element element) pane) (score-pane:staff-step 1)) + +(defmethod right-bulge ((element lyrics-element) pane) + (+ (score-pane:staff-step 0.5) + (/ (text-size pane (map 'string 'code-char (text element))) 2))) (defun compute-gaps-adjacent-timelines (bars method pane) (declare (ignore method)) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.16 gsharp/measure.lisp:1.17 --- gsharp/measure.lisp:1.16 Mon Nov 28 05:25:34 2005 +++ gsharp/measure.lisp Tue Nov 29 05:22:20 2005 @@ -621,7 +621,7 @@ ;;; compute some important parameters of a bar (defgeneric compute-bar-parameters (bar)) -(defmethod compute-bar-parameter (bar) +(defmethod compute-bar-parameters (bar) nil) (defmethod compute-bar-parameters ((bar melody-bar))

1 0

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

29 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv25450 Modified Files: drawing.lisp Log Message: More code towards a better spacing algorithm. Date: Tue Nov 29 04:05:25 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.35 gsharp/drawing.lisp:1.36 --- gsharp/drawing.lisp:1.35 Mon Nov 28 05:25:34 2005 +++ gsharp/drawing.lisp Tue Nov 29 04:05:24 2005 @@ -108,28 +108,87 @@ (defgeneric right-bulge (element pane)) (defmethod left-bulge ((element element) pane) - 0) + (score-pane:staff-step 1)) (defmethod right-bulge ((element element) pane) - 0) + (score-pane:staff-step 1)) -(defun compute-gaps (measures method pane) +(defun compute-gaps-adjacent-timelines (bars method pane) + (declare (ignore method)) + (loop for bar in bars + do (loop for (e1 e2) on (elements bar) + for t1 = (timeline e1) + do (cond ((null e2) + (when (flexichain:flexi-last-p t1) + (setf (smallest-gap t1) + (max (smallest-gap t1) + (right-bulge e1 pane))))) + ((eq (flexichain:flexi-next t1) + (timeline e2)) + (setf (smallest-gap t1) + (max (smallest-gap t1) + (+ (right-bulge e1 pane) + (left-bulge e2 pane))))))))) + +(defun compute-gaps-separated-timelines (bars method pane) (declare (ignore method)) + (flet ((handle-timelines (timelines element-gap) + (let ((sum-gap (reduce #'+ timelines :key #'smallest-gap)) + (sum-elasticity (reduce #'+ timelines :key #'elasticity))) + (unless (> sum-gap element-gap) + (if (zerop sum-elasticity) + (loop for timeline = (find (/ element-gap (length timelines)) + timelines + :key #'smallest-gap + :test #'<) + until (null timeline) + do (decf element-gap (smallest-gap timeline)) + do (setf timelines (remove timeline timelines :test #'eq)) + finally (let ((gap (/ element-gap (length timelines)))) + (loop for timeline in timelines + do (setf (smallest-gap timeline) gap)))) + (loop for timeline = (let ((gap/elasticity (/ element-gap sum-elasticity))) + (find-if (lambda (timeline) + (> (smallest-gap timeline) + (* (elasticity timeline) gap/elasticity))) + timelines)) + until (null timeline) + do (decf element-gap (smallest-gap timeline)) + do (decf sum-elasticity (elasticity timeline)) + do (setf timelines (remove timeline timelines :test #'eq)) + finally (let ((gap/elasticity (/ element-gap sum-elasticity))) + (loop for timeline in timelines + do (setf (smallest-gap timeline) + (* (elasticity timeline) gap/elasticity)))))))))) + (loop for bar in bars + do (loop for (e1 e2) on (elements bar) + for t1 = (timeline e1) + do (cond ((null e2) + (unless (flexichain:flexi-last-p t1) + (let ((timelines (loop for tl = t1 then (flexichain:flexi-next tl) + collect tl + until (flexichain:flexi-last-p tl)))) + (handle-timelines timelines (right-bulge e1 pane))))) + ((not (eq (flexichain:flexi-next t1) + (timeline e2))) + (let ((timelines (loop for tl = t1 then (flexichain:flexi-next tl) + until (eq tl (timeline e2)) + collect tl))) + (handle-timelines timelines (+ (right-bulge e1 pane) + (left-bulge e2 pane)))))))))) + +(defun compute-gaps (measures method pane) (loop for measure in measures - do (loop for bar in (measure-bars measure) - do (loop for (e1 e2) on (elements bar) - for t1 = (timeline e1) - do (cond ((null e2) - (when (flexichain:flexi-last-p t1) - (setf (smallest-gap t1) - (max (smallest-gap t1) - (right-bulge e1 pane))))) - ((eq (flexichain:flexi-next t1) - (timeline e2)) - (setf (smallest-gap t1) - (max (smallest-gap t1) - (+ (right-bulge e1 pane) - (left-bulge e2 pane)))))))))) + ;; initially, look only at adjacent elements whose + ;; corrsponding timelines are also adjacent, and at the last + ;; element of a bar, provided that its timeline is also the + ;; last one in the measure + do (compute-gaps-adjacent-timelines (measure-bars measure) method pane) + + ;; then look at adjacent elements whose corresponding + ;; timelines are NOT adjacent, or the last element of a bar + ;; whose corresponding timeline is not the last one in the meaure + do (compute-gaps-separated-timelines (measure-bars measure) method pane))) (defun draw-measure (pane measure min-dist compress x method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist)

1 0