150 'INITIALISATION
160 ' 170 ON ERROR GOTO 3410 180 DEFINT b-z:DEFREAL y:DEG 190 DIM l(255),c(255),n(255),noi(255) 200 DIM ev(15),et(15) 210 DIM nt(15,5),ht(15,5),lt(15,5) 220 DIM nv(15,5),hv(15,5),lv(15,5) 230 s=0:hs=0:ls=1:hso=0:lso=0:ns=1:z=0 240 nv(1,1)=3:nt(1,1)=3:hv(1,1)=1:ht(1,1)=1:lv(1,1)=1:lt(1,1)=1 250 nv(1,2)=1:nt(1,2)=1:hv(1,2)=0:ht(1,2)=0:lv(1,2)=20:lt(1,2)=20 260 nv(1,3)=3:nt(1,3)=3:hv(1,3)=-1:ht(1,3)=-1:lv(1,3)=1:lt(1,3)=1:nev=1 270 y=125000/440:q=1:du=0:vo=7:ev(1)=-1 280 ven=1:ten=1:et(1)=-1:note=-1:nois=0 290 a$="##":c$=",###":n$=CHR$(237) 300 ev$="ENV":et$="ENT":vo$="VOLUME" 310 tn$="TON":b$=CHR$(7)+CHR$(7) 320 ouex$=CHR$(23)+CHR$(1) 330 norm$=CHR$(23)+CHR$(0) 340 tran$=CHR$(22)+CHR$(1) 350 opak$=CHR$(22)+CHR$(0) 360 trex$=tran$+ouex$ 370 SYMBOL 244,126,255,231,231,255,255,231,231 380 SYMBOL 245,231,231,255,255,231,231,231,231 390 SYMBOL 246,127,255,224,254,127,7,255,254 400 SYMBOL 247,126,255,231,231,231,231,255,126 410 SYMBOL 248,227,243,251,239,239,231,231,231 420 ENV 1,3,1,1,1,0,20,3,-1,1 430 ENT 1,3,1,1,1,0,20,3,-1,1 440 KEY 139,"mode 2:speed key 20,2:ink 0,0:ink 1,13:pen 1:paper 0:? opak$norm$:list"+CHR$(13) 450 KEY DEF 18,1,13:KEY DEF 68,1,9 460 ' 470 'PRESENTATION 480 ' 490 MODE 1:INK 1,15,9:INK 2,14,24:INK 3,6,16:INK 0,0:BORDER 0:SPEED INK 6,6 500 p=1 510 FOR i=0 TO 640 STEP 15:MOVE 320,320 520 DRAW i,50-30*COS(i/1.8),p:p=p+1:IF p>3 THEN p=1 530 NEXT:p=0 540 FOR i=244 TO 248:LOCATE 1,1:PEN 1 550 PRINT opak$CHR$(i)tran$:p=p+1:IF p=4 THEN p=1 560 PEN p:k=0 570 FOR a=49152 TO 63488 STEP 2048 580 p$=LEFT$(BIN$(PEEK(a),8),4)+LEFT$(BIN$(PEEK(a+1),8),4) 590 LOCATE 1+8*(i-244),2+k:k=k+1 600 FOR j=1 TO 8 610 IF MID$(p$,j,1)="1" THEN PRINT CHR$(i); ELSE PRINT " "; 620 NEXT j:PRINT:NEXT a,i 630 LOCATE 13,24:PRINT "Par : Serge CECI" 640 LOCATE 13,25:PRINT "----------------"CHR$(30)opak$" " 650 p$="86553865513531338655386551353131" 660 d$="21211112121212132121111212121213" 670 pb$="0106010601060106010601060106010" 680 DEF FNn(n)=y/(2^(1-(10-n)/12)) 690 FOR i=1 TO LEN(p$) 700 n=VAL(MID$(p$,i,1)):d=-VAL(MID$(d$,i,1)):pb=VAL(MID$(pb$,i,1)) 710 SOUND 1,FNn(n),d,vo,1,1 720 SOUND 2,FNn(n+2),d,vo-1,1,1,pb 730 SOUND 4,FNn(n+7),d,vo-2,1,1 740 NEXT:OUT &BC00,13:FOR i=1 TO 40 750 OUT &BD00,i:FOR j=1 TO 100 760 NEXT j,i 770 ' 780 'MODULE CLAVIER MUSICAL 790 ' 800 GOSUB 1140 810 GOSUB 900 820 sk=ABS(du):IF du<>0 THEN 850 830 FOR i=1 TO 5 840 sk=sk+lv(ven,i):NEXT 850 sk=INT(sk/3):IF sk<4 THEN sk=4 860 IF sk>60 THEN sk=60 870 SPEED KEY sk,sk/4 880 GOSUB 1530 890 GOTO 980 900 RESTORE 910 FOR o=q TO q+1:FOR n=1 TO 12 920 READ t:n(t)=y/2^(o-(10-n)/12) 930 NEXT n,o:RETURN 940 DATA 9,49,81,50,87,69,52,82 950 DATA 53,84,54,89,85,56,73,57 960 DATA 79,80,45,64,94,91,16,13 970 '.......saisie......... 980 PRINTtrex$:TAG 990 t$=INKEY$:IF t$="" THEN 990 1000 t=ASC(UPPER$(t$)) 1010 IF t=242 OR t=243 THEN 1110 1020 vo=vo+(t=241 AND vo>0)-(t=240 AND vo<15) 1030 IF t=92 OR t=47 THEN 1570 1040 IF n(t)=0 THEN 990 1050 pern=-note*n(t):perb=-nois*noi(t) 1060 MOVE c(t),l(t):PRINTn$; 1070 IF SQ(1)<128 THEN SOUND 1,pern,du,vo,ven,ten,perb:GOTO 1100 1080 IF SQ(2)<128 THEN SOUND 2,pern,du,vo,ven,ten,perb:GOTO 1100 1090 IF SQ(4)<128 THEN SOUND 4,pern,du,vo,ven,ten,perb ELSE 1070 1100 MOVE c(t),l(t):PRINTn$;:GOTO 990 1110 q=q+(t=242 AND q>-3)-(t=243 AND q<4) 1120 GOSUB 900:GOTO 990 1130 '....dessin clavier.... 1140 MODE 1:INK 1,26:INK 2,14:INK 3,7,14:INK 0,1:SPEED INK 60,6:BORDER 4 1150 PEN 3:LOCATE 2,2:PRINT CHR$(228);:LOCATE 39,2:PRINT CHR$(228);:LOCATE 2,24:PRINT CHR$(228);:LOCATE 39,24:PRINT CHR$(228); 1160 FOR i=1 TO 15:MOVE 146,340+8*i:DRAWR 350,0,1:NEXT 1170 DRAWR 0,-30:MOVER -2,0:DRAWR 0,30:MOVER -4,0:DRAWR 0,-30:MOVE 146,348:DRAWR 0,30 1180 PEN 3:PRINT tran$:FOR i=16 TO 24 STEP 4 1190 LOCATE i,3:PRINT CHR$(244+(i-16)/2):NEXT 1200 FOR i=18 TO 22 STEP 4 1210 LOCATE i,2:PRINT CHR$(244+(i-16)/2):NEXT 1220 PEN 1:LOCATE 11,3:PRINT CHR$(236):LOCATE 12,2:PRINT n$:LOCATE 27,2:PRINT CHR$(236):LOCATE 28,3:PRINT n$opak$ 1230 WINDOW #0,10,31,5,12:PAPER 2:PEN 1 1240 MOVE 0,0:DRAW 639,0,1:DRAWR 0,399:DRAWR -640,0:DRAWR 0,-399 1250 ORIGIN 96,80 1260 FOR i=0 TO 110 STEP 2 1270 DRAWR 448,0,1:MOVER -448,2:NEXT 1280 FOR j=0 TO 224 STEP 224:FOR i=32 TO 64 STEP 32 1290 MOVE i-8+j,48 1300 FOR h=48 TO 110 STEP 2 1310 DRAWR 16,0,0:MOVER -16,2 1320 NEXT h,i,j 1330 FOR j=0 TO 224 STEP 224:FOR i=128 TO 192 STEP 32 1340 MOVE i-8+j,48 1350 FOR h=48 TO 110 STEP 2 1360 DRAWR 16,0,0:MOVER -16,2 1370 NEXT h,i,j 1380 MOVE 0,0:FOR i=1 TO 15 1390 DRAWR 0,110,0:MOVER 0,-110:DRAWR 32,0:NEXT 1400 MOVE 0,0:DRAWR 447,0,3:DRAWR 0,110:DRAWR -448,0:DRAWR 0,-112:DRAWR 449,0,2:DRAWR 0,114:DRAWR -450,0:DRAWR 0,-114 1410 MOVE 46,126:DRAWR 354,0,1:DRAWR 0,130:DRAWR -354,0:DRAWR 0,-130 1420 '...COORDONNEES DE LA NOTE JOUEE.. 1430 RESTORE 1440 FOR i=1 TO 24:READ c(i):NEXT 1450 FOR i=1 TO 24:j=c(i):READ c(j),l(j) 1460 NEXT:c(53)=152:l(53)=70:RETURN 1470 DATA 8,20,24,70,40,20,56,70,72,20 1480 DATA 104,20,120,70,136,20,152,70 1490 DATA 168,20,184,70,200,20,232,20 1500 DATA 248,70,264,20,280,70,296,20 1510 DATA 328,20,344,70,360,20,376,70 1520 DATA 392,20,408,70,424,20 1530 CLS:PEN 1:LOCATE 5,2:PRINT CHR$(242)" "CHR$(243);:PEN 0:PRINT " =Octave "CHR$(171) 1540 LOCATE 5,4:PEN 1:PRINT CHR$(240)" "CHR$(241);:PEN 0:PRINT " =Volume "CHR$(171) 1550 PEN 1:LOCATE 5,6:PRINT "/ ç";:PEN 0:PRINT " =Options":RETURN 1560 '......OPTION......... 1570 TAGOFF:CLS:SPEED KEY 20,5 1580 PRINT opak$norm$ 1590 FOR i=2 TO 7:LOCATE 1,i:PEN 0 1600 PRINT "<";:PEN 1:PRINT USING "#";i-1; 1610 PEN 0:PRINT ">";:NEXT 1620 LOCATE 5,2:PRINT "Duree Fixe (ENV=0)" 1630 LOCATE 5,3:PRINT "Definition ENV-ENT" 1640 LOCATE 5,4:PRINT "Choix ENT definie" 1650 LOCATE 5,5:PRINT "Choix ENV definie" 1660 LOCATE 5,6:PRINT "Ajout de Bruit" 1670 LOCATE 5,7:PRINT "Retour Clavier" 1680 t$=INKEY$:IF t$="" THEN 1680 1690 t=VAL(t$) 1700 ON t GOTO 1730,1870,2850,3080,3120,820 1710 GOTO 1680 1720 ' 1730 ' CHOIX DUREE (ENV=0) 1740 ' 1750 CLS:LOCATE 1,2:PEN 3:PRINT "Nouvelle duree :":PRINT "-32000 a 32000 sec/100" 1760 PEN 0:PRINT " d<0 : d fois ENV" 1770 PRINT " d=0 : ENV connectee" 1780 PRINT " d>0 : ENV supprimee":PRINT 1790 INPUT " ";du:IF du<-32000 OR du>32000 THEN 1750 1800 CLS:PEN 1:LOCATE 2,4:IF du=0 THEN PRINT "ENV No"nev"selectionnee":ven=nev 1810 IF du<0 THEN PRINT " A chaque note":PRINT " "ABS(du)"ENV No"nev:ven=nev 1820 IF du>0 THEN PRINT " ENV deconnectee":nev=ven:ven=0 1830 CALL &BB06:GOTO 820 1840 ' 1850 ' MODULE ENVELOPPES 1860 ' 1870 '......DESSIN QUADRILLAGE..... 1880 z=0:s=0 1890 MODE 1:INK 2,12:INK 3,16:INK 1,26:INK 0,0:BORDER 0:PAPER 0:GOTO 2070 1900 MODE 1:INK 2,12:INK 3,16:INK 1,26:INK 0,0:BORDER 0:PAPER 0 1910 ORIGIN 0,80,0,640,400,80 1920 WINDOW #0,1,40,21,25 1930 FOR i=20 TO 320 STEP 6 1940 MOVE 40,i:DRAW 640,i,2:NEXT 1950 FOR i=40 TO 640 STEP 6 1960 MOVE i,20:DRAW i,400,2:NEXT 1970 MOVE 40,20:DRAWR 599,0,3:DRAWR 0,299:DRAWR -600,0:DRAWR 0,-300 1980 FOR i=50 TO 320 STEP 60 1990 MOVE 40,i:DRAW 640,i,3:NEXT 2000 FOR i=40 TO 640 STEP 60 2010 MOVE i,20:DRAW i,400,3:NEXT 2020 TAG:j=56:FOR i=-20 TO 20 STEP 10 2030 MOVE 0,j:PRINT USING a$;ABS(i);:j=j+60:NEXT 2040 j=0:FOR i=12 TO 600 STEP 60 2050 MOVE i,15:PRINT j;:j=j+10:NEXT:TAGOFF:RETURN 2060 '......MENU DES ENVELOPPES... 2070 CLS:PEN 1:PRINT:PRINT "Voulez-vous definir une Enveloppe de :" 2080 PRINT TAB(15)"<";:PEN 3:PRINT "T";:PEN 1:PRINT ">on" 2090 PRINT TAB(15)"<";:PEN 3:PRINT "V";:PEN 1:PRINT ">olume" 2100 PRINT "ou Revenir au <";:PEN 3:PRINT "C";:PEN 1:PRINT ">lavier......?" 2110 t$=INKEY$:IF t$="" THEN 2110 2120 t=ASC(UPPER$(t$)) 2130 IF t=67 THEN 800 2140 IF t=84 THEN e$=et$:ee$=tn$ 2150 IF t=86 THEN e$=ev$:ee$=vo$ 2160 IF t<>84 AND t<>86 THEN 2110 2170 PEN 3:PRINT:PRINT "No de l'Enveloppe de "ee$" (1-15) ";:INPUT n:IF n<1 OR n>15 THEN CLS:GOTO 2170 2180 IF (e$=ev$ AND ev(n))OR(e$=et$ AND et(n)) THEN 2200 2190 GOSUB 1900:GOTO 2260 2200 PRINT b$:PEN 1:PRINT "ENVELOPPE DEJA DEFINIE !!!":PRINT:PEN 3:PRINT "Confirmez-vous la redefinition "; 2210 INPUT t$:IF UPPER$(t$)<>"O" THEN 2170 2220 IF e$=ev$ THEN FOR i=1 TO 5:nv(n,i)=0:hv(n,i)=0:lv(n,i)=0:NEXT:ev(n)=0 2230 IF e$=et$ THEN FOR i=1 TO 5:nt(n,i)=0:ht(n,i)=0:lt(n,i)=0:NEXT:et(n)=0 2240 GOTO 2190 2250 '...SCRUTATION DES TOUCHES... 2260 CLS:PEN 3:LOCATE 11,3:PRINT e$;:PEN 1:PRINT n:LOCATE 22,3:PEN 3:PRINT "section":PEN 1:MOVE 40,170 2270 t$=INKEY$:IF t$="" THEN 2270 2280 LOCATE 29,3:PRINT s;:t=ASC(t$) 2290 IF s>5 OR t=92 OR t=47 THEN 2660 2300 IF t=224 THEN t=244 2310 IF t<240 OR t>244 THEN 2270 2320 ON t-239 GOTO 2350,2410,2470,2520,2580 2330 GOTO 2270 2340 '..........HAUT........... 2350 IF YPOS>307 THEN PRINT b$;:GOTO 2270 2360 IF s>5 THEN 2660 2370 te=TESTR(2,0):MOVER -2,0:DRAWR -6*ls*z,0,te:IF hs<0 THEN tn=TESTR(0,-2):MOVER 0,2 ELSE tn=1 2380 hs=hs+1:DRAWR 0,6,tn:DRAWR 6*ls,0,1 2390 z=1:GOTO 2270 2400 '..........BAS............ 2410 IF YPOS<33 THEN PRINT b$;:GOTO 2270 2420 IF s>5 THEN 2660 2430 te=TESTR(2,0):MOVER -2,0:DRAWR -6*ls*z,0,te:IF hs>0 THEN tn=TESTR(0,2):MOVER 0,-2 ELSE tn=1 2440 hs=hs-1:DRAWR 0,-6,tn:DRAWR 6*ls,0,1 2450 z=1:GOTO 2270 2460 '.........GAUCHE.......... 2470 IF XPOS<41 OR ls<1 OR z=0 THEN PRINT b$;:GOTO 2270 2480 ls=ls-1:te=TESTR(2,0):MOVER -2,0 2490 DRAWR -6,0,te 2500 GOTO 2270 2510 '.........DROITE.......... 2520 IF XPOS>632 THEN PRINT b$;:GOTO 2270 2530 IF s>5 THEN 2660 2540 ls=ls+1 2550 DRAWR 6,0,1 2560 z=1:GOTO 2270 2570 '..........COPY........... 2580 IF z=0 THEN 2270 2590 SOUND 7,50,20,12,0,0,1 2600 IF hs=hso AND ls=lso THEN ns=ns+1 ELSE s=s+1:hos=hs:lso=ls:ns=1 2610 IF s>5 THEN 2660 2620 IF e$=ev$ THEN nv(n,s)=ns:hv(n,s)=hs:lv(n,s)=ls:GOTO 2640 2630 IF e$=et$ THEN nt(n,s)=ns:ht(n,s)=hs:lt(n,s)=ls 2640 hs=0:z=0:GOTO 2270 2650 '.....ENVELOPPE DEFINIE..... 2660 CLS:PRINT b$;"Enveloppe de "ee$" : "; 2670 PRINT e$" ";:PRINT USING a$;n 2680 PEN 3:PRINT STRING$(15+LEN(ee$),"_"):PEN 1 2690 FOR j=1 TO 5:LOCATE 23+LEN(ee$),j 2700 IF e$=et$ THEN 2740 2710 PRINT USING c$;nv(n,j);:PRINT USING c$;hv(n,j);:PRINT USING c$;lv(n,j); 2720 IF lv(n,j)=0 THEN lv(n,j)=1 2730 GOTO 2760 2740 PRINT USING c$;nt(n,j);:PRINT USING c$;ht(n,j);:PRINT USING c$;lt(n,j); 2750 IF lt(n,j)=0 THEN lt(n,j)=1 2760 NEXT 2770 IF e$=ev$ THEN ev(n)=-1:ven=n:GOTO 2800 2780 et(n)=-1:ten=n 2790 ENT n,nt(n,1),ht(n,1),lt(n,1),nt(n,2),ht(n,2),lt(n,2),nt(n,3),ht(n,3),lt(n,3),nt(n,4),ht(n,4),lt(n,4),nt(n,5),ht(n,5),lt(n,5):GOTO 2810 2800 ENV n,nv(n,1),hv(n,1),lv(n,1),nv(n,2),hv(n,2),lv(n,2),nv(n,3),hv(n,3),lv(n,3),nv(n,4),hv(n,4),lv(n,4),nv(n,5),hv(n,5),lv(n,5) 2810 PEN 1:t$=INKEY$:IF t$="" THEN 2810 2820 s=0:hs=0:ls=1:hso=0:ns=1:z=0 2830 GOTO 2070 2840 ' 2850 ' CHOIX ENT 2860 ' 2870 CLS:e$=et$ 2880 PEN 3:LOCATE 2,3:PRINT e$" choisie (0 a 15)" 2890 PEN 0:LOCATE 15,5:INPUT n:PRINT CHR$(17):PEN 1 2900 IF n<0 OR n>15 THEN CLS:GOTO 2880 2910 IF n<>0 THEN 2950 2920 PRINT " "e$" supprimee :":PRINT CHR$(20) 2930 IF e$=ev$ THEN ven=0 ELSE ten=0 2940 GOTO 3030 2950 IF (e$=et$ AND et(n)<>-1) OR (e$=ev$ AND ev(n)<>-1) THEN PRINT:PRINT b$"ENVELOPPE NON DEFENIE"CHR$(30):GOTO 2880 2960 IF e$=ev$ THEN ven=n ELSE ten=n 2970 CLS:MOVE 70,140:DRAWR 0,102,0:MOVE 70,190:DRAWR 200,0:PLOT 70,190,1 2980 FOR s=1 TO 5 2990 IF e$=ev$ THEN 3010 3000 FOR ns=1 TO nt(n,s):DRAWR 0,2*ht(n,s):DRAWR 2*lt(n,s),0:NEXT ns:GOTO 3020 3010 FOR ns=1 TO nv(n,s):DRAWR 0,2*hv(n,s):DRAWR 2*lv(n,s),0:NEXT ns 3020 NEXT s:LOCATE 16,3:PRINT e$n 3030 LOCATE 17,6:PEN 3:PRINT "OK ?" 3040 t$=INKEY$:IF t$="" THEN 3040 3050 t$=UPPER$(t$):IF t$="N" THEN CLS:GOTO 2880 3060 PEN 0:GOTO 820 3070 ' 3080 ' CHOIX ENV 3090 ' 3100 CLS:e$=ev$:GOTO 2880 3110 ' 3120 ' AJOUT DE BRUIT 3130 ' 3140 CLS:FOR i=3 TO 5:PEN 0:LOCATE 4,i 3150 PRINT "<";:PEN 1:PRINT USING "#";i-2;:PEN 0:PRINT ">":NEXT 3160 LOCATE 8,3:PRINT "Note Seule" 3170 LOCATE 8,4:PRINT "Bruit Seul" 3180 LOCATE 8,5:PRINT "Note+Bruit" 3190 GOSUB 3360:PEN 1 3200 t$=INKEY$:IF t$="" THEN 3200 3210 t=VAL(UPPER$(t$)):IF t>3 THEN 3200 3220 CLS:LOCATE 2,4 3230 ON t+1 GOTO 3200,3240,3280,3320 3240 '.....note seule.......... 3250 note=-1:nois=0 3260 PRINT "Bruit deconnecte" 3270 GOTO 3350 3280 '.....bruit seul.......... 3290 note=0:nois=-1 3300 PRINT "Notes deconnectees" 3310 GOTO 3350 3320 '.....note+bruit.......... 3330 note=-1:nois=-1 3340 PRINT "Note+Bruit connectes" 3350 CALL &BB06:GOTO 820 3360 RESTORE:FOR i=24 TO 1 STEP -1 3370 READ t:noi(t)=i:NEXT:RETURN 3380 ' 3390 ' ANTI-OVERFLOW 3400 ' 3410 IF ERR<>6 OR ERL<>1790 THEN RESUME 3420 PEN 1:PRINT "DEDORDEMENT !!!"b$b$ 3430 FOR i=1 TO 600:NEXT:RESUME 1750 3440 ' FIN |