[gsharp-cvs] CVS gsharp
dlewis
dlewis at common-lisp.net
Mon Apr 20 15:04:47 UTC 2009
Update of /project/gsharp/cvsroot/gsharp
In directory cl-net:/tmp/cvs-serv25231
Modified Files:
buffer.lisp cursor.lisp drawing.lisp gui.lisp melody.lisp
packages.lisp score-pane.lisp
Log Message:
Basic time signature support. Only some sigs supported and spacing is basic.
Key and time signatures now share a staffwise-elements slot in the stave.
--- /project/gsharp/cvsroot/gsharp/buffer.lisp 2008/02/09 16:58:35 1.59
+++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2009/04/20 15:04:47 1.60
@@ -208,8 +208,8 @@
;; there might be more than one key signature in the bar,
;; and they might have changed their relative order as a
;; result of the edit.
- (setf (key-signatures staff)
- (sort (key-signatures staff)
+ (setf (staffwise-elements staff)
+ (sort (staffwise-elements staff)
(lambda (x y) (gsharp::starts-before-p x (bar y) y))))))))))
(defmethod add-element :after ((element element) (bar bar) position)
--- /project/gsharp/cvsroot/gsharp/cursor.lisp 2008/11/19 16:05:13 1.8
+++ /project/gsharp/cvsroot/gsharp/cursor.lisp 2009/04/20 15:04:47 1.9
@@ -166,10 +166,10 @@
(when (> (pos cursor) position)
(incf (pos cursor)))))
-(defmethod add-element :after ((keysig key-signature) bar position)
- (let ((staff (staff keysig)))
- (setf (key-signatures staff)
- (merge 'list (list keysig) (key-signatures staff)
+(defmethod add-element :after ((element staffwise-element) bar position)
+ (let ((staff (staff element)))
+ (setf (staffwise-elements staff)
+ (merge 'list (list element) (staffwise-elements staff)
(lambda (x y) (gsharp::starts-before-p x (bar y) y))))))
(defmethod remove-element :before ((element element) (bar cbar))
--- /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/11/19 16:05:13 1.87
+++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2009/04/20 15:04:47 1.88
@@ -162,6 +162,13 @@
(score-pane:staff-step 5)
(score-pane:staff-step 2)))
+(defmethod right-bulge ((timesig time-signature) pane)
+ ;; FIXME: this is probably wrong; it should either compute the bulge
+ ;; properly, or else approximate using (length - 0.5) *
+ ;; typical-width-of-component
+ (* (length (time-signature-components timesig))
+ (score-pane:staff-step 5)))
+
(defmethod right-bulge ((keysig key-signature) pane)
;; FIXME: shares much code with DRAW-ELEMENT (KEY-SIGNATURE).
(let ((old-keysig (keysig keysig)))
@@ -697,7 +704,7 @@
(defun draw-beam-group (pane elements)
(let ((e (car elements)))
- (when (typep e 'key-signature)
+ (when (typep e 'staffwise-element)
(assert (null (cdr elements)))
(return-from draw-beam-group
(draw-element pane e (final-absolute-element-xoffset e)))))
@@ -1115,3 +1122,15 @@
for x from x by (score-pane:staff-step 2.5)
while (eq (aref (alterations keysig) pitch) :sharp)
do (score-pane:draw-accidental pane :sharp x (+ line yoffset)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Time signature element
+
+(defmethod draw-element (pane (timesig time-signature) &optional (flags t))
+ (declare (ignore flags))
+ (let ((staff (staff timesig))
+ (x (final-absolute-element-xoffset timesig)))
+ (score-pane:with-vertical-score-position (pane (staff-yoffset staff))
+ (dolist (component (time-signature-components timesig))
+ (score-pane:draw-time-signature-component pane component x)))))
\ No newline at end of file
--- /project/gsharp/cvsroot/gsharp/gui.lisp 2008/11/19 16:05:13 1.96
+++ /project/gsharp/cvsroot/gsharp/gui.lisp 2009/04/20 15:04:47 1.97
@@ -955,10 +955,28 @@
(define-gsharp-command com-insert-keysig ()
(insert-keysig))
-(defmethod remove-element :before ((keysig key-signature) (bar bar))
- (let ((staff (staff keysig)))
- (setf (key-signatures staff)
- (remove keysig (key-signatures staff)))
+(defun insert-timesig (numerator denominator)
+ (let* ((cursor (current-cursor))
+ (staff (car (staves (layer cursor))))
+ (timesig (make-instance 'time-signature
+ :staff staff
+ :components
+ (list (if denominator
+ (cons numerator denominator)
+ numerator)))))
+ (insert-element timesig cursor)
+ (forward-element cursor)
+ timesig))
+
+(define-gsharp-command (com-insert-timesig :name t)
+ ((numerator '(integer 1 8) :prompt "Numerator")
+ (denominator '(integer 1 8) :prompt "Denominator"))
+ (insert-timesig numerator denominator))
+
+(defmethod remove-element :before ((element staffwise-element) (bar bar))
+ (let ((staff (staff element)))
+ (setf (staffwise-elements staff)
+ (remove element (staffwise-elements staff)))
(gsharp-measure::invalidate-everything-using-staff (current-buffer) staff)))
;;; FIXME: this isn't quite right (argh) for the case of two
--- /project/gsharp/cvsroot/gsharp/melody.lisp 2007/10/22 11:45:37 1.1
+++ /project/gsharp/cvsroot/gsharp/melody.lisp 2009/04/20 15:04:47 1.2
@@ -78,8 +78,17 @@
((clef :accessor clef :initarg :clef :initform (make-clef :treble))
(%keysig :accessor keysig :initarg :keysig
:initform (make-array 7 :initial-element :natural))
- (key-signatures :accessor key-signatures :initform nil)))
-
+ (staffwise-elements :accessor staffwise-elements :initform nil)))
+
+(defgeneric key-signatures (staff)
+ (:method ((s fiveline-staff))
+ (remove-if #'(lambda (x) (not (typep x 'key-signature)))
+ (staffwise-elements s))))
+(defgeneric time-signatures (staff)
+ (:method ((s fiveline-staff))
+ (remove-if #'(lambda (x) (not (typep x 'time-signature)))
+ (staffwise-elements s))))
+
(defmethod initialize-instance :after ((obj fiveline-staff) &rest args)
(declare (ignore args))
(with-slots (%keysig) obj
@@ -309,9 +318,13 @@
(:documentation "make the key signature N alterations
flatter by removing some sharps and/or adding some flats"))
-(defclass key-signature (element)
- ((%staff :initarg :staff :reader staff)
- (%alterations :initform (make-array 7 :initial-element :natural)
+(defclass staffwise-element (element)
+ ((%staff :initarg :staff :reader staff)))
+(defmethod slots-to-be-saved append ((s-e staffwise-element))
+ '(%staff))
+
+(defclass key-signature (staffwise-element)
+ ((%alterations :initform (make-array 7 :initial-element :natural)
:initarg :alterations :reader alterations)))
(defun make-key-signature (staff &rest args &key alterations)
@@ -320,7 +333,7 @@
(apply #'make-instance 'key-signature :staff staff args))
(defmethod slots-to-be-saved append ((k key-signature))
- '(%staff %alterations))
+ '(%alterations))
(defmethod more-sharps ((sig key-signature) &optional (n 1))
(let ((alt (alterations sig)))
@@ -357,6 +370,20 @@
((eq (aref alt 4) :natural) (setf (aref alt 4) :flat))
((eq (aref alt 0) :natural) (setf (aref alt 0) :flat))
((eq (aref alt 3) :natural) (setf (aref alt 3) :flat))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Time signature
+;; * no make function (no type checking)
+;; * slots-to-be-saved only 'cos it's there
+;; * What accessors do we need (if any)?
+;; * Should I copy the (keysig) functionality from gui.lisp?
+
+(defclass time-signature (staffwise-element)
+ ((%components :initarg :components :reader time-signature-components
+ :initform nil)))
+(defmethod slots-to-be-saved append ((t-s time-signature))
+ '(%components))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
--- /project/gsharp/cvsroot/gsharp/packages.lisp 2008/11/19 16:05:13 1.67
+++ /project/gsharp/cvsroot/gsharp/packages.lisp 2009/04/20 15:04:47 1.68
@@ -41,6 +41,7 @@
#: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-time-signature-component
#:draw-flags-up #:draw-flags-down
#:draw-tie-up #:draw-tie-down
#:with-score-pane #:with-vertical-score-position
@@ -55,7 +56,8 @@
(:shadow #:rest)
(:export #:clef #:name #:lineno #:make-clef
#:staff #:fiveline-staff #:make-fiveline-staff
- #:key-signatures
+ #:key-signatures #:time-signatures
+ #:staffwise-elements
#:lyrics-staff #:make-lyrics-staff
#:gsharp-condition
#:pitch #:accidentals #:dots #:note #:make-note
@@ -91,7 +93,9 @@
#:clef #:f-position #:b-position #:bottom-line
#:keysig #:staff-pos #:xoffset #:read-everything
#:read-buffer-from-stream
+ #:staffwise-element
#:key-signature #:make-key-signature
+ #:time-signature #:time-signature-components
#:alterations #:more-sharps #:more-flats
#:line-width #:lines-per-page #:min-width #:spacing-style
#:right-edge #:left-offset
--- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2007/09/18 21:19:03 1.39
+++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2009/04/20 15:04:47 1.40
@@ -170,6 +170,35 @@
(with-output-as-presentation (stream object 'clef)
(draw-clef stream name x staff-step)))
+;;;;;;;;;;;;;;;;;; time signature
+
+(defun draw-time-signature-component (stream component x)
+ (flet ((component-name (c)
+ (ecase c
+ (1 :time-signature-1)
+ (2 :time-signature-2)
+ (3 :time-signature-3)
+ (4 :time-signature-4)
+ (5 :time-signature-5)
+ (6 :time-signature-6)
+ (7 :time-signature-7)
+ (8 :time-signature-8))))
+ (etypecase component
+ ((integer 1 8)
+ (let* ((design (sdl::ensure-design *font* (component-name component))))
+ (sdl::draw-shape stream *font* design x (staff-step -2))
+ (bounding-rectangle-width design)))
+ ((cons (integer 1 8) (integer 1 8))
+ (destructuring-bind (num . den) component
+ (let* ((num-name (component-name num))
+ (den-name (component-name den))
+ (ndesign (sdl::ensure-design *font* num-name))
+ (ddesign (sdl::ensure-design *font* den-name)))
+ (sdl::draw-shape stream *font* num-name x (staff-step -4))
+ (sdl::draw-shape stream *font* den-name x (staff-step 0))
+ (max (bounding-rectangle-width ndesign)
+ (bounding-rectangle-width ddesign))))))))
+
;;;;;;;;;;;;;;;;;; rest
(defun draw-rest (stream duration x staff-step)
More information about the Gsharp-cvs
mailing list