Code : Tout sélectionner
15 CLEAR,&HA000:SCREEN7,0,0:CLS:PRINTCHR$(20):CPRE=1:TPRE(1)=2:TPRE(2)=4:TPRE(3)=5:TPRE(4)=6
20 DIM MAP%(6500),TTEST(11),TCAR(31),TMCOM(200),TAP(75),TMOCH(9)
25 ADTG=&HA000:ADPG=&HA000+16*128:ADTX=&HA000+(16+2)*128:ADPX=&HA000+(16+2+54)*128:ADCA=&HA000+(16+2+54+4)*128
26 DATA 01,02,03,04,05,06,07
27 FOR I=1 TO 7:READ EXT$(I):NEXT
28 TPD(1)=6441:TPD(2)=6402:TPD(3)=6092:TPD(4)=6275:TPD(5)=6425:TPD(6)=6388:TPD(7)=6363
30 CLS:LOCATE 10,10:PRINT"1 - DEMO"
35 LOCATE 10,12:PRINT"2 - JEU"
40 LOCATE 10,14:PRINT"3 - PARTIE EN COURS"
45 LOCATE 10,16:PRINT"4 - FIN"
50 R$=INKEY$:IF R$="" THEN 50
52 IF R$<"1" AND R$>"4" THEN 50
53 IF R$="4" THEN CLS:NEW:END
55 IF R$="1" THEN DEM=1:EPI=1:FORI=1 TO 30:TCAR(I)=1:NEXT:GOTO100 ELSE DEM=0
60 IF R$="2" THEN EPI=1:FOR I=2 TO 30:TCAR(I)=0:NEXT:GOTO 100
70 LOADM"TCARA01.BIN":GOSUB20000:EPI=PEEK(ADCA+30):IF EPI<1 OR EPI>7 THENEPI=1
80 FOR I=2 TO 30:TCAR(I)=PEEK(ADCA+I-1):NEXT
100 GOSUB 700
101 IF DEM=1 THEN FOR I=1 TO 10000:NEXT:GOTO 130
102 K$=INKEY$:IF K$="" THEN 101
105 CLS
130 PAG$="PAGE"+EXT$(EPI)
140 TCO$="TCOMM"+EXT$(EPI)
141 PTC$="PTCOM"+EXT$(EPI)
142 TEX$="TEXTE"+EXT$(EPI)
143 PTE$="PTEXT"+EXT$(EPI)
155 DES$="DESS"+EXT$(EPI)
160 '
175 '
180 LOADP PAG$,MAP%(6500):PUT(0,5),MAP%(6500)
290 '
340 LOADM TCO$,ADTG-&HA000
341 LOADM PTC$,ADPG-&HA000
342 LOADM TEX$,ADTX-&HA000
343 LOADM PTE$,ADPX-&HA000
355 LOADP DES$,MAP%(6500)
356 GOSUB 10000
357 MAP%(6500)=TPD(EPI)
360 TAP(1)=6500:ZZ=2
361 I=6500
362 X=MAP%(I):TAP(ZZ)=X
363 IF X<=1 THEN 370
364 I=X:ZZ=ZZ+1
365 GOTO 362
366 '
370 '
385 TCAR(1)=1
400 MD=1
410 MS=MD:GOSUB 1000
420 IF MD<>255 OR TM<>69 THEN 410
425 IF DEM=1 THEN FOR I=1 TO 30:TCAR(I)=1:NEXT
430 IF TCAR(1)=0 OR EPI=7 THEN 500
431 IF DEM=1 THEN443
440 FOR I=1 TO31:IFTCAR(I)<0 OR TCAR(I)>200 THENTCAR(I)=0
441 NEXT
442 TCAR(31)=EPI+1:FOR I=1 TO 31:POKE(ADCA+I-1),TCAR(I):NEXT:SAVEM"TCARA01.BIN",ADCA,ADCA+128,0
443 EPI=EPI+1:CLS:GOTO 130
500 FOR I=1 TO31:IFTCAR(I)<0 OR TCAR(I)>200 THENTCAR(I)=0
501 NEXT
502 TCAR(31)=EPI:FOR I=1 TO 31:POKE(ADCA+I-1),TCAR(I):NEXT
503 IF DEM=0 THEN SAVEM "TCARA01.BIN",ADCA,ADCA+128,0
600 RUN
700 COLOR5,0:CLS:LOCATE11,3:PRINT"30 SEPTEMBRE 1659":COLOR7:LOCATE0,8:PRINT"... 'Nous vimes une vague furieuse,":PRINT:PRINT"semblable a une montagne...Elle":PRINT:PRINT "renversa notre chaloupe et nous":PRINT
710 PRINT"separa les uns des autres aussi bien":PRINT:PRINT"que du bateau. En un instant, nous":PRINT:PRINT"fumes tous engloutis.'...'Mais":PRINT:PRINT"je repris conscience et reussis a":PRINT:PRINT"gagner definitivement le rivage.'":RETURN
997 '
998 ' MODULE
999 '
1000 J=1:FOR I=PEEK(ADPG+2*MD-2)+256*PEEK(ADPG+2*MD-1) TO PEEK(ADPG+2*MD)+256*PEEK(ADPG+2*MD+1)
1002 TMCOM(J)=PEEK(ADTG+I-1):J=J+1
1003 NEXT
1005 '
1010 PTCOM=1:FL1=1:FL2=1
1080 TM=TMCOM(PTCOM)
1450 '
1455 ' APPEL ROUTINES
1460 '
1500 IF TM=ASC("E") THEN 1700
1505 IF TM=ASC("D") AND FL1=1 AND FL2=1 THEN PT=TAP(TMCOM(PTCOM+1)):X=INT(TMCOM(PTCOM+2)/4):Y=25-INT(TMCOM(PTCOM+3)/8):GOSUB 2000
1506 IF TM=ASC("D") THEN PTCOM=PTCOM+4:GOTO1699
1510 IF TM=ASC("T") AND FL1=1 AND FL2=1 THEN NT=TMCOM(PTCOM+1):X=TMCOM(PTCOM+2):Y=TMCOM(PTCOM+3):GOSUB 4000
1511 IF TM=ASC("T") THEN PTCOM=PTCOM+6
1520 IF TM=ASC("W") AND FL1=1 AND FL2=1 THEN JP=TMCOM(PTCOM+1):GOSUB 7000
1521 IF TM=ASC("W") THEN PTCOM=PTCOM+2
1530 NBC=TMCOM(PTCOM+2):IF TM=ASC("C") AND FL1=1 AND FL2=1 THEN NBB=TMCOM(PTCOM+1):GOSUB 6000
1531 IF TM=ASC("C") THEN PTCOM=PTCOM+3+NBC
1550 IF TM=ASC("B") AND FL1=1 AND FL2=1 THEN FOR I=1 TO 7:TTEST(I)=TMCOM(PTCOM+I):NEXT:GOSUB 5000
1551 IF TM=ASC("B") THEN PTCOM=PTCOM+8
1560 IF TM=ASC("M") AND FL1=1 AND FL2=1 THEN NC=TMCOM(PTCOM+1):OC=TMCOM(PTCOM+2):VC=TMCOM(PTCOM+3):GOSUB 8000
1561 IF TM=ASC("M") THEN PTCOM=PTCOM+4
1600 IF TM=ASC("F") THEN PTCOM=PTCOM+2:FL1=0:IF FLTEST=TMCOM(PTCOM-1) THEN FL1=1
1601 IF TM=ASC("K") THEN FL1=1:PTCOM=PTCOM+1
1602 IF TM=ASC("H") THEN PTCOM=PTCOM+2:FL2=0:IF CHOIX=TMCOM(PTCOM-1) THEN FL2=1
1603 IF TM=ASC("L") THEN FL2=1:PTCOM=PTCOM+1
1604 IF TM=ASC("R") THEN CPFR=TMCOM(PTCOM+1):PTCOM=PTCOM+2:RETA=PTCOM
1605 IF TM=ASC("N") THEN CPFR=CPFR-1:IF CPFR=0 THEN PTCOM=PTCOM+1 ELSE PTCOM=RETA
1699 GOTO 1080
1700 RETURN
1701 '
1800 FOR IB=1 TO ZZ
1810 PTCOM=PTCOM+1
1820 TTEST(IB)=TMCOM(PTCOM)
1830 NEXT IB
1840 FOR IB=1 TO TTEST(2)
1850 PTCOM=PTCOM+1
1860 TTEST(IB)=TMCOM(PTCOM)
1870 NEXT IB
1880 RETURN
1900 FOR IB=1 TO ZZ
1910 PTCOM=PTCOM+1
1920 TTEST(IB)=TMCOM(PTCOM)
1930 NEXT IB
1940 RETURN
1997 '
1998 ' === AFFICHAGE DESSIN ===
1999 '
2000 PUT(X,Y),MAP%(PT)
2190 RETURN
3997 '
3998 ' === AFFICHAGE TEXTE ===
3999 '
4000 LP=0:KP=PEEK(ADPX+2*MS-2)+256*PEEK(ADPX+2*MS-1)-1:JP=0
4010 '
4015 IF PEEK(ADTX+KP)=0 THEN JP=JP+1
4016 KP=KP+1
4017 IF JP=NT THEN GOTO4020
4018 GOTO 4010
4020 COLOR7,0
4025 CONSOLE0,4:CLS:CONSOLE0,24
4030 LOCATE X-1,Y-1
4040 IF PEEK(ADTX+KP)=0 THEN 4060
4050 PRINT CHR$(PEEK(ADTX+KP));:KP=KP+1:GOTO 4040
4060 RETURN
4997 '
4998 ' === TEST CARACT. ===
4999 '
5000 FLTEST=0
5090 Z=2:T1=TCAR(TTEST(1)):T2=TCAR(TTEST(3))
5100 GOSUB 5500:REZ1=REZ
5110 IF TTEST(4)=9 THEN 5160
5120 Z=6:T1=TCAR(TTEST(5)):T2=TCAR(TTEST(7))
5130 GOSUB 5500:REZ2=REZ
5140 IF TTEST(4)=7 THEN IF REZ1=1 OR REZ2=1 THEN FLTEST=1
5150 IF TTEST(4)=8 THEN IF REZ1=1 AND REZ2=1 THEN FLTEST=1
5160 IF TTEST(4)=9 THEN IF REZ1=1 THEN FLTEST=1
5170 RETURN
5500 REZ=0:CC=TTEST(Z)
5510 IF CC=1 THEN IF T1=T2 THEN REZ=1
5520 IF CC=2 THEN IF T1<>T2 THEN REZ=1
5530 IF CC=3 THEN IF T1<T2 THEN REZ=1
5540 IF CC=4 THEN IF T1>T2 THEN REZ=1
5550 IF CC=5 THEN IF T1<=T2 THEN REZ=1
5560 IF CC=6 THEN IF T1=>T2 THEN REZ=1
5570 RETURN
5997 '
5998 ' === TEST CLAVIER ===
5999 '
6000 FOR IP=1 TO NBC:TMOCH(IP)=TMCOM(PTCOM+2+IP):NEXT
6001 IF DEM=0 THEN 6009
6003 IF EPI=2 AND NBC=7 THEN CHOIX=TPRE(CPRE):CPRE=CPRE+1:GOTO 6006
6004 IF NBC=1 THEN CHOIX=1:GOTO 6006
6005 CHOIX=INT(RND*NBC+1)
6006 FORI=1TO 4000:NEXT:GOTO 6070
6009 IP=0:CHOIX=0
6010 IF NBC=1 THEN MD=TMOCH(1):GOTO 6100
6015 IF CHOIX<>0 THEN 6050
6020 R$=INKEY$:IF R$="" THEN 6020
6025 XX=ASC(R$+CHR$(0))
6030 IF XX>48 AND XX<49+NBC THEN CHOIX=XX-48
6040 IP=IP+1:GOTO 6015
6050 'IF CHOIX=0 THEN CHOIX=INT(RND*(NBC+1))
6070 MD=TMOCH(CHOIX)
6100 COLOR,0:CONSOLE0,4:CLS:CONSOLE0,24:RETURN
6997 '
6998 ' === TEMPORISATION ===
6999 '
7000 FOR ITM=1 TO 2*JP:NEXT
7010 RETURN
7497 '
7498 ' === MODIF. CARACT. ===
7499 '
8000 IF OC=0 THEN TCAR(NC)=TCAR(NC)+VC
8001 IF OC=1 THEN TCAR(NC)=TCAR(NC)-VC
8002 IF OC=2 THEN TCAR(NC)=VC
8010 RETURN
10000 PLAY "A0T3L11":ON INTERVAL=3 GOSUB 10020:INTERVAL ON:RESTORE 10040:RETURN
10020 READ O$,N$:IF O$="F" THEN RESTORE10040:GOTO10020
10030 PLAY "O"+O$+N$ :RETURN
10040 DATA 3,P,3,FA#,3,LA,3,SO,3,FA#,3,DO#,2,SI,3,DO#,3,RE,2,LA,3,P,3,P
10050 DATA 3,P,3,FA#,3,LA,3,SO,3,FA#,3,DO#,2,SI,3,DO#,3,RE,2,LA,3,P,3,P
10060 DATA 3,DO#,3,P,3,P,3,FA#,3,P,3,P,2,LA,2,SI,3,DO,3,MI,3,RE,2,SI,3,RE,3,DO,2,SI,3,RE,3,P,3,RE,3,MI,3,FA,3,SO,3,LA,3,DO,3,RE,3,MI,3,RE,2,SI,3,RE,3,P,3,P
10070 DATA 2,SI,2,LA,2,SI,3,DO#,3,RE,3,MI,3,DO#,3,RE,3,MI,2,FA#,3,P,3,P,F,F
20000 CONST=0:VARIA=0:SUITE=0:VAR1=0
20010 POKE &H604B,79:POKE &H604C,17
20020 POKE &H6048,2
20030 POKE &H6049,0:POKE &H604E,0
20040 FOR K=1 TO 5
20050 EXEC &HE004
20060 IF PEEK(&H604E)=4 THEN K=99:GOTO 20120
20070 AA=PEEK(&H604F)*256+PEEK(&H6050)
20080 IF PEEK(AA+1)<>&H42 THEN CONST=CONST+1
20090 IF PEEK(AA+5)=VAR1 THEN VARIA=VARIA+1
20100 IF PEEK(AA+10)<>PEEK(AA+11) THEN SUITE=SUITE+1
20110 VAR1=PEEK(AA+5)
20120 NEXT
20130 IF CONST=0 AND VARIA<3 AND SUITE<3 AND K<>100 THENRETURN ELSENEW