//mmenu.bcpl

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

external [
// OS
	Wss; Wns; Puts; Resets; MoveBlock; Zero
	Gets; Closes; Endofs; CallSwat; Noop

// MASM
	ErrorProtect; SymbKeyComp; Min

// MDISP
	Blink; DisplayOff; @NewLx; @NewCx

// MRGN
	MarkRgnDispDirty; UpdateDisplay; PaintRgnLine
	EveryTimeP; EveryTimeA; SelectedRegion

// MTXTBUF
	InputTextBuffer; InputTxtRgn; ClearInText

// MSYMB
	TVtoString

// MCMD
	CmdCommentStream; ShowActionForm; TextCmdOutStream; CmdMDFS
	CFOutStream; DisplayError

// MOVERLAY
	KillOverlays

// MINIT1
	ScreenWidth

// Defined here
	CreateAction; ForgetTemporaryActions; @CurrentMDFS
	DoTextAction; ExecuteTextCmdStream; MarkMenus; FormMenu
	CommandCount; SkipCommandCount; CFileStream; AbortingCFile

// Defined here for init only
	ActionBlock; ActionPtr; LastPermanentAction
	MenuBlock; @ItemV; MenuTVs; PutMenus
	MenuMChange; SelectMenu; deSelectMenu; PaintMenu
	ItemStream
]

manifest [ TopButton = 4; MiddleButton = 1; BottomButton = 2 ]

static[ ItemStream; @ItemV; @CurrentMDFS; MenuTVs
	ActionBlock; ActionPtr=0; LastPermanentAction; MenuBlock
	CommandCount = 0; SkipCommandCount = 0; CFileStream = 0
	AbortingCFile = 0
]

let LookUpMenu(Letter,LineN) = valof
[	let LetterV = Letter-$A
	LetterV = (LineN < 0) ? LetterV,(LetterV*MaxLineN)+LineN+($Z-$A+1)
	if LetterV > MaxMenus then resultis 0
	resultis MenuBlock!LetterV
]


//and ForgetMenu(MDFS) be
//[	MoveRegion(MDFS, 0, 0, 0, 0, 0)
//	let LetterV,LineN = MDFS>>MDFS.Letter - $A,MDFS>>MDFS.LineN
//	LetterV = ((LineN < 0) % (LineN > MaxLineN)) ? LetterV,
//		(LetterV*MaxLineN)+LineN+($Z-$A+1)
//	if LetterV > MaxMenus then CallSwat()
//	MenuBlock!LetterV = 0
//]


and CreateAction(Name,lvProc,Arg,lvMProc,Char; numargs NA) = valof
[	if ActionPtr ge MaxActions then CallSwat("Action table overflowed")
	let B = ActionBlock+ActionPtr*(size Action/16)
	B>>Action.Name = Name
	B>>Action.lvProc = lvProc
	B>>Action.lvMProc = ((NA < 4)%(lvMProc eq 0) ? lv Noop, lvMProc)
	B>>Action.Arg = Arg
	B>>Action.Char = (NA<5 ? 0,Char)
	ActionPtr = ActionPtr+1
	resultis B
]


and ForgetTemporaryActions() be ActionPtr = LastPermanentAction


and LookUpAction(Name) = valof
[	let B,C = ActionBlock,ActionBlock+(ActionPtr*(size Action/16))
	while B < C do
	[ if SymbKeyComp(B>>Action.Name,Name) eq 0 then resultis B
	  B = B+(size Action/16)
	]
	resultis 0
]


and DoTextAction(Char) be
[	let Action = valof
	[ let B,C = ActionBlock,ActionBlock+(ActionPtr*(size Action/16))
	  while B < C do
	  [ if B>>Action.Char eq Char then resultis B
	    B = B+(size Action/16)
	  ]
	  resultis 0
	]
	if Action eq 0 then [ Blink(); return ]
	DoAction(Action,TopButton,CmdMDFS)
]


and DoAction(Action,MBunion,MDFS) be
[	if TextCmdOutStream ne 0 then
	[ WLogicalActToS(TextCmdOutStream,MBunion,MDFS)
	  Puts(TextCmdOutStream,$*N)
	]
	ClearInText()		//Set flag so next in char clears
	Resets(CmdCommentStream)
	ErrorProtect(Action>>Action.lvProc,ItemStream,
		MDFS>>MDFS.Arg,MBunion,Action>>Action.Arg)
]

