//Mcmd.bcpl--command menu, error, and timeout procedures
//	Last edited: 2 January 1980

get "streams.d"
get "mdecl.d"
get "mcommon.d"

external [
// OS
	Dvec; AddToZone; Allocate; Free; sysZone; keys
	Resets; Endofs; Gets; ReadBlock; WriteBlock; Closes; CreateDiskStream
	CallSwat; DoubleAdd; Timer; GotoLabel; CallersFrame; GotoFrame

// MINIT0
	DtachFP; RunProgFP; MStatus; FirstStatic; LastStatic; NStatics
	Storage; EndStorage; StateBlock; StatePtr; StateEnd

// MIDAS
	MidasSwat; StartTimer; TimerGoing; Initialized; BegCF; TopFrame
	Resume; StateFileSize; @NestedCFiles

// MASM
	Wss; @WssCSS; PutsCSS; ResetsCSS
	DummyCall1; ErrorProtect; @AbortLabel; @AbortFrame

// MIOC
	Wns

// MTXTBUF
	ClearInText; InputStream; InputTextBuffer; TxtBNewChar

// MOVERLAY
	KillOverlays; FlushOverlays; PeelOverlay
	OverlayZone; OverlayFlushed

// MSYM
	StreamFromTextName

// MDISP
	MakeDispZoneAvail; SetDisplay; Blink; DisplayOff

// MRGN
	DriverLoop; UpdateDisplay; RemoveFromEveryTimeList
	ErrorFlag; AllowedRgn; PaintRgnLine

// MMENU
	CreateAction; ForgetTemporaryActions; ExecuteTextCmdStream
	FormMenu; DoTextAction; CommandCount; SkipCommandCount; CFileStream
	@WsMarkA; WssMark; ThisAction

// MGO
	@QuitF

// MCMDOV
	TextCmdOutStream

// xxACTIONS
	CmdDumpAct; CmdStartWCAct; CmdStopWCAct; CmdShowCmdAct
	CmdConcealAct; CmdErrorContinueAct; CmdErrorAbortAct
	CmdCFileAbortAct
	LastAction; FirstCmdAction; LastCmdAction; TimeTimeOut
	HWCFActions; NHWCFActions

// Machine dependent
	FormHWMenu; DetachHardware

//Defined here
	WnsCSS; WnsCSSD; WnsCS1; WnsCS1D; CmdDoRC; RunProgMenu; ReadCMenu
	FormCmdMenu; ShowActions; DisplayError; ErrorExit; ErrorAbort
	ConfirmAct; StartCmdOverlay; StartLargeOverlay; QuitCmdOverlay
	SetAbort; SetAbortPure; CmdAbort; CmdWriteState; RestoreState
	TEveryTime; TimeOutEveryTime
	CmdCommentStream; CmdCS1; CFOutStream
	SavedLoadText; Confirmed; LoadDone; ShowActionForm
	CmdMDFS; CmdAltMenuP; @CmdAbortAct; PassiveOnly

// Defined here for init only
	DoOverlay; EndError; CmdRunProg; ExecuteCFile
	ProgramAct; NPrograms; ReadCAct; NReadCFiles
]

static	[
	CmdMDFS; CmdCommentStream; CmdCS1; CmdEString2; CmdAltMenuP
	CmdQuitOverlayF; LoadDone = false; Confirmed = false
	ShowActionForm = false; SavedLoadText
	ProgramAct; NPrograms; ReadCAct; NReadCFiles
	PassiveOnly = false; TEveryTime = 0; CFOutStream = 0; @CmdAbortAct
]

// Procedures made external

let WnsCSS(Num) be Wns(CmdCommentStream,Num,0,8)
and WnsCSSD(Num) be Wns(CmdCommentStream,Num,0,10)
and WnsCS1(N) be Wns(CmdCS1,N,0,8)
and WnsCS1D(N) be Wns(CmdCS1,N,0,10)


and FormCmdMenu() be FormMenu(CmdMDFS,FormCmdmenuText)


