Compucolor.org – Virtual Media

Listing of file='MUSIC.BAS;01' on disk='vmedia/chip_23-sector.ccvf'

100 GOTO 5130
110 CLEAR 500
120 DIM EN$(254),PI(254),DU(254),OC(4),PN(6)
130 RESTORE 5100
140 FOR  I= 0 TO  4
150 READ  OC(I)
160 NEXT  I
170 FOR  I= 0 TO  6
180 READ  PN(I)
190 NEXT  I
191 FOR  I= 0 TO  254
192 EN$(I)= "":PI(I)= 0:DU(I)= 0
193 NEXT  I
200 LO= PEEK (32940)+ PEEK (32941)* 256+ 1
210 GOTO 1000
220 NO= 1:AD= 1.05946:MX= 254
230 PRINT  "INPUT THE NOTES, ONE AT A TIME, USING THE FORMAT"
240 PRINT  "SPECIFIED IN THE INSTRUCTIONS."
250 PRINT
260 PRINT  "NOTE #";NO;" = ";
270 INPUT  EN$(NO)
280 CO$= LEFT$ (EN$(NO),2)
290 IF  CO$= "QU" THEN EN$(0)= STR$ (NO- 1):RETURN
300 NO= NO+ 1
310 IF  NO< = MX THEN 260
320 PRINT  "MAXIMUM FILE SIZE REACHED.":FOR  I= 1 TO  1000:NEXT  I:RETURN
1000 REM   COMMAND INPUT SECTION
1010 PLOT  6,6,12
1020 INPUT  "COMMAND = ";CM$
1030 IF  CM$= "NEW" THEN GOSUB 220:GOTO 1000
1040 IF  CM$= "LOAD" THEN GOSUB 2000:GOTO 1000
1050 IF  CM$= "SAVE" THEN GOTO 3000
1060 IF  CM$= "COMP" THEN GOSUB 4000:GOTO 1000
1070 IF  CM$= "PLAY" THEN GOSUB 5000:GOTO 1000
1080 IF  CM$= "DISP" THEN GOSUB 5450:GOTO 1000
1090 IF  CM$= "QUIT" THEN GOTO 6000
1100 REM     INVALID COMMAND ENTERED
1110 PRINT
1120 PRINT "THE FOLLOWING COMMANDS ARE VALID AT THIS POINT:"
1130 PRINT
1140 PRINT TAB( 10);"'NEW'    CREATE A NEW MUSIC FILE"
1150 PRINT TAB( 10);"'LOAD'   LOAD AN EXISTING MUSIC FILE"
1160 PRINT TAB( 10);"'SAVE'   SAVE A NEW MUSIC FILE"
1170 PRINT TAB( 10);"'COMP'   COMPILE THE PIECE INTO PITCH AND DURATION"
1180 PRINT TAB( 10);"'PLAY'   PLAY A PIECE ALREADY IN MEMORY(OR LOADED)"
1190 PRINT TAB( 10);"'DISP'   DISPLAY THE NOTE, PITCH, AND DURATION ARRAYS"
1200 PRINT TAB( 10);"'QUIT'   RETURN TO BASIC"
1210 PRINT :GOTO 1020
2000 REM   FILE LOAD SECTION
2010 INPUT  "NAME OF FILE TO BE LOADED = ";FA$
2020 FU$= FA$+ ".TXT"
2030 NO= 0
2040 REM   SEE IF FILE EXISTS
2050 FILE "T",2150
2060 FILE "R",1,FU$,1
2070 REM   O.K., LOAD THE FILE
2080 EN$(NO)= ""
2090 T$= ""
2100 GET 1;T$[1]
2110 IF  T$= CHR$ (26) THEN FILE "C",1:RETURN
2120 IF  T$= CHR$ (13) THEN NO= NO+ 1:GOTO 2080
2130 EN$(NO)= EN$(NO)+ T$
2140 GOTO 2090
2150 FILE "E",FL,ER,LN
2160 IF  ER= 14 THEN PRINT "FILE DOES NOT EXIST":GOTO 2010
2170 IF  ER= 2 THEN PRINT "BAD FILE NAME":GOTO 2010
2180 PRINT  "FILE ERROR # ";ER:GOTO 2010
3000 REM  FILE SAVE SECTION
3003 REM   THIS STRING SAVE ROUTINE IS BASED ON THE ROUTINE
3006 REM   PRINTED IN ISSUE NINE OF 'DATA CHIP' THE NEWSLETTER
3009 REM   OF THE COMPUCOLOR USERS' GROUP OF ROCHESTER, NEW YORK
3010 INPUT  "NAME OF FILE = ";FA$
3020 REM   MAKE SURE THAT THE FILE DOES NOT ALREADY EXIST
3030 FILE "T",3250
3040 FILE "R",1,FA$+ ".TXT",1
3050 PRINT  "FILE ALREADY EXISTS":FILE "C",1:GOTO 3010
3060 REM   ALL IS WELL, FIGURE OUT FILE SIZE AND ALLOCATE FILE
3070 TD= NO
3080 Y= 1:FOR  X= 0 TO  TD:Y= Y+ LEN (EN$(X))+ 1:NEXT
3090 FU$= FA$+ ".TXT"
3100 FILE "N",FU$,Y,1,128
3110 FILE "R",1,FU$,1
3120 REM      FOR EACH STRING IN THE ARRAY,
3130 FOR  X= 0 TO  TD
3140 REM      FOR EACH CHARACTER IN EACH STRING,
3150 FOR  Y= 1 TO  LEN (EN$(X))
3160 REM      EXTRACT NEXT CHARACTER AND WRITE IT IF NOT NULL
3170 T$= MID$ (EN$(X),Y,1):IF T$< > ""THEN PUT 1;T$[1]
3180 NEXT
3190 REM       FOLLOW EACH STRING WITH A CARRIAGE RETURN
3200 T$= CHR$ (13):PUT 1;T$[1]
3210 NEXT
3220 REM       FOLLOW THE FILE WITH X'26'
3230 T$= CHR$ (26):PUT 1;T$[1]
3240 FILE "C",1:GOTO 1000
3250 FILE "E",FL,ER,LN
3260 IF  ER= 2 THEN PRINT  "BAD FILE NAME":GOTO 3010
3270 IF  ER= 14 THEN GOTO 3070
3280 PRINT  "FILE ERROR #";ER:GOTO 3010
4000 NO= VAL (EN$(0))
4010 FOR  I= 1 TO  NO
4020 TM$= EN$(I)
4030 IF  LEFT$ (TM$,1)= "R" THEN P= - 225:GOTO 4050
4040 P= PN(ASC (LEFT$ (TM$,1))- 65)
4050 J= 2
4060 MD$= MID$ (TM$,J,1)
4070 IF  MD$= "" THEN 4280
4080 IF  MD$= "#" THEN P= P/ AD:J= J+ 1
4090 IF  MD$= "b" THEN P= P* AD:J= J+ 1
4100 IF  MD$= "N" THEN J= J+ 1
4110 MD$= MID$ (TM$,J,1)
4120 IF  MD$= "" THEN 4280
4130 IF  MD$= "W" THEN D= 80000:J= J+ 1
4140 IF  MD$= "H" THEN D= 40000:J= J+ 1
4150 IF  MD$= "Q" THEN D= 20000:J= J+ 1
4160 IF  MD$= "E" THEN D= 10000:J= J+ 1
4170 IF  MD$= "S" THEN D= 5000:J= J+ 1
4180 IF  MD$= "T" THEN D= 2500:J= J+ 1
4190 IF  MD$= "Z" THEN D= 1250:J= J+ 1
4200 DT= D
4210 MD$= MID$ (TM$,J,1)
4220 IF  MD$= "" THEN 4280
4230 IF  MD$= "." THEN DT= D* 1.5:J= J+ 1
4240 MD$= MID$ (TM$,J,1)
4250 IF  MD$= "" THEN 4280
4260 O= ASC (MD$)- 48
4270 IF  O< 0 OR  O> 4 THEN PRINT  "OCTAVE OUT OF RANGE, NOTE#";NO:O= 0
4280 PT= P/ OC(O)
4290 IF  PT< 0 THEN PT= P
4300 DU(I)= INT ((DT/ PT)+ 0.5)
4310 PI(I)= INT (PT+ 0.5)
4320 NEXT  I
4330 RETURN
5000 REM

    **   REPLAY MUSIC   **