and ExecuteTextCmdStream(S) be
[ SkipCommandCount,CommandCount = 0,0
  let OldCFileStream = CFileStream; CFileStream = S
  while true do
  [ let Action,Buttons,MDFS,Char = nil,nil,nil,nil
    while true do // read in a good action
    [ if Endofs(S) % (AbortingCFile ne 0) do
      [	 Closes(S); CFileStream = OldCFileStream
	 SkipCommandCount = (AbortingCFile ne 0) ? AbortingCFile-1,0
	 if (CFileStream eq 0) % (AbortingCFile > 0) then AbortingCFile = 0
	 return
      ]
      Buttons,Action = 0,0
      while true do		// Collect mouse buttons
      [	if Endofs(S) then goto EndCF
	Char = Gets(S)
	if Char eq $*N then loop	// Extra <cr>'s ok for formatting
	if Char eq $  then break	// Blanks terminate buttons
	Buttons = Buttons logor selecton Char into
	[ case $L:  TopButton
	  case $M:  MiddleButton
	  case $R:  BottomButton
	  default: -1
	]
      ]
//Assume lines not beginning with "L", "M", or "R" are comments
      if Buttons ne -1 do
      [ let N,N1 = -1,nil
        if Endofs(S) then goto EndCF
        Char = Gets(S)		// Collect menu char
        while true do		// Collect menu line
	[ if Endofs(S) then goto EndCF
	  N1 = Gets(S); if (N1 > $9) % (N1 < $0) then break
	  N = (N < 0 ? N1,(N*10)+N1) - $0
	]
	MDFS = LookUpMenu(Char,N)
	if (MDFS eq 0) & (SkipCommandCount eq 0) do
		DisplayError("Undefined menu")
	let TVec = vec 80
	Resets(MenuTVs, TVec, ScreenWidth)
	while true do
	[ if Endofs(S) then goto EndCF
	  Char = Gets(S)
	  if (Char eq $ ) % (Char eq $*N) % (Char eq $;) then break
	  Puts(MenuTVs, Char)
	]
	let Str = TVtoString(TVec)
	Action = LookUpAction(Str)
	if (Action eq 0) & (SkipCommandCount eq 0) do
		DisplayError("Undefined action",0,Str)
	if Char eq $  do
	[ Resets(MenuTVs,(SkipCommandCount le 0 ? InputTextBuffer,TVec)
		,ScreenWidth)
	  while true do
	  [ if Endofs(S) then goto EndCF
	    Char = Gets(S)
//";" begins command file comment
	    if (Char eq $*N) % (Char eq $;) then break
	    Puts(MenuTVs, Char)
	  ]
	  Closes(MenuTVs); MarkRgnDispDirty(InputTxtRgn)
        ]
      ]
      until Char eq $*N do
      [	if Endofs(S) then goto EndCF
	Char = Gets(S)
      ]
      if Action ne 0 & MDFS ne 0 then break
    ] // end of "get a good action"

    if SkipCommandCount > 0 do
    [ SkipCommandCount = SkipCommandCount-1; loop ]

    if not DisplayOff do	// Show what's happening
    [ ErrorProtect(lv SelectedRegion>>Rgn.deSelect,SelectedRegion)
      let OldMenuItem = MDFS>>MDFS.SelectedItem
      let PV, N = MDFS>>MDFS.ProcV, 0
      for I = 1 to PV!0 do if PV!I eq Action then [ N = I; break ]
      if OldMenuItem ne 0 then
	  MenuMarkSItem(MDFS, OldMenuItem, false)
      MenuMarkSItem(MDFS, N, true)
      MDFS>>MDFS.SelectedItem = N
      MarkRgnDispDirty(MDFS)
      SelectedRegion = MDFS
      for I = 1 to EveryTimeP!0 do
	ErrorProtect(lv EveryTimeP!I,EveryTimeA!I)
      UpdateDisplay()
    ]		// End of display update
    DoAction(Action,Buttons,MDFS)
    CommandCount = CommandCount - 1
EndCF:
  ]
]

//  local procedures

and PaintMenu(MDFS) be
[	let TextLines = MDFS>>MDFS.TextLines
	let X = 0
	for I = 0 to MDFS>>MDFS.inLine - 1 do
	[ PaintRgnLine(I, TextLines+X)
	  X = X + TextLines!X + 1
	]
	for I = MDFS>>MDFS.inLine to MDFS>>MDFS.Rgn.Height-1 do
		PaintRgnLine(I, table [ 0 ] )
]


//Call the procedure for forming the menu
and FormMenu(MDFS,Proc,Arg) be
[	CurrentMDFS = MDFS
	ItemV!0 = 0
	MDFS>>MDFS.TextLines!0 = 0
	MDFS>>MDFS.inLine = 1
	MDFS>>MDFS.ProcV!0 = 0
	MDFS>>MDFS.SizeV!0 = 0
	Proc(ItemStream,Arg)
	MDFS>>MDFS.SelectedItem = 0
	MenuSelectItem(MDFS)
]


and MarkMenus(Proc) be
[	let MDFS = CurrentMDFS
	let TextLines = MDFS>>MDFS.TextLines
	let ProcVec = MDFS>>MDFS.ProcV
	let SizeVec = MDFS>>MDFS.SizeV
	if ProcVec!0 ge MDFS>>MDFS.ProcNMax then
	  test Proc eq 0; ifso return; ifnot CallSwat()
	ProcVec!0 = ProcVec!0 + 1
	ProcVec!(ProcVec!0) = Proc
	let X,Z = 0,0
	for I = 1 to (MDFS>>MDFS.inLine)-1 do
	[ X = X + TextLines!X + 1; Z = Z + SizeVec!Z + 1 ]
	let Size = ItemV!0
	if TextLines!X +  Size > MDFS>>MDFS.Rgn.Width then
	[	if MDFS>>MDFS.inLine ge MDFS>>MDFS.Rgn.Height then return
		MDFS>>MDFS.inLine = MDFS>>MDFS.inLine + 1
		X = X + TextLines!X + 1
		TextLines!X = 0
		Z = Z + SizeVec!Z + 1
		SizeVec!Z = 0
	]
	SizeVec!Z = SizeVec!Z + 1
	SizeVec!(Z+SizeVec!Z) = Size
	let Y = X + TextLines!X
	MoveBlock(TextLines+Y+1,ItemV+1,ItemV!0)
	TextLines!X = Y - X + ItemV!0
	ItemV!0 = 0
]


