//mcmd.bcpl

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
	Wss; Wns; Resets; Closes; Puts; Endofs; Gets; keys
	CallSwat; GotoLabel; MyFrame; GotoFrame; Noop
	OpenFile; MoveBlock; Zero; Timer; DoubleAdd
	fpComCm

	MidasCFA; StartTimer; MidasFinish		// MIDAS
	TimeStart; TimeLoad; TimeFinish; Initialized; Restoring

	SymbKeyComp; DummyCall			// MASM
	ErrorProtect; @AbortLabel; @AbortFrame

	SetDisplay; Blink; DisplayOff		// MDISP

	MarkRgnDispDirty; DriverLoop; FinishFlag	// MRGN
	PaintRgnLine; BeginError; EndError; UpdateDisplay
	AddToEveryTimeList; RemoveFromEveryTimeList

	DoubleNeg; ShowAddr; ShowBadAddr	// MMPRGN

	CreateAction; ForgetTemporaryActions; ItemStream	// MMENU
	ExecuteTextCmdStream; MarkMenus; FormMenu; DoTextAction
	CommandCount; SkipCommandCount; CFileStream; AbortingCFile

	SimpleDVectoStream; SimpleTexttoDVec	// MIOC

	ClearInText; InputTextBuffer; TxtBNewChar	// MTXTBUF

	StreamFromTextName			// MTV

	EvalAText; TVtoString			// MSYM

	KillOverlays				// MOVERLAY

	InitLoad; DumpMB; LoadSyms; LoadMB; CompareMB	// MLOAD

	MidasFP					// MINIT0

	HWActions				// MINIT2

	RestoreState				// STATE

// Machine dependent action subroutines
	@MEMNAM; NHWActions

//Defined here
	DisplayError; QuitCmdOverlay; StartCmdOverlay; WsMarkA; ConfirmAct
	CmdCommentStream; TextCmdOutStream; ShowActionForm; WssCSS
	SavedLoadText; LoadDone; ProgramStream; CmdAltMenuP; CFOutStream
	QuickOpenFile; CmdAbort; CmdAbortAct; CmdMDFS; FormCmdmenuText

// Defined here for init only
	InitCmd; RunProgram; PrintComputeTime; CmdReturn
	CmdStartM; IMAddrXct; CmdGoOverlay; CmdDebug; CmdSkipCmd
	CmdTimeOut; CmdAddrEq; CmdSetDisplay; CmdShowError
	CmdOpenOutput; CmdCloseOutput; CmdWriteMessage
	PaintPrgP; ProgramVec; CmdCommentDirty; PaintCmdP; CmdCommentVec
	CmdLoad; CmdFinish; CmdRunProg; CmdDoRC; CmdConfirm
	ProgramAct; NPrograms; FileBlock; NQuickFiles

	CmdDumpAct; CmdStartWCAct; CmdStopWCAct
	CmdShowCmdAct; CmdConcealAct; NMActions; MActions
	CmdErrorContinueAct; CmdErrorAbortAct
]

manifest [ StandardMode = 0; ErrorMode = 1
]

static	[
	CmdCommentStream; CmdCommentVec
	CmdMDFS; ProgramVec; ProgramStream
	CmdEString2; CmdMenuMode = StandardMode; CmdAltMenuP
	CmdQuitOverlayF; LoadDone = false; Confirmed = false
	TextCmdOutStream = 0; ShowActionForm = false; SavedLoadText
	NPrograms; NQuickFiles = 0; FileBlock; NMActions = 6; MActions
	TEveryTime = 0; TimeTimeOut; CFOutStream = 0

//  Actions
	CmdDumpAct; CmdStartWCAct; CmdStopWCAct
	CmdShowCmdAct; CmdConcealAct; CmdErrorContinueAct; CmdErrorAbortAct
	CmdAbortAct; ProgramAct
]


// Procedures made external

//The name arg1 to CreateAction must be resident, which is why this code is
//not in the initialization overlay.  Arg2 is lvProcedure executed when any
//mousebuttons are released while the menu item is selected, Arg3 the arg
//to the procedure, Arg4 is lvMBChangeProc (not presently used here), and
//arg5 is the command line character which invokes the action.
let InitCmd() be
[
//Machine independent actions in command menu
	CmdDumpAct = CreateAction("Dump",lv CmdLoad,lv DumpMB,0,$D)
	CmdStartWCAct = CreateAction("Write-Cmds",lv CmdStartWC,0)
	CmdStopWCAct = CreateAction("Stop-Write-Cmds",lv CmdStopWC,0)
	CmdShowCmdAct = CreateAction("Show-Cmds",lv CmdShowCmds,true)
	CmdConcealAct = CreateAction("Conceal-Cmds",lv CmdShowCmds,false)

//Machine independent actions not in command menu
	CmdErrorContinueAct = CreateAction("Continue",lv CmdErrorEnd,true)
	CmdErrorAbortAct = CreateAction("Abort",lv CmdErrorEnd,false)
	TimeTimeOut = table [ 0; 0 ]
]


