1 REMark $$stak=4000
10 IF Q_MYJOB>0 THEN WINDOW 448,200,32,16:CLS
130 init_constants
140 init_vars
150 init_board
160 REPeat loop
170 print_board
180 FOR i=0 TO 15:ab(i)=-9999*(i MOD 2*2-1)
190 top=1:sc=minimax(black,1,1)
195 IF top>1 THEN 
200 make_move best:mess$="Move from "&int_to_str$(move_from)&" to "&int_to_str$(move_to)
205 ELSE 
207 mess$="COMPUTER can not move"
208 END IF 
210 input_move (white)
220 END REPeat loop
1000 DEFine PROCedure init_constants
1010 bking=-2:black=-1
1020 empty=0:bordr=9
1030 wking=+2:white=+1
1040 true=-1:false=0
1050 END DEFine 
1070 DEFine PROCedure init_vars
1080 LOCal i
1090 RESTORE :CLS:CSIZE 0,0
1100 DIM board(45),move_list(500),m(6),ab(15)
1110 INPUT "Enter level of play( >0 <16 ):"!str$
1115 max_lev="0"&str$:IF max_lev<1 OR max_lev>15 THEN PRINT "Invalid level":GO TO 1110
1120 FOR i=1 TO 6:READ m(i)
1130 DATA +4,+5,-4,-5,+4,+5
1135 READ wg1,wg2,wg3,wg4
1137 DATA 5,1,1,2
1140 END DEFine 
1160 DEFine PROCedure init_board
1170 LOCal i
1180 FOR i=6 TO 40:board(i)=empty
1185 REMark board(6)=bking:board(11)=wking:board(21)=wking:GO TO 1210
1190 FOR i=6 TO 18:board(i)=black
1200 FOR i=28 TO 40:board(i)=white
1210 FOR i=1 TO 5:board(i)=bordr:board(i+40)=bordr:board(9*i-4)=bordr
1212 INPUT "Enter load file name or null"!filename$
1216 IF filename$<>"" THEN load_game:input_move (white)
1220 END DEFine 
1280 DEFine PROCedure input_move(col)
1290 LOCal t_list(50),illegal,sq$,t_top
1310 top=1:IF NOT generate_moves(col) THEN win_game -col
1330 REPeat get_move
1340 print_board
1350 INK 2:AT 10,0:PRINT \mess$ TO 40\\
1355 IF top=1 THEN PRINT "It is not possible to move":RETurn 
1360 REPeat get_from_sqr
1370 INPUT "From:"!sq$
1375 IF sq$=="save" OR sq$="s" THEN save_game:NEXT get_move
1380 t_list(2)=str_to_int(sq$)
1390 IF NOT illegal THEN EXIT get_from_sqr
1400 PRINT "Illegal square:"!sq$
1410 END REPeat get_from_sqr
1450 t_top=3
1460 REPeat get_to_sqr
1470 INPUT "To:"!sq$
1480 IF sq$="" THEN EXIT get_to_sqr
1490 t_list(t_top)=str_to_int(sq$)
1500 IF illegal THEN PRINT "Illegal square:"!sq$:ELSE t_top=t_top+2
1510 END REPeat get_to_sqr
1590 t_top=1
1600 REPeat check_legality
1610 IF t_top>=top THEN mess$="Illegal move.  Try again":NEXT get_move
1650 FOR i=t_top+1,t_top+2 TO t_top+move_list(t_top)-1 STEP 2
1660 IF move_list(i)<>t_list(i-t_top+1) THEN t_top=t_top+move_list(t_top):NEXT check_legality
1670 END FOR i
1680 EXIT get_move
1690 END REPeat check_legality
1700 END REPeat get_move
1710 make_move (t_top)
1720 END DEFine 
1730 DEFine FuNction int_to_str$(index)
1740 LOCal j
1750 j=2*index+2*(index-1) DIV 9-11
1760 RETurn (8-j DIV 10)&"ABCDEFGH"(j MOD 10)
1765 END DEFine 
1770 DEFine FuNction str_to_int(x$)
1780 LOCal x,y,z
1785 IF LEN(x$)<>2 THEN illegal=true:RETurn 0
1790 x=x$(2) INSTR "ABCDEFGH":y=8-x$(1) INSTR "12345678"
1800 IF x<1 OR y>7 THEN illegal=true:RETurn 0
1810 z=10*y+x:illegal=false:RETurn z DIV 2-z DIV 20+5
1820 END DEFine 
1870 DEFine PROCedure make_move(index)
1880 LOCal m_len,i,sq0
1890 m_len=move_list(index):move_from=move_list(index+1):sq0=move_from
1910 FOR i=index+2 TO index+m_len-1 STEP 2
1920 move_to=move_list(i)
1930 board(move_to)=board(sq0):board(sq0)=empty
1940 IF m_len>3 THEN board((sq0+move_to)/2)=empty
1950 sq0=move_to
1960 END FOR i
1970 SELect ON sq0=6 TO 9:IF board(sq0)=white THEN board(sq0)=wking
1980 SELect ON sq0=37 TO 40:IF board(sq0)=black THEN board(sq0)=bking
1990 END DEFine 
2090 DEFine FuNction generate_moves(col)
2100 LOCal t_list(100),sq0,jump_found,start,piece
2110 jump_found=false:start=top
2120 FOR sq0=6 TO 40
2125 piece=board(sq0)
2130 IF piece=col OR piece=col*2 THEN 
2140 k1=2+(piece>0)-(piece<0):k2=2*ABS(piece)+k1-1:t_list(1)=sq0
2160 IF jump(sq0,k1,k2,col,2) THEN jump_found=true:ELSE IF NOT jump_found THEN no_jump sq0,k1,k2,col
2170 END IF 
2180 END FOR sq0
2185 RETurn t_list(1)>0
2190 END DEFine 
2260 DEFine FuNction jump(sq0,k1,k2,col,jump_num)
2270 LOCal k,j,poss_jump,sq1,sq2,piece
2280 poss_jump=false
2290 FOR k=k1 TO k2
2300 sq1=sq0+m(k):piece=board(sq1)
2310 IF piece=-col OR piece=-2*col THEN 
2320 sq2=sq1+m(k)
2330 IF board(sq2)=empty THEN 
2340 IF NOT jump_found THEN jump_found=true:top=start
2380 t_list(jump_num)=sq2:t_list(jump_num+1)=piece
2390 board(sq2)=board(sq0):board(sq1)=empty:board(sq0)=empty
2400 IF NOT jump(sq2,k1,k2,col,jump_num+2) THEN 
2410 move_list(top)=jump_num+2
2420 FOR j=1 TO jump_num+1:move_list(top+j)=t_list(j)
2430 top=top+jump_num+2
2440 END IF 
2450 board(sq0)=board(sq2):board(sq1)=piece:board(sq2)=empty
2460 poss_jump=true
2470 END IF 
2475 END IF 
2480 END FOR k
2490 RETurn poss_jump
2500 END DEFine 
2600 DEFine PROCedure no_jump(sq0,k1,k2,col)
2610 LOCal k,sq1
2620 FOR k=k1 TO k2
2630 sq1=sq0+m(k)
2640 IF board(sq1)=empty THEN move_list(top)=3:move_list(top+1)=sq0:move_list(top+2)=sq1:top=top+3
2650 END FOR k
2660 END DEFine 
2670 DEFine PROCedure print_board
2680 LOCal i,j,pb(78)
2690 FOR i=1 TO 78:pb(i)=bordr
2700 FOR i=6 TO 40:pb(2*i+(2*i-1) DIV 9-11)=board(i)
2710 PAPER 4:CLS:CSIZE 2,0:PRINT
2720 FOR i=1 TO 8
2730 INK 2:PRINT TO 5;CHR$(57-i);" ";
2740 FOR j=1 TO 8:PRINT piece$(pb(10*(i-1)+j));
2750 PRINT
2760 END FOR i
2770 INK 2:PRINT TO 5;"  A B C D E F G H":CSIZE 0,0
2780 END DEFine 
2910 DEFine FuNction piece$(type)
2920 SELect ON type
2930 =bordr:RETurn "  "
2940 =empty:INK 2:RETurn ". "
2950 =black:INK 0:RETurn "O "
2960 =bking:INK 0:RETurn "X "
2970 =white:INK 7:RETurn "O "
2980 =wking:INK 7:RETurn "X "
2990 END SELect 
3000 END DEFine 
3080 DEFine FuNction sgn(x):RETurn (x>0)-(x<0):END DEFine 
3400 DEFine FuNction evaluate(col)
3420 RETurn material(col)*wg1+advance(col)*wg2+centre(col)*wg3+fork(col)*wg4
3430 END DEFine 
3490 DEFine FuNction material(col)
3500 LOCal sq,value,piece
3510 value=0
3520 FOR sq=6 TO 40:piece=board(sq):value=value+(piece>0)-(piece<0)
3530 IF col=black THEN RETurn 3-value:ELSE RETurn value-3
3540 END DEFine 
3680 DEFine FuNction advance(col)
3690 LOCal sq,value
3700 value=0
3710 FOR sq=15 TO 22:IF board(sq)=col THEN value=value+col
3720 FOR sq=24 TO 31:IF board(sq)=col THEN value=value-col
3730 RETurn value
3740 END DEFine 
3760 DEFine FuNction centre(col)
3770 value=0
3780 FOR sq=16,17,20,21,25,6,29,30:IF sgn(board(sq))=col THEN value=value+1
3790 RETurn value
3800 END DEFine 
3850 DEFine FuNction fork(col)
3860 LOCal t_pres,j_pos,value
3870 value=0:t_pres=start
3880 REPeat search_moves
3890 j_pos=false
3900 IF t_pres>=top OR move_list(t_pres)=3 THEN EXIT search_moves
3920 j_pos=move_list(t_pres+1):t_pres=t_pres+move_list(t_pres)
3930 IF move_list(t_pres+1)=j_pos THEN 
3940 value=value+1
3950 REPeat next_piece:t_pres=t_pres+move_list(t_pres):IF move_list(t_pres+1)<>j_pos THEN EXIT next_piece
3960 END IF 
3970 END REPeat search_moves
3980 RETurn value
3990 END DEFine 
4120 DEFine FuNction minimax(col,level,pres)
4130 LOCal j,start,lt,score,high,m_len,sq0,sq1,piece
4140 IF level=1 THEN IF NOT generate_moves(col) THEN win_game -col
4160 IF level=1 THEN best=pres:PRINT #0,\TO 5;top;:ELSE PRINT #0;" [ ";
4165 lt=top:high=-9999
4170 REPeat scan_moves
4180 IF pres>=lt THEN EXIT scan_moves
4185 sq0=move_list(pres+1):piece=board(sq0)
4190 PRINT #0,!int_to_str$(sq0);
4200 make_move pres
4210 IF level>max_lev OR level MOD 2 AND quiescent THEN score=evaluate(col):ELSE score=minimax(-col,level+1,(start))
4220 m_len=move_list(pres):board(sq0)=piece
4230 FOR j=pres+2 TO pres+m_len-2 STEP 2:sq1=move_list(j):board((sq0+sq1)/2)=move_list(j+1):sq0=sq1
4240 board(move_list(j))=empty:top=start
4270 IF score>high THEN 
4280 high=score:IF level=1 THEN best=pres:PRINT #0,"x";
4290 IF level MOD 2=0 THEN IF high>ab(level) THEN PRINT #0," a]";:RETurn -high
4300 END IF 
4305 pres=pres+m_len
4310 END REPeat scan_moves
4320 PRINT #0," ]";:ab(level)=high:RETurn -high
4330 END DEFine 
4340 DEFine FuNction quiescent
4350 LOCal ans
4360 start=top:ans=NOT generate_moves(-col):ans=ans OR top=start OR move_list(start)=3:RETurn ans
4370 END DEFine 
5000 DEFine PROCedure load_game
5010 OPEN_IN #3,filename$
5020 INPUT #3,mess$:FOR i=1 TO 45:INPUT #3,board(i)
5030 CLOSE #3
5040 END DEFine 
5070 DEFine PROCedure save_game
5075 LOCal i
5080 OPEN_OVER #3,ram1_save_dr
5090 PRINT #3,mess$:FOR i=1 TO 45:PRINT #3,board(i)
5100 CLOSE #3
5110 END DEFine 
5120 DEFine PROCedure win_game(col)
5125 print_board:PAUSE 100
5130 CLS:CSIZE 2,1:AT 4,10
5140 IF col=black THEN PRINT "BLACK wins"
5150 IF col=white THEN PRINT "WHITE wins"
5160 STOP
5170 END DEFine 
