-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathPOPPA.F
executable file
·616 lines (528 loc) · 15.1 KB
/
POPPA.F
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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
\ $Workfile: poppa.f $
\ $Revision: 1.5 $
\
\ "pop" song derived from p0p.f
needs b0b b0b.f
needs __NU110 nu110.f
needs __DRUMS110 drums110.f
needs __CHORDS chords.f
needs __VOLUME volume.f
needs __DRUMBOT drumbot.f
needs __SNAP snap.f
needs __THEME theme.f
ifdef __POPPA forget __POPPA
otherwise formula
ifend
create __POPPA .( loading poppa.f...) cr
variable comping
\ our "standard" notational conveniences
ifndef // alias // |1| ifend
ifndef /' alias /' |2| ifend
ifndef ?V alias ?V ?ChangeVolume ifend
ifndef V$
:ap V$ ( note -- ) ?ChangeVolume $ ;ap
ifend
' V$ is Theme$
\ add a random int between -n and +n to v
:ap randVol ( v n -- )
dup 2* irnd -
+ to $volume
;ap
:ap snare2&4 ( -- )
/4 ?V Kick
/2 ?V Snare
/4 ?V Snare
;ap
\ create a composite drum
:ap fatdrum:
create ( n1 n2 n3 -- ) \ drum has 3 components
c, c, c,
does> count ?dup if z$ then
count ?dup if z$ then
c@ V$
;ap
0 0 0 fatdrum: noDrum
sd1 sd2 0 fatdrum: sd12
sd1 sd2 sd3 fatdrum: sd123
sd3 sd4 sd5 fatdrum: sd345
bd1 bd2 0 fatdrum: bd12
\ 8 bars of drums for the intro. Cryptic stuff, huh?
:ap drumIntro
['] sd345 is Snare
['] noDrum is Kick snare2&4
snare2&4
['] sd123 is Kick snare2&4
['] noDrum is Kick snare2&4
['] sd123 is Kick snare2&4
['] noDrum is Kick snare2&4
['] bd12 is Kick snare2&4
['] sd12 is Snare snare2&4
;ap
\ ***** drum fills *****
chil chih cch ccl 4 Limb: cymbowl \ array of chinese and crash cymbals
\ hit toms n times
:ap toms ( n -- )
0 ?do tomhand Hit loop
;ap
\ hit ride cymbals n times
:ap rides ( n -- )
0 ?do ridehand Hit loop
;ap
\ hit rototoms n times
:ap rotos ( n -- )
0 ?do rotohand Hit loop
;ap
\ hit a crash cymbal
:ap crash crashhand Hit ;ap
\ hit crash cymbals n times
:ap crashes ( n -- )
0 ?do crash loop
;ap
\ half a measure as Dick Clark intended
:ap halfCliche ( -- )
/4 clubfoot Hit
/8 snarehand Hit clubfoot Hit
;ap
:ap theCliche ( -- )
halfCliche
/4 clubfoot Hit snarehand Hit
;ap
\ sequence generators
:sg ~/7s 2|7 & ;sg
:sg ~/4 1|4 & ;sg
:sg ~/7. 3|14 & ;sg
:sg ~/7 1|7 & ;sg
:sg ~/8 1|8 & ;sg
:sg ~/10 1|10 & ;sg
:sg ~/21s 2|21 & ;sg
:sg ~/14 1|14 & ;sg
:sg ~/16 1|16 & ;sg
:sg ~/20 1|20 & ;sg
:sg ~/21 1|21 & ;sg
:ap /7s ::tsg begin ~/7s again ;;sg ;ap
:ap /7 ::tsg begin ~/7 again ;;sg ;ap
:ap /7. ::tsg begin ~/7. again ;;sg ;ap
:ap /14 ::tsg begin ~/14 again ;;sg ;ap
:ap /21 ::tsg begin ~/21 again ;;sg ;ap
:ap /21s ::tsg begin ~/21s again ;;sg ;ap
:ap dfill/2
::tsg \ 7 timing elements
3Rand case
0 of 6 0 do ~/16 loop /8 endof
1 of 5 0 do ~/20 loop ~/8 ~/8 endof
2 of 7 0 do ~/14 loop endof
3 of 3 0 do ~/16 loop ~/8
3 0 do ~/16 loop endof
endcase
;;sg
5Rand case
0 of 7 rotos endof
1 of 6 toms crash endof
2 of 3 toms crash 3 rides endof
3 of crash 5 rotos crash endof
4 of 4 toms crash 2 rides endof
5 of 2 crashes 5 rides endof
endcase
;ap
:ap dfill/1
::tsg \ 7 timing elements
3Rand case
0 of 6 0 do ~/8 loop /4 endof
1 of 5 0 do ~/10 loop ~/4 ~/4 endof
2 of 7 0 do ~/7 loop endof
3 of 3 0 do ~/8 loop ~/4
3 0 do ~/8 loop endof
endcase
;;sg
5Rand case
0 of 7 rotos endof
1 of 6 toms crash endof
2 of 3 rotos crash 3 rotos endof
3 of crash 5 rotos crash endof
4 of 4 toms crash 2 rides endof
5 of 3 crashes 4 rides endof
endcase
;ap
\ one measure which might contain a drum fill
:ap ?drumfill ( -- )
3Rand
if 2Rand
if theCliche
else /4 clubfoot Hit
dfill/2 /4 cymbowl Hit
then
else 2Rand
if 2Rand if theCliche
else dfill/1
then
else 2Rand if halfCliche dfill/2
else dfill/1
then
then
then
;ap
\ one measure that WILL contain a drum fill
:ap drumfill
brnd
if dfill/1
else brnd
if dfill/2 dfill/2
else halfCliche dfill/2
then
then
;ap
\ the chord progression for the verse
:ap Verse
I // I // I // I //
IV // IV // IV // IV //
I // I // I // I //
IV // IV // IV // III //
;ap
\ the alternate chord progression for the verse
:ap altVerse
vi // vi // vi // vi //
ii // ii // ii // III //
vi // vi // vi // III //
ii // ii // II // V //
;ap
:ap Bottom ( -- n )
Root 5th RootKey min \ the lower of Root or 5th
;ap
:ap bGroove
/4 36 48 randVol Root $
/8 12 24 randVol rest Bottom $
/2 36 48 randVol Root $
;ap
quan gRand
:ap guit$
[ octal ] 10000 irnd to gRand
0
gRand 0111 and if Gtr1 swap 1+ then
gRand 1110 and if Gtr2 swap 1+ then
gRand 0222 and if Gtr3 swap 1+ then
gRand 2220 and if Gtr4 swap 1+ then
gRand 0444 and if Gtr5 swap 1+ then
gRand 4440 and if Gtr6 swap 1+ then [ decimal ]
?dup if dup 1-
if ?V $n \ play chord
else drop V$ \ or single note
then
then \ or nothing at all
;ap
:ap alt$ [ octal ]
0 \ use existing gRand
gRand 4200 and if Gtr1 swap 1+ then
gRand 0024 and if Gtr2 swap 1+ then
gRand 2400 and if Gtr3 swap 1+ then
gRand 0012 and if Gtr4 swap 1+ then
gRand 0041 and if Gtr5 swap 1+ then
gRand 1100 and if Gtr6 swap 1+ then [ decimal ]
?dup if dup 1-
if ?V $n \ play chord
else drop V$ \ or single note
then
then \ or nothing at all
;ap
:ap firstHalf8
/4 guit$
/8 alt$
/4 guit$
;ap
:ap secondHalf8
\ /8 pedon$
/4 guit$
/16 alt$
rest
;ap
:ap compGuitar ( -- )
comping on
begin comping @ if firstHalf8 then
comping @ if secondHalf8 then
comping @ 0= if exit then
again
;ap
:ap rthmTrack
::ap \ chord progression, beat leader
I
// // // //
// // //
comping on //
Verse altVerse Verse
Verse altVerse Verse
comping off
vi
;;ap
::ap \ alternating progression
// // // //
// // // // /'
Verse altVerse altVerse
altVerse Verse Verse
;;ap
::ap \ cliche 2&4 drums
Part_2 drums pedon
0 60 SetVolumeRange
1|256 time-advance \ trail slightly
drumIntro
begin comping @ \ keep it up till comping is turned off
while snare2&4
repeat
/7 7 rotos crash
;;ap
::ap \ drum fills
Part_2 drums pedon
60 120 SetVolumeRange
1|256 time-advance \ trail slightly
dfill/2 /2 chil V$
// // /' dfill/2 /1 crash
// // /7 7 rotos
begin comping @
while /2 \ 8 measures
cymbowl Hit halfCliche
theCliche
?drumfill ?drumfill
?drumfill ?drumfill
theCliche drumfill
repeat
/7 chil V$ 6 rotos Kick
;;ap
::ap Part_4 ac.bass
60 100 SetVolumeRange
1|256 time-advance \ bass trails
// // // //
pedon /1
/' Root $ /' \ 2 measures
/' Root $ /' \ 2 more
pedoff
96 0
do bGroove
loop
/1 Root $ pedon
;;ap
::ap Part_3 a.guitar.2
-12.0 to $transpose
1|512 time-advance \ trail slightly
// // // //
-25 25 SetVolumeRange pedon
/' |8| secondHalf8
compGuitar
/1 guit$ pedon
;;ap
;ap
\ *** Theme Composer ***
: sgArray:
create ( #elements -- ) ,
;
: sgCount ( sgArray -- adr0 #elements )
dup @
swap Cell + swap
;
\ each of these sg (Sequence Generator) arrays is 2/7ths long
1 sgArray: sg7.0 ' /7s ,
2 sgArray: sg7.1 ' /7. , ' /14 ,
2 sgArray: sg7.2 ' /7 , ' /7 ,
3 sgArray: sg7.3 ' /7 , ' /14 , ' /14 ,
3 sgArray: sg7.4 ' /7 , ' /21s , ' /21 ,
4 sgArray: sg7.5 ' /7 , ' /21 , ' /21 , ' /21 ,
3 sgArray: sg7.6 ' /21s , ' /21 , ' /7 ,
3 sgArray: sg7.7 ' /14 , ' /14 , ' /7 ,
2 sgArray: sg7.8 ' /14 , ' /7. ,
create sg[]
sg7.0 , sg7.1 , sg7.2 , sg7.3 , sg7.4 ,
sg7.5 , sg7.6 , sg7.7 , sg7.8 , sg7.0 ,
:ap randSg ( -- sgArray )
10 irnd Cells sg[] + @
;ap
\ note range checking
pquan $maxnote
pquan $minnote
:ap fixhi ( note -- note' )
recursive
dup $maxnote >
if drop 2 -nps fixhi
then
;ap
:ap fixlo ( note -- note' )
recursive
dup $minnote <
if drop 2 +nps fixlo
then
;ap
\ these are the Note Generators. Stack for each is ( -- note )
:ap ng1 +ps fixhi ;ap
:ap ng2 +ps fixhi Snap ;ap
:ap ng3 -ps fixlo ;ap
:ap ng4 -ps fixlo Snap ;ap
:ap ng5 2 +nps fixhi ;ap
:ap ng6 2 -nps fixlo ;ap
:ap ng7 2Rand 1+ +nps fixhi ;ap
:ap ng8 2Rand 1+ -nps fixlo ;ap
create ng[]
' 0 ,
' ng1 , ' ng2 , ' ng3 , ' ng4 ,
' ng5 , ' ng6 , ' ng7 , ' ng8 ,
' 0 ,
:ap randNoteCfa ( -- cfa )
ng[] 10 irnd Cells + @
;ap
:ap composeTheme7 ( Theme -- )
dup to $theme ClearTheme
7 0
do randSg sgCount 0
do randNoteCfa
over @ $theme >Theme
Cell +
loop drop
loop
;ap
28 Theme: theMainTheme
28 Theme: mainTheme1
28 Theme: mainTheme2
28 Theme: mainTheme3
28 Theme: mainTheme4
28 Theme: theAltTheme
28 Theme: theJammer
:ap initPoppa
140 BPM _Eb to _Key Academy_49
;ap
initPoppa
:ap playHead
2 0 do
mainTheme1 PlayTheme mainTheme2 PlayTheme
mainTheme3 PlayTheme mainTheme4 PlayTheme
loop
;ap
:ap _sitout2
/7 -ps Snap V$
13|7 time-advance
;ap
:ap sitout2_
13|7 time-advance
/7 +ps Snap V$
;ap
:ap _sitout2_
/7 -ps Snap V$
12|7 time-advance
/7 +ps Snap V$
;ap
:ap jam7for2
$volume dup $vstep +
$maxvol min to $volume
theJammer PlayTheme
( old $volume) to $volume
;ap
:ap newJam theJammer composeTheme7
;ap
:ap keyboardIntro
// // sitout2_ _sitout2 sitout2_
;ap
:ap lead1intro
sitout2_ // // // // _sitout2_
;ap
:ap lead2intro
// // _sitout2 sitout2_ sitout2_
;ap
:ap keyboardPart
keyboardIntro
playHead
_sitout2 sitout2_
mainTheme1 PlayTheme mainTheme2 PlayTheme
_sitout2 sitout2_
mainTheme1 PlayTheme mainTheme2 PlayTheme
jam7for2 jam7for2
mainTheme3 PlayTheme mainTheme4 PlayTheme
_sitout2 sitout2_
mainTheme3 PlayTheme mainTheme4 PlayTheme
mainTheme1 PlayTheme _sitout2
mainTheme2 PlayTheme _sitout2
mainTheme1 PlayTheme jam7for2
mainTheme2 PlayTheme _sitout2
mainTheme3 PlayTheme _sitout2
mainTheme4 PlayTheme jam7for2
mainTheme3 PlayTheme _sitout2
mainTheme4 PlayTheme _sitout2
playHead
/1 2 -nps Snap pedon $
;ap
:ap 1stLeadPart
lead1intro
playHead
jam7for2 newJam jam7for2 newJam
mainTheme1 PlayTheme mainTheme2 PlayTheme
_sitout2 sitout2_
mainTheme1 PlayTheme mainTheme2 PlayTheme
_sitout2 sitout2_
mainTheme3 PlayTheme mainTheme4 PlayTheme
jam7for2 newJam jam7for2
_sitout2 mainTheme4 PlayTheme
mainTheme1 PlayTheme jam7for2 newJam
mainTheme2 PlayTheme _sitout2
mainTheme1 PlayTheme _sitout2
mainTheme2 PlayTheme jam7for2 newJam
mainTheme3 PlayTheme _sitout2
mainTheme4 PlayTheme _sitout2
mainTheme3 PlayTheme jam7for2 newJam
mainTheme4 PlayTheme jam7for2
playHead
/1 2 -nps Snap V$
;ap
:ap 2ndLeadPart
lead2intro
playHead
_sitout2 sitout2_
mainTheme1 PlayTheme mainTheme2 PlayTheme
jam7for2 newJam jam7for2 newJam
mainTheme1 PlayTheme mainTheme2 PlayTheme
_sitout2 sitout2_
mainTheme3 PlayTheme mainTheme4 PlayTheme
_sitout2 sitout2_
jam7for2 newJam jam7for2
mainTheme1 PlayTheme _sitout2
mainTheme2 PlayTheme jam7for2 newJam
mainTheme1 PlayTheme _sitout2
mainTheme2 PlayTheme _sitout2
mainTheme3 PlayTheme jam7for2 newJam
mainTheme4 PlayTheme _sitout2
mainTheme3 PlayTheme _sitout2
mainTheme4 PlayTheme jam7for2
playHead
/1 2 -nps Snap V$
;ap
:ap Poppa
mainTheme1 composeTheme7
mainTheme2 composeTheme7
mainTheme3 composeTheme7
mainTheme4 composeTheme7
theJammer composeTheme7
rthmTrack
::ap Part_5 soft.tp.1
_Key 12 + majorscale set-ps
53 to $minnote \ F3
77 to $maxnote \ F5
-20 30 SetVolumeRange
1stLeadPart
;;ap
::ap Part_6 sax.2
1|98 time-advance \ not TOO in-sync
_Key 4 + minorscale set-ps
60 to $minnote \ D3
74 to $maxnote \ D5
10 70 SetVolumeRange
2ndLeadPart
;;ap
::ap Part_1 e.piano.5
1|75 time-advance \ not TOO in-sync
_Key 12 + majorscale set-ps
58 to $minnote \ Bb3
87 to $maxnote \ Eb6
-20 40 SetVolumeRange
keyboardPart
;;ap
::ap Part_1 e.piano.5
1|84 time-advance \ not TOO in-sync
_Key 7 - majorscale set-ps
51 to $minnote \ Eb3
75 to $maxnote \ Eb5
-20 50 SetVolumeRange
keyboardPart
;;ap
;ap