(defmodule um.note
  (export all))

;;;;;;;;;;;;;
;;; PITCH ;;;
;;;;;;;;;;;;;

(defun	G9	()	127	)
(defun	F#9	()	126	)
(defun	Gb9	()	126	)
(defun	F9	()	125	)
(defun	E9	()	124	)
(defun	D#9	()	123	)
(defun	Eb9	()	123	)
(defun	D9	()	122	)
(defun	C#9	()	121	)
(defun	Db9	()	121	)
(defun	C9	()	120	)
(defun	B8	()	119	)
(defun	A#8	()	118	)
(defun	Bb8	()	118	)
(defun	A8	()	117	)
(defun	G#8	()	116	)
(defun	Ab8	()	116	)
(defun	G8	()	115	)
(defun	F#8	()	114	)
(defun	Gb8	()	114	)
(defun	F8	()	113	)
(defun	E8	()	112	)
(defun	D#8	()	111	)
(defun	Eb8	()	111	)
(defun	D8	()	110	)
(defun	C#8	()	109	)
(defun	Db8	()	109	)
(defun	C8	()	108	)
(defun	B7	()	107	)
(defun	A#7	()	106	)
(defun	Bb7	()	106	)
(defun	A7	()	105	)
(defun	G#7	()	104	)
(defun	Ab7	()	104	)
(defun	G7	()	103	)
(defun	F#7	()	102	)
(defun	Gb7	()	102	)
(defun	F7	()	101	)
(defun	E7	()	100	)
(defun	D#7	()	99	)
(defun	Eb7	()	99	)
(defun	D7	()	98	)
(defun	C#7	()	97	)
(defun	Db7	()	97	)
(defun	C7	()	96	)
(defun	B6	()	95	)
(defun	A#6	()	94	)
(defun	Bb6	()	94	)
(defun	A6	()	93	)
(defun	G#6	()	92	)
(defun	Ab6	()	92	)
(defun	G6	()	91	)
(defun	F#6	()	90	)
(defun	Gb6	()	90	)
(defun	F6	()	89	)
(defun	E6	()	88	)
(defun	D#6	()	87	)
(defun	Eb6	()	87	)
(defun	D6	()	86	)
(defun	C#6	()	85	)
(defun	Db6	()	85	)
(defun	C6	()	84	)
(defun	B5	()	83	)
(defun	A#5	()	82	)
(defun	Bb5	()	82	)
(defun	A5	()	81	)
(defun	G#5	()	80	)
(defun	Ab5	()	80	)
(defun	G5	()	79	)
(defun	F#5	()	78	)
(defun	Gb5	()	78	)
(defun	F5	()	77	)
(defun	E5	()	76	)
(defun	D#5	()	75	)
(defun	Eb5	()	75	)
(defun	D5	()	74	)
(defun	C#5	()	73	)
(defun	Db5	()	73	)
(defun	C5	()	72	)
(defun	B4	()	71	)
(defun	A#4	()	70	)
(defun	Bb4	()	70	)
(defun	A4	()	69	)
(defun	G#4	()	68	)
(defun	Ab4	()	68	)
(defun	G4	()	67	)
(defun	F#4	()	66	)
(defun	Gb4	()	66	)
(defun	F4	()	65	)
(defun	E4	()	64	)
(defun	D#4	()	63	)
(defun	Eb4	()	63	)
(defun	D4	()	62	)
(defun	C#4	()	61	)
(defun	Db4	()	61	)
(defun	C4	()	60	)
(defun	B3	()	59	)
(defun	A#3	()	58	)
(defun	Bb3	()	58	)
(defun	A3	()	57	)
(defun	G#3	()	56	)
(defun	Ab3	()	56	)
(defun	G3	()	55	)
(defun	F#3	()	54	)
(defun	Gb3	()	54	)
(defun	F3	()	53	)
(defun	E3	()	52	)
(defun	D#3	()	51	)
(defun	Eb3	()	51	)
(defun	D3	()	50	)
(defun	C#3	()	49	)
(defun	Db3	()	49	)
(defun	C3	()	48	)
(defun	B2	()	47	)
(defun	A#2	()	46	)
(defun	Bb2	()	46	)
(defun	A2	()	45	)
(defun	G#2	()	44	)
(defun	Ab2	()	44	)
(defun	G2	()	43	)
(defun	F#2	()	42	)
(defun	Gb2	()	42	)
(defun	F2	()	41	)
(defun	E2	()	40	)
(defun	D#2	()	39	)
(defun	Eb2	()	39	)
(defun	D2	()	38	)
(defun	C#2	()	37	)
(defun	Db2	()	37	)
(defun	C2	()	36	)
(defun	B1	()	35	)
(defun	A#1	()	34	)
(defun	Bb1	()	34	)
(defun	A1	()	33	)
(defun	G#1	()	32	)
(defun	Ab1	()	32	)
(defun	G1	()	31	)
(defun	F#1	()	30	)
(defun	Gb1	()	30	)
(defun	F1	()	29	)
(defun	E1	()	28	)
(defun	D#1	()	27	)
(defun	Eb1	()	27	)
(defun	D1	()	26	)
(defun	C#1	()	25	)
(defun	Db1	()	25	)
(defun	C1	()	24	)
(defun	B0	()	23	)
(defun	A#0	()	22	)
(defun	Bb0	()	22	)
(defun	A0	()	21	)
(defun	G#0	()	20	)
(defun	Ab0	()	20	)
(defun	G0	()	19	)
(defun	F#0	()	18	)
(defun	Gb0	()	18	)
(defun	F0	()	17	)
(defun	E0	()	16	)
(defun	D#0	()	15	)
(defun	Eb0	()	15	)
(defun	D0	()	14	)
(defun	C#0	()	13	)
(defun	Db0	()	13	)
(defun	C0	()	12	)
(defun	B-1	()	11	)
(defun	A#-1	()	10	)
(defun	Bb-1	()	10	)
(defun	A-1	()	9	)
(defun	G#-1	()	8	)
(defun	Ab-1	()	8	)
(defun	G-1	()	7	)
(defun	F#-1	()	6	)
(defun	Gb-1	()	6	)
(defun	F-1	()	5	)
(defun	E-1	()	4	)
(defun	D#-1	()	3	)
(defun	Eb-1	()	3	)
(defun	D-1	()	2	)
(defun	C#-1	()	1	)
(defun	Db-1	()	1	)
(defun	C-1	()	0	)

(defun midi-names ()
  #m(
G9	127
F#9	126
Gb9	126
F9	125
E9	124
D#9	123
Eb9	123
D9	122
C#9	121
Db9	121
C9	120
B8	119
A#8	118
Bb8	118
A8	117
G#8	116
Ab8	116
G8	115
F#8	114
Gb8	114
F8	113
E8	112
D#8	111
Eb8	111
D8	110
C#8	109
Db8	109
C8	108
B7	107
A#7	106
Bb7	106
A7	105
G#7	104
Ab7	104
G7	103
F#7	102
Gb7	102
F7	101
E7	100
D#7	99
Eb7	99
D7	98
C#7	97
Db7	97
C7	96
B6	95
A#6	94
Bb6	94
A6	93
G#6	92
Ab6	92
G6	91
F#6	90
Gb6	90
F6	89
E6	88
D#6	87
Eb6	87
D6	86
C#6	85
Db6	85
C6	84
B5	83
A#5	82
Bb5	82
A5	81
G#5	80
Ab5	80
G5	79
F#5	78
Gb5	78
F5	77
E5	76
D#5	75
Eb5	75
D5	74
C#5	73
Db5	73
C5	72
B4	71
A#4	70
Bb4	70
A4	69
G#4	68
Ab4	68
G4	67
F#4	66
Gb4	66
F4	65
E4	64
D#4	63
Eb4	63
D4	62
C#4	61
Db4	61
C4	60
B3	59
A#3	58
Bb3	58
A3	57
G#3	56
Ab3	56
G3	55
F#3	54
Gb3	54
F3	53
E3	52
D#3	51
Eb3	51
D3	50
C#3	49
Db3	49
C3	48
B2	47
A#2	46
Bb2	46
A2	45
G#2	44
Ab2	44
G2	43
F#2	42
Gb2	42
F2	41
E2	40
D#2	39
Eb2	39
D2	38
C#2	37
Db2	37
C2	36
B1	35
A#1	34
Bb1	34
A1	33
G#1	32
Ab1	32
G1	31
F#1	30
Gb1	30
F1	29
E1	28
D#1	27
Eb1	27
D1	26
C#1	25
Db1	25
C1	24
B0	23
A#0	22
Bb0	22
A0	21
G#0	20
Ab0	20
G0	19
F#0	18
Gb0	18
F0	17
E0	16
D#0	15
Eb0	15
D0	14
C#0	13
Db0	13
C0	12
B-1	11
B	11
A#-1	10
Bb-1	10
A#	10
Bb	10
A-1	9
A	9
G#-1	8
Ab-1	8
G#	8
Ab	8
G-1	7
G	7
F#-1	6
Gb-1	6
F#	6
Gb	6
F-1	5
F	5
E-1	4
E	4
D#-1	3
Eb-1	3
D#	3
Eb	3
D-1	2
D	2
C#-1	1
Db-1	1
C#	1
Db	1
C-1	0
C       0
))

(defun get-pitch (name)
  (mref (midi-names) name))

(defun get-pitches (names)
  (let ((all (midi-names)))
    (list-comp ((<- n names))
      (mref all n))))

(defun make
  ((names) (when (is_list names))
   (list-comp ((<- n names)) (make n)))
  ((name)
   (make name (get-velocity 'mp))))

(defun make (name velocity)
  (make name velocity 100))

(defun make (name velocity duration)
  (make name velocity duration 0))

(defun make
  ((name velocity duration delay) (when (is_atom name))
   (make (get-pitch name) velocity duration delay))
  ((pitch velocity duration delay)
   `#m(pitch ,pitch
       velocity ,velocity
       duration ,duration
       delay ,delay)))

(defun make-fuzzy
  ((names) (when (is_list names))
   (list-comp ((<- n names)) (make-fuzzy n)))
  ((n-or-p)
   (make-fuzzy n-or-p (default-values))))

(defun make-fuzzy (n-or-p vals)
  (make-fuzzy n-or-p vals (default-variances)))

(defun make-fuzzy
  ((name vals variances) (when (is_atom name))
   (make-fuzzy (get-pitch name) vals variances))
  ((pitch values variances)
   (let ((`#m(velocity ,v duration ,dur delay ,del)
             (maps:merge (default-values) values))
         (`#m(velocity ,v-var duration ,dur-var delay ,del-var)
             (maps:merge (default-variances) variances)))
    `#m(pitch ,pitch
        velocity ,(fuzzy-velocity v v-var)
        duration ,(fuzzy-duration dur dur-var)
        delay ,(fuzzy-delay del del-var)))))

(defun default-values ()
  `#m(velocity ,(get-velocity 'mp)
      duration 100
      delay 0))

(defun default-variances ()
  #m(velocity 2
     duration 2
     delay 150))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; NOTE VALUE, DURATION & DELAY (before playing) ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun values ()
  '(2                 ; double note / breve 
    1                 ; whole note / semibreve 
    1/2               ; half note / minim 
    1/4               ; quarter note / crotchet
    1/8               ; eighth note / quaver
    1/16              ; sixteenth note / semiquaver
    1/32              ; thirty-second note / demisemiquaver
    1/64              ; sixty-fourth note / hemidemisemiquaver
    1/128             ; semihemidemisemiquaver
    ))

(defun value-multipliers ()
  `#m(;; notes
      (n 1.0)
      (n. 1.5)
      (n.. 1.75)
      (n... 1.875)
      ;; rests
      (r 1.0)
      (r. 1.5)
      (r.. 1.75)
      (r... 1.875)))

(defun fuzzy-duration (ms)
  (fuzzy-duration ms (mref (default-variances) 'duration)))

(defun fuzzy-duration (ms variance)
  (round (abs (rand:normal ms variance))))

(defun fuzzy-delay (ms)
  (fuzzy-delay ms (mref (default-variances) 'delay)))

(defun fuzzy-delay (ms variance)
  (round (abs (rand:normal ms variance))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; DYNAMICS & VELOCITY ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;

#| The initial division of the range 0-127 into the ppp to fff dynamic ranges
(of which there are eight) was done in the following manner:

lfe> (list-comp ((<- x (lutil-lists:chunks (lists:seq 10 120)
                                            8 ; <-- number of parts
                                            #(by-parts))))
                (lists:nth 7 x))
Which gave:
(16 30 44 58 72 86 100 114)

Note that these may be changed to taste/hearing at a latter date.
|#
(defun dynamics ()
  '(#(ffff 127)
    #(fff  114) ; Fortississimo
    #(ff   100) ; Fortissimo
    #(f     86) ; Forte
    #(mf    72) ; Mezzo forte
    #(mp    58) ; Mezzo piano
    #(p     44) ; Piano
    #(pp    30) ; Pianissimo
    #(ppp   16) ; Pianississimo
    #(pppp   1)))

(defun velocities ()
  (list-comp ((<- `#(,k ,v) (dynamics))) `#(,v ,k)))

(defun get-velocity (name)
  (proplists:get_value name (dynamics)))

(defun get-dynamic (num)
  (proplists:get_value num (velocities)))

#| To get the MIDI ranges for the dynamics, did the following in the LFE REPL:

lfe> (lfe_io:format "~w~n" (list (lists:reverse (++ '(127) 
                                                   (cdr
                                                     (lists:flatten
                                                       (lists:map (match-lambda ((`(,a ,b)) 
                                                                    (let ((range (round (/ (- a b) 2))))
                                                                      (list (+ a range) (- a range)))))
                                                                  (lutil-list:chunks vs 2 #(by-length)))))))))

Which gave:
(8 24 37 51 65 79 93 107 120 127)
|#
(defun nearest-dynamic
  ((num) (when (=< num 8))
   'pppp)
  ((num) (when (=< num 24))
   'ppp)
  ((num) (when (=< num 37))
   'pp)
  ((num) (when (=< num 51))
   'p)
  ((num) (when (=< num 65))
   'mp)
  ((num) (when (=< num 79))
   'mf)
  ((num) (when (=< num 93))
   'f)
  ((num) (when (=< num 107))
   'ff)
  ((num) (when (=< num 120))
   'fff)
  ((num) (when (> num 120))
   'ffff))

#| It seems like a normal distribution around a dynamic would be a nice first-
approximation for selecting a random velocity that stays within the defined
range of a given dynamic.

|#
(defun fuzzy-velocity (name)
  (fuzzy-velocity name (mref (default-variances) 'velocity)))

(defun fuzzy-velocity
  ((name variance) (when (is_atom name))
   (fuzzy-velocity (get-velocity name) variance))
  ((v variance)
   (round (abs (rand:normal v variance)))))

;;;;;;;;;;;;;;;;;;;
;;; PERFORMANCE ;;;
;;;;;;;;;;;;;;;;;;;

(defun play
  ((device channel notes) (when (is_list notes))
   (play-notes device channel notes))
  ((device channel note) (when (is_map note))
   (play-note device channel note)))

(defun play-note
  ((device channel note) (when (is_atom note))
   (play-note device channel (make note)))
  ((device channel `#m(pitch ,p velocity ,v duration ,dur delay ,del))
   (let ((note-on (midimsg:note-on channel p v))
         (note-off (midimsg:note-on channel p 0)))
     (timer:apply_after del 'um.ml 'send `(,device ,note-on))
     (timer:apply_after (- dur del) 'um.ml 'send `(,device ,note-off)))))

(defun play-notes (device channel notes)
  (play-notes device channel notes 250))

(defun play-notes (device channel notes delay)
  (play-notes device channel notes delay 0))

(defun play-notes (device channel notes delay repeats)
  (play-notes device channel notes delay repeats '()))

(defun play-notes
  ((device channel '() _ 0 _)
   'ok)
  ((device channel '() delay repeats acc)
   (play-notes device channel acc delay (- repeats 1) '()))
  ((device channel `(,head . ,tail) delay repeats acc)
   (play-note device channel head)
   ;; TODO: this is a hack; we need to send timing data MIDI messages ...
   (timer:sleep delay)
   (play-notes device channel tail delay repeats (++ acc `(,head)))))

(defun lengthen (notes duration-multiplier)
  (lists:map (lambda (m)
               (mset m 'duration (* duration-multiplier (mref m 'duration))))
             notes))

(defun delay (notes delay-multiplier)
  (lists:map (lambda (m)
               (mset m 'delay (* delay-multiplier (mref m 'delay))))
             notes))