games-request@tekred.TEK.COM (03/10/88)
Submitted by: Fred Hansen <wjh+@andrew.cmu.edu>
Comp.sources.games: Volume 3, Issue 101
Archive-name: go/Part05
#! /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 5 (of 5)."
# Contents: goMenu.pas
# Wrapped by billr@saab on Wed Mar 9 09:14:47 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f goMenu.pas -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"goMenu.pas\"
else
echo shar: Extracting \"goMenu.pas\" \(16045 characters\)
sed "s/^X//" >goMenu.pas <<'END_OF_goMenu.pas'
X{---------------------------------------------------------------}
X{ Go Menu Manager }
X{ Copyright (c) 1982 by Three Rivers Computer Corp. }
X{ }
X{ Written: December 3, 1982 by Stoney Ballard }
X{ Edit History: }
X{ }
X{ Jan 5, 1983 - Fixed bug in menu select }
X{ Jan 27, 1983 - added setPlayLevel }
X{---------------------------------------------------------------}
X
Xmodule goMenu;
X
Xexports
X
Ximports fileDefs from fileDefs;
Ximports goTree from goTree;
X
Xprocedure initMenu;
Xfunction getMenuCmd: integer;
Xprocedure endCmd;
Xprocedure putMString(cmd: integer; ms: string);
Xprocedure activate(cmd: integer; act: boolean);
Xprocedure restoreCursor;
Xfunction confirmed: boolean;
Xfunction menuGoFile(var fName: pathName): boolean;
Xprocedure waitNoButton;
Xprocedure waitButton;
Xprocedure clearLine(ln: integer);
Xprocedure prompt(s: string);
Xprocedure showComment;
Xprocedure showTag;
Xfunction getHCMenu: integer;
Xfunction getTagMenu: tagPtr;
Xprocedure setMenuCursor;
Xprocedure menuPlayLevel(var playLevel: integer; maxLevel: integer);
X
Xprivate
X
Ximports goCom from goCom;
Ximports goMgr from goMgr;
Ximports popUp from popUp;
Ximports raster from raster;
Ximports screen from screen;
Ximports IO_Others from IO_Others;
Ximports fileSystem from fileSystem;
Ximports fileUtils from fileUtils;
Ximports perq_String from perq_String;
X
Xconst
X mWidth = 180;
X mHeight = 18;
X mLBorder = 12;
X mTBorder = 10;
X mVSpacing = mHeight + 4;
X mHSpacing = mWidth + 8;
X grHeight = mHeight - 2;
X grWidth = (((mWidth - 2 + 15) div 16 + 3) div 4) * 4;
X
Xtype
X mStr = string[20];
X
X menuBox = record
X leftX, topY, rightX, botY: integer;
X isAct: boolean;
X str: mStr;
X end;
X
X greyPat = array[0..grHeight - 1] of array[0..grWidth - 1] of integer;
X pGreyPat = ^greyPat;
X
Xvar
X mItems: array[1..mLast] of menuBox;
X curHiLi, curCmd: integer;
X mGreyP: pGreyPat;
X isMenuCursor: boolean;
X valDesc: pNameDesc;
X cnfDesc: pNameDesc;
X res: resRes;
X goFNames: array[1..1024] of string[25];
X tabXPos, tabYPos: integer;
X
Xprocedure restoreCursor;
Xbegin { restoreCursor }
X if isMenuCursor then
X IOLoadCursor(defaultCursor, 0, 0)
X else
X IOLoadCursor(selCursor, curC, curC);
Xend { restoreCursor };
X
Xprocedure waitNoButton;
Xbegin { waitNoButton }
X while tabYellow or tabWhite or tabGreen or tabBlue or tabSwitch do;
Xend { waitNoButton };
X
Xprocedure waitButton;
Xbegin { waitButton }
X while not tabSwitch do;
Xend { waitButton };
X
Xprocedure menuPlayLevel(var playLevel: integer; maxLevel: integer);
Xvar
X plMenu: pNameDesc;
X i: integer;
X res: resres;
X
X handler outside;
X begin { outside }
X destroyNameDesc(plMenu);
X write(''); {control-G}
X waitNoButton;
X exit(menuPlayLevel);
X end { outside };
X
Xbegin { menuPlayLevel }
X allocNameDesc(maxLevel + 1, 0, plMenu);
X plMenu^.header := 'Play Level?';
X for i := 0 to maxLevel do
X begin
X{$R-}
X plMenu^.commands[i + 1] := intToStr(i);
X{$R=}
X end;
X menu(plMenu, false, 1, maxLevel + 1, -1, -1, -1, res);
X playLevel := res^.indices[1] - 1;
X destroyRes(res);
X destroyNameDesc(plMenu);
Xend { menuPlayLevel };
X
Xfunction getTagMenu: tagPtr;
Xvar
X tp: tagPtr;
X nTags, tIdx, i: integer;
X tMenu: pNameDesc;
X res: resres;
X
X handler outside;
X begin { outside }
X destroyNameDesc(tMenu);
X write(''); {control-G}
X waitNoButton;
X exit(getTagMenu);
X end { outside };
X
Xbegin { getTagMenu }
X getTagMenu := nil;
X tp := treeRoot^.lastTag;
X nTags := 0;
X while tp <> nil do
X begin
X nTags := nTags + 1;
X tp := tp^.nextTag;
X end;
X if nTags = 0 then
X write('') {control-G}
X else
X begin
X tp := treeRoot^.lastTag;
X allocNameDesc(nTags, 0, tMenu);
X tMenu^.header := 'Which Tag?';
X for i := nTags downTo 1 do
X begin
X{$R-}
X tMenu^.commands[i] := tp^.sTag;
X{$R=}
X tp := tp^.nextTag;
X end;
X menu(tMenu, false, 1, nTags, -1, -1, -1, res);
X restoreCursor;
X tIdx := nTags - res^.indices[1];
X destroyRes(res);
X destroyNameDesc(tMenu);
X tp := treeRoot^.lastTag;
X for i := 1 to tIdx do
X tp := tp^.nextTag;
X getTagMenu := tp;
X end;
Xend { getTagMenu };
X
Xprocedure clearLine(ln: integer);
Xvar
X lY: integer;
Xbegin { clearLine }
X lY := winTable[statWin].winTY +
X (ln * (charHeight + lineDel)) + lineY - charHeight;
X rasterop(RAndNot, sWinW - promptX - 32, charHeight,
X promptX, lY, SScreenW, SScreenP,
X promptX, lY, SScreenW, SScreenP);
Xend { clearLine };
X
Xprocedure posLine(ln: integer);
Xvar
X lY: integer;
Xbegin { posLine }
X clearLine(ln);
X lY := winTable[statWin].winTY + (ln * (charHeight + lineDel)) + lineY;
X SSetCursor(promptX, lY);
Xend { posLine };
X
Xprocedure prompt(s: string);
Xbegin { prompt }
X posLine(promptLine);
X write(s);
Xend { prompt };
X
Xprocedure showTag;
Xvar
X ts: string;
Xbegin { showTag }
X posLine(tagLine);
X if getTag(curMove, ts) then
X write('Tag: ', ts);
Xend { showTag };
X
Xprocedure showComment;
Xvar
X cs: string;
Xbegin { showComment }
X posLine(cmtLine);
X if getComment(curMove, cs) then
X write('Comment: ', cs);
Xend { showComment };
X
Xfunction getHCMenu: integer;
Xvar
X res: resres;
X
X handler outside;
X begin { outside }
X restoreCursor;
X getHCMenu := none;
X write(''); {control-G}
X exit(getHCMenu);
X end { outside };
X
Xbegin { getHCMenu }
X menu(valDesc, false, 1, 8, -1, -1, -1, res);
X restoreCursor;
X getHCMenu := res^.indices[1] + 1;
X destroyRes(res);
Xend { getHCMenu };
X
Xfunction menuGoFile(var fName: pathName): boolean;
Xvar
X fi, i: integer;
X fid: fileID;
X fileMenu: pNameDesc;
X res: resres;
X scanP: ptrScanRecord;
X
X function isGoFName(var rName: string): boolean;
X var
X ts: string;
X begin { isGoFName }
X isGoFName := false;
X ts := rName;
X convUpper(ts);
X if length(ts) < 3 then
X exit(isGoFName);
X ts := subStr(ts, length(ts) - 2, 3);
X if ts = '.GO' then
X begin
X rName := subStr(rName, 1, length(rName) - 3);
X isGoFName := true;
X end;
X end { isGoFName };
X
X handler outside;
X begin { outside }
X destroyNameDesc(fileMenu);
X restoreCursor;
X menuGoFile := false;
X write(''); {control-G}
X exit(menuGoFile);
X end { outside };
X
Xbegin { menuGoFile }
X new(scanP);
X scanP^.initialCall := true;
X scanP^.dirName := '';
X prompt('Scanning Directory...');
X fi := 0;
X while FSScan(scanP, fName, fid) do
X if isGoFName(fName) then
X begin
X fi := fi + 1;
X goFNames[fi] := fName;
X end;
X dispose(scanP);
X prompt('');
X if fi < 1 then
X begin
X prompt('No GO files found');
X menuGoFile := false;
X exit(menuGoFile);
X end;
X allocNameDesc(fi, 0, fileMenu);
X fileMenu^.header := 'Available Games';
X for i := 1 to fi do
X begin
X{$R-}
X fileMenu^.commands[i] := goFNames[i];
X{$R=}
X end;
X menu(fileMenu, false, 1, fi, -1, -1, -1, res);
X restoreCursor;
X destroyNameDesc(fileMenu);
X fName := goFNames[res^.indices[1]];
X destroyRes(res);
X menuGoFile := true;
Xend { menuGoFile };
X
Xfunction confirmed: boolean;
X
X handler outside;
X begin { outside }
X confirmed := false;
X restoreCursor;
X exit(confirmed);
X end { outside };
X
Xbegin { confirmed }
X if treeDirty then
X begin
X menu(cnfDesc, false, 1, 2, -1, -1, -1, res);
X restoreCursor;
X confirmed := res^.indices[1] = 2;
X destroyRes(res);
X end
X else
X confirmed := true;
Xend { confirmed };
X
Xprocedure activate(cmd: integer; act: boolean);
Xvar
X dFun: lineStyle;
Xbegin { activate }
X with mItems[cmd] do
X begin
X isAct := act;
X if isAct then
X dFun := drawLine
X else
X dFun := eraseLine;
X line(dFun, leftX, topY, rightX, topY, SScreenP);
X line(dFun, leftX, botY, rightX, botY, SScreenP);
X line(dFun, leftX, topY, leftX, botY, SScreenP);
X line(dFun, rightX, topY, rightX, botY, SScreenP);
X end;
Xend { activate };
X
Xfunction findItem(x, y: integer): integer;
Xvar
X i: integer;
Xbegin { findItem }
X for i := 1 to mLast do
X with mItems[i] do
X if isAct then
X if (x >= leftX) and (x <= rightX) and
X (y >= topY) and (y <= botY) then
X begin
X findItem := i;
X exit(findItem);
X end;
X findItem := none;
Xend { findItem };
X
Xprocedure invertItem(cmd: integer);
Xbegin { invertItem }
X with mItems[cmd] do
X rasterop(rNot, mWidth - 2, mHeight - 2,
X leftX + 1, topY + 1, SScreenW, SScreenP,
X leftX + 1, topY + 1, SScreenW, SScreenP);
Xend { invertItem };
X
Xprocedure checkHighLight;
Xvar
X cmd: integer;
Xbegin { checkHighLight }
X cmd := findItem(tabXPos, tabYPos);
X if cmd <> curHiLi then
X begin
X if curHiLi <> none then
X invertItem(curHiLi);
X if cmd <> none then
X invertItem(cmd);
X curHiLi := cmd;
X end;
Xend { checkHighLight };
X
Xprocedure writeMStr(cmd, cFunc: integer);
Xbegin { writeMStr }
X SChrFunc(cFunc);
X with mItems[cmd] do
X begin
X SSetCursor(leftX + 9, botY - 2);
X write(str);
X end;
X SChrFunc(rRpl);
Xend { writeMStr };
X
Xprocedure xorGrey(cmd: integer);
Xbegin { xorGrey }
X if (cmd <> none) and (cmd <= mLast) then
X with mItems[cmd] do
X rasterop(rXor, mWidth - 2, mHeight - 2,
X leftX + 1, topY + 1, SScreenW, SScreenP,
X 0, 0, grWidth, mGreyP);
Xend { xorGrey };
X
Xprocedure selItem(cmd: integer);
Xbegin { selItem }
X xorGrey(cmd);
X writeMStr(cmd, rOr);
Xend { selItem };
X
Xprocedure deSelItem(cmd: integer);
Xbegin { deSelItem }
X xorGrey(cmd);
X writeMStr(cmd, rAndNot);
Xend { deSelItem };
X
Xprocedure setMenuCursor;
Xbegin { setMenuCursor }
X if not isMenuCursor then
X begin
X IOLoadCursor(defaultCursor, 0, 0);
X isMenuCursor := true;
X end;
Xend { setMenuCursor };
X
Xfunction getMenuCmd: integer;
Xvar
X cmd, nCmd: integer;
X gOn: boolean;
Xbegin { getMenuCmd }
X tabXPos := tabRelX;
X tabYPos := tabRelY;
X with winTable[boardWin] do
X if (tabXPos >= winLX) and (tabXPos <= winRX) and
X (tabYPos >= winTY) and (tabYPos <= winBY) then
X begin
X if isMenuCursor then
X IOLoadCursor(selCursor, curC, curC);
X isMenuCursor := false;
X end
X else
X setMenuCursor;
X checkHighLight;
X if not tabSwitch then
X curCmd := none
X else if tabWhite then
X begin
X with mItems[mBackOne] do
X if isAct then
X begin
X cmd := mBackOne;
X if curHiLi <> cmd then
X begin
X if curHiLi <> none then
X invertItem(curHiLi);
X invertItem(cmd);
X end;
X curHiLi := cmd;
X curCmd := cmd;
X selItem(cmd);
X end
X else
X write(''); {control-G}
X waitNoButton;
X end
X else if tabGreen then
X begin
X with mItems[mForOne] do
X if isAct then
X begin
X cmd := mForOne;
X if curHiLi <> cmd then
X begin
X if curHiLi <> none then
X invertItem(curHiLi);
X invertItem(cmd);
X end;
X curHiLi := cmd;
X curCmd := cmd;
X selItem(cmd);
X end
X else
X write(''); {control-G}
X waitNoButton;
X end
X else { tabYellow or tabBlue }
X begin
X cmd := findItem(tabXPos, tabYPos);
X if cmd <> none then
X begin
X selItem(cmd);
X gOn := true;
X while tabSwitch do
X begin
X nCmd := findItem(tabRelX, tabRelY);
X if nCmd <> cmd then
X begin
X if gOn then
X deSelItem(cmd);
X gOn := false;
X end
X else
X begin
X if not gOn then
X selItem(cmd);
X gOn := true;
X end;
X end;
X if gOn then
X begin
X curCmd := cmd;
X end
X else
X begin
X write(''); {control-G}
X curCmd := none;
X end;
X waitNoButton;
X end
X else
X with winTable[boardWin] do
X if (tabXPos >= winLX) and (tabXPos <= winRX) and
X (tabYPos >= winTY) and (tabYPos <= winBY) then
X curCmd := mPlaceStone
X else
X begin
X write(''); {control-G}
X curCmd := none;
X waitNoButton;
X end;
X end;
X getMenuCmd := curCmd;
Xend { getMenuCmd };
X
Xprocedure endCmd;
Xbegin { endCmd }
X if (curCmd <> none) and (curCmd <= mLast) then
X deSelItem(curCmd);
X curCmd := none;
Xend { endCmd };
X
Xprocedure putMString(cmd: integer; ms: string);
Xbegin { putMString }
X if (curCmd = cmd) and (cmd <= mLast) then
X begin
X deSelItem(cmd);
X curCmd := none;
X end;
X with mItems[cmd] do
X begin
X rasterOp(rAndNot, mWidth - 2, mHeight - 2,
X leftX + 1, topY + 1, SScreenW, SScreenP,
X leftX + 1, topY + 1, SScreenW, SScreenP);
X str := ms;
X writeMStr(cmd, rRpl);
X if curHiLi = cmd then
X invertItem(cmd);
X end;
Xend { putMString };
X
Xprocedure initMenu;
Xvar
X i, j: integer;
X
X procedure setItem(cmd, sx, sy: integer; cs: string);
X begin { setItem }
X with mItems[cmd] do
X begin
X leftX := (sx * mHSpacing) + mLBorder + mWinX;
X topY := (sy * mVSpacing) + mTBorder + mWinY;
X isAct := false;
X rightX := leftX + mWidth - 1;
X botY := topY + mHeight - 1;
X putMString(cmd, cs);
X end;
X end { setItem };
X
Xbegin { initMenu }
X curHiLi := none;
X curCmd := none;
X setItem(mPass, 0, 0, 'Pass');
X setItem(mAutoPlay, 0, 1, 'Generate Move');
X setItem(mPlayMyself, 0, 2, 'Play Myself');
X setItem(mSetPlayLevel, 0, 3, 'Set Play Level');
X setItem(mSetHC, 0, 4, 'Set Handicap');
X setItem(mScore, 0, 5, 'Score');
X setItem(mQuit, 0, 6, 'Quit');
X setItem(mInit, 0, 7, 'Initialize');
X setItem(mBackOne, 1, 0, 'Backup One');
X setItem(mGotoRoot, 1, 1, 'Back to Start');
X setItem(mBackToBr, 1, 2, 'Back to Branch');
X setItem(mBackToStone, 1, 3, 'Back to Stone');
X setItem(mEraseMove, 1, 4, 'Erase Move');
X setItem(mPruneBranches, 1, 5, 'Prune Branches');
X setItem(mDebug, 1, 6, 'Turn Debug On');
X setItem(mWriteFile, 1, 7, 'Write File');
X setItem(mForOne, 2, 0, 'Forward One');
X setItem(mForToLeaf, 2, 1, 'Forward to Leaf');
X setItem(mForToBr, 2, 2, 'Forward to Branch');
X setItem(mStepToTag, 2, 3, 'Step Towards Tag');
X setItem(mGotoTag, 2, 5, 'Go To Tag');
X setItem(mRefBoard, 2, 6, 'Refresh Board');
X setItem(mReadFile, 2, 7, 'Read File');
X setItem(mPutTag, 3, 0, 'Put Tag');
X setItem(mPutCmt, 3, 1, 'Put Comment');
X setItem(mSetStepTag, 3, 2, 'Set Step Tag');
X setItem(mShoState, 3, 3, 'Show Player State');
X setItem(mTogNums, 3, 4, 'Show Stone Numbers');
X setItem(mBoardSize, 3, 5, 'Use Small Board');
X setItem(mPrintBoard, 3, 6, 'Print Board');
X setItem(mPrintDiag, 3, 7, 'Print Diagram');
X initPopUp;
X allocNameDesc(8, 0, valDesc);
X with valDesc^ do
X begin
X{$R-}
X header := 'How Many?';
X commands[1] := '2';
X commands[2] := '3';
X commands[3] := '4';
X commands[4] := '5';
X commands[5] := '6';
X commands[6] := '7';
X commands[7] := '8';
X commands[8] := '9';
X{$R=}
X end;
X allocNameDesc(2, 0, cnfDesc);
X with cnfDesc^ do
X begin
X header := 'Confirm';
X{$R-}
X commands[1] := 'No';
X commands[2] := 'Yes';
X{$R=}
X end;
X new(0, 4, mGreyP);
X i := 0;
X repeat
X for j := 0 to (grWidth - 1) do
X case (i mod 4) of
X 0, 2:
X mGreyP^[i, j] := #177777;
X 1:
X mGreyP^[i, j] := #125252;
X 3:
X mGreyP^[i, j] := #052525;
X end;
X i := i + 1;
X until i > (grHeight - 1);
X isMenuCursor := true;
Xend. { initMenu }
X
END_OF_goMenu.pas
echo shar: 9 control characters may be missing from \"goMenu.pas\"
if test 16045 -ne `wc -c <goMenu.pas`; then
echo shar: \"goMenu.pas\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 5 \(of 5\).
cp /dev/null ark5isdone
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