"Othello" pour SHARP PC-1500.
 Logi' Stick.

Programme BASIC de 4343 octets.

CLOAD "OTHELLO"

----- BASIC program -----------------------------------------
1 "A"BEEP ON :WAIT 0:CLS :PRINT "OTHELLO : PC-1500 5Ko MIN.":CLEAR :DIM A(99),X(3):O$="0005030000"
2 LG=4: GOSUB 5000:CLS :PRINT "   COPYRIGHT LOGI";:GPRINT O$;:PRINT "STICK": GOSUB 5000:P$="442810284400"
3 CLS :PRINT "Othello 6";:GPRINT P$;:PRINT "6 ou 8";:GPRINT P$;:PRINT "8 ?"
4 IF INKEY$ ="6"BEEP 1:NO=6:RP=31:NI=43:PB=20:RESTORE :ND=48: GOTO 7
5 IF INKEY$ <>"8" THEN 4
6 BEEP 1:NO=8:RP=59:PB=28:RESTORE 2000:NI=73:ND=80
7 FOR I=0 TO ND:READ A(I):NEXT I
8 CLS :PRINT "Voulez-vous les noirs ?":CB=3:CC=2
9 IF INKEY$ ="O"BEEP 1: GOTO 13
10 IF INKEY$ <>"N" THEN 9
12 CC=3:CB=2:BEEP 1
13 CLS :PRINT "NIVEAU :  1   2   3  ?
14 IF INKEY$ ="" THEN 14
15 NJ=ASC INKEY$ -48:IF NJ<=0 OR NJ>=4 THEN 14
16 BEEP 1:PRINT "Commencez-vous ?
17 IF INKEY$ ="O"BEEP 1:PRINT LG;":";: GOTO 144
18 IF INKEY$ ="I"BEEP 1: GOSUB 800: GOTO 21
19 IF INKEY$ <>"N" THEN 17
20 BEEP 1
21  GOSUB 80:B=CC:C=CB: GOTO 159
40 FOR Q=0 TO 3:A=(A(Q)-INT A(Q))*100:IF K=0 AND P=0 AND X(Q)=Q THEN 60
50 IF INT A(A)=1 GOSUB 70:IF H=1 AND P=1LET X(Q)=Q:H=0
60 NEXT Q:RETURN 
70 F=1: GOSUB 90:FOR F=NO TO NO+2: GOSUB 90:NEXT F:RETURN 
80 B=CB:C=CC:E=RP:D=130:RETURN 
90 FOR Y=1 TO 2:F=-F:G=A:G=G+F:IF INT A(G)<>CNEXT Y:RETURN 
100 G=G+F:IF INT A(G)=C THEN 100
110 IF INT A(G)=BLET H=1:X=1: GOTO D
120 NEXT Y:RETURN 
130 I=A:A(A)=A(A)-INT A(A)+B:FOR Z=G-F TO A+F STEP -F:A(Z)=A(Z)-INT A(Z)+B
131 E=E+1:A(E)=INT A(E)+Z/100:NEXT Z:NEXT Y:RETURN 
140  GOSUB 700:BEEP 1
141 H=0: GOSUB 80:B=CC:C=CB:D=120:FOR W=0 TO RP:A=(A(W)-INT A(W))*100:IF INT A(A)<>1 THEN 143
142  GOSUB 70:IF H=1LET W=RP
143 NEXT W:PJ=ABS (H-1):BEEP 1
144 PRINT " A vous ? (";:DN=0:NA=0:NZ=0
145 A$=INKEY$ :DC=DN:IF A$="I" AND DN=0BEEP 1: GOSUB 800
146 IF A$="I" AND DN=1LET NZ=1:BEEP 1
147 IF A$="P" AND PJ=1BEEP 1:PRINT "P)": GOSUB 80:B=CC:C=CB: GOTO 159
148 IF PJ=1 THEN 145
149 IF DN=0 AND ASC A$>48 AND ASC A$<49+NOBEEP 1:PRINT A$;")(";:DN=1:NA=NA*10+ASC A$-48
150 IF DN=1 AND ASC A$>64 AND ASC A$<65+NOBEEP 1:PRINT A$;")":DN=2:NA=NA*10+ASC A$-64
151 IF DN<>2 THEN 145
154 A=INT (NA/10)*(NO+1)+((NA/10)-INT (NA/10))*10:IF INT A(A)<>1PRINT LG;":";: GOTO 144
155  GOSUB 80:B=CC:C=CB:H=0: GOSUB 70
156 IF H=0PRINT LG;":";: GOTO 144
157 LG=LG+1:IF NZ=1 GOSUB 800
158  GOSUB 700
159 K=0:IF NJ<3 THEN 190
160 D=120:H=0:P=1:X=0:FOR Y=0 TO 3:X(Y)=4:NEXT Y: GOSUB 40:K=X
190 J=0:FOR W=0 TO RP: GOSUB 80:H=0:A=(A(W)-INT A(W))*100:IF INT A(A)<>1 THEN 270
200  GOSUB 70:IF H=0 THEN 270
205 IF NJ=1 THEN 300
210 IF W<4 THEN 300
220 B=CC:C=CB:D=120:H=0:P=0: GOSUB 40:IF H=0 AND K=0 AND W<PB THEN 310
230 IF H=0 THEN 390
240 IF J=0 THEN 400
250 FOR Z=E TO RP+1 STEP -1:L=(A(Z)-INT A(Z))*100:A(L)=A(L)+CC-CB:NEXT Z
260 A(I)=A(I)+CC-4
270 NEXT W:IF K=1 AND J<>0LET K=0: GOTO 190
280 IF J=0 AND PJ=1PRINT LG;":Passe";: GOTO 705
285 IF J=0PRINT LG;":Passe";: GOTO 140
290  GOSUB 80:A=J: GOSUB 70
300 LG=LG+1:PRINT LG;":Moi ";CHR$ (48+A/(NO+1));CHR$ (64+A-INT (A/(NO+1))*(NO+1));: GOTO 140
310 L=NO+1:IF I>NI AND I<NI+NO-1LET L=1
320 IF I>NO+2 AND I<2*NO+1LET L=1
330 M=INT A(I+L):N=INT A(I-L):IF M=1 AND N=CC THEN 400
340 IF (M=1 AND INT A(2*L+I)=CB) OR (N=1 AND INT A(I-2*L)=CB) OR (M=CB AND N=CC) GOTO 400
350 IF M=CC AND (N=CB OR N=1) GOTO 400
390 A=I: GOTO 300
400 J=I: GOTO 250
690 IF OI=1RETURN 
691 OI=1:IF CC=3LPRINT "Blancs: JOUEUR      Noirs: PC-1500":LF 3:RETURN 
692 LPRINT "Blancs: PC-1500     Noirs: JOUEUR":LF 3:RETURN 
700 IF LG-1<>INT (NO^2)RETURN 
705 WAIT 200:PRINT :ON ERROR  GOTO 709:TEXT 
706 CLS :WAIT 0:PRINT "Imprimante ou Affichage ?
707 IF INKEY$ ="I"BEEP 1,0,99: GOTO 900
708 IF INKEY$ <>"A" THEN 707
709 BEEP 1,0,99
710 WAIT 200:CLS :PRINT "**** Partie terminee ****":CLS :PRINT "         VERDICT"
720 PM=0:PN=0:FOR I=8 TO ND:IF INT A(I)=CCLET PM=PM+1
730 IF INT A(I)=CBLET PN=PN+1
740 NEXT I:WAIT 0:CLS :IF PN=PMPRINT "Egalite";PN;" a";PN:WAIT :PRINT :END
750 IF PM<PNPRINT "J";:GPRINT O$;:PRINT "ai gagne";PN;" a";PM:WAIT :PRINT :END
760 PRINT "J";:GPRINT O$;:PRINT "ai perdu !!!";PN;" a";PM:WAIT :PRINT :END
800 ON ERROR  GOTO 890:TEXT :CSIZE 1:LPRINT :LPRINT :LPRINT :COLOR 1: GOSUB 690:FOR I=48+NO TO 49 STEP -1:LPRINT CHR$ I:LPRINT :NEXT I
805 GRAPH :CSIZE 1:GLCURSOR (17,0):SORGN :FOR I=0 TO (NO-1)*19 STEP 19:GLCURSOR (I,0):LPRINT CHR$ (65+(I/19));:NEXT I
809 GRAPH :COLOR 2:GLCURSOR (10,15):SORGN :FOR I=0 TO NO*19 STEP 19:LINE (I,0)-(I,NO*19):LINE (0,I)-(NO*19,I)
820 NEXT I:PN=0:PX=2:PY=2:FOR I=8 TO ND:IF INT A(I)=0NEXT I
822 IF INT A(I)=3LINE (PX+2,PY+2)-(PX+13,PY+13),0,3,B:PN=PN+1
824 PX=PX+19:IF PX>NO*19LET PX=2:PY=PY+19
826 NEXT I:PM=0:PX=2:PY=2:FOR I=8 TO ND:IF INT A(I)=0NEXT I
828 IF INT A(I)=2LINE (PX+2,PY+2)-(PX+13,PY+13),0,0,B:PM=PM+1
830 PX=PX+19:IF PX>NO*19LET PX=2:PY=PY+19
832 NEXT I
880 LINE (0,0)-(0,-40),9,1
885 TEXT :CSIZE 1:LPRINT "Blancs:";PN;"       Noirs:";PM
890 RETURN 
900 COLOR 1:CSIZE 2:LPRINT :LPRINT "     VERDICT"
920  GOSUB 800:IF CB=2LET PZ=PN:PN=PM:PM=PZ
930 LPRINT :LPRINT :IF PN=PMLPRINT "Egalite":END
940 IF PM<PNLPRINT "J ai gagne !!!":END
950 LPRINT "J ai perdu !!!!":END
1000 DATA .08,.13,.43,.48,.22,.29,.1,.11,1.27,1.34,1.45,1.46,1.09,1.12,.15,1.2
1010 DATA 1.36,1.41,1.44,1.47,1.17,.18,1.23,1.26,2.3,3.33,1.38,1.39,.16,1.19,1.37
1015 DATA 3.40,2,1,1
1020 DATA 0,1,1,1,1,1,1,0,1,1,1,1,1,1
2000 DATA .1,.17,.73,.8,.55,.46,.37,.28,.12,.13,1.14,1.15,1.35,1.44,1.53,1.62
2010 DATA 1.78,1.77,.76,1.75,1.64,1.19,1.11,1.16,1.26,1.71,1.79,.74,1.58,1.59,1.51
2020 DATA 1.42,1.32,1.31,1.39,1.48,.57,1.6,1.33,1.3,2.38,3.47,1.67,1.68,1.52,.43
2030 DATA 1.22,1.23,1.21,3.29,2.56,1.66,1.69,1.61,.34,1.24,1.2,1.65,1.7,1.25,1,1,1
2040 DATA 0,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1
5000 GCURSOR 0:FOR I=0 TO 40:GPRINT 127-POINT I;:NEXT I
5010 FOR I=41 TO 155:GCURSOR I:GPRINT 127-POINT I;:GCURSOR I-41:GPRINT 127-POINT (I-41);:NEXT I
5020 FOR I=115 TO 155:GPRINT 127-POINT I;:NEXT I:RETURN 

