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))
d@181:   (metrical-signs composition))
d@183: (defmethod amuse-tools:get-patch-for-midi ((event tabcode-object))
d@183:   24)
d@183: (defmethod amuse-tools:get-velocity-for-midi ((event tabcode-object))
d@183:   70)
d@183: (defmethod amuse-tools:default-tempo-for-midi ((tab-comp tabcode-composition))
d@183:   (make-standard-tempo-period 60 (timepoint tab-comp) (duration tab-comp)))
d@179: (defmethod get-applicable-key-signatures (object (composition tabcode-composition))
d@183:   (restart-case 
d@183:       (error 'insufficient-information
d@183: 	     :operation 'beat-period
d@183: 	     :datatype (class-of composition))
d@183:     (amuse:guess () (multiple-value-bind (x key)
d@183: 			(amuse-harmony:krumhansl-key-finder composition composition)
d@183: 		      (declare (ignore x))
d@183: 		      (list key)))))
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@183:   (let ((bar (current-bar moment composition)))
d@183:     (restart-case
d@183: 	(let ((metre (find-if #'(lambda (x) (and (time< moment (cut-off x))
d@183: 						 (time>= moment (onset x))))
d@183: 			      (metrical-signs composition))))
d@183: 	  (unless (and bar metre)
d@183: 	    (error 'insufficient-information
d@183: 		   :operation 'beat-period
d@183: 		   :datatype (class-of composition)))
d@183: 	  (let ((beats-in-bar) (beat-duration))
d@183: 	    (cond
d@183: 	      ((ur metre)
d@183: 	       ;; we have a weird compound signature, goodness knows what to
d@183: 	       ;; do. This probably means that one of them is a proportion
d@183: 	       ;; sign. Better errors would be a gould start.
d@183: 	       (error 'insufficient-information
d@183: 		      :operation 'beat-period
d@183: 		      :datatype (class-of composition)))
d@183: 	      ((and (ll metre)
d@183: 		    (numberp (ll metre)) ;; we have a `standard
d@183: 		    (numberp (ul metre)));; time sig'
d@183: 	       (setf beats-in-bar (ul metre)
d@183: 		     beat-duration (/ 4 (ll metre)))
d@183: 	       (when (and (> beats-in-bar 3)
d@183: 			  (= (rem beats-in-bar 3) 0))
d@183: 		 (setf beats-in-bar (/ beats-in-bar 3)
d@183: 		       beat-duration (* beat-duration 3))))
d@183: 	      ((and (null (ll metre))
d@183: 		    (numberp (ul metre)))
d@183: 	       (setf beats-in-bar (ul metre))
d@183: 	       (do ((proportion 4 (/ proportion 2)))
d@183: 		   ((= (rem (/ (duration bar) proportion)
d@183: 			    beats-in-bar) 0)
d@183: 		    (setf beat-duration proportion))
d@183: 		 (unless (>= proportion 1/4)
d@183: 		   (setf beat-duration (round (/ (duration bar)
d@183: 						 beats-in-bar)))
d@183: 		   (return))))
d@183: 	      ((null (ll metre))
d@183: 	       (cond
d@183: 		 ((string= (ul metre) "C")
d@183: 		  (setf beats-in-bar 4)
d@183: 		  (setf beat-duration 1))
d@183: 		 ((string= (ul metre) "C/")
d@183: 		  (setf beats-in-bar 2)
d@183: 		  (setf beat-duration 2)))
d@183: 	       ;; clearly wrong, but for the time being try this (better is
d@183: 	       ;; work out for the whole piece
d@183: 	       (do ((proportion 4 (/ proportion 2)))
d@183: 		   ((= (rem (/ (duration bar) proportion)
d@183: 			    beats-in-bar) 0)
d@183: 		    (setf beat-duration proportion))
d@183: 		 (unless (>= proportion 2)
d@183: 		   (setf beat-duration 2)
d@183: 		   (return)))))
d@183: 	    (unless (= (rem (duration bar)
d@183: 			    (* beat-duration beats-in-bar))
d@183: 		       0)
d@183: 	      (print "Bar length doesn't match metrical symbol, I think"))
d@183: 	    (find-current-beat-with-bar-start-and-constant-beat
d@183: 	     moment bar beat-duration)))
d@183:       (amuse:use-whole-bar () :report "Use whole bar" bar)
d@183:       (amuse:use-crotchet-beat () :report "Use crotchet as beat"
d@183: 			 (find-current-beat-with-bar-start-and-constant-beat
d@183: 			  moment bar 1))
d@183:       (use-value-for-beat (new-beat) :report "Supply beat"
d@183: 			  :interactive (lambda ()
d@183: 					 (format t "Beat value:")
d@183: 					 (list (eval (read))))
d@183: 			  (find-current-beat-with-bar-start-and-constant-beat
d@183: 			   moment bar new-beat)))))
d@183:     
d@183: (defun find-current-beat-with-bar-start-and-constant-beat (current-moment bar-period beat-duration)
d@183:   (let ((beat-period (make-standard-anchored-period
d@183: 		      (timepoint bar-period) beat-duration)))
d@183:     (do ()
d@183: 	((time> (cut-off beat-period) current-moment) beat-period)
d@183:       (setf (timepoint beat-period)
d@185: 	    (timepoint (cut-off beat-period))))))
d@185: 
d@185: (defmethod amuse-tools::gsharp-staff-string ((event tabcode-pitched-event))
d@185:   (if (< (midi-pitch-number event) 60)
d@185:       "bass"
d@185:       "treble"))