Compucolor.org – Virtual Media

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

1 REM  MUSIC COMPOSITION (MCOMP)
2 REM  BY LARRY PETERSON
3 REM  OAKDALE,CALIFORNIA
5 CLEAR 500:CT= 1:PG= 1
6 DIM N$(20),NN$(20),OC(100)
7 DIM M$(20),PI$(100),NK(100),PI(100),DU(100)
8 GOSUB 5000:GOSUB 60000:GOSUB 11000
10 PLOT 12,15,18:RESTORE 35
12 ER$= "                                "
20 FOR X= 1TO 63:PLOT 20,3,X,19,105:NEXT X
25 FOR Y= 20TO 28:PLOT 3,32,Y,110:NEXT Y
28 FOR X= 1TO 63:PLOT 3,X,28,105:NEXT X:PLOT 18
30 FOR X= 1TO 8:READ M$(X):NEXT X
35 DATA "ADD         9) DELETE","EDIT       10) INSERT"
37 DATA "PLAY ALL   11) PAGE","PLAY PART  12) END","EQUIVELANTS"
40 DATA "LOAD       13) HELP","SAVE","TRANSPOSE"
45 Y= 0:PLOT 15,18
50 FOR X= 20TO 27:PLOT 3,35,X:Y= Y+ 1
60 PRINT Y") "M$(Y):NEXT X
65 PLOT 3,0,20:FOR X= 1TO 6:PRINT ER$:NEXT X
70 PLOT 3,3,20:INPUT "NEXT COMMAND - ";C
75 ON CGOTO 100,1000,2000,3000,4500,3500,4000,10000,6000,7000,500,8000,11100
100 REM  ADD A NOTE SEQUENCE
118 I= I+ 1
120 INPUT "    OCTIVE ? ";OC(I):OC(I)= OC(I)- 1
130 INPUT "     NOTE ? ";PI$(I)
140 INPUT "     TYPE ? ";NK(I)
150 GOSUB 800:GOSUB 300
200 GOTO 65
300 REM  ADD NOTE TO NOTE TABLE
302 IF OC(I)> 4OR NK(I)> 64THEN I= I- 1:GOTO 65
304 IF I= 56THEN L= 0
305 IF T= 0THEN PLOT 8:GOTO 400
307 IF T= 60THEN L= L+ 5:PLOT 3,0,L:GOTO 400
310 T= T+ 4
330 PLOT 3,T,L:PRINT I
340 PLOT 3,T,L+ 1:PRINT OC(I)+ 1
345 PLOT 3,T,L+ 2:PRINT "    ":PLOT 3,T+ 1,L+ 2:PRINT PI$(I)
350 PLOT 3,T,L+ 3:PRINT "    ":PLOT 3,T,L+ 3:PRINT NK(I)
360 RETURN
400 REM
410 PRINT "NOTE #":PRINT "OCTIVE":PRINT "PITCH":PRINT "TYPE"
420 T= 4:GOTO 310
500 REM  PAGING
505 II= I:T= 0:L= 0
510 INPUT "   PAGE 1 OR PAGE 2 ";PG
515 PLOT 8:FOR X= 1TO 19:PLOT 11:PRINT :NEXT X
520 IF PG= 2THEN XX= 57:GOTO 550
530 XX= 1
550 FOR I= XXTO II:IF I= 57GOTO 570
560 GOSUB 304
570 NEXT I:I= II
600 GOTO 65
800 REM  CALCULATE PROPER ML #'S FOR GIVEN NOTE
810 FOR X= 1TO 18
820 IF N$(X)= PI$(I)THEN PI= X+ (OC(I)* 12):GOTO 850
830 IF NN$(X)= PI$(I)THEN PI= X+ (OC(I)* 12):GOTO 850
840 NEXT X
845 I= I- 1:GOTO 65
850 DU(I)= INT (EXP (6.52322- .05983* PI))* 7/ NK(I)
860 PI(I)= INT (EXP (2.81360+ .05983* PI))
865 DU= DU(I)* CT:PI= PI(I)
900 GOSUB 63000:RETURN
1000 REM  EDIT THE NOTES
1020 INPUT " WHICH NOTE TO EDIT? ";CH
1040 INPUT " GIVE NEW OCTIVE - ";OC(CH):OC(CH)= OC(CH)- 1
1060 INPUT " GIVE NEW NOTE   - ";PI$(CH)
1080 INPUT " GIVE NEW TYPE   - ";NK(CH)
1100 II= I:I= CH:GOSUB 800
1190 IF CH< 15THEN LL= 0:CC= 0:GOTO 1700
1200 IF CH> 14AND CH< 29THEN LL= 5:CC= 1:GOTO 1700
1210 IF CH> 28AND CH< 43THEN LL= 10:CC= 2:GOTO 1700
1220 IF CH> 42AND CH< 57THEN LL= 15:CC= 3:GOTO 1700
1230 IF CH> 56AND CH< 71THEN LL= 0:CC= 0:GOTO 1700
1240 IF CH> 70AND CH< 85THEN LL= 5:CC= 1:GOTO 1700
1250 IF CH> 84THEN LL= 10:CC= 2
1700 TT= (CH- 14* CC)* 4+ 4
1720 PLOT 3,TT,LL:PRINT CH
1750 PLOT 3,TT,LL+ 1:PRINT OC(CH)+ 1
1800 PLOT 3,TT+ 1,LL+ 2:PRINT "    ":PLOT 3,TT+ 1,LL+ 2:PRINT PI$(CH)
1850 PLOT 3,TT,LL+ 3:PRINT "    ":PLOT 3,TT,LL+ 3:PRINT NK(CH)
1900 I= II:GOTO 65
2000 REM  PLAY ALL THE NOTES
2130 PRINT "  THE SPEED IS = ";CT
2140 INPUT "  DO YOU WISH TO CHANGE IT? ";Y$
2150 IF LEFT$ (Y$,1)= "Y"THEN 2170
2160 GOTO 2190
2170 INPUT "  WHAT IS THE NEW SPEED? ";CT
2190 FOR X= 1TO I
2200 DU= DU(X)* CT:PI= PI(X):GOSUB 63000:NEXT X
2300 GOTO 65
3000 REM  PLAY PART OF THE NOTES
3020 INPUT " GIVE NO. OF FIRST NOTE - ";NF
3030 INPUT " GIVE NO. OF LAST  NOTE - ";NL
3040 FOR X= NFTO NL
3080 DU= DU(X)* CT:PI= PI(X):GOSUB 63000:NEXT X
3100 GOTO 65
3500 REM  LOAD A SONG FROM THE DISK
3510 L= 0:T= 0
3520 INPUT "  WHICH SONG TO LOAD? ";S$
3560 FILE "R",1,S$+ ".MUS",1
3580 GET 1;I,CT
3600 FOR X= 1TO I
3620 GET 1;OC(X),NK(X),DU(X),PI(X),PI$(X)[2]
3640 NEXT X
3650 FILE "C",1
3800 GOTO 65
4000 REM  SAVE A SONG ON THE DISK
4020 INPUT "   GIVE NAME OF THE SONG. ";S$
4040 INPUT "    IS THIS A NEW SONG? ";A$
4050 IF LEFT$ (A$,1)= "N"GOTO 4100
4060 FILE "N",S$+ ".MUS",100,38,10
4100 FILE "R",1,S$+ ".MUS",1
4120 PUT 1;I,CT
4140 FOR X= 1TO I
4160 PUT 1;OC(X),NK(X),DU(X),PI(X),PI$(X)[2]
4200 NEXT X
4300 FILE "C",1
4400 GOTO 65
4500 REM  ADD AN EQUIVELENT NOTE
4510 INPUT " WHICH NOTE TO REPETE - ";CH
4520 I= I+ 1
4540 OC(I)= OC(CH):PI$(I)= PI$(CH):NK(I)= NK(CH)
4560 GOSUB 300:GOSUB 800:GOTO 65
4900 REM  LOAD THE NOTES
5000 RESTORE 5020
5005 FOR X= 1TO 12:READ N$(X):NEXT X
5010 FOR X= 1TO 12:READ NN$(X):NEXT X
5015 RETURN
5020 DATA C,B,A#,A,G#,G,F#,F,E,D#,D,C#
5040 DATA T,T,B!,T,A!,T,G!,T,T,E!,T,D!
6000 REM  DELETE A NOTE
6020 INPUT "WHICH NOTE TO DELETE? ";DL
6040 FOR X= DLTO I- 1
6060 OC(X)= OC(X+ 1):PI$(X)= PI$(X+ 1):NK(X)= NK(X+ 1)
6080 DU(X)= DU(X+ 1):PI(X)= PI(X+ 1)
6100 NEXT X
6120 II= I:L= 0:T= 0
6140 FOR I= 1TO II- 1
6150 IF PG= 2AND I< 65THEN 6250
6160 IF PG= 1AND I> 64THEN 6250
6170 GOSUB 304
6250 NEXT I:I= II
6260 TT= T:LL= L:OC(I)= - 1:PI$(I)= "":NK(I)= 0:GOSUB 304
6270 T= TT:L= LL:I= II- 1
6800 GOTO 65
7000 REM  INSERT A NOTE
7020 INPUT "INSERT A NOTE AFTER # - ";IN
7040 FOR X= I+ 1TO IN+ 1STEP - 1
7060 OC(X+ 1)= OC(X):PI$(X+ 1)= PI$(X):NK(X+ 1)= NK(X)
7080 DU(X+ 1)= DU(X):PI(X+ 1)= PI(X)
7100 NEXT X:I= I+ 1:CH= IN+ 1
7120 II= I:NI= IN:T= 0:L= 0
7140 FOR I= 1TO II:GOSUB 304:NEXT I:I= II
7160 PLOT 3,0,22:GOSUB 1040
7800 GOTO 65
8000 PRINT " COME BACK AGAIN SOON"
8020 PRINT "AND WE'LL PLAY SOME MORE "
8040 END
10000 REM  TRANSPOSE THE OCTIVE
10010 INPUT "TRANSPOSITION (-1 OR 2)? ";TP
10015 XX= 8:YY= 1
10020 FOR II= 1TO I
10022 OC(II)= OC(II)+ TP
10025 IF MID$ (PI$(II),2,1)= "#"THEN 10050
10028 IF MID$ (PI$(II),2,1)= "!"THEN 10050
10030 PI$(II)= LEFT$ (PI$(II),1)
10050 FOR X= 1TO 18
10100 IF N$(X)= PI$(II)THEN PI= X+ (OC(II)* 12):GOTO 10500
10200 IF NN$(X)= PI$(II)THEN PI= X+ (OC(II)* 12):GOTO 10500
10300 NEXT X
10500 DU(II)= INT (EXP (6.52322- .05983* PI))* 7/ NK(II)
10510 PI(II)= INT (EXP (2.81360+ .05983* PI))
10513 IF PG= 1AND XX> 64THEN 10540
10516 IF PG= 2AND XX< 65THEN 10540
10520 PLOT 3,XX,YY:PRINT "    ":PLOT 3,XX,YY:PRINT OC(II)+ 1
10540 XX= XX+ 4
10560 IF XX= 64THEN XX= 8:YY= YY+ 5
10580 IF YY= 21THEN YY= 1
10590 NEXT II
10600 GOTO 65

