Set of Apple II Hard Drive Images/hard.hdv/HARD/MIDI2/TEXT.TO.MIDI

Applesoft BASIC Source Code | 1990-12-08 | 3.7 KB | 135 lines | [FC] Applesoft BASIC Program (0x0801)

0  REM   PROGRAM TO READ TEXT FILE AND CREATE A MIDI FILE
1  PRINT  CHR$(4)"BRUN EXTRA.VARIABLES"
2 S0 = 8192:SQ = S0: REM    ADRS OF SEQUENCE TO BE CREATED
3 SU = 0: DIM SU$(50),ST(50),SE(50),D(32),C(32),N(32),V(32),A(32):V = 64
4  INPUT "TEXT FILE TO READ:";F$
5 C$ = "CDEFGABR#&WHQEST.+0123456cdefgabr#&whqest"
6  REM  GOTO 9 FOR TESTING
8  PRINT  CHR$(4)"VERIFY"F$: PRINT  CHR$(4)"OPEN"F$: PRINT  CHR$(4)"READ"F$
9  GOTO 1000
10  REM    SUBROUTINE TO FILL UNUSED TRACKS WITH NEW EVENTS
15  REM  GIVEN T=TRACK THAT NEEDS A NEW NOTE
100  GET A$: PRINT A$;
101  REM  TESTING: IF A$ = "" THEN  STOP
105  IF A$ = "<"  THEN  GOSUB 20000
106  IF A$ = "/"  OR A$ =  CHR$(13)  OR A$ = "*"  OR A$ = "]"  THEN 200
110  IF A$ =  CHR$(32)  THEN 100
130  IF A$ < >"["  THEN 140
132  GET A$
135  IF A$ < >"]"  AND A$ < >" "  AND A$ < > CHR$(13)  AND A$ < >"*"  THEN SU$ = SU$ +A$: GOTO 132
137 SU = SU +1:SU$(SU) = SU$:ST(SU) = SQ:SU$ = ""
139  GOTO 105
140  GOTO 150
150 F = 0: REM  TEST IF A$ IS IN C$
151  FOR I = 1 TO  LEN(C$)
152  IF A$ =  MID$ (C$,I,1)  THEN F = 1:I =  LEN(C$) +1
153  NEXT
154  IF F = 0  THEN 160
155  IF  ASC(A$) > = 97  AND  ASC(A$) < = 122  THEN A$ =  CHR$( ASC(A$) -32)
156  REM  LINE 155 CONVERTS LOWER CASE TO UPPER CASE
157 N$ = N$ +A$
159  GOTO 100
160  IF A$ < >","  THEN 200
161 A0$ = A$:F = 0:FD = 0:D0 = 0
162  FOR I = 1 TO  LEN(N$):A$ =  MID$ (N$,I,1): IF F  THEN  GOTO 167
163 RE = 0: IF A$ = "R"  THEN F = 1:RE = 1: GOTO 190
164  IF (A$ > = "0")  AND (A$ < = "6")  THEN N = N - INT(N/12) *12 +( ASC(A$) - ASC("0")) *12 +24: GOTO 190
165  IF A$ > = "A"  AND A$ < = "G"  THEN N =  INT(N/12) *12 +(2 *(A$ = "D") +4 *(A$ = "E") +5 *(A$ = "F") +7 *(A$ = "G") +9 *(A$ = "A") +11 *(A$ = "B")):F = 1: GOTO 190
167  IF A$ = "#"  THEN N = N +1: GOTO 190
168  IF A$ = "&"  THEN N = N -1: GOTO 190
170  REM  PROCESS DURATIONS
174  IF FD  THEN 180
175  IF A$ = "B"  OR A$ = "W"  OR A$ = "H"  OR A$ = "Q"  OR A$ = "E"  OR A$ = "S"  OR A$ = "T"  OR A$ = "G"  THEN D = 15 *(A$ = "G") +30 *(A$ = "T") +60 *(A$ = "S") +120 *(A$ = "E") +240 *(A$ = "Q") +480 *(A$ = "H") +960 *(A$ = "W") +1920 *(A$ = "B"):FD = 1
177  GOTO 185
180  IF A$ = "."  THEN D = D *3/2
181  IF A$ = "T"  THEN D = D *2/3
182  IF A$ = "Q"  THEN D = D *4/5
185  IF A$ = "+"  THEN D0 = D0 +D:FD = 0
190  NEXT I
192 D0 = D0 +D:D = D0
195 N$ = ""
196  GOSUB 10000: REM  ASSIGN IT TO A FREE TRACK
197  IF A0$ = ","  THEN 100
198 A$ = A0$: GOTO 105
200  IF N$ < >""  THEN 161
205  IF A$ < >"*"  THEN 210
206  GET A$: IF A$ < > CHR$(13)  THEN 206
210  IF MT = 0  THEN 100
230 SQ = SQ -1: REM  NEW DURATION WILL OVERWRITE THE ZERO THAT WAS STORED FROM LINE 10000-
999  RETURN
1000  REM    SET UP FIRST EVENT IN THE ARRAYS BEFORE GOING TO 1100
1004 SM = 0
1005  POKE SQ,0:SQ = SQ +1: REM  START WITH DELAY OF 0
1010  GOSUB 10: REM  PROCESS AN EVENT
1100  REM  STORE NOTES IN SEQUENCE
1101  REM  FIND SMALLEST OF ALL DURATIONS IN THE ARRAY, SUBTRACT IT FROM ALL DURS, IF =0, ADD A NOTE OFF TO THE SEQUENCE
1110 SM = 32768
1120  FOR I = 1 TO MT
1125  IF A(I) = 0  THEN 1140
1130  IF D(I) <SM  THEN SM = D(I)
1140  NEXT I
1142  IF SM = 32768  THEN  POKE SQ,0:SQ = SQ +1: GOTO 1240
1145  REM  POKE IN THE SM DELAY
1150  IF SM <128  THEN  POKE SQ,SM:SQ = SQ +1: GOTO 1200
1160  POKE SQ,128 + INT(SM/128)
1170  POKE SQ +1,SM - INT(SM/128) *128
1180 SQ = SQ +2
1190  REM  GENERATE NOTE OFFS
1200  FOR I = 1 TO MT
1205  IF A(I) = 0  THEN 1230
1210 D(I) = D(I) -SM
1220  IF D(I) < = 0  THEN A(I) = 0: POKE SQ,128: POKE SQ +1,N(I): POKE SQ +2,127: POKE SQ +3,0:SQ = SQ +4
1230  NEXT I
1240  IF A$ < >"]"  THEN 1250
1241 F = 0
1242  FOR J = SU TO 1  STEP  -1
1243  IF (F = 0)  AND SE(J) = 0  THEN F = 1:SE(J) = SQ -1
1244  NEXT J
1250  GOTO 1280
1280  GOSUB 10: REM  FILL UNUSED TRACKS WITH NEW EVENT
1500 DN = 1: REM   TRY TO PROVE NOT DONE
1510 DN = 0
1520  REM  TEST FOR DONENESS
1540  IF   NOT (DN)  THEN 1100
1550  PRINT : PRINT "DONE:"
1600  PRINT : PRINT "SEQUENCE STORED IN MEMORY"
1610  PRINT S0" - "SQ
1650  POKE 6,S0 - INT(S0/256) *256
1660  POKE 7, INT(S0/256)
1670  POKE 8,SQ - INT(SQ/256) *256
1680  POKE 9, INT(SQ/256)
1690  POKE 255,16: REM  TEMPO
1695  PRINT : PRINT
1700  PRINT "TO HEAR IT - BLOAD MIDI.PLAYBACK AND": PRINT "CALL 768": PRINT : PRINT "TO SAVE IT : BSAVE <NAME>,A"SO",E"SQ
9999  END
10000  REM  SUBROUTINE TO ASSIGN NEW NOTES TO TRACKS
10005  IF MT = 0  THEN MT = 1:FR = MT: GOTO 10050
10009 FR = 0
10010  FOR Q = 1 TO MT
10020  IF A(Q) = 0  THEN FR = Q:Q = MT +1
10030  NEXT Q
10040  IF FR = 0  THEN MT = MT +1:FR = MT
10050 N(FR) = N:D(FR) = D:C(FR) = 144:V(FR) = V:A(FR) = 1
10055  IF RE = 1  THEN N(FR) = 0:V(FR) = 0: REM   SPECIAL PROCESSING FOR RESTS
10060  POKE SQ,C(FR): POKE SQ +1,N(FR): POKE SQ +2,V(FR):SQ = SQ +3
10070  POKE SQ,0:SQ = SQ +1
10080  REM  10070 WAS ADDED SO NOTES IN THE SAME EVENT OCCUR AT THE SAME TIME.  WHEN AN EVENT IS DONE, SUBTRACT 1 FROM SQ AND STORE THE CORRECT DURATION IN IT
10999  RETURN
20000  REM  REPEATING PREVIOUSLY DEFINED SUBROUTINES
20010 SC$ = ""
20020  GET A$
20030  IF A$ = " "  OR A$ = ">"  OR A$ =  CHR$(13)  OR A$ = "*"  THEN 20040
20035 SC$ = SC$ +A$
20037  GOTO 20020
20040 F = 0: FOR J = 1 TO SU
20050  IF SC$ = SU$(J)  THEN F = J
20060  NEXT J
20070  IF F = 0  THEN 20999
20075  PRINT "COPYING SUBROUTINE: ";SU$(F)
20080  FOR K = ST(F) TO SE(F)
20090  POKE SQ, PEEK(K)
20095 SQ = SQ +1
20100  NEXT K
20800 A$ = "<"
20801  REM  TRICK SUBROUTINE INTO THINKING NOTHING HAPPENED HERE
20999  RETURN