(in-package :stella)

;;; The fm instrument definition.
;;;
 
(definstrument fm (start duration frequency amplitude 
                           &key (amplitude-envelope 
                                  '(0 0 25 1 75 1 100 0))
                                (mratio 1) (index 1)
                                (index-envelope '(0 1 100 1))
                                (degree 0) (distance 0)
                                (reverb 0))
  (let (beg end car mod ampf indf ind loc)
    (multiple-value-setq (beg end) (get-beg-end start duration))
    (setf car (make-oscil :frequency frequency))
    (setf mod (make-oscil :frequency (* frequency mratio)))
    (setf ind (in-hz (* frequency mratio index)))
    (setf ampf (make-env :envelope amplitude-envelope 
                         :scaler amplitude :start beg 
                         :end end))
    (setf indf (make-env :envelope index-envelope 
                         :scaler ind :start beg :end end))
    (setf loc (make-locsig :degree degree :distance distance 
                           :revscale reverb))
    (Run
      (loop for i from beg to end
            do
        (locsig loc i (* (env ampf) 
                         (oscil car (* (env indf)
                                       (oscil mod)))))))))

;;;
;;; The Fm object class definition
;;;

(defobject fm (note)
  ((instrument :initform 'fm) 
   duration
   frequency
   amplitude 
   amplitude-envelope
   mratio
   index
   index-envelope
   degree
   distance
   reverb))

;;;
;;; The output method for clm sound files.
;;;

(defmethod write-event ((object fm) (stream clm-sound-file))
  ;; call the clm instrument with our data in the proper format
  (apply (slot-value object 'instrument) 
    (collecting-slots object time duration frequency amplitude
                      &key amplitude-envelope mratio index 
                           index-envelope degree distance reverb)))

;;;
;;;  A scorefile printing method for CLM.
;;;

(defmethod write-event ((object fm) (stream clm-event-file))
  ;; prints a left paren, slot data, right paren and end-of-line.
  (let ((file (slot-value stream 'stream)))
    (formatting-slots (object file :preamble "(" :postamble ")" :eol t)
                      instrument time duration frequency amplitude
                      &key amplitude-envelope mratio index 
                           index-envelope degree distance reverb)))

;;;
;;; An object printing method for listing, etc.
;;;

(defmethod print-object ((object fm) stream)
  ;; printing-random-thing surrounds output with < > delimiters.
  (printing-random-thing (object stream)
    (formatting-slots (object stream :print-if :always)
                      instrument rhythm duration frequency amplitude
                      &key amplitude-envelope mratio index 
                           index-envelope degree distance reverb)))
