;;; -*- syntax: common-lisp; base: 10; mode: lisp -*-

;;; h-state remembers the state of the state machine
(defparameter h-state t)

;;; this function implements a two state state machine
;;; it "harmonizes" an input note by transposing it
;;; a fourth or a fifth, depending on the current state

(defun harmonize (input)
  (if h-state
      ;; up by a fifth
      (progn
        (setf h-state nil)
        (+ input 7))
    ;; up by a fourth
    (progn
      (setf h-state t)
      (+ input 5))))

(defun harmonize (input)
  (if h-state
      ;; up by a fifth
      (progn
        (setf h-state nil)
	(if (> (hertz (+ input 7))(/ (/ *srate* 2) 4))
	    (- input 7)
	  (+ input 7)))
    ;; up by a fourth
    (progn
      (setf h-state t)
      (+ input 5))))

;;; this example uses the state machine...
(with-sound()
  (loop
    repeat 10
    for time from 0 by 0.2
    for note = 60 then (harmonize note)
    do
    (fm-violin time 0.16 (hertz (if (> note 128) 128 note)) 0.1)))

;;; this second version includes some logic to avoid
;;; eternally rising pitches. If output goes above a
;;; predefined pitch it is transposed two octaves
;;; down

(defun harmonize (input)
  (if h-state
      ;; up by a fifth
      (progn
        (setf h-state nil)
        (if (> input 80) 
            (+ (- input 24) 7)
          (+ input 7)))
    ;; up by a fourth
    (progn
      (setf h-state t)
      (if (> input 70)
          (+ (- input 18) 5)
        (+ input 5)))))

;;; A more complex example

;;; silly-state is the state machine's memory, it
;;; remembers the current state
(defparameter silly-state 1)
(defparameter silly-count 0)

(defun silly-melody (input)
  (format t "state=~s:~s~%" silly-state silly-count)
  (cond
   ;; state 1
   ;; repeats input note, transitions to state=2
   ((= silly-state 1)
    (setf silly-state 2)
    input)
   ;; state 2
   ;; goes up a fourth, transitions to state=3
   ((= silly-state 2)
    (setf silly-state 3)
    (+ input 5))
   ;; state 3
   ;; goes to state=4 (and adds 7 semitones to the input)
   ;; if it has passed through 3 less than three times, 
   ;; otherwise repeats input and transitions to 5
   ((= silly-state 3)
    (if (< silly-count 3)
        (progn
          (setf silly-state 4
                silly-count (+ silly-count 1))
          (+ input 7))
      (progn
        (setf silly-state 5)
        input)))
   ;; state 4
   ;; goes up a tone, transitions back to state=2
   ((= silly-state 4)
    (setf silly-state 2)
    (+ input 2))
   ;; state 5
   ;; end of the state machine work, returns a true
   ;; as second value (if it is ignored then the next
   ;; state is set back to 1
   ((= silly-state 5)
    (setf silly-state 1
          silly-count 0)
    (values input t))))

;;; a modification on the previous state machine to add
;;; some randomness to the state selection and input
;;; processing code

(defun silly-melody (input)
  (format t "state=~s:~s~% " silly-state silly-count)
  (cond
   ;; state 1
   ((= silly-state 1)
    (setf silly-state 2)
    input)
   ;; state 2
   ((= silly-state 2)
    (if (< (random 1.0) 0.9)
        ;; in average 9 out of 10 times we go through
        ;; this state we stay in the same state, we
        ;; change the input by a random ammount
        ;; (+/- 3 semitones)
        (progn
          (setf silly-state 2)
          (+ input (- (random 6) 3)))
      ;;; in average 1 out of 10 times we go ahead to
      ;;; state 3
      (progn
        (setf silly-state 3)
        (+ input 5))))
   ;; state 3
   ((= silly-state 3)
    (if (< silly-count 3)
        (progn
          (setf silly-state 4
                silly-count (+ silly-count 1))
          (+ input 7))
      (progn
        ;;; bounce back pitch if it gets too high
        (setf silly-state 5)
        (if (> input 70)(- input 36) input))))
   ;; state 4
   ((= silly-state 4)
    (setf silly-state 2)
    (+ input 2))
   ;; state 5
   ((= silly-state 5)
    (setf silly-state 1
          silly-count 0)
    (values input t))))

;;; an example that drives the silly melody state machine

(with-sound()
  (loop
    repeat 20
    with note = 60 
    for time from 0 by 0.2
    do
    ;; we catch two returned values ("t" is end of melody)
    ;; for now we ignore the second value ("repeat" sets the
    ;; number of notes generated
    (multiple-value-bind (next end)
        (silly-melody note)
      (fm-violin time 0.16 (hertz (if (> note 128) 128 note)) 0.1)
      (setf note next)
      )))

(with-sound()
  (loop
    with note = 60 
    for time from 0 by 0.2
    do
    ;; we catch two returned values ("t" is end of melody)
    ;; end loop when the second value is "t"
    (multiple-value-bind (next end)
        (silly-melody note)
      (fm-violin time 0.16 (hertz (if (> note 128) 128 note)) 0.1)
      (setf note next)
      (if end (loop-finish)))))


;;;
;;; Markov Chains
;;;

(define happy-birthday 
     (note '(c4 c d c f e c c d c g f c c c5 a4 f e d bf bf a f g f)))



(markov-analyze happy-birthday :order 2)

(setf x (NEW MARKOV OF
     '((A4 F4 -> (E4 0.5) (G4 0.5)) (BF4 A4 -> (F4 1.0)) (BF4 BF4 -> (A4 1.0))
       (C4 C4 -> (D4 0.667) (C5 0.333)) (C4 C5 -> (A4 1.0))
       (C4 D4 -> (C4 1.0)) (C4 F4 -> (E4 1.0)) (C4 G4 -> (F4 1.0))
       (C5 A4 -> (F4 1.0)) (D4 BF4 -> (BF4 1.0)) (D4 C4 -> (F4 0.5) (G4 0.5))
       (E4 C4 -> (C4 1.0)) (E4 D4 -> (BF4 1.0)) (F4 C4 -> (C4 1.0))
       (F4 E4 -> (C4 0.5) (D4 0.5)) (F4 G4 -> (F4 1.0)) (G4 F4 -> (C4 1.0)))))


(with-sound(:srate 44100)
  (loop
    repeat 20
    for time from 0 by 0.2
    for note = (next x)
    do
    (fm-violin time 0.16 (hertz note) 0.1)))

(with-sound(:srate 44100)
  (loop
    repeat 20
    with time = 0 
    for note = (next x)
    do
    (fm-violin time 0.16 440.0 0.1)
    (format t "~d " (keynum note))
    (incf time (/ (keynum note) 128))))

(with-sound(:srate 44100)
  (loop
    repeat 20
    with time = 0 
    for note = (next x)
    do
;;    (fm-violin time 0.16 440.0 0.1)
    (format t "~d " (keynum note))
    (incf time (/ (keynum note) 128))))