Compucolor.org – Virtual Media

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

100 REM   COMPOSER BY CAP
200 REM     SET UP SOUND PROGRAM
205 POKE 32940,255:POKE 32941,159:CLEAR 200
207 LOAD "NEWML5.DAT"
210 PLOT 6,6,12,15,27,24
215 POKE 32941,151:CLEAR 200
220 TM= 40960
230 POKE 33283,7:POKE 33284,160
250 POKE TM,50:POKE TM+ 1,0:POKE TM+ 2,15:POKE TM+ 3,0:POKE TM+ 4,0
260 BL$= "                                                                "
270 GOSUB 9500
290 RE$= "     ''"
500 GOSUB 1000:GOTO 5000
1000 REM  SET UP GRAPHICS
1205 PLOT 6,7
1210 FOR X= 0TO 125STEP 6
1220 PLOT 2,246,4,X,51,243,8,136,8,255
1230 NEXT
1240 PLOT 6,56
1250 FOR X= 0TO 120STEP 6
1260 IF X= 12OR X= 36THEN NEXT
1270 IF X= 54OR X= 78THEN NEXT
1280 IF X= 96OR X= 120THEN 1300
1290 PLOT 2,246,24,X+ 3,51,243,8,136,8,255
1300 NEXT
1320 PLOT 6,1,3,0,31
1330 PRINT " C  D  E  F  G  A  B  C  D  E  F  G  A  B  C  D  E  F  G  A  B "
1340 KK= 1
1350 RETURN
2000 REM  SONG ASSEMBLER
2010 GOSUB 1000:X= CALL (6)
2020 IF X> 0THEN PLOT 3,0,18:PRINT "SYNTAX ERROR"
2030 GOTO 5000
4200 REM  EDITOR
4210 CP= 28800
4215 POKE 30846,88:POKE 30847,7
4220 POKE CP+ 1,14
4230 OUT 8,255:CH= CALL (2):OUT 8,247:XX= CALL (0)
4235 IF CH= 25THEN 4470
4245 IF CH= 26THEN 4480
4250 IF CH= 28THEN 4460
4255 IF CH= 10THEN 4450
4265 IF CH= 127THEN 4350
4270 IF CH= 5THEN 4400
4272 IF CH= 13THEN POKE CP+ 1,6:GOTO 5000
4300 POKE CP,CH:POKE CP+ 1,6:CP= CP+ 2:IF CP> 30844THEN CP= CP- 2
4305 GOTO 4220
4325 Y2= INT (DA/ 256):Y1= DA- Y2* 256:POKE AD,Y1:POKE AD+ 1,Y2:RETURN
4335 POKE CP+ 1,6:POKE CP- 1,33
4349 REM     DELETE
4350 IF CP< = 28800THEN 4220
4355 POKE CP+ 1,6:POKE CP- 1,35
4360 DA= CP- 4:AD= TM+ 297:GOSUB 4325
4365 DA= (30846- CP)/ 2:AD= TM+ 299:GOSUB 4325
4367 XX= CALL (3)
4370 CP= CP- 2:POKE 30844,32
4380 GOSUB 4500:GOTO 4220
4399 REM     INSERT
4400 IF CP> = 30844THEN 4220
4402 POKE CP+ 1,35
4405 DA= (30844- CP)/ 2:AD= TM+ 299:GOSUB 4325
4410 DA= 30846:AD= TM+ 297:GOSUB 4325
4420 XX= CALL (4)
4425 POKE CP,32
4430 GOSUB 4500:GOTO 4220
4449 REM  MOVE CURSOR
4450 POKE CP+ 1,6:CP= CP+ 128:IF CP> 30844THEN CP= CP- 128
4455 GOTO 4220
4460 POKE CP+ 1,6:CP= CP- 128:IF CP< 28800THEN CP= CP+ 128
4465 GOTO 4220
4470 POKE CP+ 1,6:CP= CP+ 2:IF CP> 30844THEN CP= CP- 2
4475 GOTO 4220
4480 POKE CP+ 1,6:CP= CP- 2:IF CP< 28800THEN CP= CP+ 2
4485 GOTO 4220
4500 POKE TM,17:POKE TM+ 2,50:XX= CALL (0):RETURN
5000 REM  MENU
5005 PLOT 3,63,16:PRINT "X"
5010 NN= 20:S1= 14
5015 PLOT 3,S1,NN:PRINT "*********************************"
5020 PLOT 3,S1,NN+ 1:PRINT "* 1.  GET SONG MENU             *"
5030 PLOT 3,S1,NN+ 2:PRINT "* 2.  EDIT SCREEN               *"
5040 PLOT 3,S1,NN+ 3:PRINT "* 3.  PLAY SONG ON SCREEN       *"
5050 PLOT 3,S1,NN+ 4:PRINT "* 4.  SAVE SONG ON SCREEN       *"
5060 PLOT 3,S1,NN+ 5:PRINT "* 6.  ERASE SCREEN              *"
5062 PLOT 3,S1,NN+ 6:PRINT "* 7.  QUIT                      *"
5070 PLOT 3,S1,NN+ 7:PRINT "*      PRESS YOUR CHOICE !      *"
5072 PLOT 3,S1,NN+ 8:PRINT "*********************************"
5073 PLOT 3,S1+ 28,NN+ 7
5074 GOSUB 4500
5075 OUT 8,255:X= CALL (2):OUT 8,247:XX= CALL (0):IF X< 32THEN 5075
5080 X$= CHR$ (X):PRINT "";X$:REM 
5095 X= VAL (X$):IF X= 0THEN 5000
5096 PLOT 3,0,18:PRINT "            "
5098 IF X= 1THEN GOSUB 7000:GOTO 5000
5100 IF X= 2THEN 4200
5110 IF X= 3THEN 2000
5111 IF X= 4THEN GOSUB 8000:GOTO 5000
5115 IF X= 7THEN OUT 8,255:PLOT 27,11,3,0,28:END
5120 IF X= 6THEN Y1= 1:Y2= 16:GOSUB 5600:PLOT 3,0,10:PRINT BL$:GOTO 5000
5125 IF X= 8THEN GOSUB 7000:GOTO 5000
5190 GOTO 5000
5600 REM  ERASE LINES
5610 FOR N= Y1TO Y2:PLOT 3,0,N:PRINT BL$:NEXT :RETURN
7000 REM  PRINT MENU
7005 Y1= 18:Y2= 31:GOSUB 5600
7010 FILE "R",1,"CATALG",1
7050 FOR N= 1TO 8
7100 GET 1,N;A$[30]
7110 PLOT 3,0,19+ N,6,7:PRINT A$
7120 NEXT
7130 FOR N= 9TO 16
7140 GET 1,N;A$[30]
7150 PLOT 3,32,19+ N- 8,6,7
7155 PRINT A$
7160 NEXT
7203 IF SV= 1THEN FILE "C",1:GOTO 7250
7205 PLOT 3,10,30
7210 INPUT "      ENTER YOUR CHOICE ! ";CH$:CH= VAL (CH$):IF CH> 16THEN 7205:REM 
7215 IF CH= 0THEN 7237
7235 GET 1,CH;A$[30]
7236 PLOT 3,20,18:PRINT MID$ (A$,5)
7237 FILE "C",1
7240 GOSUB 9000
7245 PLOT 3,0,30:PRINT BL$:GOSUB 1205
7250 RETURN
8000 REM  STORE SONG
8003 SV= 1:GOSUB 7000:SV= 0
8005 OUT 8,255
8010 PLOT 3,11,19:INPUT "NUMBER,NAME ? ";NO$,NA$
8015 OUT 8,247
8020 NO= VAL (NO$):NA$= LEFT$ (NA$+ BL$,26)
8025 IF NO= 0THEN 8250
8026 IF NO> 16THEN 8005
8030 PLOT 3,20,18:PRINT NA$
8040 SL= 0:IF PEEK (29824)< > 32THEN SL= 8* 128:IF NO> 14THEN PRINT "ERROR":OUT 8,255:END
8090 FILE "R",1,"SONGS",1:X1= 1
8100 FOR N1= 0TO 1000+ SLSTEP 128
8105 A$= ""
8110 FOR N2= 28800+ N1TO 28800+ N1+ 127STEP 2
8120 A$= A$+ CHR$ (PEEK (N2))
8130 POKE N2+ 1,14
8150 NEXT
8155 PUT 1,X1+ (NO- 1)* 8;A$[64]
8160 X1= X1+ 1
8200 NEXT
8210 FILE "C",1:PLOT 3,0,19:PRINT BL$
8215 FILE "R",1,"CATALG",2
8220 PUT 1,NO,7;NA$[25]
8223 IF SL> 0THEN PUT 1,NO+ 1,7;(RE$+ BL$)[25]
8225 FILE "C",1
8230 FOR N1= 28801+ 1024+ SLTO 28801STEP - 2
8235 POKE N1,6:NEXT
8250 GOSUB 1000:RETURN
9000 REM  GET SONG
9005 IF CH= 0THEN 9100
9010 PRINT "":REM 
9015 Y1= 1:Y2= 16:GOSUB 5600
9020 NO= CH:GOSUB 9200
9030 FILE "R",1,"SONGS",1:X1= 1
9050 FOR N= 1TO 8+ LL
9060 GET 1,(NO- 1)* 8+ N;A$[64]
9070 PLOT 3,0,N:PRINT A$
9080 NEXT
9090 FILE "C",1
9100 RETURN
9200 REM LENGTH CHECKER
9210 LL= 0:IF NO> 14THEN RETURN
9220 FILE "R",1,"CATALG",2
9230 GET 1,NO+ 1;LL$[9]
9240 IF RIGHT$ (LL$,3)= ""THEN LL= 8:REM 
9250 FILE "C",1:RETURN
9500 REM  BORDERS
9510 PLOT 11:PRINT "********************* THE MUSIC COMPOSER ***********************"
9520 PLOT 3,0,17:PRINT "****************************************************************"
9530 PLOT 3,63,16:PRINT "X":RETURN