and WssCSS(Str) be Wss(CmdCommentStream,Str)

and PaintCmdP(R) be PaintRgnLine(0, CmdCommentVec)
and PaintPrgP(R) be PaintRgnLine(0,ProgramVec)

and CmdCommentDirty(S, Rgn) be MarkRgnDispDirty(Rgn)


and WssMark(Name,Act) be
[	Wss(ItemStream,Name); MarkMenus(Act)
	Puts(ItemStream,$ ); MarkMenus(0)
]


and WsMarkA(Act) be
[	Wss(ItemStream,Act>>Action.Name); MarkMenus(Act)
	Puts(ItemStream,$ ); MarkMenus(0)
]

//Action subr is called with args
// (1) menu stream
// (2) ??
// (3) Mouse buttons
// (4) arg supplied to CreateAction

and FormCmdmenuText() be
[ switchon CmdMenuMode into
    [
    default:
    case StandardMode:
     test CmdAltMenuP ne 0
      ifso CmdAltMenuP()
      ifnot
	[
	for I = 0 to NMActions-1 do WsMarkA(MActions!I)
	if LoadDone then WsMarkA(CmdDumpAct)
	test ShowActionForm
	  ifso	WsMarkA(CmdConcealAct)
	  ifnot	WsMarkA(CmdShowCmdAct)
	test TextCmdOutStream eq 0
	  ifso	WsMarkA(CmdStartWCAct)
	  ifnot	WsMarkA(CmdStopWCAct)
	for I = 0 to NHWActions-1 do WsMarkA(HWActions!I)
	]
	endcase

    case ErrorMode:
	if CmdEString2 ne 0 then WssMark(CmdEString2,CmdErrorContinueAct)
	WsMarkA(CmdErrorAbortAct)
	endcase
  ]
]


and CmdFinish() be FinishFlag = true


and CmdErrorEnd(S,Null,MBunion,Pred) be EndError(Pred)


and CmdShowCmds(S,Null,MBunion,Pred) be
[	ShowActionForm = Pred; FormMenu(CmdMDFS,FormCmdmenuText)
]


and CmdSetDisplay(S,Null,MBunion,Off) be [ KillOverlays(); SetDisplay(Off) ]
	

and CmdStartWC() be
[	if not ConfirmAct("Write commands on ",InputTextBuffer)
		then return
	TextCmdOutStream = ErrorProtect(lv StreamFromTextName,
		QuickOpenFile,InputTextBuffer,".MIDAS",
		ksTypeReadWrite,charItem)
	if TextCmdOutStream ne 0 then ClearInText()
	FormMenu(CmdMDFS,FormCmdmenuText)
]


and CmdStopWC() be
[	if TextCmdOutStream ne 0 then Closes(TextCmdOutStream)
	TextCmdOutStream = 0; FormMenu(CmdMDFS,FormCmdmenuText)
]


//Called both as a command and at the end of initialization
and CmdDoRC() be
[	let DisplayState = SetDisplay(true)
	ErrorProtect(lv ExecuteTextCmdStream,
		StreamFromTextName(QuickOpenFile,
		InputTextBuffer,".MIDAS",ksTypeReadOnly,charItem))
	SetDisplay(DisplayState)
]


and PrintComputeTime() be
[	TimeFinish = table [ 0; 0 ] ; Timer(TimeFinish)
	DoubleAdd(TimeFinish, TimeStart)
//Get Time in 4 msec units rounded to 1/100 second
	let Time = (TimeFinish!1 rshift 2)+(TimeFinish!0 lshift 14)+1
	WssCSS(" Time: "); Wns(CmdCommentStream,Time/250,0,10)
	Puts(CmdCommentStream,$.)
	Time = Time rem 250
	Wns(CmdCommentStream,Time/25,0,10)
	Wns(CmdCommentStream,((Time rem 25) lshift 1)/5,0,10)
	WssCSS(" seconds")
]


