10 REM Program DRUMS
20 REM Author Nick Day
30 REM Version B1.3
40REM Adapted By C.J.Richardson.
50 REM BEEBUG December 1983
60 REM Program subject to copyright
70:
80 REM Initialise
90 nsteps=10
100 REM this could be altered for
110 REM other tempos.
120 ON ERROR GOTO 1100
130 DIM beat$(29)
140 MODE7
150 VDU 23;10,32,0;0;0;
160 PROCinit
170:
180 REM Main Loop
190 REPEAT REM Cycle thru rhythm
200timestep=0
210REPEAT
220VDU31,timestep MOD nsteps+1,19,ASC"
"
230timestep=timestep+1
240 PRINTTAB(editstep,21)SPC1
250 editstep=(editstep+(INKEY-26)-(INK
EY-122))
260 IF editstep<1 THEN editstep=nsteps
270 IF editstep>nsteps THEN editstep=1
280 key=INKEY(0)
290*FX21
300 IF key<>-1 THEN PROCsetchar(key)
310 char$=beat$(timestep)
320PRINTTAB(editstep,21)"^"
330VDU31,timestep MOD nsteps+1,19,ASC"
v"
340 IF char$="." GOTO 490 : REM Sorry,
Edsger
350 IF char$="L" THEN SOUND 0,1,6,1
360 IF char$="l" THEN SOUND 0,2,6,1
370 IF char$="M" THEN SOUND 0,1,5,1
380 IF char$="m" THEN SOUND 0,2,5,1
390 IF char$="H" THEN SOUND 0,1,4,1
400 IF char$="h" THEN SOUND 0,2,4,1
410 IF char$="D" THEN SOUND 1,3,255,1:
SOUND 0,1,7,1
420 IF char$="d" THEN SOUND 1,3,255,1:
SOUND 0,2,7,1
430 IF char$="U" THEN SOUND 1,4,150,1:
SOUND 0,1,7,1
440 IF char$="u" THEN SOUND 1,4,150,1:
SOUND 0,2,7,1
450 IF char$="C" THEN SOUND 0,2,4,1 :
SOUND 2,1,197,1
460 IF char$="c" THEN SOUND 0,2,4,1 :
SOUND 2,2,197,1
470 IF char$="T" THEN SOUND 3,1,245,1
480 IF char$="t" THEN SOUND 3,2,245,1
490 IF step<0 THEN step=0 : PRINT TAB(
30,20) CHR$(129)"Fastest"
500 IF step>40 THEN step=40 : PRINT TA
B(30,20) CHR$(129)"Slowest"
510 PROCwait
520 UNTILtimestep>=nsteps
530 UNTIL FALSE
540:
550 DEF PROCwait
560 REM Waits for next timestep
570 REPEAT
580 UNTIL TIME>nexttime
590 nexttime=TIME+step
600 ENDPROC
610:
620 DEF PROCclearbeat
630 REM Clears the array beat$
640 FOR I=1 TO nsteps
650 beat$(I)="."
660 NEXT
670 ENDPROC
680:
690 DEF PROCsetchar(key)
700 REM Takes action on input
710IF key=73:IF nsteps<29 nsteps=nstep
s+1:PRINTTAB(nsteps,20)".":editstep=nste
ps:beat$(nsteps)=".":ENDPROC
720IF key=79:IF nsteps>1 nsteps=nsteps
-1:PRINTTAB(nsteps+1,20)" ":editstep=nst
eps:beat$(nsteps)=" ":ENDPROC
730 IF INSTR("HhMmLlUuDdCcTtFfSs.",CHR
$(key))=0 THEN ENDPROC
740 IF key=ASC("S")ORkey=ASC("s")THEN
step=step+1 : PRINT TAB(30,20)SPC8 : END
PROC
750 IF key=ASC("F")ORkey=ASC("f")THEN
step=step-1 : PRINT TAB(30,20)SPC8 : END
PROC
760 beat$(editstep)=CHR$(key)
770 PRINTTAB(0,20)CHR$(130); : FOR i=1
TO nsteps : PRINTbeat$(i); : NEXT
780 ENDPROC
790:
800 DEF PROCinit
810 REM Initialises
820 *FX4,1
830 ENVELOPE 1,1,0,0,0,0,0,0,126,-10,0
,-1,126,100
840 ENVELOPE 2,1,0,0,0,0,0,0,126,-20,0
,-1,126,60
850 ENVELOPE 3,1,-2,0,0,255,0,0,0,0,0,
0,0,0
860 ENVELOPE 4,1,2,0,0,255,0,0,0,0,0,0
,0,0
870 PROCclearbeat
880 step=10
890 nexttime=TIME+step
900 timestep=1
910 editstep=1
920 PRINT CHR$(148)CHR$(157)CHR$(131)C
HR$(141)"Percussion Machine"
930 PRINT CHR$(148)CHR$(157)CHR$(131)C
HR$(141)"Percussion Machine"
940 PRINT'"Press H for High Drum"
950 PRINT" M for Medium Drum"
960 PRINT" L for Low Drum"
970 PRINT" U for Up Drum"
980 PRINT" D for Down Drum"
990 PRINT" C for Cymbal"
1000 PRINT" T for Triangle"
1010 PRINT" . to Clear Beat"
1020 PRINT" F to go Faster"
1030 PRINT" S to go Slower"
1040PRINT" I increase steps"
1050PRINT" O decrease steps"
1060 PRINT'" CURSOR KEYS to Move"
1070 PRINT'"Use lower case for quieter
sounds"
1080 PROCsetchar(ASC("."))
1090 ENDPROC
1100 ONERROR OFF
1110 MODE7
1120 IF ERR<>17 THEN REPORT:PRINT" at l
ine ";ERL
1130 *FX4
1140 END