//Action subr is called with args
// (1) menu stream (always ItemStream)
// (2) MDFS (always CmdMDFS for command menu)
// (3) Mouse button union
// (4) arg from ActionBlock

and FormCmdmenuText(S,MDFS) be
[ //Initialize the ScreenTV stuff for this region to all blanks and
//set dirty
	for L = 0 to MDFS>>Rgn.Height-1 do
		PaintRgnLine(MDFS,L,table [ 0 ] )
	test CmdAltMenuP ne 0
	ifso CmdAltMenuP()
	ifnot
	[
//Kludge to allow partitioning of the main command menu actions according
//to flags in the Action structure.  At the moment only two flags are used:
//ifPassive and ifActive.  Machine-dependent code manipulates the
//PassiveOnly flag to control what's displayed.
	  for I = FirstCmdAction to LastCmdAction by size Action/16 do
	  [ test PassiveOnly
	    ifso if I>>Action.ifPassive eq 0 then loop
	    ifnot if I>>Action.ifActive eq 0 then loop
	    WsMarkA(I)
	  ]
	  if LoadDone & not PassiveOnly then WsMarkA(CmdDumpAct)
	  WsMarkA(ShowActionForm ? CmdConcealAct,CmdShowCmdAct)
	  WsMarkA(TextCmdOutStream eq 0 ? CmdStartWCAct,CmdStopWCAct)
	  FormHWMenu()
	]
]


and ShowActions(Act1,FirstAct,NActs) be
[	if Act1 ne -1 then WsMarkA(Act1)
	for I = 1 to NActs do
	[ WsMarkA(FirstAct); FirstAct = FirstAct+(size Action/16)
	]
]


and SetAbort(lvProc,Arg) be CmdAbortAct =
	CreateAction("Abort",lvProc,Arg,0,$C-100B)


//Like SetAbort but don't clear comment lines at onset of action.
and SetAbortPure(lvProc,Arg) be
[	SetAbort(lvProc,Arg)
	CmdAbortAct>>Action.ifNoRes = 1
]


and CmdAbort(nil,nil,nil) be
[	ResetsCSS(); WssCSS("XXX"); QuitCmdOverlay(0)
]

//Called both as an action (with Menu eq ReadCMenu) and during
//initialization (with Menu eq RunProgMenu).
and CmdDoRC(lvMenu,nil,nil) be
[	if CmdAltMenuP ne 0 then
		ErrorAbort("RdCmds ill. inside an action")
	unless TimerGoing do StartTimer()
	SkipCommandCount = 0
//Use menu when junk numbers are on input line
	if (InputTextBuffer!1 le $9) & (InputTextBuffer!1 ge $0)
		then Resets(InputStream)
	if InputTextBuffer!0 eq 0 do	//Get name from menu?
	[ let DisplayState = SetDisplay(false)	//Display on
	  SetAbort(lv CmdAbort,0)
	  SkipCommandCount = StartCmdOverlay(rv lvMenu)
	  SetDisplay(DisplayState)
	]
//Flush stack and continue in MIDAS.BCPL
	GotoLabel(TopFrame,BegCF,0)
]


and ExecuteCFile(fname,MBunion,nil) = valof
[	Wss(InputStream,fname)
//The MProc word in the Action table for some of the ReadCMenu actions
//contains the entry-skip-count or 0 if no skip
	resultis QuitCmdOverlay(ThisAction>>Action.lvMProc)
]


and ReadCMenu() be
[	ShowActions(CmdAbortAct,LastAction+(NPrograms*(size Action/16)),
		NReadCFiles)
	ShowActions(-1,HWCFActions,NHWCFActions)
]

and RunProgMenu() be ShowActions(CmdAbortAct,LastAction,NPrograms)


