Hebdogiciel n°128

 

1 !******************************!
2 !EXELDOMINO par J.M MACHECOURT !
3 !******************************!
6 CALL HROFF:CALL POKE(50432,162,5,45,162,136,45,10,162,5,45,162,200,45,10)
10 CLS "BGG":CALL COLOR("0WMHLI"):CALL HRON("b",1,17):CALL EXEC(50432)
14 CALL DM(16,0):RANDOMIZE:DIM A(28),B(28),C(19),D(19),E(19),F(19)
18 DATA 0,0,1,0,1,1,2,0,2,1,2,2,3,0,3,1,3,2
22 DATA 3,3,4,0,4,1,4,2,4,3,4,4,5,0,5,1,5,2
26 DATA 5,3,5,4,5,5,6,0,6,1,6,2,6,3,6,4,6,5,6,6
30 FOR I=1 TO 28:READ A(I):READ B(I):NEXT I
34 R,S,G,H=6:K,L,M,N=8:XG=320:XH=303:YG=54:YH=96
38 FOR I=1 TO K
42 J=INTRND(28):IF A(J)=8 THEN 42 ELSE C(I)=A(J):D(I)=B(J):A(J)=8
46 J=INTRND(28):IF A(J)=8 THEN 46 ELSE E(I)=A(J):F(I)=B(J):A(J)=8
50 NEXT I:CALL DO(M):GOSUB 390:CALL COLOR("0BGH")
54 !
58 FOR I=1 TO L:IF E(I)=G AND F(I)=H THEN 62 ELSE NEXT I:CALL DM(1,G):GOTO 70
62 GOSUB 294:CALL DV(293,75,G,H):GOTO 170
66 !
70 CALL KEY1(V,W):IF W=0 THEN 70
74 IF V=49 THEN 86
78 IF V<>48 THEN 70
82 CLS:FOR I=1 TO K:IF C(I)=G AND D(I)=H THEN 90 ELSE NEXT I:CALL DM(2,3)
86 G=G-1:H=H-1:PAUSE .5:IF G>=0 THEN 58 ELSE CALL DM(12,3):GOTO 374
90 CALL DM(13,1):C(I),D(I)=8:GOSUB 386:N=N-1:CALL DV(293,75,G,H):GOTO 98
94 !
98 IF N<>0 THEN 102 ELSE CALL DM(15,3):GOTO 374
102 FOR I=1 TO L
106 IF E(I)=G AND F(I)=G THEN S=G:GOSUB 294:GOSUB 302:GOTO 170
110 IF E(I)=H AND F(I)=H THEN R=H:GOSUB 294:GOSUB 338:GOTO 170
114 IF E(I)=G THEN S=F(I):GOTO 122
118 IF F(I)=G THEN S=E(I) ELSE 126
122 GOSUB 294:GOSUB 322:GOTO 170
126 IF E(I)=H THEN R=F(I):GOTO 134
130 IF F(I)=H THEN R=E(I) ELSE 138
134 GOSUB 294:GOSUB 358:GOTO 170
138 NEXT I
142 !
146 FOR I=1 TO 28:IF A(I)<>8 THEN 158 ELSE NEXT I:CALL DM(3,3):FOR I=1 TO 19
150 IF C(I)=G OR D(I)=G OR E(I)=G OR F(I)=G OR C(I)=H OR D(I)=H THEN 170
154 IF E(I)=H OR F(I)=H THEN 170 ELSE NEXT I:CALL DM(12,3):GOTO 374
158 CALL DM(4,0):L=L+1:M=M+1:CALL DO(M)
162 J=INTRND(28):IF A(J)=8 THEN 162 ELSE E(L)=A(J):F(L)=B(J):A(J)=8:GOTO 98
166 !
170 IF M>0 THEN CALL DM(5,0) ELSE CALL DM(11,3):GOTO 374
174 CALL KEY1(V,W):IF W=0 THEN 174
178 CLS:IF V<>49 THEN 202
182 !
186 FOR I=1 TO 28:IF A(I)<>8 THEN 190 ELSE NEXT I:CALL DM(6,1):GOTO 98
190 J=INTRND(28):IF A(J)=8 THEN 190
194 CALL DM(7,0):N=N+1:K=K+1:C(K)=A(J):D(K)=B(J):A(J)=8:GOSUB 390:GOTO 170
198 !
202 IF V<>48 THEN 170 ELSE CALL DM(8,1)
206 CALL KEY1(V,W):IF W=0 THEN 206
210 IF V<48 OR V>54 THEN 206 ELSE LOCATE (20,28):T=V-48:PRINT T
214 LOCATE (21,28):PRINT T:PAUSE .5
218 CALL KEY1(V,W):IF W=0 THEN 218
222 IF V<48 OR V>54 THEN 218 ELSE LOCATE (20,32):U=V-48:PRINT U
226 LOCATE (21,32):PRINT U:PAUSE .5
230 FOR I=1 TO K:IF C(I)=T AND D(I)=U OR C(I)=U AND D(I)=T THEN 238 ELSE NEXT I
234 CALL DM(2,3):GOTO 170
238 IF C(I)=G AND D(I)=G THEN S=G:GOSUB 286:GOSUB 302:GOTO 98
242 IF C(I)=H AND D(I)=H THEN R=H:GOSUB 286:GOSUB 338:GOTO 98
246 IF C(I)=G AND D(I)=H THEN IF T=G THEN 254 ELSE 270
250 IF C(I)=H AND D(I)=G THEN IF T=H THEN 266 ELSE 258
254 IF C(I)=G THEN S=D(I):GOTO 262
258 IF D(I)=G THEN S=C(I) ELSE 266
262 GOSUB 286:GOSUB 322:GOTO 98
266 IF C(I)=H THEN R=D(I):GOTO 274
270 IF D(I)=H THEN R=C(I) ELSE 278
274 GOSUB 286:GOSUB 358:GOTO 98
278 CALL DM(14,3):GOTO 170
282 !
286 CALL DM(13,1):N=N-1:D(I),C(I)=8:GOSUB 390:RETURN
290 !
294 CALL DM(9,0):M=M-1:CALL DO(M):E(I),F(I)=8:RETURN
298 !
302 IF XG<64 AND XG>47 AND YG=54 THEN 326
306 IF XG<40 AND YG=54 THEN 310 ELSE 314
310 XG=XG+8:YG=29:CALL DV(XG,YG,G,S):YG=23:G=S:XG=XG+22:RETURN
314 IF YG=54 THEN XG=XG-19:CALL DV(XG,YG,G,S):G=S:RETURN
318 IF XG<60 THEN 330 ELSE CALL DV(XG,YG,G,S):G=S:XG=XG+19:RETURN
322 IF XG<30 AND YG=54 THEN 310
326 IF YG=54 THEN XG=XG-34:CALL DH(XG,YG,S,G):G=S:RETURN
330 CALL DH(XG,YG,G,S):G=S:XG=XG+34:RETURN
334 !
338 IF XH<90 AND XH>68 AND YH=96 THEN 362
342 IF XH<69 AND YH=96 THEN 346 ELSE 350
346 YH=115:XH=XH-8:CALL DV(XH,YH,R,H):YH=124:H=R:XH=XH+15:RETURN
350 IF YH=96 THEN XH=XH-19:CALL DV(XH,YH,H,R):H=R:RETURN
354 IF XH<70 THEN 366 ELSE CALL DV(XH,YH,H,R):H=R:XH=XH+19:RETURN
358 IF XH<69 AND YH=96 THEN 346
362 IF YH=96 THEN XH=XH-34:CALL DH(XH,YH,R,H):H=R:RETURN
366 CALL DH(XH,YH,H,R):H=R:XH=XH+34:RETURN
370 !
374 CALL DM(10,3)
378 CALL KEY1(V,W):IF W=0 THEN 378 ELSE IF V=48 THEN RUN
382 CALL HROFF:CLS "BCC":CALL EXEC(50439):END
386 !
390 X=4:Y=155:IF YH=96 THEN Z=140 ELSE Z=155
394 FOR I=Z TO 169:CALL LINE("b",0,I,319,I):NEXT I
398 FOR I=1 TO K
402 IF C(I)=8 OR D(I)=8 THEN 414
406 IF X>=310 THEN X=4:Y=140
410 CALL DH(X,Y,C(I),D(I)):X=X+35
414 NEXT I:RETURN
418 !
422 SUB DH(X,Y,G,H)
426 FOR I=1 TO 33:CALL LINE("W",X+I,Y,X+I-4,Y+10):NEXT I
430 CALL LINE("R",X+17,Y,X+13,Y+10)
434 FOR I=11 TO 14:CALL LINE("B",X-3,Y+I,X+29,Y+I):NEXT I
438 FOR I=1 TO 4:CALL LINE("B",X+33,Y+I,X+29,Y+10+I):NEXT I
442 CALL LINE("W",X-3,Y+10,X-3,Y+14)
446 CALL LINE("W",X+28,Y+10,X+28,Y+14)
450 ON G+1 GOSUB 462,466,470,474,482,486,490
454 X=X+16:ON H+1 GOSUB 462,466,470,474,482,486,490
458 GOTO 510
462 RETURN
466 X=X+6:Y=Y+5:GOSUB 494:X=X-6:Y=Y-5:RETURN
470 X=X+7:Y=Y+2:GOSUB 494:Y=Y+5:X=X-2:GOSUB 494:X=X-5:Y=Y-7:RETURN
474 GOSUB 466
478 X=X+3:Y=Y+2:GOSUB 494:X=X+6:Y=Y+5:GOSUB 494:X=X-9:Y=Y-7:RETURN
482 GOSUB 478:X=X+1:Y=Y+7:GOSUB 494:X=X+10:Y=Y-5:GOSUB 494:X=X-11:Y=Y-2:RETURN
486 GOSUB 466:GOSUB 482:RETURN
490 GOSUB 470:GOSUB 482:RETURN
494 CALL PLOT("B",X,Y)
498 CALL PLOT("B",X,Y+1)
502 CALL PLOT("B",X+1,Y)
506 CALL PLOT("B",X+1,Y+1):RETURN
510 X=X-16:SUBEND
514 !
518 SUB DV(X,Y,G,H)
522 FOR I=1 TO 16:CALL LINE("W",X+I+4,Y-6,X+I-7,Y+19):NEXT I
526 CALL LINE("R",X,Y+7,X+16,Y+7)
530 FOR I=20 TO 24:CALL LINE("B",X-6,Y+I,X+9,Y+I):NEXT I
534 FOR I=1 TO 5:CALL LINE("B",X+20,Y-6+I,X+9,Y+19+I):NEXT I
538 CALL LINE("W",X+9,Y+19,X+9,Y+24)
542 CALL LINE("W",X-7,Y+19,X-7,Y+24)
546 X=X+9:ON H+1 GOSUB 558,562,566,570,578,582,586
550 Y=Y+13:X=X-6:ON G+1 GOSUB 558,562,566,570,578,582,586
554 Y=Y-13:X=X+6:GOTO 606
558 RETURN
562 GOSUB 590:RETURN
566 X=X-4:GOSUB 590:X=X+8:GOSUB 590:X=X-4:RETURN
570 GOSUB 590
574 X=X+6:Y=Y-3:GOSUB 590:X=X-12:Y=Y+6:GOSUB 590:X=X+6:Y=Y-3:RETURN
578 GOSUB 574:X=X-2:Y=Y-3:GOSUB 590:X=X+5:Y=Y+6:GOSUB 590:X=X-3:Y=Y-3:RETURN
582 GOSUB 590:GOSUB 578:RETURN
586 GOSUB 566:GOSUB 578:RETURN
590 CALL PLOT("B",X,Y)
594 CALL PLOT("B",X,Y+1)
598 CALL PLOT("B",X+1,Y)
602 CALL PLOT("B",X+1,Y+1):RETURN
606 X=X-9:SUBEND
610 !
614 SUB DO(M)
618 FOR I=1 TO 14:CALL LINE("b",0,I,319,I):NEXT I
622 X,Y=1:FOR I=1 TO M:FOR J=1 TO 5:CALL LINE("B",X,Y+J,X+33,Y+J):NEXT J
626 CALL LINE("W",X,Y,X+33,Y):CALL PLOT("R",X+17,Y)
630 X=X+35:IF X>310 THEN X=1:Y=8
634 NEXT I:SUBEND
638 !
642 SUB DM(P,Q)
646 CLS
650 ON P GOTO 654,658,662,666,670,674,678,682,686,690,694,698,702,706,710,714
654 Q$=STR$(Q):Q$="Pas de double "&Q$&", et vous? oui=0/non=1":GOTO 718
658 Q$="Vous n'avez pas ce domino!":GOTO 718
662 Q$="Plus de pioche. Je passe...":GOTO 718
666 Q$="Je pioche...":GOTO 718
670 Q$="0 pour jouer / 1 pour piocher":GOTO 718
674 Q$="Plus de pioche. Vous passez...":GOTO 718
678 Q$="Vous piochez...":GOTO 718
682 Q$="Indiquez ses valeurs    ../.. ":GOTO 718
686 Q$="Je joue...":GOTO 718
690 Q$="Une autre partie? 0=oui/1=non":GOTO 718
694 Q$="J'ai gagn'e!":GOTO 718
698 Q$="Le jeu est bloqu'e.":GOTO 718
702 Q$="Vous jouez...":GOTO 718
706 Q$="Ce domino ne correspond pas!":GOTO 718
710 Q$="Vous avez gagn'e!":GOTO 718
714 Q$="EEXXEELLDDOOMMIINNOO"
718 LOCATE (20,(40-LEN(Q$))/2):PRINT Q$
722 LOCATE (21,(40-LEN(Q$))/2):PRINT Q$:IF Q<4 THEN PAUSE Q
726 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.