? beaming.fasl
? buffer.fasl
? charmap.fasl
? cursor.fasl
? drawing.fasl
? gf.fasl
? glyphs.fasl
? gui.fasl
? input-state.fasl
? measure.fasl
? midi.fasl
? numbering.fasl
? packages.fasl
? postscript.fasl
? score-pane.fasl
? sdl.fasl
? utilities.fasl
? Fonts/sdl.log
? Fonts/sdl10.gf
? Fonts/sdl10.pk
? Fonts/sdl12.gf
? Fonts/sdl12.pk
? Fonts/sdl6.gf
? Fonts/sdl6.pk
? Fonts/sdl8.gf
? Fonts/sdl8.pk
? Obseq/obseq.fasl
? Scores/twinkle.gsh
Index: buffer.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/buffer.lisp,v
retrieving revision 1.2
diff -u -r1.2 buffer.lisp
--- buffer.lisp	16 Feb 2004 16:08:00 -0000	1.2
+++ buffer.lisp	1 Mar 2004 21:02:39 -0000
@@ -263,7 +263,8 @@
 (defclass cluster (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)))
+   (stem-length :initform nil :initarg :stem-length :accessor stem-length)
+   (lyrics :initform (make-array 0 :element-type 'character :fill-pointer t :adjustable t) :accessor lyrics)))
 
 (defmethod print-object ((c cluster) stream)
   (with-slots (notehead rbeams lbeams dots xoffset stem-direction notes) c
Index: drawing.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/drawing.lisp,v
retrieving revision 1.4
diff -u -r1.4 drawing.lisp
--- drawing.lisp	20 Feb 2004 08:39:03 -0000	1.4
+++ drawing.lisp	1 Mar 2004 21:02:39 -0000
@@ -570,7 +570,12 @@
 			     (+ (staff-step stem-pos) stem-yoffset))
 	    (draw-left-stem pane x
 			    (+ (staff-step max-pos) max-yoffset)
-			    (+ (staff-step stem-pos) stem-yoffset)))))))
+			    (+ (staff-step stem-pos) stem-yoffset))))
+      (when (> (length (lyrics element)))
+	(let ((or (with-output-to-output-record (pane)
+		    (draw-text* pane (lyrics element) 0 0 :text-family :serif))))
+	  (with-bounding-rectangle* (minx miny maxx maxy) or
+	    (draw-text* pane (lyrics element) (- x (/ maxx 2)) stem-yoffset :text-family :serif)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
Index: gui.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/gui.lisp,v
retrieving revision 1.8
diff -u -r1.8 gui.lisp
--- gui.lisp	27 Feb 2004 09:34:30 -0000	1.8
+++ gui.lisp	1 Mar 2004 21:02:41 -0000
@@ -7,12 +7,17 @@
 	 (bar (barno slice 0)))
   (make-cursor bar 0)))
 