//At the moment, this procedure is pretty clean.  However, if at some
//future time code is added to save the state of the current program
//prior to a Dtach, then will have to add the commented code below.
//***NOTE CHANGES HERE FOR D0***
and CmdRunProg(Dtach,nil,nil) be
[	if CmdAltMenuP ne 0 do
	[ if not MStatus>>MStatus.MachRunning then
		ErrorAbort("RunProg/Boot ill. inside an action")
//	  RemoveFromEveryTimeList(QuitF)
//	  ForgetTemporaryActions()
//	  FlushOverlays()
//TimeOut will be on when Dtach'ing from a Go inside a command file.
//	  if TEveryTime ne 0 do
//	  [ RemoveFromEveryTimeList(TEveryTime); TEveryTime = 0
//	  ]
	]
	SetDisplay(true)
//	if Dtach do
//	[ if CFileStream ne 0 do
//	  [ Closes(CFileStream); CFileStream = 0; NestedCFiles = 0
//	  ]
//	  if TextCmdOutStream ne 0 do
//	  [ Closes(TextCmdOutStream); TextCmdOutStream = 0
//	  ]
//	]
	if CFileStream eq 0 then StartTimer()
	MStatus>>MStatus.RunProg = Dtach ? 2,1
	MStatus>>MStatus.CFileStream = CFileStream //For RdCmds
	MStatus>>MStatus.CFOutStream = CFOutStream //For Open/AppendOutput
	MStatus>>MStatus.TextCmdOutStream = TextCmdOutStream //For WrtCmds
	MStatus>>MStatus.ShowActionForm = ShowActionForm
	MakeDispZoneAvail()
//	OverlayFlushed = true
	while PeelOverlay() do [ ]
//Reset Midas and continue execution at "Resume" in MIDAS.BCPL
	RestoreState((Dtach ? DtachFP,RunProgFP),true)
]


and TimeOutEveryTime(nil) be
[	let Now = vec 1; Timer(Now); DoubleAdd(Now,TimeTimeOut)
//Timed out or completed?
	if (Now!0 ge 0) % (CommandCount le 0) do
	[ RemoveFromEveryTimeList(TEveryTime); TEveryTime = 0
	  if CommandCount > 0 do
	  [ SkipCommandCount = 1
//DoTextAction should not return because QuitCmdOverlay will be called
	    DoTextAction($C - 100B)
	  ]
	]
]


