c@43: (in-package "AMUSE-TABCODE")
c@43: 
c@43: (defmethod tempi ((composition tabcode-composition))
c@43:   ())
c@43: (defmethod time-signatures ((composition tabcode-composition))
c@43:   ())
c@43: 
d@179: (defmethod get-applicable-key-signatures (object (composition tabcode-composition))
d@179:  ())
d@179: 
d@179: (defmethod crotchet ((object tabcode-object))
d@179:   (make-standard-period 1))
d@179: 
d@179: (defmethod current-bar ((moment standard-moment) (composition tabcode-composition))
d@179:   (find-if #'(lambda (x) (and (time< moment (cut-off x))
d@179: 			      (time>= moment (onset x))))
d@179: 	   (tabcode-bars composition)))
d@179: 
d@179: (defmethod current-beat ((moment standard-moment) (composition tabcode-composition))
d@179:   ;; clearly broken, but can unbreak unusual cases as they arise (?!)
d@179:   (let ((bar (current-bar moment composition))
d@179: 	(metre (find-if #'(lambda (x) (and (time< moment (cut-off x))
d@179: 					   (time>= moment (onset x))))
d@179: 			(metrical-signs composition))))
d@179:     (unless (and bar metre)
d@179:       (error 'insufficient-information
d@179: 	     :operation 'beat-period
d@179: 	     :datatype (class-of composition)))
d@179:     (let ((beats-in-bar) (beat-duration))
d@179:       (cond
d@179: 	((ur metre)
d@179: 	 ;; we have a weird compound signature, goodness knows what to
d@179: 	 ;; do. This probably means that one of them is a proportion
d@179: 	 ;; sign.
d@179: 	 (error 'insufficient-information
d@179: 		:operation 'beat-period
d@179: 		:datatype (class-of composition)))
d@179: 	((and (ll metre)
d@179: 	      (numberp (ll metre)) ;; we have a `standard
d@179: 	      (numberp (ul metre)));; time sig'
d@179: 	 (setf beats-in-bar (ul metre)
d@179: 	       beat-duration (/ 4 (ll metre)))
d@179: 	 (when (and (> beats-in-bar 3)
d@179: 		    (= (rem beats-in-bar 3) 0))
d@179: 	   (setf beats-in-bar (/ beats-in-bar 3)
d@179: 		 beat-duration (* beat-duration 3))))
d@179: 	((and (null (ll metre))
d@179: 	      (numberp (ul metre)))
d@179: 	 (setf beats-in-bar (ul metre))
d@179: 	 (do ((proportion 4 (/ proportion 2)))
d@179: 	     ((= (rem (/ (duration bar) proportion)
d@179: 		      beats-in-bar) 0)
d@179: 	      (setf beat-duration proportion))))
d@179: 	((null (ll metre))
d@179: 	 (cond
d@179: 	   ((string= (ul metre) "C")
d@179: 	    (setf beats-in-bar 4)
d@179: 	    (setf beat-duration 1))
d@179: 	   ((string= (ul metre) "C/")
d@179: 	    (setf beats-in-bar 2)
d@179: 	    (setf beat-duration 2)))))
d@179:       (unless (= (rem (duration bar)
d@179: 		      (* beat-duration beats-in-bar))
d@179: 		 0)
d@179: 	(error "Bar length doesn't match metrical symbol, I think"))
d@179:       (let ((beat-period (make-standard-anchored-period
d@179: 			  (timepoint bar) beat-duration)))
d@179: 	(do ()
d@179: 	    ((time> (cut-off beat-period) moment) beat-period)
d@179: 	  (setf (timepoint beat-period)
d@179: 		(timepoint (cut-off beat-period))))))))
d@179: