|
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: 38049 (0x94a1)
Types: TextFile
Names: »goBoard.pas«
└─⟦b20c6495f⟧ Bits:30007238 EUUGD18: Wien-båndet, efterår 1987
└─⟦this⟧ »EUUGD18/General/GoBoard/goBoard.pas«
{---------------------------------------------------------------}
{ goBoard.Pas }
{ }
{ Board Image Handler for Go }
{ Copyright (c) 1982 by Three Rivers Computer Corp. }
{ }
{ Written: June 3, 1982 by Stoney Ballard }
{ Edit History: }
{ June 3, 1982 Started }
{ June 4, 1982 Add dead group removal }
{ June 10, 1982 Use new go file manager }
{ Nov 8, 1982 Split From Go.Pas }
{---------------------------------------------------------------}
module goBoard;
exports
imports goCom from goCom;
imports screen from screen;
type
SoundType = (atari, koV, s3, s4, die, die2, die3, error);
exception gbFatal;
procedure initGoBoard;
procedure clearBoard;
procedure addHCStones(num: integer);
procedure placeStone(which: sType; lx, ly, ofx, ofy, moveNum: integer);
procedure placeAlt(which: sType; lx, ly, ofx, ofy: integer);
procedure remStone(lx, ly: integer);
procedure showPass(which: sType);
procedure remPass;
function passLocCur(cx, cy: integer): boolean;
function bLocCur(cx, cy: integer; var lx, ly, sx, sy: integer): boolean;
procedure beep(sound: SoundType);
procedure dotStone(lx, ly: integer);
procedure showAllStones;
procedure printBoard(isDiagram: boolean);
procedure showCaptures;
procedure turnIs(who: sType);
procedure refreshBoard;
procedure putBString(x, y: integer; s: string);
private
imports raster from raster;
imports io_unit from io_unit;
imports io_others from io_others;
imports memory from memory;
imports fileSystem from fileSystem;
imports perq_string from perq_string;
imports csdx from csdx;
imports goMgr from goMgr;
imports goTree from goTree;
imports goMenu from goMenu;
imports system from system;
imports go from go;
const
sPicC = 15;
sPicS = 32;
hpPicS = 10;
hpPicC = 4;
patchS = 40;
patchC = 19;
picWW = 4;
htHeight = 4;
htWidth = 48;
gridWidth = 32;
pGridWidth = 34; { for printing }
xMargin = boardX + gridWidth;
yMargin = boardY + gridWidth;
pxMargin = pBoardX + pGridWidth;
pyMargin = pBoardY + pGridWidth;
gridBorder = gridWidth div 2;
pGridBorder = pGridWidth div 2;
gridXMargin = xMargin - gridBorder;
gridYMargin = yMargin - gridBorder;
pGridXMargin = pxMargin - pGridBorder;
pGridYMargin = pyMargin - pGridBorder;
htXMargin = xMargin - gridWidth;
htYMargin = yMargin - gridWidth;
phtXMargin = pxMargin - pGridWidth;
phtYMargin = pyMargin - pGridWidth;
boardHeight = 20 * gridWidth;
pBoardHeight = 20 * pGridWidth;
slopSize = 2;
lineWidth = 2;
extraXO = pxMargin; { 96 }
extraYO = 768;
pedgeBX = pxMargin; { 96 }
pedgeBY = pyMargin + (19 * pGridWidth); { 672 }
pedgeLX = pBoardX; { 64 }
pedgeLY = pBoardY + (19 * pGridWidth); { 640 }
edgeBX = xMargin; { 96 }
edgeBY = yMargin + (19 * GridWidth); { 672 }
edgeLX = BoardX; { 64 }
edgeLY = BoardY + (19 * GridWidth); { 640 }
rCmtY = pBoardX + pBoardHeight + 32;
lCmtY = rCmtY + 8 + charHeight;
tFntWidth = 6;
tFntHeight = 9;
maxSMark = 2;
type
htArray = array[0..3] of array[0..47] of integer;
pHtArray = ^htArray;
beepbuf = array[0..63] of integer;
pBeepBuf = ^BeepBuf;
var
hcDot: pPicBuf;
htBuf: pHtArray;
patch: array[1..9] of pPicBuf;
StatPtr: IOStatPtr;
statRec: IOStatus;
sounds: array[atari..die3] of pBeepBuf;
stones: array[sType] of pPicBuf;
stoneCir: pPicBuf;
stoneMarks: array[0..maxSMark] of pPicBuf;
sysFont: fontPtr;
goBNumFont: fontPtr;
goSNumFont: fontPtr;
goTNumFont: fontPtr;
goSLetFont: fontPtr;
printing: boolean;
scrSavPtr: rasterPtr;
sNumBase, sNumStart: integer;
bigNums: boolean;
{ merely beeps the given sound }
procedure beep(sound: SoundType);
var
zilch: Double;
rep, i: integer;
savY, savB, savG, savW, savS: boolean;
begin { beep }
if sound = error then
IOBeep
else
begin
savY := tabYellow;
savW := tabWhite;
savG := tabGreen;
savB := tabBlue;
savS := tabSwitch;
IOSetModeTablet(offTablet);
if sound = die then
rep := 128 * 3
else
rep := 128;
UnitIO(Speech, RECAST(sounds[sound],IOBufPtr), IOWriteHiVol, rep,
zilch, nil, StatPtr);
IOSetModeTablet(relTablet);
tabYellow := savY;
tabWhite := savW;
tabGreen := savG;
tabBlue := savB;
tabSwitch := savS;
end;
end { beep };
procedure showCaptures;
var
s: string;
procedure dectos(val: integer);
var
numC, i: integer;
ts: string;
c: char;
begin { dectos }
if val = 0 then
s := '0'
else
begin
numC := 0;
adjust(ts, 20);
while val <> 0 do
begin
numC := numC + 1;
ts[numC] := chr(val mod 10 + ord('0'));
val := val div 10;
end;
adjust(s, numC);
for i := 1 to numC do
s[i] := ts[numC - i + 1];
end;
end { dectos };
begin { showCaptures }
dectos(captures[black]);
SSetCursor(captNBX, captNY);
write(s:3);
dectos(captures[white]);
SSetCursor(captNWX, captNY);
write(s:3);
end { showCaptures };
procedure turnIs(who: sType);
begin { turnIs }
SSetCursor(turnX, turnY);
if who = white then
write('White to Play')
else
write('Black to Play');
end { turnIs };
procedure putBString(x, y: integer; s: string);
var
xp, yp, sw, i: integer;
fnt: fontPtr;
begin { putBString }
setFont(goSNumFont);
fnt := goSNumFont;
for i := 1 to length(s) do
if (s[i] >= '0') and
(s[i] <= '9') then
s[i] := chr(ord(s[i]) - #46 + #200);
xp := x * gridWidth + xMargin;
yp := y * gridWidth + yMargin;
sw := 0;
for i := 1 to length(s) do
sw := sw + fnt^.index[lAnd(ord(s[i]), #177)].width;
xp := xp - (sw div 2);
yp := yp + (fnt^.height div 2) + 1;
SChrFunc(0);
SSetCursor(xp, yp);
write(s:0);
end { putBString };
procedure putStone(cx, cy, mNum: integer; val: bVal);
const
widthPad = 2;
shPad = 3;
bhPad = 1;
var
x, y, org: integer;
ns: string;
sl, d, sw, n: integer;
cv: integer;
fnt: fontPtr;
heightPad: integer;
begin { putStone }
x := cx - sPicC;
y := cy - sPicC;
rasterop(RAndNot, sPicS, sPicS, x, y, SScreenW, SScreenP,
0, 0, picWW, stones[black]);
rasterop(ROr, sPicS, sPicS, x, y, SScreenW, SScreenP,
0, 0, picWW, stones[val]);
if numbEnabled and (mNum > 0) then
begin
n := mNum - sNumBase;
if n < 0 then
exit(putStone);
n := n + sNumStart;
if bigNums then
begin
fnt := goBNumFont;
heightPad := bhPad;
end
else
begin
fnt := goSNumFont;
heightPad := shPad;
end;
if val = black then
if bigNums then
begin
if n > 9 then
org := ord('`')
else
org := ord('j');
end
else
begin
if n > 99 then
org := #24
else
org := #0;
end
else if bigNums then
begin
if n > 9 then
org := ord('@')
else
org := ord('J');
end
else
begin
if n > 99 then
org := #12
else
org := #60;
end;
ns := ' ';
sl := 0;
sw := 0;
if n >= 100 then
d := 100
else if n >= 10 then
d := 10
else
d := 1;
while d > 0 do
begin
sl := sl + 1;
cv := (n div d) + org;
ns[sl] := chr(cv + #200);
sw := sw + fnt^.index[cv].width;
n := n mod d;
d := d div 10;
end;
adjust(ns, sl);
x := cx - (sw div 2) + widthPad;
y := cy + (fnt^.height div 2) + heightPad;
setFont(fnt);
SSetCursor(x, y);
SChrFunc(6);
write(ns);
setFont(sysFont);
SChrFunc(0);
end;
end { putStone };
procedure showStone(lx, ly: integer);
var
x, y: integer;
begin { showStone }
with board[lx, ly] do
begin
if printing then
if printLarge then
begin
x := lx * pGridWidth + pxMargin;
y := ly * pGridWidth + pyMargin;
end
else { small board }
begin
x := lx * gridWidth + xMargin;
y := ly * gridWidth + yMargin;
end
else { not printing }
begin
x := lx * gridWidth + xMargin + xOfs;
y := ly * gridWidth + yMargin + yOfs;
end;
putStone(x, y, mNum, val);
end;
end { showStone };
procedure showAllStones;
var
i, j: integer;
begin { showAllStones }
for j := 0 to maxPoint do
for i := 0 to maxPoint do
if board[i, j].val <> empty then
showStone(i, j);
end { showAllStones };
procedure dotStone(lx, ly: integer);
var
x, y: integer;
begin { dotStone }
with board[lx, ly] do
if val <> empty then
begin
x := lx * gridWidth + xMargin + xOfs;
y := ly * gridWidth + yMargin + yOfs;
rasterop(rNot, 2, 2, x, y, SScreenW, SScreenP,
x, y, SScreenW, SScreenP);
end;
end { dotStone };
function bLocCur(cx, cy: integer; var lx, ly, sx, sy: integer): boolean;
var
xic, yic: integer;
begin { bLocCur }
bLocCur := false;
if printing and printLarge then
begin
cx := cx - pGridXMargin;
cy := cy - pGridYMargin;
end
else
begin
cx := cx - gridXMargin;
cy := cy - gridYMargin;
end;
if (cx >= 0) and (cy >= 0) then
begin
if printing and printLarge then
begin
lx := cx div pGridWidth;
ly := cy div pGridWidth;
xic := lx * pGridWidth + pGridBorder;
yic := ly * pGridWidth + pGridBorder;
end
else
begin
lx := cx div gridWidth;
ly := cy div gridWidth;
xic := lx * gridWidth + gridBorder;
yic := ly * gridWidth + gridBorder;
end;
if (lx <= maxPoint) and (ly <= maxPoint) then
begin
if cx < xic - slopSize then
cx := xic - slopSize
else if cx > xic + slopSize then
cx := xic + slopSize;
if cy < yic - slopSize then
cy := yic - slopSize
else if cy > yic + slopSize then
cy := yic + slopSize;
sx := cx - xic;
sy := cy - yic;
bLocCur := true;
end;
end;
end { bLocCur };
procedure showPass(which: sType);
begin { showPass }
SSetCursor(passX, passY);
if which = black then
write(' Black Passes ')
else
write(' White Passes ');
passShowing := true;
end { showPass };
procedure remPass;
begin { remPass }
SSetCursor(passX, passY);
write(' ');
passShowing := false;
end { remPass };
function passLocCur(cx, cy: integer): boolean;
begin { passLocCur }
passLocCur := (cx >= passX) and (cx < (passX + passW)) and
(cy <= passY) and (cy > (passY - passH));
end { passLocCur };
procedure showAlt(lx, ly: integer; sv: sType);
begin { showAlt }
with board[lx, ly] do
begin
lx := lx * gridWidth + xMargin - sPicC;
ly := ly * gridWidth + yMargin - sPicC;
rasterop(ROr, sPicS, sPicS, lx, ly, SScreenW, SScreenP,
0, 0, picWW, stoneCir);
end;
end { showAlt };
procedure placeStone(which: sType; lx, ly, ofx, ofy, moveNum: integer);
begin { placeStone }
if passShowing then
remPass;
with board[lx, ly] do
begin
val := which;
xOfs := ofx;
yOfs := ofy;
mNum := moveNum;
showStone(lx, ly);
end;
end { placeStone };
procedure placeAlt(which: sType; lx, ly, ofx, ofy: integer);
begin { placeAlt }
with board[lx, ly] do
begin
val := alternate;
xOfs := 0;
yOfs := 0;
mNum := -1;
showAlt(lx, ly, which);
end;
end { placeAlt };
procedure remStone(lx, ly: integer);
var
x, y, i, j: integer;
begin { remStone }
with board[lx, ly] do
if val <> empty then
begin
val := empty;
if ly = 0 then
i := 1
else if ly = maxPoint then
i := 7
else i := 4;
if lx = maxPoint then
i := i + 2
else if lx > 0 then
i := i + 1;
if printing and printLarge then
begin
x := (lx * pGridWidth) - patchC + pxMargin;
y := (ly * pGridWidth) - patchC + pyMargin;
end
else
begin
x := (lx * gridWidth) - patchC + xMargin;
y := (ly * gridWidth) - patchC + yMargin;
end;
rasterop(RRpl, patchS, patchS, x, y, SScreenW, SScreenP,
0, 0, picWW, patch[i]);
if ((lx = 3) and (ly = 3)) or
((lx = 9) and (ly = 3)) or
((lx = 15) and (ly = 3)) or
((lx = 3) and (ly = 9)) or
((lx = 9) and (ly = 9)) or
((lx = 15) and (ly = 9)) or
((lx = 3) and (ly = 15)) or
((lx = 9) and (ly = 15)) or
((lx = 15) and (ly = 15)) then
if printing and printLarge then
rasterop(ROr, hpPicS, hpPicS,
pxMargin + (pGridWidth * lx) - hpPicC,
pyMargin + (pGridWidth * ly) - hpPicC,
SScreenW, SScreenP,
0, 0, picWW, hcDot)
else
rasterop(ROr, hpPicS, hpPicS,
xMargin + (gridWidth * lx) - hpPicC,
yMargin + (gridWidth * ly) - hpPicC,
SScreenW, SScreenP,
0, 0, picWW, hcDot);
for i := lx - 1 to lx + 1 do
for j := ly - 1 to ly + 1 do
if (i >= 0) and (i <= maxPoint) and
(j >= 0) and (j <= maxPoint) then
if (board[i, j].val = black) or
(board[i, j].val = white) then
begin
showStone(i, j);
if (i = dotSX) and (j = dotSY) then
dotStone(i, j);
end;
end;
end { remStone };
procedure addHCStones(num: integer);
begin { addHCStones }
case num of
2:
begin
placeStone(black, 3, 15, 0, 0, 0);
placeStone(black, 15, 3, 0, 0, 0);
end;
3:
begin
placeStone(black, 3, 15, 0, 0, 0);
placeStone(black, 15, 3, 0, 0, 0);
placeStone(black, 15, 15, 0, 0, 0);
end;
4:
begin
placeStone(black, 3, 15, 0, 0, 0);
placeStone(black, 15, 3, 0, 0, 0);
placeStone(black, 3, 3, 0, 0, 0);
placeStone(black, 15, 15, 0, 0, 0);
end;
5:
begin
placeStone(black, 3, 3, 0, 0, 0);
placeStone(black, 3, 15, 0, 0, 0);
placeStone(black, 9, 9, 0, 0, 0);
placeStone(black, 15, 3, 0, 0, 0);
placeStone(black, 15, 15, 0, 0, 0);
end;
6:
begin
placeStone(black, 3, 3, 0, 0, 0);
placeStone(black, 3, 15, 0, 0, 0);
placeStone(black, 3, 9, 0, 0, 0);
placeStone(black, 15, 9, 0, 0, 0);
placeStone(black, 15, 3, 0, 0, 0);
placeStone(black, 15, 15, 0, 0, 0);
end;
7:
begin
placeStone(black, 3, 3, 0, 0, 0);
placeStone(black, 3, 15, 0, 0, 0);
placeStone(black, 3, 9, 0, 0, 0);
placeStone(black, 9, 9, 0, 0, 0);
placeStone(black, 15, 9, 0, 0, 0);
placeStone(black, 15, 3, 0, 0, 0);
placeStone(black, 15, 15, 0, 0, 0);
end;
8:
begin
placeStone(black, 3, 3, 0, 0, 0);
placeStone(black, 3, 9, 0, 0, 0);
placeStone(black, 3, 15, 0, 0, 0);
placeStone(black, 9, 3, 0, 0, 0);
placeStone(black, 9, 15, 0, 0, 0);
placeStone(black, 15, 3, 0, 0, 0);
placeStone(black, 15, 9, 0, 0, 0);
placeStone(black, 15, 15, 0, 0, 0);
end;
9:
begin
placeStone(black, 3, 3, 0, 0, 0);
placeStone(black, 3, 9, 0, 0, 0);
placeStone(black, 3, 15, 0, 0, 0);
placeStone(black, 9, 3, 0, 0, 0);
placeStone(black, 9, 9, 0, 0, 0);
placeStone(black, 9, 15, 0, 0, 0);
placeStone(black, 15, 3, 0, 0, 0);
placeStone(black, 15, 9, 0, 0, 0);
placeStone(black, 15, 15, 0, 0, 0);
end;
end;
end { addHCStones };
procedure drawBoard;
var
i, j, c, lWidth, x, y, w: integer;
xMarg, yMarg, gWid, eBX, eBY, eLX, eLY: integer;
begin { drawBoard }
if printing then
begin
lWidth := 1;
if printLarge then
begin
xMarg := pxMargin;
yMarg := pyMargin;
gWid := pGridWidth;
eBX := pedgeBX;
eBY := pedgeBY;
eLX := pedgeLX;
eLY := pedgeLY;
end
else
begin
xMarg := xMargin;
yMarg := yMargin;
gWid := gridWidth;
eBX := edgeBX;
eBY := edgeBY;
eLX := edgeLX;
eLY := edgeLY;
end
end
else
begin
lWidth := lineWidth;
xMarg := xMargin;
yMarg := yMargin;
gWid := gridWidth;
end;
if not printing then
for i := (htYMargin div htHeight) to
((htYMargin + boardHeight) div htHeight) - 1 do
rasterop(RRpl, bWinW - (htXMargin * 2), htHeight,
htXMargin, i * htHeight, SScreenW, SScreenP,
htXMargin, 0, htWidth, htBuf)
else
rasterop(rAndNot, bWinW - (phtXMargin * 2), (bWinY + bWinH) - phtYMargin,
phtXMargin, phtYMargin, SScreenW, SScreenP,
phtXMargin, phtYMargin, SScreenW, SScreenP);
for i := 1 to maxPoint - 1 do
rasterop(ROrNot, (maxPoint * gWid) + lWidth, lWidth,
xMarg, yMarg + (i * gWid), SScreenW, SScreenP,
xMarg, yMarg + (i * gWid), SScreenW, SScreenP);
for i := 1 to maxPoint - 1 do
rasterop(ROrNot, lWidth, (maxPoint * gWid) + lWidth,
xMarg + (i * gWid), yMarg, SScreenW, SScreenP,
xMarg + (i * gWid), yMarg, SScreenW, SScreenP);
rasterop(ROrNot, (maxPoint * gWid) + lineWidth, lineWidth,
xMarg, yMarg, SScreenW, SScreenP,
xMarg, yMarg, SScreenW, SScreenP);
rasterop(ROrNot, (maxPoint * gWid) + lineWidth, lineWidth,
xMarg, yMarg + (maxPoint * gWid), SScreenW, SScreenP,
xMarg, yMarg + (maxPoint * gWid), SScreenW, SScreenP);
rasterop(ROrNot, lineWidth, (maxPoint * gWid) + lineWidth,
xMarg, yMarg, SScreenW, SScreenP,
xMarg, yMarg, SScreenW, SScreenP);
rasterop(ROrNot, lineWidth, (maxPoint * gWid) + lineWidth,
xMarg + (maxPoint * gWid), yMarg, SScreenW, SScreenP,
xMarg + (maxPoint * gWid), yMarg, SScreenW, SScreenP);
rasterop(ROr, hpPicS, hpPicS,
xMarg + (gWid * 3) - hpPicC,
yMarg + (gWid * 3) - hpPicC,
SScreenW, SScreenP,
0, 0, picWW, hcDot);
rasterop(ROr, hpPicS, hpPicS,
xMarg + (gWid * 9) - hpPicC,
yMarg + (gWid * 3) - hpPicC,
SScreenW, SScreenP,
0, 0, picWW, hcDot);
rasterop(ROr, hpPicS, hpPicS,
xMarg + (gWid * 15) - hpPicC,
yMarg + (gWid * 3) - hpPicC,
SScreenW, SScreenP,
0, 0, picWW, hcDot);
rasterop(ROr, hpPicS, hpPicS,
xMarg + (gWid * 3) - hpPicC,
yMarg + (gWid * 9) - hpPicC,
SScreenW, SScreenP,
0, 0, picWW, hcDot);
rasterop(ROr, hpPicS, hpPicS,
xMarg + (gWid * 9) - hpPicC,
yMarg + (gWid * 9) - hpPicC,
SScreenW, SScreenP,
0, 0, picWW, hcDot);
rasterop(ROr, hpPicS, hpPicS,
xMarg + (gWid * 15) - hpPicC,
yMarg + (gWid * 9) - hpPicC,
SScreenW, SScreenP,
0, 0, picWW, hcDot);
rasterop(ROr, hpPicS, hpPicS,
xMarg + (gWid * 3) - hpPicC,
yMarg + (gWid * 15) - hpPicC,
SScreenW, SScreenP,
0, 0, picWW, hcDot);
rasterop(ROr, hpPicS, hpPicS,
xMarg + (gWid * 9) - hpPicC,
yMarg + (gWid * 15) - hpPicC,
SScreenW, SScreenP,
0, 0, picWW, hcDot);
rasterop(ROr, hpPicS, hpPicS,
xMarg + (gWid * 15) - hpPicC,
yMarg + (gWid * 15) - hpPicC,
SScreenW, SScreenP,
0, 0, picWW, hcDot);
if not printing then
begin
SSetCursor(captBX, captY);
write('Black Captures');
SSetCursor(captWX, captY);
write('White Captures');
end
else
begin
for i := 1 to maxPoint + 1 do
begin
if i > 9 then
w := charWidth * 2
else
w := charWidth;
x := ((i - 1) * gWid) + eBX - (w div 2);
y := eBY + charHeight;
SSetCursor(x, y);
write(i:0);
end;
for i := 0 to maxPoint do
begin
x := eLX - charWidth;
y := eLY - ((maxPoint - i) * gWid) + (charHeight div 2);
c := i + ord('A');
if c >= ord('I') then
c := c + 1;
SSetCursor(x, y);
SPutChr(chr(c));
end;
end;
end { drawBoard };
procedure clearBoard;
var
i, j, xMarg, yMarg, gWid: integer;
begin { clearBoard }
drawBoard;
if printing and printLarge then
begin
xMarg := pxMargin;
yMarg := pyMargin;
gWid := pGridWidth;
end
else
begin
xMarg := xMargin;
yMarg := yMargin;
gWid := gridWidth;
end;
rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[1],
xMarg + (0 * gWid) - patchC,
yMarg + (0 * gWid) - patchC,
SScreenW, SScreenP);
rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[2],
xMarg + (6 * gWid) - patchC,
yMarg + (0 * gWid) - patchC,
SScreenW, SScreenP);
rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[3],
xMarg + (18 * gWid) - patchC,
yMarg + (0 * gWid) - patchC,
SScreenW, SScreenP);
rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[4],
xMarg + (0 * gWid) - patchC,
yMarg + (6 * gWid) - patchC,
SScreenW, SScreenP);
rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[5],
xMarg + (6 * gWid) - patchC,
yMarg + (6 * gWid) - patchC,
SScreenW, SScreenP);
rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[6],
xMarg + (18 * gWid) - patchC,
yMarg + (6 * gWid) - patchC,
SScreenW, SScreenP);
rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[7],
xMarg + (0 * gWid) - patchC,
yMarg + (18 * gWid) - patchC,
SScreenW, SScreenP);
rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[8],
xMarg + (6 * gWid) - patchC,
yMarg + (18 * gWid) - patchC,
SScreenW, SScreenP);
rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[9],
xMarg + (18 * gWid) - patchC,
yMarg + (18 * gWid) - patchC,
SScreenW, SScreenP);
for i := 0 to maxPoint do
for j := 0 to maxPoint do
board[i][j].val := empty;
if not printing then
remPass;
end { clearBoard };
procedure showPlayHistory(isDiagram: boolean);
var
curRow, curCol, bx, by, bLim, curNum: integer;
cm, scm, tm: pMRec;
c: char;
needWipe, lastCapt: boolean;
procedure getMarks;
var
bx, by, lbx, lby, gx, gy, sMark, x, y, w: integer;
curC: char;
done: boolean;
begin { getMarks }
lbx := -1;
lby := -1;
curC := 'a';
sMark := 0;
prompt('Point at locations to place marks - press off board to stop');
while tabSwitch do;
done := false;
setFont(goSLetFont);
sChrFunc(rOr);
repeat
while not tabSwitch do;
if bLocCur(tabRelX, tabRelY, bx, by, gx, gy) then
begin
if printLarge then
begin
x := bx * pGridWidth + pxMargin;
y := by * pGridWidth + pyMargin;
end
else
begin
x := bx * GridWidth + xMargin;
y := by * GridWidth + yMargin;
end;
if board[bx, by].val = empty then
begin
rasterop(rXor, 20, 30, x - 10, y - 15, SScreenW, SScreenP,
x - 10, y - 15, SScreenW, SScreenP);
w := goSLetFont^.index[ord(curC)].width - 2;
SSetCursor(x - (w div 2), y + 7);
write(curC);
curC := chr(ord(curC) + 1);
end
else
begin
x := x - sPicC;
y := y - sPicC;
if (bx = lbx) and (by = lby) then
begin
if sMark <= maxSMark then
begin
rasterop(RXor, sPicS, sPicS, x, y, SScreenW, SScreenP,
0, 0, picWW, stoneMarks[sMark]);
sMark := sMark + 1;
end
else
sMark := 0;
end
else
sMark := 0;
if sMark <= maxSMark then
rasterop(RXor, sPicS, sPicS, x, y, SScreenW, SScreenP,
0, 0, picWW, stoneMarks[sMark]);
end;
lbx := bx;
lby := by;
end
else
done := true;
while tabSwitch do;
until done;
sChrFunc(rRpl);
setFont(sysFont);
prompt('');
end { getMarks };
begin { showPlayHistory }
if not isDiagram then
begin
bLim := 99;
sNumBase := 0;
sNumStart := 0;
end
else
bLim := 1000;
curNum := 0;
needWipe := true;
wipeTreeMarks;
cm := curMove;
while cm <> treeRoot do
begin
cm^.mark := true;
cm := cm^.blink;
end;
repeat
if needWipe then
begin
rasterop(rAndNot, 768, 1024 - extraYO,
0, extraYO, SScreenW, SScreenP,
0, extraYO, SScreenW, SScreenP);
curRow := 0;
curCol := 0;
showAllStones;
needWipe := false;
end;
cm := cm^.flink;
while not cm^.mark do
cm := cm^.slink;
with cm^ do
case id of
hcPlay:
begin
addHCStones(hcNum);
curNum := 1;
end;
move:
begin
if board[mx, my].val <> empty then
begin
bx := curCol * (20 * charWidth) + extraXO;
by := curRow * charHeight * 2 + extraYO + charHeight;
SSetCursor(bx, by);
if who = black then
write('Black ')
else
write('White ');
write((moveN - sNumBase):0, ' at ');
c := chr(my + ord('A'));
if c >= 'I' then
c := chr(ord(c) + 1);
write(c, '-', (mx + 1):0);
curRow := curRow + 1;
if (curRow * charHeight * 2 + extraYO + charHeight) > 1000 then
begin
curRow := 0;
curCol := curCol + 1;
end;
end
else
placeStone(who, mx, my, 0, 0, moveN);
curNum := moveN;
lastCapt := false;
repeat
if cm^.flink = nil then
lastCapt := true
else if cm^.flink^.id = remove then
begin
cm := cm^.flink;
if curNum < sNumBase then
remStone(cm^.mx, cm^.my);
end
else
lastCapt := true;
until lastCapt;
end;
pass:
begin
if not isDiagram then
begin
bx := curCol * (20 * charWidth) + extraXO;
by := curRow * charHeight * 2 + extraYO + charHeight;
SSetCursor(bx, by);
if who = black then
write('Black ')
else
write('White ');
write((moveN - sNumBase):0, ' - Pass');
curRow := curRow + 1;
if (curRow * charHeight * 2 + extraYO + charHeight) > 1000 then
begin
curRow := 0;
curCol := curCol + 1;
end;
end;
curNum := moveN;
end;
end { case };
if (curNum = bLim) or
(cm = curMove) then
begin
if isDiagram then
getMarks;
csdx;
if cm <> curMove then
begin
sNumBase := bLim + 1;
bLim := bLim + 100;
needWipe := true;
clearBoard;
scm := curMove;
curMove := treeRoot;
switchBranch(cm);
curMove := scm;
wipeTreeMarks;
tm := curMove;
while tm <> treeRoot do
begin
tm^.mark := true;
tm := tm^.blink;
end;
end;
end;
until cm = curMove;
sNumBase := 0;
sNumStart := 0;
end { showPlayHistory };
procedure printBoard(isDiagram: boolean);
label
1;
var
sseg: integer;
neWas: boolean;
cmSave: pMRec;
procedure showFName;
var
fnX, fnY: integer;
fs: string;
begin { showFName }
getFNameString(fs);
if fs <> '' then
begin
fnY := charHeight + 8;
fnX := 384 - (charWidth * length(fs) div 2);
SSetCursor(fnX, fnY);
write(fs);
end;
end { showFName };
procedure showComments(isDiagram: boolean);
var
cx: integer;
cs: string;
begin { showComments }
if not isDiagram then
if getComment(treeRoot, cs) then
begin
cx := 384 - (charWidth * length(cs) div 2);
SSetCursor(cx, rCmtY);
write(cs);
end;
if getComment(curMove, cs) then
begin
cx := 384 - (charWidth * length(cs) div 2);
if isDiagram then
SSetCursor(cx, charHeight + 8)
else
SSetCursor(cx, lCmtY);
write(cs);
end;
end { showComments };
handler ctlC;
begin { ctlC }
IOKeyClear;
resetInput;
write(''); {control-G}
prompt('');
goto 1;
end { ctlC };
function readNum(pmpt: string): integer;
label
2;
var
n: integer;
handler notNumber(fn: pathName);
begin { notNumber }
write(''); {control-G}
prompt('Bad Number - try again: ');
goto 2;
end { notNumber };
handler pastEOF(fn: pathName);
begin { pastEOF }
write(''); {control-G}
goto 1;
end { pastEOF };
begin { readNum }
prompt('');
2:
resetInput;
write(pmpt);
readln(n);
readNum := n;
end { readNum };
begin { printBoard }
if curMove = treeRoot then
begin
write(''); {control-G}
exit(printBoard);
end;
cmSave := curMove;
if scrSavPtr = nil then
begin
createSegment(sseg, 192, 1, 192);
scrSavPtr := makePtr(sseg, 0, rasterPtr);
end;
rasterop(rRpl, 768, 1024, 0, 0, SScreenW, scrSavPtr,
0, 0, SScreenW, SScreenP);
rasterop(rAndNot, 768, 1024, 0, 0, SScreenW, SScreenP,
0, 0, SScreenW, SScreenP);
printing := true;
neWas := numbEnabled;
numbEnabled := true;
sNumBase := 0;
sNumStart := 0;
drawBoard;
bigNums := false;
showAllStones;
if not isDiagram then
begin
showComments(false);
showFName;
csdx;
end
else
begin
sNumBase := readNum('Start Numbering at which stone? ');
sNumStart := readNum('First Number is? ');
prompt('');
end;
clearBoard;
bigNums := true;
if isDiagram then
showComments(true);
showPlayHistory(isDiagram);
1:
rasterop(rRpl, 768, 1024, 0, 0, SScreenW, SScreenP,
0, 0, SScreenW, scrSavPtr);
printing := false;
numbEnabled := neWas;
bigNums := false;
sNumBase := 0;
sNumStart := 0;
clearBoard;
curMove := treeRoot;
captures[black] := 0;
captures[white] := 0;
switchBranch(cmSave);
curMove := cmSave;
end { printBoard };
procedure refreshBoard;
begin { refreshBoard }
drawBoard;
showAllStones;
dotSX := -1;
dotLast;
end { refreshBoard };
{ initializes this module }
procedure initGoBoard;
procedure beepInit;
const
size = (WordSize(beepBuf) * 7 + 255) div 256;
var
d: SoundType;
i,j: integer;
beepSeg: integer;
begin { beepInit }
createSegment(beepSeg, size, 1, size);
new(0,4,StatPtr);
for d := atari to die3 do
new(beepSeg, 4, sounds[d]);
for i := 0 to 63 do
begin
sounds[atari]^[i] := 511;
case i mod 3 of
0: sounds[koV]^[i] := -5;
1: sounds[koV]^[i] := 34;
2: sounds[koV]^[i] := 0;
end;
case i mod 4 of
0: sounds[s3]^[i] := 1023;
1: sounds[s3]^[i] := 0;
2: sounds[s3]^[i] := -1;
3: sounds[s3]^[i] := -1023;
end;
case i mod 5 of
0: sounds[s4]^[i] := 43;
1: sounds[s4]^[i] := 765;
2: sounds[s4]^[i] := -432;
3: sounds[s4]^[i] := -6;
4: sounds[s4]^[i] := 345;
end;
end;
for i := 0 to 1 do
for j := 0 to 15 do
begin
sounds[die]^[i*32+j] := -1;
sounds[die]^[i*32+16+j] := 0;
end;
for i := 0 to 63 do
begin
sounds[die2]^[i] := sounds[die]^[i];
sounds[die3]^[i] := sounds[die]^[i];
end;
end { beepInit };
procedure definePats;
var
i, j, blks, gbg: integer;
fid: fileID;
begin { definePats }
fid := FSLookup('go.animate', blks, gbg);
if fid = 0 then
begin
writeln('GO.ANIMATE not found');
raise gbFatal;
end
else if blks < 8 then
begin
writeln('GO.ANIMATE too short');
raise gbFatal;
end;
new(0, 4, stones[black]);
FSBlkRead(fid, 0, recast(stones[black], pDirBlk));
new(0, 4, stones[white]);
FSBlkRead(fid, 1, recast(stones[white], pDirBlk));
new(0, 4, hcDot);
FSBlkRead(fid, 2, recast(hcDot, pDirBlk));
new(0, 4, selCursor);
FSBlkRead(fid, 3, recast(selCursor, pDirBlk));
new(0, 4, stoneCir);
FSBlkRead(fid, 4, recast(stoneCir, pDirBlk));
new(0, 4, stoneMarks[0]);
FSBlkRead(fid, 5, recast(stoneMarks[0], pDirBlk));
new(0, 4, stoneMarks[1]);
FSBlkRead(fid, 6, recast(stoneMarks[1], pDirBlk));
new(0, 4, stoneMarks[2]);
FSBlkRead(fid, 7, recast(stoneMarks[2], pDirBlk));
new(0, 4, htBuf);
for i := 0 to 47 do
htBuf^[0, i] := #125252;
for i := 0 to 47 do
htBuf^[1, i] := 0;
for i := 0 to 47 do
htBuf^[2, i] := #125252; { #52525 }
for i := 0 to 47 do
htBuf^[3, i] := 0;
for i := 1 to 9 do
new(0, 4, patch[i]);
end { definePats };
procedure setupFont;
var
bblks, sblks, tBlks, lBlks, bits, fontseg, i: integer;
bFID, sFID, tFID, lFID: fileID;
bp: pDirBlk;
begin { setupFont }
sysFont := getFont;
bFID := FSLookup('goBNum.kst', bblks, bits);
if bFID = 0 then
begin
writeln('goBNum.KST not found');
raise gbFatal;
end;
sFID := FSLookup('goSNum.kst', sblks, bits);
if sFID = 0 then
begin
writeln('goSNum.KST not found');
raise gbFatal;
end;
tFID := FSLookup('goTNum.kst', tblks, bits);
if sFID = 0 then
begin
writeln('goTNum.KST not found');
raise gbFatal;
end;
lFID := FSLookup('goSLets.kst', lBlks, bits);
if lFID = 0 then
begin
writeln('goSLets.KST not found');
raise gbFatal;
end;
createSegment(fontseg, bblks + sblks + tBlks + lBlks, 1,
bblks + sblks + tBlks + lBlks);
for i := 0 to bblks - 1 do
begin
bp := makePtr(fontSeg, i * 256, pDirBlk);
FSBlkRead(bFID, i, bp);
end;
goBNumFont := makePtr(fontseg, 0, fontPtr);
for i := 0 to sblks - 1 do
begin
bp := makePtr(fontSeg, (i + bblks) * 256, pDirBlk);
FSBlkRead(sFID, i, bp);
end;
goSNumFont := makePtr(fontseg, bblks * 256, fontPtr);
for i := 0 to tblks - 1 do
begin
bp := makePtr(fontSeg, (i + bblks + sBlks) * 256, pDirBlk);
FSBlkRead(tFID, i, bp);
end;
goTNumFont := makePtr(fontseg, (bblks + sBlks) * 256, fontPtr);
for i := 0 to lBlks - 1 do
begin
bp := makePtr(fontSeg, (i + bblks + sBlks + tBlks) * 256, pDirBlk);
FSBlkRead(lFID, i, bp);
end;
goSLetFont := makePtr(fontseg, (bblks + sBlks + tBlks) * 256, fontPtr);
end { setupFont };
begin { initGoBoard }
printing := false;
beepInit;
definePats;
setupFont;
scrSavPtr := nil;
sNumBase := 0;
sNumStart := 0;
bigNums := false;
end. { initGoBoard }