//Start a very large overlay:  First call InitP to build the actions;
//InitP returns lvProc for a procedure that will return the menu-forming
//procedure.  Then flush out OverlayZone, add large storage blocks from
//the stack and sysZone to OverlayZone, and call StartCmdOverlay(lvProc);
//overlays needed will swap in during execution.  After QuitCmdOverlay,
//flush everything and clean up.
//**All of callers leading to StartLargeOverlay must be resident.
and StartLargeOverlay(lvInitP,A1,A2,A3,A4; numargs NA) be
[	lvInitP = DummyCall1(lvInitP,NA-1,A1,A2,A3,A4)
	FlushOverlays()
//sysZone block will be used for the D1SimIFU overlay.
	let ExtraSysZone = Allocate(sysZone,#5100)
	if ExtraSysZone eq 0 then MidasSwat(SmallsysZone)
	AddToZone(OverlayZone,ExtraSysZone,#5100)
//Use Dvec so stack depth of DummyCall1(..) above won't add to the #3100
//words here.  Nesting of DummyCall1, SimGo, SetupIMA, PrCCV, SearchBlocks,
//GetBlock, ... is quite deep.
	let ExtraStack = #3100
	Dvec(StartLargeOverlay,lv ExtraStack)
//This block will be used for D1SimCon overlay.
	AddToZone(OverlayZone,ExtraStack,#3100)
	StartCmdOverlay(lvInitP)
	KillOverlays()	//Rebuilds zone if display is off
	Free(sysZone,ExtraSysZone)
]


//Initiate an action which uses an alternate command menu.
//Action terminates with QuitCmdOverlay(Result) and Result is returned,
//or by ErrorExit or DisplayError, which return 0.
//StartCmdOverlay establishes a super-errorset that overrides the
//more local errorsets established by ErrorProtect.
//lvInitP may be either a menu-forming procedure or lvProc for a procedure
//that returns the menu-forming procedure as its result.
and StartCmdOverlay(lvInitP,A1,A2,A3,A4; numargs NA) = valof
[	let DisplayState = DisplayOff
	let oldCmdAltMenuP,oldCmdQuitOverlayF = CmdAltMenuP,CmdQuitOverlayF
	CmdAltMenuP = lvInitP > LastStatic ? lvInitP,
		DummyCall1(lvInitP,NA-1,A1,A2,A3,A4)
	FormCmdMenu()
//DoOverlay has to be called by ErrorProtect so that AbortFrame and
//AbortLabel will be restored after QuitCmdOverlay before any other errors
//can occur.
	let Result = ErrorProtect(lv DoOverlay)
	CmdAltMenuP,CmdQuitOverlayF = oldCmdAltMenuP,oldCmdQuitOverlayF
	FormCmdMenu()
//Restore display to its old on/off state
	SetDisplay(DisplayState); resultis Result
]


//In command files:
//For "Go" CommandCount will be > 0, so DriverLoop() will be called
//For "AltIO", CommandCount will be 0, so the subsidiary menu commands
//will come from the command file.
//DoOverlay is called from StartCmdOverlay and Init2.
and DoOverlay() = valof
[	CmdQuitOverlayF = CallersFrame()
	test (CFileStream ne 0) & (CommandCount le 0) & (not ErrorFlag)
	ifso ExecuteTextCmdStream(CFileStream)
	ifnot DriverLoop()
//The above calls don't return--QuitCmdOverlay(..) will be called
	MidasSwat(CFileRetn)
]


//Used by actions to return from command overlays; by DisplayError and
//ErrorExit to abort either the command overlay or last ErrorProtect call.
and QuitCmdOverlay(Result) be
[	if CmdAltMenuP ne 0 do
	[ ForgetTemporaryActions(); GotoFrame(CmdQuitOverlayF,Result)
	]
	GotoLabel(AbortFrame,AbortLabel,Result)
]


//If numargs is > 3 then CmdCommentStream is untouched
and DisplayError(S1,S2,S3,NoCSS; numargs NA) = valof
[	Confirmed = false
	if not Initialized then CallSwat(S1)
	let DisplayOff = SetDisplay(false)
	if NA < 4 do
	[ ResetsCSS()
	  if NA > 2 then WssCSS(S3)
	  WssCSS(S1)
	]
	CmdEString2 = NA > 1? S2, 0
	ErrorFlag,AllowedRgn = true,CmdMDFS
	let R = StartCmdOverlay(ErrorMenu)
	ErrorFlag = false
	SetDisplay(DisplayOff)
	if R then resultis true	//Continue
//Return 0 from StartCmdOverlay or last ErrorProtect(..)
	QuitCmdOverlay(0)
]

//P is true to continue from error, false to abort command
and EndError(P,nil,nil) be
[	if P then GotoFrame(CmdQuitOverlayF,P)
	QuitCmdOverlay(0)
]


and ErrorMenu() be
[	if CmdEString2 ne 0 then WssMark(CmdEString2,CmdErrorContinueAct)
//Presently cannot allow abort of command within CFile because on
//OpenFile errors this crashes.
	WsMarkA((CFileStream ne 0 ? CmdCFileAbortAct,CmdErrorAbortAct))
]


and ErrorPrin(S1,S2,S3; numargs NA) be
[	if NA < 1 then S1 = "No good"
	Confirmed = false
	test Initialized
	ifso WssCSS(S1)
	ifnot CallSwat(S1)
	if NA > 1 then WssCSS(S2)
	if NA > 2 then WssCSS(S3)
	test CFileStream ne 0
	ifso DisplayError(0,"Continue",0,true)
	ifnot
	[ SetDisplay(false); Blink()
	]
]


//Prints the three argument strings on CmdCommentStream (prints
//"No good" if none of these strings is given); then, if inside a
//command overlay calls DisplayError and exits from the command overlay
//if the user continues; if not inside a command overlay, exits from the
//last ErrorProtect call with a result of 0.
and ErrorExit(S1,S2,S3; numargs NA) be
[	DummyCall1(lv ErrorPrin,NA,S1,S2,S3)
	QuitCmdOverlay(0)
]


//Abort action not in command overlay (actions that are illegal during
//a command overlay, such as SetValue, cannot call ErrorExit because
//they crash Midas).
and ErrorAbort(S1,S2,S3; numargs NA) be
[	DummyCall1(lv ErrorPrin,NA,S1,S2,S3)
	GotoLabel(AbortFrame,AbortLabel,0)
]


and ConfirmAct(Str,TV) = valof
[	if Confirmed then
	[ Confirmed = false; resultis true
	]
	WssCSS(Str)
	for I = 1 to TV!0 do PutsCSS(TV!I)
	WssCSS(" [confirm]")
	UpdateDisplay()
	let DisplayOff = SetDisplay(false)
	[ if not Endofs(keys) then switchon Gets(keys) into
	  [
case $n: case $N: case 177B: case $C-100:
	    ResetsCSS(); WssCSS("XXX")
	    SetDisplay(DisplayOff); resultis false

case $.: case $Y: case $y: case $*N:
	    ResetsCSS(); SetDisplay(DisplayOff); resultis true

default:   Blink()
	  ]
	] repeat
]

//The state of the program consists of its statics (all of which are saved),
//some page zero items (explicitly saved by calls on SaveStatics), and the
//core between StateEnd and EndStorage when SaveState is called.
//The address of the first static (Layout!26) and last static (Layout!27)
//are obtained from the layout vector in the Executive's call to Midas.
//It seems wasteful to save all procedure statics, but this is necessary
//if the Overlay package is used, and it is easier to save all than be
//selective.  There is no provision for enumerating individual blocks of
//storage outside the region delimited by StateEnd and (final) EndStorage.

//SaveState can be called multiple times, allowing the program to
//fire up with different initial information.
and SaveState(S) = valof
[	if S eq 0 then MidasSwat(BadSaveStateFP)
//Copy selected items (zrel statics) into StateBlock
	for I = 0 to StatePtr-2 by 2 do
	[ StateBlock!(I+1) = rv StateBlock!I
	]
	WriteBlock(S,FirstStatic,NStatics)
	let BufSize = StateEnd-EndStorage
	WriteBlock(S,EndStorage,BufSize)
	Closes(S)
//Return file size for statistical purposes
	resultis NStatics+BufSize
]


//Must be resident
and CmdWriteState(nil,nil,nil) be
[	if InputTextBuffer!0 eq 0 then ErrorAbort("Missing state file name")
	let S = StreamFromTextName(InputTextBuffer,
		".STATE",ksTypeWriteOnly,wordItem)
	TxtBNewChar(#177); KillOverlays()
	let C = CFileStream; CFileStream = 0
	StateFileSize = SaveState(S)
	CFileStream = C
]


//S is a stream argument for the file created by SaveState.  reinitFlag
//should be true when RestoreState is called during initialization.
//The program can reinitialize itself during operation by calling
//RestoreState with reinitFlag false.
and RestoreState(FP,reinitFlag) be
[	let S = CreateDiskStream(FP,ksTypeReadOnly)
	if S eq 0 then MidasSwat(BadRestoreStateFP)
	let newEndStorage = EndStorage
	ReadBlock(S,FirstStatic,NStatics)
	if not reinitFlag then
	  if newEndStorage ne StateEnd then MidasSwat(MidasIncompatible)
	let WC = StateEnd - EndStorage
	let N = ReadBlock(S,EndStorage,WC)
	if N ne WC then MidasSwat(StateFileClobbered)
	for I = 0 to StatePtr-2 by 2 do
	[ rv (StateBlock!I) = StateBlock!(I+1)
	]
	Closes(S); GotoLabel(TopFrame,Resume,0)
](1792)