10 REM Model 100 Music Sequencer by Mark Lutton 73106,1627

11 REM Version 1.1  10/6/85

12 REM Shareware.  If you like this program please send $10 to

13 REM Mark Lutton, 30 Rich St., Malden, MA 02148.

14 REM Copyright (c) 1985 by Mark Lutton.

15 REM You may distribute the program but you may not sell it.

80 CLEAR 1000:MAXFILES=2:DEFINT A-Z

90 DZ=400:TZ=50:GOSUB 5000:GOSUB3200

100 A$=INKEY$:IF A$=""THEN 100

120 GOSUB 3000:PRINT #2,A$;:GOTO 100

1000 IF SP>=SN THEN GOSUB 3400:P2=P2-8

1100 PRINT@P2*5,;

1110 IF P3=0 THEN PRINT "REM";:ELSE IF P1=0 THEN PRINT "REST";:ELSE PRINT N$(P1);

1120 RETURN

1500 LINE (PX,PY-8)-(PX+8,PY),0,BF

1510 V=VV(PV)

1520 LINE (PX,PY-2)-(PX,PY-1):LINE (PX+1,PY)-(PX+2,PY):LINE(PX+1,PY-3)-(PX+2,PY-3):LINE(PX+3,PY-2)-(PX+3,PY-1)

1530 IF PV<8 THEN LINE(PX+1,PY-2)-(PX+2,PY-1),1,BF

1540 IF PV<10 THEN LINE(PX+3,PY-8)-(PX+3,PY-1)

1550 IF PV<6 THEN LINE(PX+4,PY-8)-(PX+5,PY-8)

1560 IF PV<4 THEN LINE(PX+4,PY-6)-(PX+5,PY-6)

1570 IF PV<2 THEN LINE(PX+4,PY-4)-(PX+5,PY-4)

1580 IF PV MOD 2 = 1 THEN LINE(PX+6,PY-3)-(PX+7,PY-2),1,BF

1590 RETURN

1900 CLS:PRINT@280," MM  Play Last Rem  Dur"+CHR$(152)+" Dur"+CHR$(153)+" Tupl End";

1910 PRINT@240,"Quarter note = ";MM;

1920 IF TN<>TD THEN PRINT@272,TD;":";TN;

1930 PX=GX:PY=GY:PV=VN:GOSUB 1500:PRINT@0,;:RETURN

2000 IF DX=0 THEN RETURN

2005 FOR I=P1 TO DX-1

2010 IF D(I)=0 THEN 2030

2020 SOUND P(I),V(I)

2030 NEXT

2040 RETURN

2500 GOSUB 1900

2510 IF DX>S1 THENFOR I=S1 TO DX-1:P1=PC(I):P2=I-S1:P3=D(I):GOSUB 1000:NEXT

2520 RETURN

2700 IF DX<1 THEN RETURN

2710 DX=DX-1:SP=SP-1:IF SP>=SN-32 OR S1<8THEN 2750

2720 S1=S1-32:SP=SP+32:IF S1<0 THEN SP=SP+S1:S1=0

2730 GOSUB 2500:RETURN

2750 PRINT@SP*5,SPACE$(5);

2760 RETURN

3000 A=ASC(A$):A1=K(A):IF A=29 THEN GOSUB 2700:RETURN:REM backspace 1

3020 IF A<>32 AND A1=0 THEN RETURN

3030 D(DX)=V*TN/TD:P(DX)=N1(A1):PC(DX)=A1:V(DX)=60*50*D(DX)/MM/16:IF V(DX)<1 THEN V(DX)=1

3040 SOUND P(DX),V(DX):P1=A1:P2=SP:P3=D(DX):GOSUB 1000

3050 DX=DX+1:SP=SP+1:IF DX<DZ THEN RETURN

3060 CLS:PRINT"Oops! Out of note space.  Hit return.":A$=INPUT$(1):GOTO 6800

3200 FN=2:ON ERROR GOTO 3290:OPEN "safety.do" FOR INPUT AS #2:ON ERROR GOTO 0

3210 IF EOF(2) THEN CLOSE 2:GOTO 3300

3220 A$=INPUT$(1,2):IF A$<CHR$(247) THENGOSUB 3000:GOTO 3210

