gsharp-cvs July 2007

gsharp-cvs@common-lisp.net

2 participants
12 discussions

[gsharp-cvs] CVS gsharp
by crhodes 28 Jul '07

28 Jul '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv9849 Modified Files: score-pane.lisp Log Message: Make the light glyphs ink a function of the view, allowing for views of the same class but with all-black printing (e.g. for noninteractive Postscript or HTML Canvas output.) Make barlines be drawn at integral coordinates. --- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/06/14 03:38:56 1.36 +++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2007/07/27 22:34:31 1.37 @@ -1,7 +1,8 @@ (in-package :score-pane) (defclass score-view (view) - ((%number-of-pages :initform "-" :accessor number-of-pages) + ((light-glyphs-ink :initform +gray50+ :initarg :light-glyphs-ink :accessor light-glyphs-ink) + (%number-of-pages :initform "-" :accessor number-of-pages) (%current-page-number :initform "-" :accessor current-page-number))) (defclass score-pane (esa-pane-mixin application-pane) ()) @@ -355,7 +356,8 @@ (multiple-value-bind (left right) (bar-line-offsets *font*) (let ((x1 (+ x left)) (x2 (+ x right))) - (draw-rectangle* pane x1 y1 x2 y2)))) + ;; see comment in ROUND-COORDINATE in McCLIM's CLX backend + (draw-rectangle* pane (floor (+ x1 0.5)) y1 (floor (+ x2 0.5)) y2)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -594,5 +596,5 @@ ,@body)))) (defmacro with-light-glyphs (pane &body body) - `(with-drawing-options (,pane :ink +gray50+) + `(with-drawing-options (,pane :ink (light-glyphs-ink (stream-default-view ,pane))) ,@body))

1 0

[gsharp-cvs] CVS gsharp
by crhodes 28 Jul '07

