- gsharp-cvs@common-lisp.net - mailman3.common-lisp.net

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

05 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv26001 Modified Files: drawing.lisp Log Message: A step toward the separation of the code for assigning x and y coordinates to all objects and the code for drawing those objects. Date: Mon Dec 5 03:16:32 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.43 gsharp/drawing.lisp:1.44 --- gsharp/drawing.lisp:1.43 Thu Dec 1 02:54:10 2005 +++ gsharp/drawing.lisp Mon Dec 5 03:16:31 2005 @@ -324,9 +324,10 @@ coeff min-dist)) compress)))))) (loop for bar in (measure-bars measure) do + (compute-element-x-positions bar x time-alist) (if (gsharp-cursor::cursors (slice bar)) - (draw-bar pane bar x y width time-alist) - (score-pane:with-light-glyphs pane (draw-bar pane bar x y width time-alist)))))) + (draw-bar pane bar x y width) + (score-pane:with-light-glyphs pane (draw-bar pane bar x y width)))))) ;;; eventually remove the existing draw-system and rename this ;;; to draw-system @@ -486,8 +487,7 @@ (- bot-note-pos length))))) (defun compute-element-x-positions (bar x time-alist) - (let (;;(time-alist (time-alist bar)) - (start-time 0)) + (let ((start-time 0)) (mapc (lambda (element) (setf (final-absolute-element-xoffset element) (round (+ x @@ -524,7 +524,7 @@ (when (or (typep element 'rest) (notes element)) (when (non-empty-cluster-p element) (compute-stem-length element)) - (draw-element pane element (final-absolute-element-xoffset element)))) + (draw-element pane element))) (let* ((stem-direction (final-stem-direction (car elements))) (dominating-notes (loop for element in elements @@ -571,7 +571,7 @@ (+ (final-absolute-element-xoffset (car elements)) left) ss1 offset1 (+ (final-absolute-element-xoffset (car (last elements))) left) ss2 offset2)))) (loop for element in elements do - (draw-element pane element (final-absolute-element-xoffset element) nil)))))) + (draw-element pane element nil)))))) (defgeneric new-draw-bar (pane bar)) @@ -622,8 +622,7 @@ (when (eq element cursor-element) (draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2)))))))))) -(defmethod draw-bar (pane (bar melody-bar) x y width time-alist) - (compute-element-x-positions bar x time-alist) +(defmethod draw-bar (pane (bar melody-bar) x y width) (setf (system-y-position bar) y (final-absolute-bar-xoffset bar) x (final-width bar) width) @@ -631,21 +630,20 @@ (loop for group in (beam-groups (elements bar)) do (draw-beam-group pane group)))) -(defmethod draw-bar (pane (bar lyrics-bar) x y width time-alist) - (compute-element-x-positions bar x time-alist) +(defmethod draw-bar (pane (bar lyrics-bar) x y width) (setf (system-y-position bar) y (final-absolute-bar-xoffset bar) x (final-width bar) width) (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)))))) + do (draw-element pane element))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Cluster -(defgeneric draw-element (pane element x &optional flags)) +(defgeneric draw-element (pane element &optional flags)) (defmethod note-difference ((note1 note) (note2 note)) (- (pitch note1) (pitch note2))) @@ -695,19 +693,16 @@ ;;; draw a cluster. The stem direction and the stem position have ;;; already been computed. ;;; 1. Group notes by staff. -;;; 2. Determine which notes in each group go to the left and which notes -;;; go to the right of the stem. -;;; 3. Determine which notes in each group should be displayed with an accidental. -;;; 4. Compute the x offset of each accidental to be displayed. -;;; 5. Draw the notes in each group -;;; 6. If necessary, draw ledger lines for notes in a group -;;; 7. Draw the stem, if any -(defmethod draw-element (pane (element cluster) x &optional (flags t)) +;;; 2. Draw the notes in each group +;;; 3. If necessary, draw ledger lines for notes in a group +;;; 4. Draw the stem, if any +(defmethod draw-element (pane (element cluster) &optional (flags t)) (unless (null (notes element)) (let ((direction (final-stem-direction element)) (stem-pos (final-stem-position element)) (stem-yoffset (final-stem-yoffset element)) - (groups (group-notes-by-staff (notes element)))) + (groups (group-notes-by-staff (notes element))) + (x (final-absolute-element-xoffset element))) (when flags (score-pane:with-vertical-score-position (pane stem-yoffset) (draw-flags pane element x direction stem-pos))) @@ -729,19 +724,21 @@ ;;; ;;; Rest -(defmethod draw-element (pane (element rest) x &optional (flags t)) +(defmethod draw-element (pane (element rest) &optional (flags t)) (declare (ignore flags)) - (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) - (score-pane:draw-rest pane (undotted-duration element) x (staff-pos element)) - (draw-dots pane (dots element) x (1+ (staff-pos element))))) + (let ((x (final-absolute-element-xoffset element))) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) + (score-pane:draw-rest pane (undotted-duration element) x (staff-pos element)) + (draw-dots pane (dots element) x (1+ (staff-pos element)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Lyrics element -(defmethod draw-element (pane (element lyrics-element) x &optional (flags t)) +(defmethod draw-element (pane (element lyrics-element) &optional (flags t)) (declare (ignore flags)) - (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) - (with-text-family (pane :serif) - (draw-text* pane (map 'string 'code-char (text element)) - x 0 :align-x :center)))) + (let ((x (final-absolute-element-xoffset element))) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) + (with-text-family (pane :serif) + (draw-text* pane (map 'string 'code-char (text element)) + x 0 :align-x :center)))))

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/gui.lisp gsharp/packages.lisp
by rstrandh＠common-lisp.net 01 Dec '05

01 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv12638 Modified Files: drawing.lisp gui.lisp packages.lisp Log Message: Removed the cursor-drawing code from the score-drawing functions. Instead we now store the x and y positions and the width of each bar. Cursor drawing is now implemented as looking up those stored values and draing the cursor based on them. Date: Thu Dec 1 02:54:11 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.42 gsharp/drawing.lisp:1.43 --- gsharp/drawing.lisp:1.42 Wed Nov 30 23:23:51 2005 +++ gsharp/drawing.lisp Thu Dec 1 02:54:10 2005 @@ -1,5 +1,14 @@ (in-package :gsharp-drawing) +(define-added-mixin dbar () bar + (;; indicates the absolute y position of the system to which the + ;; bar belongs + (system-y-position :accessor system-y-position) + ;; the absolute x position of the bar + (final-absolute-bar-xoffset :accessor final-absolute-bar-xoffset) + ;; + (final-width :accessor final-width))) + (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 @@ -285,7 +294,7 @@ ;;; eventually remove the existing draw-measure and rename this ;;; to draw-measure -(defun new-draw-measure (pane measure x force draw-cursor) +(defun new-draw-measure (pane measure x force) (loop with timelines = (timelines measure) for i from 0 below (flexichain:nb-elements timelines) for timeline = (flexichain:element* timelines i) @@ -296,10 +305,10 @@ 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))))) + (new-draw-bar pane bar) + (score-pane:with-light-glyphs pane (new-draw-bar pane bar))))) -(defun draw-measure (pane measure min-dist compress x y method draw-cursor) +(defun draw-measure (pane measure min-dist compress x y method) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) compress)) (time-alist (cons (cons 0 (/ (min-width method) compress)) @@ -316,32 +325,32 @@ compress)))))) (loop for bar in (measure-bars measure) do (if (gsharp-cursor::cursors (slice bar)) - (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)))))) + (draw-bar pane bar x y width time-alist) + (score-pane:with-light-glyphs pane (draw-bar pane bar x y width time-alist)))))) ;;; eventually remove the existing draw-system and rename this ;;; to draw-system -(defun new-draw-system (pane measures x force staves draw-cursor) +(defun new-draw-system (pane measures x force staves) (loop for measure in measures - do (new-draw-measure pane measure x force draw-cursor) + do (new-draw-measure pane measure x force) 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 y widths method staves draw-cursor) +(defun draw-system (pane measures x y widths method staves) (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 y method draw-cursor) + (draw-measure pane measure min-dist compress x y method) (incf x width) (score-pane:draw-bar-line pane x (+ y (- (score-pane:staff-step 8))) (+ y (staff-yoffset (car (last staves)))))))) -(defmethod draw-buffer (pane (buffer buffer) *cursor* x y draw-cursor) +(defmethod draw-buffer (pane (buffer buffer) *cursor* x y) (score-pane:with-staff-size 6 (let* ((staves (staves buffer)) (timesig-offset (max (* (score-pane:staff-step 2) @@ -381,7 +390,7 @@ (let ((widths (compute-widths measures method))) (draw-system pane measures (+ x (left-offset buffer) timesig-offset) yy - widths method staves draw-cursor) + widths method staves) (score-pane:draw-bar-line pane x (+ yy (- (score-pane:staff-step 8))) (+ yy (staff-yoffset (car (last staves))))) @@ -564,44 +573,73 @@ (loop for element in elements do (draw-element pane element (final-absolute-element-xoffset element) nil)))))) -(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)) -(defgeneric new-draw-bar (pane bar draw-cursor)) +(defun draw-the-cursor (pane cursor-element last-note) + (let* ((cursor (cursor *application-frame*)) + (staff (car (staves (layer cursor)))) + (bar (bar cursor))) + (flet ((draw-cursor (x) + (let* ((sy (system-y-position bar)) + ;; Why (- STAFF-YOFFSET)? dunno. -- CSR, 2005-10-28 + (yoffset (- (gsharp-drawing::staff-yoffset staff)))) + (if (typep staff 'fiveline-staff) + (let* ((clef (clef staff)) + (bottom-line (- (ecase (name clef) (:treble 32) (:bass 24) (:c 35)) + (lineno clef))) + (lnote-offset (score-pane:staff-step (- last-note bottom-line)))) + (draw-line* pane + x (+ sy (- (+ (score-pane:staff-step 12) yoffset))) + x (+ sy (- (+ (score-pane:staff-step -4) yoffset))) + :ink +yellow+) + (draw-line* pane + (- x 1) (+ sy (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset))) + (- x 1) (+ sy (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset))) + :ink +red+) + (draw-line* pane + (+ x 1) (+ sy (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset))) + (+ x 1) (+ sy (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset))) + :ink +red+)) + (progn (draw-line* pane + (+ x 1) (+ sy (- (+ (score-pane:staff-step 2) yoffset))) + (+ x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset))) + :ink +red+) + (draw-line* pane + (- x 1) (+ sy (- (+ (score-pane:staff-step 2) yoffset))) + (- x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset))) + :ink +red+)))))) + (score-pane:with-staff-size 6 + (let* ((x (final-absolute-bar-xoffset bar)) + (width (final-width bar)) + (elements (elements bar))) + (if (null cursor-element) + (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 element cursor-element) + (draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2)))))))))) -(defmethod draw-bar (pane (bar melody-bar) x y width time-alist draw-cursor) +(defmethod draw-bar (pane (bar melody-bar) x y width time-alist) (compute-element-x-positions bar x time-alist) + (setf (system-y-position bar) y + (final-absolute-bar-xoffset bar) x + (final-width bar) width) (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))))))))) + do (draw-beam-group pane group)))) -(defmethod draw-bar (pane (bar lyrics-bar) x y width time-alist draw-cursor) +(defmethod draw-bar (pane (bar lyrics-bar) x y width time-alist) (compute-element-x-positions bar x time-alist) + (setf (system-y-position bar) y + (final-absolute-bar-xoffset bar) x + (final-width bar) width) (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))))))))) + do (draw-element pane element (final-absolute-element-xoffset element)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.46 gsharp/gui.lisp:1.47 --- gsharp/gui.lisp:1.46 Thu Dec 1 01:19:39 2005 +++ gsharp/gui.lisp Thu Dec 1 02:54:10 2005 @@ -103,44 +103,13 @@ for dx from (+ right 5) by 5 do (score-pane:draw-dot pane (+ xpos dx) 4))))))))) -(defun draw-the-cursor (pane x) - (let* ((state (input-state *application-frame*)) - (staff (car (staves (layer (cursor *application-frame*))))) - ;; Why (- STAFF-YOFFSET)? dunno. -- CSR, 2005-10-28 - (yoffset (- (gsharp-drawing::staff-yoffset staff)))) - (if (typep staff 'fiveline-staff) - (let* ((clef (clef staff)) - (bottom-line (- (ecase (name clef) (:treble 32) (:bass 24) (:c 35)) - (lineno clef))) - (lnote-offset (score-pane:staff-step (- (last-note state) bottom-line)))) - (draw-line* pane - x (- (+ (score-pane:staff-step 12) yoffset)) - x (- (+ (score-pane:staff-step -4) yoffset)) - :ink +yellow+) - (draw-line* pane - (- x 1) (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)) - (- x 1) (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)) - :ink +red+) - (draw-line* pane - (+ x 1) (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)) - (+ x 1) (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)) - :ink +red+)) - (progn (draw-line* pane - (+ x 1) (- (+ (score-pane:staff-step 2) yoffset)) - (+ x 1) (- (+ (score-pane:staff-step -2) yoffset)) - :ink +red+) - (draw-line* pane - (- x 1) (- (+ (score-pane:staff-step 2) yoffset)) - (- x 1) (- (+ (score-pane:staff-step -2) yoffset)) - :ink +red+))))) - (defmethod display-score ((frame gsharp) pane) (let* ((buffer (buffer frame))) (recompute-measures buffer) (score-pane:with-score-pane pane - (flet ((draw-cursor (x) (draw-the-cursor pane x))) - (draw-buffer pane buffer (cursor *application-frame*) - (left-margin buffer) 100 #'draw-cursor))))) + (draw-buffer pane buffer (cursor *application-frame*) + (left-margin buffer) 100) + (gsharp-drawing::draw-the-cursor pane (cursor-element (cursor *application-frame*)) (last-note (input-state *application-frame*)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.36 gsharp/packages.lisp:1.37 --- gsharp/packages.lisp:1.36 Tue Nov 29 20:37:40 2005 +++ gsharp/packages.lisp Thu Dec 1 02:54:10 2005 @@ -196,7 +196,7 @@ (:use :clim :clim-lisp :gsharp-buffer :gsharp-measure :gsharp-cursor :gsharp-utilities :sdl :gsharp-beaming :obseq) (:shadowing-import-from :gsharp-buffer #:rest) - (:export #:draw-buffer)) + (:export #:draw-buffer #:draw-the-cursor)) (defpackage :midi (:use :common-lisp)

1 0

[gsharp-cvs] CVS update: gsharp/gui.lisp
by rstrandh＠common-lisp.net 01 Dec '05

01 Dec '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv6095 Modified Files: gui.lisp Log Message: The input state is again visible. Date: Thu Dec 1 01:19:40 2005 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.45 gsharp/gui.lisp:1.46 --- gsharp/gui.lisp:1.45 Sat Nov 26 22:30:13 2005 +++ gsharp/gui.lisp Thu Dec 1 01:19:39 2005 @@ -67,7 +67,7 @@ (let ((state (input-state *application-frame*))) (score-pane:with-score-pane pane (score-pane:with-staff-size 10 - (score-pane:with-vertical-score-position (pane 800) + (score-pane:with-vertical-score-position (pane 100) (let ((xpos 30)) (score-pane:draw-notehead pane (notehead state) xpos 4) (when (not (eq (notehead state) :whole)) @@ -83,7 +83,7 @@ (loop repeat (lbeams state) for staff-step from -4 by 2 do (score-pane:draw-beam pane (- x 10) staff-step 0 x staff-step 0))))) - (score-pane:draw-left-stem pane xpos (score-pane:staff-step 4) (score-pane:staff-step -4))) + (score-pane:draw-left-stem pane xpos (- (score-pane:staff-step 4)) (- (score-pane:staff-step -4)))) (when (or (eq (stem-direction state) :auto) (eq (stem-direction state) :up)) (when (eq (notehead state) :filled) @@ -96,7 +96,7 @@ (loop repeat (lbeams state) for staff-step downfrom 12 by 2 do (score-pane:draw-beam pane (- x 10) staff-step 0 x staff-step 0))))) - (score-pane:draw-right-stem pane xpos (score-pane:staff-step 4) (score-pane:staff-step 12)))) + (score-pane:draw-right-stem pane xpos (- (score-pane:staff-step 4)) (- (score-pane:staff-step 12))))) (score-pane:with-notehead-right-offsets (right up) (declare (ignore up)) (loop repeat (dots state)

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