3230 ON ASC(A$)-247 GOSUB 6105,6205,6305,6405,6505,6605,6705,6805:GOTO 3210

3290 I=ERR:IF I=52 THEN RESUME 3300:ELSE ERROR I

3300 ON ERROR GOTO 0:OPEN "safety.do" FOR APPEND AS #2

3310 FN=1:RETURN

3400 CALL 17618,4,1:REM scroll 5 lines. Won't work on T200.

3410 SP=SP-8:S1=S1+8

3420 RETURN

5000 CLS:PRINT@90,"Model 100 Sequencer"::PRINT@133,"by Mark Lutton";

5010 DIM P(DZ),V(DZ),D(DZ),PC(DZ),T$(TZ),N$(61),N1(61),K(127),VV(11)

5020 DIM DX,TX,A$,A,A1,VN,V,MM,TN,TD,P1,P2,P3,PX,PY,PV,SP,SN,S1,GX,GY,I,LN,PL,LK,P$,D$

5100 RESTORE 8000:FOR I=0 TO 127:READ K(I):NEXT

5110 RESTORE 8200:FOR I=0 TO 61:READ N$(I):NEXT

5120 RESTORE 8300:FOR I=0 TO 61:READ N1(I):NEXT

5130 RESTORE 8400:FORI=0TO11:READVV(I):NEXT

5140 MM=120:DX=0:TX=0:VN=6:TN=1:TD=1:GX=180:GY=53:SP=0:S1=0

5150 SN=40:REM for M100. Make it 114 for T200. (Untested.)

5300 PRINT@280,"Would you like instructions? ";:A$=INPUT$(1)

5320 IF A$="y" OR A$="Y" THEN GOSUB 9000

5330 GOSUB 1900

5340 ON KEY GOSUB 6100,6200,6300,6400,6500,6600,6700,6800:KEY ON

5390 RETURN

6100 KEY STOP:PRINT#2,CHR$(248);

6105 PRINT@255,"    ";:PRINT@255,;:IFFN=1THENINPUT"";MM:PRINT#2,MM:ELSEINPUT#FN,MM

6108 PRINT@255,MM;"  ";

6110 FOR I=0 TO DX-1

6120 V(I)=60*50*D(I)/MM/16:IF V(I)<1 THEN V(I)=1

6130 NEXT

6140 KEY ON:RETURN

6200 KEY STOP:PRINT#2,CHR$(249);

6205 P1=0:GOSUB 2000:KEY ON:RETURN

6300 KEY STOP:PRINT#2,CHR$(250);

6305 P1=DX-8:IF P1<0 THEN P1=0

6310 GOSUB 2000:KEY ON:RETURN

6400 KEY STOP:PRINT#2,CHR$(251);

6405 CLS:IFFN=1THENLINEINPUT"rem? ";T$(TX):PRINT#2,T$(TX):ELSELINEINPUT#FN,T$(TX)

6410 D(DX)=0:P(DX)=TX:TX=TX+1:DX=DX+1:SP=SP+1:IF SP>=SN THEN GOSUB 3400

6412 IF DX>=DZ THEN 150:ELSE IF TX<TZ THEN 6420

6415 CLS:PRINT"Oops! Out of rem space. Hit return.":A$=INPUT$(1):GOTO 6800

6420 GOSUB 2500:KEY ON:RETURN

6500 KEY STOP:PRINT#2,CHR$(252);

6505 IF VN<11 THEN VN=VN+1

6510 PX=GX:PY=GY:PV=VN:GOSUB 1500:KEY ON:RETURN

6600 KEY STOP:PRINT#2,CHR$(253);

6605 IF VN>0 THEN VN=VN-1

6610 PX=GX:PY=GY:PV=VN:GOSUB 1500:KEY ON:RETURN

6700 KEY STOP:PRINT#2,CHR$(254);

6705 IF TN=TD THEN 6720:ELSETN=1:TD=1:GOTO 6740

6720 PRINT@240,SPACE$(20);:PRINT@240,;:IFFN=1THENINPUT"How many";TD:PRINT#2,TD:ELSEINPUT#FN,TD

