//mmprgn.bcpl

get "mdecl.d"

external [
// OS
	Wss; Wns; Resets; Puts; CallSwat; Noop; DoubleAdd; MoveBlock; Zero

// MASM
	StrSize; ErrorProtect

// MDISP
	Blink

// MRGN
	CharInputRoutine

// MIOC
	RTexttoData; MTexttoData; RDatatoStream; MDatatoStream
	SimpleDVectoStream; SimpleTexttoDVec

// MMENU
	CreateAction; MarkMenus; ItemStream; FormMenu
	SkipCommandCount

// MSYMB
	EvalAText; TVtoString; SearchBlocks

// MTXTBUF
	InputTextBuffer

// MCMD
	CmdCommentStream; DisplayError; WsMarkA; WssCSS

// Machine interface
	MGetRegData; MGetMemData; MPutRegData; MPutMemData; @MEMNAM
	AltRForms; AltMForms

// Defined here
	MPDSwitchPhase; DoubleNeg; ShowAddr; ShowBadAddr
	@LongOne; LongMinOne

// Defined here for init only
	MPDAs; MPDAVec; MPDVs; MPDVVec; MPDEveryTime
	MPDlist; InitMPDispRegions; MPDdeSelect
	MPDrlx; MPDrcx; BugAddrAct; BugValAct; Plus1Act; Minus1Act
	SkipVEql; SkipVGr; SkipVLs
]


manifest [
//  form of the menu
	StandardMenu = 1; AddressMenu = 2

//  Phases
	BadValuePhase = 1; PhaseA = 2; PhaseB = 3

// mouse buttons
	TopButton = #4; MiddleButton = #1; BottomButton = #2
]


static	[
	MPDAs; MPDAVec; MPDVs; MPDVVec
	MPDPhase = PhaseA; OldMPDPhase = PhaseA
	MPDrlx = 0; MPDrcx = 0; MPDlist = 0
	@LongOne; LongMinOne

//  Actions
	BugAddrAct; BugValAct; Plus1Act; Minus1Act
	]

let InitMPDispRegions() be
[	LongOne = table [ 0; 1 ]
	LongMinOne = table [ -1; -1 ]
	BugAddrAct = CreateAction("Addr",lv SetAddr,0,lv AddrMChange)
	BugValAct = CreateAction("Val",lv SetValue,0,lv ValMChange)
	Plus1Act = CreateAction("A+1",lv StepAddr,true,lv AddrMChange)
	Minus1Act = CreateAction("A-1",lv StepAddr,false,lv AddrMChange)
]


and MPDSwitchPhase() be MPDPhase = ( OldMPDPhase eq PhaseA? PhaseB, PhaseA)


//This routine is called every time through DriverLoop.  It is
//responsible for repainting all of the MPD menus which have changed.
//The various action routines and the initialization code set
//phase = BadValuePhase which forces painting.  The microprocessor
//interface code reverses the current phase which causes only those
//items with changed values to paint
and MPDEveryTime(MPD,BuildingDisplay; numargs NA) be
[ while MPD ne 0 do
  [ if MPDPhase ne MPD>>MPD.Phase then
    [	test MPD>>MPD.Idle ne 0
	ifso if MPD>>MPD.Phase eq BadValuePhase then
		FormMenu(MPD>>MPD.MDFS,FormMPDmenu,MPD)
	ifnot
	[ let Val = vec ValSize; MoveBlock(Val,lv MPD>>MPD.Value,ValSize)
	  switchon MPD>>MPD.AVal.TypeStorage into
	  [
  case RegTypeStorage:
	    MGetRegData(MPD>>MPD.AVal.X,lv MPD>>MPD.Value); endcase

  case MemTypeStorage:
	    MGetMemData(MPD>>MPD.AVal.X,lv MPD>>MPD.AVal.Addr,lv MPD>>MPD.Value)
	    endcase

  default:  CallSwat()
	  ]
	  if ((MPD>>MPD.MenuMode eq StandardMenu) & valof
	  [ for I = 0 to ValSize-1 do
	    [ if Val!I ne (lv MPD>>MPD.Value)!I then resultis true ]
	    resultis false
	  ] ) % (MPD>>MPD.Phase eq BadValuePhase) % (NA > 1) then
		FormMenu(MPD>>MPD.MDFS,FormMPDmenu,MPD)
	]
	MPD>>MPD.Phase = MPDPhase
    ]
    MPD = MPD>>MPD.Rabove
  ]
  OldMPDPhase = MPDPhase
]

