From crhodes at common-lisp.net Thu Jul 5 21:13:03 2007 From: crhodes at common-lisp.net (crhodes) Date: Thu, 5 Jul 2007 17:13:03 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070705211303.D77EF4507D@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv8543 Modified Files: buffer.lisp cursor.lisp drawing.lisp gui.lisp measure.lisp Log Message: Alright, let's try this: more correct key signatures, I hope. The major change to the protocol is that REMOVE-ELEMENT takes as a required argument the bar as well as the element; this allows more symmetric methods to be written for the various stealth mixin bits of functionality. Key signatures are elements, as before, within a layer. However, they are also kept on a list sorted by sequence in a slot of the staff, and KEYSIG is responsible for checking the relevant staff for other key signature elements. Editing actions or commands are also responsible for maintaining this list sorted in the right order. New almost-correct function for testing the temporal-and-logical ordering of elements. Drawing code now computes the correct key signature for the each staff; linebreaking is done with a conservative assumption for how wide the key signature will be. Please test. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/28 13:56:53 1.48 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/07/05 21:13:03 1.49 @@ -725,7 +725,7 @@ (defgeneric add-element (element bar position)) ;;; Delete an element from the bar to which it belongs. -(defgeneric remove-element (element)) +(defgeneric remove-element (element bar)) (defclass bar (gsharp-object) ((slice :initform nil :initarg :slice :accessor slice) @@ -768,20 +768,44 @@ (with-slots (elements) b (setf elements (ninsert-element element elements position))) (setf bar b))) - + +(defun maybe-update-key-signatures (bar) + (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))))))))) + +(defmethod add-element :after ((element element) (bar bar) position) + (maybe-update-key-signatures bar)) + (define-condition element-not-in-bar (gsharp-condition) () (:report (lambda (condition stream) (declare (ignore condition)) (format stream "Attempt to delete an element not in a bar")))) -(defmethod remove-element ((element element)) +(defmethod remove-element ((element element) (b bar)) (with-slots (bar) element - (assert bar () 'element-not-in-bar) + (assert (and bar (eq b bar)) () 'element-not-in-bar) (with-slots (elements) bar (setf elements (delete element elements :test #'eq))) (setf bar nil))) +(defmethod remove-element :before ((element element) (bar bar)) + (maybe-update-key-signatures bar)) + (defclass melody-bar (bar) ((print-character :allocation :class :initform #\|))) --- /project/gsharp/cvsroot/gsharp/cursor.lisp 2006/06/19 17:40:34 1.3 +++ /project/gsharp/cvsroot/gsharp/cursor.lisp 2007/07/05 21:13:03 1.4 @@ -161,20 +161,21 @@ (defcclass cbar bar ()) -(defmethod add-element :after ((element element) (bar bar) position) +(defmethod add-element :after ((element element) (bar cbar) position) (loop for cursor in (cursors bar) do (when (> (pos cursor) position) (incf (pos cursor))))) (defmethod add-element :after ((keysig gsharp-buffer::key-signature) bar position) - (setf (gsharp-buffer::key-signatures (staff keysig)) - ;; FIXME: unordered - (cons keysig (gsharp-buffer::key-signatures (staff keysig))))) + (let ((staff (staff keysig))) + (setf (gsharp-buffer::key-signatures staff) + (merge 'list (list keysig) (gsharp-buffer::key-signatures staff) + (lambda (x y) (gsharp::starts-before-p x (bar y) y)))))) -(defmethod remove-element :before ((element element)) +(defmethod remove-element :before ((element element) (bar cbar)) (let ((elemno (number element))) - (loop for cursor in (cursors (bar element)) do + (loop for cursor in (cursors bar) do (when (> (pos cursor) elemno) (decf (pos cursor)))))) @@ -195,7 +196,8 @@ (defmethod delete-element ((cursor gsharp-cursor)) (assert (not (end-of-bar-p cursor)) () 'end-of-bar) - (remove-element (elementno (bar cursor) (pos cursor)))) + (let ((bar (bar cursor))) + (remove-element (elementno bar (pos cursor)) bar))) (defmethod cursor-bar ((cursor gsharp-cursor)) (bar cursor)) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/06/10 08:10:03 1.76 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/07/05 21:13:03 1.77 @@ -32,7 +32,15 @@ (object (type score-pane:lyrics-staff) stream (view textual-view) &key) (format stream "[lyrics staff ~a]" (name object))) -(defmethod draw-staff-and-clef (pane (staff fiveline-staff) x1 x2) +(defun key-signature-for-staff (staff measures) + (let ((key-signatures (gsharp-buffer::key-signatures staff)) + (barno (gsharp-numbering:number (car (measure-bars (car measures)))))) + (or (and key-signatures + (find barno key-signatures :from-end t :test #'> + :key (lambda (x) (gsharp-numbering:number (bar x))))) + (keysig staff)))) + +(defmethod draw-staff-and-clef (pane (staff fiveline-staff) measures x1 x2) (when (clef staff) (present (clef staff) `((score-pane:clef) @@ -40,24 +48,25 @@ :x ,(+ x1 10) :staff-step ,(lineno (clef staff))) :stream pane) - (let ((yoffset (b-position (clef staff)))) - (loop for pitch in '(6 2 5 1 4 0 3) - for line in '(0 3 -1 2 -2 1 -3) - for x from (+ x1 10 (score-pane:staff-step 8)) by (score-pane:staff-step 2) - while (eq (aref (alterations (keysig staff)) pitch) :flat) - do (score-pane:draw-accidental pane :flat x (+ line yoffset)))) - (let ((yoffset (f-position (clef staff)))) - (loop for pitch in '(3 0 4 1 5 2 6) - for line in '(0 -3 1 -2 -5 -1 -4) - for x from (+ x1 10 (score-pane:staff-step 8)) by (score-pane:staff-step 2.5) - while (eq (aref (alterations (keysig staff)) pitch) :sharp) - do (score-pane:draw-accidental pane :sharp x (+ line yoffset))))) - (present staff - `((score-pane:fiveline-staff) - :x1 ,x1 :x2 ,x2) - :stream pane)) + (let ((keysig (key-signature-for-staff staff measures))) + (let ((yoffset (b-position (clef staff)))) + (loop for pitch in '(6 2 5 1 4 0 3) + for line in '(0 3 -1 2 -2 1 -3) + for x from (+ x1 10 (score-pane:staff-step 8)) by (score-pane:staff-step 2) + while (eq (aref (alterations keysig) pitch) :flat) + do (score-pane:draw-accidental pane :flat x (+ line yoffset)))) + (let ((yoffset (f-position (clef staff)))) + (loop for pitch in '(3 0 4 1 5 2 6) + for line in '(0 -3 1 -2 -5 -1 -4) + for x from (+ x1 10 (score-pane:staff-step 8)) by (score-pane:staff-step 2.5) + while (eq (aref (alterations keysig) pitch) :sharp) + do (score-pane:draw-accidental pane :sharp x (+ line yoffset))))) + (present staff + `((score-pane:fiveline-staff) + :x1 ,x1 :x2 ,x2) + :stream pane))) -(defmethod draw-staff-and-clef (pane (staff lyrics-staff) x1 x2) +(defmethod draw-staff-and-clef (pane (staff lyrics-staff) measures x1 x2) (present staff `((score-pane:lyrics-staff) :x1 ,x1 :x2 ,x2) @@ -389,14 +398,14 @@ (loop for measure in measures do (draw-measure pane measure)))) -(defun draw-staves (pane staves x y right-edge) +(defun draw-staves (pane staves measures x y right-edge) (loop for staff in staves do (score-pane:with-vertical-score-position (pane (+ y (staff-yoffset staff))) (if (member staff (staves (layer (slice (bar *cursor*))))) - (draw-staff-and-clef pane staff x right-edge) + (draw-staff-and-clef pane staff measures x right-edge) (score-pane:with-light-glyphs pane - (draw-staff-and-clef pane staff x right-edge)))))) + (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) @@ -416,20 +425,20 @@ (score-pane:draw-bar-line pane x (+ y (- (score-pane:staff-step 8))) (+ y (staff-yoffset (car (last staves))))) - (draw-staves pane staves x y right-edge)) + (draw-staves pane staves measures x y right-edge)) -(defun compute-timesig-offset (staves) +(defun compute-timesig-offset (staves measures) (max (* (score-pane:staff-step 2) (loop for staff in staves maximize (if (typep staff 'fiveline-staff) - (count :flat (alterations (keysig staff))) + (count :flat (alterations (key-signature-for-staff staff measures))) 0))) (* (score-pane:staff-step 2.5) (loop for staff in staves maximize (if (typep staff 'fiveline-staff) - (count :sharp (alterations (keysig staff))) + (count :sharp (alterations (key-signature-for-staff staff measures))) 0))))) (defun split (sequence n method) @@ -504,11 +513,16 @@ (defmethod draw-buffer (pane (buffer buffer) *cursor* x y) (score-pane:with-staff-size 6 (let* ((staves (staves buffer)) - (timesig-offset (compute-timesig-offset staves)) + ;; 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) timesig-offset) + (- (line-width old-method) max-timesig-offset) (lines-per-page old-method)))) (right-edge (right-edge buffer)) (systems-per-page (max 1 (floor 12 (length staves))))) @@ -523,9 +537,15 @@ :test #'eq)) all-measures) (let ((measure-seqs (layout-page all-measures systems-per-page method))) - (loop for measures in measure-seqs do + (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 - method x yy timesig-offset right-edge) + new-method x yy timesig-offset right-edge) (incf yy (+ 20 (* 70 (length staves)))))))) buffer))))) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/28 13:56:53 1.79 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/07/05 21:13:03 1.80 @@ -597,12 +597,12 @@ (defparameter *current-cluster* nil) (defparameter *current-note* nil) -(defun insert-note (pitch cluster) +(defun insert-note (pitch cluster accidentals) (let* ((state (input-state *application-frame*)) (staff (car (staves (layer (slice (bar cluster)))))) (note (make-note pitch staff :head (notehead state) - :accidentals (aref (alterations (keysig (current-cursor))) (mod pitch 7)) + :accidentals accidentals :dots (dots state)))) (setf *current-cluster* cluster *current-note* note) @@ -618,8 +618,9 @@ (t diff))))) (defun insert-numbered-note-new-cluster (pitch) - (let ((new-pitch (compute-and-adjust-note pitch))) - (insert-note new-pitch (insert-cluster)))) + (let* ((new-pitch (compute-and-adjust-note pitch)) + (accidentals (aref (alterations (keysig (current-cursor))) (mod new-pitch 7)))) + (insert-note new-pitch (insert-cluster) accidentals))) (define-gsharp-command (com-insert-note-a :keystroke #\a) () (insert-numbered-note-new-cluster 5)) @@ -686,8 +687,9 @@ (setf *current-note* (nth (1- pos) notes))))) (defun insert-numbered-note-current-cluster (pitch) - (let ((new-pitch (compute-and-adjust-note pitch))) - (insert-note new-pitch (cur-cluster)))) + (let* ((new-pitch (compute-and-adjust-note pitch)) + (accidentals (aref (alterations (keysig (current-cursor))) (mod new-pitch 7)))) + (insert-note new-pitch (cur-cluster) accidentals))) (define-gsharp-command com-add-note-a () (insert-numbered-note-current-cluster 5)) @@ -710,36 +712,30 @@ (define-gsharp-command com-add-note-g () (insert-numbered-note-current-cluster 4)) -(define-gsharp-command com-more-dots () - (setf (dots (cur-element)) - (min (1+ (dots (cur-element))) 3))) - -(define-gsharp-command com-fewer-dots () - (setf (dots (cur-element)) - (max (1- (dots (cur-element))) 0))) - -(define-gsharp-command com-more-rbeams () - (setf (rbeams (cur-element)) - (min (1+ (rbeams (cur-element))) 3))) - -(define-gsharp-command com-fewer-lbeams () - (setf (lbeams (cur-element)) - (max (1- (lbeams (cur-element))) 0))) - -(define-gsharp-command com-more-lbeams () - (setf (lbeams (cur-element)) - (min (1+ (lbeams (cur-element))) 3))) - -(define-gsharp-command com-fewer-rbeams () - (setf (rbeams (cur-element)) - (max (1- (rbeams (cur-element))) 0))) - -(define-gsharp-command com-rotate-notehead () - (setf (notehead (cur-element)) - (ecase (notehead (cur-element)) - (:whole :half) - (:half :filled) - (:filled :whole)))) +(macrolet ((define-duration-altering-command (name &body body) + `(define-gsharp-command ,name () + (let ((element (cur-element))) + , at body + (gsharp-buffer::maybe-update-key-signatures + (bar (current-cursor))))))) + (define-duration-altering-command com-more-dots () + (setf (dots element) (min (1+ (dots element)) 3))) + (define-duration-altering-command com-fewer-dots () + (setf (dots element) (max (1- (dots element)) 0))) + (define-duration-altering-command com-more-rbeams () + (setf (rbeams element) (min (1+ (rbeams element)) 3))) + (define-duration-altering-command com-fewer-lbeams () + (setf (lbeams element) (max (1- (lbeams element)) 0))) + (define-duration-altering-command com-more-lbeams () + (setf (lbeams element) (min (1+ (lbeams element)) 3))) + (define-duration-altering-command com-fewer-rbeams () + (setf (rbeams element) (max (1- (rbeams element)) 0))) + (define-duration-altering-command com-rotate-notehead () + (setf (notehead element) + (ecase (notehead element) + (:whole :half) + (:half :filled) + (:filled :whole))))) (define-gsharp-command com-rotate-stem-direction () (setf (stem-direction (cur-cluster)) @@ -937,37 +933,43 @@ (define-gsharp-command com-insert-keysig () (insert-keysig)) -(defmethod remove-element :before ((keysig gsharp-buffer::key-signature)) +(defmethod remove-element :before ((keysig gsharp-buffer::key-signature) (bar bar)) (let ((staff (staff keysig))) (setf (gsharp-buffer::key-signatures staff) (remove keysig (gsharp-buffer::key-signatures staff))) (gsharp-measure::invalidate-everything-using-staff (current-buffer) staff))) -;;; FIXME: this function does not work for finding a key signature in -;;; a different layer (but on the same staff). This will bite in -;;; polyphonic music with key signature changes (e.g. Piano music) -(defun %keysig (staff key-signatures bar bars element-or-nil) - ;; common case - (when (null key-signatures) - (return-from %keysig (keysig staff))) - ;; earlier in the same bar? - (let ((k nil)) - (dolist (e (elements bar) (when k (return-from %keysig k))) - (when (eq e element-or-nil) - (if k - (return-from %keysig k) - (return nil))) - (when (and (typep e 'gsharp-buffer::key-signature) - (eq (staff e) staff)) - (setq k e)))) - ;; must be an earlier bar. - (let ((bars (nreverse (loop for b in bars until (eq b bar) collect b)))) - (dolist (b bars (keysig staff)) - (when (find b key-signatures :key #'bar) - (dolist (e (reverse (elements b)) (error "inconsistency")) - (when (and (typep e 'key-signature) - (eq (staff e) staff)) - (return-from %keysig e))))))) +;;; FIXME: this isn't quite right (argh) for the case of two +;;; temporally coincident zero-duration elements on the same staff in +;;; different layers: essentially all bets are off. +(defun starts-before-p (thing bar element-or-nil) + ;; does THING start before the temporal position denoted by BAR and + ;; ELEMENT-OR-NIL? + (assert (or (null element-or-nil) (eq (bar element-or-nil) bar))) + (let ((barno (number bar))) + (cond + ((> (number (bar thing)) barno) nil) + ((< (number (bar thing)) barno) t) + (t (let ((thing-start-time (loop for e in (elements (bar thing)) + if (eq e element-or-nil) + do (return-from starts-before-p nil) + until (eq e thing) sum (duration e))) + (element-start-time + ;; this is actually the right answer for + ;; ELEMENT-OR-NIL = NIL, which means "end of bar" + (loop for e in (elements bar) + if (eq e thing) do (return-from starts-before-p t) + until (eq e element-or-nil) sum (duration e)))) + (or (> element-start-time thing-start-time) + (and (= element-start-time thing-start-time) + (or (null element-or-nil) + (> (duration element-or-nil) 0))))))))) + +(defun %keysig (staff key-signatures bar element-or-nil) + (or (and key-signatures + (find-if (lambda (x) (starts-before-p x bar element-or-nil)) + key-signatures :from-end t)) + (keysig staff))) (defmethod keysig ((cursor gsharp-cursor)) ;; FIXME: not just a cursor but _the_ cursor (i.e. in a given staff) @@ -978,19 +980,15 @@ (let* ((staff (car (staves (layer cursor)))) (key-signatures (gsharp-buffer::key-signatures staff)) (bar (bar cursor)) - (slice (slice bar)) - (bars (bars slice)) (element-or-nil (cursor-element cursor))) - (%keysig staff key-signatures bar bars element-or-nil))) + (%keysig staff key-signatures bar element-or-nil))) (defmethod keysig ((note note)) (let* ((staff (staff note)) (key-signatures (gsharp-buffer::key-signatures staff)) (bar (bar (cluster note))) - (slice (slice bar)) - (bars (bars slice)) (element-or-nil (cluster note))) - (%keysig staff key-signatures bar bars element-or-nil))) + (%keysig staff key-signatures bar element-or-nil))) (defmethod keysig ((cluster cluster)) (error "Called ~S (a staff-scope operation) on an element with no ~ @@ -1000,10 +998,8 @@ (defmethod keysig ((element element)) (let* ((staff (staff element)) (key-signatures (gsharp-buffer::key-signatures staff)) - (bar (bar element)) - (slice (slice bar)) - (bars (bars slice))) - (%keysig staff key-signatures bar bars element))) + (bar (bar element))) + (%keysig staff key-signatures bar element))) (define-gsharp-command com-tie-note-left () (let ((note (cur-note))) @@ -1093,7 +1089,7 @@ ;; layout for motion will be different from the layout on ;; the screen... (staves (staves buffer)) - (timesig-offset (gsharp-drawing::compute-timesig-offset staves)) + (timesig-offset (gsharp-drawing::compute-timesig-offset staves page-measures)) (method (let ((old-method (buffer-cost-method buffer))) (make-measure-cost-method (min-width old-method) (spacing-style old-method) --- /project/gsharp/cvsroot/gsharp/measure.lisp 2007/06/21 11:14:25 1.33 +++ /project/gsharp/cvsroot/gsharp/measure.lisp 2007/07/05 21:13:03 1.34 @@ -397,9 +397,8 @@ (declare (ignore position)) (mark-modified bar)) -(defmethod remove-element :before ((element relement)) - (when (bar element) - (mark-modified (bar element)))) +(defmethod remove-element :before ((element element) (bar rbar)) + (mark-modified bar)) (defmethod mark-modified ((bar rbar)) (setf (modified-p bar) t) @@ -859,7 +858,7 @@ :lines-per-page lines-per-page)) ;;; As required by the obseq library, define a sequence cost, i.e., in -;;; this case the cost of a sequece of measures. +;;; this case the cost of a sequence of measures. (defclass measure-seq-cost (seq-cost) ((min-dist :initarg :min-dist :reader min-dist) (coeff :initarg :coeff :reader coeff) From crhodes at common-lisp.net Fri Jul 6 14:16:21 2007 From: crhodes at common-lisp.net (crhodes) Date: Fri, 6 Jul 2007 10:16:21 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070706141621.15A5C5201E@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv24335 Modified Files: gui.lisp modes.lisp Log Message: Reducing my deviation from upstream, part $n$: M-: support. --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/07/05 21:13:03 1.80 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/07/06 14:16:20 1.81 @@ -579,6 +579,26 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; development and debugging aids + +;;; FIXME: you might expect that this was in an ESA component, but in +;;; fact it's not. Maybe it should be? +(define-gsharp-command (com-eval-expression :name t) + ((expression 'expression :prompt "Eval")) + "Prompt for and evaluate a lisp expression. +Prints the results in the minibuffer." + (let* ((*package* (find-package :gsharp)) + (values (multiple-value-list + (handler-case (eval expression) + (error (condition) + (beep) + (display-message "~a" condition) + (return-from com-eval-expression nil))))) + (result (format nil "~:[; No values~;~:*~{~S~^,~}~]" values))) + (display-message result))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; note insertion commands (defun insert-cluster () --- /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/28 14:36:14 1.26 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2007/07/06 14:16:20 1.27 @@ -39,6 +39,9 @@ (set-key 'com-istate-fewer-lbeams 'global-gsharp-table '((#\i) (#\x) (#\[))) (set-key 'com-istate-fewer-rbeams 'global-gsharp-table '((#\i) (#\x) (#\]))) +(set-key `(com-eval-expression ,*unsupplied-argument-marker*) + 'global-gsharp-table '((#\: :meta))) + ;;; the melody table contains commands that are specific to the ;;; melody layer From crhodes at common-lisp.net Wed Jul 11 15:28:13 2007 From: crhodes at common-lisp.net (crhodes) Date: Wed, 11 Jul 2007 11:28:13 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070711152813.2FA3B5D0E1@common-lisp.net> 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" From crhodes at common-lisp.net Thu Jul 12 16:04:50 2007 From: crhodes at common-lisp.net (crhodes) Date: Thu, 12 Jul 2007 12:04:50 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070712160450.9F59966001@common-lisp.net> 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)) From crhodes at common-lisp.net Tue Jul 17 06:36:33 2007 From: crhodes at common-lisp.net (crhodes) Date: Tue, 17 Jul 2007 02:36:33 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070717063633.6361F28238@common-lisp.net> 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 @@ , at body)) (defun draw-path (path) - (climi::convolute-regions *pen* path)) + (climi::convolve-regions *pen* path)) From rstrandh at common-lisp.net Wed Jul 18 07:51:54 2007 From: rstrandh at common-lisp.net (rstrandh) Date: Wed, 18 Jul 2007 03:51:54 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070718075154.8E8A52E1D6@common-lisp.net> 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) , at 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) , at 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 From crhodes at common-lisp.net Sat Jul 21 16:49:34 2007 From: crhodes at common-lisp.net (crhodes) Date: Sat, 21 Jul 2007 12:49:34 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070721164934.CE34B7209C@common-lisp.net> 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 From crhodes at common-lisp.net Fri Jul 27 16:34:10 2007 From: crhodes at common-lisp.net (crhodes) Date: Fri, 27 Jul 2007 12:34:10 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070727163410.6F283830A8@common-lisp.net> 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) , at 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))) From crhodes at common-lisp.net Fri Jul 27 16:47:50 2007 From: crhodes at common-lisp.net (crhodes) Date: Fri, 27 Jul 2007 12:47:50 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070727164750.C03886F24A@common-lisp.net> 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) From crhodes at common-lisp.net Fri Jul 27 22:28:06 2007 From: crhodes at common-lisp.net (crhodes) Date: Fri, 27 Jul 2007 18:28:06 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070727222806.0FC3D21057@common-lisp.net> 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 ()) From crhodes at common-lisp.net Fri Jul 27 22:31:04 2007 From: crhodes at common-lisp.net (crhodes) Date: Fri, 27 Jul 2007 18:31:04 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070727223104.A033E7E005@common-lisp.net> 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) From crhodes at common-lisp.net Fri Jul 27 22:34:33 2007 From: crhodes at common-lisp.net (crhodes) Date: Fri, 27 Jul 2007 18:34:33 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070727223433.79EF42D16D@common-lisp.net> 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 @@ , at 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))) , at body))