5010 FOR I= 1TO  NO
5020 IF  PI(I)> 0 THEN 5040
5030 FOR  II= 1 TO  ABS (DU(I)):NEXT  II:GOTO 5090
5040 Z1= INT (PI(I)/ 256):Z2= PI(I)- Z1* 256
5050 POKE LO,Z2:POKE LO+ 1,Z1
5060 Z1= INT (DU(I)/ 256):Z2= DU(I)- Z1* 256
5070 POKE LO+ 2,Z2:POKE LO+ 3,Z1
5080 X= CALL (0)
5090 NEXT I:RETURN
5100 DATA  1,2,4,8,16
5110 DATA  713.525,635.678,600,534.539,476.22,449.492,400.452
5120 REM

      **   LOAD ASSM PATCH   **

5130 TM= PEEK (32940)+ PEEK (32941)* 256
5140 IF TM> 65500THEN 5190
5150 POKE TM+ 1,50:POKE TM+ 3,15
5160 REM   60027 CHECKS IF MACHINE LANGUAGE ALREADY LOADED
5170 A= 0:FOR N= TM+ 176TO TM+ 182:A= A+ PEEK (N):NEXT
5180 IF A= 1445THEN 5270
5190 AD= 32940:TM= TM- 200:DA= TM:GOSUB 5280:CLEAR 100
5200 TM= PEEK (32940)+ PEEK (32941)* 256
5210 RESTORE 5310
5220 REM   60050 LOADS MACHINE LANGUAGE
5230 FOR N= 1TO 200:READ A:IF A> 255THEN N= 220:GOTO 5260
5240 IF A< 0THEN DA= TM- A:AD= TM+ N:GOSUB 5280:GOTO 5260
5250 POKE TM+ N,A
5260 NEXT
5270 AD= 33283:DA= TM+ 8:GOSUB 5280:GOTO 110
5280 Z1= INT (DA/ 256):Z2= DA- Z1* 256
5290 POKE AD,Z2:N= N+ 1:POKE AD+ 1,Z1:RETURN
5300 REM        MACHINE LANGUAGE DATA
5310 DATA 50,0,15,0,0,0,0,123,254,0,194,-121,30,8,243
5320 DATA 58,-6,87,58,-7,254,0,194,-33,122,50,-7,42,-1
5330 DATA 34,-49,42,-3,34,-46,33,-22,1,50,0,11,120,177
5340 DATA 194,-51,123,238,2,211,4,95,43,124,181,194
5350 DATA -48,58,-5,254,0,202,-100,61,50,-5,58,-49,130
5360 DATA 50,-49,58,-7,103,122,50,-7,84,195,-45,50,-7
5370 DATA 50,-4,50,-2,62,15,50,-3,62,50,50,-1,251,201
5380 DATA 254,1,194,-158,33,0,0,6,4,14,17,17,128,0,25
5390 DATA 126,17,128,255,25,119,35,0,13,194,-133,17,8
5400 DATA 0,25,5,194,-131,201
5410 DATA 254,2,194,-182,245,229,197,205,36,0,194,-166
5420 DATA 95,175,87,50,255,129,193,225,241,201,201
5430 DATA 300
5440 REM  *** DISPLAY THE ARRAYS ***
5450 T2= 0
5460 PLOT  6,6,12
5470 PRINT  "ENTRY","PITCH","DURATION"
5480 PRINT
5490 FOR  T1= O TO  19
5500 PRINT  EN$(T2),PI(T2),DU(T2)
5510 T2= T2+ 1
5520 IF  T2> NO THEN 5560
5530 NEXT  T1
5540 INPUT  "HIT RETURN TO CONTINUE.";XX$
5550 GOTO 5460
5560 INPUT  "HIT RETURN TO RETURN TO COMMAND LEVEL.";XX$
5570 RETURN
6000 END