and FormMPDmenu(S, MPD) be
[	if MPD>>MPD.Idle ne 0 do
	[ for I = 1 to MPD>>MPD.TextSpace do Puts(S,$ )
	  MarkMenus(BugAddrAct); return
	]
	switchon MPD>>MPD.MenuMode into
	[
case StandardMenu: ShowMPDNormalPict(S, MPD); return

case AddressMenu:
	test MPD>>MPD.AVal.TypeStorage ne RegTypeStorage
	ifso
	[ WsMarkA(Plus1Act)
	  if ((lv MPD>>MPD.AVal.Addr)!0 ne 0)  logor
		((lv MPD>>MPD.AVal.Addr)!1 ne 0) do
	  [ WsMarkA(Minus1Act) ]
	]
	ifnot ShowMPDNormalPict(S,MPD)
	return
	]
]


and ShowOffset(S,MPD) be
[	let Offs = lv MPD>>MPD.AVal.Offset
	let Sign = MPD>>MPD.AVal.Sign
	if (Offs!0 ne 0) % (Offs!1 ne 0) % (Sign eq 0) do
	[ Puts(S,(Sign ne 0 ? (Offs!0 < 0 ? $-,$+),$ ))
	  let Offset = vec 1; MoveBlock(Offset,Offs,2)
	  if Offset!0 < 0 then DoubleNeg(Offset)
	  SimpleDVectoStream(S,32,Offset,0,true)
	]
]


and ShowBadAddr(Str; numargs NA) be
[	WssCSS((NA < 1 ? "Bad address",Str)); Blink()
]

and ShowMPDNormalPict(S, MPD) be
[	Resets(MPDAs); Resets(MPDVs)
	if MPD>>MPD.NoName eq 0 then Wss(MPDAs, lv MPD>>MPD.AVal.SName)
	switchon MPD>>MPD.AVal.TypeStorage into
	[
	case RegTypeStorage:
		RDatatoStream(MPDVs,MPD>>MPD.AVal.X,lv MPD>>MPD.Value)
		endcase

	case MemTypeStorage:
		if MPD>>MPD.NoName eq 0 then ShowOffset(MPDAs,MPD)
		MDatatoStream(MPDVs,MPD>>MPD.AVal.X,lv MPD>>MPD.Value)
		endcase
	
	default: CallSwat()
	]

//If the name and value do not fill the text space available, the
//code below leaves a null zone no bigger than 2 chars between them.
//If the name is less than 5 characters, extra blanks extend the name
//up to 5 characters.  Any more blanks beyond that extend the value.
//If the value overlaps the name, then the name is truncated except that
//one character of name is always printed (unless the NoName flag is set,
//in which case no name characters are ever printed).
//Note:  DVtoS routines never print leading 0's and blanks

	let ALim = MPDAVec!0		//Size of name
	let BlankSpace = MPD>>MPD.TextSpace - ALim - MPDVVec!0
	let VStart = 1
	if BlankSpace < 0 do		//Overlap?
	[ ALim = ALim + BlankSpace	//Then truncate name
	  BlankSpace = 0
	  if ALim < 0 do		//Name completely overlapped?
	  [ VStart = 1 - ALim; ALim = 0 ]
	]
	test MPD>>MPD.NoName ne 0
	ifso [ BlankSpace = BlankSpace+ALim; ALim = 0 ]
	ifnot				//Extend name up to 5 chars
	[ if ALim le 0 do [ ALim = 1; VStart = VStart+1 ]
	  for I = 1 to ALim do Puts(S,MPDAVec!I)
	  while (BlankSpace > 2) & (ALim < 5) do
	  [ Puts(S,$ ); BlankSpace = BlankSpace-1; ALim = ALim+1 ]
	  MarkMenus(BugAddrAct)
	  if BlankSpace > 0 do		//But leave gap if possible
					//2 char gap if value big enough
	  [ Puts(S,$ ); BlankSpace = BlankSpace-1
	    if (BlankSpace > 0) & ((MPDVVec!0 + BlankSpace) ge 5) do
	    [ Puts(S,$ ); BlankSpace = BlankSpace-1 ]
	    MarkMenus(0)
	  ]
	]
	for I = 1 to BlankSpace do Puts(S, $ )	//Rest of blanks extend value
	for I = VStart to MPDVVec!0 do Puts(S, MPDVVec!I)
	MarkMenus(BugValAct)
]

