Othello

Program listing

5 on error goto 9000
10 rem START OF PROGRAM
20 width 0
100 rem INITIALIZE
105 gosub 400
110 bd$="...........................XO......OX..........................."
120 print cl$
130 print chr$(27)+"cA02E00000000000000100000000000000000"+chr$(19)
140 print chr$(27)+"cA12E00000000000000100000000000000000"+chr$(19)
145 gosub 1100:rem set display with board
149 pf%=1:rem panic factor
150 gosub 6900:rem read position values from panic table
399 goto 500
400 rem read the ttycap file to extract the terminal capabilities
401 open old "/etc/termcap" as 2
402 rem 1=cursor home
403 rem 2=cursor up, 3=cursor down, 4=cursor left, 5=cursor right
404 rem 6=clear screen, 9=erase to EOL, 10=set dim, 11=set normal
405 rem 7=position cursor parameter string, see crt_termcap document
406 rem input tc=value from table, output tc$=string of interest
410 rem read a string at the time and put it in correct place
420 tc%=1:gosub 490:ch$=tc$
421 tc%=9:gosub 490:ce$=tc$:rem read erase to EOL
422 tc%=10:gosub 490:pd$=tc$
423 tc%=11:gosub 490:pn$=tc$
424 tc%=6:gosub 490:cl$=tc$
425 tc%=5:gosub 490:cf$=tc$:rem cursor forward
426 tc%=3:gosub 490:cd$=tc$:rem cursor down
427 tc%=4:gosub 490:cb$=tc$
428 tc%=2:gosub 490:cu$=tc$:rem cursor up
489 return
490 tc$=""
491 position #2,2*val(term$),mode 0:rem read the address in file of terminal
492 let po$=inch$(2)+inch$(2):position #2,2*tc%+2+cvt$%(po$),mode 0
493 let po$=inch$(2)+inch$(2):position #2,cvt$%(po$)-2*tc%-4,mode 1
495 let tc$=tc$+inch$(2):if right$(tc$,1)<>chr$(0) goto 495
499 return
500 close 2
510 p$="X":s$="O"
520 cm%=0:rem common area pointer
525 print ch$;string$(chr$(10),11);
530 print "       The higher, the better (1-9):";
532 i$=inch$(0)
533 dl%=(asc(i$)-48):if dl%<1 or dl%>9 goto 532
600 rem set up used variables and comment them
610 dim my%(7):rem index for board string instead of multiply
620 for my%=0 to 7:my%(my%)=8*my%:next my%:rem See..its done here instead
630 dim px%(64):dim py%(64)
640 for qy%=0 to 7:for qx%=1 to 8:px%(8*qy%+qx%)=qx%-1:py%(8*qy%+qx%)=qy%:next qx%:next qy%
650 dim sa(64)
660 sx%=18:hx%=47
670 dim da%(64):rem holding direction detection flags on board..!#$
680 restore 8900:for a%=1 to 64:read da%(a%):next a%
690 dim do%(20)
695 restore 696:for a%=0 to 20:read do%(a%):next a%
696 data -9,-8,-7,-1,0,0,0,0,0,1,0,7,0,0,0,0,0,8,9,0,0
1000 rem MAINLOOP
1010 gosub 1200:rem ask for side
1015 if CB$="X" goto 1060
1020 gosub 2000:rem player inputs, and play help!
1025 if nm%=1 and vm$="" goto 1500:rem no moves any part
1030 gosub 1100:rem update display
1040 gosub 5000:if x%=1 goto 1500:rem end of game detected
1050 swap p$,s$:rem swap side
1052 if mo%>56 and pf%<>6 then pf%=6:gosub 6900
1055 om%=tm%
1057 for i%=0 to 64:sa(i%)=0:next i%
1058 print ch$;string$(chr$(10),19);"   ";
1060 tm=second:gosub 4000:tm=second-tm
1065 print ch$;string$(chr$(10),17);"  ";tm%-om%;"moves took";int(tm+.5);"seconds   ";
1070 gosub 3700:rem move selection
1075 gosub 1100:rem update display
1080 swap p$,s$:goto 1020
1100 rem print borard
1101 print ch$;string$(chr$(10),1);
1105 print "       "+" 1  2  3  4  5  6  7  8"
1110 for qy%=0 to 7
1115 print "    ";qy%+1;pd$;
1117 for qx%=1 to 8
1120 print " ";mid$(bd$,8*qy%+qx%,1);" ";
1130 next qx%
1135 print pn$
1140 next qy%
1145 print op$
1199 return
1200 rem ask for side
1203 print
1205 print "      X will start !   "
1210 print "      WHAT LETTER DO YOU WANT ? (O/X) :";
1220 let i$=inch$(0):if i$<>"o" and i$<>"x" and i$<>"O" and i$<>"X" goto 1220
1230 if i$="X" or i$="x" then CB$="O" else CB$="X":rem opposite of player.
1240 if CB$="X" then OB$="O" else OB$="X"
1250 print ch$;string$(chr$(10),11);spc(40)
1251 print spc(45)
1252 print spc(45)
1253 print spc(45)
1260 print ch$;string$(chr$(10),11);"   YOU HAVE ";pd$;" ";OB$;" ";pn$
1262 print
1264 print "   I look ";dl%;" moves ahead";
1290 print
1299 return
1300 rem PRINT POSSIBLE MOVES
1310 print ch$;chr$(10);chr$(10);string$(cf$,40);" YOUR POSSIBLE MOVES:"
1315 if vm$="" then print chr$(10);string$(cf$,40);" You can't move, of course!":return
1320 print
1330 print string$(cf$,40);" use ENTER to select the position"
1340 print string$(cf$,40);" use SPACE to select another position"
1399 return
1400 rem INPUT A MOVE SELECTION
1405 if vm$="" then return
1415 i%=len(vm$)
1416 v%=1
1417 print ch$;string$(chr$(10),2+py%(asc(mid$(vm$,v%,1))));string$(cf$,7);pd$;chr$(8);chr$(8);
1418 print string$(cf$+cf$+cf$,1+px%(asc(mid$(vm$,v%,1))));"*";chr$(8);
1420 i$=inch$(0)
1421 if i$<>" " and i$<>chr$(13) then print chr$(8);"*";chr$(8);:goto 1420
1422 if i$=" " then v%=1-(v%<i%)*v%:print chr$(8);".";:goto 1417
1460 vm$=mid$(vm$,v%,1)
1490 print ch$;string$(chr$(10),2);string$(cf$,40);
1491 i%=5
1492 print ce$;chr$(10);
1493 i%=i%-1:if i%>0 goto 1492
1495 print pn$
1499 return
1500 rem END OF GAME
1505 x%=0:o%=0:for i%=1 to 64:let x%=x%-(mid$(bd$,i%,1)="X"):o%=o%-(mid$(bd$,i%,1)="O"):next i%
1507 print ch$;string$(chr$(10),11);string$(cf$,40);pd$;" X ";pn$;"= ";x%;"  ";pd$;" O ";pn$;"= ";o%;
1510 print ch$;string$(chr$(10),7);string$(cf$,40);"End of game..again? (y/n):";
1520 i$=inch$(0)
1530 if i$="y" or i$="Y" goto 5
1540 if i$<>"n" and i$<>"N" goto 1520
1590 goto 9000
1599 stop
2000 rem USER MOVE INPUT AND CHECK
2010 gosub 3600:rem investigate board for valid moves
2015 if vm$="" and nm%=1 then return
2020 gosub 1300:rem print possible moves
2030 gosub 1400:rem input a valid selection
2040 i%=asc(vm$):gosub 3200
2050 mo%=mo%+1
2099 return
3000 rem CHECK FOR VALID MOVES (examine area for opponent)
3001 if mo%<50 goto 3100
3005 a%=0:t$=left$(bd$,hx%)
3010 i%=instr(i%+1,t$,".")
3011 if i%=0 then return
3013 dt%=-10
3014 dt%=do%(dt%+10):if dt% then t%=i% else goto 3010
3015 for a%=0 to 10
3016 t%=t%+dt%:if t%<1 or t%>64 goto 3014
3017 if da%(t%)+da%(t%-dt%)=0 goto 3014
3018 q$=mid$(bd$,t%,1)
3019 if q$="." goto 3014
3021 if q$=s$ then next a%
3022 if q$=p$ and a% then return
3030 goto 3014
3100 rem check for valid moves
3105 t$=left$(bd$,hx%)
3107 if dt% goto 3114
3110 o%=instr(o%+1,t$,p$)
3111 if o%=0 then i%=0:return
3113 dt%=-10
3114 dt%=do%(dt%+10):if dt% then t%=o% else goto 3110
3115 for a%=0 to 10
3116 t%=t%+dt%:if t%<1 or t%>64 goto 3114
3117 if da%(t%)+da%(t%-dt%)=0 goto 3114
3118 q$=mid$(bd$,t%,1)
3119 if q$=p$ goto 3114
3121 if q$=s$ then next a%
3122 if q$="." and a% then i%=t%:goto 3140
3130 goto 3114
3140 rem
3145 return
3200 rem DO A MOVE
3210 xx%=px%(i%):yy%=py%(i%)
3215 for dx%=-1 to 1:for dy%=-1 to 1
3220 if dx% or dy% then goto 3221 else goto 3260
3221 mx%=xx%:my%=yy%
3225 mx%=mx%+dx%:my%=my%+dy%
3230 if (8 and (mx% or my%))>7 goto 3260
3235 a$=mid$(bd$,my%(my%)+mx%+1,1)
3240 if a$="." goto 3260
3242 if a$=s$ goto 3225
3250 mx%=mx%-dx%:my%=my%-dy%
3253 bd$=left$(bd$,my%(my%)+mx%)+p$+mid$(bd$,my%(my%)+mx%+2)
3255 SC%=SC%+((asc(mid$(pv$,my%(my%)+mx%+1))-40)*((p$=OB$)-(p$=CB$)))*(8/(cl%+1))
3257 if mx%-xx% or my%-yy% goto 3250
3258 if sx%+9>i% then sx%=i%-10:if sx%<0 then sx%=0
3259 if hx%-9<i% then hx%=i%+10:if hx%>64 then hx%=64
3260 next dy%:next dx%
3262 tm%=tm%+1
3269 return
3600 rem examine for valid moves. for opponent
3605 vm$=""
3610 i%=sx%:o%=sx%
3625 gosub 3000
3630 if a% then vm$=vm$+chr$(i%)
3640 if i%<>0 goto 3625
3650 return
3700 rem SELECT A MOVE FROM THE SCORE ARRAY
3710 sc=-30000:v%=0
3720 for i%=1 to 64 
3730 if sa(i%)>=sc+2*rnd(0) and sa(i%)<>0 then sc=sa(i%):v%=i%
3740 next i%
3750 if v%=0 goto 3790
3780 i%=v%:gosub 3200
3785 mo%=mo%+1
3790 print ch$;string$(chr$(10),15);string$(cf$,3);"I MOVED :";
3795 if v%=0 then print "Can't move"; else print 1+xx%;",";1+yy%;
3797 print ",total moves";tm%;
3798 print chr$(7);
3799 return
4000 rem RECURSIVE EVALUATOR:stop on 1:memory out 2:game end 3:defined depth
4010 cm%=cm%+128:common cm%:rem add on to common area, push variables
4011 field common,64 as BD$,1 as P$,2 as iv$,2 as sc$,1 as sx$,1 as hx$,1 as dt$
4015 lset sc$=cvt%$(SC%):lset BD$=bd$:lset P$=p$:lset sx$=chr$(sx%):lset hx$=chr$(hx%)
4020 i%=sx%:dt%=0:o%=sx%:cl%=cl%+1:rem set up used variables
4025 gosub 3000
4030 if i%=0 goto 4080:rem exit if no more
4040 if cl%=1 then I%=i%:print ".";
4045 gosub 3200:rem execute the move found
4050 gosub 5000:if x%=0 then swap p$,s$:lset dt$=chr$(dt%+32):lset iv$=chr$(i%)+chr$(o%):gosub 4000:i%=asc(iv$):o%=asc(right$(iv$,1)):dt%=asc(dt$)-32
4060 sa(I%)=sa(I%)+SC%:rem add deepest score in movearray
4065 bd$=BD$:SC%=cvt$%(sc$):p$=P$:sx%=asc(sx$):hx%=asc(hx$):rem restore board,score and side
4068 if p$="X" then s$="O" else s$="X"
4075 goto 4025:rem examine moves until fully explored in all levels
4080 rem exit recursive loop, restore variables
4085 cm%=cm%-128:cl%=cl%-1
4086 if cm% then common cm%:field common,64 as BD$,1 as P$,2 as iv$,2 as sc$,1 as sx$,1 as hx$,1 as dt$
4099 return
5000 rem EVALUATE IF RECURSIVE LOOP MUST STOP: x%=0 if not.
5005 x%=1
5010 if instr(1,bd$,"X")=0 or instr(1,bd$,"O")=0 or instr(1,bd$,".")=0 then return
5020 if mem(0)>50000 then print ch$;string$(cf$,10);"Migraine";:return
5090 x%=(dl%=cl%)
5099 return
6900 rem read position values, dependent on number of moves left
6901 rem                                and the panic factor
6905 on pf% gosub 6911,6912,6913,6914,6915,6916,6917,6918,6919
6907 PF%=pf%
6910 return
6911 restore 8020:goto 6920
6912 restore 8010:goto 6920
6913 restore 8030:goto 6920
6914 restore 8040:goto 6920
6916 restore 8030:goto 6920
6920 rem loop reading values
6921 pv$=""
6922 for q%=0 to 7
6925 read v$:pv$=pv$+v$
6930 next q%
6949 return
7000 rem SPECIAL GAMES CONTROLS
7010 print ch$;string$(chr$(10),21);"  ENTER new deepest level:";
7020 input dl%
7030 dl%=dl%+(dl%>0)
7099 resume 
8019 rem board values for pf%=1
8020 data "laceecal"
8021 data "a.ABBA.a"
8022 data "cAJDDJAc"
8023 data "eBGCCGBe"
8024 data "eBGCCGBe"
8025 data "cAJDDJAc"
8026 data "a.ABBA.a"
8027 data "laceecal"
8030 rem End game values
8031 data "AAAAAAAA"
8032 data "AAAAAAAA"
8033 data "AAAAAAAA"
8034 data "AAAAAAAA"
8035 data "AAAAAAAA"
8036 data "AAAAAAAA"
8037 data "AAAAAAAA"
8038 data "AAAAAAAA"
8900 rem board edge detection flags
8901 data 1,2,3,4,5,6,7,-1
8902 data 1,2,3,4,5,6,7,-1
8903 data 1,2,3,4,5,6,7,-1
8904 data 1,2,3,4,5,6,7,-1
8905 data 1,2,3,4,5,6,7,-1
8906 data 1,2,3,4,5,6,7,-1
8907 data 1,2,3,4,5,6,7,-1
8908 data 1,2,3,4,5,6,7,-1
9000 rem ERROR HANDLER
9010 if err=8 then resume 9900:rem END OF FILE
9020 if err=34 then resume 9900
9800 rem UNKNOWN ERROR HANDLER
9810 if err<>0 then exec,"basicerror"+str$(err)
9820 if err<>0 then print "      in line "+str$(erl)
9890 if err<>0 then resume 9900
9900 rem EXIT PROGRAM
9910 print chr$(27)+"cA02E00000000000000000000003030000000"+chr$(19)
9911 print chr$(27)+"cA12E00000000000000000000003030000000"+chr$(19)
9999 end