11000 PLOT 12:REM  INSTRUCTION SET
11005 PRINT :PRINT :PRINT :PRINT
11010 PLOT 14:PRINT "WELCOME TO THE MUSIC MACHINE":PLOT 15
11015 PRINT "FOR ASSISTANCE WITH ANY COMMAND CALL FOR HELP."
11020 PRINT :INPUT "HIT RETURN WHEN YOU ARE READY TO CONTINUE ";A$
11030 RETURN
11040 PLOT 18,12
11100 REM  HELP ON FUNCTIONS
11110 INPUT "WHICH COMMAND FOR HELP #";H
11120 GOSUB 11300
11125 PLOT 8
11130 ON HGOTO 11200,11400,11600,11800,12000,12200,12400,12600,12800,13000,13200,13400,13600
11200 PRINT "              ADD":PLOT 15
11205 PRINT "    THE ADD FUNCTION IS USED TO ADD NOTES TO THE SONG."
11210 PRINT "THE FOLLOWING INFORMATION IS REQUIRED"
11215 PRINT "1) OCTIVE NUMBER.  THE RANGE IS 1 TO 5, WITH 1 THE HIGHEST."
11220 PRINT "2) NOTE.  THE RANGE IS FROM A TO G.  FOR SHARPS"
11225 PRINT "   USE # AFTER THE NOTE, FOR FLATS USE AN !."
11230 PRINT "3) TYPE.  THE RANGE IS FROM 1 TO 64, AND REFERS TO"
11235 PRINT "   WEATHER THE NOTE IS A FULL NOTE (1), A HALF"
11240 PRINT "   NOTE (2), A QUARTER NOTE (4), ETC.  ANY NUMBER"
11245 PRINT "   BETWEEN 1 AND 64 CAN BE USED."
11250 GOSUB 11020:GOSUB 11300:GOTO 65
11300 PLOT 8,15:FOR X= 1TO 19:PLOT 11:PRINT :NEXT X:RETURN
11400 PLOT 14:PRINT "               EDIT":PLOT 15
11410 PRINT "  THE EDIT FUNCTION ALLOWS YOU TO MODIFY ANY NOTE."
11420 PRINT "SIMPLY GIVE THE NUMBER OF THE NOTE TO BE EDITED"
11430 PRINT "AND THE APPROPRIATE NEW VALUES AS PROMPTED."
11500 GOTO 11250
11600 PLOT 14:PRINT "               PLAY ALL":PLOT 15
11610 PRINT "   THE PLAY ALL FUNCTION PLAYS THE ENTIRE SONG"
11615 PRINT "WHEN ACCESSED THE SPEED AT WHICH THE SONG IS PLAYED CAN BE"
11620 PRINT "CHANGE BY ANSWERING Y TO THE QUESTION.  THEN GIVING THE NEW"
11625 PRINT "SPEED DESIRED.  THE SMALLER THE NUMBER THE FASTER
11630 PRINT "THE SONG WILL PLAY.  IN THIS WAY THE TEMPO CAN BE"
11635 PRINT "VARIED OVER A WIDE RANGE.  VALUES LESS THAN ONE CAN BE USED."
11700 GOTO 11250
11800 PLOT 14:PRINT "               PLAY PART":PLOT 15
11810 PRINT "   THE PLAY PART FUNCTION IS USED TO PLAY SPECIFIC BRACKETED"
11820 PRINT "NOTES.  WHEN PROMPTED ENTER THE NUMBER OF THE NOTE WHERE YOU"
11830 PRINT "WANT TO START PLAYING AND NEXT THE ENDING NUMBER."
11840 PRINT "JUST THE NOTES BETWEEN THOES NUMBERS WILL BE PLAYED.
11900 GOTO 11250
12000 PLOT 14:PRINT "          EQUIVELANTS":PLOT 15
12010 PRINT "   THE EQUIVELANTS FUNCTION ALLOWS A NOTE PREVIOUSLY ENTERED"
12020 PRINT "TO BE REPEATED AS THE NEXT NOTE TO BE ADDED TO THE SONG."
12030 PRINT "JUST ENTER THE NUMBER OF THE PREVIOUS NOTE."
12100 GOTO 11250
12200 PLOT 14:PRINT "               LOAD":PLOT 15
12210 PRINT "   THE LOAD FUNCTION IS USED TO GET A PREVIOUSLY SAVED SONG"
12220 PRINT "FROM THE DISK.  ENTER THE NAME OF THE SONG AS SAVED
12230 PRINT "AND THE TUNE WILL BE LOADED INTO MEMORY.  USE THE PAGE COMMAND "
12240 PRINT "TO DISPLAY THE NOTES ON THE SCREEN."
12300 GOTO 11250
12400 PLOT 14:PRINT "               SAVE":PLOT 15
12410 PRINT "   THE SAVE COMMAND IS USED TO SAVE A SONG ON THE"
12420 PRINT "DISK.  WHEN THE NAME OF THE SONG IS GIVEN (6 LETTER LIMIT)"
12430 PRINT "FOR THE FIRST TIME SUFFICIENT SPACE IS ALLOCATED ON THE DISK"
12440 PRINT "FOR 100 NOTES.  AFTER THAT A SONG CAN BE LOADED, MODIFIED AND"
12450 PRINT "SAVE ON THE SAME TRACK.  IF YOU WISH AT ANY TIME TO SET UP A"
12460 PRINT "NEW FILE RESPOND WITH Y WHEN PROMPTED AND GIVE THE NEW NAME."
12500 GOTO 11250
12600 PLOT 14:PRINT "               TRANSPOSE":PLOT 15
12610 PRINT "   THE TRANSPOSE FUNCTION CAN BE USED TO SHIFT THE
12620 PRINT "KEY OF THE SONG.  BY ENTERING A 1 THE OCTIVE WILL
12630 PRINT "BE SHIFTED DOWN ONE OCTIVE.  USING A -1 THE OCTIVE
12640 PRINT "WILL BE SHIFTED UP ONE OCTIVE.  VALUES LESS THAN
12650 PRINT "ONE WILL RESULT IN FRACTIONAL TRANSPOSITIONS."
12660 PRINT "HOWEVER, FRACTIONAL CHANGES WILL RESULT IN NOTES"
12670 PRINT "DIFFERENT THAN THOES ENTERED.  NO ALGORITHM HAS"
12680 PRINT "BEEN INCLUDED TO CONVERT TO THE PROPER NOTE ON THE
12690 PRINT "SCREEN (A,D,C ETC).  BUT WHEN PLAYED THE PITCH
12700 PRINT "WILL BE CORRECTLY TRANSPOSED."
12750 GOSUB 11020:GOSUB 11300:GOTO 65
12800 PLOT 14:PRINT "               DELETE":PLOT 15
12810 PRINT "   THE DELETE FUNCTION IS USE TO REMOVE UNDESIRED"
12820 PRINT "NOTES FROM THE SONG.  SIMPLY ENTER THE NUMBER OF
12830 PRINT "THE NOTE TO BE DELETED."
12900 GOTO 11250
13000 PLOT 14:PRINT "               INSERT":PLOT 15
13010 PRINT "   WITH THE INSERT COMMAND A NEW NOTE CAN BE PLACED
13015 PRINT "ANY WHERE IN THE SONG.  FIRST GIVE THE NUMBER OF
13020 PRINT "THE NOTE JUST BEFORE THE POINT WHERE YOU WANT THE
13030 PRINT "NEW NOTE INSERTED.  NEXT ENTER THE NOTE CHARACTERISTICS"
13040 PRINT "AS PROMPTED.  FOR FURTHER HELP SEE ADD."
13100 GOTO 11250
13200 PLOT 14:PRINT "               PAGE":PLOT 15
13210 PRINT "   THE PROGRAM IS SET-UP TO HOLD A MAXIMUM OF 100
13220 PRINT "NOTES.  HOWEVER, THE SCREEN CAN ONLY HOLD 56 AT A
13230 PRINT "TIME, THUS, PAGE=1 WILL DISPLAY THE FIRST 56 NOTES
13240 PRINT "AND PAGE=2 WILL DISPLAY THE REMAINING NOTES."
13300 GOTO 11250
13400 PLOT 14:PRINT "               END":PLOT 15
13410 PRINT "   THIS DOES JUST WHAT YOU WOULD EXPECT, BUT BEWARE
13520 PRINT "FOR YOU WILL ERASE YOUR SONG IF IT WASN'T SAVED."
13530 GOTO 11250
13600 PLOT 14:PRINT "                HELP":PLOT 15
13610 PRINT "   THE HELP COMMAND MAKES IT POSSIBLE FOR YOU TO
13620 PRINT "TO CHECK ON THE USE OF ANY COMMAND AT ANY TIME YOU
13630 PRINT "NEED HELP.  AFTER USING HELP THE NOTES CAN BE
13640 PRINT "RETURNED TO THE SCREEN WITH THE PAGE COMMAND."
13700 GOTO 11250
60000 REM  SOUND PATCH
60005 PLOT 6,7,12,14,3,15,15
60010 DA= 48962
60015 AD= 32940:GOSUB 60100
60020 TM= PEEK (32940)+ PEEK (32941)* 256
60021 POKE TM+ 1,50:POKE TM+ 2,0:POKE TM+ 3,15:POKE TM+ 4,0
60025 AD= 33283:DA= TM+ 8:GOSUB 60100
60027 A= 0:FOR N= TM+ 176TO TM+ 182:A= A+ PEEK (N):NEXT
60030 IF A= 1445THEN 60090
60035 PRINT "LOADING SOUND PATCH"
60040 RESTORE 60200
60050 FOR N= 1TO 200:READ A:IF A> 255THEN N= 220:GOTO 60080
60060 IF A< 0THEN DA= TM- A:AD= TM+ N:GOSUB 60100:N= N+ 1:GOTO 60080
60070 POKE TM+ N,A
60080 NEXT
60090 RETURN
60100 Z1= INT (DA/ 256):Z2= DA- Z1* 256
60110 POKE AD,Z2:POKE AD+ 1,Z1:RETURN
60199 REM   MACHINE LANGUAGE DATA
60200 DATA 50,0,15,0,0,0,0,123,254,0,194,-121,30,8,243
60210 DATA 58,-6,87,58,-7,254,0,194,-33,122,50,-7,42,-1
60220 DATA 34,-49,42,-3,34,-46,33,-22,1,50,0,11,120,177
60230 DATA 194,-51,123,238,2,211,4,95,43,124,181,194
60240 DATA -48,58,-5,254,0,202,-100,61,50,-5,58,-49,130
60250 DATA 50,-49,58,-7,103,122,50,-7,84,195,-45,50,-7
60260 DATA 50,-4,50,-2,62,15,50,-3,62,50,50,-1,251,201
60270 DATA 254,1,194,-158,33,0,0,6,4,14,17,17,128,0,25
60280 DATA 126,17,128,255,25,119,35,0,13,194,-133,17,8
60290 DATA 0,25,5,194,-131,201
60300 DATA 254,2,194,-182,245,229,197,205,36,0,194,-166
60310 DATA 95,175,87,50,255,129,193,225,241,201,201
60320 DATA 300
62000 TM= PEEK (32940)+ PEEK (32041)* 256:RETURN
63000 REM   SOUND POKER
63020 AD= TM+ 1:DA= PI:GOSUB 60100
63030 AD= TM+ 3:DA= DU:GOSUB 60100
63040 POKE TM+ 5,NS:POKE TM+ 6,S1:POKE TM+ 7,S2
63050 QQ= CALL (0):RETURN