and MPDMChange(TopMenuMode,MiddleMenuMode,BottomMenuMode,MPD,MB) be
[	let NewMode = selecton MB into
	[
case TopButton: TopMenuMode
case MiddleButton: MiddleMenuMode
case BottomButton: BottomMenuMode
default: StandardMenu
	]
	if MPD>>MPD.MenuMode ne NewMode do
	[ MPD>>MPD.MenuMode = NewMode; MPD>>MPD.Phase = BadValuePhase ]
]


and AddrMChange(S, MPD, MB, N) be
	MPDMChange(StandardMenu,StandardMenu,AddressMenu,MPD,MB)


and ValMChange(S, MPD, MB, N) be
	MPDMChange(StandardMenu,StandardMenu,StandardMenu,MPD,MB)


and GetVal(S,MPD,V1,V2) = valof
[	SimpleTexttoDVec(InputTextBuffer,ValSize*16,V1)
	SetValue(S,MPD,BottomButton)
	SimpleTexttoDVec(InputTextBuffer,ValSize*16,V2)
	for I = 0 to ValSize-1 do
	[ let X = V1!I - V2!I
	  if X ne 0 then resultis X
	]
	resultis 0
]


//Invisible command (command files only)--skip if value in selected
//menu is equal to InputTextBuffer
and SkipVEql(S,MPD) be
[	let V1,V2 = vec ValSize-1,vec ValSize-1
	if GetVal(S,MPD,V1,V2) eq 0 then SkipCommandCount = 1
]


//Skip next command if value in selected menu is greater than text arg
and SkipVGr(S,MPD) be
[	let V1,V2 = vec ValSize-1,vec ValSize-1
	if GetVal(S,MPD,V1,V2) < 0 then SkipCommandCount = 1
]


and SkipVLs(S,MPD) be
[	let V1,V2 = vec ValSize-1,vec ValSize-1
	if GetVal(S,MPD,V1,V2) > 0 then SkipCommandCount = 1
]

and SetAddr(S,MPD,MBunion) be
[	NewStandard(MPD)
	let X,AVal = 1,vec size AVal/16
	if ((MBunion & MiddleButton) ne 0) & (MPD>>MPD.Idle eq 0) do
	[ ShowAddr(lv MPD>>MPD.AVal); return ]
	MPD>>MPD.Idle = 1
	if InputTextBuffer!0 eq 0 then return
	unless EvalAText(InputTextBuffer, lv X, AVal, false) do
	[ ShowBadAddr(); return ]
	MoveBlock(lv MPD>>MPD.AVal,AVal,size AVal/16)
	switchon MPD>>MPD.AVal.TypeStorage into
	[
case MemTypeStorage:
	if not MGetMemData(MPD>>MPD.AVal.X,lv MPD>>MPD.AVal.Addr,
		lv MPD>>MPD.Value) do [ ShowBadAddr(); return ]
case RegTypeStorage: endcase
default: CallSwat()
	]
	MPD>>MPD.Idle = 0
]