+(defparameter *lyrics-command-table* (make-hash-table :test #'equal))
+
 (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))
+
+;;; FIXME: should probably be frame slots, or maybe even buffer? (pane?) slots.
 (defparameter *commands* *global-command-table*)
+(defparameter *mode* :fundamental)
 
 (defun add-command (gesture command table)
   (setf (gethash (list (car gesture) (apply #'make-modifier-state (cdr gesture)))
@@ -92,6 +97,21 @@
 (add-command '(#\)) 'com-end-kbd-macro *c-x-command-table*)
 (add-command '(#\e) 'com-call-last-kbd-macro *c-x-command-table*)
 
+;;; lyrics
+(loop for char across "abcdefghijklmnopqrstuvwxyz"
+      do (add-command `(,char) 'com-self-insert *lyrics-command-table*)
+      do (add-command `(,char :shift) 'com-self-insert *lyrics-command-table*)
+      do (add-command `(,(char-upcase char)) 'com-self-insert *lyrics-command-table*)
+      do (add-command `(,(char-upcase char) :shift) 'com-self-insert *lyrics-command-table*))
+
+(add-command '(#\f :control) 'com-forward-element *lyrics-command-table*)
+(add-command '(#\b :control) 'com-backward-element *lyrics-command-table*)
+(add-command '(#\h :control) 'com-erase-char *lyrics-command-table*)
+
+(add-command '(#\-) 'com-insert-hyphen-and-forward-cluster *lyrics-command-table*)
+(add-command '(#\_ :shift) 'com-insert-underscore-and-forward-cluster *lyrics-command-table*)
+(add-command '(#\Space) 'com-forward-cluster *lyrics-command-table*)
+
 (defmethod redisplay-gsharp-panes (frame &key force-p)
   (loop for pane in (frame-current-panes frame)
 	do (when (typep pane 'score-pane)
@@ -102,19 +122,29 @@
 (defparameter *kbd-macro-recording-p* nil)
 (defparameter *kbd-macro-funs* '())
 
+(defvar *current-key-character*)
+
 (defmethod dispatch-event :around ((pane score-pane) (event key-press-event))
   (when (keyboard-event-character event)
     (let* ((key (list (keyboard-event-character event)
 		      (event-modifier-state event)))
+	   (*current-key-character* (keyboard-event-character 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*))
+	     (setf *commands*
+		   (ecase *mode*
+		     (:fundamental *global-command-table*)
+		     (:lyrics *lyrics-command-table*))))
 	    (t (format *error-output* "no command for ~a~%" key)
-	       (setf *commands* *global-command-table*)
+	       (finish-output *error-output*)
+	       (setf *commands*
+		     (ecase *mode*
+		       (:fundamental *global-command-table*)
+		       (:lyrics *lyrics-command-table*)))
 	       (when *kbd-macro-recording-p* (setf *kbd-macro-funs* '()
 						   *kbd-macro-recording-p* nil))))
       (redisplay-gsharp-panes *gsharp-frame* :force-p t))))
@@ -507,10 +537,16 @@
 (make-command-table
  'modes-command-table
  :errorp nil
- :menu '(("Fundamental" :command com-fundamental)))
+ :menu '(("Fundamental" :command com-fundamental)
+	 ("Lyrics" :command com-lyrics)))
 
 (define-gsharp-command (com-fundamental :name t) ()
-  nil)
+  (setf *mode* :fundamental)
+  (setf *commands* *global-command-table*))
+
+(define-gsharp-command (com-lyrics :name t) ()
+  (setf *mode* :lyrics)
+  (setf *commands* *lyrics-command-table*))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -697,6 +733,32 @@
 
 (define-gsharp-command com-insert-empty-cluster ()
   (insert-cluster))  
+
+(define-gsharp-command com-self-insert ()
+  (vector-push-extend *current-key-character* (lyrics (cur-cluster))))
+
+(define-gsharp-command com-erase-char ()
+  (decf (fill-pointer (lyrics (cur-cluster)))))
+
+(define-gsharp-command com-forward-cluster ()
+  (do ()
+      ((progn (forward-element (cursor *gsharp-frame*))
+	      ;; FIXME: CUR-ELEMENT doesn't change on barlines.
+	      ;; Therefore this test is testing the wrong object.
+	      (typep (cur-element) 'cluster)))))
+
+(define-gsharp-command com-insert-hyphen-and-forward-cluster ()
+  ;; FIXME: this actually needs to be a lot more complicated.  We need
+  ;; to record the desire for a hyphen joiner between syllables, and
+  ;; (when displaying) compute aesthetically pleasing length(s) and
+  ;; placement(s).
+  (vector-push-extend #\- (lyrics (cur-cluster)))
+  (com-forward-cluster))
+
+(define-gsharp-command com-insert-underscore-and-forward-cluster ()
+  ;; FIXME: as with hyphen insertion, this is not good enough.
+  (vector-push-extend #\_ (lyrics (cur-cluster)))
+  (com-forward-cluster))
 
 (defun cur-cluster ()
   (current-cluster (cursor *gsharp-frame*)))
Index: packages.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/packages.lisp,v
retrieving revision 1.2
diff -u -r1.2 packages.lisp
--- packages.lisp	16 Feb 2004 16:08:00 -0000	1.2
+++ packages.lisp	1 Mar 2004 21:02:42 -0000
@@ -38,7 +38,7 @@
 	   #:staff #:make-staff #:gsharp-condition
 	   #:pitch #:accidentals #:dots #:cluster #:note
 	   #:make-note #:note-less #:note-equal #:bar
-	   #:notehead #:rbeams #:lbeams #:dots #:element #:notes
+	   #:notehead #:rbeams #:lbeams #:dots #:element #:notes #:lyrics
 	   #:add-note #:find-note #:remove-note #:cluster #:make-cluster
 	   #:rest #:make-rest #:slice #:elements
 	   #:nb-elements #:elementno #:add-element
