Note: L'EXL100 ne pouvant charger la totalité du programme en mémoire, Tarot est scindé en deux programmes «TAROT0.BAS» et «TAROT1.BAS». Le listing a été adapté pour une utilisation sur disquette. Exécutez le premier programme, la seconde partie se lancera automatiquement.
1 DIM P(130)
4 L=80:CLS "GBB"
5 LOCATE (10,4):PRINT "Hebdogiciel No 134 - TAROT":PAUSE 4
6 !DESSIN
8 !CARACTERES ATOUTS
10 CALL CHAR(1,"FF457FFAEDCF87890978")
12 CALL CHAR(2,"FF857635EFFAAACBE521")
14 CALL CHAR(3,"FF422231187AAABBCFE1")
16 CALL CHAR(4,"123FEFECACADD76342FF")
18 CALL CHAR(5,"0380905047E25F772AFF")
20 CALL CHAR(6,"02040770506040D0A0FF")
22 !COEUR
24 CALL CHAR(10,"00006CFEFE7C38101000")
26 CALL CHAR(11,"000000000000006CFEFE")
28 CALL CHAR(13,"7C381010")
30 !PIQUE
32 CALL CHAR(20,"001010387CFEFE381038")
34 CALL CHAR(21,"0000000000001010387C")
36 CALL CHAR(23,"FEFE381038")
38 !CARREAU
40 CALL CHAR(30,"081C3E7F3E1C08")
42 CALL CHAR(31,"000000000000081C3E7F")
44 CALL CHAR(33,"3E1C08")
46 !TREFLE
48 CALL CHAR(40,"10381054FE5410103800")
50 CALL CHAR(41,"000000000010381054FE")
52 CALL CHAR(43,"54101038000000000000")
54 !VALET
56 CALL CHAR(90,"0060F0F0780C1E1E3E3E")
58 CALL CHAR(91,"000000000000010101FF")
60 CALL CHAR(92,"3E3E003E7EE6868687FF")
62 CALL CHAR(93,"0000000000000030F0FF")
64 CALL CHAR(94,"FF0F0C")
66 CALL CHAR(95,"FFE16161677E7C007C7C")
68 CALL CHAR(96,"FF808080")
70 CALL CHAR(97,"7C7C7878301E0F0F06")
72 !DAME
74 CALL CHAR(110,"00003C7EFFFFDB993C7E")
76 CALL CHAR(111,"000101030203010000FF")
78 CALL CHAR(112,"FFFFFF7E7E7EFFBD3CFF")
80 CALL CHAR(113,"008080C040C0800000FF")
82 CALL CHAR(114,"FF0000010302030101")
84 CALL CHAR(115,"FF3CBDFF7E7E7EFFFFFF")
86 CALL CHAR(116,"FF000080C040C08080")
88 CALL CHAR(117,"FF3CDBDBFFFF7E18")
90 !CAVALIER
92 CALL CHAR(100,"0000000000707020727B")
94 CALL CHAR(101,"0000070F0F14140404FF")
96 CALL CHAR(102,"7777FEFCFCFE050504FF")
98 CALL CHAR(103,"C0C000000000000000FF")
100 CALL CHAR(104,"FFC00000000000000303")
102 CALL CHAR(105,"FF20A0A07F3F3F7FEEEE")
104 CALL CHAR(106,"FF20202828F0F0E0")
106 CALL CHAR(107,"DE4E040E0E")
108 !ROI
110 CALL CHAR(120,"000000000000547C7C54")
112 CALL CHAR(121,"0000081C1D090B0E0CFF")
114 CALL CHAR(122,"7C3810FFFFFEFE7C7CFF")
116 CALL CHAR(123,"1C083E0808FC7C0808FF")
118 CALL CHAR(124,"FF10103E3F11107C1038")
120 CALL CHAR(125,"FF3E3E7F7FFFFF081C3E")
122 CALL CHAR(126,"FF3070D090B83810")
124 CALL CHAR(127,"2A3E3E2A")
126 !EXCUSE
128 CALL CHAR(50,"0000000000000C0E0303")
130 CALL CHAR(51,"00000070386060E0C0E0")
132 CALL CHAR(52,"00000206010304")
134 CALL CHAR(53,"0303478E0E8CDCD83830")
136 CALL CHAR(54,"3018")
138 CALL CHAR(55,"00000000000001010303")
140 CALL CHAR(56,"30286C44C2C08080")
142 CALL CHAR(57,"03060404")
144 !TITRE
146 CALL HRON("B",8,6):GOSUB 382
148 DATA 40,80,100,120,140,176,204,236,250,290,400
150 DATA 40,80,100,120,140,180,200,240,250,290,400
152 DATA 40,80,99,121,140,150,170,180,200,210,230,240,250,290,400
154 DATA 50,70,96,105,115,124,140,150,170,180,200,210,230,240,260,280,400
156 DATA 50,70,94,103,117,126,140,176,200,210,230,240,260,280,400
158 DATA 50,70,92,128,140,150,172,182,200,210,230,240,260,280,400
160 DATA 50,70,90,100,120,130,140,150,174,184,200,210,230,240,260,280,400
162 DATA 50,70,90,100,120,130,140,150,176,186,204,236,260,280,400
164 DATA 50,70,90,100,120,130,140,150,178,188,206,234,260,280,400
166 RESTORE 148:FOR I=0 TO 130:READ P(I):NEXT
168 I,TEST=0
170 !TAROT
172 IF I=131 THEN 186
174 CALL LINE("G",P(I),L,P(I+1),L)
176 IF P(I+2)<>400 THEN 180
178 RANDOMIZE:L=L+INTRND(4):I=I+3:GOTO 172
180 IF TEST=1 THEN 182 ELSE TEST=1:GOTO 172
182 TEST=0:I=I+2:GOTO 172
186 !AFFICHAGE BOUTS
188 CALL COLOR("0BW"):LOCATE (14,10):PRINT "1 "
190 LOCATE (14,30):PRINT "21 "
192 CALL COLOR("1BW"):LOCATE (15,10):PRINT CHR$(1);CHR$(2);CHR$(3)
194 LOCATE (15,30):PRINT CHR$(1);CHR$(2);CHR$(3)
196 LOCATE (16,10):PRINT CHR$(4);CHR$(5);CHR$(6)
198 LOCATE (16,30):PRINT CHR$(4);CHR$(5);CHR$(6)
200 CALL COLOR("0BW"):LOCATE (17,10):PRINT " 1"
202 LOCATE (17,30):PRINT " 21"
204 CALL COLOR("0MW"):LOCATE (4,19):PRINT CHR$(42)
206 CALL COLOR("1MW"):LOCATE (4,20):PRINT CHR$(50);CHR$(51)
208 LOCATE (5,19):PRINT CHR$(52);CHR$(53);CHR$(54)
210 LOCATE (6,19):PRINT CHR$(55);CHR$(56)&" "
212 LOCATE (7,19):PRINT CHR$(57)
214 CALL COLOR("0MW"):LOCATE (7,20):PRINT " "&CHR$(42)
216 CALL COLOR("0YB"):LOCATE (20,1):PRINT "Voulez-vous les regles ? 1=OUI 0=NON"
218 R=VAL(KEY$)
220 CLS:CALL HROFF
222 IF R=0 THEN 248
230 RESTORE 524:FOR I=0 TO 15:GOSUB 250:NEXT
232 X$=KEY$:IF X$="" THEN 232
240 CLS:RESTORE 550:FOR I=0 TO 16:GOSUB 250:NEXT
242 CALL COLOR("0RHLF")
244 LOCATE (18,6):PRINT "BBOONNNNEE CCHHAANNCCEE !!!!"
245 LOCATE (19,6):PRINT "BBOONNNNEE CCHHAANNCCEE !!!!"
246 CALL COLOR("0YB"):PRINT "PATIENCE ...":CALL DOS("LOADRUN A:TAROT1.BAS")
247 X$=KEY$:IF X$="" THEN 247
248 CLS:PRINT "PATIENCE ...":CALL DOS("LOADRUN A:TAROT1.BAS")
249 !AFFICHAGE
250 READ A$:L=0:N=LEN(A$)
252 IF A$="Tapez une touche pour sortir" THEN L=3
254 FOR Y=1 TO N
256 LOCATE (2+I+L,((40-N)/2)+Y)
258 PRINT SEG$(A$,Y,1)
260 NEXT
261 RETURN
382 !BONJOUR
414 PAUSE 1:RETURN
524 DATA "Les regles utilisees sont celles"
526 DATA "de la Federation Francaise de Tarot"
528 DATA "........"
530 DATA "La donne est reglementaire,ainsi"
532 DATA "que les prises (petite,garde,sans "
533 DATA "et contre le chien)"
534 DATA "L'EXL 100 gere les jeux de Est,Nord"
536 DATA "et Ouest independamment les uns"
538 DATA "des autres."
539 DATA "Il gere le decompte des points."
540 DATA "A vous de gagner ( !! ) avec le "
542 DATA "jeu de Sud.Le choix d'une carte se"
543 DATA "fait avec le manche (ou fleches),"
544 DATA "la validation du choix par TIR "
545 DATA "(ou espace)."
548 DATA "Tapez une touche pour sortir"
550 DATA "La manette orange suffit pour jouer."
552 DATA "Aucune frappe sur ENTER n'est demandee."
554 DATA "........"
556 DATA "Les dernieres lignes sont reservees"
558 DATA "aux messages."
560 DATA "Lors du choix d'une carte,si le curseur"
562 DATA "sort d'un cote il reapparait de l'autre."
564 DATA "Si vous avez une poignee a montrer,"
566 DATA "il faut taper successivement les atouts"
568 DATA "EX: 15 tapez 1 puis 5 puis # pour"
570 DATA "valider,puis un autre atout."
572 DATA "A la fin apres le dernier #,tapez *"
574 DATA "Si vous montrez l'excuse 10EME,vous"
576 DATA "entrez 22."
578 DATA "Pour tous les autres cas il suffit de "
580 DATA "suivre les messages."
582 DATA "Tapez une touche pour sortir"
10 CALL POKE(50688,162,5,45,162,136,45,10)
11 CALL EXEC(50688)
90 CLS "Wbb"
100 ! INITIALISATION
110 DIM P(78),J(3,5,20),CHIEN(5)
120 DIM C$(3,5),RE(3),N(5),E(5),G(4),K(3,4)
125 DIM ECRAN(1,8)
130 EC,DO=0
140 DIM POINT(3)
150 ! MISE EN PLACE DU TABLEAU
155 CLS:CALL COLOR("0RG")
160 FOR Y=2 TO 10:LOCATE (Y,2):PRINT RPT$(" ",11):NEXT
165 LOCATE (6,5):PRINT "O E"
170 CALL COLOR("0WR"):LOCATE (1,1):PRINT "DONNEUR:"
180 CALL COLOR("0BY"):LOCATE (1,27):PRINT "NORD : "
190 LOCATE (2,27):PRINT "OUEST: "
200 LOCATE (3,27):PRINT "VOUS : "
210 LOCATE (4,27):PRINT "EST : "
215 GOSUB 7900
300 TOUR=0
305 CALL COLOR("0Yb"):LOCATE (21,1):PRINT "Un instant SVP"
310 ! CHARGEMENT DU PAQUET
312 DATA 401,414,20,13,104,109,205,210,301,3,7,410,105
314 DATA 413,312,313,19,16,306,203,114,107,106,17,1,108
316 DATA 15,12,10,5,112,214,314,309,310,405,407,501,201
318 DATA 412,409,403,9,302,311,213,209,208,21,18,101,204
320 DATA 402,408,110,4,8,11,211,102,113,212,202,2,206
322 DATA 6,14,103,111,303,411,406,404,308,307,304,305,207
328 AT=1
330 FOR Z=0 TO 5:IF CHIEN(Z)=0 THEN 332 ELSE NEXT:GOTO 490
332 RANDOMIZE:I=INTRND(6)-1:IF CHIEN(I)=1 THEN 332 ELSE CHIEN(I)=1
334 IF I=0 THEN RESTORE 312
335 IF I=1 THEN RESTORE 314
336 IF I=2 THEN RESTORE 316
337 IF I=3 THEN RESTORE 318
338 IF I=4 THEN RESTORE 320
339 IF I=5 THEN RESTORE 322
340 FOR Y=1 TO 13:READ EC:P(AT)=EC:AT=AT+1:NEXT
345 GOTO 330
490 ! DONNE
495 GOSUB 9100
496 CALL COLOR("0Wb")
498 IF TOUR=0 THEN DO=INTRND(4)-1:GOTO 500
499 DO=DO+1:IF DO>3 THEN DO=DO-4
500 TOUR=TOUR+1:ON DO+1 GOTO 501,502,503,504
501 R$="NORD ":GOTO 505
502 R$="OUEST":GOTO 505
503 R$="SUD ":GOTO 505
504 R$="EST "
505 IF TOUR<>1 THEN 512
506 LOCATE (21,1):PRINT R$&" A TIRE LA PLUS PETITE CARTE.":PAUSE 3
512 GOSUB 9100:CALL COLOR("0BY"):LOCATE (1,9):PRINT R$
513 FOR I=0 TO 3:RE(I)=DO+1+I:NEXT
540 ! DISTRIBUTION
545 FOR I=0 TO 3:FOR Y=0 TO 5:FOR Z=0 TO 20:J(I,Y,Z)=0:NEXT:NEXT:NEXT
550 RANDOMIZE:A=0:Z=INTRND(78)
551 FOR I=0 TO 5
552 FOR W=RE(0)TO RE(3):WW=W
553 IF WW>7 THEN WW=WW-8 ELSE IF WW>3 THEN WW=WW-4
554 FOR Y=1 TO 3
555 Z=Z+1
556 IF Z>78 THEN Z=1
557 J(WW,INT(P(Z)/100),(P(Z)-INT(P(Z)/100)*100)-1)=1
558 NEXT Y:NEXT W
559 Z=Z+1
560 IF Z>78 THEN Z=1
561 IF A>5 THEN 600 ELSE CHIEN(A)=P(Z):A=A+1
562 NEXT I
600 ! ETUDE CHIEN
601 FOR Z=0 TO 5:RC(Z)=0:NEXT
602 FOR Z=0 TO 5:I=INT(CHIEN(Z)/100)
604 Y=CHIEN(Z)-100*I:IF Y=14 THEN RC(I)=1
606 NEXT
650 GOSUB 6500
670 ! REPARTITION PAR JOUEUR
672 CALL COLOR("0Yb"):FOR WW=0 TO 3
674 GOSUB 7100
677 NEXT
690 ! PETIT SEC ?
692 FOR W=0 TO 3
694 IF C$(W,0)="01"AND C$(W,5)="" THEN GOSUB 8000:GOTO 495
696 NEXT
700 ! ETUDE DE JEU
701 FOR Z=0 TO 3:E(Z)=0:G(Z)=0:NEXT
702 F=0:FOR W=RE(0)TO RE(3):WW=W
704 IF WW>3 THEN WW=WW-4
706 IF WW=2 THEN 750
708 S,L,AT,B,Q,CD,CR,RD,R,D=0
711 V$=C$(WW,0):H=LEN(V$)
712 IF H<12 THEN AT=1
713 IF H>10 AND H<18 THEN AT=2
714 IF H>16 AND H<24 THEN AT=3
716 IF H>22 THEN AT=4
717 IF LEN(V$)<9 THEN 723
718 HH$=SEG$(V$,LEN(V$)-9,2)
719 IF H>18 AND VAL(HH$)>12 THEN AT=AT+1
720 IF H>18 AND VAL(HH$)>15 THEN AT=AT+1
723 IF J(WW,0,0)=1 THEN B=B+1
724 IF J(WW,0,20)=1 THEN B=B+1
725 IF J(WW,5,0)=1 THEN B=B+1
726 FOR I=1 TO 4:TEST=0:TES2=0:V$=C$(WW,I)
727 IF V$="" THEN Q=Q+1:GOTO 737
728 IF LEN(V$)<4 THEN 734
729 IF SEG$(V$,LEN(V$)-3,4)="1314" THEN RD=RD+1:TEST=1
730 IF SEG$(V$,LEN(V$)-3,4)="1214" THEN CR=CR+1:TEST=1
731 IF SEG$(V$,LEN(V$)-3,4)="1213" THEN CD=CD+1:TES2=2
732 IF TEST<>1 AND J(WW,I,13)=1 THEN R=R+1
733 IF TES2<>1 AND J(WW,I,12)=1 THEN D=D+1
734 IF LEN(V$)=2 THEN S=S+1
736 IF LEN(V$)>13 THEN L=L+1
737 NEXT:E(WW)=(.8*RD+.6*CR+R+.6*D+.2*CD)+5*B+.3*S+.6*L+Q+5*AT
750 NEXT
800 ! QUI PREND
801 F=0:FOR W=RE(0)TO RE(3):WW=W
802 IF WW>3 THEN WW=WW-4
803 IF WW=2 THEN GOSUB 9000:GOTO 812
804 IF E(WW)<12 THEN G(WW)=0:GOTO 810
805 IF E(WW)>=12 AND E(WW)<18 THEN G(WW)=1
806 IF E(WW)>=18 AND E(WW)<26 THEN G(WW)=2
807 IF E(WW)>=26 AND E(WW)<30 THEN G(WW)=4
808 IF E(WW)>=30 THEN G(WW)=6
810 IF (WW=RE(0)OR WW=RE(0)+4)THEN IF G(WW)<>0 THEN PF=WW:F=G(WW)
811 IF WW=RE(0)OR WW=RE(0)+4 THEN 830
812 IF WW=0 THEN ZZ=4 ELSE ZZ=WW
813 IF G(WW)>G(ZZ-1)THEN PF=WW:F=G(WW):GOTO 830
814 TEST=1:G(WW)=0:GOTO 830
815 IF WW=0 THEN ZZ=4 ELSE ZZ=WW
816 G(WW)=G(ZZ-1):GOTO 850
830 GOSUB 6600
842 IF TEST=1 THEN TEST=0:GOTO 815
850 NEXT
855 IF F=0 THEN LOCATE (21,1):PRINT "ON REDONNE":PAUSE 3:GOSUB 9100:GOTO 499
860 AT=79:A=0
861 IF F<3 THEN 1000
862 FOR Z=0 TO 5:I=INT(CHIEN(Z)/100):Y=CHIEN(Z)-100*I
864 IF F=4 THEN CD=72:RD=1:GOSUB 9200
866 IF F=6 THEN CD=78:RD=7:GOSUB 9300
868 NEXT
870 GOTO 2000
1000 ! PRIS DU CHIEN
1001 TES4=0:EC=0:CD=72:RD=1:Q,R,D=0
1002 GOSUB 7950:FOR Z=0 TO 5:I=INT(CHIEN(Z)/100)
1004 Y=CHIEN(Z)-100*I
1005 IF PF<>2 THEN J(PF,I,Y-1)=1
1006 CALL AFCAR(I,Y,7,13+4*(Z+1)):NEXT
1008 IF PF=2 THEN 1100
1012 WW=PF
1016 GOSUB 7100
1020 ! ORDRE FONCTION LONG
1022 Q=0:TEST=0
1024 FOR Z=1 TO 4:N(Z)=Z:E(Z)=LEN(C$(PF,Z)):NEXT
1026 FOR I=1 TO 3
1028 IF E(I)<=E(I+1)THEN 1032
1029 TES4=E(I):E(I)=E(I+1):E(I+1)=TES4
1030 TES4=N(I):N(I)=N(I+1):N(I+1)=TES4
1031 GOTO 1026
1032 NEXT
1035 ! ECART
1036 IF E(1)=0 THEN FOR Z=1 TO 3:N(Z)=N(Z+1):E(Z)=E(Z+1):NEXT:N(4),E(4)=0
1037 IF E(4)<>0 THEN I=N(4) ELSE I=N(3)
1038 IF J(PF,I,12)=1 AND J(PF,I,13)=1 THEN Y=13:GOSUB 9200:EC=EC+1
1039 IF J(PF,I,11)=1 AND J(PF,I,13)=1 THEN Y=12:GOSUB 9200:EC=EC+1
1042 IF J(PF,N(1),13)=1 THEN R1=E(1)-2 ELSE R1=E(1)
1044 FOR Z=1 TO R1 STEP 2:I=N(1):HH$=C$(PF,I)
1045 Y=VAL(SEG$(HH$,Z,2)):GOSUB 9200:EC=EC+1
1046 IF EC=6 THEN 1070
1048 NEXT
1049 IF N(4)=0 THEN HH=2 ELSE HH=3
1051 IF J(PF,N(HH),11)=1 THEN I=N(HH):Y=12:GOSUB 9200:EC=EC+1
1053 IF EC=6 THEN 1070
1056 IF HH<>2 THEN HH=HH-1
1057 FOR Z=1 TO E(HH)STEP 2:I=N(HH):HH$=C$(PF,I)
1059 Y=VAL(SEG$(HH$,Z,2)):IF Y<14 THEN GOSUB 9200:EC=EC+1
1060 IF EC=6 THEN 1070
1061 NEXT
1062 IF EC<>6 THEN HH=HH+1:GOTO 1057
1070 ! SORTIR ECART
1072 GOSUB 8200
1090 GOTO 2000
1099 ! ECART SUD
1100 CALL COLOR("0RW"):LOCATE (21,1):PRINT "FAITES VOTRE ECART":L=6:C=17:EC=0
1102 PAUSE 3:LOCATE (L,C):PRINT CHR$(14)
1109 GOSUB 9100:LOCATE (21,2):PRINT "ENCORE ";6-EC;" CARTES":CALL KEY1(R,D)
1112 IF R=32 THEN 1200 ELSE IF R=130 THEN GOSUB 6000:L=L+5
1113 IF R=128 THEN GOSUB 6000:L=L-5
1114 IF R=129 THEN GOSUB 6000:C=C+4
1115 IF R=131 THEN GOSUB 6000:C=C-4
1118 IF C>15 AND L>16 THEN L=6
1120 IF C<15 AND L>16 THEN L=11
1124 IF C>15 AND L<6 THEN L=16
1125 IF C<15 AND L<11 THEN L=16
1128 IF L=6 AND C>37 THEN C=17
1129 IF L<>6 AND C>37 THEN C=5
1130 IF L=6 AND C<17 THEN C=37
1131 IF L<>6 AND C<5 THEN C=37
1135 GOSUB 6100
1140 GOTO 1109
1200 ! SORTIR ECART
1201 GOSUB 6000:CALL EFC(L,C)
1202 IF L<>6 THEN 1250
1203 Z=((C-13)/4)-1:IF CHIEN(Z)=0 THEN 1500
1204 I=INT(CHIEN(Z)/100):Y=CHIEN(Z)-100*I
1208 EC=EC+1:GOSUB 9200:CHIEN(Z)=0:GOTO 1500
1250 Z=(C-1)/4
1252 TES4=0:GOSUB 8500
1254 IF TEST=1 THEN 1109
1258 I=INT(CAR/100):Y=CAR-100*I:GOSUB 9200:EC=EC+1
1500 IF EC<6 THEN 1109
1502 FOR I=0 TO 5:IF CHIEN(I)=0 THEN 1510
1504 Y=INT(CHIEN(I)/100)
1506 J(PF,Y,(CHIEN(I)-100*Y)-1)=1
1510 NEXT
1515 GOSUB 8200
1520 GOSUB 9100:GOSUB 7900
1560 GOSUB 6500
2000 ! JEU
2002 WW=PF:GOSUB 6600:TOPT=0:FOR Z=0 TO 3:FOR H=0 TO 4:K(Z,H),N(H)=0
2003 E(H)=0:NEXT:NEXT:EX,D,R=0
2004 PETBOU=0:GOSUB 7925
2006 ! DEBUT
2007 FOR MEN=1 TO 18
2008 PJ=0:FOR Z=0 TO 3:G(Z)=0:NEXT
2010 FOR W=RE(0)TO RE(3):WW=W
2012 IF WW>3 THEN WW=WW-4:DEB=RE(0)
2014 IF WW=2 THEN GOSUB 3000:GOTO 2027
2016 IF WW=PF THEN GOSUB 4500:GOTO 2020
2018 GOSUB 4000
2020 IF WW=0 THEN L=2:C=7
2022 IF WW=1 THEN L=5:C=3
2024 IF WW=3 THEN L=5:C=11
2026 CALL AFCAR(I,Y,L,C)
2027 J(WW,I,Y-1)=0:GOSUB 7100
2028 G(WW)=100*I+Y:IF W=RE(0)THEN CM,CI=I:JOE=WW:HAUT=Y:GOTO 2034
2029 IF CI=CM THEN 2032
2030 IF I<>0 THEN 2034
2031 IF Y>HAUT THEN HAUT=Y:JOE=WW ELSE 2034
2032 IF (I<>CI AND I=0)THEN CM=I:HAUT=Y:JOE=WW:GOTO 2034
2033 IF I=CI THEN IF Y>HAUT THEN HAUT=Y:JOE=WW
2034 NEXT
2036 ! QUI A LA MAIN
2037 FOR Z=0 TO 3:RE(Z)=JOE+Z:NEXT
2038 ! RAMASSE PLI
2039 FOR Z=0 TO 3:IF G(Z)=1 AND MEN<>18 THEN TOPT=1:GOTO 2042
2040 IF G(Z)=1 AND MEN=18 THEN PETIT=1:PRO=JOE:GOTO 2042 ELSE PETIT=0
2041 NEXT
2042 IF EX=1 THEN 2045
2043 FOR Z=0 TO 3:IF G(Z)=501 THEN EX=1:JO2=JOE:PE=Z:GOTO 2045
2044 NEXT
2045 IF JOE<>PF THEN 2050
2046 FOR Z=0 TO 3
2047 IF G(Z)<>501 THEN I=INT(G(Z)/100):Y=G(Z)-100*I:GOSUB 9200
2048 NEXT:GOTO 2054
2050 FOR Z=0 TO 3:IF G(Z)=501 THEN 2052
2051 I=INT(G(Z)/100):Y=G(Z)-100*I:GOSUB 9300
2052 NEXT Z
2054 IF EX=1 AND MEN=18 THEN 2056 ELSE 2082
2056 IF PE<>PF THEN 2062 ELSE FOR Z=72 TO AT STEP -1:Y=P(Z)-100*(INT(P(Z)/100))
2057 IF Y<11 AND Y>1 THEN EC=P(Z):P(Z)=501:GOTO 2060
2058 NEXT Z
2060 I=INT(EC/100):Y=EC-100*I:GOSUB 9300:GOTO 2082
2062 IF JO2<>PF THEN I=5:Y=1:GOSUB 9300:GOTO 2082
2064 FOR Z=0 TO A:Y=(Z)-100*(INT(P(Z)/100))
2065 IF Y<11 AND Y>1 THEN EC=P(Z):P(Z)=501:GOTO 2068
2066 NEXT Z
2068 I=INT(EC/100):Y=EC-100*I:GOSUB 9200
2082 GOSUB 7925:NEXT:GOTO 5000
3000 ! JEU DE SUD
3002 ! POIGNEE?
3004 CALL COLOR("0Wb"):IF MEN=1 THEN 3006 ELSE 3030
3006 PO$="":LOCATE (21,1):PRINT "POIGNEE ? 10-13-15 >1=OUI 0=NON"
3008 LOCATE (21,1):R$=KEY$:GOSUB 8800
3010 GOSUB 9100:IF R$="0" THEN 3030 ELSE IF R$="1" THEN 3012
3011 GOTO 3006
3012 LOCATE (22,1):PRINT "ENTRER LES ATOUTS SEPARES PAR #.FINI *":V$="":TES2=0
3013 LOCATE (21,1):HH$=KEY$:GOSUB 8800
3014 IF HH$="#" THEN 3018
3015 IF HH$="*" THEN Z=LEN(PO$):GOTO 3026
3016 IF NUMERIC(HH$)=0 THEN 3013
3017 V$=V$&HH$:LOCATE (21,1):PRINT V$:GOTO 3013
3018 EC=VAL(V$):IF EC>22 THEN 3028
3019 IF EC=22 THEN IF J(2,5,0)=1 THEN 3022 ELSE 3028
3020 IF J(2,0,EC-1)=0 THEN 3028
3022 IF EC<10 THEN V$="0"&V$:IF EC=1 THEN E(4)=1
3023 PO$=PO$&V$:TEST=21:COMT=3*(LEN(PO$)/2):IF COMT>30 THEN COMT=COMT-30:TEST=22
3024 IF TES2=0 AND TEST=22 THEN LOCATE (22,1):PRINT " ":TES2=1
3025 LOCATE (TEST,COMT+1):PRINT V$:V$="":GOTO 3013
3026 IF (Z-20)*(Z-26)*(Z-30)=0 THEN E(WW)=(INT(Z/5)*10)-20:GOTO 3030
3028 GOSUB 9100:LOCATE (21,1):CALL COLOR("0RbF"):PRINT "ERREUR/ RECOMMENCER"
3029 PAUSE 3:GOTO 3002
3030 ! QUELLE CARTE
3032 GOSUB 9100:CALL COLOR("0Wb")
3034 LOCATE (21,1):PRINT "QUELLE CARTE JOUEZ-VOUS?":L=11:C=21:CALL COLOR("0RW")
3036 LOCATE (L,C):PRINT CHR$(14)
3038 CALL KEY1(R,D)
3039 IF R=32 THEN GOSUB 6000:GOTO 3100
3040 IF R=130 THEN GOSUB 6000:L=L+5
3042 IF R=128 THEN GOSUB 6000:L=L-5
3044 IF R=129 THEN GOSUB 6000:C=C+4
3046 IF R=131 THEN GOSUB 6000:C=C-4
3048 IF L>16 THEN L=11
3050 IF L<11 THEN L=16
3052 IF C>37 THEN C=5
3054 IF C<5 THEN C=37
3056 GOSUB 6100
3058 GOTO 3038
3100 ! SORTIR LA CARTE
3104 Z=(C-1)/4
3106 TES4=1:GOSUB 8500
3108 IF TEST=1 THEN 3030
3109 I=INT(CAR/100):Y=CAR-100*I
3110 GOSUB 9100:IF I=5 OR RE(0)=2 THEN 3134
3111 IF I<>0 OR CM<>0 THEN 3115
3112 IF Y>HAUT THEN 3134 ELSE R1=LEN(C$(2,0))-1
3113 IF VAL(SEG$(C$(2,0),R1,2))<HAUT THEN 3115 ELSE LOCATE (22,1)
3114 PRINT "VOUS DEVEZ MONTER A L'ATOUT !":PAUSE 2:GOTO 3032
3115 IF I=CI THEN 3134
3116 IF C$(2,CI)<>"" THEN LOCATE (21,1) ELSE 3130
3118 PRINT "VOUS AVEZ DE LA COULEUR DEMANDEE. (On triche ??)"
3119 PAUSE 3:GOTO 3032
3130 IF I<>0 AND C$(2,0)<>"" THEN LOCATE (21,1) ELSE 3134
3132 PRINT "VOUS AVEZ DE L'ATOUT POUR COUPER.":PAUSE 3:GOTO 3032
3134 CALL EFC(L,C)
3136 ECRAN((L-11)/5,Z-1)=0
3140 CALL AFCAR(I,Y,7,7):IF (I=0 AND I<>CI)THEN K(2,CI)=1
3150 IF PF=2 THEN PJ=1
3151 IF I=0 AND CI<>0 THEN K(2,CI)=1
3152 RETURN
4000 ! JEU EN DEFENSE
4002 ! DEBUT DU TOUR
4003 IF MEN=17 AND J(WW,5,0)=1 THEN I=5:Y=1:GOTO 4490
4004 IF MEN=1 THEN GOSUB 15000
4005 IF W<>RE(0)THEN 4200
4006 IF WW=PF-1 THEN 4008 ELSE 4007
4007 IF (PF=0 AND WW=3)THEN 4008 ELSE 4100
4008 IF E(4)=0 AND J(WW,0,20)=1 AND TOPT=0 THEN I=0:Y=21:GOTO 4490
4009 FOR Z=1 TO 4:IF N(Z)=1 OR RC(Z)=1 THEN 4024
4010 I=INTRND(4):IF RC(I)=1 THEN 4024 ELSE IF N(I)=1 THEN 4010
4012 IF C$(WW,I)="" THEN 4024
4016 V$=C$(WW,I):R1=LEN(V$)
4018 IF R1=2 THEN Y=VAL(V$):GOTO 4490
4020 IF (R1=4 AND SEG$(V$,3,2)="14")THEN 4021 ELSE 4022
4021 IF VAL(SEG$(V$,1,2))>11 THEN Y=14:N(Z)=1:GOTO 4490
4022 Y=VAL(SEG$(V$,1,2)):N(Z)=1:GOTO 4490
4024 NEXT
4026 FOR Z=1 TO 4:I=Z:IF N(Z)=1 THEN 4036
4028 IF RC(Z)=1 THEN 4036
4030 V$=C$(WW,Z):IF V$="" THEN 4036 ELSE R1=LEN(V$)
4032 IF R1<7 AND J(WW,Z,13)=1 THEN Y=14:GOTO 4490
4034 Y=VAL(SEG$(C$(WW,I),1,2)):GOTO 4490
4036 NEXT
4038 FOR I=1 TO 4
4042 IF K(PF,I)=1 THEN 4056
4044 V$=C$(WW,I):IF V$="" THEN 4056 ELSE R1=LEN(V$)
4046 Y=VAL(SEG$(V$,R1-1,2))
4047 T=Y:FOR Y=14 TO T+1 STEP -1:GOSUB 10200
4048 IF TEST=1 THEN 4049 ELSE 4034
4049 NEXT:Y=T:GOTO 4490
4056 NEXT
4100 ! FAIRE COUPER PRENEUR
4102 FOR I=1 TO 4:IF K(PF,I)=0 THEN 4110
4104 V$=C$(WW,I):IF V$="" THEN 4110 ELSE R1=LEN(V$)
4106 IF (R1=2 AND VAL(V$)>12 AND LEN(C$(WW,0))<4)THEN 4110
4108 Y=VAL(SEG$(V$,1,2)):GOTO 4490
4110 NEXT
4112 FOR I=1 TO 4
4114 IF N(I)=0 THEN 4126 ELSE V$=C$(WW,I)
4116 IF V$="" THEN 4126 ELSE R1=LEN(V$)
4118 IF J(WW,I,13)=1 THEN GOSUB 10000 ELSE 4122
4120 IF H+R1/2<10 THEN Y=14:GOTO 4490
4122 Y=14:GOSUB 10200:IF TEST=1 THEN Y=VAL(SEG$(V$,R1-1,2)):GOTO 4490
4124 GOTO 4034
4126 NEXT
4128 GOSUB 10300:IF I=0 THEN 4137
4130 Y=VAL(SEG$(C$(WW,I),1,2)):GOTO 4490
4137 V$=C$(WW,0):Y=VAL(SEG$(V$,LEN(V$)-1,2)):FOR S=21 TO Y+1:GOSUB 10200
4138 IF TEST=1 THEN 4140 ELSE Y=VAL(SEG$(V$,1,2)):GOTO 4490
4140 NEXT:GOTO 4490
4142 Y=VAL(SEG$(C$(WW,I),1,2)):GOTO 4490
4200 ! AUTRE QUE OUVREUR
4201 Z=0
4202 ON CI+1 GOTO 4210,4300,4300,4300,4300,4450
4210 I=0:IF C$(WW,I)="" THEN 4420 ELSE V$=C$(WW,I):R1=LEN(V$)
4212 FOR Z=O TO 3:IF G(Z)=1 THEN 4214 ELSE NEXT
4213 GOTO 4219
4214 IF PJ<>0 THEN 4216 ELSE 4219
4216 Y=VAL(SEG$(V$,R1-1,2)):IF Y>HAUT THEN 4490 ELSE 4219
4218 IF J(WW,5,0)=1 THEN I=5:Y=1:GOTO 4490
4219 GOSUB 7200:IF Y<>0 THEN 4490
4221 IF (PJ=1 AND JOE<>PF AND J(WW,0,0)=1)THEN Y=1:GOTO 4490
4222 IF J(WW,5,0)=1 THEN I=5:Y=1:GOTO 4490
4223 IF R1<3 THEN EC=1:GOTO 4225
4224 IF J(WW,0,0)=1 THEN EC=3 ELSE EC=1
4225 Y=VAL(SEG$(C$(WW,I),EC,2)):GOTO 4490
4300 ! AUTRE COUL QUE ATOUT
4302 IF C$(WW,CI)="" THEN 4400 ELSE V$=C$(WW,CI):R1=LEN(V$):I=CI
4304 IF PJ=0 THEN 4350
4306 IF CM<>CI THEN 4342
4308 IF JOE=PF THEN 4336
4310 Y=VAL(SEG$(V$,R1-1,2)):IF Y>HAUT THEN 4490
4334 GOTO 4034
4336 IF (V$="13"OR V$="12")AND HAUT=14 AND J(WW,5,0)=1 THEN I=5:Y=1:GOTO 4490
4337 GOSUB 7200:IF Y<>0 THEN 4490
4340 GOTO 4034
4342 IF JOE<>PF THEN 4346
4343 FOR Z=W+1 TO RE(3):S=Z:IF Z>3 THEN S=S-4
4344 IF (K(S,I)=1 AND HAUT<12)THEN Y=VAL(SEG$(V$,R1-1,2)):GOTO 4490
4345 NEXT
4346 GOTO 4034
4350 IF K(PF,I)=1 THEN 4360
4351 S=VAL(SEG$(V$,R1-1,2))
4354 FOR Y=14 TO S+1 STEP -1:GOSUB 10200
4356 IF TEST=0 THEN 4360
4358 NEXT:Y=S:GOTO 4490
4360 Y=VAL(SEG$(V$,1,2)):GOTO 4490
4400 ! COUPE
4402 V$=C$(WW,0):I=0
4404 IF V$="" THEN 4420 ELSE K(WW,CI)=1
4406 IF CM=0 THEN 4412
4408 IF PJ=0 AND J(WW,0,0)=1 THEN Y=VAL(SEG$(V$,3,2)):GOTO 4490
4409 IF PJ=1 AND J(WW,5,0)=1 AND JOE<>PF THEN Y=1:I=5:GOTO 4490
4410 GOTO 4034
4412 GOSUB 7200:IF Y<>0 THEN 4490
4416 GOTO 4034
4419 ! DEFOSSE
4420 IF J(WW,5,0)=1 THEN Y=1:I=5:GOTO 4490
4421 FOR I=1 TO 4:V$=C$(WW,I):IF K(PF,I)=1 AND V$<>"" THEN 4422 ELSE 4425
4422 R1=LEN(V$):FOR S=R1-1 TO 1 STEP -2:Y=VAL(SEG$(V$,S,2))
4423 IF PJ=1 AND JOE<>PF AND Y>10 THEN 4490
4424 IF (PJ=0 OR JOE=PF)AND Y<11 THEN 4490 ELSE NEXT
4425 NEXT
4426 FOR I=1 TO 4:V$=C$(WW,I):IF V$="" THEN 4436
4428 R1=LEN(V$):FOR S=R1-1 TO 1 STEP -2
4429 Y=VAL(SEG$(V$,S,2))
4430 IF Y>10 AND PJ=1 AND JOE<>PF THEN 4490
4431 IF Y<11 AND (PJ=0 OR JOE=PF)THEN 4490
4434 NEXT
4436 NEXT
4438 FOR I=1 TO 4:IF C$(WW,I)="" THEN 4442
4440 Y=VAL(SEG$(C$(WW,I),1,2)):GOTO 4490
4442 NEXT
4450 GOTO 4006
4490 IF CI=5 THEN CI,CM=I:JOE=WW:HAUTE=Y
4491 N(I)=1:RETURN
4500 !JEU EN ATTAQUE
4501 IF MEN=17 AND J(PF,5,0)=1 THEN I=5:Y=1:GOTO 4990
4502 IF MEN<>1 THEN 4510
4504 GOSUB 15000
4506 IF J(PF,0,0)=1 THEN CH=0:GOSUB 16000:GOTO 4510
4508 V$=C$(PF,0):R1=LEN(V$):IF R1<16 THEN 4510
4509 IF VAL(SEG$(V$,R1-7,2))>13 THEN CH=1 ELSE CH=0
4510 IF W<>RE(0)THEN 4570
4512 IF CH=0 OR TOPT=1 THEN 4538
4513 V$=C$(PF,0):R1=LEN(V$):IF J(PF,0,0)=1 AND R1>2 THEN EC=3 ELSE EC=1
4514 I=0:GOSUB 10000
4515 IF H<9 THEN Y=VAL(SEG$(V$,EC,2)):GOTO 4990
4516 BOUT=0:FOR ZZ=15 TO 21:Y=ZZ:IF J(PF,O,Y-1)=1 THEN BOUT=BOUT+1:GOTO 4520
4518 GOSUB 10200:IF TEST=1 THEN BOUT=BOUT+1
4520 NEXT
4523 IF BOUT<5 THEN Y=VAL(SEG$(V$,EC,2)):GOTO 4990
4524 IF J(PF,0,20)=1 THEN Y=21:GOTO 4990
4526 C=VAL(SEG$(V$,R1-1,2))
4528 FOR Y=21 TO C+1 STEP -1:GOSUB 10200:IF TEST=1 THEN 4532
4530 Y=VAL(SEG$(V$,EC,2)):GOTO 4990
4532 NEXT
4534 Y=C:GOTO 4990
4536 ! FAIRE COUPER
4538 FOR I=1 TO 4:IF C$(PF,I)="" THEN 4544 ELSE FOR Z=0 TO 3:IF Z=PF THEN 4542
4540 IF K(Z,I)=1 THEN Y=VAL(SEG$(C$(PF,I),1,2)):IF Y<12 THEN 4990
4542 NEXT
4544 NEXT
4546 ! FAIRE JOUER DS LA LONGUE
4548 GOSUB 10300:IF I=0 THEN 4513
4550 V$=C$(PF,I):R1=LEN(V$):Y=VAL(SEG$(V$,R1-1,2)):GOTO 4990
4552 IF Y=14 THEN 4990
4554 IF J(PF,I,12)<>1 THEN 4556 ELSE Y=14:GOSUB 10000:GOSUB 10200
4555 IF TEST=1 AND H<7 THEN Y=13:GOTO 4990
4556 Y=VAL(SEG$(V$,1,2)):GOTO 4990
4570 ! AUTRE QUE ENTAME
4572 ON CI+1 GOTO 4574,4600,4600,4600,4600,4900
4574 I=0:V$=C$(PF,0):R1=LEN(V$):IF V$="" THEN 4800
4575 FOR Z=0 TO 3:IF G(Z)=1 THEN 4576 ELSE 4582
4576 IF W=RE(3)THEN 4578 ELSE Y=VAL(SEG$(V$,R1-1,2))
4577 IF Y>HAUT THEN 4990 ELSE 4580
4578 GOSUB 7200:IF Y<>0 THEN 4990
4580 IF J(PF,0,0)=1 AND R1>2 THEN R2=3 ELSE R2=1
4581 Y=VAL(SEG$(V$,R2,2)):GOTO 4990
4582 NEXT
4584 IF HAUT<14 AND J(PF,5,0)=1 THEN Y=1:I=5:GOTO 4990
4586 GOTO 4578
4600 V$=C$(PF,CI):R1=LEN(V$):IF R1=0 THEN 4700
4602 I=CI:IF CM=0 THEN Y=VAL(SEG$(V$,1,2)):GOTO 4990
4604 GOSUB 10000:IF H+R1/2>9 THEN Y=VAL(SEG$(V$,1,2)):GOTO 4990
4606 IF J(PF,CI,13)=1 THEN Y=14:GOTO 4990
4608 Y=14:GOSUB 10200
4609 IF (TEST=1 AND J(PF,CI,12)=1)THEN Y=13:GOTO 4990
4610 IF (EC=0 AND (PF+1=RE(0)OR PF+1=4))THEN 4611 ELSE 4614
4611 IF R1>4 THEN R2=3 ELSE R2=1
4612 Y=VAL(SEG$(V$,R1-R2,2)):GOTO 4990
4614 Y=VAL(SEG$(V$,1,2)):GOTO 4990
4700 ! COUPE
4702 V$=C$(PF,0):R1=LEN(V$):IF R1=0 THEN 4800 ELSE K(PF,CI)=1
4704 I=0:IF CM<>CI THEN 4711
4705 GOSUB 10000
4706 IF J(PF,0,0)=1 AND H=0 AND PETBOU=0 THEN Y=1:GOTO 4990
4707 IF J(PF,0,0)=1 AND R1>2 THEN R2=3 ELSE R2=1
4708 FOR Z=0 TO 3:IF G(Z)-INT(G(Z)/100)*100:IF ZZ>10 THEN 4710 ELSE NEXT
4709 IF J(PF,5,0)AND W=RE(3)THEN I=5:Y=0:GOTO 4990
4710 Y=VAL(SEG$(V$,1,2)):GOTO 4990
4711 GOSUB 7200:IF Y<>0 THEN 4990
4712 IF J(PF,0,0)=1 THEN 4707
4713 !NEXT
4714 Y=VAL(SEG$(V$,1,2)):GOTO 4990
4722 GOSUB 7200:IF Y<>0 THEN 4990
4723 IF J(PF,0,0)=1 THEN 4707
4724 Y=VAL(SEG$(V$,1,2)):GOTO 4990
4800 ! DEFOSSE
4801 IF J(PF,5,0)=1 THEN I=5:Y=1:GOTO 4990
4802 FOR S=1 TO 4:FOR Z=0 TO 3:IF Z=PF THEN 4820
4804 V$=C$(PF,S):R1=LEN(V$):IF R1=0 THEN 4822
4806 Y=VAL(SEG$(V$,1,2)):IF K(Z,S)AND Y<11 THEN 4990
4820 NEXT
4822 NEXT
4824 FOR I=1 TO 4:V$=C$(PF,Z):R1=LEN(V$)
4826 IF Z=1 THEN R2=R1:S=Z:GOTO 4830
4828 IF R1>R2 THEN R2=R1:S=Z
4830 NEXT
4831 V$=C$(PF,S)
4832 I=S:Y=VAL(SEG$(V$,1,2))
4900 GOTO 4512
4990 N(I)=1:PJ=1:IF I=0 AND CI<>0 THEN K(PF,CI)=1
4991 IF CI=5 THEN CI,CM=I:JOE=WW:HAUTE=Y
4992 RETURN
5000 ! AFF CHIEN
5001 CALL COLOR("0BW")
5002 IF F=4 OR F=6 THEN 5004 ELSE 5100
5004 GOSUB 9100:LOCATE (21,1):PRINT "LE CHIEN ETAIT "
5005 GOSUB 7950:FOR Z=0 TO 5
5006 I=INT(CHIEN(Z)/100):Y=CHIEN(Z)-100*I
5008 CALL AFCAR(I,Y,7,17+4*Z):NEXT
5100 ! POINTS ATTAQUE
5101 CALL COLOR("0BW"):COMT=0:B=0
5102 FOR Z=78 TO AT STEP -1
5104 I=INT(P(Z)/100):Y=P(Z)-100*I
5106 ON I+1 GOTO 5108,5110,5110,5110,5110,5108
5108 IF Y=1 OR Y=21 THEN COMT=COMT+4.5:B=B+1:GOTO 5112
5109 COMT=COMT+.5:GOTO 5112
5110 IF Y<11 THEN COMT=COMT+.5 ELSE COMT=COMT+(Y-10)+.5
5112 NEXT
5200 ! RESULTATS
5202 IF B=0 THEN COMT=COMT-56
5204 IF B=1 THEN COMT=COMT-51
5206 IF B=2 THEN COMT=COMT-41
5208 IF B=3 THEN COMT=COMT-36
5209 S=INT(COMT/10)*10:EC=COMT-S:IF EC<5 THEN COMT=S ELSE COMT=S+10
5210 IF COMT<0 THEN AT=-F*(25-COMT):GOTO 5214
5212 AT=F*(25+COMT)
5214 LOCATE (22,1):PRINT "GAIN =",AT:PAUSE 3
5215 FOR Z=0 TO 3
5216 IF Z=PF THEN POINT(Z)=POINT(Z)+(3*AT):GOTO 5220
5218 POINT(Z)=POINT(Z)-AT
5220 NEXT
5800 ! RAJOUTE POIGNEE
5802 FOR Z=0 TO 3:IF E(Z)=0 THEN 5850
5803 IF AT>=0 THEN TEST=1 ELSE TEST=-1
5804 FOR T=0 TO 3:IF T=PF THEN 5810
5805 POINT(T)=POINT(T)-TEST*E(Z):GOTO 5812
5810 POINT(PF)=POINT(PF)+TEST*3*E(Z)
5811 LOCATE (22,1):PRINT "POIGNEE =",E(Z)*TEST:PAUSE 3
5812 NEXT
5850 NEXT
5900 ! PETIT AU BOUT
5902 IF PETIT=0 THEN 5950
5904 IF PRO=PF THEN TEST=1 ELSE TEST=-1
5906 FOR Z=0 TO 3:IF Z=PF THEN 5910
5908 POINT(Z)=POINT(Z)-TEST*F*10:GOTO 5912
5910 POINT(Z)=POINT(Z)+TEST*F*30
5911 LOCATE (22,1):PRINT "PETIT =",TEST*10*F
5912 NEXT
5950 ! AFFICHE POINT
5951 CALL COLOR("0BY")
5952 FOR Z=0 TO 3:LOCATE (Z+1,33):PRINT POINT(Z):NEXT
5960 ! ON CONTINUE
5962 LOCATE (21,1):PRINT "UN AUTRE TOUR ? 1=OUI 0=NON"
5964 HH$=KEY$:GOSUB 8800
5968 IF HH$="1" THEN GOSUB 7900:GOSUB 9100:GOTO 490
5970 IF HH$="0" THEN END
5972 GOTO 5962
6000 ! EFFAC POINTEUR
6002 IF R=32 THEN GOSUB 8800:GOTO 6004
6003 CALL SPEECH("L,0D7C8BAABAB602FC")
6004 CALL COLOR("0Bb"):LOCATE (L,C):PRINT " "
6010 RETURN
6099 ! AFFICHE POINTEUR
6100 CALL COLOR("0Wb"):LOCATE (L,C):PRINT CHR$(14):RETURN
6500 ! AFFICHAGE CARTES DE SUD
6501 GOSUB 7900:L=12:H=0:TEST=0:FOR I=0 TO 5
6502 FOR Y=1 TO 21
6503 IF J(2,I,Y-1)=0 THEN 6511
6504 H=H+1:EC=100*I+Y
6507 IF (TEST=0 AND H=10)THEN L=17:TEST=1
6508 IF H=10 THEN H=1
6509 C=5+(H-1)*4:ECRAN((L-12)/5,H-1)=EC
6510 CALL AFCAR(I,Y,L,C)
6511 NEXT
6512 NEXT
6515 RETURN
6600 ! AFFICHAGE DES PRISES
6601 IF WW=0 THEN V$="NORD "
6602 IF WW=1 THEN V$="OUEST"
6603 IF WW=2 THEN V$="SUD "
6604 IF WW=3 THEN V$="EST "
6605 IF G(WW)=0 THEN HH$="PASSE "
6606 IF G(WW)=1 THEN HH$="PETITE"
6607 IF G(WW)=2 THEN HH$="GARDE "
6608 IF G(WW)=4 THEN HH$=" SANS "
6609 IF G(WW)=6 THEN HH$="CONTRE"
6610 CALL COLOR("0BY"):LOCATE (1,16):PRINT V$:LOCATE (3,16):PRINT HH$:PAUSE 4
6620 RETURN
7099 ! MISE EN ORDRE
7100 FOR Z=0 TO 5:C$(WW,Z)="":FOR ZZ=1 TO 21
7102 IF J(WW,Z,ZZ-1)=1 AND ZZ<10 THEN C$(WW,Z)=C$(WW,Z)&"0"&STR$(ZZ)
7104 IF J(WW,Z,ZZ-1)=1 AND ZZ>9 THEN C$(WW,Z)=C$(WW,Z)&STR$(ZZ)
7105 NEXT:NEXT
7106 RETURN
7200 ! CARTE PLUS FORTE
7201 IF I=0 THEN S=21 ELSE S=14
7202 FOR Y=1 TO S:IF J(WW,I,Y-1)=1 AND Y>HAUT THEN 7208
7204 NEXT
7206 Y=0
7208 RETURN
7900 ! CARTES EN BLANC SUD
7901 CALL COLOR("0WW")
7905 FOR Z=1 TO 6 STEP 5:FOR S=1 TO 9:FOR ZZ=0 TO 3
7910 LOCATE (11+Z+ZZ,4*S):PRINT " "
7915 NEXT:NEXT:NEXT
7920 RETURN
7925 ! EFFAC TABLE
7926 CALL COLOR("0BW")
7928 FOR Z=0 TO 3:LOCATE (2+Z,6):PRINT " "
7930 LOCATE (5+Z,2):PRINT " "
7932 LOCATE (5+Z,10):PRINT " "
7934 LOCATE (7+Z,6):PRINT " "
7936 NEXT
7940 RETURN
7950 ! CARTE BLANC CHIEN
7951 CALL COLOR("0WW"):FOR Z=1 TO 6:FOR S=0 TO 3
7952 LOCATE (7+S,4*Z+12):PRINT " "
7953 NEXT:NEXT
7954 RETURN
7960 ! CARTE CHIEN b
7962 FOR Z=0 TO 3:LOCATE (7+Z,16):CALL COLOR("0Wb")
7964 PRINT " ":NEXT
7966 RETURN
8000 ! PETIT SEC ?
8002 IF W=0 THEN V$="NORD"
8003 IF W=1 THEN V$="OUEST"
8004 IF W=2 THEN V$="VOUS"
8005 IF W=3 THEN V$="EST"
8010 LOCATE (21,1):CALL COLOR("0Wb"):PRINT "ON REDONNE:PETIT SEC CHEZ ";V$
8011 DO=DO-1
8012 RETURN
8200 ! REMISE EN ORDRE COULEURS
8202 FOR Z=73 TO 78:I=INT(P(Z)/100):Y=P(Z)-100*I:J(PF,I,Y-1)=0:NEXT
8204 WW=PF:GOSUB 7100:GOSUB 7960
8210 RETURN
8500 ! CARTE DEJA JOUEE?
8502 TEST=0:CAR=ECRAN((L-11)/5,Z-1)
8506 IF CAR<>0 THEN 8510
8508 CALL COLOR("0Wb"):LOCATE (21,1):PRINT "ERREUR ; RECOMMENCER "
8509 PAUSE 2:TEST=1
8510 IF TES4=0 THEN ECRAN((L-11)/5,Z-1)=0
8600 RETURN
8800 ! TOC
8802 CALL SPEECH("L,0D7C91B2BAB602FC")
8804 RETURN
9000 ! SUD PREND?
9001 CALL COLOR("0Wb"):LOCATE (21,1)
9002 PRINT " QUE FAITES-VOUS ? 0=PASSE 1=PETITE 2=GARDE 4=SANS 6=CONTRE"
9003 V$=KEY$:GOSUB 8800:IF NUMERIC(V$)=0 THEN 9000
9004 Z=VAL(V$):IF Z*(Z-1)*(Z-2)*(Z-4)*(Z-6)<>0 THEN 9000
9005 G(WW)=Z:GOSUB 9100
9006 RETURN
9100 ! EFFACT LIGNE
9101 CALL COLOR("0Wb"):HH$=RPT$(" ",39)
9102 LOCATE (21,1):PRINT HH$
9103 LOCATE (22,1):PRINT HH$
9104 RETURN
9200 ! REMPL PAQ BAS=PRENEUR
9204 AT=AT-1:P(AT)=100*I+Y
9208 RETURN
9300 ! REMPL PAQ HAUT=DEF
9306 A=A+1:P(A)=100*I+Y
9308 RETURN
10000 ! NB CARTES TOMBEES D'1 COULEUR
10002 H=0
10003 IF A=RD-1 THEN 10020
10004 FOR Z=RD TO A
10010 IF INT(P(Z)/100)=I THEN H=H+1
10012 NEXT
10020 IF AT=CD+1 THEN 10030
10024 FOR Z=AT TO CD
10026 IF INT(P(Z)/100)=I THEN H=H+1
10028 NEXT
10030 RETURN
10200 ! CETTE CARTE EST TOMBEE?
10202 TEST=0:IF (I=0 AND Y=22)OR (I<>0 AND Y=14)THEN TEST=1:GOTO 10220
10203 IF A=RD-1 THEN 10210
10204 FOR Z=RD TO A
10206 IF 100*I+Y=P(Z)THEN TEST=1:GOTO 10220
10208 NEXT
10210 IF AT=CD+1 THEN 10220
10214 FOR Z=AT TO CD
10216 IF 100*I+Y=P(Z)THEN TEST=1:GOTO 10220
10218 NEXT
10220 RETURN
10300 ! CHERCHE LONGUE
10302 FOR Z=1 TO 4:R1=LEN(C$(WW,Z))
10304 IF Z=1 THEN R2=R1:I=Z:GOTO 10308
10306 IF R1>R2 THEN R2=R1:I=Z
10308 NEXT
10310 IF R2=0 THEN I=0
10312 RETURN
15000 ! POIGNEE ?
15002 CALL COLOR("0RY"):V$=C$(WW,0):R1=LEN(V$):IF R1<20 THEN 15100
15003 IF WW=0 THEN R$="NORD"
15004 IF WW=1 THEN R$="OUEST"
15005 IF WW=3 THEN R$="EST"
15006 IF R1>19 AND R1<25 THEN R2=10:E(WW)=20
15008 IF R1=26 OR R1=28 THEN R2=13:E(WW)=30
15009 IF R1>28 THEN R2=15:E(WW)=40
15010 LOCATE (21,1):PRINT "POIGNEE CHEZ ";R$:PAUSE 3:GOSUB 9100
15012 FOR Z=1 TO R2:R$=SEG$(V$,2*Z-1,2)
15013 IF VAL(R$)=1 THEN E(4)=1
15014 IF Z<11 THEN S=Z:LOCATE (21,S*3-2):PRINT R$:GOTO 15018
15016 S=Z-10:LOCATE (22,S*3-2):PRINT R$
15018 NEXT
15100 RETURN
16000 ! PETIT AU BOUT?
16002 V$=C$(PF,0):R1=LEN(V$)
16004 IF R1>18 THEN PETBOU=1
16050 RETURN
20100 SUB AFCAR(I,Y,L,C)
20101 CALL SPEECH("L,0D7C8BAABAB602FC"):IF I=0 THEN 20200
20102 IF I=1 THEN HH$="1RW"
20103 IF I=2 THEN HH$="1BW"
20104 IF I=3 THEN HH$="1RW"
20105 IF I=4 THEN HH$="1BW"
20106 IF I=5 THEN HH$="1MW"
20107 S=10*I:CALL COLOR(HH$):IF Y>10 THEN 20133 ELSE IF I=5 THEN 20190
20108 IF Y=1 OR Y=3 OR Y=5 OR Y=7 OR Y=9 THEN LOCATE (L+1,C):PRINT CHR$(S+1)
20109 IF Y=1 OR Y=3 OR Y=5 OR Y=7 OR Y=9 THEN LOCATE (L+2,C):PRINT CHR$(S+3)
20110 IF Y=2 OR Y=3 THEN LOCATE (L,C):PRINT CHR$(S)
20111 IF Y=2 OR Y=3 THEN LOCATE (L+3,C):PRINT CHR$(S)
20112 IF Y>3 AND Y<11 THEN 20113 ELSE 20117
20113 LOCATE (L,C-1):PRINT CHR$(S)
20114 LOCATE (L,C+1):PRINT CHR$(S)
20115 LOCATE (L+3,C+1):PRINT CHR$(S)
20116 LOCATE (L+3,C-1):PRINT CHR$(S)
20117 IF Y=6 OR Y=7 THEN 20118 ELSE 20122
20118 LOCATE (L+1,C-1):PRINT CHR$(S+1)
20119 LOCATE (L+1,C+1):PRINT CHR$(S+1)
20120 LOCATE (L+2,C+1):PRINT CHR$(S+3)
20121 LOCATE (L+2,C-1):PRINT CHR$(S+3)
20122 IF Y>7 AND Y<11 THEN 20123 ELSE 20127
20123 LOCATE (L+1,C-1):PRINT CHR$(S)
20124 LOCATE (L+1,C+1):PRINT CHR$(S)
20125 LOCATE (L+2,C+1):PRINT CHR$(S)
20126 LOCATE (L+2,C-1):PRINT CHR$(S)
20127 IF Y<>10 THEN 20132
20128 LOCATE (L,C):PRINT CHR$(S+1)
20129 LOCATE (L+1,C):PRINT CHR$(S+3)
20130 LOCATE (L+2,C):PRINT CHR$(S+1)
20131 LOCATE (L+3,C):PRINT CHR$(S+3)
20132 GOTO 20250
20133 IF Y=11 THEN V$="V":D1=90
20134 IF Y=12 THEN V$="C":D1=100
20135 IF Y=13 THEN V$="D":D1=110
20136 IF Y=14 THEN V$="R":D1=120
20140 LOCATE (L,C+1):PRINT CHR$(S)
20141 LOCATE (L+3,C-1):PRINT CHR$(S)
20142 CALL COLOR("1BW"):LOCATE (L,C-1):PRINT V$;CHR$(D1)
20144 LOCATE (L+1,C-1):PRINT CHR$(D1+1);CHR$(D1+2);CHR$(D1+3)
20146 LOCATE (L+2,C-1):PRINT CHR$(D1+4);CHR$(D1+5);CHR$(D1+6)
20148 LOCATE (L+3,C):PRINT CHR$(D1+7);V$
20170 GOTO 20250
20180 ! DESSIN EXCUSE
20190 LOCATE (L,C-1):PRINT CHR$(42);CHR$(50);CHR$(51)
20192 LOCATE (L+1,C-1):PRINT CHR$(52);CHR$(53);CHR$(54)
20193 LOCATE (L+2,C-1):PRINT CHR$(55);CHR$(56)
20194 LOCATE (L+3,C-1):PRINT CHR$(57);" ";CHR$(42)
20195 GOTO 20250
20200 ! DESSIN ATOUT
20201 CALL COLOR("0BW"):LOCATE (L,C-1):PRINT STR$(Y)
20205 IF Y>9 THEN LOCATE (L+3,C) ELSE LOCATE (L+3,C+1)
20206 PRINT STR$(Y)
20222 CALL COLOR("1BW"):LOCATE (L+1,C-1):PRINT CHR$(1);CHR$(2);CHR$(3)
20223 LOCATE (L+2,C-1):PRINT CHR$(4);CHR$(5);CHR$(6)
20250 SUBEND
21000 SUB EFC(L,C)
21002 CALL COLOR("0BW"):FOR Z=L+1 TO L+4:LOCATE (Z,C-1):PRINT " ":NEXT
21004 SUBEND
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.