Hebdogiciel n°94 à n°97

10 !*************************!
20 ! EXELMUSIC               !
30 ! (C) 1985 JOCELYN DONZE  !
40 !*************************!
50 CLS "BCC"
60 DIM HA(68),DU(68),SI$(68),Z$(68)
70 !
80 !
90 !
100 CALL POKE(50688,165,8,6,10)
110 CALL POKE(49156,198,0)
120 !
130 !
140 !
150 CALL COLOR("0RLH")
160 LOCATE (9,11):PRINT "EEXXEELLMMUUSSIICC"
170 LOCATE (10,11):PRINT "EEXXEELLMMUUSSIICC"
180 A$=" PAR JOCELYN DONZE"
190 FOR I=1 TO LEN(A$)
200 CALL COLOR("0BB")
210 LOCATE (13,I+14):PRINT CHR$(12)
220 FOR J=1 TO 20
230 CALL KEY1(A,B)
240 IF A<>255 THEN 290
250 NEXT J
260 CALL COLOR("0bC")
270 LOCATE (13,I+14):PRINT SEG$(A$,I,1)
280 NEXT I:PAUSE 1
290 CALL COLOR("0CC")
300 A=159
310 LOCATE (13,15):PRINT " "
320 FOR I=1 TO 8
330 LOCATE (22,40):PRINT " "
340 CALL POKE(258,A,133)
350 A=A/1.0595
360 PAUSE .1
370 NEXT I
380 CALL POKE(259,45)
390 CALL COLOR("0BC")
400 LOCATE (6,2):PRINT "VOULEZ-VOUS :"
410 LOCATE (9,6):PRINT "1>ACCEDER A UN ORGUE ELECTRONIQUE"
420 LOCATE (11,6):PRINT "2>PROGRAMMER UNE MELODIE"
430 LOCATE (13,6):PRINT "3>CHARGER UNE MELODIE"
440 LOCATE (15,6):PRINT "4>AVOIR UNE DEMONSTRATION"
450 LOCATE (18,5):PRINT "VOTRE CHOIX :"
460 A$=KEY$
470 IF NOT NUMERIC(A$)THEN 460
480 A=VAL(A$):IF A<1 OR A>4 THEN 460
490 ON A GOTO 500,880,2170,1900
500 ! ORGUE
510 CLS:DIM V$(127)
520 FOR I=0 TO 127:V$(I)="159":NEXT I
530 !
540 ! TABLE DES NOTES
550 !
560 V$(65)="168":V$(90)="159":V$(69)="141":V$(82)="126":V$(84)="119"
570 V$(89)="106":V$(85)="94":V$(73)="84":V$(79)="79":V$(80)="71":V$(50)="145"
580 V$(51)="133":V$(53)="112":V$(54)="100":V$(55)="89":V$(52)="118"
590 V$(57)="76"
600 CALL COLOR("0RHL")
610 LOCATE (1,14):PRINT "OORRGGUUEE"
620 LOCATE (2,14):PRINT "OORRGGUUEE"
630 CALL COLOR("0BC")
640 LOCATE (5,2):PRINT "TABLE DE CORRESPONDANCE:TOUCHE/NOTE"
650 CALL COLOR("0bC")
660 LOCATE (7,5):PRINT "A:SI"
670 PRINT "    Z:DO              2:DO#/REb"
680 PRINT "    E:RE              3:RE#/MIb"
690 PRINT "    R:MI"
700 PRINT "    T:FA              5:FA#/SOLb"
710 PRINT "    Y:SOL             6:SOL#/LAb"
720 PRINT "    U:LA              7:LA#/SIb"
730 PRINT "    I:SI"
740 PRINT "    O:DO              8:DO#/REb"
750 PRINT "    P:RE"
760 CALL COLOR("0BC")
770 LOCATE (21,1):PRINT "POUR REVENIR AU MENU:TOUCHE D'ESPACEMENT"
780 PAUSE 1
790 CALL KEY1(A,B):IF A=255 THEN 790
800 !
810 ! CREATION DE LA NOTE
820 !
830 C=A:IF A=32 THEN CLS:GOTO 390
840 CALL POKE(258,VAL(V$(A)),135)
850 CALL KEY1(A,B):IF A=C THEN 850
860 CALL POKE(259,45)
870 GOTO 790
880 ! MUSIQUE PROGRAMMEE
890 CLS "BWW":GOSUB 2360
900 CALL COLOR("0BW")
910 J=1:X=23:Y1=0:B=0:VI=1
920 LOCATE (15,1):PRINT "INTRODUCTION DES NOTES :"
930 LOCATE (17,3):PRINT "NOTE N.";J
940 LOCATE (19,4):INPUT A$
950 IF J=68 THEN 1530
960 IF A$="" THEN 1530
970 IF LEN(A$)>6 THEN 940
980 Z$(J)=A$
990 IF A$<>"E" THEN 1080
1000 X=X-18:IF X<22 THEN X=312:Y=Y-34
1010 CO$,CP$="W":J=J-1:A$=Z$(J)
1020 GOSUB 2590
1030 SI$(J)="":X=X-18:IF X<22 THEN X=312:Y=Y-34
1040 FOR I=1 TO 17 STEP 4
1050 CALL LINE("G",X-7,I+Y1+9,X+8,I+Y1+9)
1060 NEXT I
1070 GOTO 930
1080 IF LEN(A$)=1 AND A$="D" THEN SI$(J)="1":DU(J)=.2:GOTO 1330
1090 IF LEN(A$)=1 AND A$="S" THEN SI$(J)="1":DU(J)=.5:GOTO 1330
1100 N$=SEG$(A$,1,2)
1110 RESTORE 1160
1120 FOR I=1 TO 7
1130 READ NO$,H
1140 IF N$=NO$ THEN HA(J)=H
1150 NEXT I
1160 DATA DO,159,RE,141,MI,126,FA,119,SO,106,LA,94,SI,84
1170 D$=SEG$(A$,3,1)
1180 RESTORE 1510
1190 FOR I=1 TO 5
1200 READ DU$,D
1210 IF D$=DU$ THEN DU(J)=D
1220 NEXT I
1230 IF LEN(A$)<4 THEN 1320
1240 FOR I1=4 TO LEN(A$)
1250 B$=SEG$(A$,I1,1)
1260 IF B$="#" THEN HA(J)=HA(J)/1.0595
1270 IF B$="b" THEN HA(J)=HA(J)*1.0595
1280 IF B$="1" THEN HA(J)=HA(J)*2
1290 IF B$="3" THEN HA(J)=HA(J)/2
1300 IF B$="." THEN DU(J)=DU(J)*1.5
1310 NEXT I1
1320 IF HA(J)<20 OR DU(J)=0 THEN 1390
1330 CO$="B":CP$="G"
1340 GOSUB 2590
1350 J=J+1
1360 IF B=1 THEN 2080
1370 IF B=2 THEN 2350
1380 GOTO 930
1390 CALL COLOR("0RW")
1400 FOR I=1 TO 3
1410 CALL POKE(258,159,133)
1420 LOCATE (17,3):PRINT "ERREUR    "
1430 PAUSE .3
1440 LOCATE (17,3):PRINT "      "
1450 CALL POKE(258,133,133)
1460 PAUSE .3
1470 NEXT I
1480 CALL POKE(259,45)
1490 CALL COLOR("0BW")
1500 GOTO 930
1510 DATA D,.09,C,.2,N,.5,B,1.3,R,2.6
1520 !
1530 ! EXECUTION DU MORCEAU
1540 !
1550 CLS
1560 CALL LINE("B",X,Y1+9,X,Y1+26)
1570 CALL LINE("B",X+2,Y1+9,X+2,Y1+26)
1580 CALL LINE("B",X+3,Y1+9,X+3,Y1+26)
1590 PAUSE 1
1600 LOCATE (16,2):PRINT "AUDITION"
1610 X1=25:Y1=35
1620 FOR I=1 TO J-1
1630 IF SI$(I)="1" THEN 1650
1640 CALL POKE(258,HA(I),134)
1650 CALL LINE("R",X1,Y1,X1,Y1+2)
1660 PAUSE DU(I)/VI
1670 CALL POKE(259,45)
1680 CALL LINE("W",X1,Y1,X1,Y1+2)
1690 X1=X1+18:IF X1>313 THEN X1=25:Y1=Y1+34
1700 FOR I1=1 TO 30:NEXT I1
1710 NEXT I
1720 PAUSE 1
1730 LOCATE (16,2):PRINT "VOULEZ-VOUS ECOUTER DE NOUVEAU ?"
1740 A$=KEY$
1750 IF A$="O" THEN CLS:GOTO 1590
1760 PAUSE 1:CALL HROFF
1770 LOCATE (3,2):PRINT "VOULEZ-VOUS SAUVEGARDER LE MORCEAU ? "
1780 A$=KEY$
1790 IF A$="N" THEN 1890
1800 !
1810 ! SAUVEGARDE MELODIE
1820 !
1830 OPEN #1,"1.MUSI",OUTPUT,VARIABLE J*7+14
1840 PRINT #1,J;",";
1850 FOR I=1 TO J-1
1860 PRINT #1,Z$(I);",";
1870 NEXT I
1880 CLOSE #1
1890 CLS "BCC":GOTO 390
1900 ! DEMONSTRATION
1910 CLS
1920 LOCATE (5,7):PRINT "L'EXELVISION VOUS PRESENTE :"
1930 CALL COLOR("0bHLF")
1940 LOCATE (9,19):PRINT "LLEE"
1950 LOCATE (10,19):PRINT "LLEE"
1960 LOCATE (12,3):PRINT "CCAARRNNAAVVAALL  DDEE  VVEENNIISSEE"
1970 LOCATE (13,3):PRINT "CCAARRNNAAVVAALL  DDEE  VVEENNIISSEE"
1980 CALL COLOR("0RC")
1990 LOCATE (22,9):PRINT "APPUYER SUR UNE TOUCHE"
2000 A$=KEY$:CLS "BWW"
2010 GOSUB 2360
2020 X=23:Y1=0:B=1:J=1:VI=2
2030 RESTORE 2120
2040 CALL COLOR("0BW")
2050 LOCATE (17,2):PRINT "UN INSTANT S'IL VOUS PLAIT.."
2060 FOR A=1 TO 64:READ Z$(A):NEXT A
2070 FOR A=1 TO 64:A$=Z$(A):GOTO 1080
2080 NEXT A:CLS:GOTO 1550
2090 !
2100 ! DATAS MELODIE :NOTE/DUREE
2110 !
2120 DATA DON3,REB3,DON3,SIBb,LAN,SINb,SOB.,SOC,LAC,SIBb,SIN,REB3,DON3,LAR,S
2130 DATA DON3,FAB3,DON3,DON3,SINb,LAN,SINb,SOB.,SOC,LAC,SIBb,SIN,REB3,DON3,FAR
2140 DATA S,DON3,DON3,SINb,LAN,LAN,SON,FAN,FAN,MIB.,SOC,LAC,SIBb,SIN,REB3,DON3
2150 DATA LAR,S,DON3,DON3,SINb,LAN,LAN,SON,FAN,FAN,MIB.,SOC,LAC,SIBb,SIN,REB3
2160 DATA DON3,FAR
2170 !
2180 ! CHARGEMENT D'UN MORCEAU
2190 !
2200 X=23:Y1=0:B=2:VI=1
2210 CLS "BWW":CALL COLOR("0BW")
2220 LOCATE (2,2):PRINT "CHARGEMENT:"
2230 OPEN #1,"1.MUSI",INPUT,VARIABLE 500
2240 INPUT #1,J,
2250 J1=J
2260 FOR I=1 TO J-1
2270 INPUT #1,Z$(I),
2280 NEXT I
2290 CLOSE #1
2300 GOSUB 2360
2310 LOCATE (2,2):PRINT "UN MOMENT S'IL VOUS PLAIT"
2320 J=1
2330 FOR A=1 TO J1-1
2340 A$=Z$(A):GOTO 1080
2350 NEXT A:CLS:GOTO 1550
2360 !
2370 ! DESSIN PORTEE
2380 !
2390 CALL HRON("W",1,14)
2400 FOR I=1 TO 7 STEP 2
2410 FOR J=1 TO 5
2420 CALL LINE("G",0,J*4+I*17-11,319,J*4+I*17-11)
2430 NEXT J:NEXT I
2440 !
2450 ! DESSIN CLEFS DE SOL
2460 !
2470 DATA 000011,0000101,0000101,00001001,00001001,00001001,0000101,0000101
2480 DATA 0000101,000011,00001,00001,00011,00101,01001,1001111,10101001
2490 DATA 10101001,101010001,100010001,010010001,01001001,0011111,00001,00001
2500 DATA 0001,01101,01101,01001,00101,0001
2510 FOR I=1 TO 4
2520 RESTORE 2470
2530 FOR I1=1 TO 31
2540 READ A$
2550 FOR K=1 TO LEN(A$)
2560 IF SEG$(A$,K,1)="1" THEN CALL PLOT("B",K+3,I*34+I1-31)
2570 NEXT K:NEXT I1:NEXT I
2580 RETURN
2590 !
2600 ! DESSIN DES NOTES/SILENCES
2610 !
2620 RESTORE 3040
2630 IF SI$(J)="1" THEN GOSUB 3050:GOTO 3020
2640 FOR I=1 TO 7
2650 READ NO$,H
2660 IF N$=NO$ THEN Y=H+Y1:GOTO 2680
2670 NEXT I
2680 FOR I1=4 TO LEN(A$)
2690 B$=SEG$(A$,I1,1)
2700 IF B$="1" THEN Y=Y+14
2710 IF B$="3" THEN Y=Y-14
2720 NEXT I1
2730 FOR I1=4 TO LEN(A$)
2740 B$=SEG$(A$,I1,1)
2750 IF B$="." THEN CALL LINE(CO$,X+7,Y+3,X+8,Y+3)
2760 IF B$="#" THEN GOSUB 3140
2770 IF B$="b" THEN GOSUB 3220
2780 NEXT I1
2790 IF D$="R" THEN 2820:CALL LINE(CO$,X+7,Y+4,X+8,Y+4)
2800 IF Y>Y1+16 THEN CALL LINE(CO$,X+4,Y-9,X+4,Y):GOTO 2820
2810 CALL LINE(CO$,X,Y+1,X,Y+13)
2820 IF Y>Y1+27 THEN CALL LINE(CP$,X-3,Y1+30,X+6,Y1+30)
2830 IF Y<Y1+6 THEN CALL LINE(CP$,X-3,Y1+6,X+6,Y1+6)
2840 !
2850 ! DESSIN DE LA NOTE
2860 !
2870 CALL LINE(CO$,X+1,Y,X+3,Y)
2880 CALL LINE(CO$,X,Y+1,X,Y+3)
2890 CALL LINE(CO$,X+4,Y+1,X+4,Y+3)
2900 CALL LINE(CO$,X+1,Y+4,X+3,Y+4)
2910 IF D$="R"OR D$="B" THEN 3020
2920 FOR I1=1 TO 3
2930 CALL LINE(CO$,X+1,Y+I1,X+3,Y+I1)
2940 NEXT I1
2950 IF D$="N" THEN 3020
2960 IF Y<Y1+17 THEN GOTO 3000
2970 CALL LINE(CO$,X+4,Y-9,X+8,Y-7)
2980 IF D$="D" THEN CALL LINE(CO$,X+4,Y-7,X+8,Y-5)
2990 GOTO 3020
3000 CALL LINE(CO$,X,Y+13,X+4,Y+11)
3010 IF D$="D" THEN CALL LINE(CO$,X,Y+11,X+4,Y+9)
3020 X=X+18:IF X>312 THEN X=23:Y1=Y1+34
3030 RETURN
3040 DATA DO,28,RE,26,MI,24,FA,22,SO,20,LA,18,SI,16
3050 !
3060 ! DESSIN SILENCE
3070 !
3080 CALL LINE(CO$,X,Y1+15,X+7,Y1+15)
3090 IF DU(J)=.6 THEN 3120
3100 CALL LINE(CO$,X+7,15+Y1,X+2,21+Y1)
3110 RETURN
3120 CALL LINE(CO$,X,15+Y1,X+5,21+Y1)
3130 RETURN
3140 !
3150 ! DESSIN DIESE
3160 !
3170 CALL LINE(CO$,X-7,Y,X-3,Y)
3180 CALL LINE(CO$,X-7,Y+4,X-3,Y+4)
3190 CALL LINE(CO$,X-6,Y-1,X-6,Y+5)
3200 CALL LINE(CO$,X-4,Y-1,X-4,Y+5)
3210 RETURN
3220 !
3230 ! DESSIN BEMOL
3240 !
3250 CALL LINE(CO$,X-7,Y-3,X-7,Y+3)
3260 CALL LINE(CO$,X-7,Y+1,X-5,Y+1)
3270 CALL LINE(CO$,X-7,Y+3,X-5,Y+3)
3280 CALL PLOT(CO$,X-4,Y+2)
3290 RETURN

 

 

Ce listing est uniquement proposé pour un usage privé.
Sans accord écrit préalable, vous n'êtes pas autorisé à le distribuer, le transmettre ou le rediffuser.