and CmdConfirm() be Confirmed = true


and CmdTimeOut() be
[	SetDisplay(false)	//Turn on display (to execute EveryTime stuff)
	Timer(TimeTimeOut)
	let TimeOut = vec 1; SimpleTexttoDVec(InputTextBuffer,32,TimeOut)
	CommandCount = 2
	DoubleAdd(TimeTimeOut,TimeOut); DoubleNeg(TimeTimeOut)
	if TEveryTime eq 0 then
		TEveryTime = AddToEveryTimeList(TimeOutEveryTime)
]


and TimeOutEveryTime() be
[	let Now = vec 1; Timer(Now); DoubleAdd(Now,TimeTimeOut)
	if Now!0 > 0 do	//Timed out
	[ RemoveFromEveryTimeList(TEveryTime); TEveryTime = 0
	  if CommandCount > 0 do
	  [ DoTextAction($C - 100B); SkipCommandCount = 1; return ]
	]
	if CommandCount le 0 then
	[ RemoveFromEveryTimeList(TEveryTime); TEveryTime = 0 ]
]


and CmdSkipCmd(S,Null,MBunion,Backward) be
[	let SC = vec 0; SimpleTexttoDVec(InputTextBuffer,16,SC)
	SkipCommandCount = SC!0; if Backward then Resets(CFileStream)
]


and CmdReturn() be
[	let SC = vec 0; SimpleTexttoDVec(InputTextBuffer,16,SC)
	AbortingCFile = SC!0+1
]


and CmdShowError() be
[	SkipCommandCount = 77777B
	let S = TVtoString(InputTextBuffer); TxtBNewChar(177B)
	DisplayError(S,"Continue")
	SkipCommandCount = 0
]


and CmdOpenOutput() be
[	if CFOutStream ne 0 then Closes(CFOutStream)
	CFOutStream = StreamFromTextName(QuickOpenFile,InputTextBuffer,
		".REPORT",ksTypeWriteOnly,charItem)
]


and CmdCloseOutput() be if CFOutStream ne 0 then
	[ Closes(CFOutStream); CFOutStream = 0 ]


and CmdWriteMessage() be
[	for I = 1 to InputTextBuffer!0 do Puts(CFOutStream,
		(InputTextBuffer!I eq $~ ? 15B,InputTextBuffer!I))
]


and CmdRunProg() be
[	WssCSS("Select microprogram:")
	StartCmdOverlay(lv CmdRunProg1)
]


and CmdRunProg1() = valof
[	CmdAbortAct = CreateAction("Abort",lv CmdAbort,0,0,$C-100B)
	resultis RunProgMenu
]


and RunProgMenu() be
[	WsMarkA(CmdAbortAct)
	for I = 0 to NPrograms-1 do WsMarkA(ProgramAct!I)
]


and RunProgram(S,garb,Buttons,fname) be
[	StartTimer()
	Restoring!1 = fname; Restoring!0 = true
	Restoring!2 = CFileStream; Restoring!3 = CFOutStream
	MidasFinish()
	RestoreState(OpenFile(0,ksTypeReadOnly,wordItem,0,MidasFP),true)
]


and CmdAbort() be
[	Resets(CmdCommentStream); WssCSS("XXX")
	KillOverlays(); QuitCmdOverlay()
]


and CmdLoad(S,Null,MBunion,lvProc) be
[	ErrorProtect(lv InitLoad,lvProc)
	TimeLoad = table [ 0; 0 ] ; Timer(TimeLoad)
	DoubleAdd(TimeLoad,TimeStart)
]


and QuickOpenFile(Name,ksType,Item) = valof
[	let EndP = (NQuickFiles-1)*lDV
	for I = 0 to EndP by lDV do
	[ if SymbKeyComp(Name,FileBlock!I) eq 0 then resultis
		OpenFile(Name,ksType,Item,0,FileBlock+I+(offset DV.fp/16))
	]
	resultis OpenFile(Name,ksType,Item)
]

and CmdDebug(S,Null,MBUnion,lvProc) be
[	let AV,Count,X = vec 7,0,1
	for J = 0 to 5 do
	[ if X > InputTextBuffer!0 then break
	  if not GetSimpleAddr(InputTextBuffer,lv X,AV+J,true,12) do
	  [ ShowBadAddr("Required args are addresses in LDR"); return ]
	  Count = Count+1; AV!J = (AV!(J+1))*5
	]
	if X le InputTextBuffer!0 then return	//????
	if Count eq 0 then DisplayError("Requires one or more LDR addresses")
//Make call with displacements into LDRMEM rather than AddrVec's
	StartCmdOverlay(lvProc,Count,AV)
]


