1 CLEAR ,32768!,10000:KEY OFF : COLOR 7,0  :CLS
2 PRINT "               +----------------------------------------------+"
3 PRINT "               |";:COLOR 15,0:PRINT"   C O N T R E P O I N T   A   2   V O I X ";:COLOR 7,0:PRINT"   |"
4 PRINT "               |----------------------------------------------|"
5 PRINT "               |   Version 25/06/86    |  J.Bujold/M.Baron    |"
6 PRINT "               +----------------------------------------------+"
7 PRINT:GOSUB 30000:CLS
10 DEFINT A-Y: DIM NOTE$(7),ACC(4)
20 RANDOMIZE q
30 DATA do,ré,mi,fa,sol,la,si,0,2,4,5
35 DATA do-,sol-,la-,fa-,sol-,mi-,fa-,ré-,do-
40 FOR I = 1 TO 7:READ NOTE$(I):NEXT I
42 FOR I = 1 TO 4:READ ACC(I):NEXT I
44 ' FOR I = 1 TO 9:READ CF$(I):NEXT I :M=6:ss=1:REM ------ Enlever REM pour tests
46 ' N=9:R=1:GOTO 170                  :REM ------ Enlever REM pour tests
47 PRINT "               +----------------------------------------------+"
48 PRINT "               | ";:COLOR 15,0:PRINT"Introduction des données et du cantus firmus";:COLOR 7,0:PRINT" |"
49 PRINT "               +----------------------------------------------+":PRINT
50 INPUT "Combien de mesures dans le cantus firmus ";N
51 IF N>15 THEN PRINT "Une quinzaine de mesures serait un maximum raisonnable, bourreau d'élèves !":PRINT:PRINT"Soyez plus réaliste cette fois...":GOTO 50
52 IF N<6 THEN PRINT"Pas de temps à perdre. Faites-le vous-même ou donnez en un plus long !":PRINT:PRINT"Pas de blagues, cette fois..." :GOTO 50
60 DIM CF(N),CF$(N)
80 DIM CH(N):PRINT
85 INPUT"Intervalle mélodique maximum (3=3ce, 4=4te, 5=5te, 6=6xte) ";M : M=M-1:IF M=-1 THEN M=4
86 INPUT"L'avant-dernière mesure doit contenir la sensible ";QQ$:IF LEFT$(QQ$,1)="" OR LEFT$(QQ$,1)="O" OR LEFT$(QQ$,1)="o" THEN SS=1 ELSE SS = 0
90 PRINT: COLOR 31,0:PRINT "Donnez les notes du cantus firmus.":COLOR 7,0
120 PRINT
130 I=1:PRINT "Note de la";I;"ère mesure du C. F. ";:INPUT A$:CF$(I)=A$+"-"
140 FOR I = 2 TO N
150 PRINT "Note de la";I;"ème mesure du C. F. ";:INPUT A$:CF$(I)=A$+"-"
151 IF I=N-1 AND SS=1 AND A$<>"ré" AND A$<>"mi" AND A$<>"sol" THEN COLOR 31,0:PRINT "Vous ne pouvez exiger la sensible avec cette basse!":COLOR 7,0:GOTO 150
160 NEXT I
165 PRINT:PRINT "------------------------------------------------------------------------------"
170 FOR I = 1 TO N : REM ------- Début du contrepoint.
180 X = INSTR(CF$(I),"+")
190 IF X <> 0 THEN X = 7: GOTO 220
200 X = INSTR(CF$(I),"-")
210 IF X <> 0 THEN X = -7
220 IF X <> 0 THEN CF$(I) = LEFT$(CF$(I),LEN(CF$(I))-1)
230 FOR J = 1 TO 7
240 IF CF$(I)=NOTE$(J) THEN CF(I)=J:GOTO 260
250 NEXT J
260 IF J <> 8 THEN 310
270 CLS:COLOR 0,7 :PRINT " CORRECTION :":PRINT:COLOR 7,0:IF I = 1 THEN 280 ELSE 290
280 PRINT "La note de la ";:COLOR 31,0:PRINT"1";:COLOR 7,0:PRINT " ère mesure est erronée.":GOTO 300
290 PRINT "La note de la";:COLOR 31,0:PRINT I;:COLOR 7,0:PRINT "ème mesure est erronée.":COLOR 7,0
300 PRINT: INPUT "La note S. V. P. "; CF$(I):CLS: GOTO 170
310 NEXT I
315 COLOR 15,0:PRINT"FAUTES RENCONTREES ET EVITEES:":COLOR 7,0
320 FOR I = 1 TO N
330 IF I = 1 THEN GOSUB 1000:GOTO 360
340 IF I = N THEN GOSUB 1100:GOTO 360
350 C=0 :GOSUB 1200  : REM ----- Compteur d'essais à zéro avant chaque mesure.
360 NEXT I
370 PRINT
380 NB=NB+1:PRINT"Exercice n°";NB:REM --- N° réussi et num. des mesures.
382 COLOR 15,0:PRINT"Mes.";:COLOR 7,0:FOR I = 1 TO N:PRINT TAB(5*I) I;:NEXT I:PRINT:PRINT "--";:PRINT STRING$(N*5,"-")
390 REM -------------  Affichage numérique en hauteurs absolues.
400 ' FOR I = 1 TO N:PRINT TAB(5*I) CH(I);:NEXT I:PRINT
410 ' FOR I = 1 TO N:PRINT TAB(5*I) CF(I);:NEXT I:PRINT:PRINT
415 REM -------------  Affichage des noms de notes.
420 COLOR 15,0:PRINT"CP";:FOR I = 1 TO N:J = CH(I):GOSUB 20009:PRINT TAB(5*I) A$+" ";:GOSUB 40000:NEXT I:PRINT
430 COLOR 15,0:PRINT"CF";:COLOR 7,0:FOR I = 1 TO N:J = CF(I):GOSUB 20009:PRINT TAB(5*I) A$+" ";:NEXT I:PRINT:V=CSRLIN:H=POS(0)
435 PRINT STRING$(79,"-");
440 LOCATE 25,1:COLOR 0,7:PRINT"  ";:COLOR 16,7:PRINT"R";:COLOR 0,7:PRINT" rejouer,   ";:COLOR 16,7:PRINT"I";:COLOR 0,7:PRINT" imprimer,    ";:COLOR 16,7:PRINT CHR$(17);"-+";:COLOR 0,7:PRINT" continuer,    ";
442 COLOR 16,7:PRINT"D";:COLOR 0,7:PRINT" données différentes,   ";:COLOR 16,7:PRINT"Q";:COLOR 0,7:PRINT" Fin.";
450 A$=INKEY$:IF A$=""THEN 450 ELSE IF A$="I"OR A$="i" THEN 470 ELSE IF (A$="d" OR A$="D") THEN RUN ELSE IF A$="R"OR A$="r"THEN GOTO 39000 ELSE IF A$="q"OR A$="Q"THEN SYSTEM ELSE LOCATE,1,1:COLOR 7,0:PRINT STRING$(79," ");:LOCATE V,H,0:PRINT:GOTO 170
470 LPRINT"    Exercice N°";NB:LPRINT"Cpt";:FOR I = 1 TO N:J = CH(I):GOSUB 20009:LPRINT TAB(5*I) A$+" ";:NEXT I:LPRINT
480 LPRINT"CF";:FOR I = 1 TO N:J = CF(I):GOSUB 20009:LPRINT TAB(5*I) A$+" ";:NEXT I:LPRINT
485 LPRINT "------------------------------------------------------------------------------"
490 GOTO 450
999 END
1000 K = INT (RND * 4)+1
1005 IF K <> 1 AND K <> 3 THEN 1000 :REM ----- Oblige à partir sur 5te ou 8ve.
1010 CH(I) =ACC(K)+8: IF INT(RND*2)=1 THEN CH(I)=CH(I)+7
1020 RETURN
1100 REM  ----- Oblige à terminer sur l'octave, par mouvement contraire.
1110 IF CH(I-1) < 8 THEN CH(I)=8 :GOSUB 1114:GOTO 1130 : REM Oblige fin ascendante.
1112 IF CH(I-1) <15 THEN CH(I)=15:GOSUB 1114 :GOTO 1130
1113 CH(I)=15:FLAG=1 : REM --- Normalement, CH(I)=22 (non prévu dans la matrice)
1114 IF ABS(CH(I)-CH(I-2))>5 OR FLAG<>0 THEN PRINT"Succession incorrecte deux dernières mesures":FLAG=0:C=49:GOTO 1205 : REM vérification 7ème en 2 sauts dans les 3 dernières mesures.
1130 RETURN
1200 K = INT (RND * 4)+1:L = INT (RND * 3)
1205 C=C+1:IF C=50 THEN COLOR 31,0:PRINT"Blocage total";:COLOR 7,0:PRINT"         mesure";I:PRINT:GOTO 170:REM --- Après 50 essais manqués on recommence tout.
1210 Z= ACC(K) + (L * 7) + CF(I):IF Z > 21 THEN 1200 ELSE CH(I)=Z
1220 IF CH(I)=CH(I-1)THEN 1200
1300 REM ----------------------------- Empêche deux 8ves ou 5tes consécutives.
1310 J= ABS(CH(I)-CF(I)):K= ABS(CH(I-1)-CF(I-1))
1315 IF J=0  AND I=N-1 THEN 1200 ELSE IF J = 7 AND I = N-1 THEN 1200 ELSE IF J =14 AND I = N-1 THEN 1316 ELSE 1320  :REM Avant-dernière mesure + dernière.
1316 PRINT"Octaves consécutives, deux dernières mesures": GOTO 1200
1320 IF (J=0 OR J = 7 OR J =14) AND (K = 0 OR K = 7 OR K = 14) THEN 1322 ELSE 1330:REM Octaves consécutives n'importe où.
1322 PRINT"Octaves consécutives, mesures";I-1;"-";I: GOTO 1200
1330 IF ( J=4 OR J=11 OR J=18) AND (K=4 OR K=11 OR K=18) THEN 1340 ELSE 1390: REM Quintes consécutives n'importe où.
1340 PRINT"Quintes consécutives, mesures";I-1;"-";I :GOTO 1200
1390 Z = ABS(CH(I)-CH(I-1)):IF Z > M THEN 1200:REM -- Interv. disj. maxi. - 1!
1392 IF CH(I) MOD 7 = 0 THEN 1394 ELSE 1395 : REM ----- Vérifie fa - si
1394 IF CH(I-1) MOD 7 = 4 THEN PRINT"Intervalle fa - si,   mesures";I-1;"-";I:GOTO 1200
1395 IF CH(I) MOD 7 = 4 THEN 1396 ELSE 1400 : REM ----- Vérifie si - fa
1396 IF CH(I-1) MOD 7 = 0 THEN PRINT"Intervalle si - fa,   mesures";I-1;"-";I:GOTO 1200
1400 Z=ABS(CH(I)-CF(I)) : REM Calcule l'intervalle harmonique.
1410 IF Z MOD 7 = 4 OR Z MOD 7 = 0 THEN 1420 ELSE 1500 : REM --- 5te ou 8ve?
1420 IF SGN(CH(I)-CH(I-1))=SGN(CF(I)-CF(I-1)) THEN 1430 ELSE 1500 : REM La 5te ou 8ve est-elle directe?
1430 IF Z MOD 7 = 4 THEN PRINT"Quinte "; ELSE PRINT "Octave ";
1432 PRINT "directe,       mesures";I-1;"-";I : GOTO 1200
1500 IF I < 3 THEN 1600 ELSE 1505
1505 IF ABS(CH(I)-CH(I-2)) > 5 THEN 1510 ELSE 1600
1510 PRINT"Succession incorrecte mesures";I-2;"-";I: GOTO 1200 : REM --- Toute 7ème en 2 sauts est évitée.
1600 IF SS=1 THEN 1610 ELSE 1700 : REM Test au cas où sensible obligatoire.
1610 IF (I = N-1 AND CH(I) MOD 7 <>0) THEN PRINT"Sensible manquée,     mesure";I:GOTO 1200  ELSE 1700
1700 IF I < 4 THEN GOTO 19999 ELSE 1710 :REM Pasde vér. des 3ces ou 6xtes cons. avant la 4ème mesure!
1710 Z=CH(I)-CF(I) : Y=CH(I-1)-CF(I-1) : X=CH(I-2)-CF(I-2):W=CH(I-3)-CF(I-3)
1720 IF Z = Y AND Z = X AND Z = W THEN 1730 ELSE 19999
1730 PRINT"4 mesures parallèles, mesures";I-3;"-";I: GOTO 1200 : REM 3ces ou 6xtes parallèles.
19999 T=0: RETURN   :REM  ---------------  Mesure OK, on passe à la suivante.
20009 F=0:IF J < 8 THEN A$=NOTE$(J)+"-":GOTO 20039 :REM ------  Affichage final.
20019 IF J > 7 AND J < 15 THEN A$=NOTE$(J-7):GOTO 20039
20029 A$=NOTE$(J-14)+"+"
20039 RETURN
30000 PRINT"Cette simulation de contrepoint fonctionne dans les conditions suivantes:"
30020 PRINT"Le C.F. est en ";:COLOR 15,0:PRINT"do majeur";:COLOR 7,0:PRINT", à la partie ";:COLOR 15,0:PRINT"inférieure";:COLOR 7,0:PRINT" et contenu dans ";:COLOR 15,0:PRINT"une";:COLOR 7,0:PRINT" octave."
30030 PRINT"Les règles actuellement respectées sont:"
30040 PRINT"       - Consonances de la première et de la dernière mesure."
30045 PRINT"       - Sensible présente dans l'avant-dernière mesure (facultatif)."
30050 PRINT"       - Quintes consécutives."
30060 PRINT"       - Octaves consécutives."
30070 PRINT"       - Quintes directes."
30080 PRINT"       - Octaves directes."
30090 PRINT"       - Maximum de 3 tierces ou 3 sixtes consécutives."
30100 PRINT"       - Intervalle de triton en un saut."
30110 PRINT"       - Intervalles de 7èmes (ou plus) en 2 sauts."
30120 PRINT"On peut déterminer l'intervalle mélodique ";:COLOR 15,0:PRINT"maximum";:COLOR 7,0:PRINT" permis, effectuer des tests"
30130 PRINT"consécutifs sur le même C.F. et ";:COLOR 15,0:PRINT"imprimer les résultats";:COLOR 7,0:PRINT" les plus intéressants."
30140 PRINT
30150 PRINT"L'imagination est simulée par le hasard; les fautes évitées et les blocages"
30160 PRINT"sont affichés pendant le travail, avant la réalisation finale."
30165 COLOR 31,0:PRINT TAB(75) CHR$(17);"-+";
30170 QQ$=INKEY$:IF QQ$=""THEN 30170
30180 COLOR 7,0:RETURN
39000 FOR I = 1 TO N: J=CH(I): GOSUB 20009:GOSUB 40000:NEXT:GOTO 440
40000 REM ---------- Routine son.
40005 PLAY "MB":PLAY "ML"
40007 IF I=N AND A$="do+" AND CH(I-1) >15 THEN PLAY "O4c":RETURN : REM CONTOURNE LE FAIT QUE LE DO 4ME OCTAVE N'est pas prévu dans la matrice._
40008 IF A$="do-" THEN PLAY "O1c"
40010 IF A$="ré-" THEN PLAY "O1d"
40020 IF A$="mi-" THEN PLAY "O1e"
40030 IF A$="fa-" THEN PLAY "O1f"
40040 IF A$="sol-" THEN PLAY "O1g"
40050 IF A$="la-" THEN PLAY "O1a"
40060 IF A$="si-" THEN PLAY "O1b"
40070 IF A$="do" THEN PLAY "O2c"
40080 IF A$="ré" THEN PLAY "O2d"
40090 IF A$="mi" THEN PLAY "O2e"
40100 IF A$="fa" THEN PLAY "O2f"
40110 IF A$="sol" THEN PLAY "O2g"
40120 IF A$="la" THEN PLAY "O2a"
40130 IF A$="si" THEN PLAY "O2b"
40140 IF A$="do+" THEN PLAY "O3c"
40150 IF A$="ré+" THEN PLAY "O3d"
40160 IF A$="mi+" THEN PLAY "O3e"
40170 IF A$="fa+" THEN PLAY "O3f"
40180 IF A$="sol+" THEN PLAY "O3g"
40190 IF A$="la+" THEN PLAY "O3a"
40200 IF A$="si+" THEN PLAY "O3b"
49000 RETURN