|
DataMuseum.dkPresents historical artifacts from the history of: DKUUG/EUUG Conference tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DKUUG/EUUG Conference tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: T g
Length: 50784 (0xc660)
Types: TextFile
Names: »goPlayUtils.pas«
└─⟦b20c6495f⟧ Bits:30007238 EUUGD18: Wien-båndet, efterår 1987
└─⟦this⟧ »EUUGD18/General/GoBoard/goPlayUtils.pas«
module goPlayUtils;
exports
imports goCom from goCom;
const
iNil = 32767; { a distinguished value like nil }
maxGroup = 512;
maxSPoint = 16;
type
intBoard = array[-2..maxPoint + 2] of array[-2..maxPoint + 2] of integer;
boolBoard = array[-2..maxPoint + 2] of array[-2..maxPoint + 2] of boolean;
point = record
px, py: integer;
end;
pointList = record
p: array[1..400] of point;
indx: integer;
end;
sPointList = record
p: array[1..maxSPoint] of point;
indx: integer;
end;
intList = record
indx: integer;
v: array[1..400] of integer;
end;
sgRec = record
w, s, sm: integer;
end;
groupRec = record
groupMark: integer;
atLevel: integer;
isLive: boolean;
isDead: boolean;
libC: integer;
numEyes: integer;
size: integer;
lx, ly: integer;
end;
var
kleim, ekstre, bord, ndbord, sGroups, threatBord: intBoard;
groupIDs, connectMap, protPoints: intBoard;
groupSeen, legal: boolBoard;
maxGroupID: integer;
pList, pList1, plist2, plist3, pPlist: pointList;
nlcGroup, aList: intList;
sList: array[1..400] of sgRec;
gList: array[0..maxGroup] of groupRec;
killFlag: boolean;
numCapt: integer;
utilPlayLevel: integer;
treeLibLim: integer;
mySType: sType;
showTrees: boolean;
sGlist: array[1..maxGroup] of integer;
depthLimit: integer;
markBoard: intBoard;
marker: integer;
function saveable(gx, gy: integer; var savex, savey: integer): boolean;
function killable(gx, gy: integer; var killx, killy: integer): boolean;
procedure initBoolBoard(var bb: boolBoard);
procedure spanGroup(x, y: integer; var libs: pointList);
function abs(i: integer): integer;
procedure intersectPlist(var p1, p2, pr: pointList);
procedure initArray(var ary: intBoard);
procedure initState;
procedure copyArray(var dAry, sAry: intBoard);
procedure steik;
procedure spread;
procedure respreicen;
procedure plei(x, y, z: integer);
procedure genState;
procedure saveState;
procedure restoreState;
function tencen(x, y: integer): integer;
procedure genConnects;
procedure initGPUtils;
procedure sortLibs;
private
imports screen from screen;
imports raster from raster;
imports goBoard from goBoard;
imports io_others from io_others;
type
playType = (rem, add, chLib, reMap);
playRec = record
gID: integer;
case kind: playType of
rem, add:
(who, xl, yl, nextGID, sNumber: integer);
chLib:
(oldLC, oldLevel: integer);
reMap:
(oldGID: integer)
end;
var
adjInAtari, adj2Libs: boolean;
intersectNum, spanNum, libMark: integer;
playStack: array[1..1024] of playRec;
playMark: integer;
newGID: integer;
tryLevel: integer;
grpMark: integer;
gMap: array[0..maxGroup] of integer;
dbStop, inGenState: boolean;
exception screwup;
procedure pause;
begin { pause }
{ if dbStop and not inGenState then
begin
while not tabswitch do;
repeat
if tabYellow then
dbStop := false;
until not tabswitch;
end; }
end { pause };
procedure sstone(w, x, y, numb: integer);
var
cx, cy: integer;
begin { sstone }
sReadCursor(cx, cy);
if w = 1 then
placeStone(mySType, x, y, 0, 0, numb)
else if mySType = white then
placeStone(black, x, y, 0, 0, numb)
else
placeStone(white, x, y, 0, 0, numb);
sSetCursor(cx, cy);
end { sstone };
procedure rstone(x, y: integer);
var
cx, cy: integer;
begin { rstone }
sReadCursor(cx, cy);
remStone(x, y);
sSetCursor(cx, cy);
end { rstone };
procedure initBoolBoard(var bb: boolBoard);
var
i, j: integer;
begin { initBoolBoard }
for i := 0 to maxPoint do
for j := 0 to maxPoint do
bb[i, j] := false;
end { initBoolBoard };
function abs(i: integer): integer;
begin { abs }
if i < 0 then
abs := -i
else
abs := i;
end { abs };
procedure sortLibs;
var
i, j, t: integer;
begin { sortLibs }
for i := 1 to maxGroupID do
sGList[i] := i;
for i := 1 to maxGroupID - 1 do
for j := i + 1 to maxGroupID do
if gList[sGlist[i]].libC > gList[sGlist[j]].libC then
begin
t := sGList[i];
sGlist[i] := sGlist[j];
sGlist[j] := t;
end;
end { sortLibs };
procedure spanGroup(x, y: integer; var libs: pointList);
var
lookFor: integer;
procedure span(x, y: integer);
begin { span }
markBoard[x, y] := marker;
if bord[x, y] = 0 then
begin
libs.indx := libs.indx + 1;
libs.p[libs.indx].px := x;
libs.p[libs.indx].py := y;
end
else if bord[x, y] = lookFor then
begin
groupSeen[x, y] := true;
if (x > 0) and (markBoard[x - 1, y] <> marker) then
span(x - 1, y);
if (y > 0) and (markBoard[x, y - 1] <> marker) then
span(x, y - 1);
if (x < maxPoint) and (markBoard[x + 1, y] <> marker) then
span(x + 1, y);
if (y < maxPoint) and (markBoard[x, y + 1] <> marker) then
span(x, y + 1);
end
else if gList[gMap[groupIDs[x, y]]].libC = 1 then
adjInAtari := true
else if (gList[gMap[groupIDs[x, y]]].libC = 2) and
(not gList[gMap[groupIDs[x, y]]].isLive) then
adj2Libs := true;
end { span };
begin { spanGroup }
marker := marker + 1;
if marker = 0 then
begin
initArray(markBoard);
marker := 1;
end;
adjInAtari := false;
adj2Libs := false;
lookFor := bord[x, y];
libs.indx := 0;
span(x, y);
end { spanGroup };
procedure sSpanGroup(x, y: integer; var libs: sPointList);
var
lookFor: integer;
procedure span(x, y: integer);
begin { span }
markBoard[x, y] := marker;
if bord[x, y] = 0 then
begin
libs.indx := libs.indx + 1;
if libs.indx <= maxSPoint then
begin
libs.p[libs.indx].px := x;
libs.p[libs.indx].py := y;
end;
end
else if bord[x, y] = lookFor then
begin
groupSeen[x, y] := true;
if (x > 0) and (markBoard[x - 1, y] <> marker) then
span(x - 1, y);
if (y > 0) and (markBoard[x, y - 1] <> marker) then
span(x, y - 1);
if (x < maxPoint) and (markBoard[x + 1, y] <> marker) then
span(x + 1, y);
if (y < maxPoint) and (markBoard[x, y + 1] <> marker) then
span(x, y + 1);
end
else if gList[gMap[groupIDs[x, y]]].libC = 1 then
adjInAtari := true
else if (gList[gMap[groupIDs[x, y]]].libC = 2) and
(not gList[gMap[groupIDs[x, y]]].isLive) then
adj2Libs := true;
end { span };
begin { sSpanGroup }
marker := marker + 1;
if marker = 0 then
begin
initArray(markBoard);
marker := 1;
end;
adjInAtari := false;
adj2Libs := false;
lookFor := bord[x, y];
libs.indx := 0;
span(x, y);
end { sSpanGroup };
procedure listAdjacents(x, y: integer; var iL: intList);
var
me, him: integer;
procedure span(x, y: integer);
begin { span }
markBoard[x, y] := marker;
if bord[x, y] = me then
begin
if (x > 0) and (markBoard[x - 1, y] <> marker) then
span(x - 1, y);
if (x < maxPoint) and (markBoard[x + 1, y] <> marker) then
span(x + 1, y);
if (y > 0) and (markBoard[x, y - 1] <> marker) then
span(x, y - 1);
if (y < maxPoint) and (markBoard[x, y + 1] <> marker) then
span(x, y + 1);
end
else if bord[x, y] = him then
if gList[gMap[groupIDs[x, y]]].groupMark <> grpMark then
begin
gList[gMap[groupIDs[x, y]]].groupMark := grpMark;
iL.indx := iL.indx + 1;
iL.v[iL.indx] := gMap[groupIDs[x, y]];
end;
end { span };
begin { listAdjacents }
grpMark := grpMark + 1;
marker := marker + 1;
if marker = 0 then
begin
initArray(markBoard);
marker := 1;
end;
iL.indx := 0;
me := bord[x, y];
him := -me;
span(x, y);
end { listAdjacents };
procedure listDiags(x, y: integer; var diags: sPointList);
var
me: integer;
procedure span(x, y: integer);
begin { span }
markBoard[x, y] := marker;
if (x > 0) and (y > 0) and
(bord[x - 1, y - 1] = 0) and
(bord[x, y - 1] <> me) and
(bord[x - 1, y] <> me) and
(markBoard[x - 1, y - 1] <> marker) then
begin
markBoard[x - 1, y - 1] := marker;
diags.indx := diags.indx + 1;
if diags.indx <= maxSPoint then
with diags.p[diags.indx] do
begin
px := x - 1;
py := y - 1;
end;
end;
if (x < maxPoint) and (y > 0) and
(bord[x + 1, y - 1] = 0) and
(bord[x, y - 1] <> me) and
(bord[x + 1, y] <> me) and
(markBoard[x + 1, y - 1] <> marker) then
begin
markBoard[x + 1, y - 1] := marker;
diags.indx := diags.indx + 1;
if diags.indx <= maxSPoint then
with diags.p[diags.indx] do
begin
px := x + 1;
py := y - 1;
end;
end;
if (x > 0) and (y < maxPoint) and
(bord[x - 1, y + 1] = 0) and
(bord[x, y + 1] <> me) and
(bord[x - 1, y] <> me) and
(markBoard[x - 1, y + 1] <> marker) then
begin
markBoard[x - 1, y + 1] := marker;
diags.indx := diags.indx + 1;
if diags.indx <= maxSPoint then
with diags.p[diags.indx] do
begin
px := x - 1;
py := y + 1;
end;
end;
if (x < maxPoint) and (y < maxPoint) and
(bord[x + 1, y + 1] = 0) and
(bord[x, y + 1] <> me) and
(bord[x + 1, y] <> me) and
(markBoard[x + 1, y + 1] <> marker) then
begin
markBoard[x + 1, y + 1] := marker;
diags.indx := diags.indx + 1;
if diags.indx <= maxSPoint then
with diags.p[diags.indx] do
begin
px := x + 1;
py := y + 1;
end;
end;
if (x > 0) and (bord[x - 1, y] = me) and
(markBoard[x - 1, y] <> marker) then
span(x - 1, y);
if (x < maxPoint) and (bord[x + 1, y] = me) and
(markBoard[x + 1, y] <> marker) then
span(x + 1, y);
if (y > 0) and (bord[x, y - 1] = me) and
(markBoard[x, y - 1] <> marker) then
span(x, y - 1);
if (y < maxPoint) and (bord[x, y + 1] = me) and
(markBoard[x, y + 1] <> marker) then
span(x, y + 1);
end { span };
begin { listDiags }
me := bord[x, y];
diags.indx := 0;
marker := marker + 1;
if marker = 0 then
begin
initArray(markBoard);
marker := 1;
end;
span(x, y);
end { listDiags };
procedure intersectPlist(var p1, p2, pr: pointList);
var
i, j, k: integer;
begin { intersectPlist }
marker := marker + 1;
if marker = 0 then
begin
initArray(markBoard);
marker := 1;
end;
pr.indx := 0;
for i := 1 to p1.indx do
with p1.p[i] do
markBoard[px, py] := marker;
j := 0;
for i := 1 to p2.indx do
with p2.p[i] do
if markBoard[px, py] = marker then
begin
j := j + 1;
pr.p[j] := p2.p[i];
end;
pr.indx := j;
end { intersectPlist };
procedure initArray(var ary: intBoard);
var
i, j: integer;
begin { initArray }
for i := 0 to maxPoint do
for j := 0 to maxPoint do
ary[i, j] := 0;
end { initArray };
procedure initState;
var
i, j: integer;
begin { initState }
for i := -2 to maxPoint + 2 do
for j := -2 to maxPoint + 2 do
begin
ekstre[i, j] := 0;
kleim[i, j] := 0;
groupIDs[i, j] := 0;
connectMap[i, j] := 0;
protPoints[i, j] := 0;
end;
end { initState };
procedure copyArray(var dAry, sAry: intBoard);
var
i, j: integer;
begin { copyArray }
for i := 0 to maxPoint do
for j := 0 to maxPoint do
dAry[i, j] := sAry[i, j];
end { copyArray };
{
generates a one-point spread in the force field array (kleim)
the spread from a single point after four calls is:
1
2 2 2
2 4 6 4 2
2 4 8 10 8 4 2
1 2 6 10 62 10 6 2 1
2 4 8 10 8 4 2
2 4 6 4 2
2 2 2
1
}
procedure steik;
var
i, j: integer;
begin { steik }
initArray(ekstre);
for i := 0 to maxPoint do
for j := 0 to maxPoint do
begin
ekstre[i, j] := ekstre[i, j] + kleim[i, j];
if kleim[i, j] > 0 then
begin
if i > 0 then
ekstre[i - 1, j] := ekstre[i - 1, j] + 1;
if j > 0 then
ekstre[i, j - 1] := ekstre[i, j - 1] + 1;
if i < maxPoint then
ekstre[i + 1, j] := ekstre[i + 1, j] + 1;
if j < maxPoint then
ekstre[i, j + 1] := ekstre[i, j + 1] + 1;
end
else if kleim[i, j] < 0 then
begin
if i > 0 then
ekstre[i - 1, j] := ekstre[i - 1, j] - 1;
if j > 0 then
ekstre[i, j - 1] := ekstre[i, j - 1] - 1;
if i < maxPoint then
ekstre[i + 1, j] := ekstre[i + 1, j] - 1;
if j < maxPoint then
ekstre[i, j + 1] := ekstre[i, j + 1] - 1;
end;
end;
copyArray(kleim, ekstre);
end { steik };
{
sets up kleim from the current board position
}
procedure spread;
var
i, j: integer;
begin { spread }
for i := 0 to maxPoint do
for j := 0 to maxPoint do
kleim[i, j] := ndbord[i, j] * 50;
steik;
steik;
steik;
steik;
end { spread };
{
gList is initialized with the size, loc, and libCount of each group
groupIDs contains the serial numbers of the groups.
}
procedure respreicen;
var
i, j, gID, libCount, gSize, who: integer;
procedure span(x, y: integer);
begin { span }
if (bord[x, y] = 0) and
(markBoard[x, y] <> marker) then { a liberty }
begin
markBoard[x, y] := marker;
libCount := libCount + 1;
end
else if (bord[x, y] = who) and
(groupIDs[x, y] = 0) then
begin
groupIDs[x, y] := gID;
gSize := gSize + 1;
if x > 0 then
span(x - 1, y);
if x < maxPoint then
span(x + 1, y);
if y > 0 then
span(x, y - 1);
if y < maxPoint then
span(x, y + 1);
end;
end { span };
begin { respreicen }
gID := 0;
for i := 0 to maxPoint do
for j := 0 to maxPoint do
groupIDs[i, j] := 0;
for i := 0 to maxPoint do
for j := 0 to maxPoint do
if (bord[i, j] <> 0) and { a stone there }
(groupIDs[i, j] = 0) then { not seen yet }
begin
marker := marker + 1;
if marker = 0 then
begin
initArray(markBoard);
marker := 1;
end;
gID := gID + 1;
libCount := 0;
gSize := 0;
who := bord[i, j];
span(i, j); { span the group, collecting info }
with gList[gID] do
begin
groupMark := 0;
atLevel := 0;
isLive := false; { we don't know yet }
isDead := false;
numEyes := -1;
size := gSize;
libC := libCount;
lx := i;
ly := j;
end;
gMap[gID] := gID; { set up identity map }
end;
maxGroupID := gID;
newGID := gID;
grpMark := 0;
end { respreicen };
{
play z at [x, y].
killFlag is set true if anything is killed.
}
procedure plei(x, y, z: integer);
var
i, me, him, myGID: integer;
isNew: boolean;
procedure killGroup(x, y: integer);
begin { killGroup }
playMark := playMark + 1;
with playStack[playMark] do
begin { record this kill }
kind := rem;
who := him;
xl := x;
yl := y;
gID := groupIDs[x, y];
sNumber := board[x, y].mNum;
if showTrees then
rstone(x, y);
end;
numCapt := numCapt + 1;
bord[x, y] := 0;
groupIDs[x, y] := 0;
if x > 0 then
begin
if bord[x - 1, y] = me then
begin
nlcGroup.indx := nlcGroup.indx + 1;
nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x - 1, y]];
end
else if bord[x - 1, y] = him then
killGroup(x - 1, y);
end;
if x < maxPoint then
begin
if bord[x + 1, y] = me then
begin
nlcGroup.indx := nlcGroup.indx + 1;
nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x + 1, y]];
end
else if bord[x + 1, y] = him then
killGroup(x + 1, y);
end;
if y > 0 then
begin
if bord[x, y - 1] = me then
begin
nlcGroup.indx := nlcGroup.indx + 1;
nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y - 1]];
end
else if bord[x, y - 1] = him then
killGroup(x, y - 1);
end;
if y < maxPoint then
begin
if bord[x, y + 1] = me then
begin
nlcGroup.indx := nlcGroup.indx + 1;
nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y + 1]];
end
else if bord[x, y + 1] = him then
killGroup(x, y + 1);
end;
end { killGroup };
procedure mergeGroup(sGID: integer);
var
i: integer;
begin { mergeGroup }
for i := 1 to newGID do
if gMap[i] = sGID then
begin
playMark := playMark + 1;
with playStack[playMark] do
begin
kind := reMap;
gID := i;
oldGID := sGID;
end;
gMap[i] := myGID;
end;
end { mergeGroup };
begin { plei }
me := z;
him := -me;
killFlag := false; { set true if something is killed }
numCapt := 0;
tryLevel := tryLevel + 1;
isNew := false;
bord[x, y] := z; { play the stone }
if (x > 0) and (bord[x - 1, y] = me) then { connect to adjacent group }
myGID := gMap[groupIDs[x - 1, y]]
else if (x < maxPoint) and (bord[x + 1, y] = me) then
myGID := gMap[groupIDs[x + 1, y]]
else if (y > 0) and (bord[x, y - 1] = me) then
myGID := gMap[groupIDs[x, y - 1]]
else if (y < maxPoint) and (bord[x, y + 1] = me) then
myGID := gMap[groupIDs[x, y + 1]]
else { nobody to connect to }
begin
newGID := newGID + 1;
isNew := true;
myGID := newGID;
with gList[myGID] do
begin
groupMark := 0;
atLevel := tryLevel;
isLive := false;
numEyes := -1;
size := -1;
lx := x;
ly := y;
end;
gMap[myGID] := myGID;
end;
groupIDs[x, y] := myGID;
playMark := playMark + 1;
with playStack[playMark] do
begin { record this move }
kind := add;
who := me;
xl := x;
yl := y;
gID := myGID;
sNumber := 0;
if isNew then
nextGID := newGID - 1
else
nextGID := newGID;
if showTrees then
sstone(me, x, y, 0);
end;
{ merge adjacent groups }
if (x > 0) and (bord[x - 1, y] = me) and
(gMap[groupIDs[x - 1, y]] <> myGID) then
mergeGroup(gMap[groupIDs[x - 1, y]]);
if (x < maxPoint) and (bord[x + 1, y] = me) and
(gMap[groupIDs[x + 1, y]] <> myGID) then
mergeGroup(gMap[groupIDs[x + 1, y]]);
if (y > 0) and (bord[x, y - 1] = me) and
(gMap[groupIDs[x, y - 1]] <> myGID) then
mergeGroup(gMap[groupIDs[x, y - 1]]);
if (y < maxPoint) and (bord[x, y + 1] = me) and
(gMap[groupIDs[x, y + 1]] <> myGID) then
mergeGroup(gMap[groupIDs[x, y + 1]]);
{ kill opposing groups, listing affected groups }
nlcGroup.indx := 1;
nlcGroup.v[1] := myGID; { init list to include me }
if (x > 0) and (bord[x - 1, y] = him) and
(gList[gMap[groupIDs[x - 1, y]]].libC = 1) then
begin
killFlag := true;
killGroup(x - 1, y);
end;
if (x < maxPoint) and (bord[x + 1, y] = him) and
(gList[gMap[groupIDs[x + 1, y]]].libC = 1) then
begin
killFlag := true;
killGroup(x + 1, y);
end;
if (y > 0) and (bord[x, y - 1] = him) and
(gList[gMap[groupIDs[x, y - 1]]].libC = 1) then
begin
killFlag := true;
killGroup(x, y - 1);
end;
if (y < maxPoint) and (bord[x, y + 1] = him) and
(gList[gMap[groupIDs[x, y + 1]]].libC = 1) then
begin
killFlag := true;
killGroup(x, y + 1);
end;
{ list groups adjacent to me }
if (x > 0) and (bord[x - 1, y] = him) then
begin
nlcGroup.indx := nlcGroup.indx + 1;
nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x - 1, y]];
end;
if (x < maxPoint) and (bord[x + 1, y] = him) then
begin
nlcGroup.indx := nlcGroup.indx + 1;
nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x + 1, y]];
end;
if (y > 0) and (bord[x, y - 1] = him) then
begin
nlcGroup.indx := nlcGroup.indx + 1;
nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y - 1]];
end;
if (y < maxPoint) and (bord[x, y + 1] = him) then
begin
nlcGroup.indx := nlcGroup.indx + 1;
nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y + 1]];
end;
{ fix liberty count for affected groups }
grpMark := grpMark + 1;
for i := 1 to nlcGroup.indx do
with gList[nlcGroup.v[i]] do
if groupMark <> grpMark then
begin
if atLevel <> tryLevel then
begin
playMark := playMark + 1;
with playStack[playMark] do
begin
kind := chLib;
gID := nlcGroup.v[i];
oldLevel := atLevel;
oldLC := libC;
end;
end;
groupMark := grpMark;
atLevel := tryLevel;
spanGroup(lx, ly, pPList);
libC := pPList.indx;
end;
end { plei };
procedure saveState;
begin { saveState };
playMark := 0;
tryLevel := 0;
newGID := maxGroupID;
end { saveState };
{
undoes a move sequence back to uMark
}
procedure undoTo(uMark: integer);
var
i: integer;
begin { undoTo }
for i := playMark downto uMark + 1 do
with playStack[i] do
if kind = rem then
begin
bord[xl, yl] := who;
groupIDs[xl, yl] := gID;
if showTrees then
sstone(who, xl, yl, sNumber);
end
else if kind = add then
begin
bord[xl, yl] := 0;
groupIDs[xl, yl] := 0;
tryLevel := tryLevel - 1;
newGID := nextGID;
if showTrees then
rstone(xl, yl);
end
else if kind = reMap then
gMap[gID] := oldGID
else { change libs of group - gID is pre-mapped }
with gList[gID] do
begin
libC := oldLC;
atLevel := oldLevel;
end;
playMark := uMark;
end { undoTo };
{
restores the state of the world after trying a move sequence
}
procedure restoreState;
var
i: integer;
begin { restoreState }
if playMark > 0 then
begin
undoTo(0);
playMark := 0;
tryLevel := 0;
end;
end { restoreState };
exception bpt;
{
returns true if the group (at x, y) is killable.
if so, returns the point to play at in killx, killy.
}
function killable(gx, gy: integer; var killx, killy: integer): boolean;
const
tryLimit = 300;
var
me, him, depth, i, j, tryCount, tl, topMark, tkMark, mark2: integer;
sChar: char;
lList, dList: sPointList;
tp: point;
libList: array[1..maxSPoint] of integer;
esc: boolean;
function mtNbrs(x, y: integer): integer;
var
n: integer;
begin { mtNbrs }
n := 0;
if (x > 0) and (bord[x - 1, y] = 0) then
n := n + 1;
if (x < maxPoint) and (bord[x + 1, y] = 0) then
n := n + 1;
if (y > 0) and (bord[x, y - 1] = 0) then
n := n + 1;
if (y < maxPoint) and (bord[x, y + 1] = 0) then
n := n + 1;
mtNbrs := n;
end { mtNbrs };
function tKillTree(tx, ty: integer): boolean;
var
tkMark: integer;
escape: boolean;
function killTree(tx, ty: integer; var escape: boolean): boolean;
label
1, 2;
var
curMark, mark2, mark3, i, j, k, tl, dStart: integer;
lList1, lList2: sPointList;
libList: array[1..maxSPoint] of integer;
tp: point;
esc: boolean;
begin { killTree }
escape := false;
tryCount := tryCount + 1;
if tryCount > tryLimit then
begin
killable := false;
undoTo(tkMark);
for i := 1 to depth - 1 do
begin
sClearChar(sChar, rXor);
end;
depth := 1;
exit(tKilltree);
end;
write(sChar);
depth := depth + 1;
curMark := playMark;
plei(tx, ty, me); { try my move }
pause;
if gList[gMap[groupIDs[tx, ty]]].libC = 0 then { I'm dead }
killTree := false
else if killFlag then { I killed something of his }
killTree := true
else if gList[gMap[groupIDs[gx, gy]]].libC > treeLibLim then { safe }
killTree := false
else
begin
sSpanGroup(gx, gy, lList1); { find his liberties }
if gList[gMap[groupIDs[tx, ty]]].libC = 1 then { he can kill me }
begin
if lList1.indx < maxSPoint then { add that option to his list }
begin
lList1.indx := lList1.indx + 1;
spanGroup(tx, ty, pList2); { find my liberty }
with lList1.p[lList1.indx] do
begin
px := pList2.p[1].px;
py := pList2.p[1].py;
end;
end
else
begin
killTree := false; { forget it }
goto 1;
end;
end;
for i := 1 to maxSPoint do { init liblist so diags can be marked }
libList[i] := -1;
if (utilPlayLevel > 4) and
(lList1.indx > 1) and
(gList[gMap[groupIDs[gx, gy]]].libC > 1) then { try diags }
begin
listDiags(gx, gy, dList);
j := 0;
i := lList1.indx;
while (j < dList.indx) and
(i < maxSPoint) do
begin
j := j + 1;
i := i + 1;
libList[i] := 0; { mark this as a diag }
with dList.p[j] do
begin
lList1.p[i].px := px;
lList1.p[i].py := py;
end;
end;
lList1.indx := i;
end;
if lList1.indx > 1 then { sort by decreasing lib count }
begin
for i := 1 to lList1.indx do
if libList[i] <> 0 then { diags are tried last }
with lList1.p[i] do
begin
mark2 := playMark;
plei(px, py, him);
libList[i] := gList[gMap[groupIDs[gx, gy]]].libC;
if (libList[i] > treeLibLim) or
((libList[i] > (depthLimit - depth)) and
(libList[i] > 2)) then
begin
escape := true;
killTree := false;
goto 1; { he can live }
end;
undoTo(mark2);
end;
for i := 1 to lList1.indx - 1 do
for j := i + 1 to lList1.indx do
if libList[i] < libList[j] then
begin
tl := libList[i];
libList[i] := libList[j];
libList[j] := tl;
tp := lList1.p[i];
lList1.p[i] := lList1.p[j];
lList1.p[j] := tp;
end;
end;
for i := 1 to lList1.indx + 1 do { try his responses }
begin
mark2 := playMark;
if i <= lList1.indx then { try his move }
with lList1.p[i] do
begin
plei(px, py, him); { play his response }
pause;
if gList[gMap[groupIDs[px, py]]].libC < 2 then
goto 2; { a bogus move }
end
else if gList[gMap[groupIDs[gx, gy]]].libC <= 1 then
begin
killTree := true; { can't tenuki if in atari }
goto 1;
end;
if gList[gMap[groupIDs[gx, gy]]].libC > treeLibLim then
begin
escape := true;
killTree := false;
goto 1;
end;
if gList[gMap[groupIDs[gx, gy]]].libC > 1 then
begin { look at my responses }
sSpanGroup(gx, gy, lList2); { list his liberties }
dStart := lList2.indx + 1;
if adjInAtari then { he wins }
begin
killTree := false;
goto 1;
end;
if (lList2.Indx > 2) and adj2Libs then { he wins }
begin
killTree := false;
goto 1;
end;
for k := 1 to maxSPoint do
libList[k] := -1;
if utilPlayLevel > 4 then { account for diagonal moves }
begin
listDiags(gx, gy, dList);
j := 0;
k := lList2.indx;
while (j < dList.indx) and
(k < maxSPoint) do
begin
j := j + 1;
k := k + 1;
libList[k] := 100;
with dList.p[j] do
begin
lList2.p[k].px := px;
lList2.p[k].py := py;
end;
end;
lList2.indx := k;
end;
if lList2.indx > 1 then { sort by increasing lib count }
begin
for k := 1 to lList2.indx do
if libList[k] <> 100 then { diags go last }
with lList2.p[k] do
begin
mark3 := playMark;
plei(px, py, me);
libList[k] := gList[gMap[groupIDs[gx, gy]]].libC;
undoTo(mark3);
end;
for k := 1 to lList2.indx - 1 do
for j := k + 1 to lList2.indx do
if libList[k] > libList[j] then
begin
tl := libList[k];
libList[k] := libList[j];
libList[j] := tl;
tp := lList2.p[k];
lList2.p[k] := lList2.p[j];
lList2.p[j] := tp;
end
else if (libList[k] = libList[j]) and
(libList[k] = 1) then
if mtNbrs(lList2.p[k].px, lList2.p[k].py) <
mtNbrs(lList2.p[j].px, lList2.p[j].py) then
begin
tl := libList[k];
libList[k] := libList[j];
libList[j] := tl;
tp := lList2.p[k];
lList2.p[k] := lList2.p[j];
lList2.p[j] := tp;
end;
end;
for j := 1 to lList2.indx do
begin
if killTree(lList2.p[j].px, lList2.p[j].py, esc) then
goto 2; { this kills him }
if esc and (j >= dStart) then
begin
killTree := false;
goto 1; { don't bother with more diags if escapes }
end;
end;
killTree := false; { none of my responses kills him }
goto 1;
end;
2:
undoTo(mark2);
end;
killTree := true; { none of his responses saves him }
end;
1:
undoTo(curMark);
sClearChar(sChar, rXor);
depth := depth - 1;
end { killTree };
begin { tKillTree }
tryCount := 0;
tkMark := playMark;
tKillTree := killTree(tx, ty, escape);
end { tKillTree };
begin { killable }
dbStop := true;
him := bord[gx, gy]; { find out who I am }
me := -him;
if me = 1 then
sChar := '>'
else
sChar := '|';
write(sChar);
depth := 1;
topMark := playMark;
sSpanGroup(gx, gy, lList); { find his liberties }
if lList.indx = 1 then
begin
killable := true;
killx := lList.p[1].px;
killy := lList.p[1].py;
end
else if lList.indx > treeLibLim then
killable := false
else if adjInAtari then
killable := false
else if (lList.indx > 2) and adj2Libs then
killable := false
else
begin
for i := 1 to maxSPoint do
libList[i] := -1;
if utilPlayLevel > 4 then { account for diagonal moves }
begin
listDiags(gx, gy, dList);
j := 0;
i := lList.indx;
while (j < dList.indx) and
(i < maxSPoint) do
begin
j := j + 1;
i := i + 1;
libList[i] := 100;
with dList.p[j] do
begin
lList.p[i].px := px;
lList.p[i].py := py;
end;
end;
lList.indx := i;
end;
if lList.indx > 1 then { sort by increasing lib count }
begin
for i := 1 to lList.indx do
if libList[i] <> 100 then { diags go last }
with lList.p[i] do
begin
mark2 := playMark;
plei(px, py, me);
libList[i] := gList[gMap[groupIDs[gx, gy]]].libC;
undoTo(mark2);
end;
for i := 1 to lList.indx - 1 do
for j := i + 1 to lList.indx do
if libList[i] > libList[j] then
begin
tl := libList[i];
libList[i] := libList[j];
libList[j] := tl;
tp := lList.p[i];
lList.p[i] := lList.p[j];
lList.p[j] := tp;
end
else if (libList[i] = libList[j]) and
(libList[i] = 1) then
if mtNbrs(lList.p[i].px, lList.p[i].py) <
mtNbrs(lList.p[j].px, lList.p[j].py) then
begin
tl := libList[i];
libList[i] := libList[j];
libList[j] := tl;
tp := lList.p[i];
lList.p[i] := lList.p[j];
lList.p[j] := tp;
end;
end;
for i := 1 to lList.indx do
begin
if legal[lList.p[i].px, lList.p[i].py] then
begin
killx := lList.p[i].px;
killy := lList.p[i].py;
if tKillTree(killx, killy) then
begin
killable := true;
sClearChar(sChar, rXor);
exit(killable);
end;
end;
end;
killable := false;
end;
sClearChar(sChar, rXor);
end { killable };
{
returns true if the group (at gx, gy) is saveable.
if so, returns the point to play at in savex, savey
}
function saveable(gx, gy: integer; var savex, savey: integer): boolean;
label
1;
var
me, him, gx1, gx2, i, j, smark, mark2, tl: integer;
sChar: char;
dList: sPointList;
tp: point;
libList: array[1..maxSPoint] of integer;
begin { saveable }
dbStop := true;
me := bord[gx, gy];
him := -me;
if me = 1 then
sChar := '|'
else
sChar := '>';
write(sChar);
spanGroup(gx, gy, pList3); { find my liberties }
if adjInAtari then { one of my options is to kill }
begin
listAdjacents(gx, gy, aList);
for i := 1 to aList.indx do
if gList[aList.v[i]].libC = 1 then
with gList[aList.v[i]] do
begin
spanGroup(lx, ly, pList1); { find it's liberty }
pList3.indx := pList3.indx + 1;
pList3.p[pList3.indx].px := pList1.p[1].px;
pList3.p[pList3.indx].py := pList1.p[1].py;
end;
end;
for i := 1 to maxSPoint do
libList[i] := -1;
if (utilPlayLevel > 4) and
(gList[gMap[groupIDs[gx, gy]]].libC > 1) then { account for diags }
begin
listDiags(gx, gy, dList);
j := 0;
i := pList3.indx;
while (j < dList.indx) and
(i < maxSPoint) do
begin
j := j + 1;
i := i + 1;
libList[i] := 100;
with dList.p[j] do
begin
pList3.p[i].px := px;
pList3.p[i].py := py;
end;
end;
pList3.indx := i;
end;
if pList3.indx > 1 then { sort by decreasing lib count }
begin
for i := 1 to pList3.indx do
if libList[i] <> 100 then
with pList3.p[i] do
begin
mark2 := playMark;
plei(px, py, me);
libList[i] := gList[gMap[groupIDs[gx, gy]]].libC;
if libList[i] > treeLibLim then { i'm safe }
begin
savex := px;
savey := py;
saveable := true;
goto 1;
end;
undoTo(mark2);
end;
for i := 1 to pList3.indx - 1 do
for j := i + 1 to pList3.indx do
if libList[i] < libList[j] then
begin
tl := libList[i];
libList[i] := libList[j];
libList[j] := tl;
tp := pList3.p[i];
pList3.p[i] := pList3.p[j];
pList3.p[j] := tp;
end;
end;
for i := 1 to pList3.indx do
begin
savex := pList3.p[i].px;
savey := pList3.p[i].py;
if legal[savex, savey] then
begin
smark := playMark;
plei(savex, savey, me);
pause;
if gList[gMap[groupIDs[savex, savey]]].libC > 1 then
if gList[gMap[groupIDs[gx, gy]]].libC > treeLibLim then
begin
saveable := true;
restoreState;
sClearChar(sChar, rXor);
exit(saveable);
end
else if gList[gMap[groupIDs[gx, gy]]].libC > 1 then
if not killable(gx, gy, gx1, gx2) then
begin
saveable := true;
restoreState;
sClearChar(sChar, rXor);
exit(saveable);
end;
undoTo(smark);
end;
end;
saveable := false;
1:
restoreState;
sClearChar(sChar, rXor);
end { saveable };
{
marks unsavable groups as dead
}
procedure markDead;
var
i, j, gx, gy: integer;
begin { markDead }
for i := 1 to maxGroupID do
with gList[i] do
if killable(lx, ly, gx, gy) then
isDead := not saveable(lx, ly, gx, gy)
else
isDead := false;
for i := 0 to maxPoint do
for j := 0 to maxPoint do
if bord[i, j] = 0 then
ndbord[i, j] := 0
else if gList[groupIDs[i, j]].isDead then
ndbord[i, j] := 0
else
ndbord[i, j] := bord[i, j];
end { markDead };
{
marks groups with two eyes as live
}
procedure markLive;
var
i, j, size, sMark: integer;
saw1, sawm1: boolean;
procedure span(x, y: integer);
begin { span }
if ndbord[x, y] = 1 then
saw1 := true
else if ndbord[x, y] = -1 then
sawm1 := true
else if sGroups[x, y] = 0 then
begin
sGroups[x, y] := sMark;
size := size + 1;
if x > 0 then
span(x - 1, y);
if x < maxPoint then
span(x + 1, y);
if y > 0 then
span(x, y - 1);
if y < maxPoint then
span(x, y + 1);
end;
end { span };
function checkLive(x, y: integer): boolean;
var
numEyes, who: integer;
procedure span(x, y: integer);
begin { span }
markBoard[x, y] := marker;
if ndbord[x, y] = 0 then
with sList[sGroups[x, y]] do
begin
if (sm <> marker) and
(w = who) then
begin
sm := marker;
if s > 6 then
exit(checkLive);
numEyes := numEyes + 1;
if numEyes > 1 then
exit(checkLive);
end;
end
else if bord[x, y] = who then
begin
if (x > 0) and
(markBoard[x - 1, y] <> marker) then
span(x - 1, y);
if (x < maxPoint) and
(markBoard[x + 1, y] <> marker) then
span(x + 1, y);
if (y > 0) and
(markBoard[x, y - 1] <> marker) then
span(x, y - 1);
if (y < maxPoint) and
(markBoard[x, y + 1] <> marker) then
span(x, y + 1);
end;
end { span };
begin { checkLive }
checkLive := true;
numEyes := 0;
who := bord[x, y];
marker := marker + 1;
span(x, y);
checkLive := false;
end { checkLive };
begin { markLive }
sMark := 0;
initArray(sGroups);
for i := 0 to maxPoint do
for j := 0 to maxPoint do
if (sGroups[i, j] = 0) and
(ndbord[i, j] = 0) then
begin
size := 0;
sMark := sMark + 1;
sawm1 := false;
saw1 := false;
span(i, j);
sList[sMark].s := size;
sList[sMark].sm := 0;
if sawm1 then
if saw1 then
sList[sMark].w := 0
else
sList[sMark].w := -1
else if saw1 then
sList[sMark].w := 1
else
sList[sMark].w := 0;
end;
for i := 1 to maxGroupID do
with gList[i] do
if not isDead then
isLive := checkLive(lx, ly);
end { markLive };
{
generates the connection map and the protected point map.
}
procedure genConnects;
var
x, y, numStones: integer;
begin { genConnects }
for x := 0 to maxPoint do
for y := 0 to maxPoint do
begin
connectMap[x, y] := 0;
protPoints[x, y] := 0;
end;
for x := 0 to maxPoint do
for y := 0 to maxPoint do
if bord[x, y] = 1 then { map connections to this stone }
begin
if x > 0 then { direct connection }
connectMap[x - 1, y] := connectMap[x - 1, y] + 1;
if x < maxPoint then
connectMap[x + 1, y] := connectMap[x + 1, y] + 1;
if y > 0 then
connectMap[x, y - 1] := connectMap[x, y - 1] + 1;
if y < maxPoint then
connectMap[x, y + 1] := connectMap[x, y + 1] + 1;
if (x > 0) and (y > 0) and { diagonal connection }
(bord[x - 1, y] = 0) and (bord[x, y - 1] = 0) then
connectMap[x - 1, y - 1] := connectMap[x - 1, y - 1] + 1;
if (x < maxPoint) and (y > 0) and
(bord[x + 1, y] = 0) and (bord[x, y - 1] = 0) then
connectMap[x + 1, y - 1] := connectMap[x + 1, y - 1] + 1;
if (x < maxPoint) and (y < maxPoint) and
(bord[x + 1, y] = 0) and (bord[x, y + 1] = 0) then
connectMap[x + 1, y + 1] := connectMap[x + 1, y + 1] + 1;
if (x > 0) and (y < maxPoint) and
(bord[x - 1, y] = 0) and (bord[x, y + 1] = 0) then
connectMap[x - 1, y + 1] := connectMap[x - 1, y + 1] + 1;
if (x > 1) and (kleim[x - 1, y] > 3) then { one point jump }
connectMap[x - 2, y] := connectMap[x - 2, y] + 1;
if (x < (maxPoint - 1)) and (kleim[x + 1, y] > 3) then
connectMap[x + 2, y] := connectMap[x + 2, y] + 1;
if (y > 1) and (kleim[x, y - 1] > 3) then
connectMap[x, y - 2] := connectMap[x, y - 2] + 1;
if (y < (maxPoint - 1)) and (kleim[x, y + 1] > 3) then
connectMap[x, y + 2] := connectMap[x, y + 2] + 1;
if (x > 1) and (y > 0) and { knight's move }
(kleim[x - 1, y] > 3) and (kleim[x - 1, y - 1] > 3) then
connectMap[x - 2, y - 1] := connectMap[x - 2, y - 1] + 1;
if (x > 0) and (y > 1) and
(kleim[x, y - 1] > 3) and (kleim[x - 1, y - 1] > 3) then
connectMap[x - 1, y - 2] := connectMap[x - 1, y - 2] + 1;
if (x < (maxPoint - 1)) and (y > 0) and
(kleim[x + 1, y] > 3) and (kleim[x + 1, y - 1] > 3) then
connectMap[x + 2, y - 1] := connectMap[x + 2, y - 1] + 1;
if (x < maxPoint) and (y > 1) and
(kleim[x, y - 1] > 3) and (kleim[x + 1, y - 1] > 3) then
connectMap[x + 1, y - 2] := connectMap[x + 1, y - 2] + 1;
if (x > 1) and (y < maxPoint) and
(kleim[x - 1, y] > 3) and (kleim[x - 1, y + 1] > 3) then
connectMap[x - 2, y + 1] := connectMap[x - 2, y + 1] + 1;
if (x > 0) and (y < (maxPoint - 1)) and
(kleim[x, y + 1] > 3) and (kleim[x - 1, y + 1] > 3) then
connectMap[x - 1, y + 2] := connectMap[x - 1, y + 2] + 1;
if (x < (maxPoint - 1)) and (y < maxPoint) and
(kleim[x + 1, y] > 3) and (kleim[x + 1, y + 1] > 3) then
connectMap[x + 2, y + 1] := connectMap[x + 2, y + 1] + 1;
if (x < maxPoint) and (y < (maxPoint - 1)) and
(kleim[x, y + 1] > 3) and (kleim[x + 1, y + 1] > 3) then
connectMap[x + 1, y + 2] := connectMap[x + 1, y + 2] + 1;
end
else if bord[x, y] = 0 then { see if protected point }
begin
numStones := 0;
if x = 0 then
numStones := numStones + 1;
if y = 0 then
numStones := numStones + 1;
if x = maxPoint then
numStones := numStones + 1;
if y = maxPoint then
numStones := numStones + 1;
if (x > 0) and (bord[x - 1, y] = 1) then
numStones := numStones + 1;
if (y > 0) and (bord[x, y - 1] = 1) then
numStones := numStones + 1;
if (x < maxPoint) and (bord[x + 1, y] = 1) then
numStones := numStones + 1;
if (y < maxPoint) and (bord[x, y + 1] = 1) then
numStones := numStones + 1;
if numStones = 4 then
protPoints[x, y] := 1
else if numStones = 3 then
begin
if (x > 0) and
((bord[x - 1, y] = 0) or
((bord[x - 1, y] = -1) and
(gList[groupIDs[x - 1, y]].libC = 1))) then
protPoints[x, y] := 1
else if (x < maxPoint) and
((bord[x + 1, y] = 0) or
((bord[x + 1, y] = -1) and
(gList[groupIDs[x + 1, y]].libC = 1))) then
protPoints[x, y] := 1
else if (y > 0) and
((bord[x, y - 1] = 0) or
((bord[x, y - 1] = -1) and
(gList[groupIDs[x, y - 1]].libC = 1))) then
protPoints[x, y] := 1
else if (y < maxPoint) and
((bord[x, y + 1] = 0) or
((bord[x, y + 1] = -1) and
(gList[groupIDs[x, y + 1]].libC = 1))) then
protPoints[x, y] := 1
end;
end;
for x := 0 to maxPoint do
for y := 0 to maxPoint do
if bord[x, y] <> 0 then
begin
connectMap[x, y] := 0;
protPoints[x, y] := 0;
end;
end { genConnects };
{
generates the whole state of the game.
}
procedure genState;
var
i, j: integer;
begin { genState }
inGenState := true;
respreicen;
markDead;
markLive;
spread;
genConnects;
inGenState := false;
end { genState };
{
generates a value for the [x, y] location that appears to get larger
for points that are saddle points in the influence graph (klein)
}
function tencen(x, y: integer): integer;
var
a, b, c, d, w, z: integer;
begin { tencen }
if kleim[x, y] > -1 then { if he does not influence this area, return 50 }
begin
tencen := 50;
exit(tencen);
end;
w := kleim[x, y]; { w <= -1 }
a := iNil;
if x > 0 then
if kleim[x - 1, y] > -1 then { if neighbor is not influenced by him }
a := kleim[x - 1, y] - w; { score is sum of his influence on central }
b := iNil; { point and my influence on this neighbor }
if y > 0 then
if kleim[x, y - 1] > -1 then
b := kleim[x, y - 1] - w;
c := iNil;
if x < maxPoint then
if kleim[x + 1, y] > -1 then
c := kleim[x + 1, y] - w;
d := iNil;
if y < maxPoint then
if kleim[x, y + 1] > -1 then
d := kleim[x, y + 1] - w;
z := a; { z := max(a, b, c, d) }
if z <> iNil then
begin
if (b <> iNil) and
(b > z) then
z := b;
end
else
z := b;
if z <> iNil then
begin
if (c <> iNil) and
(c > z) then
z := c;
end
else
z := c;
if z <> iNil then
begin
if (d <> iNil) and
(d > z) then
z := d;
end
else
z := d;
if (z <> iNil) and
((x = 0) or
(y = 0) or
(x = maxPoint) or
(y = maxPoint)) then
z := z * 2; { double z if on the edge of the board ?? }
if z <> iNil then
tencen := z
else
tencen := 50;
end { tencen };
procedure initGPUtils;
begin { initGPUtils }
initArray(markBoard);
initState;
marker := 0;
playMark := 0;
with gList[0] do
begin
isLive := false;
isDead := false;
libC := 0;
size := 0;
numEyes := 0;
lx := -1;
ly := -1;
end;
gMap[0] := 0;
dbStop := false;
inGenState := false;
end. { initGPUtils }