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

[gsharp-cvs] CVS update: Directory change: gsharp/Flexichain/Doc
by Robert Strandh 01 Aug '04

01 Aug '04

Update of /project/gsharp/cvsroot/gsharp/Flexichain/Doc In directory common-lisp.net:/tmp/cvs-serv18496/Doc Log Message: Directory /project/gsharp/cvsroot/gsharp/Flexichain/Doc added to the repository Date: Sun Aug 1 08:18:02 2004 Author: rstrandh New directory gsharp/Flexichain/Doc added

1 0

[gsharp-cvs] CVS update: Directory change: gsharp/Flexichain
by Robert Strandh 01 Aug '04

01 Aug '04

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv27296/Flexichain Log Message: Directory /project/gsharp/cvsroot/gsharp/Flexichain added to the repository Date: Sun Aug 1 08:15:30 2004 Author: rstrandh New directory gsharp/Flexichain added

1 0

[gsharp-cvs] CVS update: gsharp/gui.lisp gsharp/modes.lisp
by Robert Strandh 01 Aug '04

01 Aug '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv3200 Modified Files: gui.lisp modes.lisp Log Message: Lyrics input now allows for accents, provided that your keyboard is capable of generating dead keys for these accents. It only works for X11 at the moment, I would think. The way I do it is not great, since now I get messages about missing commands for the control keys. I have to think of a better way of doing it. Loading a file now calls select-layer so that the appropriate mode is selected. Loading the bach score with lyrics now immediately lets you edit the lyrics. Date: Sun Aug 1 08:14:33 2004 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.16 gsharp/gui.lisp:1.17 --- gsharp/gui.lisp:1.16 Sat Jul 24 13:09:55 2004 +++ gsharp/gui.lisp Sun Aug 1 08:14:33 2004 @@ -17,8 +17,8 @@ (defparameter *last-character* nil) (defmethod dispatch-event :around ((pane score-pane:score-pane) (event key-press-event)) - (when (keyboard-event-character event) - (let ((key (list (keyboard-event-character event) + (when (or (keyboard-event-character event) (keyboard-event-key-name event)) + (let ((key (list (or (keyboard-event-character event) (keyboard-event-key-name event)) (event-modifier-state event)))) (setf *accumulated-keys* (append *accumulated-keys* (list key))) (setf *last-character* (char-to-unicode (car key))) @@ -289,7 +289,8 @@ (setf (buffer *gsharp-frame*) buffer (input-state *gsharp-frame*) input-state (cursor *gsharp-frame*) cursor) - (number-all (buffer *gsharp-frame*)))) + (number-all (buffer *gsharp-frame*)) + (select-layer cursor (car (layers (segment (cursor *gsharp-frame*))))))) (define-gsharp-command (com-save-buffer-as :name t) () (let* ((stream (frame-standard-input *gsharp-frame*)) Index: gsharp/modes.lisp diff -u gsharp/modes.lisp:1.2 gsharp/modes.lisp:1.3 --- gsharp/modes.lisp:1.2 Sat Jul 24 13:09:55 2004 +++ gsharp/modes.lisp Sun Aug 1 08:14:33 2004 @@ -97,70 +97,70 @@ do (add-keyseq `((,c)) (make-insert-fun i) *lyrics-layer-mode-table*)) ;;; try some latin prefix mode for national characters -(add-keyseq '((#\`) (#\A :shift)) (make-insert-fun 192) *lyrics-layer-mode-table*) -(add-keyseq '((#\') (#\A :shift)) (make-insert-fun 193) *lyrics-layer-mode-table*) -(add-keyseq '((#\^) (#\A :shift)) (make-insert-fun 194) *lyrics-layer-mode-table*) -(add-keyseq '((#\~) (#\A :shift)) (make-insert-fun 195) *lyrics-layer-mode-table*) -(add-keyseq '((#\") (#\A :shift)) (make-insert-fun 196) *lyrics-layer-mode-table*) -(add-keyseq '((#\/) (#\A :shift)) (make-insert-fun 197) *lyrics-layer-mode-table*) -(add-keyseq '((#\/) (#\E :shift)) (make-insert-fun 198) *lyrics-layer-mode-table*) -(add-keyseq '((#\/) (#\C :shift)) (make-insert-fun 199) *lyrics-layer-mode-table*) -(add-keyseq '((#\`) (#\E :shift)) (make-insert-fun 200) *lyrics-layer-mode-table*) -(add-keyseq '((#\') (#\E :shift)) (make-insert-fun 201) *lyrics-layer-mode-table*) -(add-keyseq '((#\^) (#\E :shift)) (make-insert-fun 202) *lyrics-layer-mode-table*) -(add-keyseq '((#\") (#\E :shift)) (make-insert-fun 203) *lyrics-layer-mode-table*) -(add-keyseq '((#\`) (#\I :shift)) (make-insert-fun 204) *lyrics-layer-mode-table*) -(add-keyseq '((#\') (#\I :shift)) (make-insert-fun 205) *lyrics-layer-mode-table*) -(add-keyseq '((#\^) (#\I :shift)) (make-insert-fun 206) *lyrics-layer-mode-table*) -(add-keyseq '((#\") (#\I :shift)) (make-insert-fun 207) *lyrics-layer-mode-table*) -(add-keyseq '((#\/) (#\D :shift)) (make-insert-fun 208) *lyrics-layer-mode-table*) -(add-keyseq '((#\~) (#\N :shift)) (make-insert-fun 209) *lyrics-layer-mode-table*) -(add-keyseq '((#\`) (#\O :shift)) (make-insert-fun 210) *lyrics-layer-mode-table*) -(add-keyseq '((#\') (#\O :shift)) (make-insert-fun 211) *lyrics-layer-mode-table*) -(add-keyseq '((#\^) (#\O :shift)) (make-insert-fun 212) *lyrics-layer-mode-table*) -(add-keyseq '((#\~) (#\O :shift)) (make-insert-fun 213) *lyrics-layer-mode-table*) -(add-keyseq '((#\") (#\O :shift)) (make-insert-fun 214) *lyrics-layer-mode-table*) - -(add-keyseq '((#\/) (#\O :shift)) (make-insert-fun 216) *lyrics-layer-mode-table*) -(add-keyseq '((#\`) (#\U :shift)) (make-insert-fun 217) *lyrics-layer-mode-table*) -(add-keyseq '((#\') (#\U :shift)) (make-insert-fun 218) *lyrics-layer-mode-table*) -(add-keyseq '((#\^) (#\U :shift)) (make-insert-fun 219) *lyrics-layer-mode-table*) -(add-keyseq '((#\") (#\U :shift)) (make-insert-fun 220) *lyrics-layer-mode-table*) -(add-keyseq '((#\') (#\Y :shift)) (make-insert-fun 221) *lyrics-layer-mode-table*) - - -(add-keyseq '((#\`) (#\a)) (make-insert-fun 224) *lyrics-layer-mode-table*) -(add-keyseq '((#\') (#\a)) (make-insert-fun 225) *lyrics-layer-mode-table*) -(add-keyseq '((#\^) (#\a)) (make-insert-fun 226) *lyrics-layer-mode-table*) -(add-keyseq '((#\~) (#\a)) (make-insert-fun 227) *lyrics-layer-mode-table*) -(add-keyseq '((#\") (#\a)) (make-insert-fun 228) *lyrics-layer-mode-table*) -(add-keyseq '((#\/) (#\a)) (make-insert-fun 229) *lyrics-layer-mode-table*) -(add-keyseq '((#\/) (#\e)) (make-insert-fun 230) *lyrics-layer-mode-table*) -(add-keyseq '((#\~) (#\c)) (make-insert-fun 231) *lyrics-layer-mode-table*) -(add-keyseq '((#\`) (#\e)) (make-insert-fun 232) *lyrics-layer-mode-table*) -(add-keyseq '((#\') (#\e)) (make-insert-fun 233) *lyrics-layer-mode-table*) -(add-keyseq '((#\^) (#\e)) (make-insert-fun 234) *lyrics-layer-mode-table*) -(add-keyseq '((#\") (#\e)) (make-insert-fun 235) *lyrics-layer-mode-table*) -(add-keyseq '((#\`) (#\i)) (make-insert-fun 236) *lyrics-layer-mode-table*) -(add-keyseq '((#\') (#\i)) (make-insert-fun 237) *lyrics-layer-mode-table*) -(add-keyseq '((#\^) (#\i)) (make-insert-fun 238) *lyrics-layer-mode-table*) -(add-keyseq '((#\") (#\i)) (make-insert-fun 239) *lyrics-layer-mode-table*) - - -(add-keyseq '((#\`) (#\o)) (make-insert-fun 242) *lyrics-layer-mode-table*) -(add-keyseq '((#\') (#\o)) (make-insert-fun 243) *lyrics-layer-mode-table*) -(add-keyseq '((#\^) (#\o)) (make-insert-fun 244) *lyrics-layer-mode-table*) -(add-keyseq '((#\~) (#\o)) (make-insert-fun 245) *lyrics-layer-mode-table*) -(add-keyseq `((#\") (#\o)) (make-insert-fun 246) *lyrics-layer-mode-table*) - -(add-keyseq '((#\/) (#\o)) (make-insert-fun 248) *lyrics-layer-mode-table*) -(add-keyseq '((#\`) (#\u)) (make-insert-fun 249) *lyrics-layer-mode-table*) -(add-keyseq '((#\') (#\u)) (make-insert-fun 250) *lyrics-layer-mode-table*) -(add-keyseq '((#\^) (#\u)) (make-insert-fun 251) *lyrics-layer-mode-table*) -(add-keyseq '((#\") (#\u)) (make-insert-fun 252) *lyrics-layer-mode-table*) -(add-keyseq '((#\') (#\y)) (make-insert-fun 253) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--grave) (#\A :shift)) (make-insert-fun 192) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--acute) (#\A :shift)) (make-insert-fun 193) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--circumflex :shift) (#\A :shift)) (make-insert-fun 194) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--tilde :shift) (#\A :shift)) (make-insert-fun 195) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--diaeresis :shift) (#\A :shift)) (make-insert-fun 196) *lyrics-layer-mode-table*) +(add-keyseq '((:dead-above-ring) (#\A :shift)) (make-insert-fun 197) *lyrics-layer-mode-table*) +(add-keyseq '((:dead-above-ring) (#\E :shift)) (make-insert-fun 198) *lyrics-layer-mode-table*) +(add-keyseq '((:dead-above-ring) (#\C :shift)) (make-insert-fun 199) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--grave) (#\E :shift)) (make-insert-fun 200) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--acute) (#\E :shift)) (make-insert-fun 201) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--circumflex :shift) (#\E :shift)) (make-insert-fun 202) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--diaeresis :shift) (#\E :shift)) (make-insert-fun 203) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--grave) (#\I :shift)) (make-insert-fun 204) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--acute) (#\I :shift)) (make-insert-fun 205) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--circumflex :shift) (#\I :shift)) (make-insert-fun 206) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--diaeresis :shift) (#\I :shift)) (make-insert-fun 207) *lyrics-layer-mode-table*) +(add-keyseq '((:dead-above-ring) (#\D :shift)) (make-insert-fun 208) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--tilde :shift) (#\N :shift)) (make-insert-fun 209) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--grave) (#\O :shift)) (make-insert-fun 210) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--acute) (#\O :shift)) (make-insert-fun 211) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--circumflex :shift) (#\O :shift)) (make-insert-fun 212) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--tilde :shift) (#\O :shift)) (make-insert-fun 213) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--diaeresis :shift) (#\O :shift)) (make-insert-fun 214) *lyrics-layer-mode-table*) + +(add-keyseq '((:dead-above-ring) (#\O :shift)) (make-insert-fun 216) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--grave) (#\U :shift)) (make-insert-fun 217) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--acute) (#\U :shift)) (make-insert-fun 218) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--circumflex :shift) (#\U :shift)) (make-insert-fun 219) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--diaeresis :shift) (#\U :shift)) (make-insert-fun 220) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--acute) (#\Y :shift)) (make-insert-fun 221) *lyrics-layer-mode-table*) + + +(add-keyseq '((:dead--grave) (#\a)) (make-insert-fun 224) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--acute) (#\a)) (make-insert-fun 225) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--circumflex :shift) (#\a)) (make-insert-fun 226) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--tilde :shift) (#\a)) (make-insert-fun 227) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--diaeresis :shift) (#\a)) (make-insert-fun 228) *lyrics-layer-mode-table*) +(add-keyseq '((:dead-above-ring) (#\a)) (make-insert-fun 229) *lyrics-layer-mode-table*) +(add-keyseq '((:dead-above-ring) (#\e)) (make-insert-fun 230) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--tilde :shift) (#\c)) (make-insert-fun 231) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--grave) (#\e)) (make-insert-fun 232) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--acute) (#\e)) (make-insert-fun 233) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--circumflex :shift) (#\e)) (make-insert-fun 234) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--diaeresis :shift) (#\e)) (make-insert-fun 235) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--grave) (#\i)) (make-insert-fun 236) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--acute) (#\i)) (make-insert-fun 237) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--circumflex :shift) (#\i)) (make-insert-fun 238) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--diaeresis :shift) (#\i)) (make-insert-fun 239) *lyrics-layer-mode-table*) + + +(add-keyseq '((:dead--grave) (#\o)) (make-insert-fun 242) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--acute) (#\o)) (make-insert-fun 243) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--circumflex :shift) (#\o)) (make-insert-fun 244) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--tilde :shift) (#\o)) (make-insert-fun 245) *lyrics-layer-mode-table*) +(add-keyseq `((:dead--diaeresis :shift) (#\o)) (make-insert-fun 246) *lyrics-layer-mode-table*) + +(add-keyseq '((:dead-above-ring) (#\o)) (make-insert-fun 248) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--grave) (#\u)) (make-insert-fun 249) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--acute) (#\u)) (make-insert-fun 250) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--circumflex :shift) (#\u)) (make-insert-fun 251) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--diaeresis :shift) (#\u)) (make-insert-fun 252) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--acute) (#\y)) (make-insert-fun 253) *lyrics-layer-mode-table*) -(add-keyseq '((#\") (#\y)) (make-insert-fun 255) *lyrics-layer-mode-table*) +(add-keyseq '((:dead--diaeresis :shift) (#\y)) (make-insert-fun 255) *lyrics-layer-mode-table*)

1 0

[gsharp-cvs] CVS update: gsharp/Scores/bach181-lyrics.ghs
by Robert Strandh 24 Jul '04

24 Jul '04

Update of /project/gsharp/cvsroot/gsharp/Scores In directory common-lisp.net:/tmp/cvs-serv7169/Scores Added Files: bach181-lyrics.ghs Log Message: Gsharp definitely has lyrics. When a lyrics layer is selected, the ordinary alphabetic keys append characters to the preceding lyrics element. use C-Space to insert a new lyrics element. Use C-h to erase the last character of a lyrics element. It's a bit clunky, but it works. I seriously doubt the full power of Goatee is needed to edit lyrics. I noticed that (probably unintentionally) McCLIM can handle Unicode texts in the form of vectors of integers to draw-text. It probably just passes them on to the port-specific functions, and it happens to work with clx. It probably won't work on all backends, but it would be nice if it did. The default font on my machine can probably only do character codes up to 255, but with a good font, it should be able to do up to 65535. But right now, I can get the German national characters, which are needed for Bach. Check out the new file Scores/bach181-lyrics.gsh. In it, you will also notice that there is one place in which words overlap. To fix that (which is not just a lyrics problem, but also happens with clusters with many accidentals) Gsharp must learn to compute how much extra room an element might need, and adjust spacing accordingly, Unfortunately McCLIM does not handle input from a US-international keyboard, so I actually had to put in the ü's manually, but it should work for others. With lyrics, MIDI file generation is most likely broken, but I haven't checked that yet. It should just skip lyrics layers. Date: Sat Jul 24 13:09:57 2004 Author: rstrandh

1 0

[gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/drawing.lisp gsharp/gui.lisp gsharp/modes.lisp gsharp/packages.lisp
by Robert Strandh 24 Jul '04

24 Jul '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv7169 Modified Files: buffer.lisp drawing.lisp gui.lisp modes.lisp packages.lisp Log Message: Gsharp definitely has lyrics. When a lyrics layer is selected, the ordinary alphabetic keys append characters to the preceding lyrics element. use C-Space to insert a new lyrics element. Use C-h to erase the last character of a lyrics element. It's a bit clunky, but it works. I seriously doubt the full power of Goatee is needed to edit lyrics. I noticed that (probably unintentionally) McCLIM can handle Unicode texts in the form of vectors of integers to draw-text. It probably just passes them on to the port-specific functions, and it happens to work with clx. It probably won't work on all backends, but it would be nice if it did. The default font on my machine can probably only do character codes up to 255, but with a good font, it should be able to do up to 65535. But right now, I can get the German national characters, which are needed for Bach. Check out the new file Scores/bach181-lyrics.gsh. In it, you will also notice that there is one place in which words overlap. To fix that (which is not just a lyrics problem, but also happens with clusters with many accidentals) Gsharp must learn to compute how much extra room an element might need, and adjust spacing accordingly, Unfortunately McCLIM does not handle input from a US-international keyboard, so I actually had to put in the ü's manually, but it should work for others. With lyrics, MIDI file generation is most likely broken, but I haven't checked that yet. It should just skip lyrics layers. Date: Sat Jul 24 13:09:55 2004 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.5 gsharp/buffer.lisp:1.6 --- gsharp/buffer.lisp:1.5 Fri Jul 23 09:51:16 2004 +++ gsharp/buffer.lisp Sat Jul 24 13:09:55 2004 @@ -408,6 +408,14 @@ :initform (make-array 5 :adjustable t :element-type 'fixnum :fill-pointer 0) :reader text))) +(defmethod initialize-instance :after ((elem lyrics-element) &rest args) + (declare (ignore args)) + (with-slots (text) elem + (unless (adjustable-array-p text) + (let ((length (length text))) + (setf text (make-array length :adjustable t :element-type 'fixnum + :fill-pointer length :initial-contents text)))))) + (defun make-lyrics-element (rbeams lbeams dots notehead staff) (make-instance 'lyrics-element :rbeams rbeams :lbeams lbeams :dots dots @@ -415,7 +423,7 @@ (defmethod print-object ((elem lyrics-element) stream) (with-slots (notehead rbeams lbeams dots xoffset staff text) elem - (format stream "[A :notehead ~W :rbeams ~W :lbeams ~W :dots ~W :xoffset ~W :staff ~W :text ~W ] " text))) + (format stream "[A :notehead ~W :rbeams ~W :lbeams ~W :dots ~W :xoffset ~W :staff ~W :text ~W ] " notehead rbeams lbeams dots xoffset staff text))) (defun read-lyrics-element-v3 (stream char n) (declare (ignore char n)) @@ -424,6 +432,13 @@ (set-dispatch-macro-character #\[ #\A #'read-lyrics-element-v3 *gsharp-readtable-v3*) + +(defmethod append-char ((elem lyrics-element) char) + (vector-push-extend char (text elem))) + +(defmethod erase-char ((elem lyrics-element)) + (unless (zerop (fill-pointer (text elem))) + (decf (fill-pointer (text elem))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.7 gsharp/drawing.lisp:1.8 --- gsharp/drawing.lisp:1.7 Fri Jul 23 09:51:16 2004 +++ gsharp/drawing.lisp Sat Jul 24 13:09:55 2004 @@ -642,5 +642,4 @@ (defmethod draw-element (pane (element lyrics-element) x &optional (flags t)) (declare (ignore flags)) (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) - (draw-text* pane (map 'string #'unicode-to-char (text element)) - x 0 :align-x :center))) + (draw-text* pane (text element) x 0 :align-x :center))) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.15 gsharp/gui.lisp:1.16 --- gsharp/gui.lisp:1.15 Fri Jul 23 09:51:16 2004 +++ gsharp/gui.lisp Sat Jul 24 13:09:55 2004 @@ -13,7 +13,7 @@ (defparameter *kbd-macro-funs* '()) (defparameter *accumulated-keys* '()) -(defparameter *modes* (list *global-mode-table*)) +(defparameter *modes* (list *melody-layer-mode-table* *global-mode-table*)) (defparameter *last-character* nil) (defmethod dispatch-event :around ((pane score-pane:score-pane) (event key-press-event)) @@ -29,7 +29,8 @@ (dico-object x *accumulated-keys*) (declare (ignore value prefix-p)) exists-p)))) - (fboundp (dico-object dico *accumulated-keys*))) + (or (functionp (dico-object dico *accumulated-keys*)) + (fboundp (dico-object dico *accumulated-keys*)))) (let ((command (dico-object dico *accumulated-keys*))) (when *kbd-macro-recording-p* (push command *kbd-macro-funs*)) (handler-case (funcall command) @@ -394,6 +395,11 @@ (declare (ignore string)) (if success layer (error 'no-such-layer)))) +(defmethod select-layer :after (cursor (layer layer)) + (setf *modes* (list (cond ((typep layer 'melody-layer) *melody-layer-mode-table*) + ((typep layer 'lyrics-layer) *lyrics-layer-mode-table*)) + *global-mode-table*))) + (define-gsharp-command (com-select-layer :name t) () (let ((selected-layer (accept 'layer :prompt "Select layer"))) (select-layer (cursor *gsharp-frame*) selected-layer))) @@ -1155,3 +1161,20 @@ (define-gsharp-command com-call-last-kbd-macro () (handler-case (mapc #'funcall *kbd-macro-funs*) (gsharp-condition (condition) (format *error-output* "~a~%" condition)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Lyrics + +(defun insert-lyrics-element () + (let* ((state (input-state *gsharp-frame*)) + (cursor (cursor *gsharp-frame*)) + (element (make-lyrics-element + (if (eq (notehead state) :filled) (rbeams state) 0) + (if (eq (notehead state) :filled) (lbeams state) 0) + (dots state) + (notehead state) + (car (staves (layer (cursor *gsharp-frame*))))))) + (insert-element element cursor) + (forward-element cursor) + element)) Index: gsharp/modes.lisp diff -u gsharp/modes.lisp:1.1 gsharp/modes.lisp:1.2 --- gsharp/modes.lisp:1.1 Fri Jul 23 09:51:16 2004 +++ gsharp/modes.lisp Sat Jul 24 13:09:55 2004 @@ -11,70 +11,156 @@ ;;; global mode table (defparameter *global-mode-table* (make-sequence-dico :test #'equal)) -(add-keyseq '((#\L :shift)) 'com-lower *global-mode-table*) -(add-keyseq '((#\H :shift)) 'com-higher *global-mode-table*) (add-keyseq '((#\f :control)) 'com-forward-element *global-mode-table*) (add-keyseq '((#\b :control)) 'com-backward-element *global-mode-table*) (add-keyseq '((#\d :control)) 'com-delete-element *global-mode-table*) -(add-keyseq '((#\h :control)) 'com-erase-element *global-mode-table*) -(add-keyseq '((#\c)) 'com-insert-note-c *global-mode-table*) -(add-keyseq '((#\d)) 'com-insert-note-d *global-mode-table*) -(add-keyseq '((#\e)) 'com-insert-note-e *global-mode-table*) -(add-keyseq '((#\f)) 'com-insert-note-f *global-mode-table*) -(add-keyseq '((#\g)) 'com-insert-note-g *global-mode-table*) -(add-keyseq '((#\a)) 'com-insert-note-a *global-mode-table*) -(add-keyseq '((#\b)) 'com-insert-note-b *global-mode-table*) -(add-keyseq '((#\,)) 'com-insert-rest *global-mode-table*) -(add-keyseq '((#\Space)) 'com-insert-empty-cluster *global-mode-table*) -(add-keyseq '((#\C :shift)) 'com-add-note-c *global-mode-table*) -(add-keyseq '((#\D :shift)) 'com-add-note-d *global-mode-table*) -(add-keyseq '((#\E :shift)) 'com-add-note-e *global-mode-table*) -(add-keyseq '((#\F :shift)) 'com-add-note-f *global-mode-table*) -(add-keyseq '((#\G :shift)) 'com-add-note-g *global-mode-table*) -(add-keyseq '((#\A :shift)) 'com-add-note-a *global-mode-table*) -(add-keyseq '((#\B :shift)) 'com-add-note-b *global-mode-table*) -(add-keyseq '((#\h :meta)) 'com-rotate-notehead *global-mode-table*) -(add-keyseq '((#\s :meta)) 'com-rotate-stem-direction *global-mode-table*) -(add-keyseq '((#\p)) 'com-current-increment *global-mode-table*) -(add-keyseq '((#\n)) 'com-current-decrement *Global-mode-table*) (add-keyseq '((#\| :shift)) 'com-insert-measure-bar *global-mode-table*) (add-keyseq '((#\.)) 'com-more-dots *global-mode-table*) (add-keyseq '((#\[)) 'com-more-lbeams *global-mode-table*) (add-keyseq '((#\])) 'com-more-rbeams *global-mode-table*) -(add-keyseq '((#\#)) 'com-sharper *global-mode-table*) -(add-keyseq '((#\# :shift)) 'com-sharper *global-mode-table*) -(add-keyseq '((#\@ :shift)) 'com-flatter *global-mode-table*) -(add-keyseq '((#\# :meta)) 'com-more-sharps *global-mode-table*) -(add-keyseq '((#\# :meta :shift)) 'com-more-sharps *global-mode-table*) -(add-keyseq '((#\@ :meta :shift)) 'com-more-flats *global-mode-table*) -(add-keyseq '((#\u :meta)) 'com-up *global-mode-table*) -(add-keyseq '((#\d :meta)) 'com-down *global-mode-table*) (add-keyseq '((#\l :meta)) 'com-left *global-mode-table*) (add-keyseq '((#\r :meta)) 'com-right *global-mode-table*) -(add-keyseq '((#\p :meta)) 'com-previous-layer *global-mode-table*) -(add-keyseq '((#\n :meta)) 'com-next-layer *global-mode-table*) -(add-keyseq '((#\i) (#\.)) 'com-istate-more-dots *global-mode-table*) -(add-keyseq '((#\i) (#\[)) 'com-istate-more-lbeams *global-mode-table*) -(add-keyseq '((#\i) (#\])) 'com-istate-more-rbeams *global-mode-table*) -(add-keyseq '((#\i) (#\h)) 'com-istate-rotate-notehead *global-mode-table*) -(add-keyseq '((#\i) (#\s)) 'com-istate-rotate-stem-direction *global-mode-table*) -(add-keyseq '((#\i) (#\x) (#\.)) 'com-istate-fewer-dots *global-mode-table*) -(add-keyseq '((#\i) (#\x) (#\[)) 'com-istate-fewer-lbeams *global-mode-table*) -(add-keyseq '((#\i) (#\x) (#\])) 'com-istate-fewer-rbeams *global-mode-table*) -(add-keyseq '((#\x) (#\.)) 'com-fewer-dots *global-mode-table*) -(add-keyseq '((#\x) (#\[)) 'com-fewer-lbeams *global-mode-table*) -(add-keyseq '((#\x) (#\])) 'com-fewer-rbeams *global-mode-table*) (add-keyseq '((#\x :control) (#\( :shift)) 'com-start-kbd-macro *global-mode-table*) (add-keyseq '((#\x :control) (#\()) 'com-start-kbd-macro *global-mode-table*) (add-keyseq '((#\x :control) (#\) :shift)) 'com-end-kbd-macro *global-mode-table*) (add-keyseq '((#\x :control) (#\))) 'com-end-kbd-macro *global-mode-table*) (add-keyseq '((#\x :control) (#\e)) 'com-call-last-kbd-macro *global-mode-table*) +(add-keyseq '((#\r :control)) 'com-rotate-notehead *global-mode-table*) + +;;; melody mode table +(defparameter *melody-layer-mode-table* (make-sequence-dico :test #'equal)) + +(add-keyseq '((#\L :shift)) 'com-lower *melody-layer-mode-table*) +(add-keyseq '((#\H :shift)) 'com-higher *melody-layer-mode-table*) +(add-keyseq '((#\c)) 'com-insert-note-c *melody-layer-mode-table*) +(add-keyseq '((#\d)) 'com-insert-note-d *melody-layer-mode-table*) +(add-keyseq '((#\e)) 'com-insert-note-e *melody-layer-mode-table*) +(add-keyseq '((#\f)) 'com-insert-note-f *melody-layer-mode-table*) +(add-keyseq '((#\g)) 'com-insert-note-g *melody-layer-mode-table*) +(add-keyseq '((#\a)) 'com-insert-note-a *melody-layer-mode-table*) +(add-keyseq '((#\b)) 'com-insert-note-b *melody-layer-mode-table*) +(add-keyseq '((#\,)) 'com-insert-rest *melody-layer-mode-table*) +(add-keyseq '((#\Space)) 'com-insert-empty-cluster *melody-layer-mode-table*) +(add-keyseq '((#\C :shift)) 'com-add-note-c *melody-layer-mode-table*) +(add-keyseq '((#\D :shift)) 'com-add-note-d *melody-layer-mode-table*) +(add-keyseq '((#\E :shift)) 'com-add-note-e *melody-layer-mode-table*) +(add-keyseq '((#\F :shift)) 'com-add-note-f *melody-layer-mode-table*) +(add-keyseq '((#\G :shift)) 'com-add-note-g *melody-layer-mode-table*) +(add-keyseq '((#\A :shift)) 'com-add-note-a *melody-layer-mode-table*) +(add-keyseq '((#\B :shift)) 'com-add-note-b *melody-layer-mode-table*) +(add-keyseq '((#\p)) 'com-current-increment *melody-layer-mode-table*) +(add-keyseq '((#\n)) 'com-current-decrement *Melody-Layer-mode-table*) +(add-keyseq '((#\i) (#\.)) 'com-istate-more-dots *melody-layer-mode-table*) +(add-keyseq '((#\i) (#\[)) 'com-istate-more-lbeams *melody-layer-mode-table*) +(add-keyseq '((#\i) (#\])) 'com-istate-more-rbeams *melody-layer-mode-table*) +(add-keyseq '((#\i) (#\h)) 'com-istate-rotate-notehead *melody-layer-mode-table*) +(add-keyseq '((#\i) (#\s)) 'com-istate-rotate-stem-direction *melody-layer-mode-table*) +(add-keyseq '((#\i) (#\x) (#\.)) 'com-istate-fewer-dots *melody-layer-mode-table*) +(add-keyseq '((#\i) (#\x) (#\[)) 'com-istate-fewer-lbeams *melody-layer-mode-table*) +(add-keyseq '((#\i) (#\x) (#\])) 'com-istate-fewer-rbeams *melody-layer-mode-table*) +(add-keyseq '((#\x) (#\.)) 'com-fewer-dots *melody-layer-mode-table*) +(add-keyseq '((#\x) (#\[)) 'com-fewer-lbeams *melody-layer-mode-table*) +(add-keyseq '((#\x) (#\])) 'com-fewer-rbeams *melody-layer-mode-table*) +(add-keyseq '((#\h :control)) 'com-erase-element *melody-layer-mode-table*) +(add-keyseq '((#\h :meta)) 'com-rotate-notehead *melody-layer-mode-table*) +(add-keyseq '((#\s :meta)) 'com-rotate-stem-direction *melody-layer-mode-table*) +(add-keyseq '((#\#)) 'com-sharper *melody-layer-mode-table*) +(add-keyseq '((#\# :shift)) 'com-sharper *melody-layer-mode-table*) +(add-keyseq '((#\@ :shift)) 'com-flatter *melody-layer-mode-table*) +(add-keyseq '((#\# :meta)) 'com-more-sharps *melody-layer-mode-table*) +(add-keyseq '((#\# :meta :shift)) 'com-more-sharps *melody-layer-mode-table*) +(add-keyseq '((#\@ :meta :shift)) 'com-more-flats *melody-layer-mode-table*) +(add-keyseq '((#\u :meta)) 'com-up *melody-layer-mode-table*) +(add-keyseq '((#\d :meta)) 'com-down *melody-layer-mode-table*) ;;; lyrics mode table (defparameter *lyrics-layer-mode-table* (make-sequence-dico :test #'equal)) +(add-keyseq '((#\h :control)) (lambda () (erase-char (cur-element))) + *lyrics-layer-mode-table*) +(add-keyseq '((#\h :meta)) 'com-erase-element *lyrics-layer-mode-table*) +(add-keyseq '((#\Space :control)) 'insert-lyrics-element *lyrics-layer-mode-table*) -;;; melody mode table -(defparameter *melody-layer-mode-table* (make-sequence-dico :test #'equal)) +(defun make-insert-fun (code) + (lambda () (append-char (cur-element) code))) + +(loop for c in '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M + #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z) + for i from 65 + do (add-keyseq `((,c :shift)) (make-insert-fun i) *lyrics-layer-mode-table*)) + +(loop for c in '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m + #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z) + for i from 97 + do (add-keyseq `((,c)) (make-insert-fun i) *lyrics-layer-mode-table*)) + +;;; try some latin prefix mode for national characters +(add-keyseq '((#\`) (#\A :shift)) (make-insert-fun 192) *lyrics-layer-mode-table*) +(add-keyseq '((#\') (#\A :shift)) (make-insert-fun 193) *lyrics-layer-mode-table*) +(add-keyseq '((#\^) (#\A :shift)) (make-insert-fun 194) *lyrics-layer-mode-table*) +(add-keyseq '((#\~) (#\A :shift)) (make-insert-fun 195) *lyrics-layer-mode-table*) +(add-keyseq '((#\") (#\A :shift)) (make-insert-fun 196) *lyrics-layer-mode-table*) +(add-keyseq '((#\/) (#\A :shift)) (make-insert-fun 197) *lyrics-layer-mode-table*) +(add-keyseq '((#\/) (#\E :shift)) (make-insert-fun 198) *lyrics-layer-mode-table*) +(add-keyseq '((#\/) (#\C :shift)) (make-insert-fun 199) *lyrics-layer-mode-table*) +(add-keyseq '((#\`) (#\E :shift)) (make-insert-fun 200) *lyrics-layer-mode-table*) +(add-keyseq '((#\') (#\E :shift)) (make-insert-fun 201) *lyrics-layer-mode-table*) +(add-keyseq '((#\^) (#\E :shift)) (make-insert-fun 202) *lyrics-layer-mode-table*) +(add-keyseq '((#\") (#\E :shift)) (make-insert-fun 203) *lyrics-layer-mode-table*) +(add-keyseq '((#\`) (#\I :shift)) (make-insert-fun 204) *lyrics-layer-mode-table*) +(add-keyseq '((#\') (#\I :shift)) (make-insert-fun 205) *lyrics-layer-mode-table*) +(add-keyseq '((#\^) (#\I :shift)) (make-insert-fun 206) *lyrics-layer-mode-table*) +(add-keyseq '((#\") (#\I :shift)) (make-insert-fun 207) *lyrics-layer-mode-table*) +(add-keyseq '((#\/) (#\D :shift)) (make-insert-fun 208) *lyrics-layer-mode-table*) +(add-keyseq '((#\~) (#\N :shift)) (make-insert-fun 209) *lyrics-layer-mode-table*) +(add-keyseq '((#\`) (#\O :shift)) (make-insert-fun 210) *lyrics-layer-mode-table*) +(add-keyseq '((#\') (#\O :shift)) (make-insert-fun 211) *lyrics-layer-mode-table*) +(add-keyseq '((#\^) (#\O :shift)) (make-insert-fun 212) *lyrics-layer-mode-table*) +(add-keyseq '((#\~) (#\O :shift)) (make-insert-fun 213) *lyrics-layer-mode-table*) +(add-keyseq '((#\") (#\O :shift)) (make-insert-fun 214) *lyrics-layer-mode-table*) + +(add-keyseq '((#\/) (#\O :shift)) (make-insert-fun 216) *lyrics-layer-mode-table*) +(add-keyseq '((#\`) (#\U :shift)) (make-insert-fun 217) *lyrics-layer-mode-table*) +(add-keyseq '((#\') (#\U :shift)) (make-insert-fun 218) *lyrics-layer-mode-table*) +(add-keyseq '((#\^) (#\U :shift)) (make-insert-fun 219) *lyrics-layer-mode-table*) +(add-keyseq '((#\") (#\U :shift)) (make-insert-fun 220) *lyrics-layer-mode-table*) +(add-keyseq '((#\') (#\Y :shift)) (make-insert-fun 221) *lyrics-layer-mode-table*) + + +(add-keyseq '((#\`) (#\a)) (make-insert-fun 224) *lyrics-layer-mode-table*) +(add-keyseq '((#\') (#\a)) (make-insert-fun 225) *lyrics-layer-mode-table*) +(add-keyseq '((#\^) (#\a)) (make-insert-fun 226) *lyrics-layer-mode-table*) +(add-keyseq '((#\~) (#\a)) (make-insert-fun 227) *lyrics-layer-mode-table*) +(add-keyseq '((#\") (#\a)) (make-insert-fun 228) *lyrics-layer-mode-table*) +(add-keyseq '((#\/) (#\a)) (make-insert-fun 229) *lyrics-layer-mode-table*) +(add-keyseq '((#\/) (#\e)) (make-insert-fun 230) *lyrics-layer-mode-table*) +(add-keyseq '((#\~) (#\c)) (make-insert-fun 231) *lyrics-layer-mode-table*) +(add-keyseq '((#\`) (#\e)) (make-insert-fun 232) *lyrics-layer-mode-table*) +(add-keyseq '((#\') (#\e)) (make-insert-fun 233) *lyrics-layer-mode-table*) +(add-keyseq '((#\^) (#\e)) (make-insert-fun 234) *lyrics-layer-mode-table*) +(add-keyseq '((#\") (#\e)) (make-insert-fun 235) *lyrics-layer-mode-table*) +(add-keyseq '((#\`) (#\i)) (make-insert-fun 236) *lyrics-layer-mode-table*) +(add-keyseq '((#\') (#\i)) (make-insert-fun 237) *lyrics-layer-mode-table*) +(add-keyseq '((#\^) (#\i)) (make-insert-fun 238) *lyrics-layer-mode-table*) +(add-keyseq '((#\") (#\i)) (make-insert-fun 239) *lyrics-layer-mode-table*) + + +(add-keyseq '((#\`) (#\o)) (make-insert-fun 242) *lyrics-layer-mode-table*) +(add-keyseq '((#\') (#\o)) (make-insert-fun 243) *lyrics-layer-mode-table*) +(add-keyseq '((#\^) (#\o)) (make-insert-fun 244) *lyrics-layer-mode-table*) +(add-keyseq '((#\~) (#\o)) (make-insert-fun 245) *lyrics-layer-mode-table*) +(add-keyseq `((#\") (#\o)) (make-insert-fun 246) *lyrics-layer-mode-table*) + +(add-keyseq '((#\/) (#\o)) (make-insert-fun 248) *lyrics-layer-mode-table*) +(add-keyseq '((#\`) (#\u)) (make-insert-fun 249) *lyrics-layer-mode-table*) +(add-keyseq '((#\') (#\u)) (make-insert-fun 250) *lyrics-layer-mode-table*) +(add-keyseq '((#\^) (#\u)) (make-insert-fun 251) *lyrics-layer-mode-table*) +(add-keyseq '((#\") (#\u)) (make-insert-fun 252) *lyrics-layer-mode-table*) +(add-keyseq '((#\') (#\y)) (make-insert-fun 253) *lyrics-layer-mode-table*) + +(add-keyseq '((#\") (#\y)) (make-insert-fun 255) *lyrics-layer-mode-table*) + + + \ No newline at end of file Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.7 gsharp/packages.lisp:1.8 --- gsharp/packages.lisp:1.7 Fri Jul 23 09:51:16 2004 +++ gsharp/packages.lisp Sat Jul 24 13:09:55 2004 @@ -50,12 +50,12 @@ #:notehead #:rbeams #:lbeams #:dots #:element #:melody-element #:notes #:add-note #:find-note #:remove-note #:cluster #:make-cluster - #:rest #:make-rest #:lyrics-element + #:rest #:make-rest #:lyrics-element #:make-lyrics-element #:slice #:elements #:nb-elements #:elementno #:add-element #:remove-element #:bar #:make-bar #:melody-bar #:lyrics-bar - #:layer + #:layer #:lyrics-layer #:melody-layer #:bars #:nb-bars #:barno #:add-bar #:remove-bar #:slice #:segment #:slices #:sliceno @@ -74,7 +74,7 @@ #:stem-direction #:stem-length #:notehead-duration #:element-duration #:clef #:keysig #:staff-pos #:xoffset #:read-everything #:save-buffer-to-stream #:line-width #:min-width #:spacing-style #:right-edge #:left-offset - #:left-margin #:text + #:left-margin #:text #:append-char #:erase-char )) (defpackage :gsharp-numbering

1 0

[gsharp-cvs] CVS update: gsharp/Doc/commands.tex gsharp/Doc/gsharp.tex gsharp/Doc/plans.tex gsharp/Doc/release-notes.tex
by Robert Strandh 24 Jul '04

24 Jul '04

Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv6768 Modified Files: commands.tex gsharp.tex plans.tex release-notes.tex Log Message: Updated the `getting started' to reflect the new and altered commands for staves and layers. Updated the command summary in the reference manual for the same reason. Added items to the release notes to reflect user-visible changes. Removed and modified some items in the `future plans' section to reflect some improvements already made. At some point in the future, I need to update the `internals' part to reflect the existence of lyrics, etc., but since the way it is implemented might change some, there is no point in doing that right now. Date: Fri Jul 23 23:41:55 2004 Author: rstrandh Index: gsharp/Doc/commands.tex diff -u gsharp/Doc/commands.tex:1.3 gsharp/Doc/commands.tex:1.4 --- gsharp/Doc/commands.tex:1.3 Sun Jul 18 23:23:53 2004 +++ gsharp/Doc/commands.tex Fri Jul 23 23:41:54 2004 @@ -114,21 +114,23 @@ \hline \end{tabular} -\section{Operations on the current layer} +\section{Operations on layers} \begin{tabular}{|l|l|l|} \hline Key & Command name & Description\\ \hline -\kbd{Meta-n} & Next Layer & Make the next layer current\\ -\kbd{Meta-p} & Previous Layer & Make the previous layer current\\ - & Insert Layer After & Insert new layer after current\\ - & Insert Layer Before & Insert new layer before current\\ - & Delete Layer & Delete the current layer\\ - & Add Layer Staff & Adds a new staff to the layer\\ - & & (promts for a name of an existing staff)\\ - & Delete Layer Staff & Deletes a staff from the layer\\ - & & (promts for a name of an existing staff)\\ + & Select Layer & Prompts for a new current lsyer\\ + & Rename Layer & Prompts for a layer and a new name\\ + & Add Layer & Prompts for a name and an initial\\ + & & staff for the new layer. The type\\ + & & of the new layer is determined by\\ + & & the type of the initial staff.\\ + & Delete Layer & Prompts for a layer to delete\\ + & Rotate Staves & If they layer is displayed on \\ + & & multiple staves, rotate them so\\ + & & that a different one becomes the\\ + & & current one.\\ \hline \end{tabular} @@ -136,22 +138,22 @@ \begin{tabular}{|l|l|l|} \hline -Key & Command name & Description\\ +Key & Command name & Description\\ \hline - & Add Staff After & Add a new staff after an existing one\\ - & & (prompts for the existing staff, \\ - & & for the name and the type of the new staff, \\ - & & and a clef and a line for the clef\\ - & & if type is \texttt{fiveline})\\ - & Add Staff Before & Add a new before after an existing one\\ - & & (prompts for the existing staff, \\ - & & for the name and the type of the new staff, \\ - & & and a clef and a line for the clef\\ - & & if type is \texttt{fiveline})\\ - & Delete Staff & Delete a staff (promts for staff to delete)\\ - & Rename Staff & Rename current staff (prompts for a new name)\\ - & Set clef & Set the clef of the current staff\\ - & & (promts for name of clef and line number)\\ + & Insert Staff After & Add a new staff after an existing one\\ + & & (prompts for the existing staff, \\ + & & for the name and the type of the new staff, \\ + & & and a clef and a line for the clef\\ + & & if type is \texttt{fiveline})\\ + & Insert Staff Before & Add a new before after an existing one\\ + & & (prompts for the existing staff, \\ + & & for the name and the type of the new staff, \\ + & & and a clef and a line for the clef\\ + & & if type is \texttt{fiveline})\\ + & Delete Staff & Delete a staff (promts for staff to delete)\\ + & Rename Staff & Rename current staff (prompts for a new name)\\ + & Set clef & Set the clef of the current staff\\ + & & (promts for name of clef and line number)\\ \kbd{Meta-\#} & More Sharps & removes a flat or adds a sharp to the key signature\\ \kbd{Meta-@} & More Flats & removes a sharp or adds a flat to the key signature\\ \hline Index: gsharp/Doc/gsharp.tex diff -u gsharp/Doc/gsharp.tex:1.3 gsharp/Doc/gsharp.tex:1.4 --- gsharp/Doc/gsharp.tex:1.3 Fri Apr 2 09:13:35 2004 +++ gsharp/Doc/gsharp.tex Fri Jul 23 23:41:54 2004 @@ -121,12 +121,41 @@ You should be seeing a main window (known as a \emph{frame}) with a menu bar and four sub-windows, known as \emph{panes}. +\subsection{The score pane} +\label{sec-score-pane} + The largest pane is the \emph{score pane}\index{score - pane}\index{pane!score|)} where you will do most of the editing, + pane}\index{pane!score|)} where you will do most of the editing, + +When prompted for some item on display in the score pane, you can +usually click on it. For instance, if you have issued a command that +operates on a particular staff, you can usually click on a visual +representation of the staff in the score pane to satisfy the request +for the staff. + +\subsection{The command pane} +label{sec-command-pane} The pane at the bottom is a {\clim} \emph{command pane}\index{command pane}\index{pane!command|)}. In it, you can type -commands that do not have keyboard shortcuts. +commands that do not have keyboard shortcuts. + +The command pane is also where you get prompted for arguments to +various {\gs} commands. In those cases, you usually have a choice +between clicking on a visual representation of the argument you would +like to supply as mentioned in section \ref{sec-score-pane}, or to +type some textual representation of it directly at the prompt. + +When typing some textual representation of some existing object, such +as the name of a layer or of a staff, you can usually use +\emph{completion}\index{completion}, which means that you can type a +unique prefix of the text and then use the \kbd{TAB} key to get {\gs} +to fill in the rest. Using completion after having issued a command +in the command pane is usually faster (provided you have some idea of +what the textual representation is) than to grab the mouse and click +on the object in the score pane. + +\subsection{Other panes} In the upper-right corner, you will see a the pane that determines the \emph{input state}\index{input state}\index{pane!input state|)} @@ -364,31 +393,177 @@ \chapter{Operations on measures} You add a measure bar at the cursor location by typing \kbd{|}. As - with other element, the cursor will be positioned right after the - newly created measure bar. In fact, a measure bar is just like any - other element as far as editing operations are concerned. +with other element, the cursor will be positioned right after the +newly created measure bar. In fact, a measure bar is just like any +other element as far as editing operations are concerned. Thus, to delete a measure bar, you simply use the ordinary commands for erasing or deleting elements. +\chapter{Operations on staves} +\label{chap-op-staves} + +Initially, when {\gs} starts up, there is a single staff on display. +It is a standard five-line staff with a treble clef on staff step 2 +(we count the bottom line of the staff as staff step 0). + +\section{Renaming and existing staff} + +Staves have unique names in {\gs}. Initially, the name of the first +staff on display is some default name such as ``default staff''. You +typically want to use names of staves that suggest the kind of musical +material displayed on it, such as ``Trumpets'' or ``Piano right +hand'', etc. + +You can give a different name to an existing staff by issuing the +command \command{Rename Staff}, either from a menu or form the command +pane. This command prompts for a staff to rename and a new name for +the staff. At the prompt for the staff to rename, you have a choice +of clicking on a staff on display as indicated in section +\ref{sec-score-pane}, or typing its name in the command pane possibly +with \emph{completion}\index{completion} as indicated in section +\ref{sec-score-pane}. Renaming a staff is such an infrequent +operation that there is no keyboard shortcut for it. + +\section{Inserting a new staff} +\label{sec-inserting-staff} + +Unless you are writing some very simple music, or a part for a +monophonic instrument, you probably want to be able to add new staves +to the score. Because adding new staves are done fairly infrequently, +there is no keyboard shortcut for doing it. Instead, you have to +issue one of the commands for doing this either by typing it (with +completion, see \ref{sec-command-pane}) in the command pane or using +the mouse to select one from a menu. + +{\gs} imposes an \emph{order} on the staves of a score. This order is +the one used to display the staves from top to bottom. There are two +commands available for inserting new staves, \command{Insert Staff + After} to insert a staff \emph{after} an existing one, and \command{Insert + Staff Before} to insert a staff \emph{before} an existing one. + +In both cases, you will be prompted for some required information, in +order for {\gs} to be able to create the new staff. First, you will +be prompted for an existing staff after which (in the case of +\command{Insert Staff After} or before which (in the case of +\command{Insert Staff Before} you would like to insert the new staff. +As usual, you can either click on a visual representation of the staff +in the score pane (see section \ref{sec-score-pane}) or type its name +in the command pane with completion (see section +\ref{sec-command-pane}). + +Next, you are prompted for the type of the staff to create. There are +currently two types of staves, namely `fiveline' and `lyrics'. At the +moment, the only way to answer this question is to type it in the +command pane (again, completion is available). + +If you requested a five-line staff to be created, you will also be +prompted for the type of clef you would like the staff to have. There +are three possible choices `treble', `bass', and `c', which you have +to type in the command pane at the prompt. You will also be prompted +for a `line' number on which the clef is to be placed. Recall that +the lines are numbered with even numbers starting with `0' for the +bottom line of the staff. The normal place for a treble clef is thus +`2' and the normal place for a bass clef is `6'. For the c clef it +varies. + +If instead you requested a lyrics staff to be created, there is no +more information to supply. + +\section{Deleting a staff} + +To delete an existing staff, you issue the \command{Delete Staff} +command, either from a menu or in the command pane. Deleting an +existing staff is such an infrequent operation that no keyboard +shortcut is provided. + +The command prompts for a staff to be deleted. As usual, you can +either satisfy the request by clicking on the visual representation of +a staff in the score pane (see section \ref{sec-score-pane}) or typing +a response in the command pane (see section \ref{sec-command-pane}). + +\section{Changing the key signature} + +To alter the key signature of a staff, use the commands \kbd{Meta-\#} +\command{More Sharps} and \kbd{Meta-@} \command{More Flats}. + \chapter{Operations on layers} -To change the current layer, you can type \kbd{Meta-p} -(\command{Previous Layer}) or \kbd{Meta-n} (\command{Next Layer}. +{\gs} organizes musical material into \emph{layers}\index{layer}. A +{\gs} layer corresponds roughly to a \emph{void}\index{voice} in +traditional music terminology. The reason a different term was chosen +is that there might be some notations that require a voice to be split +into several layers. Each layer can be displayed on one or more +staves, one of which is always the \emph{current}\index{current staff} +one. + +In {\gs}, layers have unique names. Initially, when {\gs} starts up, +it has a single layer with some default name such as ``default +layer''. It has a single staff on which it is displayed, namely the +default staff (see chapter \ref{chap-op-staves}). + +You typically want to choose names for layers that suggest the kind of +music material that is contained in it. Since a layer has (or will +have) a unique \emph{instrument}\index{instrument} associated with it, +we advice you not to mix material for different instruments in a +layer. Therefore, when a part plays several instruments (presumably +not simultaneously) we advice you to use a different layer for each +instrument in the part. Typically, then, a layer name would be the +name of an instruments playing a single part, such as ``First Violin'' +or ``Solo Guitar''. + +\section{Renaming an existing layer} + +You can rename any layer by issuing the command \command{Rename +Layer}, either in the command pane (see section +\ref{sec-command-pane}) or from a menu. + +You will first be prompted for a layer to rename. Currently the only +way to satisfy this request is by typing the name of the layer to the +prompt in the command pane. Completion is possible as usual (see +section \ref{sec-command-pane}). + +Next, you will be prompted for a new name of the layer. To satisfy +the request, you type any string at the prompts. Notice that names +must be unique. If you type the name of an existing layer, your +entire command will be rejected. + +\section{Selecting a layer} + +{\gs} has the concept of a \emph{current layer}\index{current layer} +which receives all music material typed in the score pane, such as +notes, rests, etc. + +To change the current layer, issue the \command{Select Layer} either +from a menu or in the command pane. + +You will be prompted for a layer to be used as the current one. At +the moment, the only way to satisfy this request is to type its unique +name (with completion, see \ref{sec-command-pane}) at the prompt in +the command pane. + +\section{Adding a new layer} + +Before adding a new layer, make sure you have created one of the +staves on which you would its material to be displayed (see section +\ref{sec-inserting-staff}). + +Adding a new layer is done by issuing the command \command{Add + Layer}. You will be prompted for a unique name of the new layer, +and for an existing staff to use as the initial staff of the layer. + +The type of the layer that is created as a result of this command +depends on the type of the initial staff. If the initial staff is an +ordinary five-line staff, then a melody layer is created. If instead +the initial staff is a lyrics staff, a lyrics layer is created. -To insert a new layer, you have to go to the command pane and type the -full command, either \command{Insert Layer After} or \command{Insert - Layer Before} according to whether you would like the new layer to -be ordered before or after the current one. The order between layers -only affects the order in which they are presented to you with the -\command{Next Layer} and \command{Previous Layer} commands. You will -be prompted for the name of a staff to use for displaying material in -this layer. Later, you can modify the relation between layers and -staves. +\section{Deleting a layer} To delete the current layer, you have to use the command pane (since this is an operation that is presumably rare). The command to use is -\command{Delete Layer}. +\command{Delete Layer}. You will be prompted for a layer to delete. + +\section{Adding an existing staff to a layer} A layer can be displayed on one or several \emph{staves}. Most layers will have a single staff associated with them, but is occasionally @@ -398,6 +573,12 @@ displayed on one staff and some other elements on a different staff. +To add a staff to the possible staves of a layer, use the command +\command{Add Staff To Layer}. You will be prompted for a staff to add +and a layer to add it to. + +\section{Stem direction of a layer} + A layer can have a preferred stem direction for all clusters in it\unimp{It is not hard to do, though}. The user can override this stem direction for individual elements, but if the stem direction of @@ -405,25 +586,6 @@ be displayed with the stem direction determined by the layer. If the stem direction of the layer is also \emph{auto}, the layout engine will determine the stem direction. - -\chapter{Operations on staves} - -To add a new staff, use the command \command{Add Staff}. You will be prompted -for the name of the new staff. - -To delete a staff, use the command \command{Delete Staff}. Again, you -will be prompted for the name of the staff to delete. - -To add a staff to the current layer (so that material in that layer -can be displayed on that staff), use the command \command{Add Layer - Staff}. You will be prompted for the name of a staff to add. - -To delete a staff from the current layer, use the command -\command{Delete Layer Staff}. You will be prompted for the name of a -staff. - -To alter the key signature of a staff, use the commands \kbd{Meta-\#} -\command{More Sharps} and \kbd{Meta-@} \command{More Flats}. % *********************************************************** \part{Reference manual} Index: gsharp/Doc/plans.tex diff -u gsharp/Doc/plans.tex:1.2 gsharp/Doc/plans.tex:1.3 --- gsharp/Doc/plans.tex:1.2 Mon Feb 16 08:08:01 2004 +++ gsharp/Doc/plans.tex Fri Jul 23 23:41:54 2004 @@ -27,8 +27,6 @@ \item Playing as MIDI should create a temporary file with a unique name in \texttt{/tmp} as opposed a file in the current directory with a name that can clash with others. -\item Someone who knows how pathnames work needs to find out how to - use them in place of strings for filenames. \end{itemize} \section{Major issues} @@ -170,12 +168,6 @@ itself. Such space would include space for lyrics, accidentals of complicated clusters, etc. -\subsection{Menu items with arguments} - -This is a {\clim} project. Currently {\clim} does not know how to -read arguments when a command has been invoked from a menu item. -Consequently, we are restricted to menu items that have no arguments. - \subsection{Layout by page} We need to have a more sophisticated layout algorithm that divides the @@ -223,7 +215,8 @@ \subsection{Other major projects} \begin{itemize} -\item presentations everywhere (note heads, clusters, beam groups). +\item presentations everywhere (note heads, clusters, beam groups). + Currently, McCLIM is a bit to slow for this. \item context menus on notes, etc \item allow mouse-based input of new notes by making staff steps around cursor into presentations. Move pointer to horizontal Index: gsharp/Doc/release-notes.tex diff -u gsharp/Doc/release-notes.tex:1.5 gsharp/Doc/release-notes.tex:1.6 --- gsharp/Doc/release-notes.tex:1.5 Sun Jul 18 23:23:53 2004 +++ gsharp/Doc/release-notes.tex Fri Jul 23 23:41:54 2004 @@ -25,6 +25,43 @@ arguments now prompt for existing staves as opposed to just names of staves. \item Added completion for clef types and staff types. +\item Added completion for names of staves and of layers. +\item Naming a layer or a staff requires the user to give a unique + name. +\item Added beginning of support for lyrics. Lyrics are ultimately + going to be Unicode strings, but only a subset of ASCII (letters, + digits) is currently handled. +\item Layers are no longer ordered. Commands related to this ordering + (Next Layer, Previous Layer, Insert Layer After, etc) were removed. + New commands were added: Select Layer prompts for a layer and makes + it the current one. Rename Layer prompts for a layer and a new name + (that must be unique). Add Layer prompts for a unique name and an + initial staff for the layer. The type of the staff determines what + type of layer is created. Delete Layer prompts for a layer + deletes the layer, and automatically inserts a new one if the last + one was deleted. +\item Commands for manipulating staves are now: Insert Staff Before, + which prompts for a staff after which the new one is to be inserted, + for the unique name of the new staff, for the type of the new staff + (currently fiveline or lyrics), for the type of clef to be used on + the new staff, and for a line number on which the clef is to be + placed. Insert Staff After is like Insert Staff Before, except that + the new staff is inserted before an existing one. Delete Staff + prompts for a staff to delete. Rename Staff prompts for a staff to + rename and a new unique name. +\item Each layer contains a list of staves on which music material + from the layer can be presented. There is usually just one staff in + the list, but sometimes two (for piano music). Add Staff To Layer + is a command that prompts for an existing staff to add, and for an + existing layer to which to add the staff, and adds the staff to the + list managed by the layer. The new staff is made the current one + for the layer. +\item Each layer now has its own current staff. When returning to a + multi-staff layer after having edited some other layer, the user now + finds that the last staff that was used in that layer is the current + one. +\item Added a `Staves' menu in the menu bar for mouse access to the + staff commands. \end{itemize} \subsection{Bug fixes from 0.2}

1 0

[gsharp-cvs] CVS update: gsharp/modes.lisp gsharp/sequence-dico.lisp gsharp/buffer.lisp gsharp/cursor.lisp gsharp/drawing.lisp gsharp/gui.lisp gsharp/input-state.lisp gsharp/measure.lisp gsharp/numbering.lisp gsharp/packages.lisp gsharp/score-pane.lisp gsharp/system.lisp gsharp/utilities.lisp
by Robert Strandh 23 Jul '04

23 Jul '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv31201 Modified Files: buffer.lisp cursor.lisp drawing.lisp gui.lisp input-state.lisp measure.lisp numbering.lisp packages.lisp score-pane.lisp system.lisp utilities.lisp Added Files: modes.lisp sequence-dico.lisp Log Message: These current modifications are not in a good state yet. Some of them are terribly kludgy, but I do not think anything is broken. New files: modes.lisp containing key bindings sequence-dico.lisp: a dictionary that searches for objects associated with sequences (lists really). Utilities: Added some horribly kludgy Unicode support. Buffer: New types: lyrics-staff, melody-element, lyrics-element, melody-bar, lyrics-bar, melody-layer, lyrics-layer Layers are no longer ordered. Cursor: Removed functionality that used layer ordering. Gui: Removed commands that used layer ordering. Added new commands to navigate, insert, and delete layers. Factored out and improved command processing. Some menus in menu bar work better. Added new presentation methods and types. Still no support for typing lyrics, but you can see them if they are already in a .gsh file. Input state: It no longer contains the staff. Instead the current staff is the first in the list of staves in the current layer. Drawing: We can now draw lyrics. Score pane: Now has a lyrics-staff presentation type. Date: Fri Jul 23 09:51:16 2004 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.4 gsharp/buffer.lisp:1.5 --- gsharp/buffer.lisp:1.4 Sun Jul 18 23:23:53 2004 +++ gsharp/buffer.lisp Fri Jul 23 09:51:16 2004 @@ -65,7 +65,9 @@ ;;; Staff (defclass staff () - ((name :accessor name :initarg :name :initform "default"))) + ((name :accessor name :initarg :name :initform "default staff"))) + +;;; fiveline (defgeneric clef (fiveline-staff)) @@ -100,6 +102,26 @@ #'read-fiveline-staff-v3 *gsharp-readtable-v3*) +;;; lyric + +(defclass lyrics-staff (staff) + ()) + +(defmethod print-object ((s lyrics-staff) stream) + (with-slots (name) s + (format stream "[L :name ~W ] " name))) + +(defun make-lyrics-staff (name) + (make-instance 'lyrics-staff :name name)) + +(defun read-lyrics-staff-v3 (stream char n) + (declare (ignore char n)) + (apply #'make-instance 'lyrics-staff (read-delimited-list #\] stream t))) + +(set-dispatch-macro-character #\[ #\L + #'read-lyrics-staff-v3 + *gsharp-readtable-v3*) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Note @@ -243,6 +265,12 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Melody element + +(defclass melody-element (element) ()) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; Cluster ;;; Return a list of the notes of the cluster @@ -261,7 +289,7 @@ ;;; to any cluster. (defgeneric remove-note (note)) -(defclass cluster (element) +(defclass cluster (melody-element) ((notes :initform '() :initarg :notes :accessor notes) (stem-direction :initarg :stem-direction :accessor stem-direction) (stem-length :initform nil :initarg :stem-length :accessor stem-length))) @@ -329,7 +357,7 @@ ;;; ;;; Rest -(defclass rest (element) +(defclass rest (melody-element) ((staff :initarg :staff :reader staff) (staff-pos :initarg :staff-pos :initform 4 :reader staff-pos))) @@ -372,6 +400,33 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Lyrics element + +(defclass lyrics-element (element) + ((staff :initarg :staff :reader staff) + (text :initarg :text + :initform (make-array 5 :adjustable t :element-type 'fixnum :fill-pointer 0) + :reader text))) + +(defun make-lyrics-element (rbeams lbeams dots notehead staff) + (make-instance 'lyrics-element + :rbeams rbeams :lbeams lbeams :dots dots + :notehead notehead :staff staff)) + +(defmethod print-object ((elem lyrics-element) stream) + (with-slots (notehead rbeams lbeams dots xoffset staff text) elem + (format stream "[A :notehead ~W :rbeams ~W :lbeams ~W :dots ~W :xoffset ~W :staff ~W :text ~W ] " text))) + +(defun read-lyrics-element-v3 (stream char n) + (declare (ignore char n)) + (apply #'make-instance 'lyrics-element (read-delimited-list #\] stream t))) + +(set-dispatch-macro-character #\[ #\A + #'read-lyrics-element-v3 + *gsharp-readtable-v3*) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; Bar ;;; It is recommended that the concept of a bar be hidden from the @@ -401,37 +456,6 @@ ((slice :initform nil :initarg :slice :reader slice) (elements :initform '() :initarg :elements :reader elements))) -(defmethod print-object ((b bar) stream) - (format stream "[| :elements ~W ] " (elements b))) - -(defun make-bar () - (make-instance 'bar)) - -(defun read-bar-v2 (stream char n) - (declare (ignore char n)) - (let* ((elements (read stream nil nil t)) - (bar (make-instance 'bar :elements elements))) - (loop for element in elements do - (setf (slot-value element 'bar) bar)) - (skip-until-close-bracket stream) - bar)) - -(set-dispatch-macro-character #\[ #\| - #'read-bar-v2 - *gsharp-readtable-v2*) - -(defun read-bar-v3 (stream char n) - (declare (ignore char n)) - (let* ((rest (read-delimited-list #\] stream t)) - (bar (apply #'make-instance 'bar rest))) - (loop for element in (elements bar) do - (setf (slot-value element 'bar) bar)) - bar)) - -(set-dispatch-macro-character #\[ #\| - #'read-bar-v3 - *gsharp-readtable-v3*) - (defmethod nb-elements ((bar bar)) (length (elements bar))) @@ -465,6 +489,59 @@ (setf elements (delete element elements :test #'eq))) (setf bar nil))) +(defclass melody-bar (bar) ()) + +(defmethod print-object ((b melody-bar) stream) + (format stream "[| :elements ~W ] " (elements b))) + +(defun make-melody-bar () + (make-instance 'melody-bar)) + +(defun read-melody-bar-v2 (stream char n) + (declare (ignore char n)) + (let* ((elements (read stream nil nil t)) + (bar (make-instance 'melody-bar :elements elements))) + (loop for element in elements do + (setf (slot-value element 'bar) bar)) + (skip-until-close-bracket stream) + bar)) + +(set-dispatch-macro-character #\[ #\| + #'read-melody-bar-v2 + *gsharp-readtable-v2*) + +(defun read-melody-bar-v3 (stream char n) + (declare (ignore char n)) + (let* ((rest (read-delimited-list #\] stream t)) + (bar (apply #'make-instance 'melody-bar rest))) + (loop for element in (elements bar) do + (setf (slot-value element 'bar) bar)) + bar)) + +(set-dispatch-macro-character #\[ #\| + #'read-melody-bar-v3 + *gsharp-readtable-v3*) + +(defclass lyrics-bar (bar) ()) + +(defmethod print-object ((b lyrics-bar) stream) + (format stream "[C :elements ~W ] " (elements b))) + +(defun make-lyrics-bar () + (make-instance 'lyrics-bar)) + +(defun read-lyrics-bar-v3 (stream char n) + (declare (ignore char n)) + (let* ((rest (read-delimited-list #\] stream t)) + (bar (apply #'make-instance 'lyrics-bar rest))) + (loop for element in (elements bar) do + (setf (slot-value element 'bar) bar)) + bar)) + +(set-dispatch-macro-character #\[ #\C + #'read-lyrics-bar-v3 + *gsharp-readtable-v3*) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Slice @@ -497,11 +574,6 @@ (defun make-empty-slice () (make-instance 'slice)) -(defun make-initialized-slice () - (let ((slice (make-empty-slice))) - (add-bar (make-bar) slice 0) - slice)) - (defun read-slice-v2 (stream char n) (declare (ignore char n)) (let* ((bars (read stream nil nil t)) @@ -552,14 +624,24 @@ (declare (ignore condition)) (format stream "Attempt to delete a bar not in a slice")))) -(defmethod remove-bar ((bar bar)) +(defmethod remove-bar ((bar melody-bar)) (with-slots (slice) bar (assert slice () 'bar-not-in-slice) (with-slots (bars) slice (setf bars (delete bar bars :test #'eq)) (unless bars ;; make sure there is one bar left - (add-bar (make-bar) slice 0))) + (add-bar (make-instance 'melody-bar) slice 0))) + (setf slice nil))) + +(defmethod remove-bar ((bar lyrics-bar)) + (with-slots (slice) bar + (assert slice () 'bar-not-in-slice) + (with-slots (bars) slice + (setf bars (delete bar bars :test #'eq)) + (unless bars + ;; make sure there is one bar left + (add-bar (make-instance 'lyrics-bar) slice 0))) (setf slice nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -592,34 +674,46 @@ (defgeneric tail (layer)) (defclass layer () - ((segment :initform nil :initarg :segment :reader segment) - (staves :initform '() :initarg :staves :accessor staves) + ((name :initform "default layer" :initarg :name :accessor name) + (segment :initform nil :initarg :segment :reader segment) + (staves :initarg :staves :accessor staves) (head :initarg :head :accessor head) (body :initarg :body :accessor body) (tail :initarg :tail :accessor tail))) -(defmethod print-object ((l layer) stream) - (with-slots (head body tail staves) l - (format stream "[_ :staves ~W :head ~W :body ~W :tail ~W ] " - staves head body tail))) - -(defun make-initialized-layer () - (let* ((head (make-initialized-slice)) - (body (make-initialized-slice)) - (tail (make-initialized-slice)) - (result (make-instance 'layer :head head :body body :tail tail))) - (setf (slot-value head 'layer) result - (slot-value body 'layer) result - (slot-value tail 'layer) result) - result)) +;;; melody layer + +(defclass melody-layer (layer) ()) + +(defmethod make-layer (name (initial-staff fiveline-staff)) + (flet ((make-initialized-slice () + (let ((slice (make-empty-slice))) + (add-bar (make-instance 'melody-bar) slice 0) + slice))) + (let* ((head (make-initialized-slice)) + (body (make-initialized-slice)) + (tail (make-initialized-slice)) + (result (make-instance 'melody-layer + :name name :staves (list initial-staff) + :head head :body body :tail tail))) + (setf (slot-value head 'layer) result + (slot-value body 'layer) result + (slot-value tail 'layer) result) + result))) + +(defmethod print-object ((l melody-layer) stream) + (with-slots (head body tail name staves) l + (format stream "[_ :name ~W :staves ~W :head ~W :body ~W :tail ~W ] " + name staves head body tail))) -(defun read-layer-v2 (stream char n) +(defun read-melody-layer-v2 (stream char n) (declare (ignore char n)) (let* ((staves (read stream nil nil t)) (head (read stream nil nil t)) (body (read stream nil nil t)) (tail (read stream nil nil t)) - (layer (make-instance 'layer :staves staves :head head :body body :tail tail))) + (layer (make-instance 'melody-layer + :staves staves :head head :body body :tail tail))) (setf (slot-value head 'layer) layer (slot-value body 'layer) layer (slot-value tail 'layer) layer) @@ -627,20 +721,58 @@ layer)) (set-dispatch-macro-character #\[ #\_ - #'read-layer-v2 + #'read-melody-layer-v2 *gsharp-readtable-v2*) -(defun read-layer-v3 (stream char n) +(defun read-melody-layer-v3 (stream char n) (declare (ignore char n)) (let* ((rest (read-delimited-list #\] stream t)) - (layer (apply #'make-instance 'layer rest))) + (layer (apply #'make-instance 'melody-layer rest))) (setf (slot-value (head layer) 'layer) layer (slot-value (body layer) 'layer) layer (slot-value (tail layer) 'layer) layer) layer)) (set-dispatch-macro-character #\[ #\_ - #'read-layer-v3 + #'read-melody-layer-v3 + *gsharp-readtable-v3*) + +;;; lyrics layer + +(defclass lyrics-layer (layer) ()) + +(defmethod make-layer (name (initial-staff lyrics-staff)) + (flet ((make-initialized-slice () + (let ((slice (make-empty-slice))) + (add-bar (make-instance 'lyrics-bar) slice 0) + slice))) + (let* ((head (make-initialized-slice)) + (body (make-initialized-slice)) + (tail (make-initialized-slice)) + (result (make-instance 'lyrics-layer + :name name :staves (list initial-staff) + :head head :body body :tail tail))) + (setf (slot-value head 'layer) result + (slot-value body 'layer) result + (slot-value tail 'layer) result) + result))) + +(defmethod print-object ((l lyrics-layer) stream) + (with-slots (head body tail name staves) l + (format stream "[M :name ~W :staves ~W :head ~W :body ~W :tail ~W ] " + name staves head body tail))) + +(defun read-lyrics-layer-v3 (stream char n) + (declare (ignore char n)) + (let* ((rest (read-delimited-list #\] stream t)) + (layer (apply #'make-instance 'lyrics-layer rest))) + (setf (slot-value (head layer) 'layer) layer + (slot-value (body layer) 'layer) layer + (slot-value (tail layer) 'layer) layer) + layer)) + +(set-dispatch-macro-character #\[ #\M + #'read-lyrics-layer-v3 *gsharp-readtable-v3*) (defmethod slices ((layer layer)) @@ -657,7 +789,7 @@ (:report (lambda (condition stream) (declare (ignore condition)) - (format stream "That staff already in the layer")))) + (format stream "That staff is already in the layer")))) (define-condition staff-not-in-layer (gsharp-condition) () (:report @@ -674,8 +806,7 @@ (defmethod add-staff-to-layer ((staff staff) (layer layer)) (assert (not (member staff (staves layer) :test #'eq)) () 'staff-already-in-layer) - (setf (staves layer) - (append (staves layer) (list staff)))) + (push staff (staves layer))) (defmethod remove-staff-from-layer ((staff staff) (layer layer)) (assert (not (null (staves layer))) @@ -708,11 +839,8 @@ ;;; and strictly less than the number of layers of the segment. (defgeneric layerno (segment position)) -;;; Add a layer to a segment. The new layer will be inserted before -;;; the element in the position indicated. Values of position must be -;;; greater than or equal to zero and less than or equal to the -;;; current number of segments of the layer. -(defgeneric add-layer (layer segment position)) +;;; Add a layer to a segment. +(defgeneric add-layer (layer segment)) ;;; Delete a layer from the segment to which it belongs (defgeneric remove-layer (layer)) @@ -727,9 +855,9 @@ (defun make-empty-segment () (make-instance 'segment)) -(defun make-initialized-segment () +(defun make-initialized-segment (staff) (let ((segment (make-empty-segment))) - (add-layer (make-initialized-layer) segment 0) + (add-layer (make-layer "Default layer" staff) segment) segment)) (defun read-segment-v2 (stream char n) @@ -769,11 +897,11 @@ (declare (ignore condition)) (format stream "Attempt to add a layer already in a segment")))) -(defmethod add-layer ((layer layer) (seg segment) position) +(defmethod add-layer ((layer layer) (seg segment)) (with-slots (segment) layer (assert (not segment) () 'layer-already-in-a-segment) (with-slots (layers) seg - (setf layers (ninsert-element layer layers position))) + (push layer layers)) (setf segment seg))) (define-condition layer-not-in-segment (gsharp-condition) () @@ -789,7 +917,8 @@ (setf layers (delete layer layers :test #'eq)) ;; make sure there is one layer left (unless layers - (add-layer (make-initialized-layer) segment 0))) + (add-layer (make-layer "Default layer" (car (staves (buffer segment)))) + segment))) (setf segment nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -832,7 +961,8 @@ (defclass buffer () ((segments :initform '() :initarg :segments :accessor segments) - (staves :initform (list (make-fiveline-staff "default")) :initarg :staves :accessor staves) + (staves :initform (list (make-fiveline-staff "default staff")) + :initarg :staves :accessor staves) (min-width :initform *default-min-width* :initarg :min-width :accessor min-width) (spacing-style :initform *default-spacing-style* :initarg :spacing-style :accessor spacing-style) (right-edge :initform *default-right-edge* :initarg :right-edge :accessor right-edge) @@ -849,7 +979,7 @@ (defun make-initialized-buffer () (let ((buffer (make-empty-buffer))) - (add-segment (make-initialized-segment) buffer 0) + (add-segment (make-initialized-segment (car (staves buffer))) buffer 0) buffer)) (defun read-buffer-v2 (stream char n) @@ -912,7 +1042,7 @@ (setf segments (delete segment segments :test #'eq)) ;; make sure there is one segment left (unless segments - (add-segment (make-initialized-segment) buffer 0))) + (add-segment (make-initialized-segment (car (staves buffer))) buffer 0))) (setf buffer nil))) (define-condition staff-already-in-buffer (gsharp-condition) () Index: gsharp/cursor.lisp diff -u gsharp/cursor.lisp:1.1.1.1 gsharp/cursor.lisp:1.2 --- gsharp/cursor.lisp:1.1.1.1 Mon Feb 16 07:46:11 2004 +++ gsharp/cursor.lisp Fri Jul 23 09:51:16 2004 @@ -198,6 +198,9 @@ ;;; ;;; Slice +(defmethod slice ((cursor gsharp-cursor)) + (slice (bar cursor))) + (defgeneric first-slice-p (cursor)) (defgeneric last-slice-p (cursor)) @@ -316,43 +319,17 @@ ;;; ;;; Layer -(defgeneric next-layer (cursor)) +(defmethod layer ((cursor gsharp-cursor)) + (layer (slice cursor))) -(defgeneric previous-layer (cursor)) - -(defmethod next-layer ((cursor gsharp-cursor)) - (let* ((oldbar (bar cursor)) - (oldbarno (number oldbar)) - (oldslice (slice oldbar)) - (oldsliceno (number oldslice)) - (oldlayer (layer oldslice)) - (oldlayerno (number oldlayer)) - (segment (segment oldlayer)) - (nb-layers (nb-layers segment)) - (newlayerno (if (= oldlayerno (1- nb-layers)) - 0 - (1+ oldlayerno))) - (newlayer (layerno segment newlayerno)) - (newslice (sliceno newlayer oldsliceno)) - (newbarno (min (1- (nb-bars newslice)) oldbarno)) - (newbar (barno newslice newbarno))) - (unset-cursor cursor) - (set-cursor cursor newbar 0))) +(defgeneric select-layer (cursor new-layer)) -(defmethod previous-layer ((cursor gsharp-cursor)) +(defmethod select-layer ((cursor gsharp-cursor) (new-layer layer)) (let* ((oldbar (bar cursor)) (oldbarno (number oldbar)) (oldslice (slice oldbar)) (oldsliceno (number oldslice)) - (oldlayer (layer oldslice)) - (oldlayerno (number oldlayer)) - (segment (segment oldlayer)) - (nb-layers (nb-layers segment)) - (newlayerno (if (zerop oldlayerno) - (1- nb-layers) - (1- oldlayerno))) - (newlayer (layerno segment newlayerno)) - (newslice (sliceno newlayer oldsliceno)) + (newslice (sliceno new-layer oldsliceno)) (newbarno (min (1- (nb-bars newslice)) oldbarno)) (newbar (barno newslice newbarno))) (unset-cursor cursor) @@ -368,9 +345,8 @@ ;;; ;;; Segment -(defgeneric insert-layer-before (layer cursor)) - -(defgeneric insert-layer-after (layer cursor)) +(defmethod segment ((cursor gsharp-cursor)) + (segment (layer cursor))) (defgeneric delete-layer (cursor)) @@ -398,14 +374,6 @@ (1- layerno)))) (mapc #'set-cursor cursors)))) -(defmethod insert-layer-before ((layer layer) (cursor gsharp-cursor)) - (let ((cursor-layer (cursor-layer cursor))) - (add-layer layer (segment cursor-layer) (number cursor-layer)))) - -(defmethod insert-layer-after ((layer layer) (cursor gsharp-cursor)) - (let ((cursor-layer (cursor-layer cursor))) - (add-layer layer (segment cursor-layer) (1+ (number cursor-layer))))) - (defmethod delete-layer ((cursor gsharp-cursor)) (remove-layer (cursor-layer cursor))) @@ -415,6 +383,9 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Buffer + +(defmethod buffer ((cursor gsharp-cursor)) + (buffer (segment cursor))) (defgeneric first-segment-p (cursor)) Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.6 gsharp/drawing.lisp:1.7 --- gsharp/drawing.lisp:1.6 Wed Jul 21 05:42:59 2004 +++ gsharp/drawing.lisp Fri Jul 23 09:51:16 2004 @@ -14,10 +14,14 @@ (format stream "[~a clef on staff step ~a]" (name object) (lineno object))) (define-presentation-method present - (object (type score-pane:staff) stream (view textual-view) &key) - (format stream "[staff ~a]" (name object))) + (object (type score-pane:fiveline-staff) stream (view textual-view) &key) + (format stream "[fiveline staff ~a]" (name object))) -(defmethod draw-staff-and-clef (pane (staff staff) x1 x2) +(define-presentation-method present + (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) (when (clef staff) (present (clef staff) `((score-pane:clef) @@ -44,7 +48,13 @@ while (eq (aref (keysig staff) pitch) :sharp) do (score-pane:draw-accidental pane :sharp x (+ line yoffset))))) (present staff - `((score-pane:staff) + `((score-pane:fiveline-staff) + :x1 ,x1 :x2 ,x2) + :stream pane)) + +(defmethod draw-staff-and-clef (pane (staff lyrics-staff) x1 x2) + (present staff + `((score-pane:lyrics-staff) :x1 ,x1 :x2 ,x2) :stream pane)) @@ -115,10 +125,16 @@ (let* ((staves (staves buffer)) (timesig-offset (max (* (score-pane:staff-step 2) (loop for staff in staves - maximize (count :flat (keysig staff)))) + maximize + (if (typep staff 'fiveline-staff) + (count :flat (keysig staff)) + 0))) (* (score-pane:staff-step 2.5) (loop for staff in staves - maximize (count :sharp (keysig staff)))))) + maximize + (if (typep staff 'fiveline-staff) + (count :sharp (keysig staff)) + 0))))) (method (let ((old-method (buffer-cost-method buffer))) (make-measure-cost-method (min-width old-method) (spacing-style old-method) @@ -146,7 +162,7 @@ (decf yy 90)))) buffer))))) -(define-added-mixin velement () element +(define-added-mixin velement () melody-element ((final-stem-direction :accessor final-stem-direction) (final-stem-position :accessor final-stem-position) (final-stem-yoffset :initform 0 :accessor final-stem-yoffset) @@ -156,6 +172,9 @@ (max-yoffset :accessor element-max-yoffset) (xpos :accessor element-xpos))) +(define-added-mixin welement () lyrics-element + ((xpos :accessor element-xpos))) + (defun compute-maxpos-minpos (element) (if (and (typep element 'cluster) (notes element)) (let ((max-note (reduce (lambda (n1 n2) @@ -350,7 +369,7 @@ (defun draw-cursor (pane x) (draw-line* pane x (score-pane:staff-step -4) x (score-pane:staff-step 12) :ink +red+)) -(defmethod draw-bar (pane (bar bar) x width time-alist draw-cursor) +(defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) (let ((elements (elements bar)) (group '())) @@ -374,6 +393,22 @@ (when (eq (cursor-element *cursor*) element) (funcall draw-cursor (/ (+ xx (element-xpos element)) 2)))))))) +(defmethod draw-bar (pane (bar lyrics-bar) x 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 (element-xpos element))) + (when (eq (cursor-bar *cursor*) bar) + (if (null (cursor-element *cursor*)) + (funcall draw-cursor (/ (+ (if (null elements) + x + (element-xpos (car (last elements)))) + x width) 2)) + (loop for element in elements + and xx = x then (element-xpos element) do + (when (eq (cursor-element *cursor*) element) + (funcall draw-cursor (/ (+ xx (element-xpos element)) 2)))))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Cluster @@ -600,3 +635,12 @@ (score-pane:draw-rest pane (notehead-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)) + (declare (ignore flags)) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) + (draw-text* pane (map 'string #'unicode-to-char (text element)) + x 0 :align-x :center))) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.14 gsharp/gui.lisp:1.15 --- gsharp/gui.lisp:1.14 Wed Jul 21 07:45:43 2004 +++ gsharp/gui.lisp Fri Jul 23 09:51:16 2004 @@ -7,118 +7,47 @@ (bar (barno slice 0))) (make-cursor bar 0))) -(defparameter *global-command-table* (make-hash-table :test #'equal)) -(defparameter *x-command-table* (make-hash-table :test #'equal)) -(defparameter *i-command-table* (make-hash-table :test #'equal)) -(defparameter *ix-command-table* (make-hash-table :test #'equal)) -(defparameter *c-x-command-table* (make-hash-table :test #'equal)) -(defparameter *commands* *global-command-table*) - -(defun add-command (gesture command table) - (setf (gethash (list (car gesture) (apply #'make-modifier-state (cdr gesture))) - table) - command)) - -;;; global command table - -(add-command '(#\L :shift) 'com-lower *global-command-table*) -(add-command '(#\H :shift) 'com-higher *global-command-table*) -(add-command '(#\f :control) 'com-forward-element *global-command-table*) -(add-command '(#\b :control) 'com-backward-element *global-command-table*) -(add-command '(#\d :control) 'com-delete-element *global-command-table*) -(add-command '(#\h :control) 'com-erase-element *global-command-table*) -(add-command '(#\c) 'com-insert-note-c *global-command-table*) -(add-command '(#\d) 'com-insert-note-d *global-command-table*) -(add-command '(#\e) 'com-insert-note-e *global-command-table*) -(add-command '(#\f) 'com-insert-note-f *global-command-table*) -(add-command '(#\g) 'com-insert-note-g *global-command-table*) -(add-command '(#\a) 'com-insert-note-a *global-command-table*) -(add-command '(#\b) 'com-insert-note-b *global-command-table*) -(add-command '(#\,) 'com-insert-rest *global-command-table*) -(add-command '(#\Space) 'com-insert-empty-cluster *global-command-table*) -(add-command '(#\C :shift) 'com-add-note-c *global-command-table*) -(add-command '(#\D :shift) 'com-add-note-d *global-command-table*) -(add-command '(#\E :shift) 'com-add-note-e *global-command-table*) -(add-command '(#\F :shift) 'com-add-note-f *global-command-table*) -(add-command '(#\G :shift) 'com-add-note-g *global-command-table*) -(add-command '(#\A :shift) 'com-add-note-a *global-command-table*) -(add-command '(#\B :shift) 'com-add-note-b *global-command-table*) -(add-command '(#\h :meta) 'com-rotate-notehead *global-command-table*) -(add-command '(#\s :meta) 'com-rotate-stem-direction *global-command-table*) -(add-command '(#\p) 'com-current-increment *global-command-table*) -(add-command '(#\n) 'com-current-decrement *Global-command-table*) -(add-command '(#\| :shift) 'com-insert-measure-bar *global-command-table*) -(add-command '(#\.) 'com-more-dots *global-command-table*) -(add-command '(#\[) 'com-more-lbeams *global-command-table*) -(add-command '(#\]) 'com-more-rbeams *global-command-table*) -(add-command '(#\#) 'com-sharper *global-command-table*) -(add-command '(#\# :shift) 'com-sharper *global-command-table*) -(add-command '(#\@ :shift) 'com-flatter *global-command-table*) -(add-command '(#\# :meta) 'com-more-sharps *global-command-table*) -(add-command '(#\# :meta :shift) 'com-more-sharps *global-command-table*) -(add-command '(#\@ :meta :shift) 'com-more-flats *global-command-table*) -(add-command '(#\u :meta) 'com-up *global-command-table*) -(add-command '(#\d :meta) 'com-down *global-command-table*) -(add-command '(#\l :meta) 'com-left *global-command-table*) -(add-command '(#\r :meta) 'com-right *global-command-table*) -(add-command '(#\p :meta) 'com-previous-layer *global-command-table*) -(add-command '(#\n :meta) 'com-next-layer *global-command-table*) -(add-command '(#\x) *x-command-table* *global-command-table*) -(add-command '(#\i) *i-command-table* *global-command-table*) -(add-command '(#\x :control) *c-x-command-table* *global-command-table*) - -;;; i command table -(add-command '(#\.) 'com-istate-more-dots *i-command-table*) -(add-command '(#\[) 'com-istate-more-lbeams *i-command-table*) -(add-command '(#\]) 'com-istate-more-rbeams *i-command-table*) -(add-command '(#\h) 'com-istate-rotate-notehead *i-command-table*) -(add-command '(#\s) 'com-istate-rotate-stem-direction *i-command-table*) -(add-command '(#\x) *ix-command-table* *i-command-table*) - -;;; ix command table -(add-command '(#\.) 'com-istate-fewer-dots *ix-command-table*) -(add-command '(#\[) 'com-istate-fewer-lbeams *ix-command-table*) -(add-command '(#\]) 'com-istate-fewer-rbeams *ix-command-table*) - -;;; x-command-table -(add-command '(#\.) 'com-fewer-dots *x-command-table*) -(add-command '(#\[) 'com-fewer-lbeams *x-command-table*) -(add-command '(#\]) 'com-fewer-rbeams *x-command-table*) - -;;; c-x-command-table -(add-command '(#\( :shift) 'com-start-kbd-macro *c-x-command-table*) -(add-command '(#\() 'com-start-kbd-macro *c-x-command-table*) -(add-command '(#\) :shift) 'com-end-kbd-macro *c-x-command-table*) -(add-command '(#\)) 'com-end-kbd-macro *c-x-command-table*) -(add-command '(#\e) 'com-call-last-kbd-macro *c-x-command-table*) - -(defmethod redisplay-gsharp-panes (frame &key force-p) - (loop for pane in (frame-current-panes frame) - do (when (typep pane 'score-pane:score-pane) - (redisplay-frame-pane frame pane :force-p force-p)))) - (defvar *gsharp-frame*) (defparameter *kbd-macro-recording-p* nil) (defparameter *kbd-macro-funs* '()) +(defparameter *accumulated-keys* '()) +(defparameter *modes* (list *global-mode-table*)) +(defparameter *last-character* nil) + (defmethod dispatch-event :around ((pane score-pane:score-pane) (event key-press-event)) (when (keyboard-event-character event) - (let* ((key (list (keyboard-event-character event) - (event-modifier-state event))) - (command (gethash key *commands*))) - (cond ((hash-table-p command) (setf *commands* command)) - ((fboundp command) - (when *kbd-macro-recording-p* (push command *kbd-macro-funs*)) - (handler-case (funcall command) - (gsharp-condition (condition) (format *error-output* "~a~%" condition))) - (setf *commands* *global-command-table*)) - (t (format *error-output* "no command for ~a~%" key) - (setf *commands* *global-command-table*) - (when *kbd-macro-recording-p* (setf *kbd-macro-funs* '() - *kbd-macro-recording-p* nil)))) + (let ((key (list (keyboard-event-character event) + (event-modifier-state event)))) + (setf *accumulated-keys* (append *accumulated-keys* (list key))) + (setf *last-character* (char-to-unicode (car key))) + (let (dico) + (cond ((and (setf dico (find t *modes* + :key (lambda (x) + (multiple-value-bind (value exists-p prefix-p) + (dico-object x *accumulated-keys*) + (declare (ignore value prefix-p)) + exists-p)))) + (fboundp (dico-object dico *accumulated-keys*))) + (let ((command (dico-object dico *accumulated-keys*))) + (when *kbd-macro-recording-p* (push command *kbd-macro-funs*)) + (handler-case (funcall command) + (gsharp-condition (condition) (format *error-output* "~a~%" condition)))) + (setf *accumulated-keys* '())) + ((setf dico (find-if (lambda (x) + (multiple-value-bind (value exists-p prefix-p) + (dico-object x *accumulated-keys*) + (declare (ignore value exists-p)) + prefix-p)) + *modes*)) + nil) + (t (format *error-output* "no command for ~a~%" *accumulated-keys*) + (setf *accumulated-keys* '()) + (when *kbd-macro-recording-p* (setf *kbd-macro-funs* '() + *kbd-macro-recording-p* nil))))) (redisplay-frame-panes *gsharp-frame*)))) - + (define-application-frame gsharp () ((buffer :initarg :buffer :accessor buffer) (cursor :initarg :cursor :accessor cursor) @@ -201,24 +130,33 @@ (defun draw-the-cursor (pane x) (let* ((state (input-state *gsharp-frame*)) - (staff (staff state)) - (yoffset (gsharp-drawing::staff-yoffset staff)) - (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+))) + (staff (car (staves (layer (cursor *gsharp-frame*))))) + (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))) @@ -288,6 +226,7 @@ ("Slice" :menu slice-command-table) ("Measure" :menu measure-command-table) ("Modes" :menu modes-command-table) + ("Staves" :menu staves-command-table) ("Play" :menu play-command-table))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -306,7 +245,7 @@ (let* ((buffer (make-initialized-buffer)) (cursor (make-initial-cursor buffer)) (staff (car (staves buffer))) - (input-state (make-input-state staff))) + (input-state (make-input-state))) (setf (buffer *gsharp-frame*) buffer (cursor *gsharp-frame*) cursor (input-state *gsharp-frame*) input-state @@ -344,8 +283,7 @@ :prompt "File Name") (simple-parse-error () (error 'file-not-found)))) (buffer (read-everything filename)) - (staff (car (staves buffer))) - (input-state (make-input-state staff)) + (input-state (make-input-state)) (cursor (make-initial-cursor buffer))) (setf (buffer *gsharp-frame*) buffer (input-state *gsharp-frame*) input-state @@ -398,12 +336,14 @@ (define-gsharp-command (com-insert-segment-before :name t) () (let ((cursor (cursor *gsharp-frame*))) - (insert-segment-before (make-initialized-segment) cursor) + (insert-segment-before (make-initialized-segment (car (staves (buffer *gsharp-frame*)))) + cursor) (backward-segment cursor))) (define-gsharp-command (com-insert-segment-after :name t) () (let ((cursor (cursor *gsharp-frame*))) - (insert-segment-after (make-initialized-segment) cursor) + (insert-segment-after (make-initialized-segment (car (staves (buffer *gsharp-frame*)))) + cursor) (forward-segment cursor))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -413,50 +353,64 @@ (make-command-table 'layer-command-table :errorp nil - :menu '(("Next" :command com-next-layer) - ("Previous" :command com-previous-layer) - ("Delete Current" :command com-delete-layer) - ("Insert After Current" :command com-insert-layer-after) - ("Insert Before Current" :command com-insert-layer-before))) - -(define-gsharp-command (com-next-layer :name t) () - (next-layer (cursor *gsharp-frame*)) - (setf (staff (input-state *gsharp-frame*)) - (car (staves (layer (slice (bar (cursor *gsharp-frame*)))))))) - -(define-gsharp-command (com-previous-layer :name t) () - (previous-layer (cursor *gsharp-frame*)) - (setf (staff (input-state *gsharp-frame*)) - (car (staves (layer (slice (bar (cursor *gsharp-frame*)))))))) + :menu '(("Select" :command com-select-layer) + ("Rename" :command com-rename-layer) + ("New" :command com-add-layer) + ("Delete" :command com-delete-layer))) +(define-condition layer-name-not-unique (gsharp-condition) () + (:report + (lambda (condition stream) + (declare (ignore condition)) + (format stream "Layer name already exists")))) -(define-gsharp-command (com-delete-layer :name t) () - (delete-layer (cursor *gsharp-frame*))) +(defun acquire-unique-layer-name (prompt) + (let ((name (accept 'string :prompt prompt))) + (assert (not (member name (layers (segment (cursor *gsharp-frame*))) + :test #'string= :key #'name)) + () `layer-name-not-unique) + name)) -(define-gsharp-command (com-insert-layer-before :name t) ((staff-name 'string :prompt "Staff")) - (let ((cursor (cursor *gsharp-frame*)) - (staff (find-staff staff-name (buffer *gsharp-frame*)))) - (if (not staff) - (message "No such staff in buffer~%") - (progn (insert-layer-before (make-initialized-layer) cursor) - (previous-layer cursor) - (let ((layer (layer (slice (bar (cursor *gsharp-frame*)))))) - (add-staff-to-layer staff layer) - (setf (staff (input-state *gsharp-frame*)) - staff)))))) +(define-condition no-such-layer (gsharp-condition) () + (:report + (lambda (condition stream) + (declare (ignore condition)) + (format stream "No such layer")))) -(define-gsharp-command (com-insert-layer-after :name t) () - (let ((cursor (cursor *gsharp-frame*)) - (staff (accept 'score-pane:staff :prompt "Staff"))) -;;; (staff (find-staff staff-name (buffer *gsharp-frame*)))) - (if (not staff) - (message "No such staff in buffer~%") - (progn (insert-layer-after (make-initialized-layer) cursor) - (next-layer cursor) - (let ((layer (layer (slice (bar (cursor *gsharp-frame*)))))) - (add-staff-to-layer staff layer) - (setf (staff (input-state *gsharp-frame*)) - staff)))))) +(define-presentation-method accept + ((type layer) stream (view textual-view) &key) + (multiple-value-bind (layer success string) + (handler-case (complete-input stream + (lambda (so-far mode) + (complete-from-possibilities + so-far + (layers (segment (cursor *gsharp-frame*))) + '() + :action mode + :predicate (lambda (obj) (declare (ignore obj)) t) + :name-key #'name + :value-key #'identity))) + (simple-parse-error () (error 'no-such-layer))) + (declare (ignore string)) + (if success layer (error 'no-such-layer)))) + +(define-gsharp-command (com-select-layer :name t) () + (let ((selected-layer (accept 'layer :prompt "Select layer"))) + (select-layer (cursor *gsharp-frame*) selected-layer))) + +(define-gsharp-command (com-rename-layer :name t) () + (setf (name (accept 'layer :prompt "Rename layer")) + (acquire-unique-layer-name "New name of layer"))) + +(define-gsharp-command (com-add-layer :name t) () + (let* ((name (acquire-unique-layer-name "Name of new layer")) + (staff (accept 'score-pane:staff :prompt "Initial staff of new layer")) + (new-layer (make-layer name staff))) + (add-layer new-layer (segment (cursor *gsharp-frame*))) + (select-layer (cursor *gsharp-frame*) new-layer))) + +(define-gsharp-command (com-delete-layer :name t) () + (delete-layer (cursor *gsharp-frame*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -514,6 +468,20 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; staves menu + +(make-command-table + 'staves-command-table + :errorp nil + :menu '(("Rotate" :command com-rotate-staves))) + +(define-gsharp-command (com-rotate-staves :name t) () + (let ((layer (layer (cursor *gsharp-frame*)))) + (setf (staves layer) + (append (cdr (staves layer)) (list (car (staves layer))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; play menu (make-command-table @@ -588,7 +556,7 @@ (error "write compatibility layer for RUN-PROGRAM"))) (define-gsharp-command (com-play-layer :name t) () - (let* ((slice (body (layer (slice (bar (cursor *gsharp-frame*)))))) + (let* ((slice (body (layer (cursor *gsharp-frame*)))) (durations (measure-durations (list slice))) (tracks (list (track-from-slice slice 0 durations))) (midifile (make-instance 'midifile @@ -609,7 +577,7 @@ (setq climi::*all-ports* nil) (let* ((buffer (make-initialized-buffer)) (staff (car (staves buffer))) - (input-state (make-input-state staff)) + (input-state (make-input-state)) (cursor (make-initial-cursor buffer))) (setf *gsharp-frame* (make-application-frame 'gsharp :buffer buffer @@ -639,11 +607,11 @@ (defun insert-note (pitch cluster) (let* ((state (input-state *gsharp-frame*)) + (staff (car (staves (layer (slice (bar cluster)))))) (note (make-note pitch - (staff state) + staff (notehead state) - (aref (keysig (staff state)) (mod pitch 7)) -;;; (accidentals state) + (aref (keysig staff) (mod pitch 7)) (dots state)))) (setf *current-cluster* cluster *current-note* note) @@ -690,7 +658,7 @@ (if (eq (notehead state) :filled) (lbeams state) 0) (dots state) (notehead state) - (staff (input-state *gsharp-frame*))))) + (car (staves (layer (cursor *gsharp-frame*))))))) (insert-element rest cursor) (forward-element cursor) rest)) @@ -972,10 +940,11 @@ (:up :down) (:down :auto)))) -(define-gsharp-command (com-set-clef :name t) ((name '(member :treble :bass :c)) - (line '(or integer null) :prompt "Line")) - (setf (clef (staff (input-state *gsharp-frame*))) - (make-clef name line))) +(define-gsharp-command (com-set-clef :name t) () + (let ((staff (accept 'score-pane:fiveline-staff :prompt "Set clef of staff")) + (type (accept 'clef-type :prompt "Type of clef")) + (line (accept 'integer :prompt "Line of clef"))) + (setf (clef staff) (make-clef type line)))) (define-gsharp-command com-higher () (incf (last-note (input-state *gsharp-frame*)) 7)) @@ -989,7 +958,7 @@ (loop until (end-of-bar-p cursor) do (push (cursor-element cursor) elements) do (delete-element cursor)) - (insert-bar-after (make-bar) cursor) + (insert-bar-after (make-instance (class-of (bar cursor))) cursor) (forward-bar cursor) (loop for element in elements do (insert-element element cursor)))) @@ -1022,7 +991,7 @@ (if success staff (error 'no-such-staff)))) (define-presentation-method accept - ((type fiveline-staff) stream (view textual-view) &key) + ((type score-pane:fiveline-staff) stream (view textual-view) &key) (multiple-value-bind (staff success string) (handler-case (complete-input stream (lambda (so-far mode) @@ -1056,7 +1025,7 @@ (lambda (so-far mode) (complete-from-possibilities so-far - '(:fiveline) + '(:fiveline :lyrics) '() :action mode :predicate (lambda (obj) (declare (ignore obj)) t) @@ -1093,26 +1062,27 @@ (declare (ignore condition)) (format stream "Staff name already exists")))) -(defun acquire-unique-staff-name () - (let ((name (accept 'string :prompt "Staff name"))) +(defun acquire-unique-staff-name (prompt) + (let ((name (accept 'string :prompt prompt))) (assert (not (member name (staves (buffer *gsharp-frame*)) :test #'string= :key #'name)) () `staff-name-not-unique) name)) (defun acquire-new-staff () - (let ((name (acquire-unique-staff-name))) + (let ((name (acquire-unique-staff-name "Name of new staff"))) (ecase (accept 'staff-type :prompt "Type") - (:fiveline (let ((clef (accept 'clef-type :prompt "Clef")) - (line (accept 'integer :prompt "Line"))) - (make-fiveline-staff name (make-clef clef line))))))) + (:fiveline (let ((clef (accept 'clef-type :prompt "Clef type of new staff")) + (line (accept 'integer :prompt "Line of clef"))) + (make-fiveline-staff name (make-clef clef line)))) + (:lyrics (make-lyrics-staff name))))) -(define-gsharp-command (com-add-staff-before :name t) () - (add-staff-before-staff (accept 'score-pane:staff :prompt "Before staff") +(define-gsharp-command (com-insert-staff-before :name t) () + (add-staff-before-staff (accept 'score-pane:staff :prompt "Insert staff before staff") (acquire-new-staff) (buffer *gsharp-frame*))) -(define-gsharp-command (com-add-staff-after :name t) () - (add-staff-after-staff (accept 'score-pane:staff :prompt "After staff") +(define-gsharp-command (com-insert-staff-after :name t) () + (add-staff-after-staff (accept 'score-pane:staff :prompt "Insert staff after staff") (acquire-new-staff) (buffer *gsharp-frame*))) @@ -1121,23 +1091,24 @@ (buffer *gsharp-frame*))) (define-gsharp-command (com-rename-staff :name t) () - (let* ((staff (accept 'score-pane:staff :prompt "Staff")) - (name (acquire-unique-staff-name)) + (let* ((staff (accept 'score-pane:staff :prompt "Rename staff")) + (name (acquire-unique-staff-name "New name of staff")) (buffer (buffer *gsharp-frame*))) (rename-staff name staff buffer))) -(define-gsharp-command (com-add-layer-staff :name t) () - (let ((staff (accept 'score-pane:staff :prompt "Staff")) - (layer (layer (slice (bar (cursor *gsharp-frame*)))))) +(define-gsharp-command (com-add-staff-to-layer :name t) () + (let ((staff (accept 'score-pane:staff :prompt "Add staff to layer")) + (layer (layer (cursor *gsharp-frame*)))) (add-staff-to-layer staff layer))) -(define-gsharp-command (com-delete-layer-staff :name t) ((name 'string)) - (let ((staff (find-staff name (buffer *gsharp-frame*))) - (layer (layer (slice (bar (cursor *gsharp-frame*)))))) +;;; FIXME restrict to staves that are actually in the layer. +(define-gsharp-command (com-delete-staff-from-layer :name t) () + (let ((staff (accept 'score-pane:staff :prompt "Add staff to layer")) + (layer (layer (cursor *gsharp-frame*)))) (remove-staff-from-layer staff layer))) (define-gsharp-command com-more-sharps () - (let ((keysig (keysig (staff (input-state *gsharp-frame*))))) + (let ((keysig (keysig (car (staves (layer (cursor *gsharp-frame*))))))) (cond ((eq (aref keysig 3) :flat) (setf (aref keysig 3) :natural)) ((eq (aref keysig 0) :flat) (setf (aref keysig 0) :natural)) ((eq (aref keysig 4) :flat) (setf (aref keysig 4) :natural)) @@ -1154,7 +1125,7 @@ ((eq (aref keysig 6) :natural) (setf (aref keysig 6) :sharp))))) (define-gsharp-command com-more-flats () - (let ((keysig (keysig (staff (input-state *gsharp-frame*))))) + (let ((keysig (keysig (car (staves (layer (cursor *gsharp-frame*))))))) (cond ((eq (aref keysig 6) :sharp) (setf (aref keysig 6) :natural)) ((eq (aref keysig 2) :sharp) (setf (aref keysig 2) :natural)) ((eq (aref keysig 5) :sharp) (setf (aref keysig 5) :natural)) Index: gsharp/input-state.lisp diff -u gsharp/input-state.lisp:1.1.1.1 gsharp/input-state.lisp:1.2 --- gsharp/input-state.lisp:1.1.1.1 Mon Feb 16 07:46:17 2004 +++ gsharp/input-state.lisp Fri Jul 23 09:51:16 2004 @@ -7,8 +7,7 @@ (notehead :initform :filled :accessor notehead) (stem-direction :initform :auto :accessor stem-direction) (last-note :initform 34 :accessor last-note) ; a B in the fourth octave - (accidentals :initform :natural :accessor accidentals) - (staff :initarg :staff :accessor staff))) + (accidentals :initform :natural :accessor accidentals))) -(defun make-input-state (staff) - (make-instance 'input-state :staff staff)) +(defun make-input-state () + (make-instance 'input-state)) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.2 gsharp/measure.lisp:1.3 --- gsharp/measure.lisp:1.2 Mon Feb 16 08:08:00 2004 +++ gsharp/measure.lisp Fri Jul 23 09:51:16 2004 @@ -154,8 +154,7 @@ (when (buffer segment) (mark-modified (buffer segment)))) -(defmethod add-layer :after ((layer layer) (segment rsegment) position) - (declare (ignore position)) +(defmethod add-layer :after ((layer layer) (segment rsegment)) (mark-modified segment)) (defmethod remove-layer :before ((layer rlayer)) Index: gsharp/numbering.lisp diff -u gsharp/numbering.lisp:1.1.1.1 gsharp/numbering.lisp:1.2 --- gsharp/numbering.lisp:1.1.1.1 Mon Feb 16 07:46:18 2004 +++ gsharp/numbering.lisp Fri Jul 23 09:51:16 2004 @@ -82,8 +82,7 @@ (defnclass nsegment segment ()) -(defmethod add-layer :after ((layer nlayer) (segment segment) position) - (declare (ignore position)) +(defmethod add-layer :after ((layer nlayer) (segment segment)) (number-elements (layers segment))) (defmethod remove-layer :around ((layer nlayer)) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.6 gsharp/packages.lisp:1.7 --- gsharp/packages.lisp:1.6 Wed Jul 21 05:43:00 2004 +++ gsharp/packages.lisp Fri Jul 23 09:51:16 2004 @@ -1,7 +1,13 @@ +(defpackage :sequence-dico + (:use :clim-lisp) + (:export #:sequence-dico #:standard-sequence-dico + #:make-sequence-dico #:dico-object)) + (defpackage :gsharp-utilities (:shadow built-in-class) (:use :clim-lisp :clim-mop) - (:export #:ninsert-element #:define-added-mixin)) + (:export #:ninsert-element #:define-added-mixin + #:unicode-to-char #:char-to-unicode)) (defpackage :gf (:use :common-lisp) @@ -36,18 +42,24 @@ (:use :common-lisp :gsharp-utilities) (:shadow #:rest) (:export #:clef #:make-clef #:name #:lineno - #:staff #:fiveline-staff #:make-fiveline-staff #:gsharp-condition - #:pitch #:accidentals #:dots #:cluster #:note + #:staff #:fiveline-staff #:make-fiveline-staff + #:lyrics-staff #:make-lyrics-staff + #:gsharp-condition + #:pitch #:accidentals #:dots #:note #:make-note #:note-less #:note-equal #:bar - #:notehead #:rbeams #:lbeams #:dots #:element #:notes + #:notehead #:rbeams #:lbeams #:dots #:element + #:melody-element #:notes #:add-note #:find-note #:remove-note #:cluster #:make-cluster - #:rest #:make-rest #:slice #:elements + #:rest #:make-rest #:lyrics-element + #:slice #:elements #:nb-elements #:elementno #:add-element - #:remove-element #:bar #:make-bar #:layer + #:remove-element #:bar #:make-bar + #:melody-bar #:lyrics-bar + #:layer #:bars #:nb-bars #:barno #:add-bar #:remove-bar - #:slice #:make-empty-slice #:make-initialized-slice + #:slice #:segment #:slices #:sliceno - #:head #:body #:tail #:make-initialized-layer #:buffer + #:head #:body #:tail #:make-layer #:buffer #:make-empty-buffer #:make-initialized-buffer #:layers #:nb-layers #:layerno #:add-layer #:remove-layer #:segment @@ -62,7 +74,7 @@ #:stem-direction #:stem-length #:notehead-duration #:element-duration #:clef #:keysig #:staff-pos #:xoffset #:read-everything #:save-buffer-to-stream #:line-width #:min-width #:spacing-style #:right-edge #:left-offset - #:left-margin + #:left-margin #:text )) (defpackage :gsharp-numbering @@ -122,7 +134,8 @@ (defpackage :score-pane (:use :clim :clim-extensions :clim-lisp :sdl) (:shadow #:rest) - (:export #:draw-staff #:draw-stem #:draw-right-stem #:draw-left-stem + (:export #:draw-fiveline-staff #:draw-lyrics-staff + #:draw-stem #:draw-right-stem #:draw-left-stem #:draw-ledger-line #:draw-bar-line #:draw-beam #:staff-step #:draw-notehead #:draw-accidental #:draw-clef #:draw-rest #:draw-dot #:draw-flags-up #:draw-flags-down @@ -130,7 +143,7 @@ #:with-staff-size #:with-notehead-right-offsets #:with-suspended-note-offset #:with-notehead-left-offsets #:with-light-glyphs #:score-pane - #:clef #:staff #:notehead)) + #:clef #:staff #:fiveline-staff #:lyrics-staff #:notehead)) (defpackage :gsharp-beaming (:use :common-lisp) @@ -150,8 +163,7 @@ #:forward-slice #:backward-slice #:head-slice #:body-slice #:tail-slice #:in-last-slice #:in-first-slice - #:next-layer #:previous-layer - #:insert-layer-before #:insert-layer-after #:delete-layer + #:select-layer #:delete-layer #:forward-segment #:backward-segment #:insert-segment-before #:insert-segment-after #:delete-segment @@ -184,9 +196,9 @@ #:unknown-event #:status #:data-byte)) (defpackage :gsharp - (:use :clim :clim-lisp + (:use :clim :clim-lisp :gsharp-utilities :gsharp-buffer :gsharp-cursor :gsharp-drawing :gsharp-numbering - :gsharp-measure :sdl :midi) + :gsharp-measure :sdl :midi :sequence-dico) (:shadowing-import-from :gsharp-numbering #:number) (:shadowing-import-from :gsharp-buffer #:rest)) Index: gsharp/score-pane.lisp diff -u gsharp/score-pane.lisp:1.5 gsharp/score-pane.lisp:1.6 --- gsharp/score-pane.lisp:1.5 Wed Jul 21 05:43:00 2004 +++ gsharp/score-pane.lisp Fri Jul 23 09:51:16 2004 @@ -417,16 +417,31 @@ (define-presentation-type staff () :options (x1 x2)) -(defun draw-staff (pane x1 x2) +(define-presentation-type fiveline-staff () :inherit-from 'staff :options (x1 x2)) + +(defun draw-fiveline-staff (pane x1 x2) (multiple-value-bind (left right) (bar-line-offsets *font*) (loop for staff-step from 0 by 2 repeat 5 do (draw-staff-line pane (+ x1 left) staff-step (+ x2 right))))) (define-presentation-method present - (object (type staff) stream (view score-view) &key) - (with-output-as-presentation (stream object 'staff) - (draw-staff stream x1 x2))) + (object (type fiveline-staff) stream (view score-view) &key) + (with-output-as-presentation (stream object 'fiveline-staff) + (draw-fiveline-staff stream x1 x2))) + +(define-presentation-type lyrics-staff () :inherit-from 'staff :options (x1 x2)) + +(defun draw-lyrics-staff (pane x1 x2) + (declare (ignore x2)) + (multiple-value-bind (left right) (bar-line-offsets *font*) + (declare (ignore right)) + (draw-text* pane "--" (+ x1 left) 0))) + +(define-presentation-method present + (object (type lyrics-staff) stream (view score-view) &key) + (with-output-as-presentation (stream object 'lyrics-staff) + (draw-lyrics-staff stream x1 x2))) ;;;;;;;;;;;;;;;;;; stem Index: gsharp/system.lisp diff -u gsharp/system.lisp:1.3 gsharp/system.lisp:1.4 --- gsharp/system.lisp:1.3 Mon Feb 16 10:50:59 2004 +++ gsharp/system.lisp Fri Jul 23 09:51:16 2004 @@ -22,6 +22,7 @@ (gsharp-defsystem (:gsharp) "packages" + "sequence-dico" "utilities" "gf" "sdl" @@ -38,4 +39,5 @@ "cursor" "input-state" "midi" + "modes" "gui") Index: gsharp/utilities.lisp diff -u gsharp/utilities.lisp:1.1.1.1 gsharp/utilities.lisp:1.2 --- gsharp/utilities.lisp:1.1.1.1 Mon Feb 16 07:46:21 2004 +++ gsharp/utilities.lisp Fri Jul 23 09:51:16 2004 @@ -71,3 +71,34 @@ (when (symbolp c1) (setf c1 (find-class c1))) (when (symbolp c2) (setf c2 (find-class c2))) (eq c1 c2)) + +;;; Unicode utilities + +(defparameter *char-to-unicode-table* (make-hash-table)) +(defparameter *unicode-to-char-table* (make-hash-table)) + +(defun char-to-unicode (char) + (or (gethash char *char-to-unicode-table*) 0)) + +(defun unicode-to-char (unicode) + (or (gethash unicode *unicode-to-char-table*) #\_)) + +(defun set-char-unicode-correspondance (char unicode) + (setf (gethash char *char-to-unicode-table*) unicode + (gethash unicode *unicode-to-char-table*) char)) + +(loop for char in '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M + #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z) + for code from 65 + do (set-char-unicode-correspondance char code)) + +(loop for char in '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m + #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z) + for code from 97 + do (set-char-unicode-correspondance char code)) + +(loop for char in '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) + for code from 48 + do (set-char-unicode-correspondance char code)) + +

1 0

[gsharp-cvs] CVS update: gsharp/gui.lisp
by Robert Strandh 21 Jul '04

21 Jul '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv21760 Modified Files: gui.lisp Log Message: completions for staves, staff types, and clef types work better now (should no longer fail on parse error). improved rename-staff command and made staff names unique. Date: Wed Jul 21 07:45:43 2004 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.13 gsharp/gui.lisp:1.14 --- gsharp/gui.lisp:1.13 Wed Jul 21 05:42:59 2004 +++ gsharp/gui.lisp Wed Jul 21 07:45:43 2004 @@ -998,74 +998,113 @@ ;;; ;;; Adding, deleting, and modifying staves +(define-condition no-such-staff (gsharp-condition) () + (:report + (lambda (condition stream) + (declare (ignore condition)) + (format stream "No such staff")))) + +(define-presentation-method accept + ((type score-pane:staff) stream (view textual-view) &key) + (multiple-value-bind (staff success string) + (handler-case (complete-input stream + (lambda (so-far mode) + (complete-from-possibilities + so-far + (staves (buffer *gsharp-frame*)) + '() + :action mode + :predicate (lambda (obj) (declare (ignore obj)) t) + :name-key #'name + :value-key #'identity))) + (simple-parse-error () (error 'no-such-staff))) + (declare (ignore string)) + (if success staff (error 'no-such-staff)))) + (define-presentation-method accept ((type fiveline-staff) stream (view textual-view) &key) (multiple-value-bind (staff success string) - (complete-input stream - (lambda (so-far mode) - (complete-from-possibilities - so-far - (staves (buffer *gsharp-frame*)) - '() - :action mode - :predicate (lambda (obj) (typep obj 'fiveline-staff)) - :name-key #'name - :value-key #'identity))) + (handler-case (complete-input stream + (lambda (so-far mode) + (complete-from-possibilities + so-far + (staves (buffer *gsharp-frame*)) + '() + :action mode + :predicate (lambda (obj) (typep obj 'fiveline-staff)) + :name-key #'name + :value-key #'identity))) + (simple-parse-error () (error 'no-such-staff))) (declare (ignore string)) - (if success - staff - (error "no such staff name")))) ; FIXME add a gsharp error here. + (if success staff (error 'no-such-staff)))) (defun symbol-name-lowcase (symbol) (string-downcase (symbol-name symbol))) (define-presentation-type staff-type ()) +(define-condition no-such-staff-type (gsharp-condition) () + (:report + (lambda (condition stream) + (declare (ignore condition)) + (format stream "No such staff type")))) + (define-presentation-method accept ((type staff-type) stream (view textual-view) &key) (multiple-value-bind (type success string) - (complete-input stream - (lambda (so-far mode) - (complete-from-possibilities - so-far - '(:fiveline) - '() - :action mode - :predicate (lambda (obj) (declare (ignore obj)) t) - :name-key #'symbol-name-lowcase - :value-key #'identity))) + (handler-case (complete-input stream + (lambda (so-far mode) + (complete-from-possibilities + so-far + '(:fiveline) + '() + :action mode + :predicate (lambda (obj) (declare (ignore obj)) t) + :name-key #'symbol-name-lowcase + :value-key #'identity))) + (simple-completion-error () (error 'no-such-staff-type))) (declare (ignore string)) - (if success - type - (error "no such staff type")))) + (if success type (error 'no-such-staff-type)))) (define-presentation-type clef-type ()) (define-presentation-method accept ((type clef-type) stream (view textual-view) &key) (multiple-value-bind (type success string) - (complete-input stream - (lambda (so-far mode) - (complete-from-possibilities - so-far - '(:treble :bass :c :percussion) - '() - :action mode - :predicate (lambda (obj) (declare (ignore obj)) t) - :name-key #'symbol-name-lowcase - :value-key #'identity))) + (handler-case (complete-input stream + (lambda (so-far mode) + (complete-from-possibilities + so-far + '(:treble :bass :c :percussion) + '() + :action mode + :predicate (lambda (obj) (declare (ignore obj)) t) + :name-key #'symbol-name-lowcase + :value-key #'identity))) + (simple-completion-error () (error 'no-such-staff-type))) (declare (ignore string)) (if success type (error "no such staff type")))) +(define-condition staff-name-not-unique (gsharp-condition) () + (:report + (lambda (condition stream) + (declare (ignore condition)) + (format stream "Staff name already exists")))) + +(defun acquire-unique-staff-name () + (let ((name (accept 'string :prompt "Staff name"))) + (assert (not (member name (staves (buffer *gsharp-frame*)) :test #'string= :key #'name)) + () `staff-name-not-unique) + name)) + (defun acquire-new-staff () - (let ((name (accept 'string :prompt "Staff name")) - (type (accept 'staff-type :prompt "Type"))) - (ecase type + (let ((name (acquire-unique-staff-name))) + (ecase (accept 'staff-type :prompt "Type") (:fiveline (let ((clef (accept 'clef-type :prompt "Clef")) (line (accept 'integer :prompt "Line"))) - (make-fiveline-staff name (make-clef clef line))))))) + (make-fiveline-staff name (make-clef clef line))))))) (define-gsharp-command (com-add-staff-before :name t) () (add-staff-before-staff (accept 'score-pane:staff :prompt "Before staff") @@ -1081,13 +1120,14 @@ (remove-staff-from-buffer (accept 'score-pane:staff :prompt "Staff") (buffer *gsharp-frame*))) -(define-gsharp-command (com-rename-staff :name t) ((name 'string)) - (let ((buffer (buffer *gsharp-frame*)) - (state (input-state *gsharp-frame*))) - (rename-staff name (staff state) buffer))) +(define-gsharp-command (com-rename-staff :name t) () + (let* ((staff (accept 'score-pane:staff :prompt "Staff")) + (name (acquire-unique-staff-name)) + (buffer (buffer *gsharp-frame*))) + (rename-staff name staff buffer))) -(define-gsharp-command (com-add-layer-staff :name t) ((name 'string)) - (let ((staff (find-staff name (buffer *gsharp-frame*))) +(define-gsharp-command (com-add-layer-staff :name t) () + (let ((staff (accept 'score-pane:staff :prompt "Staff")) (layer (layer (slice (bar (cursor *gsharp-frame*)))))) (add-staff-to-layer staff layer)))

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/gui.lisp gsharp/packages.lisp gsharp/score-pane.lisp
by Robert Strandh 21 Jul '04

21 Jul '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv12067 Modified Files: drawing.lisp gui.lisp packages.lisp score-pane.lisp Log Message: added preseentation types for staff and clef in score pane. score pane is no longer `use'd by other packages, exported symbols from score pane are explicitly prefixed by client code. removed presentation type for staff-line in score pane. Date: Wed Jul 21 05:43:00 2004 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.5 gsharp/drawing.lisp:1.6 --- gsharp/drawing.lisp:1.5 Wed Jul 14 11:07:33 2004 +++ gsharp/drawing.lisp Wed Jul 21 05:42:59 2004 @@ -10,31 +10,43 @@ (accidental-position :initform nil :accessor accidental-position))) (define-presentation-method present - (staff (type staff) stream (view textual-view) &key) - (format stream "[staff ~a]" (name staff))) + (object (type score-pane:clef) stream (view textual-view) &key) + (format stream "[~a clef on staff step ~a]" (name object) (lineno object))) + +(define-presentation-method present + (object (type score-pane:staff) stream (view textual-view) &key) + (format stream "[staff ~a]" (name object))) (defmethod draw-staff-and-clef (pane (staff staff) x1 x2) (when (clef staff) - (draw-clef pane (name (clef staff)) (+ x1 10) (lineno (clef staff))) + (present (clef staff) + `((score-pane:clef) + :name ,(name (clef staff)) + :x ,(+ x1 10) + :staff-step ,(lineno (clef staff))) + :stream pane) (let ((yoffset (ecase (name (clef staff)) (:bass (- (lineno (clef staff)) 4)) (:treble (+ (lineno (clef staff)) 2)) (:c (- (lineno (clef staff))) 1)))) (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 (staff-step 8)) by (staff-step 2) + for x from (+ x1 10 (score-pane:staff-step 8)) by (score-pane:staff-step 2) while (eq (aref (keysig staff) pitch) :flat) - do (draw-accidental pane :flat x (+ line yoffset)))) + do (score-pane:draw-accidental pane :flat x (+ line yoffset)))) (let ((yoffset (ecase (name (clef staff)) (:bass (lineno (clef staff))) (:treble (+ (lineno (clef staff)) 6)) (:c (+ (lineno (clef staff))) 3)))) (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 (staff-step 8)) by (staff-step 2.5) + for x from (+ x1 10 (score-pane:staff-step 8)) by (score-pane:staff-step 2.5) while (eq (aref (keysig staff) pitch) :sharp) - do (draw-accidental pane :sharp x (+ line yoffset))))) - (draw-staff staff pane x1 x2)) + do (score-pane:draw-accidental pane :sharp x (+ line yoffset))))) + (present staff + `((score-pane:staff) + :x1 ,x1 :x2 ,x2) + :stream pane)) (defun line-cost (measures method) (reduce (lambda (x y) (combine-cost method x y)) measures :initial-value nil)) @@ -85,7 +97,7 @@ (loop for bar in (measure-bars measure) do (if (gsharp-cursor::cursors (slice bar)) (draw-bar pane bar x width time-alist draw-cursor) - (with-light-glyphs pane (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)))))) (defun draw-system (pane measures x widths method staves draw-cursor) (let ((compress (compute-compress-factor measures method)) @@ -94,17 +106,17 @@ for width in widths do (draw-measure pane measure min-dist compress x method draw-cursor) (incf x width) - (draw-bar-line pane x - (staff-step 8) - (staff-yoffset (car (last staves))))))) + (score-pane:draw-bar-line pane x + (score-pane:staff-step 8) + (staff-yoffset (car (last staves))))))) (defmethod draw-buffer (pane (buffer buffer) *cursor* x y draw-cursor) - (with-staff-size 6 + (score-pane:with-staff-size 6 (let* ((staves (staves buffer)) - (timesig-offset (max (* (staff-step 2) + (timesig-offset (max (* (score-pane:staff-step 2) (loop for staff in staves maximize (count :flat (keysig staff)))) - (* (staff-step 2.5) + (* (score-pane:staff-step 2.5) (loop for staff in staves maximize (count :sharp (keysig staff)))))) (method (let ((old-method (buffer-cost-method buffer))) @@ -119,17 +131,17 @@ (gsharp-measure::new-map-over-obseq-subsequences (lambda (measures) (let ((widths (compute-widths measures method))) - (with-vertical-score-position (pane yy) + (score-pane:with-vertical-score-position (pane yy) (draw-system pane measures (+ x (left-offset buffer) timesig-offset) widths method staves draw-cursor) - (draw-bar-line pane x - (staff-step 8) - (staff-yoffset (car (last staves))))) + (score-pane:draw-bar-line pane x + (score-pane:staff-step 8) + (staff-yoffset (car (last staves))))) (loop for staff in staves do - (with-vertical-score-position (pane yy) + (score-pane:with-vertical-score-position (pane yy) (if (member staff (staves (layer (slice (bar *cursor*))))) (draw-staff-and-clef pane staff x right-edge) - (with-light-glyphs pane + (score-pane:with-light-glyphs pane (draw-staff-and-clef pane staff x right-edge)))) (decf yy 90)))) buffer))))) @@ -250,7 +262,9 @@ (start-time 0)) (mapc (lambda (element) (setf (element-xpos element) - (+ x (staff-step (xoffset element)) (cdr (assoc start-time time-alist)))) + (+ x + (score-pane:staff-step (xoffset element)) + (cdr (assoc start-time time-alist)))) (incf start-time (duration element))) (elements bar)))) @@ -296,7 +310,7 @@ (if (eq stem-direction :up) -1000 1000))) dominating-notes)) (x-positions (mapcar (lambda (element) - (/ (element-xpos element) (staff-step 1))) + (/ (element-xpos element) (score-pane:staff-step 1))) elements)) (beaming (beaming-single (mapcar #'list positions x-positions) stem-direction))) (loop for element in elements do @@ -318,23 +332,23 @@ (+ y1 (* slope (- (element-xpos element) x1)))) (setf (final-stem-yoffset element) (staff-yoffset dominating-staff))))) - (with-vertical-score-position (pane (staff-yoffset dominating-staff)) + (score-pane:with-vertical-score-position (pane (staff-yoffset dominating-staff)) (if (eq stem-direction :up) - (with-notehead-right-offsets (right up) + (score-pane:with-notehead-right-offsets (right up) (declare (ignore up)) - (draw-beam pane - (+ (element-xpos (car elements)) right) ss1 offset1 - (+ (element-xpos (car (last elements))) right) ss2 offset2)) - (with-notehead-left-offsets (left down) + (score-pane:draw-beam pane + (+ (element-xpos (car elements)) right) ss1 offset1 + (+ (element-xpos (car (last elements))) right) ss2 offset2)) + (score-pane:with-notehead-left-offsets (left down) (declare (ignore down)) - (draw-beam pane - (+ (element-xpos (car elements)) left) ss1 offset1 - (+ (element-xpos (car (last elements))) left) ss2 offset2)))) + (score-pane:draw-beam pane + (+ (element-xpos (car elements)) left) ss1 offset1 + (+ (element-xpos (car (last elements))) left) ss2 offset2)))) (loop for element in elements do (draw-element pane element (element-xpos element) nil)))))) (defun draw-cursor (pane x) - (draw-line* pane x (staff-step -4) x (staff-step 12) :ink +red+)) + (draw-line* pane x (score-pane:staff-step -4) x (score-pane:staff-step 12) :ink +red+)) (defmethod draw-bar (pane (bar bar) x width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) @@ -376,38 +390,38 @@ (lineno clef)))) (defun draw-ledger-lines (pane x notes) - (with-vertical-score-position (pane (staff-yoffset (staff (car notes)))) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff (car notes)))) (let* ((positions (mapcar #'note-position notes)) (max-pos (reduce #'max positions)) (min-pos (reduce #'min positions))) (loop for pos from 10 to max-pos by 2 - do (draw-ledger-line pane x pos)) + do (score-pane:draw-ledger-line pane x pos)) (loop for pos from -2 downto min-pos by 2 - do (draw-ledger-line pane x pos))))) + do (score-pane:draw-ledger-line pane x pos))))) (defun draw-flags (pane element x direction pos) (let ((nb (max (rbeams element) (lbeams element)))) (when (and (> nb 0) (eq (notehead element) :filled)) (if (eq direction :up) - (with-notehead-right-offsets (right up) + (score-pane:with-notehead-right-offsets (right up) (declare (ignore up)) - (draw-flags-down pane nb (+ x right) pos)) - (with-notehead-left-offsets (left down) + (score-pane:draw-flags-down pane nb (+ x right) pos)) + (score-pane:with-notehead-left-offsets (left down) (declare (ignore down)) - (draw-flags-up pane nb (+ x left) pos)))))) + (score-pane:draw-flags-up pane nb (+ x left) pos)))))) (defun draw-dots (pane nb-dots x pos) - (let ((staff-step (staff-step 1))) + (let ((staff-step (score-pane:staff-step 1))) (loop with dotpos = (if (evenp pos) (1+ pos) pos) repeat nb-dots for xx from (+ x (* 2 staff-step)) by staff-step do - (draw-dot pane xx dotpos)))) + (score-pane:draw-dot pane xx dotpos)))) (defun draw-note (pane note notehead nb-dots x pos) - (with-vertical-score-position (pane (staff-yoffset (staff note))) - (draw-notehead pane notehead x pos) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff note))) + (score-pane:draw-notehead pane notehead x pos) (when (final-accidental note) - (draw-accidental pane (final-accidental note) (accidental-position note) pos)) + (score-pane:draw-accidental pane (final-accidental note) (accidental-position note) pos)) (draw-dots pane nb-dots x pos))) (defun draw-notes (pane notes dots notehead) @@ -419,7 +433,7 @@ (if (eq direction :up) (lambda (x y) (< (note-position x) (note-position y))) (lambda (x y) (> (note-position x) (note-position y)))))) - (with-suspended-note-offset offset + (score-pane:with-suspended-note-offset offset (setf (final-xposition (car group)) x) (when (eq direction :down) (setf offset (- offset))) (loop for note in (cdr group) @@ -519,7 +533,7 @@ notes-with-accidentals)) (defun compute-final-accidental-positions (notes x final-stem-direction) - (let* ((staff-step (staff-step 1)) + (let* ((staff-step (score-pane:staff-step 1)) (notes (sort (copy-list notes) (lambda (x y) (> (note-position x) (note-position y))))) (notes-with-accidentals (remove-if-not #'final-accidental notes))) @@ -559,7 +573,7 @@ (stem-yoffset (final-stem-yoffset element)) (groups (group-notes-by-staff (notes element)))) (when flags - (with-vertical-score-position (pane stem-yoffset) + (score-pane:with-vertical-score-position (pane stem-yoffset) (draw-flags pane element x direction stem-pos))) (loop for group in groups do (compute-final-xpositions group x direction) @@ -569,12 +583,12 @@ (draw-ledger-lines pane x group)) (unless (eq (notehead element) :whole) (if (eq direction :up) - (draw-right-stem pane x - (+ (staff-step min-pos) min-yoffset) - (+ (staff-step stem-pos) stem-yoffset)) - (draw-left-stem pane x - (+ (staff-step max-pos) max-yoffset) - (+ (staff-step stem-pos) stem-yoffset))))))) + (score-pane:draw-right-stem pane x + (+ (score-pane:staff-step min-pos) min-yoffset) + (+ (score-pane:staff-step stem-pos) stem-yoffset)) + (score-pane:draw-left-stem pane x + (+ (score-pane:staff-step max-pos) max-yoffset) + (+ (score-pane:staff-step stem-pos) stem-yoffset))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -582,7 +596,7 @@ (defmethod draw-element (pane (element rest) x &optional (flags t)) (declare (ignore flags)) - (with-vertical-score-position (pane (staff-yoffset (staff element))) - (draw-rest pane (notehead-duration element) x (staff-pos element)) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) + (score-pane:draw-rest pane (notehead-duration element) x (staff-pos element)) (draw-dots pane (dots element) x (1+ (staff-pos element))))) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.12 gsharp/gui.lisp:1.13 --- gsharp/gui.lisp:1.12 Sun Jul 18 23:23:53 2004 +++ gsharp/gui.lisp Wed Jul 21 05:42:59 2004 @@ -94,7 +94,7 @@ (defmethod redisplay-gsharp-panes (frame &key force-p) (loop for pane in (frame-current-panes frame) - do (when (typep pane 'score-pane) + do (when (typep pane 'score-pane:score-pane) (redisplay-frame-pane frame pane :force-p force-p)))) (defvar *gsharp-frame*) @@ -102,7 +102,7 @@ (defparameter *kbd-macro-recording-p* nil) (defparameter *kbd-macro-funs* '()) -(defmethod dispatch-event :around ((pane score-pane) (event key-press-event)) +(defmethod dispatch-event :around ((pane score-pane:score-pane) (event key-press-event)) (when (keyboard-event-character event) (let* ((key (list (keyboard-event-character event) (event-modifier-state event))) @@ -126,16 +126,16 @@ (:menu-bar menubar-command-table :height 25) (:pointer-documentation t) (:panes - (score (make-pane 'score-pane + (score (make-pane 'score-pane:score-pane :width 700 :height 900 :name "score" :display-time :no-clear :display-function 'display-score)) - (state (make-pane 'score-pane + (state (make-pane 'score-pane:score-pane :width 50 :height 200 :name "state" :display-function 'display-state)) - (element (make-pane 'score-pane + (element (make-pane 'score-pane:score-pane :width 50 :height 700 :min-height 100 :max-height 20000 :name "element" @@ -161,43 +161,43 @@ (defmethod display-state ((frame gsharp) pane) (let ((state (input-state *gsharp-frame*))) - (with-score-pane pane - (with-staff-size 10 - (with-vertical-score-position (pane 800) + (score-pane:with-score-pane pane + (score-pane:with-staff-size 10 + (score-pane:with-vertical-score-position (pane 800) (let ((xpos 30)) - (draw-notehead pane (notehead state) xpos 4) + (score-pane:draw-notehead pane (notehead state) xpos 4) (when (not (eq (notehead state) :whole)) (when (or (eq (stem-direction state) :auto) (eq (stem-direction state) :down)) (when (eq (notehead state) :filled) - (with-notehead-left-offsets (left down) + (score-pane:with-notehead-left-offsets (left down) (declare (ignore down)) (let ((x (+ xpos left))) (loop repeat (rbeams state) for staff-step from -4 by 2 do - (draw-beam pane x staff-step 0 (+ x 10) staff-step 0)) + (score-pane:draw-beam pane x staff-step 0 (+ x 10) staff-step 0)) (loop repeat (lbeams state) for staff-step from -4 by 2 do - (draw-beam pane (- x 10) staff-step 0 x staff-step 0))))) - (draw-left-stem pane xpos (staff-step 4) (staff-step -4))) + (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))) (when (or (eq (stem-direction state) :auto) (eq (stem-direction state) :up)) (when (eq (notehead state) :filled) - (with-notehead-right-offsets (right up) + (score-pane:with-notehead-right-offsets (right up) (declare (ignore up)) (let ((x (+ xpos right))) (loop repeat (rbeams state) for staff-step downfrom 12 by 2 do - (draw-beam pane x staff-step 0 (+ x 10) staff-step 0)) + (score-pane:draw-beam pane x staff-step 0 (+ x 10) staff-step 0)) (loop repeat (lbeams state) for staff-step downfrom 12 by 2 do - (draw-beam pane (- x 10) staff-step 0 x staff-step 0))))) - (draw-right-stem pane xpos (staff-step 4) (staff-step 12)))) - (with-notehead-right-offsets (right up) + (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:with-notehead-right-offsets (right up) (declare (ignore up)) (loop repeat (dots state) for dx from (+ right 5) by 5 do - (draw-dot pane (+ xpos dx) 4))))))))) + (score-pane:draw-dot pane (+ xpos dx) 4))))))))) (defun draw-the-cursor (pane x) (let* ((state (input-state *gsharp-frame*)) @@ -206,24 +206,24 @@ (clef (clef staff)) (bottom-line (- (ecase (name clef) (:treble 32) (:bass 24) (:c 35)) (lineno clef))) - (lnote-offset (staff-step (- (last-note state) bottom-line)))) + (lnote-offset (score-pane:staff-step (- (last-note state) bottom-line)))) (draw-line* pane - x (+ (staff-step 12) yoffset) - x (+ (staff-step -4) yoffset) + x (+ (score-pane:staff-step 12) yoffset) + x (+ (score-pane:staff-step -4) yoffset) :ink +yellow+) (draw-line* pane - (- x 1) (+ (staff-step -3.4) yoffset lnote-offset) - (- x 1) (+ (staff-step 3.6) yoffset lnote-offset) + (- 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) (+ (staff-step -3.4) yoffset lnote-offset) - (+ x 1) (+ (staff-step 3.6) yoffset lnote-offset) + (+ x 1) (+ (score-pane:staff-step -3.4) yoffset lnote-offset) + (+ x 1) (+ (score-pane:staff-step 3.6) yoffset lnote-offset) :ink +red+))) (defmethod display-score ((frame gsharp) pane) (let* ((buffer (buffer frame))) (recompute-measures buffer) - (with-score-pane pane + (score-pane:with-score-pane pane (flet ((draw-cursor (x) (draw-the-cursor pane x))) (draw-buffer pane buffer (cursor *gsharp-frame*) (left-margin buffer) 800 #'draw-cursor))))) @@ -241,9 +241,9 @@ (defmethod display-element ((frame gsharp) pane) (when (handler-case (cur-cluster) (gsharp-condition () nil)) - (with-score-pane pane - (with-staff-size 10 - (with-vertical-score-position (pane 500) + (score-pane:with-score-pane pane + (score-pane:with-staff-size 10 + (score-pane:with-vertical-score-position (pane 500) (let* ((xpos 30) (cluster (cur-cluster)) (notehead (notehead cluster)) @@ -256,9 +256,9 @@ (declare (ignore stem-direction stem-length notehead lbeams rbeams dots)) (loop for note in notes do (draw-ellipse* pane xpos (* 15 (note-position note)) 7 0 0 7) - (draw-accidental pane (accidentals note) - (- xpos (if (oddp (note-position note)) 15 25)) - (* 3 (note-position note)))) + (score-pane:draw-accidental pane (accidentals note) + (- xpos (if (oddp (note-position note)) 15 25)) + (* 3 (note-position note)))) (when notes (draw-ellipse* pane xpos (* 15 (note-position (cur-note))) 7 0 0 7 :ink +red+)) @@ -447,7 +447,7 @@ (define-gsharp-command (com-insert-layer-after :name t) () (let ((cursor (cursor *gsharp-frame*)) - (staff (accept 'staff :prompt "Staff"))) + (staff (accept 'score-pane:staff :prompt "Staff"))) ;;; (staff (find-staff staff-name (buffer *gsharp-frame*)))) (if (not staff) (message "No such staff in buffer~%") @@ -1068,17 +1068,17 @@ (make-fiveline-staff name (make-clef clef line))))))) (define-gsharp-command (com-add-staff-before :name t) () - (add-staff-before-staff (accept 'staff :prompt "Before staff") + (add-staff-before-staff (accept 'score-pane:staff :prompt "Before staff") (acquire-new-staff) (buffer *gsharp-frame*))) (define-gsharp-command (com-add-staff-after :name t) () - (add-staff-after-staff (accept 'staff :prompt "After staff") + (add-staff-after-staff (accept 'score-pane:staff :prompt "After staff") (acquire-new-staff) (buffer *gsharp-frame*))) (define-gsharp-command (com-delete-staff :name t) () - (remove-staff-from-buffer (accept 'staff :prompt "Staff") + (remove-staff-from-buffer (accept 'score-pane:staff :prompt "Staff") (buffer *gsharp-frame*))) (define-gsharp-command (com-rename-staff :name t) ((name 'string)) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.5 gsharp/packages.lisp:1.6 --- gsharp/packages.lisp:1.5 Sun Jul 18 23:23:53 2004 +++ gsharp/packages.lisp Wed Jul 21 05:43:00 2004 @@ -120,8 +120,8 @@ #:128th-rest #:measure-rest #:double-whole-rest)) (defpackage :score-pane - (:use :clim :clim-extensions :clim-lisp :sdl :gsharp-buffer) - (:shadowing-import-from :gsharp-buffer #:rest) + (:use :clim :clim-extensions :clim-lisp :sdl) + (:shadow #:rest) (:export #:draw-staff #:draw-stem #:draw-right-stem #:draw-left-stem #:draw-ledger-line #:draw-bar-line #:draw-beam #:staff-step #:draw-notehead #:draw-accidental #:draw-clef #:draw-rest #:draw-dot @@ -129,7 +129,8 @@ #:with-score-pane #:with-vertical-score-position #:with-staff-size #:with-notehead-right-offsets #:with-suspended-note-offset - #:with-notehead-left-offsets #:with-light-glyphs #:score-pane )) + #:with-notehead-left-offsets #:with-light-glyphs #:score-pane + #:clef #:staff #:notehead)) (defpackage :gsharp-beaming (:use :common-lisp) @@ -163,7 +164,7 @@ (defpackage :gsharp-drawing (:use :clim :clim-lisp :gsharp-buffer :gsharp-measure :gsharp-cursor - :gsharp-utilities :sdl :score-pane :gsharp-beaming :obseq) + :gsharp-utilities :sdl :gsharp-beaming :obseq) (:shadowing-import-from :gsharp-buffer #:rest) (:export #:draw-buffer)) @@ -185,7 +186,7 @@ (defpackage :gsharp (:use :clim :clim-lisp :gsharp-buffer :gsharp-cursor :gsharp-drawing :gsharp-numbering - :gsharp-measure :score-pane :sdl :midi) + :gsharp-measure :sdl :midi) (:shadowing-import-from :gsharp-numbering #:number) (:shadowing-import-from :gsharp-buffer #:rest)) Index: gsharp/score-pane.lisp diff -u gsharp/score-pane.lisp:1.4 gsharp/score-pane.lisp:1.5 --- gsharp/score-pane.lisp:1.4 Wed Jul 14 11:07:33 2004 +++ gsharp/score-pane.lisp Wed Jul 21 05:43:00 2004 @@ -1,5 +1,7 @@ (in-package :score-pane) +(defclass score-view (view) ()) + (defclass score-pane (application-pane) ((pixmaps :initform (make-hash-table :test #'eq) :reader pane-pixmaps) (darker-gray-progressions :initform (make-array 10 :initial-element nil :adjustable t) @@ -7,6 +9,10 @@ (lighter-gray-progressions :initform (make-array 10 :initial-element nil :adjustable t) :reader lighter-gray-progressions))) +(defmethod initialize-instance :after ((pane score-pane) &rest args) + (declare (ignore args)) + (setf (stream-default-view pane) (make-instance 'score-view))) + (defmethod dispatch-event :before ((pane score-pane) (event pointer-enter-event)) (let ((port (port pane))) (setf (port-keyboard-input-focus port) pane))) @@ -233,6 +239,13 @@ (:half +glyph-half+) (:filled +glyph-filled+))) +(define-presentation-type notehead () :options (name x staff-step)) + +(define-presentation-method present + (object (type notehead) stream (view score-view) &key) + (with-output-as-presentation (stream object 'notehead) + (draw-notehead stream name x staff-step))) + ;;;;;;;;;;;;;;;;;; accidental (define-pixmap-recording (accidental-output-record medium-draw-accidental draw-accidental (name)) @@ -251,6 +264,13 @@ (:bass +glyph-f-clef+) (:c +glyph-c-clef+))) +(define-presentation-type clef () :options (name x staff-step)) + +(define-presentation-method present + (object (type clef) stream (view score-view) &key) + (with-output-as-presentation (stream object 'clef) + (draw-clef stream name x staff-step))) + ;;;;;;;;;;;;;;;;;; rest (define-pixmap-recording (rest-output-record medium-draw-rest draw-rest (duration)) @@ -323,18 +343,6 @@ (y2 (+ (staff-step staff-step) up))) (medium-draw-staff-line pane x1 y1 x2 y2)))) -(defclass staff-line () - ((x1 :initarg :x1) - (staff-step :initarg :staff-step) - (x2 :initarg :x2))) - -(define-presentation-type staff-line ()) - -(define-presentation-method present (line (type staff-line) stream view &key) - (declare (ignore view)) - (with-slots (x1 staff-step x2) line - (draw-staff-line stream x1 staff-step x2))) - (defclass staff-output-record (output-record) ((parent :initarg :parent :initform nil :accessor output-record-parent) (x :initarg :x1 :initarg :x-position) @@ -407,16 +415,18 @@ (loop for staff-line in (slot-value record 'staff-lines) do (replay-output-record staff-line stream region x-offset y-offset))) -(define-presentation-method present - (staff (type staff) stream (view textual-view) &key) - (format stream "[staff ~a]" (name staff))) +(define-presentation-type staff () :options (x1 x2)) + +(defun draw-staff (pane x1 x2) + (multiple-value-bind (left right) (bar-line-offsets *font*) + (loop for staff-step from 0 by 2 + repeat 5 + do (draw-staff-line pane (+ x1 left) staff-step (+ x2 right))))) -(defun draw-staff (staff pane x1 x2) - (with-output-as-presentation (pane staff 'staff) - (multiple-value-bind (left right) (bar-line-offsets *font*) - (loop for staff-step from 0 by 2 - repeat 5 - do (draw-staff-line pane (+ x1 left) staff-step (+ x2 right)))))) +(define-presentation-method present + (object (type staff) stream (view score-view) &key) + (with-output-as-presentation (stream object 'staff) + (draw-staff stream x1 x2))) ;;;;;;;;;;;;;;;;;; stem

1 0

[gsharp-cvs] CVS update: gsharp/Doc/buffer.tex gsharp/Doc/commands.tex gsharp/Doc/release-notes.tex
by Robert Strandh 19 Jul '04

19 Jul '04

Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv3761/Doc Modified Files: buffer.tex commands.tex release-notes.tex Log Message: Staff types, staves, and clef types are now presentation types. Add staff commands prompt for existing staff and name, type, clef types, etc. for staff to insert. We still do not verify that staff name is unique. We also need to add completion for staff names. Updated documentation and release notes to reflect changes. Date: Sun Jul 18 23:23:53 2004 Author: rstrandh Index: gsharp/Doc/buffer.tex diff -u gsharp/Doc/buffer.tex:1.1 gsharp/Doc/buffer.tex:1.2 --- gsharp/Doc/buffer.tex:1.1 Fri Apr 2 09:13:35 2004 +++ gsharp/Doc/buffer.tex Sun Jul 18 23:23:53 2004 @@ -83,10 +83,19 @@ \Defclass {staff} +The protocol class for all staves. + \Definitarg {:name} The default value for this initarg is \lispobj{"default"}. +\Defgeneric {name} {staff} + +Return the name of the staff. With \lispobj{setf}, change the name of +the staff. + +\Defclass {fiveline-staff} + \Definitarg {:clef} This value must always be supplied. @@ -96,19 +105,14 @@ The default value for this initarg is a vector with seven elements, each begin the object \lispobj{:natural}. -\Defun {make-staff} {\optional (clef \texttt(make-clef :treble))} - -\Defgeneric {name} {staff} - -Return the name of the staff. With \lispobj{setf}, change the name of -the staff. +\Defun {make-fiveline-staff} {name \optional (clef \texttt(make-clef :treble))} -\Defgeneric {clef} {staff} +\Defgeneric {clef} {fiveline-staff} Return the clef of the staff. With \lispobj{setf}, change the clef of the staff. -\Defgeneric {keysig} {staff} +\Defgeneric {keysig} {fiveline-staff} Return the key signature of the staff. With \lispobj{setf}, change the key signature of the staff. @@ -116,8 +120,8 @@ %------------------------------------------------------------------- \subsection{External representation} -A staff is printed (by \lispobj{print-object}) like this in version 3 -of the external representation: +A fiveline staff is printed (by \lispobj{print-object}) like this in +version 3 of the external representation: \texttt{[= :name \textit{name} :clef \textit{clef} :keysig \textit{keysig} ]} Index: gsharp/Doc/commands.tex diff -u gsharp/Doc/commands.tex:1.2 gsharp/Doc/commands.tex:1.3 --- gsharp/Doc/commands.tex:1.2 Wed Feb 18 22:48:08 2004 +++ gsharp/Doc/commands.tex Sun Jul 18 23:23:53 2004 @@ -94,7 +94,7 @@ \kbd{x]} & Fewer Rbeams & Remove a beam to the right\\ \kbd{[} & More Lbeams & Add another beam to the left\\ \kbd{x[} & Fewer Lbeams & Remove a beam to the left\\ -\kbd{Meta-u} & Up & Move rest to a highter staff line\\ +\kbd{Meta-u} & Up & Move rest to a higher staff line\\ \kbd{Meta-d} & Down & Move rest to a lower staff line\\ \hline \end{tabular} @@ -138,8 +138,17 @@ \hline Key & Command name & Description\\ \hline - & Add Staff & Add a new staff (promts for a name)\\ - & Delete Staff & Delete a staff (promts for a name)\\ + & Add Staff After & Add a new staff after an existing one\\ + & & (prompts for the existing staff, \\ + & & for the name and the type of the new staff, \\ + & & and a clef and a line for the clef\\ + & & if type is \texttt{fiveline})\\ + & Add Staff Before & Add a new before after an existing one\\ + & & (prompts for the existing staff, \\ + & & for the name and the type of the new staff, \\ + & & and a clef and a line for the clef\\ + & & if type is \texttt{fiveline})\\ + & Delete Staff & Delete a staff (promts for staff to delete)\\ & Rename Staff & Rename current staff (prompts for a new name)\\ & Set clef & Set the clef of the current staff\\ & & (promts for name of clef and line number)\\ Index: gsharp/Doc/release-notes.tex diff -u gsharp/Doc/release-notes.tex:1.4 gsharp/Doc/release-notes.tex:1.5 --- gsharp/Doc/release-notes.tex:1.4 Wed Feb 25 14:24:56 2004 +++ gsharp/Doc/release-notes.tex Sun Jul 18 23:23:53 2004 @@ -19,6 +19,12 @@ Christophe Rhodes). \item {\gs} now runs on SBCL as well as on CMUCL (thanks to Christophe Rhodes). +\item Fixed problem with flickering introduced by new version of McCLIM. +\item More menu commands that need arguments now work correctly. +\item Staves are now clickable. Commands that take staves as + arguments now prompt for existing staves as opposed to just names of + staves. +\item Added completion for clef types and staff types. \end{itemize} \subsection{Bug fixes from 0.2}

1 0