100 MODE 8
110 initialise
120 introduction
130 print_board
140 white_move
150 IF finish THEN GO TO 180
160 move%=move%+1:black_move
170 IF NOT finish THEN GO TO 140
180 ans$=fninput$(9,1)
190 IF ans$=="y" THEN GO TO 120
200 IF NOT ans$=="n" THEN GO TO 180
210 message 5,""
220 CLOSE #3:CLOSE #4:CLOSE #5:CLOSE #6:CLOSE #7
230 STOP
270 DEFine PROCedure initialise
280 LOCal i
290 black=1:white=2:colour=3
300 marker=4:liberty=8
310 DIM weight(255),grp_list(248)
320 DIM capture(4),cloc(4),tloc(4)
330 DIM m$(8)
340 read_messages
350 read_handicaps
360 read_patterns
370 DIM dir%(4)
390 dir%(1)=16:dir%(2)=1:dir%(3)=-16:dir%(4)=-1
400 END DEFine 
470 DEFine PROCedure read_messages
480 LOCal m
490 RESTORE 540
500 DIM mess$(9,42)
510 FOR m=0 TO 9:READ mess$(m)
540 DATA "THINKING: ","Illegal Entry: ","Stone already on point: "
550 DATA "Illegal. Ko on point: ","Illegal. Suicide on point: "
560 DATA "   O.K. GAME OVER","","How many handicap stones (2-9)?"
570 DATA "Type your move, PASS or QUIT :","Want to play again (Y/N)?"
580 END DEFine 
680 DEFine PROCedure read_handicaps
690 LOCal i
700 DIM hncp(43)
710 RESTORE 730
720 FOR i=0 TO 43:READ hncp(i)
730 DATA 68,204
740 DATA 68,204,76
750 DATA 68,204,76,196
760 DATA 68,204,76,196,136
770 DATA 68,204,76,196,132,140
780 DATA 68,204,76,196,132,140,136
790 DATA 68,204,76,196,132,140,72,200
800 DATA 68,204,76,196,132,140,72,200,136
810 END DEFine 
870 DEFine PROCedure read_patterns
880 LOCal i
890 DIM pat(23,2)
900 RESTORE 920
910 FOR i=0 TO 23:READ pat(i,0),pat(i,1),pat(i,2)
920 DATA 32,17,16,2,-15,1
930 DATA -32,-17,-16,-2,15,-1
940 DATA 33,16,17,31,16,15
950 DATA -33,-16,-17,-31,-16,-15
960 DATA -14,1,-15,18,1,17
970 DATA 14,-1,15,-18,-1,-17
980 DATA 48,33,32,48,17,16
990 DATA -48,-33,-32,-48,-17,-16
1000 DATA 3,-14,2,3,-15,1
1010 DATA -3,14,-2,-3,15,-1
1020 DATA 64,33,32,4,-14,2
1030 DATA -64,-33,-32,-4,14,2
1040 END DEFine 
1100 DEFine PROCedure read_weights
1110 LOCal a,b,c,d,x,y,v
1120 RESTORE 1200
1130 FOR y=1 TO 8
1140 FOR x=y TO 8
1150 a=16*y+x:b=16*x+y:c=16*y+16-x:d=16*x+16-y
1160 READ v:weight(a)=v:weight(b)=v:weight(c)=v:weight(d)=v
1170 weight(272-a)=v:weight(272-b)=v:weight(272-c)=v:weight(272-d)=v
1180 END FOR x
1190 END FOR y
1200 DATA 0,1,1,2,2,2,2,2
1210 DATA   4,5,5,4,4,3,3
1220 DATA     7,7,6,6,5,5
1230 DATA       7,6,5,5,4
1240 DATA         6,5,4,3
1250 DATA           4,3,2
1260 DATA             2,1
1270 DATA               0
1280 END DEFine 
1360 DEFine PROCedure introduction
1370 game_init
1380 set_screen
1390 END DEFine 
1430 DEFine PROCedure game_init
1440 read_weights
1450 location=0:move%=0
1460 ko=0:finish=0
1470 capture(1)=0:capture(2)=0
1480 DIM board(271):FOR x=0 TO 15:board(x)=colour:board(16*x)=colour:board(x+256)=colour
1490 END DEFine 
1530 DEFine PROCedure set_screen
1540 WINDOW 512,256,0,0:PAPER 0:CLS
1550 BLOCK 242,182,232,16,2
1560 OPEN #3,scr_230x170a238x22
1570 CSIZE #3,2,0:PAPER #3,1:INK #3,5:CLS #3
1580 PRINT #3,"  ABCDEFGHIJKLMNO  "
1590 FOR i=15 TO 1 STEP -1:i$=" "&i:PRINT #3,i$(LEN(i$)-1 TO);FILL$("+",15);i
1600 PRINT #3,"  ABCDEFGHIJKLMNO  "
1610 WINDOW #3,182,150,262,32
1620 PAPER #3,4:INK #3,6:CLS #3
1630 FOR i=1 TO 15:PRINT #3,FILL$("+",15)
1640 BLOCK 194,54,32,16,2
1650 OPEN #4,scr_182x42a38x22
1660 CSIZE #4,2,0:PAPER #4,1:CLS #4
1670 BLOCK 194,122,32,76,2
1680 OPEN #5,scr_182x110a38x82
1690 PAPER #5,1:CLS #5:PRINT #5,"     MOVES"
1700 CSIZE #5,2,0:UNDER #5,1
1710 PRINT #5,"No. Black White":UNDER #5,0
1720 WINDOW #5,182,90,38,102
1730 BLOCK 442,24,32,202,2
1740 OPEN #6,con_430x12a38x208_5
1750 CSIZE #6,2,0:PAPER #6,1:CLS #6
1760 BLOCK 442,24,32,230,2
1770 OPEN #7,scr_430x12a38x236
1780 CSIZE #7,2,0:PAPER #7,1:CLS #7:FLASH #7,1:INK #7,3
1790 hand=fninput$(7,1)
1800 IF hand<2 OR hand>9 THEN GO TO 1790
1810 handicap hand
1820 INK #5,5:PRINT #5,"  1 ";
1830 INK #5,0:PRINT #5,"Hncp ";
1840 END DEFine 
1970 DEFine PROCedure handicap(hand)
1980 LOCal i,q
1990 q=INT((hand-2)/2*(hand+1)+.5)
2000 FOR i=q TO q+hand-1:board(hncp(i))=black
2010 END DEFine 
2070 DEFine PROCedure print_board
2080 LOCal p,x,y
2090 CLS #7
2100 AT #4,0,0:INK #4,5:PRINT #4,"Stones Captured"
2110 c1$="   "&capture(1):c2$="   "&capture(2)
2120 INK #4,7:PRINT #4,\" by WHITE:";c2$(LEN(c2$)-3 TO)
2130 INK #4,0:PRINT #4," by BLACK:";c1$(LEN(c1$)-3 TO);
2140 CLS #3
2150 FOR y=15 TO 1 STEP -1
2160 FOR x=1 TO 15:p=board(16*y+x)+1:INK #3,"607"(p):PRINT #3,"+OO"(p);
2170 END FOR y
2180 END DEFine 
2280 DEFine FuNction fninput$(m,w)
2290 LOCal s,a$,i$
2300 a$="":s=0:Q_CURSON #6
2310 CLS #6::INK #6,5:PRINT #6,mess$(m);" ";:INK #6,7:PRINT #6,a$;
2320 i$=INKEY$(#6,-1):i=CODE(i$)
2360 IF i=10 THEN GO TO 2530
2370 IF i<>194 THEN GO TO 2450
2380 IF s>0 THEN s=s-1:a$=a$(1 TO s):GO TO 2310:ELSE GO TO 2320
2450 IF i>=96 AND i<123 THEN i$=CHR$(i-32)
2460 IF s<w THEN s=s+1:a$=a$&i$:PRINT #6,i$;
2470 GO TO 2320
2530 IF s=0 THEN GO TO 2310
2540 Q_CURSOFF #6:RETurn a$
2550 END DEFine 
2580 DEFine PROCedure message(m,a$)
2590 CLS #7:PRINT #7,mess$(m);a$:BEEP 200,3
2600 END DEFine 
2640 DEFine FuNction fnint_to_char$(p)
2650 IF p<0 THEN RETurn "Pass "
2660 m$=" "&CHR$(p MOD 16+64)&(p DIV 16)&atari$&"  "
2670 RETurn m$(1 TO 5)
2680 END DEFine 
2720 DEFine PROCedure white_move
2730 LOCal c,i,p,x,y,a$,c$,y$
2740 a$=fninput$(8,4):w$=a$
2750 IF a$=="PASS" THEN ko=0:p=-1:GO TO 2880
2760 IF a$=="QUIT" THEN finish=1:GO TO 2900
2770 IF LEN(a$)<2 THEN message 1,a$:GO TO 2740
2780 x=CODE(a$)-64:y$=a$(2 TO)
2790 FOR c=1 TO LEN(y$):IF y$(c) INSTR "0123456789"=0 THEN message 1,a$:GO TO 2740
2830 y=y$
2840 IF x<1 OR x>15 OR y<1 OR y>15 THEN message 1,a$:GO TO 2740
2850 p=16*y+x:i=legality(p,white)
2860 IF i>0 THEN message i,a$:GO TO 2740
2870 make_move p,white
2880 message 0,""
2890 INK #5,7:PRINT #5,!fnint_to_char$(p)
2900 END DEFine 
2940 DEFine PROCedure black_move
2950 bl=0
2960 group_evaluation
2970 IF bl=0 THEN defend_connection
2980 IF bl=0 THEN attack_connection
2990 IF bl=0 THEN start_attack
3000 IF bl=0 THEN start_connection
3010 IF bl=0 THEN find_any_move
3020 IF bl=0 THEN bl=-1:ELSE make_move bl,black
3030 n$="  "&move%:BEEP 3000,90
3040 INK #5,5:PRINT #5,n$(LEN(n$)-2 TO);" ";
3050 INK #5,0:PRINT #5,fnint_to_char$(bl);
3060 END DEFine 
3110 DEFine PROCedure group_evaluation
3115 message 0,"Group Evaluation"
3120 hi=-999:DIM checked(255)
3130 FOR gp=17 TO 255
3135 IF checked(gp) THEN NEXT gp:GO TO 3270
3140 gc=board(gp):IF gc=0 OR gc=colour THEN NEXT gp:GO TO 3270
3150 count gp,gc
3160 IF clib>2 THEN NEXT gp:GO TO 3270
3170 tloc(1)=cloc(1):tloc(2)=cloc(2):gl=clib:gs=cstn
3180 FOR gq=1 TO gl
3190 IF legality(tloc(gq),black)>0 THEN NEXT gq:GO TO 3250
3200 score=(8*gs/gl-clib+2*gl)
3210 IF gc=black THEN 
3215 gb=cloc(1):IF clib<gl OR board(gb)>0 THEN NEXT gq:GO TO 3250
3220 ga=tloc(gq):board(ga)=black:board(gb)=white
3225 count ga,black:board(ga)=0:board(gb)=0
3230 IF clib+RND(1)<=gl THEN NEXT gq:GO TO 3250
3235 END IF 
3240 IF score>hi THEN hi=score:bl=tloc(gq)
3250 END FOR gq
3270 END FOR gp
3280 END DEFine 
3320 DEFine PROCedure find_any_move
3325 message 0,"Find Any Move"
3330 hi=-999
3340 FOR gl=17 TO 255
3350 score=RND+weight(gl)
3360 IF board(gl)=0 AND score>hi THEN 
3370 IF legality(gl,black)=0 AND clib>2 THEN hi=score:bl=gl
3380 END IF 
3390 END FOR gl
3400 END DEFine 
3440 DEFine PROCedure defend_connection
3445 message 0,"Defend Connection"
3450 h=-999
3470 FOR gl=1 TO 255
3480 IF (board(gl)&&black)=0 THEN NEXT gl:GO TO 3620
3490 FOR pt=0 TO 23
3500 IF (board((gl+pat(pt,1)) MOD 256)&&white)=0 THEN NEXT pt:GO TO 3600
3510 IF (board((gl+pat(pt,0)) MOD 256)&&black)=0 THEN NEXT pt:GO TO 3600
3520 gd=(gl+pat(pt,2)) MOD 256:score=RND+weight(gd)
3530 IF board(gd)=0 AND score>hi THEN 
3540 IF legality(gd,black)=0 AND clib>2 THEN hi=score:bl=gd
3550 END IF 
3600 END FOR pt
3620 END FOR gl
3640 END DEFine 
3680 DEFine PROCedure attack_connection
3685 message 0,"Attack Connection"
3690 hi=-999
3710 FOR gl=1 TO 255
3720 IF (board(gl)&&white)=0 THEN NEXT gl:GO TO 3860
3730 FOR pt=0 TO 23
3740 IF (board((gl+pat(pt,1)) MOD 256)&&black)=0 THEN NEXT pt:GO TO 3840
3750 IF (board((gl+pat(pt,0)) MOD 256)&&white)=0 THEN NEXT pt:GO TO 3840
3760 gd=(gl+pat(pt,2)) MOD 256:score=RND+weight(gd)
3770 IF board(gd)=0 AND score>hi THEN 
3780 IF legality(gd,black)=0 AND clib>2 THEN hi=score:bl=gd
3790 END IF 
3840 END FOR pt
3860 END FOR gl
3880 END DEFine 
3920 DEFine PROCedure start_attack
3925 message 0,"Attack Connection - Start"
3930 hi=-999
3940 FOR gl=17 TO 255
3950 IF board(gl)<>white THEN NEXT gl:GO TO 4090
3960 FOR pt=0 TO 23
3965 gd=board((gl+pat(pt,2)) MOD 256)
3970 IF gd=black OR gd=white THEN NEXT pt:GO TO 4070
3980 IF board((gl+pat(pt,0)) MOD 256)<>white THEN NEXT pt:GO TO 4070
3990 gc=(gl+pat(pt,1)) MOD 256:score=RND+weight(gc)
4000 IF board(gc)=0 AND score>hi THEN 
4010 IF legality(gc,black)=0 AND clib>2 THEN hi=score:bl=gc
4020 END IF 
4070 END FOR pt
4090 END FOR gl
4100 END DEFine 
4140 DEFine PROCedure start_connection
4145 message 0,"Start New Connection"
4150 hi=-999
4160 FOR gl=17 TO 255
4170 IF board(gl)<>black THEN NEXT gl:GO TO 4300
4180 FOR pt=0 TO 23
4185 gd=board((gl+pat(pt,2)) MOD 256)
4190 IF gd=black OR gd=white THEN NEXT pt:GO TO 4280
4200 gb=(gl+pat(pt,0)) MOD 256:score=RND+weight(gb)
4210 IF board(gb)=0 AND score>hi THEN 
4220 IF legality(gb,black)=0 AND clib>2 THEN hi=score:bl=gb
4230 END IF 
4280 END FOR pt
4300 END FOR gl
4310 END DEFine 
4350 DEFine PROCedure make_move(p,c)
4360 LOCal a,n,i
4370 n=0:atari$=" ":board(p)=c
4380 FOR a=p-1,p+1,p-16,p+16
4400 IF board(a)<>colour-c THEN NEXT a:GO TO 4440
4410 count a,colour-c
4420 IF clib=0 THEN ko=a:n=n+cstn:remove
4430 IF clib=1 THEN atari$="+"
4440 END FOR a
4450 IF n<>0 THEN ko=0
4460 capture(c)=capture(c)+n
4465 c1$="   "&capture(1):c2$="   "&capture(2):CLS #7
4470 AT #4,2,10:INK #4,7:PRINT #4,c2$(LEN(c2$)-3 TO)
4475 AT #4,3,10:INK #4,0:PRINT #4,c1$(LEN(c1$)-3 TO);
4480 AT #3,15-p DIV 16,p MOD 16-1:INK #3,"07"(c):PRINT #3,"O";
4490 END DEFine 
4540 DEFine PROCedure remove
4550 LOCal i,p
4560 FOR i=1 TO cstn
4570 p=grp_list(i):board(p)=0
4575 AT #3,15-p DIV 16,p MOD 16-1:INK #3,6:PRINT #3,"+";
4580 END FOR i
4590 END DEFine 
4660 DEFine FuNction legality(p,c)
4670 LOCal a,k,s,i,checked(271)
4680 IF board(p) THEN RETurn 2
4690 s=0:k=0:board(p)=c
4700 FOR a=p-1,p+1,p-16,p+16
4720 IF board(a)=colour-c AND checked(a)=0 THEN count a,colour-c:k=k+cstn*(clib=0)
4730 END FOR a
4740 IF k=0 THEN count p,c:IF clib=0 THEN s=4
4750 board(p)=0
4760 IF p=ko AND k=1 THEN RETurn 3:ELSE RETurn s
4770 END DEFine 
4890 DEFine PROCedure count(p,c)
4895 LOCal i,gl,gp,inspect(271)
4900 clib=0:cstn=0:DIM cloc(6)
4910 IF board(p)=0 THEN RETurn 
4915 cstn=1:grp_list(cstn)=p:inspect(p)=1:i=1
4920 REPeat piece
4930 IF i>cstn THEN RETurn 
4940 gl=grp_list(i)
4950 FOR gp=gl-1,gl+1,gl-16,gl+16
4960 IF inspect(gp)=0 THEN inspect(gp)=1:ELSE NEXT gp:GO TO 5000
4970 IF board(gp)=0 THEN clib=clib+1:cloc(clib)=gp:NEXT gp:GO TO 5000
4980 IF board(gp)<>c THEN NEXT gp:GO TO 5000
4990 cstn=cstn+1:grp_list(cstn)=gp:checked(gp)=1
5000 END FOR gp
5010 IF clib>2 THEN RETurn 
5020 i=i+1
5030 END REPeat piece
5040 END DEFine 
