games-request@tekred.TEK.COM (03/10/88)
Submitted by: Fred Hansen <wjh+@andrew.cmu.edu>
Comp.sources.games: Volume 3, Issue 97
Archive-name: go/Part01
[Here's a good project for a go or Pascal lover. As noted
in the README file, this will take some some work to get
it running on Unix. If somewon takes up the challenge,
please send me your results so I can share them with
the rest of the net. -br
P.S. Three of the files have ^G characters in them. If they
unpack with errors, look for the comment "control-G" and fix
the "write('');" to be "write('^G');".]
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 1 (of 5)."
# Contents: README MANIFEST goCom.pas goPlayUtils.pas
# Wrapped by billr@saab on Wed Mar 9 09:14:43 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f README -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"README\"
else
echo shar: Extracting \"README\" \(597 characters\)
sed "s/^X//" >README <<'END_OF_README'
XThis go board manager and rudimentary go player was written by
XStoney Ballard at Perq Systems in 1983-1984. It is written in
XPerq Pascal and utilizes some Perq libraries for I/O. The code
Xis offered here if someone is interested to convert it to Unix.
X
XThe wonderful part about it is that a game is recorded as a tree
Xand can be played forward or backward, branching at any point
Xwhere there were alternate moves.
X
XFor some time, this program was also used to generate the go
Xboards displayed in the American Go Journal. For this it used
Xsome large font digits which are now lost.
X
XFred Hansen
END_OF_README
if test 597 -ne `wc -c <README`; then
echo shar: \"README\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f MANIFEST -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"MANIFEST\"
else
echo shar: Extracting \"MANIFEST\" \(414 characters\)
sed "s/^X//" >MANIFEST <<'END_OF_MANIFEST'
X File Name Archive # Description
X-----------------------------------------------------------
X MANIFEST 1 This shipping list
X README 1
X go.pas 4
X goBoard.pas 3
X goCom.pas 1
X goMenu.pas 5
X goMgr.pas 4
X goPlayUtils.pas 1
X goPlayer.pas 2
X goTree.pas 3
END_OF_MANIFEST
if test 414 -ne `wc -c <MANIFEST`; then
echo shar: \"MANIFEST\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f goCom.pas -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"goCom.pas\"
else
echo shar: Extracting \"goCom.pas\" \(3924 characters\)
sed "s/^X//" >goCom.pas <<'END_OF_goCom.pas'
X{---------------------------------------------------------------------------}
X{ goCom.Pas }
X{ }
X{ Common Data for Go }
X{ Copyright (c) 1982 by Three Rivers Computer Corp. }
X{ }
X{ Written: June 3, 1982 by Stoney Ballard }
X{ Edit History: }
X{ June 3, 1982 Started }
X{ June 4, 1982 Add dead group removal }
X{ June 10, 1982 Use new go file manager }
X{ Nov 9, 1982 Split From Go.Pas }
X{ V3.5 - Jan 11, 1983 Fixed bug in printer that screwed capture count }
X{ V3.6 - Jan 14, 1983 Changed Scoring and board coordinates to conform to }
X{ tournament rules }
X{ V3.7 - Jan 17, 1983 added computer player!!!! }
X{ V3.8 - Mar 8, 1983 Added PrintDiagram }
X{ Made board 34 grid for printing }
X{ V3.9 - May 3, 1983 Add board print size switch and command }
X{---------------------------------------------------------------------------}
X
X
Xmodule goCom;
X
Xexports
X
Ximports IO_Others from IO_Others;
Ximports fileDefs from fileDefs;
X
Xconst
X version = '3.9';
X
X numPoints = 19;
X maxPoint = numPoints - 1;
X curC = 31;
X maxTagLen = 16;
X
X charHeight = 13;
X charWidth = 9;
X
X boardWin = 1;
X menuWin = 2;
X statWin = 3;
X bWinX = 0;
X bWinY = 0;
X bWinW = 768;
X bWinH = 768;
X mWinX = 0;
X mWinY = 768;
X mWinW = 768;
X mWinH = 192;
X sWinX = 0;
X sWinY = 960;
X sWinW = 768;
X sWinH = 64;
X
X promptX = sWinX + 32;
X lineY = 4;
X lineDel = 2;
X promptLine = 1;
X tagLine = 2;
X cmtLine = 3;
X
X boardX = bWinX + 64;
X boardY = bWinY + 32;
X pBoardX = bWinX + 44; { for printing }
X pBoardY = bWinY + 24;
X
X passX = bWinX + 321;
X passY = bWinY + 712; { 712 }
X passW = 126;
X passH = 13;
X
X captBX = bWinX + 64;
X captWX = bWinX + 578;
X captY = bWinY + 712; { 712 }
X
X captNBX = captBX + 45;
X captNWX = captWX + 45;
X captNY = bWinY + 732; { 732 }
X
X turnX = bWinX + 325;
X turnY = bWinY + 752; { 752 }
X
X none = -1;
X mInit = 1;
X mSetHc = 2;
X mPass = 3;
X mScore = 4;
X mForToBr = 5;
X mBackToBr = 6;
X mBackToStone = 7;
X mForToLeaf = 8;
X mPutTag = 9;
X mGotoTag = 10;
X mGotoRoot = 11;
X mPutCmt = 12;
X mReadFile = 13;
X mWriteFile = 14;
X mPruneBranches = 15;
X mTogNums = 16;
X mPrintBoard = 17;
X mStepToTag = 18;
X mSetStepTag = 19;
X mQuit = 20;
X mBackOne = 21;
X mForOne = 22;
X mEraseMove = 23;
X mAutoPlay = 24;
X mPlayMyself = 25;
X mSetPlayLevel = 26;
X mDebug = 27;
X mRefBoard = 28;
X mShoState = 29;
X mPrintDiag = 30;
X mBoardSize = 31;
X mLast = 31; { the last command in the menu }
X mPlaceStone = 32; { this command is not in the menu }
X mCtlC = 33; { nor is this }
X
Xtype
X bVal = (black, white, empty, alternate);
X sType = black..white;
X bRec = record
X val: bval;
X xOfs, yOfs: integer;
X mNum: integer;
X marked: boolean;
X end;
X
X boardArray = array[0..maxPoint] of array[0..maxPoint] of bRec;
X
X picBuf = array[0..63] of array[0..3] of integer;
X pPicBuf = ^picBuf;
X
Xvar
X board: boardArray;
X captures: array[sType] of integer;
X moveNum: integer;
X koX, koY: integer;
X selCursor: curPatPtr;
X dotSX, dotSY: integer;
X passShowing: boolean;
X numbEnabled: boolean;
X treeDirty: boolean;
X gameFName: pathName;
X debug: boolean;
X printLarge: boolean;
X
Xprivate
X
Xprocedure comBug;
Xbegin { comBug }
Xend. { comBug }
END_OF_goCom.pas
if test 3924 -ne `wc -c <goCom.pas`; then
echo shar: \"goCom.pas\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f goPlayUtils.pas -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"goPlayUtils.pas\"
else
echo shar: Extracting \"goPlayUtils.pas\" \(50784 characters\)
sed "s/^X//" >goPlayUtils.pas <<'END_OF_goPlayUtils.pas'
Xmodule goPlayUtils;
X
Xexports
X
Ximports goCom from goCom;
X
Xconst
X iNil = 32767; { a distinguished value like nil }
X maxGroup = 512;
X maxSPoint = 16;
X
Xtype
X intBoard = array[-2..maxPoint + 2] of array[-2..maxPoint + 2] of integer;
X
X boolBoard = array[-2..maxPoint + 2] of array[-2..maxPoint + 2] of boolean;
X
X point = record
X px, py: integer;
X end;
X
X pointList = record
X p: array[1..400] of point;
X indx: integer;
X end;
X
X sPointList = record
X p: array[1..maxSPoint] of point;
X indx: integer;
X end;
X
X intList = record
X indx: integer;
X v: array[1..400] of integer;
X end;
X
X sgRec = record
X w, s, sm: integer;
X end;
X
X groupRec = record
X groupMark: integer;
X atLevel: integer;
X isLive: boolean;
X isDead: boolean;
X libC: integer;
X numEyes: integer;
X size: integer;
X lx, ly: integer;
X end;
X
Xvar
X kleim, ekstre, bord, ndbord, sGroups, threatBord: intBoard;
X groupIDs, connectMap, protPoints: intBoard;
X groupSeen, legal: boolBoard;
X maxGroupID: integer;
X pList, pList1, plist2, plist3, pPlist: pointList;
X nlcGroup, aList: intList;
X sList: array[1..400] of sgRec;
X gList: array[0..maxGroup] of groupRec;
X killFlag: boolean;
X numCapt: integer;
X utilPlayLevel: integer;
X treeLibLim: integer;
X mySType: sType;
X showTrees: boolean;
X sGlist: array[1..maxGroup] of integer;
X depthLimit: integer;
X markBoard: intBoard;
X marker: integer;
X
Xfunction saveable(gx, gy: integer; var savex, savey: integer): boolean;
Xfunction killable(gx, gy: integer; var killx, killy: integer): boolean;
Xprocedure initBoolBoard(var bb: boolBoard);
Xprocedure spanGroup(x, y: integer; var libs: pointList);
Xfunction abs(i: integer): integer;
Xprocedure intersectPlist(var p1, p2, pr: pointList);
Xprocedure initArray(var ary: intBoard);
Xprocedure initState;
Xprocedure copyArray(var dAry, sAry: intBoard);
Xprocedure steik;
Xprocedure spread;
Xprocedure respreicen;
Xprocedure plei(x, y, z: integer);
Xprocedure genState;
Xprocedure saveState;
Xprocedure restoreState;
Xfunction tencen(x, y: integer): integer;
Xprocedure genConnects;
Xprocedure initGPUtils;
Xprocedure sortLibs;
X
Xprivate
X
Ximports screen from screen;
Ximports raster from raster;
Ximports goBoard from goBoard;
Ximports io_others from io_others;
X
Xtype
X playType = (rem, add, chLib, reMap);
X
X playRec = record
X gID: integer;
X case kind: playType of
X rem, add:
X (who, xl, yl, nextGID, sNumber: integer);
X chLib:
X (oldLC, oldLevel: integer);
X reMap:
X (oldGID: integer)
X end;
X
Xvar
X adjInAtari, adj2Libs: boolean;
X intersectNum, spanNum, libMark: integer;
X playStack: array[1..1024] of playRec;
X playMark: integer;
X newGID: integer;
X tryLevel: integer;
X grpMark: integer;
X gMap: array[0..maxGroup] of integer;
X dbStop, inGenState: boolean;
X
Xexception screwup;
X
Xprocedure pause;
Xbegin { pause }
X{ if dbStop and not inGenState then
X begin
X while not tabswitch do;
X repeat
X if tabYellow then
X dbStop := false;
X until not tabswitch;
X end; }
Xend { pause };
X
Xprocedure sstone(w, x, y, numb: integer);
Xvar
X cx, cy: integer;
Xbegin { sstone }
X sReadCursor(cx, cy);
X if w = 1 then
X placeStone(mySType, x, y, 0, 0, numb)
X else if mySType = white then
X placeStone(black, x, y, 0, 0, numb)
X else
X placeStone(white, x, y, 0, 0, numb);
X sSetCursor(cx, cy);
Xend { sstone };
X
Xprocedure rstone(x, y: integer);
Xvar
X cx, cy: integer;
Xbegin { rstone }
X sReadCursor(cx, cy);
X remStone(x, y);
X sSetCursor(cx, cy);
Xend { rstone };
X
Xprocedure initBoolBoard(var bb: boolBoard);
Xvar
X i, j: integer;
Xbegin { initBoolBoard }
X for i := 0 to maxPoint do
X for j := 0 to maxPoint do
X bb[i, j] := false;
Xend { initBoolBoard };
X
Xfunction abs(i: integer): integer;
Xbegin { abs }
X if i < 0 then
X abs := -i
X else
X abs := i;
Xend { abs };
X
Xprocedure sortLibs;
Xvar
X i, j, t: integer;
Xbegin { sortLibs }
X for i := 1 to maxGroupID do
X sGList[i] := i;
X for i := 1 to maxGroupID - 1 do
X for j := i + 1 to maxGroupID do
X if gList[sGlist[i]].libC > gList[sGlist[j]].libC then
X begin
X t := sGList[i];
X sGlist[i] := sGlist[j];
X sGlist[j] := t;
X end;
Xend { sortLibs };
X
Xprocedure spanGroup(x, y: integer; var libs: pointList);
Xvar
X lookFor: integer;
X
X procedure span(x, y: integer);
X begin { span }
X markBoard[x, y] := marker;
X if bord[x, y] = 0 then
X begin
X libs.indx := libs.indx + 1;
X libs.p[libs.indx].px := x;
X libs.p[libs.indx].py := y;
X end
X else if bord[x, y] = lookFor then
X begin
X groupSeen[x, y] := true;
X if (x > 0) and (markBoard[x - 1, y] <> marker) then
X span(x - 1, y);
X if (y > 0) and (markBoard[x, y - 1] <> marker) then
X span(x, y - 1);
X if (x < maxPoint) and (markBoard[x + 1, y] <> marker) then
X span(x + 1, y);
X if (y < maxPoint) and (markBoard[x, y + 1] <> marker) then
X span(x, y + 1);
X end
X else if gList[gMap[groupIDs[x, y]]].libC = 1 then
X adjInAtari := true
X else if (gList[gMap[groupIDs[x, y]]].libC = 2) and
X (not gList[gMap[groupIDs[x, y]]].isLive) then
X adj2Libs := true;
X end { span };
X
Xbegin { spanGroup }
X marker := marker + 1;
X if marker = 0 then
X begin
X initArray(markBoard);
X marker := 1;
X end;
X adjInAtari := false;
X adj2Libs := false;
X lookFor := bord[x, y];
X libs.indx := 0;
X span(x, y);
Xend { spanGroup };
X
Xprocedure sSpanGroup(x, y: integer; var libs: sPointList);
Xvar
X lookFor: integer;
X
X procedure span(x, y: integer);
X begin { span }
X markBoard[x, y] := marker;
X if bord[x, y] = 0 then
X begin
X libs.indx := libs.indx + 1;
X if libs.indx <= maxSPoint then
X begin
X libs.p[libs.indx].px := x;
X libs.p[libs.indx].py := y;
X end;
X end
X else if bord[x, y] = lookFor then
X begin
X groupSeen[x, y] := true;
X if (x > 0) and (markBoard[x - 1, y] <> marker) then
X span(x - 1, y);
X if (y > 0) and (markBoard[x, y - 1] <> marker) then
X span(x, y - 1);
X if (x < maxPoint) and (markBoard[x + 1, y] <> marker) then
X span(x + 1, y);
X if (y < maxPoint) and (markBoard[x, y + 1] <> marker) then
X span(x, y + 1);
X end
X else if gList[gMap[groupIDs[x, y]]].libC = 1 then
X adjInAtari := true
X else if (gList[gMap[groupIDs[x, y]]].libC = 2) and
X (not gList[gMap[groupIDs[x, y]]].isLive) then
X adj2Libs := true;
X end { span };
X
Xbegin { sSpanGroup }
X marker := marker + 1;
X if marker = 0 then
X begin
X initArray(markBoard);
X marker := 1;
X end;
X adjInAtari := false;
X adj2Libs := false;
X lookFor := bord[x, y];
X libs.indx := 0;
X span(x, y);
Xend { sSpanGroup };
X
Xprocedure listAdjacents(x, y: integer; var iL: intList);
Xvar
X me, him: integer;
X
X procedure span(x, y: integer);
X begin { span }
X markBoard[x, y] := marker;
X if bord[x, y] = me then
X begin
X if (x > 0) and (markBoard[x - 1, y] <> marker) then
X span(x - 1, y);
X if (x < maxPoint) and (markBoard[x + 1, y] <> marker) then
X span(x + 1, y);
X if (y > 0) and (markBoard[x, y - 1] <> marker) then
X span(x, y - 1);
X if (y < maxPoint) and (markBoard[x, y + 1] <> marker) then
X span(x, y + 1);
X end
X else if bord[x, y] = him then
X if gList[gMap[groupIDs[x, y]]].groupMark <> grpMark then
X begin
X gList[gMap[groupIDs[x, y]]].groupMark := grpMark;
X iL.indx := iL.indx + 1;
X iL.v[iL.indx] := gMap[groupIDs[x, y]];
X end;
X end { span };
X
Xbegin { listAdjacents }
X grpMark := grpMark + 1;
X marker := marker + 1;
X if marker = 0 then
X begin
X initArray(markBoard);
X marker := 1;
X end;
X iL.indx := 0;
X me := bord[x, y];
X him := -me;
X span(x, y);
Xend { listAdjacents };
X
Xprocedure listDiags(x, y: integer; var diags: sPointList);
Xvar
X me: integer;
X
X procedure span(x, y: integer);
X begin { span }
X markBoard[x, y] := marker;
X if (x > 0) and (y > 0) and
X (bord[x - 1, y - 1] = 0) and
X (bord[x, y - 1] <> me) and
X (bord[x - 1, y] <> me) and
X (markBoard[x - 1, y - 1] <> marker) then
X begin
X markBoard[x - 1, y - 1] := marker;
X diags.indx := diags.indx + 1;
X if diags.indx <= maxSPoint then
X with diags.p[diags.indx] do
X begin
X px := x - 1;
X py := y - 1;
X end;
X end;
X if (x < maxPoint) and (y > 0) and
X (bord[x + 1, y - 1] = 0) and
X (bord[x, y - 1] <> me) and
X (bord[x + 1, y] <> me) and
X (markBoard[x + 1, y - 1] <> marker) then
X begin
X markBoard[x + 1, y - 1] := marker;
X diags.indx := diags.indx + 1;
X if diags.indx <= maxSPoint then
X with diags.p[diags.indx] do
X begin
X px := x + 1;
X py := y - 1;
X end;
X end;
X if (x > 0) and (y < maxPoint) and
X (bord[x - 1, y + 1] = 0) and
X (bord[x, y + 1] <> me) and
X (bord[x - 1, y] <> me) and
X (markBoard[x - 1, y + 1] <> marker) then
X begin
X markBoard[x - 1, y + 1] := marker;
X diags.indx := diags.indx + 1;
X if diags.indx <= maxSPoint then
X with diags.p[diags.indx] do
X begin
X px := x - 1;
X py := y + 1;
X end;
X end;
X if (x < maxPoint) and (y < maxPoint) and
X (bord[x + 1, y + 1] = 0) and
X (bord[x, y + 1] <> me) and
X (bord[x + 1, y] <> me) and
X (markBoard[x + 1, y + 1] <> marker) then
X begin
X markBoard[x + 1, y + 1] := marker;
X diags.indx := diags.indx + 1;
X if diags.indx <= maxSPoint then
X with diags.p[diags.indx] do
X begin
X px := x + 1;
X py := y + 1;
X end;
X end;
X if (x > 0) and (bord[x - 1, y] = me) and
X (markBoard[x - 1, y] <> marker) then
X span(x - 1, y);
X if (x < maxPoint) and (bord[x + 1, y] = me) and
X (markBoard[x + 1, y] <> marker) then
X span(x + 1, y);
X if (y > 0) and (bord[x, y - 1] = me) and
X (markBoard[x, y - 1] <> marker) then
X span(x, y - 1);
X if (y < maxPoint) and (bord[x, y + 1] = me) and
X (markBoard[x, y + 1] <> marker) then
X span(x, y + 1);
X end { span };
X
Xbegin { listDiags }
X me := bord[x, y];
X diags.indx := 0;
X marker := marker + 1;
X if marker = 0 then
X begin
X initArray(markBoard);
X marker := 1;
X end;
X span(x, y);
Xend { listDiags };
X
Xprocedure intersectPlist(var p1, p2, pr: pointList);
Xvar
X i, j, k: integer;
Xbegin { intersectPlist }
X marker := marker + 1;
X if marker = 0 then
X begin
X initArray(markBoard);
X marker := 1;
X end;
X pr.indx := 0;
X for i := 1 to p1.indx do
X with p1.p[i] do
X markBoard[px, py] := marker;
X j := 0;
X for i := 1 to p2.indx do
X with p2.p[i] do
X if markBoard[px, py] = marker then
X begin
X j := j + 1;
X pr.p[j] := p2.p[i];
X end;
X pr.indx := j;
Xend { intersectPlist };
X
Xprocedure initArray(var ary: intBoard);
Xvar
X i, j: integer;
Xbegin { initArray }
X for i := 0 to maxPoint do
X for j := 0 to maxPoint do
X ary[i, j] := 0;
Xend { initArray };
X
Xprocedure initState;
Xvar
X i, j: integer;
Xbegin { initState }
X for i := -2 to maxPoint + 2 do
X for j := -2 to maxPoint + 2 do
X begin
X ekstre[i, j] := 0;
X kleim[i, j] := 0;
X groupIDs[i, j] := 0;
X connectMap[i, j] := 0;
X protPoints[i, j] := 0;
X end;
Xend { initState };
X
Xprocedure copyArray(var dAry, sAry: intBoard);
Xvar
X i, j: integer;
Xbegin { copyArray }
X for i := 0 to maxPoint do
X for j := 0 to maxPoint do
X dAry[i, j] := sAry[i, j];
Xend { copyArray };
X
X{
X generates a one-point spread in the force field array (kleim)
X
X the spread from a single point after four calls is:
X
X 1
X 2 2 2
X 2 4 6 4 2
X 2 4 8 10 8 4 2
X 1 2 6 10 62 10 6 2 1
X 2 4 8 10 8 4 2
X 2 4 6 4 2
X 2 2 2
X 1
X
X}
Xprocedure steik;
Xvar
X i, j: integer;
Xbegin { steik }
X initArray(ekstre);
X for i := 0 to maxPoint do
X for j := 0 to maxPoint do
X begin
X ekstre[i, j] := ekstre[i, j] + kleim[i, j];
X if kleim[i, j] > 0 then
X begin
X if i > 0 then
X ekstre[i - 1, j] := ekstre[i - 1, j] + 1;
X if j > 0 then
X ekstre[i, j - 1] := ekstre[i, j - 1] + 1;
X if i < maxPoint then
X ekstre[i + 1, j] := ekstre[i + 1, j] + 1;
X if j < maxPoint then
X ekstre[i, j + 1] := ekstre[i, j + 1] + 1;
X end
X else if kleim[i, j] < 0 then
X begin
X if i > 0 then
X ekstre[i - 1, j] := ekstre[i - 1, j] - 1;
X if j > 0 then
X ekstre[i, j - 1] := ekstre[i, j - 1] - 1;
X if i < maxPoint then
X ekstre[i + 1, j] := ekstre[i + 1, j] - 1;
X if j < maxPoint then
X ekstre[i, j + 1] := ekstre[i, j + 1] - 1;
X end;
X end;
X copyArray(kleim, ekstre);
Xend { steik };
X
X{
X sets up kleim from the current board position
X}
Xprocedure spread;
Xvar
X i, j: integer;
Xbegin { spread }
X for i := 0 to maxPoint do
X for j := 0 to maxPoint do
X kleim[i, j] := ndbord[i, j] * 50;
X steik;
X steik;
X steik;
X steik;
Xend { spread };
X
X{
X gList is initialized with the size, loc, and libCount of each group
X groupIDs contains the serial numbers of the groups.
X}
Xprocedure respreicen;
Xvar
X i, j, gID, libCount, gSize, who: integer;
X
X procedure span(x, y: integer);
X begin { span }
X if (bord[x, y] = 0) and
X (markBoard[x, y] <> marker) then { a liberty }
X begin
X markBoard[x, y] := marker;
X libCount := libCount + 1;
X end
X else if (bord[x, y] = who) and
X (groupIDs[x, y] = 0) then
X begin
X groupIDs[x, y] := gID;
X gSize := gSize + 1;
X if x > 0 then
X span(x - 1, y);
X if x < maxPoint then
X span(x + 1, y);
X if y > 0 then
X span(x, y - 1);
X if y < maxPoint then
X span(x, y + 1);
X end;
X end { span };
X
Xbegin { respreicen }
X gID := 0;
X for i := 0 to maxPoint do
X for j := 0 to maxPoint do
X groupIDs[i, j] := 0;
X for i := 0 to maxPoint do
X for j := 0 to maxPoint do
X if (bord[i, j] <> 0) and { a stone there }
X (groupIDs[i, j] = 0) then { not seen yet }
X begin
X marker := marker + 1;
X if marker = 0 then
X begin
X initArray(markBoard);
X marker := 1;
X end;
X gID := gID + 1;
X libCount := 0;
X gSize := 0;
X who := bord[i, j];
X span(i, j); { span the group, collecting info }
X with gList[gID] do
X begin
X groupMark := 0;
X atLevel := 0;
X isLive := false; { we don't know yet }
X isDead := false;
X numEyes := -1;
X size := gSize;
X libC := libCount;
X lx := i;
X ly := j;
X end;
X gMap[gID] := gID; { set up identity map }
X end;
X maxGroupID := gID;
X newGID := gID;
X grpMark := 0;
Xend { respreicen };
X
X{
X play z at [x, y].
X killFlag is set true if anything is killed.
X}
Xprocedure plei(x, y, z: integer);
Xvar
X i, me, him, myGID: integer;
X isNew: boolean;
X
X procedure killGroup(x, y: integer);
X begin { killGroup }
X playMark := playMark + 1;
X with playStack[playMark] do
X begin { record this kill }
X kind := rem;
X who := him;
X xl := x;
X yl := y;
X gID := groupIDs[x, y];
X sNumber := board[x, y].mNum;
X if showTrees then
X rstone(x, y);
X end;
X numCapt := numCapt + 1;
X bord[x, y] := 0;
X groupIDs[x, y] := 0;
X if x > 0 then
X begin
X if bord[x - 1, y] = me then
X begin
X nlcGroup.indx := nlcGroup.indx + 1;
X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x - 1, y]];
X end
X else if bord[x - 1, y] = him then
X killGroup(x - 1, y);
X end;
X if x < maxPoint then
X begin
X if bord[x + 1, y] = me then
X begin
X nlcGroup.indx := nlcGroup.indx + 1;
X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x + 1, y]];
X end
X else if bord[x + 1, y] = him then
X killGroup(x + 1, y);
X end;
X if y > 0 then
X begin
X if bord[x, y - 1] = me then
X begin
X nlcGroup.indx := nlcGroup.indx + 1;
X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y - 1]];
X end
X else if bord[x, y - 1] = him then
X killGroup(x, y - 1);
X end;
X if y < maxPoint then
X begin
X if bord[x, y + 1] = me then
X begin
X nlcGroup.indx := nlcGroup.indx + 1;
X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y + 1]];
X end
X else if bord[x, y + 1] = him then
X killGroup(x, y + 1);
X end;
X end { killGroup };
X
X procedure mergeGroup(sGID: integer);
X var
X i: integer;
X begin { mergeGroup }
X for i := 1 to newGID do
X if gMap[i] = sGID then
X begin
X playMark := playMark + 1;
X with playStack[playMark] do
X begin
X kind := reMap;
X gID := i;
X oldGID := sGID;
X end;
X gMap[i] := myGID;
X end;
X end { mergeGroup };
X
Xbegin { plei }
X me := z;
X him := -me;
X killFlag := false; { set true if something is killed }
X numCapt := 0;
X tryLevel := tryLevel + 1;
X isNew := false;
X bord[x, y] := z; { play the stone }
X if (x > 0) and (bord[x - 1, y] = me) then { connect to adjacent group }
X myGID := gMap[groupIDs[x - 1, y]]
X else if (x < maxPoint) and (bord[x + 1, y] = me) then
X myGID := gMap[groupIDs[x + 1, y]]
X else if (y > 0) and (bord[x, y - 1] = me) then
X myGID := gMap[groupIDs[x, y - 1]]
X else if (y < maxPoint) and (bord[x, y + 1] = me) then
X myGID := gMap[groupIDs[x, y + 1]]
X else { nobody to connect to }
X begin
X newGID := newGID + 1;
X isNew := true;
X myGID := newGID;
X with gList[myGID] do
X begin
X groupMark := 0;
X atLevel := tryLevel;
X isLive := false;
X numEyes := -1;
X size := -1;
X lx := x;
X ly := y;
X end;
X gMap[myGID] := myGID;
X end;
X groupIDs[x, y] := myGID;
X playMark := playMark + 1;
X with playStack[playMark] do
X begin { record this move }
X kind := add;
X who := me;
X xl := x;
X yl := y;
X gID := myGID;
X sNumber := 0;
X if isNew then
X nextGID := newGID - 1
X else
X nextGID := newGID;
X if showTrees then
X sstone(me, x, y, 0);
X end;
X { merge adjacent groups }
X if (x > 0) and (bord[x - 1, y] = me) and
X (gMap[groupIDs[x - 1, y]] <> myGID) then
X mergeGroup(gMap[groupIDs[x - 1, y]]);
X if (x < maxPoint) and (bord[x + 1, y] = me) and
X (gMap[groupIDs[x + 1, y]] <> myGID) then
X mergeGroup(gMap[groupIDs[x + 1, y]]);
X if (y > 0) and (bord[x, y - 1] = me) and
X (gMap[groupIDs[x, y - 1]] <> myGID) then
X mergeGroup(gMap[groupIDs[x, y - 1]]);
X if (y < maxPoint) and (bord[x, y + 1] = me) and
X (gMap[groupIDs[x, y + 1]] <> myGID) then
X mergeGroup(gMap[groupIDs[x, y + 1]]);
X { kill opposing groups, listing affected groups }
X nlcGroup.indx := 1;
X nlcGroup.v[1] := myGID; { init list to include me }
X if (x > 0) and (bord[x - 1, y] = him) and
X (gList[gMap[groupIDs[x - 1, y]]].libC = 1) then
X begin
X killFlag := true;
X killGroup(x - 1, y);
X end;
X if (x < maxPoint) and (bord[x + 1, y] = him) and
X (gList[gMap[groupIDs[x + 1, y]]].libC = 1) then
X begin
X killFlag := true;
X killGroup(x + 1, y);
X end;
X if (y > 0) and (bord[x, y - 1] = him) and
X (gList[gMap[groupIDs[x, y - 1]]].libC = 1) then
X begin
X killFlag := true;
X killGroup(x, y - 1);
X end;
X if (y < maxPoint) and (bord[x, y + 1] = him) and
X (gList[gMap[groupIDs[x, y + 1]]].libC = 1) then
X begin
X killFlag := true;
X killGroup(x, y + 1);
X end;
X { list groups adjacent to me }
X if (x > 0) and (bord[x - 1, y] = him) then
X begin
X nlcGroup.indx := nlcGroup.indx + 1;
X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x - 1, y]];
X end;
X if (x < maxPoint) and (bord[x + 1, y] = him) then
X begin
X nlcGroup.indx := nlcGroup.indx + 1;
X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x + 1, y]];
X end;
X if (y > 0) and (bord[x, y - 1] = him) then
X begin
X nlcGroup.indx := nlcGroup.indx + 1;
X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y - 1]];
X end;
X if (y < maxPoint) and (bord[x, y + 1] = him) then
X begin
X nlcGroup.indx := nlcGroup.indx + 1;
X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y + 1]];
X end;
X { fix liberty count for affected groups }
X grpMark := grpMark + 1;
X for i := 1 to nlcGroup.indx do
X with gList[nlcGroup.v[i]] do
X if groupMark <> grpMark then
X begin
X if atLevel <> tryLevel then
X begin
X playMark := playMark + 1;
X with playStack[playMark] do
X begin
X kind := chLib;
X gID := nlcGroup.v[i];
X oldLevel := atLevel;
X oldLC := libC;
X end;
X end;
X groupMark := grpMark;
X atLevel := tryLevel;
X spanGroup(lx, ly, pPList);
X libC := pPList.indx;
X end;
Xend { plei };
X
Xprocedure saveState;
Xbegin { saveState };
X playMark := 0;
X tryLevel := 0;
X newGID := maxGroupID;
Xend { saveState };
X
X{
X undoes a move sequence back to uMark
X}
Xprocedure undoTo(uMark: integer);
Xvar
X i: integer;
Xbegin { undoTo }
X for i := playMark downto uMark + 1 do
X with playStack[i] do
X if kind = rem then
X begin
X bord[xl, yl] := who;
X groupIDs[xl, yl] := gID;
X if showTrees then
X sstone(who, xl, yl, sNumber);
X end
X else if kind = add then
X begin
X bord[xl, yl] := 0;
X groupIDs[xl, yl] := 0;
X tryLevel := tryLevel - 1;
X newGID := nextGID;
X if showTrees then
X rstone(xl, yl);
X end
X else if kind = reMap then
X gMap[gID] := oldGID
X else { change libs of group - gID is pre-mapped }
X with gList[gID] do
X begin
X libC := oldLC;
X atLevel := oldLevel;
X end;
X playMark := uMark;
Xend { undoTo };
X
X{
X restores the state of the world after trying a move sequence
X}
Xprocedure restoreState;
Xvar
X i: integer;
Xbegin { restoreState }
X if playMark > 0 then
X begin
X undoTo(0);
X playMark := 0;
X tryLevel := 0;
X end;
Xend { restoreState };
X
Xexception bpt;
X
X{
X returns true if the group (at x, y) is killable.
X if so, returns the point to play at in killx, killy.
X}
Xfunction killable(gx, gy: integer; var killx, killy: integer): boolean;
Xconst
X tryLimit = 300;
X
Xvar
X me, him, depth, i, j, tryCount, tl, topMark, tkMark, mark2: integer;
X sChar: char;
X lList, dList: sPointList;
X tp: point;
X libList: array[1..maxSPoint] of integer;
X esc: boolean;
X
X function mtNbrs(x, y: integer): integer;
X var
X n: integer;
X begin { mtNbrs }
X n := 0;
X if (x > 0) and (bord[x - 1, y] = 0) then
X n := n + 1;
X if (x < maxPoint) and (bord[x + 1, y] = 0) then
X n := n + 1;
X if (y > 0) and (bord[x, y - 1] = 0) then
X n := n + 1;
X if (y < maxPoint) and (bord[x, y + 1] = 0) then
X n := n + 1;
X mtNbrs := n;
X end { mtNbrs };
X
X function tKillTree(tx, ty: integer): boolean;
X var
X tkMark: integer;
X escape: boolean;
X
X function killTree(tx, ty: integer; var escape: boolean): boolean;
X label
X 1, 2;
X var
X curMark, mark2, mark3, i, j, k, tl, dStart: integer;
X lList1, lList2: sPointList;
X libList: array[1..maxSPoint] of integer;
X tp: point;
X esc: boolean;
X begin { killTree }
X escape := false;
X tryCount := tryCount + 1;
X if tryCount > tryLimit then
X begin
X killable := false;
X undoTo(tkMark);
X for i := 1 to depth - 1 do
X begin
X sClearChar(sChar, rXor);
X end;
X depth := 1;
X exit(tKilltree);
X end;
X write(sChar);
X depth := depth + 1;
X curMark := playMark;
X plei(tx, ty, me); { try my move }
X pause;
X if gList[gMap[groupIDs[tx, ty]]].libC = 0 then { I'm dead }
X killTree := false
X else if killFlag then { I killed something of his }
X killTree := true
X else if gList[gMap[groupIDs[gx, gy]]].libC > treeLibLim then { safe }
X killTree := false
X else
X begin
X sSpanGroup(gx, gy, lList1); { find his liberties }
X if gList[gMap[groupIDs[tx, ty]]].libC = 1 then { he can kill me }
X begin
X if lList1.indx < maxSPoint then { add that option to his list }
X begin
X lList1.indx := lList1.indx + 1;
X spanGroup(tx, ty, pList2); { find my liberty }
X with lList1.p[lList1.indx] do
X begin
X px := pList2.p[1].px;
X py := pList2.p[1].py;
X end;
X end
X else
X begin
X killTree := false; { forget it }
X goto 1;
X end;
X end;
X for i := 1 to maxSPoint do { init liblist so diags can be marked }
X libList[i] := -1;
X if (utilPlayLevel > 4) and
X (lList1.indx > 1) and
X (gList[gMap[groupIDs[gx, gy]]].libC > 1) then { try diags }
X begin
X listDiags(gx, gy, dList);
X j := 0;
X i := lList1.indx;
X while (j < dList.indx) and
X (i < maxSPoint) do
X begin
X j := j + 1;
X i := i + 1;
X libList[i] := 0; { mark this as a diag }
X with dList.p[j] do
X begin
X lList1.p[i].px := px;
X lList1.p[i].py := py;
X end;
X end;
X lList1.indx := i;
X end;
X if lList1.indx > 1 then { sort by decreasing lib count }
X begin
X for i := 1 to lList1.indx do
X if libList[i] <> 0 then { diags are tried last }
X with lList1.p[i] do
X begin
X mark2 := playMark;
X plei(px, py, him);
X libList[i] := gList[gMap[groupIDs[gx, gy]]].libC;
X if (libList[i] > treeLibLim) or
X ((libList[i] > (depthLimit - depth)) and
X (libList[i] > 2)) then
X begin
X escape := true;
X killTree := false;
X goto 1; { he can live }
X end;
X undoTo(mark2);
X end;
X for i := 1 to lList1.indx - 1 do
X for j := i + 1 to lList1.indx do
X if libList[i] < libList[j] then
X begin
X tl := libList[i];
X libList[i] := libList[j];
X libList[j] := tl;
X tp := lList1.p[i];
X lList1.p[i] := lList1.p[j];
X lList1.p[j] := tp;
X end;
X end;
X for i := 1 to lList1.indx + 1 do { try his responses }
X begin
X mark2 := playMark;
X if i <= lList1.indx then { try his move }
X with lList1.p[i] do
X begin
X plei(px, py, him); { play his response }
X pause;
X if gList[gMap[groupIDs[px, py]]].libC < 2 then
X goto 2; { a bogus move }
X end
X else if gList[gMap[groupIDs[gx, gy]]].libC <= 1 then
X begin
X killTree := true; { can't tenuki if in atari }
X goto 1;
X end;
X if gList[gMap[groupIDs[gx, gy]]].libC > treeLibLim then
X begin
X escape := true;
X killTree := false;
X goto 1;
X end;
X if gList[gMap[groupIDs[gx, gy]]].libC > 1 then
X begin { look at my responses }
X sSpanGroup(gx, gy, lList2); { list his liberties }
X dStart := lList2.indx + 1;
X if adjInAtari then { he wins }
X begin
X killTree := false;
X goto 1;
X end;
X if (lList2.Indx > 2) and adj2Libs then { he wins }
X begin
X killTree := false;
X goto 1;
X end;
X for k := 1 to maxSPoint do
X libList[k] := -1;
X if utilPlayLevel > 4 then { account for diagonal moves }
X begin
X listDiags(gx, gy, dList);
X j := 0;
X k := lList2.indx;
X while (j < dList.indx) and
X (k < maxSPoint) do
X begin
X j := j + 1;
X k := k + 1;
X libList[k] := 100;
X with dList.p[j] do
X begin
X lList2.p[k].px := px;
X lList2.p[k].py := py;
X end;
X end;
X lList2.indx := k;
X end;
X if lList2.indx > 1 then { sort by increasing lib count }
X begin
X for k := 1 to lList2.indx do
X if libList[k] <> 100 then { diags go last }
X with lList2.p[k] do
X begin
X mark3 := playMark;
X plei(px, py, me);
X libList[k] := gList[gMap[groupIDs[gx, gy]]].libC;
X undoTo(mark3);
X end;
X for k := 1 to lList2.indx - 1 do
X for j := k + 1 to lList2.indx do
X if libList[k] > libList[j] then
X begin
X tl := libList[k];
X libList[k] := libList[j];
X libList[j] := tl;
X tp := lList2.p[k];
X lList2.p[k] := lList2.p[j];
X lList2.p[j] := tp;
X end
X else if (libList[k] = libList[j]) and
X (libList[k] = 1) then
X if mtNbrs(lList2.p[k].px, lList2.p[k].py) <
X mtNbrs(lList2.p[j].px, lList2.p[j].py) then
X begin
X tl := libList[k];
X libList[k] := libList[j];
X libList[j] := tl;
X tp := lList2.p[k];
X lList2.p[k] := lList2.p[j];
X lList2.p[j] := tp;
X end;
X end;
X for j := 1 to lList2.indx do
X begin
X if killTree(lList2.p[j].px, lList2.p[j].py, esc) then
X goto 2; { this kills him }
X if esc and (j >= dStart) then
X begin
X killTree := false;
X goto 1; { don't bother with more diags if escapes }
X end;
X end;
X killTree := false; { none of my responses kills him }
X goto 1;
X end;
X 2:
X undoTo(mark2);
X end;
X killTree := true; { none of his responses saves him }
X end;
X 1:
X undoTo(curMark);
X sClearChar(sChar, rXor);
X depth := depth - 1;
X end { killTree };
X
X begin { tKillTree }
X tryCount := 0;
X tkMark := playMark;
X tKillTree := killTree(tx, ty, escape);
X end { tKillTree };
X
Xbegin { killable }
X dbStop := true;
X him := bord[gx, gy]; { find out who I am }
X me := -him;
X if me = 1 then
X sChar := '>'
X else
X sChar := '|';
X write(sChar);
X depth := 1;
X topMark := playMark;
X sSpanGroup(gx, gy, lList); { find his liberties }
X if lList.indx = 1 then
X begin
X killable := true;
X killx := lList.p[1].px;
X killy := lList.p[1].py;
X end
X else if lList.indx > treeLibLim then
X killable := false
X else if adjInAtari then
X killable := false
X else if (lList.indx > 2) and adj2Libs then
X killable := false
X else
X begin
X for i := 1 to maxSPoint do
X libList[i] := -1;
X if utilPlayLevel > 4 then { account for diagonal moves }
X begin
X listDiags(gx, gy, dList);
X j := 0;
X i := lList.indx;
X while (j < dList.indx) and
X (i < maxSPoint) do
X begin
X j := j + 1;
X i := i + 1;
X libList[i] := 100;
X with dList.p[j] do
X begin
X lList.p[i].px := px;
X lList.p[i].py := py;
X end;
X end;
X lList.indx := i;
X end;
X if lList.indx > 1 then { sort by increasing lib count }
X begin
X for i := 1 to lList.indx do
X if libList[i] <> 100 then { diags go last }
X with lList.p[i] do
X begin
X mark2 := playMark;
X plei(px, py, me);
X libList[i] := gList[gMap[groupIDs[gx, gy]]].libC;
X undoTo(mark2);
X end;
X for i := 1 to lList.indx - 1 do
X for j := i + 1 to lList.indx do
X if libList[i] > libList[j] then
X begin
X tl := libList[i];
X libList[i] := libList[j];
X libList[j] := tl;
X tp := lList.p[i];
X lList.p[i] := lList.p[j];
X lList.p[j] := tp;
X end
X else if (libList[i] = libList[j]) and
X (libList[i] = 1) then
X if mtNbrs(lList.p[i].px, lList.p[i].py) <
X mtNbrs(lList.p[j].px, lList.p[j].py) then
X begin
X tl := libList[i];
X libList[i] := libList[j];
X libList[j] := tl;
X tp := lList.p[i];
X lList.p[i] := lList.p[j];
X lList.p[j] := tp;
X end;
X end;
X for i := 1 to lList.indx do
X begin
X if legal[lList.p[i].px, lList.p[i].py] then
X begin
X killx := lList.p[i].px;
X killy := lList.p[i].py;
X if tKillTree(killx, killy) then
X begin
X killable := true;
X sClearChar(sChar, rXor);
X exit(killable);
X end;
X end;
X end;
X killable := false;
X end;
X sClearChar(sChar, rXor);
Xend { killable };
X
X{
X returns true if the group (at gx, gy) is saveable.
X if so, returns the point to play at in savex, savey
X}
Xfunction saveable(gx, gy: integer; var savex, savey: integer): boolean;
Xlabel
X 1;
Xvar
X me, him, gx1, gx2, i, j, smark, mark2, tl: integer;
X sChar: char;
X dList: sPointList;
X tp: point;
X libList: array[1..maxSPoint] of integer;
Xbegin { saveable }
X dbStop := true;
X me := bord[gx, gy];
X him := -me;
X if me = 1 then
X sChar := '|'
X else
X sChar := '>';
X write(sChar);
X spanGroup(gx, gy, pList3); { find my liberties }
X if adjInAtari then { one of my options is to kill }
X begin
X listAdjacents(gx, gy, aList);
X for i := 1 to aList.indx do
X if gList[aList.v[i]].libC = 1 then
X with gList[aList.v[i]] do
X begin
X spanGroup(lx, ly, pList1); { find it's liberty }
X pList3.indx := pList3.indx + 1;
X pList3.p[pList3.indx].px := pList1.p[1].px;
X pList3.p[pList3.indx].py := pList1.p[1].py;
X end;
X end;
X for i := 1 to maxSPoint do
X libList[i] := -1;
X if (utilPlayLevel > 4) and
X (gList[gMap[groupIDs[gx, gy]]].libC > 1) then { account for diags }
X begin
X listDiags(gx, gy, dList);
X j := 0;
X i := pList3.indx;
X while (j < dList.indx) and
X (i < maxSPoint) do
X begin
X j := j + 1;
X i := i + 1;
X libList[i] := 100;
X with dList.p[j] do
X begin
X pList3.p[i].px := px;
X pList3.p[i].py := py;
X end;
X end;
X pList3.indx := i;
X end;
X if pList3.indx > 1 then { sort by decreasing lib count }
X begin
X for i := 1 to pList3.indx do
X if libList[i] <> 100 then
X with pList3.p[i] do
X begin
X mark2 := playMark;
X plei(px, py, me);
X libList[i] := gList[gMap[groupIDs[gx, gy]]].libC;
X if libList[i] > treeLibLim then { i'm safe }
X begin
X savex := px;
X savey := py;
X saveable := true;
X goto 1;
X end;
X undoTo(mark2);
X end;
X for i := 1 to pList3.indx - 1 do
X for j := i + 1 to pList3.indx do
X if libList[i] < libList[j] then
X begin
X tl := libList[i];
X libList[i] := libList[j];
X libList[j] := tl;
X tp := pList3.p[i];
X pList3.p[i] := pList3.p[j];
X pList3.p[j] := tp;
X end;
X end;
X for i := 1 to pList3.indx do
X begin
X savex := pList3.p[i].px;
X savey := pList3.p[i].py;
X if legal[savex, savey] then
X begin
X smark := playMark;
X plei(savex, savey, me);
X pause;
X if gList[gMap[groupIDs[savex, savey]]].libC > 1 then
X if gList[gMap[groupIDs[gx, gy]]].libC > treeLibLim then
X begin
X saveable := true;
X restoreState;
X sClearChar(sChar, rXor);
X exit(saveable);
X end
X else if gList[gMap[groupIDs[gx, gy]]].libC > 1 then
X if not killable(gx, gy, gx1, gx2) then
X begin
X saveable := true;
X restoreState;
X sClearChar(sChar, rXor);
X exit(saveable);
X end;
X undoTo(smark);
X end;
X end;
X saveable := false;
X1:
X restoreState;
X sClearChar(sChar, rXor);
Xend { saveable };
X
X{
X marks unsavable groups as dead
X}
Xprocedure markDead;
Xvar
X i, j, gx, gy: integer;
Xbegin { markDead }
X for i := 1 to maxGroupID do
X with gList[i] do
X if killable(lx, ly, gx, gy) then
X isDead := not saveable(lx, ly, gx, gy)
X else
X isDead := false;
X for i := 0 to maxPoint do
X for j := 0 to maxPoint do
X if bord[i, j] = 0 then
X ndbord[i, j] := 0
X else if gList[groupIDs[i, j]].isDead then
X ndbord[i, j] := 0
X else
X ndbord[i, j] := bord[i, j];
Xend { markDead };
X
X{
X marks groups with two eyes as live
X}
Xprocedure markLive;
Xvar
X i, j, size, sMark: integer;
X saw1, sawm1: boolean;
X
X procedure span(x, y: integer);
X begin { span }
X if ndbord[x, y] = 1 then
X saw1 := true
X else if ndbord[x, y] = -1 then
X sawm1 := true
X else if sGroups[x, y] = 0 then
X begin
X sGroups[x, y] := sMark;
X size := size + 1;
X if x > 0 then
X span(x - 1, y);
X if x < maxPoint then
X span(x + 1, y);
X if y > 0 then
X span(x, y - 1);
X if y < maxPoint then
X span(x, y + 1);
X end;
X end { span };
X
X function checkLive(x, y: integer): boolean;
X var
X numEyes, who: integer;
X
X procedure span(x, y: integer);
X begin { span }
X markBoard[x, y] := marker;
X if ndbord[x, y] = 0 then
X with sList[sGroups[x, y]] do
X begin
X if (sm <> marker) and
X (w = who) then
X begin
X sm := marker;
X if s > 6 then
X exit(checkLive);
X numEyes := numEyes + 1;
X if numEyes > 1 then
X exit(checkLive);
X end;
X end
X else if bord[x, y] = who then
X begin
X if (x > 0) and
X (markBoard[x - 1, y] <> marker) then
X span(x - 1, y);
X if (x < maxPoint) and
X (markBoard[x + 1, y] <> marker) then
X span(x + 1, y);
X if (y > 0) and
X (markBoard[x, y - 1] <> marker) then
X span(x, y - 1);
X if (y < maxPoint) and
X (markBoard[x, y + 1] <> marker) then
X span(x, y + 1);
X end;
X end { span };
X
X begin { checkLive }
X checkLive := true;
X numEyes := 0;
X who := bord[x, y];
X marker := marker + 1;
X span(x, y);
X checkLive := false;
X end { checkLive };
X
Xbegin { markLive }
X sMark := 0;
X initArray(sGroups);
X for i := 0 to maxPoint do
X for j := 0 to maxPoint do
X if (sGroups[i, j] = 0) and
X (ndbord[i, j] = 0) then
X begin
X size := 0;
X sMark := sMark + 1;
X sawm1 := false;
X saw1 := false;
X span(i, j);
X sList[sMark].s := size;
X sList[sMark].sm := 0;
X if sawm1 then
X if saw1 then
X sList[sMark].w := 0
X else
X sList[sMark].w := -1
X else if saw1 then
X sList[sMark].w := 1
X else
X sList[sMark].w := 0;
X end;
X for i := 1 to maxGroupID do
X with gList[i] do
X if not isDead then
X isLive := checkLive(lx, ly);
Xend { markLive };
X
X{
X generates the connection map and the protected point map.
X}
Xprocedure genConnects;
Xvar
X x, y, numStones: integer;
Xbegin { genConnects }
X for x := 0 to maxPoint do
X for y := 0 to maxPoint do
X begin
X connectMap[x, y] := 0;
X protPoints[x, y] := 0;
X end;
X for x := 0 to maxPoint do
X for y := 0 to maxPoint do
X if bord[x, y] = 1 then { map connections to this stone }
X begin
X if x > 0 then { direct connection }
X connectMap[x - 1, y] := connectMap[x - 1, y] + 1;
X if x < maxPoint then
X connectMap[x + 1, y] := connectMap[x + 1, y] + 1;
X if y > 0 then
X connectMap[x, y - 1] := connectMap[x, y - 1] + 1;
X if y < maxPoint then
X connectMap[x, y + 1] := connectMap[x, y + 1] + 1;
X if (x > 0) and (y > 0) and { diagonal connection }
X (bord[x - 1, y] = 0) and (bord[x, y - 1] = 0) then
X connectMap[x - 1, y - 1] := connectMap[x - 1, y - 1] + 1;
X if (x < maxPoint) and (y > 0) and
X (bord[x + 1, y] = 0) and (bord[x, y - 1] = 0) then
X connectMap[x + 1, y - 1] := connectMap[x + 1, y - 1] + 1;
X if (x < maxPoint) and (y < maxPoint) and
X (bord[x + 1, y] = 0) and (bord[x, y + 1] = 0) then
X connectMap[x + 1, y + 1] := connectMap[x + 1, y + 1] + 1;
X if (x > 0) and (y < maxPoint) and
X (bord[x - 1, y] = 0) and (bord[x, y + 1] = 0) then
X connectMap[x - 1, y + 1] := connectMap[x - 1, y + 1] + 1;
X if (x > 1) and (kleim[x - 1, y] > 3) then { one point jump }
X connectMap[x - 2, y] := connectMap[x - 2, y] + 1;
X if (x < (maxPoint - 1)) and (kleim[x + 1, y] > 3) then
X connectMap[x + 2, y] := connectMap[x + 2, y] + 1;
X if (y > 1) and (kleim[x, y - 1] > 3) then
X connectMap[x, y - 2] := connectMap[x, y - 2] + 1;
X if (y < (maxPoint - 1)) and (kleim[x, y + 1] > 3) then
X connectMap[x, y + 2] := connectMap[x, y + 2] + 1;
X if (x > 1) and (y > 0) and { knight's move }
X (kleim[x - 1, y] > 3) and (kleim[x - 1, y - 1] > 3) then
X connectMap[x - 2, y - 1] := connectMap[x - 2, y - 1] + 1;
X if (x > 0) and (y > 1) and
X (kleim[x, y - 1] > 3) and (kleim[x - 1, y - 1] > 3) then
X connectMap[x - 1, y - 2] := connectMap[x - 1, y - 2] + 1;
X if (x < (maxPoint - 1)) and (y > 0) and
X (kleim[x + 1, y] > 3) and (kleim[x + 1, y - 1] > 3) then
X connectMap[x + 2, y - 1] := connectMap[x + 2, y - 1] + 1;
X if (x < maxPoint) and (y > 1) and
X (kleim[x, y - 1] > 3) and (kleim[x + 1, y - 1] > 3) then
X connectMap[x + 1, y - 2] := connectMap[x + 1, y - 2] + 1;
X if (x > 1) and (y < maxPoint) and
X (kleim[x - 1, y] > 3) and (kleim[x - 1, y + 1] > 3) then
X connectMap[x - 2, y + 1] := connectMap[x - 2, y + 1] + 1;
X if (x > 0) and (y < (maxPoint - 1)) and
X (kleim[x, y + 1] > 3) and (kleim[x - 1, y + 1] > 3) then
X connectMap[x - 1, y + 2] := connectMap[x - 1, y + 2] + 1;
X if (x < (maxPoint - 1)) and (y < maxPoint) and
X (kleim[x + 1, y] > 3) and (kleim[x + 1, y + 1] > 3) then
X connectMap[x + 2, y + 1] := connectMap[x + 2, y + 1] + 1;
X if (x < maxPoint) and (y < (maxPoint - 1)) and
X (kleim[x, y + 1] > 3) and (kleim[x + 1, y + 1] > 3) then
X connectMap[x + 1, y + 2] := connectMap[x + 1, y + 2] + 1;
X end
X else if bord[x, y] = 0 then { see if protected point }
X begin
X numStones := 0;
X if x = 0 then
X numStones := numStones + 1;
X if y = 0 then
X numStones := numStones + 1;
X if x = maxPoint then
X numStones := numStones + 1;
X if y = maxPoint then
X numStones := numStones + 1;
X if (x > 0) and (bord[x - 1, y] = 1) then
X numStones := numStones + 1;
X if (y > 0) and (bord[x, y - 1] = 1) then
X numStones := numStones + 1;
X if (x < maxPoint) and (bord[x + 1, y] = 1) then
X numStones := numStones + 1;
X if (y < maxPoint) and (bord[x, y + 1] = 1) then
X numStones := numStones + 1;
X if numStones = 4 then
X protPoints[x, y] := 1
X else if numStones = 3 then
X begin
X if (x > 0) and
X ((bord[x - 1, y] = 0) or
X ((bord[x - 1, y] = -1) and
X (gList[groupIDs[x - 1, y]].libC = 1))) then
X protPoints[x, y] := 1
X else if (x < maxPoint) and
X ((bord[x + 1, y] = 0) or
X ((bord[x + 1, y] = -1) and
X (gList[groupIDs[x + 1, y]].libC = 1))) then
X protPoints[x, y] := 1
X else if (y > 0) and
X ((bord[x, y - 1] = 0) or
X ((bord[x, y - 1] = -1) and
X (gList[groupIDs[x, y - 1]].libC = 1))) then
X protPoints[x, y] := 1
X else if (y < maxPoint) and
X ((bord[x, y + 1] = 0) or
X ((bord[x, y + 1] = -1) and
X (gList[groupIDs[x, y + 1]].libC = 1))) then
X protPoints[x, y] := 1
X end;
X end;
X for x := 0 to maxPoint do
X for y := 0 to maxPoint do
X if bord[x, y] <> 0 then
X begin
X connectMap[x, y] := 0;
X protPoints[x, y] := 0;
X end;
Xend { genConnects };
X
X{
X generates the whole state of the game.
X}
Xprocedure genState;
Xvar
X i, j: integer;
Xbegin { genState }
X inGenState := true;
X respreicen;
X markDead;
X markLive;
X spread;
X genConnects;
X inGenState := false;
Xend { genState };
X
X{
X generates a value for the [x, y] location that appears to get larger
X for points that are saddle points in the influence graph (klein)
X}
Xfunction tencen(x, y: integer): integer;
Xvar
X a, b, c, d, w, z: integer;
Xbegin { tencen }
X if kleim[x, y] > -1 then { if he does not influence this area, return 50 }
X begin
X tencen := 50;
X exit(tencen);
X end;
X w := kleim[x, y]; { w <= -1 }
X a := iNil;
X if x > 0 then
X if kleim[x - 1, y] > -1 then { if neighbor is not influenced by him }
X a := kleim[x - 1, y] - w; { score is sum of his influence on central }
X b := iNil; { point and my influence on this neighbor }
X if y > 0 then
X if kleim[x, y - 1] > -1 then
X b := kleim[x, y - 1] - w;
X c := iNil;
X if x < maxPoint then
X if kleim[x + 1, y] > -1 then
X c := kleim[x + 1, y] - w;
X d := iNil;
X if y < maxPoint then
X if kleim[x, y + 1] > -1 then
X d := kleim[x, y + 1] - w;
X z := a; { z := max(a, b, c, d) }
X if z <> iNil then
X begin
X if (b <> iNil) and
X (b > z) then
X z := b;
X end
X else
X z := b;
X if z <> iNil then
X begin
X if (c <> iNil) and
X (c > z) then
X z := c;
X end
X else
X z := c;
X if z <> iNil then
X begin
X if (d <> iNil) and
X (d > z) then
X z := d;
X end
X else
X z := d;
X if (z <> iNil) and
X ((x = 0) or
X (y = 0) or
X (x = maxPoint) or
X (y = maxPoint)) then
X z := z * 2; { double z if on the edge of the board ?? }
X if z <> iNil then
X tencen := z
X else
X tencen := 50;
Xend { tencen };
X
Xprocedure initGPUtils;
Xbegin { initGPUtils }
X initArray(markBoard);
X initState;
X marker := 0;
X playMark := 0;
X with gList[0] do
X begin
X isLive := false;
X isDead := false;
X libC := 0;
X size := 0;
X numEyes := 0;
X lx := -1;
X ly := -1;
X end;
X gMap[0] := 0;
X dbStop := false;
X inGenState := false;
Xend. { initGPUtils }
X
END_OF_goPlayUtils.pas
if test 50784 -ne `wc -c <goPlayUtils.pas`; then
echo shar: \"goPlayUtils.pas\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 1 \(of 5\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 2 3 4 5 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 5 archives.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0