;; MIDI-tools_1.html
;; neuromuse
;;Frederic Voisin, 2001 -2003
;; ce fichier a servi a l'execution temps-reel du programme LISP neuromuse#0.lisp utilise pour la creation de "L'Ecarlate"
;;(Gourfink, Toeplitz et Voisin), IRCAM, Festival Agora 2001


(defvar *GO* nil)
(setf *GO* nil)


(defun send-ctl (ctl val ch)
   (let ((event (midishare::MidiNewEv midishare::typeCtrlChange)))    ; ask for a new note event
     (unless (%null-ptr-p event)    ; if the allocation was succesfull
       (midishare::chan event ch)            ; set the midi channel to 0 (means channel 1)
       (midishare::port event 0)            ; set the destination port to Modem
       (midishare::field event 0 ctl)        ; set the pitch field
       (midishare::field event 1 val)        ; set the velocity field
       (midishare::MidiSendIm *refnum* event))    ; send the note immediatly
     ))


;midishare::*refnum*
;(setf *refnum* 2)

(defun wait-for (time)
  (let ((start (float (/ (get-internal-real-time) internal-time-units-per-second))))
    (loop
          until (or (>= (- (float (/ (get-internal-real-time)
                                     internal-time-units-per-second))
                           start)
                    time)
                    *GO*)
          do nil
          )
    t))


;(wait-for 10)

(defun init-sin ()
    (format t "~% Initializing...")
    (setf *GO* nil)
    (send-ctl 3 1 0)
    (send-ctl 2 0 0)
    (send-ctl 1 0 0)
  (dotimes (n 74)
    (wait-for .05)
    (send-ctl (1+ n) 0 1)
        (send-ctl (1+ n) 0 2)
    )
  (format t "~% Init done.")
  )


;(init-sin)


(defvar *t* .05)

(defvar *timefact* 1.)

(defvar *end* nil)

(defvar *pert* 100)


(defvar *TEMP* 0) ; temperature du reseau

(defun run-sin ()
    (gc)
    (init-sin)
    (setf *dur* (remove 0 *dur*))
    (setf *end* nil)
    (setf *t* .05)
    (setf *timefact* 1.)
    (let ((r (make-list 75 :initial-element  (list (coerce '(.01 .2 .95) 'vector))
              ))
              (n 0)
              (maindur 0)
              ;(perturbation (scale *ecarts*
       ;                   (apply #'min *ecarts*)
       ;                   (apply #'max *ecarts*)
       ;                   0 127))
              ;(perturb-length (length *ecarts*))
       (trigsnd (scale *dur* (apply #'min *dur*) (apply #'max *dur*) 1 100)))
    (setf (recurrent-layer-activation sin1C)  (coerce (make-list 8 :initial-element 0) 'vector))
        (format t "~%Reso starting...")
        (loop until *end*
                  do
                  (incf n)
                  ;(dotimes (n (length (recurrent-layer-activation sin1C)))
          ; (setf (elt (recurrent-layer-activation sin1C) n )
           ;      (+ (elt (recurrent-layer-activation sin1C) n )
            ;        (* *TEMP* (random 1.0)))))
                  (let (deltaT)
                      (push (run-mlp sin1C
                          (print (concatenate 'vector (coerce (list *t*) 'vector)
                                              (caar r)))
                          :thresh 1 :slope 1)
                                 (car r))
                      
                      (setf deltaT (* *timefact* (scale (elt (caar r) 2) .0 1. 1 20.))
                               maindur (+ maindur deltat))
                      (format t "~%STEP ~S Delta T : ~S Time = ~S:~S" n deltaT
                                    (floor (/ (round maindur) 60))
                                    (mod (round maindur) 60))
           (send-ctl 1 (round (scale maindur .0 1190. 0 127)) 4) ;time
           (when (> maindur 90) ; pas tout de suite...
             (send-ctl 2 (round
                          (nth (floor (* (min 1. (/ maindur 1160)) (1- (length trigsnd)))) trigsnd))
                                             4))
           (send-ctl 3 (round (scale deltaT 1. 20. 0 127)) 0)
           (send-ctl 2 (nth (floor (* (min 1. (/ maindur 1160)) (1- (length amp)))) amp) 0)
                      (send-ctl 1 (round (scale (elt (caar r) 0) .0 .95 0 127)) 0)
           (dotimes (s 74)
             (let ((reso (eval `(symbol-value (read-from-string (format nil "|sin~SC|" (1+ ,s)))))))
               (dotimes (h (length (recurrent-layer-activation reso)))
                 (setf (elt (recurrent-layer-activation reso) h )
                       (+ (elt (recurrent-layer-activation reso) h )
                          (* *TEMP* (random 1.0)))))
               (push (run-mlp reso
                              (concatenate 'vector (coerce (list *t*) 'vector)
                                           (car (nth (1+ s) r)))
                              :thresh 1 :slope 1)
                     (nth (1+ s) r))
               (wait-for (float (/ deltat 60)))
               (send-ctl (1+ s)
                                                  (random (+ 50 *pert*))
                         3)
                              (send-ctl (1+ s)
                                                  (+ 50  (random *pert*))
                         2)
                              (send-ctl (1+ s)
                         (round (scale (elt (car (nth (1+ s) r)) 0) .0 .95 0 127))
                         1)))
                      (when (> maindur 1200) (setf *end* t))
           ))
        (send-ctl 3 120 0)
        (send-ctl 2 0 0)
    (dotimes (n 74)
             (wait-for .05)
             (send-ctl (1+ n) 0 2)
                          )
        )
    (format t "~%sin DONE.")
    (values)
    )

#|

(init-sin)
(PROCESS-KILL *midi-monitor-process*)
(setf *ecarts* (echant (remove 0 *ecarts*) 100))
(run-sin)


(setf *t* .05)
(setf *temp* .5)
(setf *timefact* 1.)
(setf *end* t)
(setf *pert* 50)
|#

;;fredv