From mipos3!omepd!intelisc!littlei!uunet!husc6!bloom-beacon!mit-eddie!uw-beaver!tektronix!tekgen!tekred!games-request Fri Mar 11 07:30:27 PST 1988 Article 195 of comp.sources.games: Path: td2cad!mipos3!omepd!intelisc!littlei!uunet!husc6!bloom-beacon!mit-eddie!uw-beaver!tektronix!tekgen!tekred!games-request From: games-request@tekred.TEK.COM Newsgroups: comp.sources.games Subject: v03i101: go - go board manager sources, Part05/05 Message-ID: <2272@tekred.TEK.COM> Date: 9 Mar 88 17:58:19 GMT Sender: billr@tekred.TEK.COM Lines: 703 Approved: billr@tekred.TEK.COM Submitted by: Fred Hansen 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 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