6730 PRINT@240,;:IFFN=1THENINPUT"In time of";TN:PRINT#2,TN:ELSEINPUT#FN,TN

6740 GOSUB 2500:KEY ON:RETURN

6800 KEY STOP:PRINT#2,CHR$(255);

6805 CLS:GOTO 6820

6810 CLOSE #1:PRINT "File already exists. Pick another name."

6820 INPUT "Output file name";A$

6825 IF A$="" THEN GOSUB 2500:KEY ON:RETURN

6830 ON ERROR GOTO 6840:OPEN A$ FOR INPUTAS#1:GOTO 6810

6840 I=ERR:IF I=52 THEN RESUME 6850:ELSE ON ERROR GOTO 0:ERROR I

6850 PRINT "Writing...":OPENA$FOROUTPUTAS#1

6860 LN=990:PL=10:I=0

6870 IF I>=DX THEN 7000

6880 LN=LN+10:LK=0:PRINT#1,LN;:GOTO 6890

6890 IF D(I)=0 THEN 6910:ELSEP$=MID$(STR$(P(I)),2):V$=MID$(STR$(V(I)),2):IFLK>0THENPRINT#1,":";

6895 PRINT#1,"sound";P$;",";V$;

6900 I=I+1:IF I>=DX THEN 7000:ELSELK=LK+1:IF LK<PL THEN 6890:ELSE PRINT#1,:GOTO 6870

6910 IF LK>0 THEN LN=LN+10:LK=0:PRINT#1,:PRINT#1,LN;

6920 PRINT#1,"rem ";T$(P(I))

6930 I=I+1:GOTO 6870

7000 CLOSE 1,2:KILL "safety.do"

7010 MENU

8000 DATA 0,0,0,0,0,0,0,0,37,3

8010 DATA 0,0,0,0,0,0,0,0,0,0

8020 DATA 0,0,0,0,0,0,0,1,0,0

8030 DATA 0,0,0,41,47,45,0,48,52,23

8040 DATA 55,57,0,60,18,0,20,22,33,17

8050 DATA 19,21,0,24,26,28,0,31,45,21

8060 DATA 42,36,44,46,43,29,37,34,33,46

8070 DATA 0,36,38,54,40,0,43,41,39,56

8080 DATA 58,42,47,31,49,53,35,44,32,51

8090 DATA 30,35,0,59,50,0,0,5,13,10

8100 DATA 9,22,0,12,14,30,16,0,19,17

8110 DATA 15,32,34,18,23,7,25,29,11,20

8120 DATA 8,27,6,0,0,0,0,61

8200 DATA"",1G,1G#,1A,1A#,1B,2C,2C#,2D,2D#,2E,2F,2F#,2G,2G#,2A,2A#,2B,3C,3C#,3D

8220 DATA 3D#,3E,3F,3F#,3G,3G#,3A,3A#,3B,4C,4C#,4D,4D#,4E,4F,4F#,4G,4G#,4A,4A#

8230 DATA 4B,5C,5C#,5D,5D#,5E,5F,5F#,5G,5G#,5A,5A#,5B,6C,6C#,6D,6D#,6E,6F,6F#,6G

8300 DATA 0,12538,11836,11172,10544,9952,9394,8866,8368,7900,7456,7032,6642

8310 DATA 6269,5918,5586,5272,4976,4697,4433,4184,3950,3728,3516,3321

8320 DATA 3134,2959,2793,2636,2488,2348,2216,2092,1975,1864,1758,1660

8330 DATA 1567,1479,1396,1318,1244,1174,1108,1046,987,932,879,830

8340 DATA 783,739,698,659,622,587,554,523,493,466,439,415,392

8400 DATA 2,3,4,6,8,12,16,24,32,48,64,96

9000 CLS

9010 PRINT "If you didn't get instructions":PRINT"with this program, send $10 to"

9020 PRINT "Mark Lutton, 30 Rich St.,"

9030 PRINT "Malden, MA 02148"

9040 PRINT "You will receive instructions and a"

9050 PRINT "listing of the latest version."

9060 PRINT "Add $5 to get it on a Chipmunk disk."

9070 A$=INPUT$(1)

9090 RETURN