//Mrgn.bcpl 22 June 1983 get "mdecl.d" get "streams.d" external [ // OS Endofs; keys; Gets; Zero; SetBlock; Noop; Min // MINIT0 SkipScanLines // MIDAS MidasSwat // MDISP UpdateDisplay; DisplayOff; LineCtrlBlockPtrsVector; FontCharWidth // MASM ErrorProtect // MMENU deSelectMenu; MenuMChange // Machine dependent @ScreenWidth; @ScreenHeight // Defined here DriverLoop; PaintSetup; PaintRgnLine; PaintMark; PaintDirtyRegions UpdateEveryTime; AddToEveryTimeList; RemoveFromEveryTimeList ScreenTV; CharInputRoutine; RegionTable ErrorFlag; AllowedRgn; SelectedRegion; ScreenLinesDirty Displayalx; Displayacx; DisplayMaxrcx; @NewLx; @NewCx // Defined here for init only ControlV; ScreenLineDirty; NRegions; EveryTimeP; EveryTimeA ] static [ // statics related to display ScreenTV // vector pointing to strings on screen ScreenLineDirty // vector of dirty flags ScreenLinesDirty = true DisplayMaxrcx; Displayalx; Displayacx // statics related to control ControlV // vector pointing to marks vectors RegionTable; NRegions = -1; AllowedRgn EveryTimeP; EveryTimeA ErrorFlag = false // statics related to mouse SelectedRegion; @NewLx; @NewCx // input char routine CharInputRoutine ] //DriverLoop is the top level scheduler in Midas. It is recursively called //during actions which user StartCmdOverlay. It never returns, and //overlay actions only exit by the GotoFrame in QuitCmdOVerlay. //The quiescent loop time in DriverLoop should be small so that the //Test overlay (etc.) will run quickly let DriverLoop() be [ let LineX,CharX,Buttons,ButtonUnion = nil,nil,0,0 let LastMx,My = -1,-1 let NewMBRgn = 0 [ if ScreenLinesDirty then UpdateDisplay() while not Endofs(keys) do CharInputRoutine(Gets(keys)) if My ne rv #427 do [ My,NewLx = rv #427,0 let scany,LCB = SkipScanLines,nil while scany < My & NewLx < ScreenHeight do [ NewLx = NewLx + 1 LCB = LineCtrlBlockPtrsVector!NewLx scany = scany+((LCB>>LCB.Line.Height+LCB>>LCB.Sepr.Height) lshift 1) ] //Treat leading gap and borders as line 0 (a no-op region) if (scany-((LCB>>LCB.Sepr.Height) lshift 1)) < My then NewLx = 0 ] let Mx = rv #426 if Mx ne LastMx do [ LastMx = Mx Mx = Mx-#16-HTab*16 //X-pos relative to left edge of 1st char NewCx = Mx le 0 ? 0, Min(ScreenWidth,(Mx+FontCharWidth-1)/FontCharWidth) ] let NewMB = (not rv #177030) & 7B if NewMB ne Buttons % //New mouse buttons different NewLx ne LineX % //New line different NewCx ne CharX do //New char. pos. different [ for Rn = ControlV!NewLx to NRegions do [ let R = RegionTable!Rn //This check may be one off, but don't care with current Rgn arrangement if R>>Rgn.aLineX > NewLx then break let Cmin = R>>Rgn.aCharX if Cmin < NewCx then if Cmin+R>>Rgn.Width ge NewCx then [ NewMBRgn = R; break ] ] //deSelectMenu is Noop if not a menu region if NewMBRgn ne SelectedRegion do deSelectMenu(SelectedRegion) test NewMB eq 0 ifso [ if NewMBRgn ne SelectedRegion then ButtonUnion = 0 SelectedRegion = NewMBRgn ] //ButtonUnion = union of all buttons down since last up ifnot ButtonUnion = ButtonUnion % NewMB //When an error menu is up, prevent actions in any other menus from //being executed. if (SelectedRegion>>Rgn.Type eq MenRgn) & ((not ErrorFlag) % (SelectedRegion eq AllowedRgn)) then MenuMChange(SelectedRegion,SelectedRegion eq NewMBRgn, NewMB,ButtonUnion) Buttons,LineX,CharX = NewMB,NewLx,NewCx if NewMB eq 0 then ButtonUnion = 0 ] unless ErrorFlag then UpdateEveryTime() ] repeat ] //Called from PaintMark, PaintRgnLine, FormMenu and PaintSetup(R,rlx) = valof [ DisplayMaxrcx = R>>Rgn.Width Displayalx,Displayacx = R>>Rgn.aLineX+1,R>>Rgn.aCharX let L = Displayalx+rlx ScreenLineDirty!L = true ScreenLinesDirty = true resultis L ] //Called from MenuMarkSItem and PaintMark(R,rlx,firstC,lastC,Flag) be [ let S = ScreenTV!(PaintSetup(R,rlx)) for I = firstC+Displayacx to lastC+Displayacx do [ S>>CV↑I = (S>>CV↑I & 177B) + Flag ] ] //Called by MarkMenus, after building an item in ItemV //This has been hand-coded in masm.asm //and PaintItem(L,TV,charX) be //[ let S = ScreenTV!L // let Offset = charX+Displayacx //No range check necessary here because MarkMenus makes one // for I = 1 to TV!0 do // [ S>>CV↑(I+Offset) = TV!I // ] //] //Called by PaintDirtyRegions & by FormCmdmenuText and PaintRgnLine(R,rlx,TV) be [ let S = ScreenTV!(PaintSetup(R,rlx)) for I = 1 to TV!0 do S>>CV↑(I+Displayacx) = TV!I let f,l = TV!0+Displayacx+1,DisplayMaxrcx+Displayacx if f > l then return //In case odd byte at beginning or even byte at end S>>CV↑f = $ ; S>>CV↑l = $ f,l = (f+1) rshift 1,(l+1) rshift 1 if l > f then SetBlock(S+f,20040B,l-f) ] //For text regions, this moves the characters out of the TV into ScreenTV //It doesn't do anything for menu regions. and PaintDirtyRegions() be for Rn = 0 to NRegions do [ let R = RegionTable!Rn if R>>Rgn.DispDirty ne 0 then [ if R>>Rgn.Type eq TextRgn do PaintRgnLine(R,0,R+(size Rgn/16)+(size ST/16)) R>>Rgn.DispDirty = 0 ] ] and UpdateEveryTime() be [ for I = 0 to MaxEveryTime-1 do ErrorProtect(EveryTimeP+I,EveryTimeA!I) ] and AddToEveryTimeList(P,A) = valof [ for I = 0 to MaxEveryTime-1 do [ if EveryTimeP!I eq Noop do [ EveryTimeP!I,EveryTimeA!I = P,A resultis I ] ] MidasSwat(ETLOvf) ] and RemoveFromEveryTimeList(I) be [ if (I ge MaxEveryTime) % (I < 0) then MidasSwat(BadArgforRETL) EveryTimeP!I = Noop ]