-
Notifications
You must be signed in to change notification settings - Fork 0
/
makes.lisp
197 lines (175 loc) · 5.06 KB
/
makes.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
(defun make-main(template) (prog()
(setpitch (car template))
(setdur (car template))
(cond ((eq (car template) 'gliss) (cmix-print 'fret1
(p-filler (cdr template)) OUTFILE))
((eq (car template) 'vgliss) (cmix-print 'vfret1
(p-filler (cdr template)) OUTFILE))
((eq (car template) 'halenize)
(halenify (+ 3 (random 2)) (nth (random 2) '(-1 1))))
(t (cmix-print (car template)
(p-filler (cdr template)) OUTFILE))
)
(setq PREVPITCH PITCH)
(setq START (+ START DUR))
)
)
(defun make-pre(type) (prog()
(cond ((eq type 'BEND) (bender 1))
((eq type 'VIB) (vibrator))
((eq type 'VBEND) (bender 3) (vibrator))
((eq type 'GLISS) (glissit))
((eq type 'VGLISS) (glissit) (vibrator))
)
)
)
(defun setpitch(cmd) (prog()
(cond ((eq cmd 'gliss) (return PITCH))
((eq cmd 'vgliss) (return PITCH))
((eq cmd 'bend1) (return PITCH))
)
another (setq PITCH (getel PITCHES))
(cond ((eq PITCH PREVPITCH) (go another)))
; (setq PITCH (trackpch))
(return PITCH)
)
)
(defun trackpch() (prog(direction)
(setq direction (getel DIRECTIONS))
(setq PINDEX (+ PINDEX direction))
(cond ((> PINDEX (- (length PITCHES) 1))
(setq DIRECTIONS DOWN)
(setq PINDEX (- PINDEX (+ (random 3) 1))) )
((< PINDEX 0)
(setq DIRECTIONS UP)
(setq PINDEX (+ PINDEX (+ (random 3) 1))) )
)
(return (nth PINDEX PITCHES))
)
)
(defun setdur(cmd) (prog()
(cond ((null WORKRHYTHS) (setq WORKRHYTHS RHYTHMS))
((eq cmd 'halenize) (return 0))
)
(setq DUR (+ (eval (car WORKRHYTHS)) (frandom .05)))
(setq WORKRHYTHS (cdr WORKRHYTHS))
; (cond ((eq cmd 'bend1) (setq DUR h)))
; (cond ((eq cmd 'vbend1) (setq DUR w)))
(return DUR)
)
)
(defun bender(func) (prog(tmp)
(setq tmp (random 3))
(cond ((eq tmp 0) (cmix-print 'makegen
`(,func 7 1000 0 100 .1 100 .02 50 .04 500 1 50 .95 50 .98 50 .93 25 1 75 .9) OUTFILE))
((eq tmp 1) (cmix-print 'makegen
`(,func 7 1000 1 25 .97 75 1 100 .95 50 .99 500 0 100 .05 75 .02 25 0 50 .2) OUTFILE))
((eq tmp 2) (cmix-print 'makegen
`(,func 7 1000 0 75 .03 25 .01 350 1 450 0 50 .02 25 .01 25 .03) OUTFILE))
)
)
)
(defun vibrator() (prog()
(cmix-print 'makegen '(1 10 1024 1 .1) OUTFILE)
(cmix-print 'makegen '(2 7 1000 0 100 1 200 .7 50 .95 150 .8 125 .7 75 .9 200 .5 100 .89) OUTFILE)
)
)
(defun glissit() (prog(nsteps stepdur step direction)
(setpitch 'DUMMY)
(setq nsteps (- (calcsteps PREVPITCH PITCH) 1))
(cond ((> nsteps 0) (setq direction 1))
(t (setq direction -1) (setq nsteps (- 0 nsteps)))
)
(setq stepdur (/ (+ (frandom 0.19) 0.1) nsteps))
(setq step 1)
(fretify nsteps stepdur step direction)
)
)
(defun calcsteps(p0 p1) (prog(intp0 intp1 ntwelves)
(setq intp0 (int p0))
(setq intp1 (int p1))
(setq ntwelves (- intp1 intp0))
(return (+ (- (* 100 (- p1 intp1)) (* 100 (- p0 intp0))) (* ntwelves 12)))
)
)
(defun fretify(nsteps stepdur step direction) (prog()
(cond ((> step nsteps) (return t)))
(cmix-print 'fret1
`(,START ,stepdur ,(pchplus PREVPITCH (* direction .01)) 20 1.0 15 .07 7.00 0 1) OUTFILE)
(setq PREVPITCH (pchplus PREVPITCH (* direction .01)))
(setq START (+ START stepdur))
(fretify nsteps stepdur (+ step 1) direction)
)
)
(defun int(v) (round v))
(defun pchplus(pitch amount) (prog (intpch newpch intcl newcl)
(setq intpch (int pitch))
(setq intcl (- (int (* pitch 10000000)) (* 10000000 intpch)))
(setq newcl (+ intcl (* 10000000 amount)))
(cond ((> newcl 0)
(cond ((> newcl 1100000) (setq newcl (- newcl 1200000))
(setq intpch (+ 1 intpch)))) )
((< newcl 0) (setq newcl (+ newcl 1200000)) (setq intpch
(- intpch 1)) )
)
(setq newpch (+ intpch (/ (float newcl) 10000000)))
(return newpch)
)
)
(defun p-filler(templ) (prog()
(cond ((null templ) (return))
((listp (car templ))
(return (cons (eval (car templ))
(p-filler (cdr templ)))))
(t (return (cons (car templ) (p-filler (cdr templ)))))
)
)
)
(defun halenify(nfrets dir) (prog(nhalens halenpitches)
(setq nhalens (+ 1 (random MAXHALENS)))
; (setq dir -1) ; added this for the Big Rise
(setq halenpitches (halenset nfrets 0 dir nhalens))
(cmix-print 'start1 (append `(,START ,HALENDUR ,(car halenpitches))
(p-filler (cddddr START1TEMPL))) OUTFILE)
(setq START (+ START HALENDUR))
(halenprint (cdr halenpitches))
(setq DUR 0) ; this sets up final (+ START DUR) in make-main
)
)
(defun halenset(nf nfcounter dir nhals) (prog(hindex)
(cond ((eq nhals 0) (return ()))
((eq nfcounter nf) (return (halenset nf 0 dir (- nhals 1))))
)
(setq hindex (+ PINDEX (* dir nfcounter)))
(cond ((< hindex 0) (setq hindex 0))
((> hindex (- (length PITCHES) 1))
(setq hindex (- (length PITCHES) 1)))
)
(return (cons (nth hindex PITCHES)
(halenset nf (+ 1 nfcounter) dir nhals)))
)
)
(defun halenprint(pitches) (prog()
(cond ((null pitches) (return t)) )
(cmix-print 'fret1 (append `(,START ,HALENDUR ,(car pitches))
(p-filler (cddddr FRET1TEMPL))) OUTFILE)
(setq START (+ START HALENDUR))
(halenprint (cdr pitches))
)
)
(defun starter() (prog()
(return START)
)
)
(defun durer() (prog()
(return DUR)
)
)
(defun pitcher() (prog()
(return PITCH)
)
)
(defun vibdepth() (prog()
(return `(cpspch\( ,PITCH \) \* 0.02))
)
)