and CmdAddrEq(S, Null, MBUnion) be
[	if InputTextBuffer!0 le 0 do
	[ WssCSS("?? "); return ]
	let AVal,X = vec size AVal/16,1
	test EvalAText(InputTextBuffer,lv X,AVal,false)
	ifso ShowAddr(AVal)
	ifnot ShowBadAddr()
]


//Accept address of procedure to be called with an IM address
//arg, if anything on command line, else no arg.  Procedure
//must finish immediately and return without putting up alternate
//menu.
and IMAddrXct(S,Null,MBUnion,lvProcedure) be
[	let Addr = GetIMAddr()
	switchon Addr into
	[
case -1: endcase
case -2: (rv lvProcedure)(); endcase
default: (rv lvProcedure)(Addr); endcase
	]
	TxtBNewChar(177B)	//Clear command line input
]


and CmdStartM(S,Null,MBUnion,lvProcedure) be
[	let Addr = GetIMAddr()
	switchon Addr into
	[
case -1: endcase
case -2: StartCmdOverlay(lvProcedure); endcase
default: StartCmdOverlay(lvProcedure,Addr); endcase
	]
	TxtBNewChar(177B)
]


and GetIMAddr() = valof
[	let X,AVec = 1,vec 1
	test InputTextBuffer!0 > 0
	ifso
	[ if not GetSimpleAddr(InputTextBuffer,lv X,AVec,false,2) do
	  [ ShowBadAddr(); resultis -1 ]
	  resultis AVec!1
	]
	ifnot resultis -2
]


and CmdGoOverlay(S,Null,MBUnion,lvWhere) be StartCmdOverlay(lvWhere)


//Initiate an action which returns an alternate command menu
//Action terminates with QuitCmdOverlay()
and StartCmdOverlay(lvInitP,A1,A2,A3,A4; numargs NA) be
[	let DisplayState = DisplayOff
	CmdAltMenuP = DummyCall(lvInitP,NA-1,A1,A2,A3,A4)
	FormMenu(CmdMDFS,FormCmdmenuText)
	CmdQuitOverlayF = MyFrame()
//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.
	test ((CFileStream ne 0) & (CommandCount le 0))
	ifso ExecuteTextCmdStream(CFileStream)
	ifnot DriverLoop()
	CmdAltMenuP = 0
//Restore display to its old on/off state
	SetDisplay(DisplayState)
	FormMenu(CmdMDFS,FormCmdmenuText)
]


and QuitCmdOverlay() be
[	ForgetTemporaryActions(); GotoFrame(CmdQuitOverlayF)
]


and GetSimpleAddr(TV,lvX,AVec,ifExpectMore,MemX) = valof
[	let AVal = vec size AVal/16
	unless EvalAText(TV, lvX, AVal, ifExpectMore)
	  then resultis false

	if AVal>>AVal.TypeStorage ne MemTypeStorage	//Not address?
	  then resultis false
	if (MemX ne -1) & (AVal>>AVal.X ne MemX)	//Wrong memory?
	  then resultis false
	MoveBlock(AVec,lv AVal>>AVal.Addr,2)
	resultis true
]


//If numargs is > 3 then CmdCommentStream is untouched
and DisplayError(S1,S2,S3,NoCSS; numargs NA) = valof
[	if not Initialized then CallSwat(S1)
	let DisplayOff = SetDisplay(false)
	if NA < 4 do
	[ Resets(CmdCommentStream)
	  if NA > 2 then WssCSS(S3)
	  WssCSS(S1)
	]
	CmdEString2 = NA > 1? S2, 0
	let Savemode,CL,CF = CmdMenuMode,AbortLabel,AbortFrame
	CmdMenuMode = ErrorMode
	FormMenu(CmdMDFS,FormCmdmenuText)
	let R = BeginError(CmdMDFS)
	CmdMenuMode,AbortLabel,AbortFrame = Savemode,CL,CF
	FormMenu(CmdMDFS,FormCmdmenuText)
	if R then [ SetDisplay(DisplayOff); resultis true ] //Continue
	GotoLabel(CF, CL, 0)	//Abort
]


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

case $.: case $Y: case $y: case 15B:
	    Resets(CmdCommentStream); SetDisplay(DisplayOff); resultis true

default:   Blink(); endcase
	  ]
	]
]