bill@dual.UUCP (06/12/84)
> The software won't let me post it to net.games.go, so I'm sending > it as mail. I'm a very new user of this system. Hope you will > know what to do with it. Enjoy. > --George Acton I am posting this for George Action with his ok. Any questions should be sent to Mr. Action. I do not know if this works nor do I make any claims as to its function or ownership. You can contact Mr. Action at proper!gsa. Have fun, Bill Kanawyer {ucbvax,amd70,ihnp4,cbosgd,decwrl,fortune,zehntel,hplabs,sun}!dual!bill = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 1000 ' GO.BAS -- a program for go on the Macintosh 1010 ' 1020 ' by George Acton, Compuserve 73026,2663 1030 ' 1040 ' Copyright (c) 1984 -- George Acton, Shreveport, La. 1050 ' Permission is hereby granted for personal, non-commercial 1060 ' reproduction and use of this program, provided that this notice 1070 ' is included in any copy. 1080 ' 10000 ' 10010 ' setup 10020 ' 10030 CLEAR,20000 10040 DEFINT A-Z 10050 SENTE=1 10060 CALL TEXTSIZE(14): CALL TEXTFONT(2) 10070 DIM BOARD(19,19), CBOARD(19,19) 10080 DIM FIRST(500), REST(500) 10090 DIM SENTEREC(500), MOVREC(500), CAPREC(500) 10100 DIM BS(50), WS(50) 11000 ' 11010 ' main loop 11020 ' 11030 GOSUB 54000 11040 FREE=1 11050 GOSUB 11060: GOTO 11050 11060 ' 11070 ' input 11080 ' 11090 GOSUB 50000 11100 IF PFLAG=1 THEN LINE (300,0)-(512,400),30,BF 11110 ON INFLAG GOSUB 20000,30000: RETURN 20000 ' 20010 ' command 20020 ' 20030 IF K$="h" THEN GOSUB 21000: RETURN 20040 IF K$="?" THEN GOSUB 21000: RETURN 20050 IF K$="i" THEN GOSUB 29000: RETURN 20060 IF K$="b" THEN GOSUB 22000: RETURN 20070 IF K$="w" THEN GOSUB 22080: RETURN 20080 IF K$="d" THEN GOSUB 23000: RETURN 20090 IF K$="s" THEN GOSUB 24000: RETURN 20100 IF K$="r" THEN GOSUB 24150: RETURN 20110 IF K$="c" THEN GOSUB 28000: RETURN 20120 IF K$="-" THEN GOSUB 26000: RETURN 20130 IF K$="+" THEN GOSUB 27000: RETURN 20140 IF K$="q" THEN SYSTEM 20150 MESS$="h for help": RETURN 21000 ' 21010 ' help screen 21020 ' 21030 CALL MOVETO(300,45): PRINT "b place black stones"; 21040 CALL MOVETO(300,65): PRINT "w place white stones"; 21050 CALL MOVETO(300,85): PRINT"d remove stones"; 21060 CALL MOVETO(300,105): PRINT "- retract move"; 21070 CALL MOVETO(300,125): PRINT"+ advance move"; 21080 CALL MOVETO(300,145): PRINT "c count board"; 21090 CALL MOVETO(300,165): PRINT "s save position"; 21100 CALL MOVETO(300,185): PRINT "r recall position"; 21110 CALL MOVETO(300,205): PRINT"i initialize"; 21120 RETURN 22000 ' 22010 ' place black stones 22020 ' 22030 MESS$="place black stones": GOSUB 50500: COLOR=1 22040 GOSUB 50000: IF INFLAG=1 THEN GOTO 23100 22050 GOSUB 51000: IF P=0 THEN GOTO 23100 22060 MOV=P: GOSUB 60000: BOARD(X,Y)=COLOR: GOSUB 56000: GOSUB 30170 22070 GOTO 22040 22080 ' 22090 MESS$="place white stones": GOSUB 50500: COLOR=-1 22100 GOTO 22040 23000 ' 23010 ' remove stones 23020 ' 23030 MESS$="removing dead stones": GOSUB 50500 23040 GOSUB 50000: IF INFLAG=1 THEN GOTO 23100 23050 GOSUB 51000: IF P=0 THEN GOTO 23100 23060 COLOR=BOARD(X,Y): BOARD(X,Y)=0: GOSUB 55000 23070 MOV=0: FIRST(FREE)=P: REST(FREE)=0: CAPLIST=FREE: FREE=FREE+1 23080 COLOR=-COLOR: GOSUB 30170 23090 GOTO 23040 23100 LINE (300,0)-(512,400),30,BF: RETURN 24000 ' 24010 ' save position 24020 ' 24030 MESS$="file name?": GOSUB 50500 24040 CALL MOVETO(300,65): INPUT F$: IF F$="" THEN 24040 24050 OPEN F$ FOR OUTPUT AS #1 24060 FOR I=1 TO MOVNUM 24070 PRINT #1, STR$(SENTEREC(I)) 24080 PRINT #1, STR$(MOVREC(I)) 24090 TEMP=CAPREC(I) 24100 WHILE TEMP<>0 24110 PRINT #1, STR$(FIRST(TEMP)): TEMP=REST(TEMP) 24120 WEND 24130 PRINT #1, STR$(0) 24140 NEXT I: CLOSE #1: RETURN 24150 ' 24160 ' retrieve file 24170 ' 24180 MESS$="file name?": GOSUB 50500 24190 CALL MOVETO(300,65): INPUT F$: IF F$="" THEN 24190 24200 GOSUB 29000 ! INITIALIZE BOARD 24210 OPEN F$ FOR INPUT AS #1 24220 WHILE NOT EOF(1): MOVNUM=MOVNUM+1 24230 INPUT #1, A$: SENTEREC(MOVNUM)=VAL(A$) 24240 INPUT #1,A$: :MOVREC(MOVNUM)=VAL(A$) 24250 INPUT #1,A$: V=VAL(A$): IF V=0 THEN 24290 24260 FIRST(FREE)=V: REST(FREE)=CAPREC(MOVNUM) 24270 CAPREC(MOVNUM)=FREE: FREE=FREE+1 24280 GOTO 24250 24290 WEND 24300 CLOSE #1: GOSUB 25040: RETURN 25000 ' 25010 ' restore board 25020 ' 25030 GOSUB 54000 25040 FOR K=1 TO 19: FOR L=1 TO 19: BOARD(K,L)=0: NEXT L: NEXT K 25050 BDEAD=0: WDEAD=0 25060 FOR M=1 TO MOVNUM 25070 COLOR=SENTEREC(M) 25080 P=MOVREC(M) 25090 CAPLIST=CAPREC(M) 25100 GOSUB 52000 25110 NEXT M 25120 RETURN 26000 ' 26010 ' retract move 26020 ' 26030 IF MOVNUM=0 THEN RETURN 26040 CAPLIST=CAPREC(MOVNUM): P=MOVREC(MOVNUM) 26050 COLOR=-SENTEREC(MOVNUM): GOSUB 53000 26060 MOVNUM=MOVNUM-1 :RETURN 27000 ' 27010 ' advance move 27020 ' 27030 IF SENTEREC(MOVNUM+1)=0 THEN RETURN 27040 MOVNUM=MOVNUM+1 27050 CAPLIST=CAPREC(MOVNUM): P=MOVREC(MOVNUM) 27060 COLOR=SENTEREC(MOVNUM): GOSUB 52000 27070 RETURN 28000 ' 28010 ' count board 28020 ' 28030 FOR K=1 TO 19: FOR L=1 TO 19: CBOARD(K,L)=0: NEXT L: NEXT K 28040 MESS$="counting": GOSUB 50500 28050 BCOUNT=0: WCOUNT=0: OFREE=FREE 28060 FOR L=1 TO 19: FOR K=1 TO 19 28070 IF CBOARD(K,L)<>0 THEN GOTO 28100 28080 IF BOARD(K,L)<>0 THEN GOTO 28100 28090 GOSUB 28500 28100 NEXT K: NEXT L 28110 LINE (300,0)-(512,400),30,BF 28120 CALL MOVETO (300,65): PRINT " B W"; 28130 CALL MOVETO (300,85): PRINT "prisoners"; 28140 CALL MOVETO (365,85): PRINT USING "#####";WDEAD,BDEAD 28150 CALL MOVETO(300,105): PRINT "land" 28160 CALL MOVETO(365,105): PRINT USING "#####";BCOUNT, WCOUNT 28170 CALL MOVETO(300,125): PRINT "score"; 28180 CALL MOVETO(365,125): PRINT USING "#####";WDEAD+BCOUNT, BDEAD+WCOUNT 28220 FREE=OFREE: PFLAG=1: RETURN 28500 ' 28510 ' mark and count one group of empty points based on k,l 28520 ' 28530 BFLAG=0: WFLAG=0 28540 COUNT=1: CBOARD(K,L)=1 28550 FIRST(FREE)=K+19*(L-1): REST(FREE)=0 28560 QLIST=FREE: FREE=FREE+1 28570 WHILE QLIST<>0 28580 P=FIRST(QLIST): QLIST=REST(QLIST) 28590 GOSUB 60000 28610 FOR N=4 TO 1 STEP -1: GOSUB 61000 28620 IF NB=0 THEN GOTO 28700 28630 IF CBOARD(NBX,NBY)<>0 THEN GOTO 28700 28640 IF BOARD(NBX,NBY)=1 THEN BFLAG=1: GOTO 28700 28650 IF BOARD(NBX,NBY)=-1 THEN WFLAG=1: GOTO 28700 28660 COUNT=COUNT+1: CBOARD(NBX,NBY)=1 28680 FIRST(FREE)=NB: REST(FREE)=QLIST 28690 QLIST=FREE: FREE=FREE+1 28700 NEXT N 28710 WEND 28720 ' 28730 IF (BFLAG=1 AND WFLAG=1) THEN 28750 28740 IF BFLAG=1 THEN BCOUNT=BCOUNT+COUNT ELSE WCOUNT=WCOUNT+COUNT 28750 RETURN 29000 ' 29010 ' initialize 29020 ' 29030 FREE=1: MOVNUM=0 29040 GOSUB 54000 29050 FOR K=1 TO 19: FOR L=1 TO 19: BOARD(K,L)=0: NEXT L: NEXT K 29060 FOR K=1 TO 500: FIRST(K)=0: REST(K)=0: NEXT K 29070 FOR K=1 TO 500: SENTEREC(K)=0: MOVREC(K)=0: CAPREC(K)=O: NEXT K 29080 RETURN 30000 ' 30010 ' main loop for move 30020 ' 30030 IF MOVNUM=0 THEN SENTE=1 ELSE SENTE=-SENTEREC(MOVNUM) 30040 GOSUB 51000: IF P=0 THEN RETURN ELSE MOV=P 30050 IF BOARD(X,Y)=0 THEN 30070 30060 MESS$="point occupied": GOSUB 50500: RETURN 30070 GOSUB 31000 30080 IF CAPLIST>0 THEN 30120 30090 IF MLIB>0 THEN 30120 30100 GOSUB 32000: IF SUICIDE=0 THEN 30120 30110 MESS$="suicide": GOSUB 50500: RETURN 30120 GOSUB 33000: IF KO=0 THEN 30150 30130 MESS$="ko": GOSUB 50500: RETURN 30140 ' 30150 COLOR=SENTE: GOSUB 52000 ' change screen and board 30160 ' 30170 MOVNUM=MOVNUM+1: SENTEREC(MOVNUM)=COLOR 30180 MOVREC(MOVNUM)=MOV: CAPREC(MOVNUM)=CAPLIST 30190 SENTEREC(MOVNUM+1)=0 30200 ' 30210 RETURN 31000 ' 31010 ' evaluate move for capture 31020 ' 31030 CAPLIST=0: GPCOLOR=-SENTE 31040 BOARD(X,Y)=SENTE: MLIB=0 31050 FOR N=1 TO 4: GOSUB 61000: IF NB=0 THEN 31120 31060 B=BOARD(NBX,NBY) 31070 IF B=0 THEN MLIB=MLIB+1: GOTO 31120 31080 IF B=SENTE THEN GOTO 31120 31090 BIGLIST=CAPLIST: ITEM=NB: GOSUB 36000 31100 IF MEMBER=1 THEN 31120 31110 GOSUB 35000: IF LIBERTY=0 THEN GOSUB 37000 31120 NEXT N 31130 BOARD(X,Y)=0: RETURN 32000 ' 32010 ' check for suicide 32020 ' 32030 BOARD(X,Y)=SENTE 32040 XSAV=X: YSAV=Y 32050 NB=X+19*(Y-1) 32060 NBX=X: NBY=Y: NB=P: GPCOLOR=SENTE:GOSUB 35000 32070 X=XSAV: Y=YSAV 32080 IF LIBERTY=0 THEN SUICIDE=1: BOARD(X,Y)=0: RETURN 32090 SUICIDE=0: RETURN 32100 X=SAVX: Y=SAVY: N=SAVN 32110 RETURN 33000 ' 33010 ' check for ko 33020 ' 33030 KO=0 33040 IF (CAPLIST=0 OR CAPREC(MOVNUM)=0) THEN RETURN 33050 IF (REST(CAPLIST)<>0 OR REST(CAPREC(MOVNUM))<>0) THEN RETURN 33060 IF FIRST(CAPLIST)<>MOVREC(MOVNUM) THEN RETURN 33070 IF MOV<>FIRST(CAPREC(MOVNUM)) THEN RETURN 33080 KO=1: RETURN 35000 ' 35010 ' determine survival of a group of stones 35020 ' 35030 GPLIST=0:SAVP=P: SAVX=X: SAVY=Y: SAVN=N: LIBERTY=0 35040 OFREE=FREE 35050 FIRST(FREE)=NB: REST(FREE)=0 35060 QLIST=FREE: FREE=FREE+1 35070 WHILE (QLIST<>0 AND LIBERTY=0) 35080 P=FIRST(QLIST): QLIST=REST(QLIST) 35090 TEST=P 35100 GOSUB 60000 35110 FOR N=1 TO 4: GOSUB 61000 35120 IF NB=0 THEN GOTO 35240 35130 B=BOARD(NBX,NBY) 35140 IF B=0 THEN LIBERTY=LIBERTY+1: GOTO 35240 35150 IF B=-GPCOLOR THEN GOTO 35240 35160 ' 35170 BIGLIST=QLIST: ITEM=NB: GOSUB 36000 35180 IF MEMBER=1 THEN 35240 35190 BIGLIST=GPLIST: ITEM=NB: GOSUB 36000 35200 IF MEMBER=1 THEN 35240 35210 FIRST(FREE)=NB: REST(FREE)=QLIST 35220 QLIST=FREE: FREE=FREE+1 35230 ' 35240 NEXT N 35250 IF LIBERTY<>0 THEN 35280 35260 FIRST(FREE)=TEST: REST(FREE)=GPLIST 35270 GPLIST=FREE: FREE=FREE+1 35280 WEND 35290 IF LIBERTY<>0 THEN FREE=OFREE 35300 P=SAVP:X=SAVX: Y=SAVY: N=SAVN 35310 RETURN 36000 ' 36010 ' determine membership 36020 ' 36030 TESTLIST=BIGLIST 36040 WHILE TESTLIST<>0 36050 IF ITEM=FIRST(TESTLIST) THEN MEMBER=1: RETURN 36060 TESTLIST=REST(TESTLIST) 36070 WEND 36080 MEMBER=0: RETURN 37000 ' 37010 ' append gplist to caplist 37020 ' 37030 IF CAPLIST=0 THEN CAPLIST=GPLIST: RETURN 37040 LAST=CAPLIST 37050 WHILE REST(LAST)<>0: LAST=REST(LAST): WEND 37060 REST(LAST)=GPLIST 37070 RETURN 50000 ' 50010 ' wait for input 50020 ' 50030 INFLAG=0: DUMMY=MOUSE(0) 50040 WHILE INFLAG=0 50050 K$=INKEY$: IF K$<>"" THEN INFLAG=1: RETURN 50060 M=MOUSE(0): IF M<>0 THEN INFLAG=2: RETURN 50070 WEND: RETURN 50500 ' 50510 ' print message 50520 ' 50530 CALL MOVETO(300,45): PRINT MESS$: PFLAG=1: RETURN 51000 ' 51010 ' get point from mouse 51020 ' 51030 WHILE MOUSE(0)<>0: WEND 51040 X=INT((MOUSE(1)+7)/14) 51050 Y=INT((MOUSE(2)+7)/14) 51060 IF X<1 OR X >19 THEN P=0: RETURN 51070 IF Y<1 OR Y>19 THEN P=0: RETURN 51080 P=X+19*(Y-1) 51090 RETURN 52000 ' 52010 ' execute move 52020 ' 52030 IF P=0 THEN 52050 52040 GOSUB 60000: BOARD(X,Y)=COLOR: GOSUB 56000 52050 RESTCAP=CAPLIST 52060 WHILE RESTCAP<>0 52070 P=FIRST(RESTCAP): RESTCAP=REST(RESTCAP) 52080 GOSUB 60000 52090 BOARD(X,Y)=0: GOSUB 55000 52100 IF COLOR=1 THEN WDEAD=WDEAD+1 ELSE BDEAD=BDEAD+1 52110 WEND 52120 RETURN 53000 ' 53010 ' retract move 53020 ' 53030 PSAV=P 53040 WHILE CAPLIST<>0 53050 P=FIRST(CAPLIST): CAPLIST=REST(CAPLIST) 53060 GOSUB 60000 53070 BOARD(X,Y)=COLOR: GOSUB 56000 53080 IF COLOR=1 THEN BDEAD=BDEAD-1 ELSE WDEAD=WDEAD-1 53090 WEND 53100 P=PSAV: IF P=0 THEN RETURN 53110 GOSUB 60000:BOARD(X,Y)=0: GOSUB 55000 53120 RETURN 54000 ' 54010 ' draw screen 54020 ' 54030 CLS 54040 CIRCLE(10,10),7,33 54050 GET (3,3)-(17,17),WS 54060 FOR I=0 TO 7: CIRCLE(10,10),I,33: NEXT I 54070 GET (3,3)-(17,17),BS 54080 CLS 54090 FOR I=1 TO 19 54100 LINE(14,14*I)-(266,14*I) 54110 LINE(14*I,14)-(14*I,266) 54120 NEXT I 54130 FOR I=4 TO 16 STEP 6:FOR J=4 TO 16 STEP 6 54140 CIRCLE(14*I,+14*J),1,33 54150 NEXT J: NEXT I 54160 RETURN 55000 ' 55010 ' delete a stone 55020 ' 55030 LINE(7+14*(X-1),7+14*(Y-1))-(21+14*(X-1),21+14*(Y-1)),30,BF 55040 CLEFT=7: CRIGHT=7: CUP=7: CDOWN=7 55050 IF X=1 THEN CLEFT=0 55060 IF X=19 THEN CRIGHT=0 55070 IF Y=1 THEN CUP=0 55080 IF Y=19 THEN CDOWN=0 55090 LINE(14-CLEFT+14*(X-1),14+14*(Y-1))-(14+CRIGHT+14*(X-1),14+14*(Y-1)) 55100 LINE(14+14*(X-1),14-CUP+14*(Y-1))-(14+14*(X-1),14+CDOWN+14*(Y-1)) 55110 IF (X=4 OR X=10 OR X=16) THEN 55120 ELSE 55150 55120 IF (Y=4 OR Y=10 OR Y=16) THEN 55130 ELSE 55150 55130 CIRCLE(14*X,14*Y),1,33 55140 ' 55150 XSAVD=X: YSAVD=Y: NSAVD=N: PSAVD=P: CSAVD=COLOR 55160 FOR N=1 TO 4: GOSUB 61000 55170 IF NB=0 THEN 55200 55180 COLOR=BOARD(NBX,NBY): IF COLOR=0 THEN 55200 55190 CIRCLE (14+14*(NBX-1),14+14*(NBY-1)),7,33 55200 NEXT N 55210 X=XSAVD: Y=YSAVD: N=NSAVD: P=PSAVD: COLOR=CSAVD 55220 RETURN 56000 ' 56010 ' put stone on screen 56020 ' 56030 IF COLOR=-1 THEN 56070 56040 PUT (7+14*(X-1),7+14*(Y-1)),BS,PSET 56050 RETURN 56060 REM 56070 PUT (7+14*(X-1),7+14*(Y-1)),WS,PSET 56080 RETURN 60000 X=P MOD 19: IF X=0 THEN X=19 60010 Y=(P-X+19)/19: RETURN 61000 ON N GOTO 61010,61020,61030, 61040 61010 IF X=1 THEN NB=0: RETURN ELSE NB=P-1:NBX=X-1: NBY=Y: RETURN 61020 IF X=19 THEN NB=0: RETURN ELSE NB=P+1:NBX=X+1: NBY=Y: RETURN 61030 IF Y=1 THEN NB=0: RETURN ELSE NB=P-19: NBX=X: NBY=Y-1: RETURN 61040 IF Y=19 THEN NB=0: RETURN ELSE NB=P+19:NBX=X: NBY=Y+1: RETURN