' Tris
' Copyright (C) 1989 Pierre Blanc
' Pierre Blanc: blanc_teutoburgo@yahoo.it
' http://www.teutoburgo.tk
' http://it.geocities.com/teutoburgo
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
' or go to http://www.gnu.org/copyleft/gpl.html
10 DIM A(3), X(9), Y(9), P(9), CW(24), WW(3), PW(3), PP(3), ROT(9, 9)
20 A(2) = 3
30 A(3) = 6: P1 = 0: P2 = 0
40 FOR N = 1 TO 9
50 READ X(N)
60 NEXT N
70 FOR N = 1 TO 9
80 READ Y(N)
90 NEXT N
92 FOR N = 1 TO 9
93 FOR M = 1 TO 9
95 READ ROT(N, M)
97 NEXT M, N
100 ' *************** TRIS CHALLENGER - PROFESSIONAL VERSION ******************
110 ' Copyright (C) 1989 -- Pierre Blanc --
120 RANDOMIZE TIMER
130 FOR N = 1 TO 24
140 READ CW(N)
150 NEXT N
155 SCREEN 0, 0, 0: WIDTH 80: KEY OFF: COLOR 10, 6, 6: CLS
157 GOSUB 5000
158 COLOR 10
160 LOCATE 19, 1: LINE INPUT "Scegli livello (1=Debole,2=Medio,3=Imbattibile) ¯"; L$
170 X$ = L$: GOSUB 9000
180 IF ER = 1 THEN ER = 0: LOCATE 18, 50: PRINT SPC(LN); : GOSUB 30000
190 IF RET = 1 THEN RET = 0: GOTO 160
193 L = VAL(L$)
197 IF L < 1 OR L > 3 THEN LOCATE 18, 50: PRINT SPC(1); : GOTO 160
200 CLS
210 TRI1$ = " ³ ³ "
220 TRI2$ = "ÄÄÄÅÄÄÄÅÄÄÄ"
230 TRI3$ = TRI1$
240 TRI4$ = TRI2$
250 TRI5$ = TRI1$
500 LOCATE 6, 35: PRINT TRI1$
510 PRINT TAB(35); TRI2$
520 PRINT TAB(35); TRI3$
530 PRINT TAB(35); TRI4$
540 PRINT TAB(35); TRI5$
560 GOSUB 6000
1000 FOR N = 1 TO 3
1010 FOR M = 1 TO 3
1020 LOCATE 4 + N * 2, 31 + M * 4: PRINT M + A(N)
1030 NEXT M
1040 NEXT N
1050 LOCATE 18, 1
1098 LOCATE 18, 1: PRINT SPC(50 + LN);
1100 LOCATE 18, 1: INPUT "Chi comincia (0=ESC,1=TU,2=IO) "; C$
1110 X$ = C$: GOSUB 9000
1120 IF ER = 1 THEN ER = 0: LOCATE 18, 34: PRINT SPC(LN); : GOSUB 30000
1125 IF RET = 1 THEN RET = 0: GOTO 1100
1130 C = VAL(C$)
1140 IF C < 0 OR C > 2 THEN LOCATE 18, 34: PRINT SPC(1); : GOTO 1100
1150 IF C = 0 THEN SYSTEM
1153 NM = 0
1155 IF C = 2 THEN GOTO 1260
1160 COLOR 14: LOCATE 18, 1: LINE INPUT "Dammi la tua mossa (numero da 1 a 9) ¯"; M$
1170 X$ = M$: GOSUB 9000
1175 LOCATE 18, 39: PRINT SPC(LN);
1180 IF ER = 1 THEN ER = 0: GOSUB 30000
1190 IF RET = 1 THEN RET = 0: GOTO 1160
1200 M = VAL(M$)
1210 IF M = 0 THEN GOSUB 30000: RET = 0: GOTO 1160
1215 IF P(M) <> 0 THEN GOSUB 30100: GOTO 1160
1220 COLOR 11: LOCATE X(M), Y(M): PRINT "x"
1230 P(M) = 1: NM = NM + 1
1233 IF L = 3 AND ROTV = 0 AND M <> 5 THEN ROTV = M
1235 K = 1: GOSUB 7500
1240 IF W = 1 THEN GOTO 8000
1250 IF NM = 9 THEN GOSUB 7000
1260 IF L = 1 THEN GOTO 1300
1270 IF L = 2 THEN GOTO 1500
1280 GOTO 1700
1290 ' --------- Livello 1
1300 MC = INT(RND * 9) + 1
1310 IF P(MC) <> 0 THEN GOTO 1300
1320 SOUND 523, .1: SOUND 196, .5: COLOR 14: LOCATE X(MC), Y(MC): PRINT "o"
1330 P(MC) = 2: NM = NM + 1
1340 K = 2: GOSUB 7500
1350 IF W = 1 THEN GOTO 8500
1360 IF NM = 9 THEN GOSUB 7000
1400 GOTO 1160
1500 ' --------- Livello 2
1510 N = 0
1520 FOR V1 = 1 TO 8
1530 FOR V2 = 1 TO 3
1540 N = N + 1
1550 IF P(CW(N)) = 2 THEN WW(V2) = 1
1560 NEXT V2
1570 IF WW(1) + WW(2) + WW(3) = 2 THEN GOSUB 2000
1580 WW(1) = 0: WW(2) = 0: WW(3) = 0
1590 NEXT V1
1600 N = 0
1610 FOR V1 = 1 TO 8
1620 FOR V2 = 1 TO 3
1630 N = N + 1
1640 IF P(CW(N)) = 1 THEN WW(V2) = 1
1650 NEXT V2
1660 IF WW(1) + WW(2) + WW(3) = 2 THEN GOSUB 2000
1680 WW(1) = 0: WW(2) = 0: WW(3) = 0
1690 NEXT V1
1695 WW(1) = 0: WW(2) = 0: WW(3) = 0: GOTO 1300
1700 ' --------- Livello 3
1710 FOR N = 1 TO 9: CP$ = CP$ + (RIGHT$(STR$(P(N)), 1)): NEXT N
1715 IF ROTV <> 0 THEN INR$ = CP$: GOSUB 5500: CP$ = NR$: NR$ = ""
1720 RESTORE 25000
1725 FOR N = 1 TO 175
1730 READ PST$
1740 IF CP$ = (LEFT$(PST$, 9)) THEN GOTO 1750
1745 NEXT N
1747 GOTO 35000
1750 CP$ = ""
1753 IF ROTV = 0 THEN GOTO 1760
1754 FOR K = 1 TO 3
1755 INR$ = RIGHT$(PST$, 9): GOSUB 5500: PST$ = LEFT$(PST$, 9) + NR$: NR$ = ""
1757 NEXT K
1760 MCC = INT(RND * 9) + 1
1765 L3$ = (MID$(PST$, 9 + MCC, 1))
1770 IF L3$ = "0" THEN GOTO 1760 ELSE IF L3$ = "1" THEN GOTO 1780
1780 IF ROTV = 0 AND MCC <> 5 THEN ROTV = MCC
1785 MC = MCC
1790 GOTO 1320
2000 FOR CN = 1 TO 3
2010 IF P(CW(N - CN + 1)) = 0 THEN MC = CW(N - CN + 1): WW(1) = 0: WW(2) = 0: WW(3) = 0: GOTO 1320
2020 NEXT CN
2030 RETURN
5000 ' Presentazione
5010 PRINT " teutoburgo.tk presenta:"
5020 PRINT
5030 PRINT " T R I S challenger (1990)"
5040 PRINT
5050 PRINT " di Pierre Blanc"
5060 PRINT : PRINT
5070 FOR N = 1 TO 3
5080 COLOR 11: PRINT " x x x"; : COLOR 14: PRINT " o o o"
5085 PRINT
5090 NEXT
5095 COLOR 10 : PRINT
5100 PRINT " Questo programma e' liberamente distribuibile seguendo la GNU GPL license"
5110 PRINT " ma e' fornito SENZA ALCUNA GARANZIA. Consultare la licenza per i dettagli"
5499 RETURN
5500 ' Rotazione
5510 FOR N = 1 TO 9
5520 NR$ = NR$ + MID$(INR$, (ROT(ROTV, N)), 1)
5530 NEXT N
5540 RETURN
6000 ' Stampa punteggi
6010 COLOR 15, 6
6100 LOCATE 1, 1: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
6110 LOCATE 2, 1: PRINT "³ Tuoi punti : "; P1; " ": LOCATE 2, 22: PRINT "³"
6120 LOCATE 3, 1: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
6130 LOCATE 1, 58: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
6140 LOCATE 2, 58: PRINT "³ Miei punti : "; P2; " ": LOCATE 2, 79: PRINT "³"
6150 LOCATE 3, 58: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
6490 COLOR 10
6499 RETURN
6500 ' Inizializzazione
6510 FOR N = 1 TO 9
6520 P(N) = 0
6530 NEXT N
6540 ROTV = 0
6550 IF LIVERR = 1 THEN LIVERR = 0: L = 3: CP$ = ""
6690 GOSUB 6000
6700 LOCATE 23, 6: COLOR 5, 2: PRINT "Premi un tasto o 'C' per cambiare livello o '0' per azzerare i punti"
6710 X$ = INKEY$: IF X$ = "" THEN GOTO 6710
6720 COLOR 10, 6
6730 IF X$ = "c" OR X$ = "C" THEN GOTO 155
6740 IF X$ = "0" THEN P1 = 0: P2 = 0: GOTO 155
6750 IF X$ = CHR$(27) THEN SYSTEM
6999 GOTO 200
7000 ' Patta
7010 FOR N = 1 TO 9
7020 IF (SCREEN(X(N), Y(N)) MOD 16) = 8 THEN LOCATE X(N), Y(N): COLOR 27: PRINT "x"
7030 IF (SCREEN(X(N), Y(N)) MOD 16) = 15 THEN LOCATE X(N), Y(N): COLOR 30: PRINT "o"
7040 NEXT N
7050 LOCATE 14, 36: COLOR 12, 4: PRINT "P A T T A"
7060 P1 = P1 + .5
7070 P2 = P2 + .5
7499 GOTO 6500
7500 ' Verify
7510 N = 1: W = 0
7520 FOR V1 = 1 TO 8
7530 FOR V2 = 1 TO 3
7540 IF P(CW(N)) = K THEN WW(V2) = 1: PP(V2) = CW(N)
7550 N = N + 1
7560 NEXT V2
7570 IF WW(1) + WW(2) + WW(3) = 3 THEN W = 1: FOR N = 1 TO 3: PW(N) = PP(N): NEXT N
7580 WW(1) = 0: WW(2) = 0: WW(3) = 0
7590 NEXT V1
7999 RETURN
8000 ' Vinci tu
8010 COLOR 27
8020 FOR N = 1 TO 3
8030 LOCATE X(PW(N)), Y(PW(N)): PRINT "x"
8040 NEXT N
8050 COLOR 4, 2
8060 FOR N = 1 TO 32
8070 LOCATE 14, 2 + N: PRINT "þHAI"
8075 SOUND 37 + N * 5, .5
8080 LOCATE 14, 73 - N: PRINT "VINTOþ"
8085 SOUND 37 + 160 - N * 5, .5
8090 NEXT N
8100 P1 = P1 + 1
8499 GOTO 6500
8500 ' Vinco io
8510 COLOR 30
8520 FOR N = 1 TO 3
8530 LOCATE X(PW(N)), Y(PW(N)): PRINT "o"
8540 NEXT N
8550 COLOR 2, 4
8560 FOR N = 1 TO 32
8570 LOCATE 14, 2 + N: PRINT "þHO"
8575 SOUND 37 + N * 5, .5
8580 LOCATE 14, 73 - N: PRINT "VINTOþ"
8585 SOUND 37 + 160 - N * 5, .5
8590 NEXT N
8600 P2 = P2 + 1
8999 GOTO 6500
9000 ' error trapping
9005 LN = LEN(X$)
9010 IF LN <> 1 THEN ER = 1: RETURN
9020 IF ASC(X$) < 48 OR ASC(X$) > 57 THEN ER = 1
9999 RETURN
20000 DATA 6,6,6,8,8,8,10,10,10,36,40,44,36,40,44,36,40,44
20010 DATA 1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,3,6,9,2,5,8,1,4,7
20013 DATA 7,4,1,8,5,2,9,6,3,1,2,3,4,5,6,7,8,9,3,6,9,2,5,8,1,4,7
20015 DATA 7,4,1,8,5,2,9,6,3,7,8,9,4,5,6,1,2,3,9,6,3,8,5,2,7,4,1
20020 DATA 1,2,3,4,5,6,7,8,9,1,4,7,2,5,8,3,6,9,1,5,9,3,5,7
24970 '
24980 ' Book di aperture per il livello 3
24990 ' Questo piccolo database e' composto da stringhe di 18 cifre
24991 ' Le prime 9 cifre della stringa identificano la posizione attuale
24992 ' Le caselle sono numerate da 1 a 9, 0 indica la casella vuota,
24993 ' 1 indica la x, 2 la o
24994 ' Le ultime 9 cifre indicano le mosse possibili per il computer
24995 ' (identificate da un 1)
24999 '0-1 mosse
25000 '
25005 DATA 000000000111111111,100000000000010000,010000000101010010
25010 DATA 001000000000010000,000100000100011100,000010000101000101
25020 DATA 000001000001110001,000000100000010000,000000010010010101
25030 DATA 000000001000010000
25039 '2 mosse
25040 DATA 210000000000110100,201000000000100101,200100000011010000
25050 DATA 200010000000001011,200001000001010100,200000100011000001
25060 DATA 200000010001010100,200000001001000100
25070 DATA 120000000000100101,021000000000001101,020100000100010000
25080 DATA 020010000000101101,020001000001010000,020000100100000000
25090 DATA 020000010000111101,020000001001000000
25100 DATA 100020000000000001,010020000101101101,001020000000000100
25110 DATA 000120000111000111,000021000111000111,000020100001000000
25120 DATA 000020010101101101,000020001100000000
25129 '3 mosse
25130 DATA 100021000011000011,100020010000101101,100020001010101010
25140 DATA 211000000000100100,210100000000011010,210001000000000100
25150 DATA 210000100000010010,210000001000010110,112000000000001001
25160 DATA 012100000000000001,012001000000110010,012000100000010011
25170 DATA 012000001000010010,010120000101000100,010021000101000001
25180 DATA 010020100101101000,010020010101101101,010020001101101000
25190 DATA 110000020001000000,011000020100000000,010100020101000000
25200 DATA 010010020101000101,010001020101000000,010000120101000000
25210 DATA 010000021101000000,200010001001000100
25219 '4 mosse
25220 DATA 210200100000010000,210020001000100100,210100200000010001
25230 DATA 201100200000000001,221100000000010000,212100000000010000
25240 DATA 200120001011000000,210012000000000010,200112000001000000
25250 DATA 200012001011000110,210010020000000100,200110020000001000
25260 DATA 200010021001101100,212001000000010100,212000100000000001
25270 DATA 200100210001010000,212000001000000100,200100201001000000
25279 '
25280 DATA 121200000000010000,120201000001000001,120200100000010000
25290 DATA 120200010000000101,121000200000000010,120100200000010010
25300 DATA 120001200000010010,120000210000101001,121000002000000010
25310 DATA 120100002000000100,120010002001101100,120001002000000010
25320 DATA 120000102000100000,120000012000100100
25330 DATA 121002000000010000,021102000100000100,021002010000000101
25340 DATA 021002001000010000,021100200000000010,021010200100101001
25350 DATA 021001200000000001,021000210000001001,021000201000001000
25360 DATA 021100002000010010,021001002000010010,021000012000101100
25370 DATA 020120010101000000,020211000100000000,020210010100000000
25380 DATA 020112000001000000,020012010001000000,020110200000001000
25390 DATA 020010210100000000,120010002001101100,020011002000100000
25400 DATA 020010012001000000,122001000000010000,020021010101000000
25410 DATA 021200010000000001,020201010100000000,020200110000000001
25420 DATA 120020010000101101,021020010000101101,120002010000000100
25430 DATA 020102010001000000,020002011000000100,020100210001000000
25440 DATA 020001210101000000,020000211101000000,100021002000000110
25450 DATA 100020012001001000,012020100000001001,010221000100000100
25460 DATA 010122000001000001
25470 DATA 020100012101000000,020001012100000000,020000112101000000
25479 '5 mosse
25480 DATA 120021010000000101,100221010001000001,211100200000000001
25490 DATA 210102100000000001,211100220000000001,211102000000010110
25500 DATA 210102001000010110,210100120001011000,210100021001011000
25510 DATA 210001120001010000,210000121001011000,210100201000011000
25520 DATA 112001002000000100,112201000000010011,021201100000010011
25530 DATA 012201001000000100,012000121100110000,012001102000110000
25540 DATA 012100021100010000,012001021100110000,112001020000000100
25550 DATA 012001120100110000,010221100001000001,010221010100000100
25560 DATA 010122010001000001,010112001100000100
25569 '6 mosse
25570 DATA 210112020000000001,121201002000000010,120200112000001000
25580 DATA 120102210001000000,120100212001000000,121200102000010000
25590 DATA 121102200000000010,021002211000100000,021001212100000000
25600 DATA 021201012100000000,020112210001000000,020211012100000000
25610 DATA 020201112100000000,020102211001000000
30000 BEEP: RET = 1: RETURN
30010 X$ = INKEY$
30020 IF X$ = CHR$(13) THEN LOCATE 22, 5: PRINT SPC(70); : RET = 1: RETURN
30030 IF X$ = CHR$(27) THEN SYSTEM
30040 GOTO 30000
30100 COLOR 13: LOCATE 22, 25: PRINT "Mossa impossibile.Premi un tasto": BEEP
30110 X$ = INKEY$
30120 IF X$ = "" THEN GOTO 30110
30130 LOCATE 22, 25: PRINT SPC(32); : RETURN
35000 L = 2: LIVERR = 1: GOTO 1500
