//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
]

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