//Mcmdov.bcpl // Last edited: 25 October 1979 get "mdecl.d" get "streams.d" get "altofilesys.d" //This file interfaces the command menu to the various procedures which //carry out actions external [ // OS DoubleAdd; Timer; TruncateDiskStream Resets; Puts; Closes; FileLength; PositionPage // MASM @WssCSS; DoubleNeg; ErrorProtect; Wss // MIOC SimpleTexttoDVec // MTXTBUF TxtBNewChar; ClearInText; InputTextBuffer // MSYM TVtoString; StreamFromTextName // MDISP SetDisplay // MRGN AddToEveryTimeList; ErrorFlag; ScreenTV; ControlV // MMENU DoTextAction; CommandCount; SkipName; SkipCommandCount; CFileStream AbortingCFile // MCMD TimeOutEveryTime; TEveryTime; FormCmdMenu; ShowActionForm DisplayError; ErrorAbort; EndError; CFOutStream Confirmed; ConfirmAct // xxACTIONS TimeTimeOut // Machine dependent @ScreenHeight // Defined here TextCmdOutStream // Defined here for init only CmdConfirm; CmdReturn; CmdAbortCFile; CmdSkipCmd CmdTimeOut; CmdShowError; CmdStartWC; CmdStopWC; CmdShowCmds CmdOpenOutput; CmdCloseOutput; CmdWriteMessage; CmdDumpDisplay ] static [ TextCmdOutStream = 0 ] let CmdShowCmds(Pred,nil,nil) be [ ShowActionForm = Pred; FormCmdMenu() ] and CmdStartWC(nil,nil,nil) be [ if InputTextBuffer!0 eq 0 then ErrorAbort("Type file name first") if not ConfirmAct("Write commands on ",InputTextBuffer) then return TextCmdOutStream = StreamFromTextName(InputTextBuffer,".MIDAS", ksTypeWriteOnly,charItem) ClearInText(); FormCmdMenu() ] and CmdStopWC(nil,nil,nil) be [ if TextCmdOutStream ne 0 do [ TruncateDiskStream(TextCmdOutStream); Closes(TextCmdOutStream) WssCSS("Closed output file"); TextCmdOutStream = 0; FormCmdMenu() ] ] and CmdConfirm(nil,nil,nil) be Confirmed = true and CmdTimeOut(nil,nil,nil) be [ SetDisplay(false) //Turn on display (to execute EveryTime stuff) Timer(TimeTimeOut) let TimeOut = vec 1 unless SimpleTexttoDVec(InputTextBuffer,32,TimeOut) do ErrorAbort("Bad arg for TimeOut") CommandCount = 2 DoubleAdd(TimeTimeOut,TimeOut); DoubleNeg(TimeTimeOut) if TEveryTime eq 0 then TEveryTime = AddToEveryTimeList(TimeOutEveryTime) ] //"L X Skip 3" or "L X Skip .FOO" are legal and CmdSkipCmd(Backward,MBunion,nil) be [ let SC = vec 0 if Backward then Resets(CFileStream) if InputTextBuffer!1 eq $. then [ let len = InputTextBuffer!0 if (len ge 2) & (len le 20) do [ for I = 2 to len do SkipName>>CV↑(I-1) = InputTextBuffer!I SkipName>>lh = len -1; return ] ] unless SimpleTexttoDVec(InputTextBuffer,16,SC) do ErrorAbort("Bad arg for Skip") SkipCommandCount = SC!0 ] and CmdReturn(nil,nil,nil) be [ let SC = vec 0 unless SimpleTexttoDVec(InputTextBuffer,16,SC) do ErrorAbort("Bad arg for Return") AbortingCFile = SC!0+1 ] //This action can be initated by control-Z as well as by the //"Abort-CFile" menu item put up by DisplayError. //If executing a cfile, then set flag to abort it. //Then execute, if doing DisplayError the "Abort" action, else //the control-C action. and CmdAbortCFile(C,nil,nil) be [ if CFileStream ne 0 then AbortingCFile = C if ErrorFlag then EndError(false,nil,nil) DoTextAction($C-100B) ] and CmdShowError(nil,nil,nil) be [ AbortingCFile = -1 let S = TVtoString(InputTextBuffer); TxtBNewChar(177B) DisplayError(S,"Continue") AbortingCFile = 0 ] and CmdOpenOutput(appendF,nil,nil) be [ if CFOutStream ne 0 then Closes(CFOutStream) let ksType,verArg = nil,nil test appendF ifso [ ksType,verArg = ksTypeReadWrite,verLatestCreate ] ifnot [ ksType,verArg = ksTypeWriteOnly,verNew ] CFOutStream = StreamFromTextName(InputTextBuffer, ".REPORT",ksType,charItem,verArg) if appendF then FileLength(CFOutStream) ] and CmdCloseOutput(nil,nil,nil) be [ if CFOutStream ne 0 then [ Closes(CFOutStream); CFOutStream = 0 ] ] //Substitute <cr> for ~ and <space> for \ and CmdWriteMessage(nil,nil,nil) be [ if CFOutStream eq 0 then ErrorAbort("No output file for WriteMessage") for I = 1 to InputTextBuffer!0 do Puts(CFOutStream, (InputTextBuffer!I eq $~ ? $*N, (InputTextBuffer!I eq $\ ? $ ,InputTextBuffer!I))) ] and CmdDumpDisplay(nil,nil,nil) be [ if CFOutStream eq 0 then ErrorAbort("No output file for DumpDisplay") Puts(CFOutStream,$*N) for I = 1 to ScreenHeight do [ if ControlV!I ne 0 do Wss(CFOutStream,ScreenTV!I) Puts(CFOutStream,$*N) ] Puts(CFOutStream,$*N) ]