[gsharp-cvs] CVS update: gsharp/drawing.lisp

[Robert Strandh]

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)