//The +1 and -1 menu items only come up when they are legal, but
//maybe the error checks here will be useful if keyboard stuff is added
and StepAddr(S, MPD, MBUnion, Sign) be
[	let AVec = vec 1; MoveBlock(AVec,lv MPD>>MPD.AVal.Addr,2)
	DoubleAdd(AVec,(Sign ? LongOne,LongMinOne))
	let DVec = vec 10
	test MGetMemData(MPD>>MPD.AVal.X,AVec,DVec)
	ifso
	[ MoveBlock(lv MPD>>MPD.AVal.Addr,AVec,2)
	  DoubleAdd(lv MPD>>MPD.AVal.Offset, (Sign ? LongOne, LongMinOne))
	  NewStandard(MPD)
	]
	ifnot ShowBadAddr() 
]


and ShowAddr(AVal) be
[	switchon AVal>>AVal.TypeStorage into
	[
case RegTypeStorage:
	WssCSS("Register ")
	Wns(CmdCommentStream,AVal>>AVal.X,0,10)
	endcase
case MemTypeStorage:
	WssCSS(MEMNAM!(AVal>>AVal.X))
	Puts(CmdCommentStream,$ )
	SimpleDVectoStream(CmdCommentStream,32,lv AVal>>AVal.Addr,0,true)
	WssCSS(" = ")
	SearchBlocks(CmdCommentStream,AVal>>AVal.X,lv AVal>>AVal.Addr)
	]
]

//TopButton going up evaluates input text and stores value.
//MiddleButton going up shows alternate value form on command comment line.
//BottomButton going up treats the value as input text.
and SetValue(S, MPD, MBunion) be
[	let X = MPD>>MPD.AVal.X	//= RegX or MemX
	let Value,TypeS = lv MPD>>MPD.Value,MPD>>MPD.AVal.TypeStorage
	if (MBunion & TopButton) ne 0 do	//Set value from InputTextBuffer
	[ switchon TypeS into
	  [
  case RegTypeStorage:
	  RTexttoData(X,InputTextBuffer,Value)
	  MPutRegData(X,Value); endcase

  case MemTypeStorage:
	  MTexttoData(X,InputTextBuffer,Value)
	  MPutMemData(X,lv MPD>>MPD.AVal.Addr,Value); endcase

  default: CallSwat(); endcase
	  ]
	  NewStandard(MPD); return
	]
	if (MBunion & BottomButton) ne 0 do	//Append to InputTextBuffer
	[ Resets(MPDVs); switchon TypeS into
	  [
case RegTypeStorage: RDatatoStream(MPDVs,X,Value); endcase
case MemTypeStorage: MDatatoStream(MPDVs,X,Value); endcase
	  ]
	  for I = 1 to MPDVVec!0 do CharInputRoutine(MPDVVec!I)
	]
	if (MBunion & MiddleButton) ne 0 do	//Alternate printout
	[ Resets(CmdCommentStream)
	  ErrorProtect((selecton TypeS into
	  [
case RegTypeStorage: AltRForms
case MemTypeStorage: AltMForms
	  ] )!X ,CmdCommentStream,X,Value,lv MPD>>MPD.AVal.Addr)
	]
]


and MPDdeSelect(MPD) be
[	if MPD>>MPD.MenuMode ne StandardMenu do NewStandard(MPD)
]


and NewStandard(MPD) be
[	MPD>>MPD.MenuMode = StandardMenu; MPD>>MPD.Phase = BadValuePhase
]
(1674)

and DoubleNeg(Ptr) be
[	Ptr!1 = - Ptr!1
	Ptr!0 = (not Ptr!0)+(Ptr!1 eq 0 ? 1,0)
]