csr21@59: (in-package "AMUSE-GSHARP")
csr21@59: 
csr21@59: (defmethod time-signatures ((composition gsharp-composition))
csr21@59:   ())
csr21@59: 
d@162: (defmethod get-composition ((id gsharp-gsh-identifier))
d@162:   "Makes a gsharp buffer from .gsh file and generates a composition
d@162: from its first segment. N.B. 1) This is not compatible with
d@162: multi-segment files 2) No application frame is created (=> data flow
d@162: is pretty much one way)"
d@162:   (let ((buffer (with-open-file (s (%gsharp-identifier-pathname id))
d@162:                   (gsharp::read-buffer-from-stream s))))
d@162:     (gsharp::recompute-measures buffer)
d@162:     (segment-composition (car (gsharp::segments buffer)))))
d@162: 
d@162: (defmethod get-composition ((id gsharp-mxml-identifier))
d@162:   "Makes a gsharp buffer from .mxml file and generates a composition
d@162: from its first segment. N.B. 1) This is not compatible with
d@162: multi-segment files 2) No application frame is created (=> data flow
d@162: is pretty much one way)"
d@162:   (let ((buffer (gsharp-mxml::parse-mxml 
d@162:                  (gsharp-mxml::musicxml-document
d@162:                   (%gsharp-identifier-pathname id)))))
d@162:     (gsharp::recompute-measures buffer)
d@162:     (segment-composition (car (gsharp::segments buffer)))))
d@162: 
d@163: ;; These may want another file
d@163: (defun gsh-id (pathname)
d@163:   "Creates an identifier for gsh files, based on a pathname"
d@163:   (make-instance 'gsharp-gsh-identifier :path pathname))
d@163: 
d@163: (defun mxml-id (pathname)
d@163:   "Creates an identifier for MusicXML files, based on a pathname"
d@163:   (make-instance 'gsharp-mxml-identifier :path pathname))
d@163: 
d@162: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
d@162: ;;
d@162: ;; These versions may not be useful, but create and return a gsharp
d@162: ;; application frame as well as a composition
d@162: 
d@162: (defgeneric get-composition-with-application-frame (identifier))
d@162: (defmethod get-composition-with-application-frame ((id gsharp-identifier))
d@162:   (let* ((frame (clim:make-application-frame 'gsharp:gsharp))
d@162:          (clim:*application-frame* frame)
d@162:          (esa:*esa-instance* frame))
d@162:     (clim:adopt-frame (clim:find-frame-manager :server-path '(:null)) frame)
d@162:     (import-from-identifier frame id)
d@162:     (gsharp::recompute-measures (car (esa-buffer::buffers frame)))
d@162:     (values (segment-composition (car (gsharp::segments (car (esa-buffer::buffers frame)))))
d@162:             frame)))
d@162: 
d@162: (defgeneric import-from-identifier (frame id))
d@162: (defmethod import-from-identifier (frame (id gsharp-gsh-identifier))
d@162:   (clim:execute-frame-command frame '(gsharp::com-new-buffer))
d@162:   (gsharp::frame-find-file frame (%gsharp-identifier-pathname id)))
d@162: (defmethod import-from-identifier (frame (id gsharp-mxml-identifier))
d@162:   (clim:execute-frame-command frame `(gsharp::com-import-musicxml ,(%gsharp-identifier-pathname id))))
d@168: 
d@168: (defmethod get-applicable-key-signatures (anchored-period (composition gsharp-composition))
d@168:   (let ((keysigs))
d@177:     (sequence::dosequence (event composition (mapcar #'import-key-signature (reverse keysigs)))
d@168:       (cond
d@168:         ((overlaps event anchored-period)
d@177:          (unless (member (gsharp::keysig (note event)) keysigs)
d@177:            (push (gsharp::keysig (note event)) keysigs)))
d@168:         ((not (before event anchored-period))
d@177:          (return-from get-applicable-key-signatures (mapcar #'import-key-signature (reverse keysigs))))))))
d@177: 
d@177: (defun import-key-signature (gsharp-keysig)
d@177:   ;; FIXME: This is WRONG - shouldn't be using standard key signature,
d@177:   ;; since important detail is lost (very rarely)
d@177:   (make-standard-key-signature-period (- (count :sharp (gsharp::alterations gsharp-keysig))
d@177:                                          (count :flat (gsharp::alterations gsharp-keysig)))
d@177:                                       ()))
d@168: 
d@168: (defmethod crotchet ((object gsharp-object))
d@177:   (make-standard-period 1))
d@177: 
d@177: ;;;
d@177: ;; Experimental
d@177: 
d@177: (defmethod amuse::current-bar ((moment standard-moment)
d@177:                                (composition gsharp-composition))
d@177:   ;; No, I don't know how (or if) these work. But it's a hard problem,
d@177:   ;; so I don't mind cheating.
d@177:   (let ((bar-lengths (gsharp-play::measure-durations
d@177:                       (mapcar #'gsharp-buffer:body
d@177:                               (gsharp-buffer::layers (car (gsharp::segments
d@177:                                                            (amuse-gsharp::buffer composition)))))))
d@177:         (moment-time (timepoint moment)) (now 0))
d@177:     (dolist (bar-duration bar-lengths)
d@177:       (when (> (+ now (* bar-duration 4)) moment-time)
d@177:         (return-from amuse::current-bar
d@177:           (make-standard-anchored-period now (* bar-duration 4))))
d@177:       (incf now (* bar-duration 4)))))
d@177: 
d@177: (defmethod get-applicable-clefs (anchored-period (composition gsharp-composition))
d@177:   (let ((clefs))
d@177:     (sequence::dosequence (event composition (mapcar #'import-clef (reverse clefs)))
d@177:       (cond
d@177:         ((overlaps event anchored-period)
d@177:          (unless (member (gsharp::clef (gsharp::staff (note event))) clefs)
d@177:            (push (gsharp::clef (gsharp::staff (note event))) clefs)))
d@177:         ((not (before event anchored-period))
d@177:          (return-from get-applicable-clefs (mapcar #'import-clef (reverse clefs))))))))