and PutMenus(S, B) be
	if ItemV!0 < ScreenWidth then
	  [ ItemV!0 = ItemV!0 + 1; ItemV!(ItemV!0) = B ]

// deSelectMenu, SelectMenu, and MenuMChange are the entries to all of
// this stuff from MRGN--they are called in order

and deSelectMenu(R) be
[// Current deselect routines are Noop for command menu and Resets for MPD's
	ErrorProtect(lv R>>MDFS.deSelect,R>>MDFS.Arg)
	R>>MDFS.mIn = 0; MenuSelectItem(R)
	if ShowActionForm then Resets(CmdCommentStream)
]


and SelectMenu(R, InR, MB, MBunion) be
[	R>>MDFS.mIn = R eq InR ? 1,0
	WActC(R,MBunion)
]


and MenuMChange(R, InR, MB, MBunion) be
[	R>>MDFS.mIn = R eq InR ? 1,0
	let N = R>>MDFS.SelectedItem
	let PV = R>>MDFS.ProcV
	let Action = PV!N
	if (Action ne 0) & (MB eq 0) & (MBunion ne 0) & (R eq InR) &
		(N ne 0) then DoAction(Action,MBunion,R)
	Action = PV!N
	if (N > 0) & (Action ne 0) then ErrorProtect(Action>>Action.lvMProc,
		ItemStream,R>>MDFS.Arg,MB,Action>>Action.Arg)
	WActC(R,MBunion)
]


and WActC(R,MBunion) be
[	MenuSelectItem(R)
	if ShowActionForm then
	[ Resets(CmdCommentStream)
	  WLogicalActToS(CmdCommentStream,MBunion,R)
	]
]

and MenuSelectItem(MDFS) be
[	let SizeVec = MDFS>>MDFS.SizeV
	let X,N = 0,0
	let rlx = NewLx-MDFS>>MDFS.Rgn.aLineX-1
	let rcx = NewCx-MDFS>>MDFS.Rgn.aCharX-1
	if MDFS>>MDFS.mIn ne 0 do
	[ rlx = Min(rlx,MDFS>>MDFS.inLine-1)
	  for I = 1 to rlx do
	  [ N = N + SizeVec!X; X = X + SizeVec!X + 1 ]
	  let Y = 0
	  for I = 1 to SizeVec!X do
	  [ Y = Y + SizeVec!(X+I)
	    N = N + 1; if Y > rcx then break
	  ]
	]
	if MDFS>>MDFS.SelectedItem ne N then
	[ if MDFS>>MDFS.SelectedItem ne 0 then
	    MenuMarkSItem(MDFS, MDFS>>MDFS.SelectedItem, false)
	  if N ne 0 logand MDFS>>MDFS.ProcV!N ne 0
	    then MenuMarkSItem(MDFS, N, true)
	  MDFS>>MDFS.SelectedItem = N
	]
	MarkRgnDispDirty(MDFS)
]


and MenuMarkSItem(MDFS, N, Flag) be
[	if N eq 0 then return
	let TextLines = MDFS>>MDFS.TextLines
	let SizeVec = MDFS>>MDFS.SizeV
	let X, Y, M = 0, 0, 0
	while M + SizeVec!Y < N do
	[ X = X + TextLines!X + 1
	  M = M + SizeVec!Y; Y = Y + SizeVec!Y + 1
	]
	for I = 1 to N-M-1 do [ Y = Y+1; X = X+SizeVec!Y ]
// set indicated chars to white on black or normal, depending on Flag
	Flag = Flag & #200
	let EndX = SizeVec!(Y+1)+X
	for I = X+1 to EndX do
	[ TextLines!I = (TextLines!I & #177) % Flag
	]
]


and WLogicalActToS(S, MB, MDFS) be
[	let N = MDFS>>MDFS.SelectedItem
	if N le 0 then return
	if (MB & TopButton) ne 0 then Puts(S, $L)
	if (MB & MiddleButton) ne 0 then Puts(S, $M)
	if (MB & BottomButton) ne 0 then Puts(S, $R)
	Puts(S, $ )
	Puts(S,MDFS>>MDFS.Letter)
	let L = MDFS>>MDFS.LineN
	if (L ge 0) & (L le MaxLineN) then Wns(S,L,0,10)
	Puts(S, $ )
	Wss(S, ((MDFS>>MDFS.ProcV)!N)>>Action.Name)
	Puts(S, $ )
	for I = 1 to InputTextBuffer!0 do Puts(S, InputTextBuffer!I)
]