(in-package :cm)

(clock-mode ':milliseconds)

;;;
;;; Example 1. Algorithm amplitude controlled by 
;;; velocity of midi input
;;;

(defparameter Velocity 64)

;;; Writer sends random notes at random times for 20 seconds. 
;;; The amplitude of each note is taken from Velocity. 

;;; message-handler sends its message out and updates Velocity if
;;; the message is a noteOn with velocity > 0.

(defun message-handler (msg now)
  (midi-write-message msg now)
  (midi-message-case msg
    (key-down
     (setf velocity (note-on-velocity msg)))))

(algorithm writer midi-note (end 20000 duration 2000)
  (setf rhythm (between 50 500))
  (setf note (between 40 90))
  (setf amplitude velocity))

;;; Reader reads all pending midi messages every 10 milliseconds.

(mute reader (rhythm 10 end 20000)
  (midi-read-messages #'message-handler))


#|
(stella)
open midi scheduling realtime clock milliseconds
mix reader,writer 1000
|#


;;;
;;; Example 2: MIDI Receive echos.
;;; Each key down produces between 4 and 11 echos; the higher
;;; the velocity the faster the echo
;;;

(defun echos (msg now)
  (midi-write-message msg now)
  (midi-message-case msg
    (key-down
     (let* ((amp (note-on-velocity msg))
            (len (between 4 12))
            (wait (round (interpl amp 10 800 127 50)))
            (dur (* wait 5))
            (off msg))
       (setf (note-on-velocity off) 0)
       (loop repeat len
             do 
             (setf (note-on-velocity msg)
             (setf amp (round (* amp .8))))
             (midi-write-message msg (incf now wait))
             (midi-write-message off (+ now dur)))))))

#|
(stella)
open midi
receive echos

receive
|#

;;;
;;;
;;; Example 3: real time graphics --- MCL only ---
;;; You must compile and load automata.lisp before
;;; trying this example.
;;;

(load "hd:lisp:cm:doc:examples:automata")

(defparameter win nil)
(defparameter siz 24)

(defun draw-state (view color row col size)
  (let ((x (* col size))
        (y (* row size)))
    (ccl:with-focused-view view
      (ccl:with-fore-color color
        (ccl:fill-rect view ccl:*black-pattern* 
                       x y (+ x size) (+ y size))))))

(defun 8states (auto index)
  (with-states auto index ((left -1) (here 0) (right 1))
    (values (mod (1+ here) 2)
            (+ (* left 4) (* here 2) right))))

(defun win (&aux (rows 8) (cols 8) )
  (setf win (make-instance 'ccl:window :window-show nil
                           :window-type :document))
  (ccl:set-view-size win (xy (* cols siz) (* rows siz)))
  (ccl:window-show win))

(algorithm 8notes midi-note (length (* 64 3))
  (vars (auto (make-instance 'automata :cells '(0 1 1 0 1 0 1 1)
                             :rule #'8states))
        (indicies (vector 0 1 2 3 4 5 6 7))
        (notes (vector 'c4 'fs4 'af4 'b4 'd5 'ef5 'e5 'g5))
        (colors
         (vector ccl:*pink-color* ccl:*purple-color* 
                 ccl:*yellow-color* ccl:*red-color*
                 ccl:*green-color*  ccl:*brown-color*
                 ccl:*blue-color* ccl:*orange-color*))
        state index)
  (setf state (state auto))
  (setf index (svref indicies state))
  (setf note (svref notes index))
  (setf rhythm (round (rescale state 0 7 150 400)))
  (setf duration rhythm)
  (setf rhythm (round rhythm 2))
  (multiple-value-bind (r c) (floor (mod count 64) 8)
    (draw-state win (svref colors index) r c siz)
    (when (= r c 7)
      (shuffle indicies))))


#|
(stella)
open midi scheduling realtime clock milliseconds initializer win
mix 8notes 1000

|#

;;;
;;; Example 4: MIDI Receive, parallel random voices.
;;;

(defvar ons (make-hash-table))

(defparameter npairs 8)  ; 12 starts stuttering in mcl3.0/mcl-midi

; (clrhash ons)
     
(defun random-voices (msg now)
  (midi-write-message msg now)
  (midi-message-case msg
    (key-down
     (loop with key = (note-on-key msg)
           repeat npairs
           for on1 = msg
           for on2 = msg
           do
           (setf (note-on-key on1) (between key 128))
           (setf (note-on-key on2) (between 0 key))
           (midi-write-message on1 now)
           (midi-write-message on2 now)
           collect on1 into list
           collect on2 into list
           finally (push list (gethash key ons))))
    (key-up
     (dolist (m (pop (gethash (note-off-key msg) ons)))
       (setf (note-on-velocity m) 0)
       (midi-write-message m now)))))


#|
(stella)
open midi
receive random-voices

receive
|#