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)