28 Jul '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv8910 Modified Files: drawing.lisp Log Message: Better tie drawing: Tie direction is taken from the final stem direction of the first note. This is not actually right, but it's incrementally better than ignoring the stem directions completely. Draw a stub tie forward if no matching note is found. (This needs to happen for unpaired backwards ties too, but the way DRAW-TIES is currently structured makes that mildly tricky.) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/07/27 16:47:50 1.80 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/07/27 22:31:04 1.81 @@ -361,6 +361,30 @@ do (compute-measure-coordinates measure x y force) do (incf x (size-at-force (elasticity-function measure) force)))) +(defun draw-tie (pane bars n1 n2) + ;; FIXME: we'll want to draw ties between (nothing) and n2 eventually + (declare (type note n1) (type (or note null) n2)) + (let ((x1 (+ (final-absolute-note-xoffset n1) (score-pane:staff-step 1.5))) + (x2 (if (typep n2 'note) + (- (final-absolute-note-xoffset n2) (score-pane:staff-step 1.5)) + (+ (final-absolute-note-xoffset n1) (score-pane:staff-step 4.5)))) + (pos (note-position n1))) + (if (eq (final-stem-direction (cluster n1)) :up) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff n1))) + (if (gsharp-cursor::cursors (slice (car bars))) + (score-pane:draw-tie-down pane x1 x2 (if (oddp pos) (1- pos) pos)) + (score-pane:with-light-glyphs pane + (score-pane:draw-tie-down pane x1 x2 (if (oddp pos) (1- pos) pos))))) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff n1))) + (if (gsharp-cursor::cursors (slice (car bars))) + (score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos)) + (score-pane:with-light-glyphs pane + (score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos)))))))) + +(defun notes-tieable (n1 n2) + (and (= (pitch n1) (pitch n2)) + (eq (staff n1) (staff n2)) + (eq (accidentals n1) (accidentals n2)))) ;;; draw the ties in BARS starting at BAR and at most LENGTH bars (defun draw-ties (pane bars bar length) @@ -373,22 +397,15 @@ repeat length collect bar)) for (e1 e2) on elements - do (when (and (typep e1 'cluster) (typep e2 'cluster) (not (null e2))) + do (when (typep e1 'cluster) (loop for n1 in (notes e1) do (when (tie-right n1) - (loop for n2 in (notes e2) + (loop for n2 in (and (typep e2 'cluster) (notes e2)) do (when (and (tie-left n2) - (= (pitch n1) (pitch n2)) - (eq (staff n1) (staff n2)) - (accidentals n1) (accidentals n2)) - (let ((x1 (+ (final-absolute-note-xoffset n1) (score-pane:staff-step 1.5))) - (x2 (- (final-absolute-note-xoffset n2) (score-pane:staff-step 1.5))) - (pos (note-position n1))) - (score-pane:with-vertical-score-position (pane (staff-yoffset (staff n1))) - (if (gsharp-cursor::cursors (slice (car bars))) - (score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos)) - (score-pane:with-light-glyphs pane - (score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos)))))))))))))) + (notes-tieable n1 n2)) + (draw-tie pane bars n1 n2) + (return)) + finally (draw-tie pane bars n1 nil)))))))) (defun draw-system (pane measures) (with-new-output-record (pane)

1 0

[gsharp-cvs] CVS gsharp
by crhodes 28 Jul '07

28 Jul '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv8376 Modified Files: cursor.lisp Log Message: Fix a minor UI annoyance: when switching layers, prefer the end of a bar rather than the start to put the cursor, so that the common case of parallel editing puts the cursor at a sensible insertion point. --- /project/gsharp/cvsroot/gsharp/cursor.lisp 2007/07/18 07:51:54 1.5 +++ /project/gsharp/cvsroot/gsharp/cursor.lisp 2007/07/27 22:28:05 1.6 @@ -341,7 +341,7 @@ (newbarno (min (1- (nb-bars newslice)) oldbarno)) (newbar (barno newslice newbarno))) (unset-cursor cursor) - (set-cursor cursor newbar 0))) + (set-cursor cursor newbar (nb-elements newbar)))) (defcclass clayer layer ())

1 0

[gsharp-cvs] CVS gsharp
by crhodes 27 Jul '07

27 Jul '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv14849 Modified Files: drawing.lisp Log Message: whitespace --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/07/27 16:34:10 1.79 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/07/27 16:47:50 1.80 @@ -406,7 +406,6 @@ (draw-staff-and-clef pane staff measures x right-edge) (score-pane:with-light-glyphs pane (draw-staff-and-clef pane staff measures x right-edge)))))) - (defun compute-and-draw-system (pane buffer staves measures method x y timesig-offset right-edge) (compute-elasticities measures method)

1 0

[gsharp-cvs] CVS gsharp
by crhodes 27 Jul '07

27 Jul '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv10923 Modified Files: drawing.lisp Log Message: refactor DRAW-BUFFER a little bit, potentially making it easier for other ways of drawing buffers (e.g. to canvas or postscript) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/07/18 07:51:54 1.78 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/07/27 16:34:10 1.79 @@ -510,44 +510,42 @@ (mapcar #'list measures) (split measures n method))) +(defmacro dopages ((measures buffer) &body body) + `(gsharp-measure::new-map-over-obseq-subsequences + (lambda (,measures) ,@body) + ,buffer)) + +(defun cursor-in-measures-p (cursor measures) + (member-if (lambda (measure) (member (bar cursor) (measure-bars measure) + :test #'eq)) + measures)) + +(defun method-for-timesig (method timesig-offset) + (make-measure-cost-method (min-width method) (spacing-style method) + (- (line-width method) timesig-offset) + (lines-per-page method))) + (defmethod draw-buffer (pane (buffer buffer) *cursor* x y) (score-pane:with-staff-size 6 (let* ((staves (staves buffer)) - ;; FIXME: is this the right fudge factor? We have a - ;; circular dependency, as we can't know the optimal - ;; splitting without knowing the staff key signatures, and - ;; we can't know the key signatures until after the - ;; splitting. (max-timesig-offset (* (score-pane:staff-step 2.5) 7)) - (method (let ((old-method (buffer-cost-method buffer))) - (make-measure-cost-method (min-width old-method) - (spacing-style old-method) - (- (line-width old-method) max-timesig-offset) - (lines-per-page old-method)))) + (method (method-for-timesig (buffer-cost-method buffer) max-timesig-offset)) (right-edge (right-edge buffer)) (systems-per-page (max 1 (floor 12 (length staves))))) (loop for staff in staves for offset from 0 by 70 do (setf (staff-yoffset staff) offset)) (let ((yy y)) - (gsharp-measure::new-map-over-obseq-subsequences - (lambda (all-measures) - (when (member-if (lambda (measure) (member (bar *cursor*) - (measure-bars measure) - :test #'eq)) - all-measures) - (let ((measure-seqs (layout-page all-measures systems-per-page method))) - (loop for measures in measure-seqs - for timesig-offset = (compute-timesig-offset staves measures) - for new-method = (make-measure-cost-method (min-width method) - (spacing-style method) - (- (+ (line-width method) max-timesig-offset) timesig-offset) - (lines-per-page method)) - do - (compute-and-draw-system pane buffer staves measures - new-method x yy timesig-offset right-edge) - (incf yy (+ 20 (* 70 (length staves)))))))) - buffer))))) + (dopages (page-measures buffer) + (when (cursor-in-measures-p *cursor* page-measures) + (let ((measure-seqs (layout-page page-measures systems-per-page method))) + (dolist (measures measure-seqs) + (let* ((toffset (compute-timesig-offset staves measures)) + (method (method-for-timesig + (buffer-cost-method buffer) toffset))) + (compute-and-draw-system pane buffer staves measures + method x yy toffset right-edge) + (incf yy (+ 20 (* 70 (length staves))))))))))))) (define-stealth-mixin xelement () element ((final-absolute-xoffset :accessor final-absolute-element-xoffset)))

1 0

[gsharp-cvs] CVS gsharp
by crhodes 21 Jul '07

21 Jul '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv1422 Added Files: .cvsignore Log Message: Ignore .fasl files --- /project/gsharp/cvsroot/gsharp/.cvsignore 2007/07/21 16:49:34 NONE +++ /project/gsharp/cvsroot/gsharp/.cvsignore 2007/07/21 16:49:34 1.1 *.fasl

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 18 Jul '07

18 Jul '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv10205 Modified Files: cursor.lisp drawing.lisp measure.lisp packages.lisp sdl.lisp utilities.lisp Log Message: Gave the stealth mixin code the right name. Removed unused variable to remove a compiler warning. --- /project/gsharp/cvsroot/gsharp/cursor.lisp 2007/07/05 21:13:03 1.4 +++ /project/gsharp/cvsroot/gsharp/cursor.lisp 2007/07/18 07:51:54 1.5 @@ -2,7 +2,7 @@ (defmacro defcclass (name base slots) `(progn - (define-added-mixin ,name () ,base + (define-stealth-mixin ,name () ,base ((cursors :initform '() :accessor cursors) ,@slots)))) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/07/05 21:13:03 1.77 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/07/18 07:51:54 1.78 @@ -8,16 +8,16 @@ (final-absolute-measure-xoffset :accessor final-absolute-measure-xoffset) (final-width :accessor final-width))) -(define-added-mixin dbar (x-y-width-mixin) bar +(define-stealth-mixin dbar (x-y-width-mixin) bar ()) -(define-added-mixin dmeasure (x-y-width-mixin) measure +(define-stealth-mixin dmeasure (x-y-width-mixin) 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 +(define-stealth-mixin dstaff () staff ((yoffset :initform 0 :accessor staff-yoffset))) (define-presentation-method present @@ -549,10 +549,10 @@ (incf yy (+ 20 (* 70 (length staves)))))))) buffer))))) -(define-added-mixin xelement () element +(define-stealth-mixin xelement () element ((final-absolute-xoffset :accessor final-absolute-element-xoffset))) -(define-added-mixin velement () melody-element +(define-stealth-mixin velement () melody-element (;; the position, in staff steps, of the end of the stem ;; that is not attached to a note, independent of the ;; staff on which it is located @@ -567,7 +567,7 @@ ;; the element (bot-note-staff-yoffset :accessor bot-note-staff-yoffset))) -(define-added-mixin welement () lyrics-element +(define-stealth-mixin welement () lyrics-element ()) ;;; Compute and store several important pieces of information @@ -992,6 +992,7 @@ ;;; Key signature element (defmethod draw-element (pane (keysig key-signature) &optional flags) + (declare (ignore flags)) (let ((staff (staff keysig)) (old-keysig (keysig keysig)) (x (final-absolute-element-xoffset keysig))) --- /project/gsharp/cvsroot/gsharp/measure.lisp 2007/07/05 21:13:03 1.34 +++ /project/gsharp/cvsroot/gsharp/measure.lisp 2007/07/18 07:51:54 1.35 @@ -2,7 +2,7 @@ (defmacro defrclass (name base slots) `(progn - (define-added-mixin ,name () ,base + (define-stealth-mixin ,name () ,base ((modified-p :initform t :accessor modified-p) ,@slots)))) @@ -24,7 +24,7 @@ ;;; ;;; Staff -(define-added-mixin rstaff () staff +(define-stealth-mixin rstaff () staff ((rank :accessor staff-rank))) (defun invalidate-slice-using-staff (slice staff) @@ -160,7 +160,7 @@ ;;; ;;; Cluster -(define-added-mixin rcluster () cluster +(define-stealth-mixin rcluster () cluster ((final-stem-direction :accessor final-stem-direction) ;; the position, in staff steps, of the top note in the element. (top-note-pos :accessor top-note-pos) @@ -729,7 +729,7 @@ ;;; ;;; Buffer -(define-added-mixin rbuffer (obseq) buffer +(define-stealth-mixin rbuffer (obseq) buffer ((modified-p :initform t :accessor modified-p))) ;;; Given a buffer, a position of a segment in the sequence of --- /project/gsharp/cvsroot/gsharp/packages.lisp 2007/06/18 15:18:17 1.60 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2007/07/18 07:51:54 1.61 @@ -1,7 +1,7 @@ (defpackage :gsharp-utilities (:shadow built-in-class) (:use :clim-lisp :clim-mop) - (:export #:ninsert-element #:define-added-mixin + (:export #:ninsert-element #:define-stealth-mixin #:unicode-to-char #:char-to-unicode)) (defpackage :mf --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2007/06/21 11:14:27 1.32 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2007/07/18 07:51:54 1.33 @@ -1046,7 +1046,6 @@ (thickpart (mf (complex xleft yleft) -- (complex xright yright))) ;; Determine the y coordinate of the previous path at the ;; cross point of the thin part. Use congruent triangles. - (ythin (/ (* (- xright edge-distance) yright) xright)) (height (* height-multiplier sld)) ;; The path for the thin part symmetric around (0, 0) (thinpart (mf (complex 0 (* 0.5 height)) -- (complex 0 (* -0.5 height))))) @@ -1581,3 +1580,4 @@ (defmethod compute-design ((font font) (shape (eql :beam-up-lower))) (climi::close-path (mf #c(0 0) -- (complex 16 0) -- (complex 0 -1) -- #c(0 0)))) + --- /project/gsharp/cvsroot/gsharp/utilities.lisp 2004/07/23 16:51:16 1.2 +++ /project/gsharp/cvsroot/gsharp/utilities.lisp 2007/07/18 07:51:54 1.3 @@ -22,8 +22,8 @@ (defmacro class-stealth-mixins (class) `(gethash ,class *stealth-mixins*)) -(defmacro define-added-mixin (name super-classes victim-class - &rest for-defclass) +(defmacro define-stealth-mixin (name super-classes victim-class + &rest for-defclass) "Like DEFCLASS but adds the newly defined class to the super classes of 'victim-class'." `(progn @@ -45,7 +45,7 @@ ;; When one wants to [re]define the victim class the new mixin ;; should be present too. We do this by 'patching' ensure-class: (defmethod clim-mop:ensure-class-using-class :around - ((name (eql ',victim-class)) class ;AMOP has these swaped ... + (class (name (eql ',victim-class)) &rest arguments &key (direct-superclasses nil direct-superclasses-p) &allow-other-keys) @@ -55,7 +55,7 @@ (dolist (k (class-stealth-mixins name)) (pushnew k direct-superclasses :test #'class-equalp)) - (apply #'call-next-method name class + (apply #'call-next-method class name :direct-superclasses direct-superclasses arguments)) (t

1 0

[gsharp-cvs] CVS gsharp
by crhodes 17 Jul '07

17 Jul '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv20957 Modified Files: mf.lisp Log Message: Change convolute -> convolve to go with this morning's mcclim/bezier.lisp commit. --- /project/gsharp/cvsroot/gsharp/mf.lisp 2006/05/29 19:55:24 1.1 +++ /project/gsharp/cvsroot/gsharp/mf.lisp 2007/07/17 06:36:32 1.2 @@ -589,4 +589,4 @@ ,@body)) (defun draw-path (path) - (climi::convolute-regions *pen* path)) + (climi::convolve-regions *pen* path))

1 0

[gsharp-cvs] CVS gsharp
by crhodes 12 Jul '07

12 Jul '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv6210 Modified Files: buffer.lisp Log Message: Quick bandage for editing scores with non-fiveline (i.e. lyrics) staves: don't try to find a key signature. (When the number of staff types expands, we will need a better protocol...) --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/07/05 21:13:03 1.49 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/07/12 16:04:49 1.50 @@ -773,19 +773,22 @@ (let* ((layer (layer (slice bar))) (staves (staves layer))) (dolist (staff staves) - (let ((key-signatures (key-signatures staff))) - (when (and key-signatures - (find (gsharp-numbering:number bar) key-signatures - :key (lambda (x) (gsharp-numbering:number (bar x))))) - ;; we actually only need to invalidate everything in the - ;; current bar using the staff, not the entire staff, but... - (gsharp-measure::invalidate-everything-using-staff (buffer staff) staff) - ;; there might be more than one key signature in the bar, - ;; and they might have changed their relative order as a - ;; result of the edit. - (setf (key-signatures staff) - (sort (key-signatures staff) - (lambda (x y) (gsharp::starts-before-p x (bar y) y))))))))) + ;; FIXME: this isn't the Right Thing: instead we should be using + ;; something like maybe-update-key-signatures-using-staff. + (when (typep staff 'fiveline-staff) + (let ((key-signatures (key-signatures staff))) + (when (and key-signatures + (find (gsharp-numbering:number bar) key-signatures + :key (lambda (x) (gsharp-numbering:number (bar x))))) + ;; we actually only need to invalidate everything in the + ;; current bar using the staff, not the entire staff, but... + (gsharp-measure::invalidate-everything-using-staff (buffer staff) staff) + ;; there might be more than one key signature in the bar, + ;; and they might have changed their relative order as a + ;; result of the edit. + (setf (key-signatures staff) + (sort (key-signatures staff) + (lambda (x y) (gsharp::starts-before-p x (bar y) y)))))))))) (defmethod add-element :after ((element element) (bar bar) position) (maybe-update-key-signatures bar))

1 0

[gsharp-cvs] CVS gsharp
by crhodes 11 Jul '07

11 Jul '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv17761 Modified Files: gsharp.asd Removed Files: bezier.lisp Log Message: Remove bezier.lisp, as it's part of mcclim now. --- /project/gsharp/cvsroot/gsharp/gsharp.asd 2007/01/31 15:25:04 1.15 +++ /project/gsharp/cvsroot/gsharp/gsharp.asd 2007/07/11 15:28:13 1.16 @@ -23,7 +23,6 @@ (gsharp-defsystem (:gsharp :depends-on (:mcclim :flexichain :midi)) "packages" "utilities" - "bezier" "mf" "sdl" "score-pane"

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

gsharp-cvs July 2007