//Mdisp.bcpl--Midas display driver
//	Last edited: 2 June 1981


get "mdecl.d"

external [
// OS
	SysErr; InitializeZone; Zero; SetBlock; Min; DoubleAdd

// GACHA10
	FontP

// MIDAS
	MidasSwat

// MASM
	ClearAndScanConvert; @MBlock; SelfRel; Wait

// MDATA
	BBWait

// MOVERLAY
	OverlayZone; OverlayFlushed

// MRGN
	PaintDirtyRegions; ScreenLineDirty; ControlV; ScreenTV
	ScreenLinesDirty

// MMPRGN
	MPDEveryTime

// xxACTIONS
	@LongOne

// Machine dependent
	@ScreenWidth; @ScreenHeight

// Defined here
	UpdateDisplay; PrepareCharInv; FinishDisplay; SetDisplay; Blink
	MakeDispZoneAvail; ReUseDispSpace
	VertIntFlag; NwdsPerScanLine; FontCharWidth
	LineCtrlBlockPtrsVector
	DisplayOff		//Predicate modified by SetDisplay

// Defined here for init only
	InitBBblock; PutLineInService; ZoneErr
	SavedDASTART; SaveData1; SaveData2; SaveData3; SavervDASTART
	StandardLineHeight; AlmostFreeBitBufferChain
	BitBufferLen; FreeBitBufferChain; BBblockSize; BBblock
	AvailBlock; AvailBlockNLines; AvailBlockSize
	]

static [
	
BitBufferLen		//630B for GACHA10.AL, ScreenWidth = 76
	
LineCtrlBlockPtrsVector
	
FreeBitBufferChain = 0; 
AlmostFreeBitBufferChain = 0
	ZoneErr = 0	//0 disables checking
	
VertIntFlag = false
	
StandardLineHeight; NwdsPerScanLine

	

SaveData1; 
SaveData2; 
SaveData3; SavedDASTART; 
SavervDASTART
	DisplayOff = true; FontCharWidth

// bit buffer blocks and avail space control
	BBblock; AvailBlock; AvailBlockNLines
]

//NA eq 1 only for the call from SetDisplay(false)
let UpdateDisplay(Z; numargs NA) be
[	if DisplayOff & (NA eq 0) then return
	PaintDirtyRegions()
	for L = 1 to ScreenHeight do if ScreenLineDirty!L do
	[ let LCB = LineCtrlBlockPtrsVector!L
	  if LCB>>LCB.Line.Buffer ne 0 do
	  [ let NewBB = GetFreeBitBuffer(ScreenTV!L)
	    ReleaseBitBuffer(LCB)
	    LCB>>LCB.Line.Buffer = NewBB+2
	  ]
	  ScreenLineDirty!L = false
	]
	ScreenLinesDirty = false
]


//Called from Init2 and by ReUseDispSpace
and PutLineInService(L) be
[	let LCB = LineCtrlBlockPtrsVector!L
	ScreenLineDirty!L = false
	if (LCB>>LCB.Line.Buffer ne 0) % (ControlV!L eq 0) then return
	LCB>>LCB.Line.Buffer = GetFreeBitBuffer(ScreenTV!L)+2
	LCB>>LCB.Line.BufC = NwdsPerScanLine+(HTab lshift 8)
]


//Called from MakeDispZoneAvail
and RemoveBuffers(P) be
[	while P!0 ne 0 do
	[ let B = P!0
	  test B ge AvailBlock
	  ifso P!0 = B!0
	  ifnot P = B
	]
]


//Called from MOVERLAY, MCMD
and MakeDispZoneAvail() be
[	if OverlayZone eq 0 do
//Take lines out of service
	[ for L = 1 to AvailBlockNLines do
	  [ let LCB = LineCtrlBlockPtrsVector!L
//Release bit buffer from DCB
	    ReleaseBitBuffer(LCB)
	    LCB>>LCB.Line.BufC = HTab lshift 8
	    LCB>>LCB.Line.Buffer = 0
	  ]
	  RemoveBuffers(lv AlmostFreeBitBufferChain)
	  RemoveBuffers(lv FreeBitBufferChain)
//Remove buffers from busy lines
	  for L = 1 to ScreenHeight do
	  [ let LCB = LineCtrlBlockPtrsVector!L
	    let BB = LCB>>LCB.Line.Buffer-2
	    if BB eq -2 then loop
	    if BB ge AvailBlock then
	    [ let NewBB = GetFreeBitBuffer()
	      MBlock(NewBB,BB,BitBufferLen+2)
	      LCB>>LCB.Line.Buffer = 0 // so wont go onto almost free list
	      ReleaseBitBuffer(LCB)
	      LCB>>LCB.Line.Buffer = NewBB+2
	    ]
	  ]
//Wait
	  until VertIntFlag do []
//Ready
	]
	OverlayZone = InitializeZone(AvailBlock,AvailBlockSize,
		SysErr,ZoneErr)
]

//Called from KillOverlays and from SetDisplay when the display is being
//turned on after being off.
//MPDEveryTime is called to build all the bit buffers without waiting for
//VertIntFlag, necessary if the display were turned on first.  This occurs
//after Read-Cmds which does not result in OverlayFlushed.
and ReUseDispSpace() be
[	InitBBblock(AvailBlock,AvailBlockNLines)
	OverlayZone = 0; OverlayFlushed = false
	for L = 1 to AvailBlockNLines do PutLineInService(L)
]


//Called from UpdateDisplay, MakeDispZoneAvail, and PutLineInService
and GetFreeBitBuffer(String; numargs NA) = valof
[	if VertIntFlag % (FreeBitBufferChain eq 0) then
	[ until VertIntFlag % DisplayOff do DoubleAdd(BBWait,LongOne)
	  let CopyList = AlmostFreeBitBufferChain
	  while CopyList ne 0 do
	  [ let NewCopyList = CopyList!BBLink
	    CopyList!BBLink = FreeBitBufferChain
	    FreeBitBufferChain = CopyList
	    CopyList = NewCopyList
	  ]
	  AlmostFreeBitBufferChain = 0
	  while FreeBitBufferChain eq 0 do MidasSwat(NoFreeBB)
	]
	let NewBB = FreeBitBufferChain
	FreeBitBufferChain = NewBB!BBLink
	NewBB!BBSize = BitBufferLen
	if NA > 0 then ClearAndScanConvert(NewBB,String)
	resultis NewBB
]


//Called from UpdateDisplay and MakeDispZoneAvail
and ReleaseBitBuffer(LCB) be
[	let OldBB = LCB>>LCB.Line.Buffer-2
	if OldBB ne -2 then
	[ OldBB!BBLink = AlmostFreeBitBufferChain
	  AlmostFreeBitBufferChain = OldBB
	  VertIntFlag = false
	]
]


and InitBBblock(Block, N) be
  for I = 1 to N do
  [	Block!0 = FreeBitBufferChain
	FreeBitBufferChain = Block
	Block = Block + BitBufferLen + 2
  ]


and FinishDisplay() be
[	rv IntActive = SaveData3
	IntVec!VertIntChan = SaveData1
	DASTART!1 = SaveData2
	rv DASTART = SavervDASTART
]


//Called directly and from NoopAction
and Blink(nil,nil,nil) be
[	let Save = rv DASTART
	rv DASTART = 0
	Wait(2000)
	rv DASTART = Save
]


//Arg true turns off display; false turns it on
//Called directly and as an action
and SetDisplay(Off,nil,nil) = valof
[	if DisplayOff eq Off then resultis Off
	DisplayOff = Off
	test Off
	ifso [ SavedDASTART = rv DASTART; rv DASTART = 0 ]
	ifnot
	[ MPDEveryTime(nil,true)
	  if OverlayFlushed then ReUseDispSpace()
	  UpdateDisplay(true)
	  rv DASTART = SavedDASTART
	]
	resultis not Off
]


//Prepare inverted black-for-white character
and PrepareCharInv(rx,FontVec,Evec) be
[	let EvecLim = Evec+EvecSize
	let FontVecLim = FontVec+PFVecSize
	let LineHeight = StandardLineHeight
	[ let Cx = SelfRel(FontP+rx)
	  Evec!0 = FontVec+LineHeight-Evec
	  let HD,XH = (Cx+1)>>lh,(Cx+1)>>rh
	  rx = Cx!0 rshift 1
	  let Cx0odd = (Cx!0 & 1) eq 0
	  let Mask = (Cx0odd ? #177777,not (#177777 rshift rx))
	  SetBlock(FontVec,Mask,LineHeight)	//Top and bottom space fill
	  let PBMx = FontVec+HD
	  let CBMx = Cx-XH
	  for I = 0 to XH-1 do PBMx!I = (not (CBMx!I)) & Mask
	  FontVec = FontVec+LineHeight+2
	  FontVec!-1 = LineHeight
	  test Cx0odd
	  ifso FontVec!-2 = 2*(FontVec+LineHeight)
	  ifnot
	  [ FontVec!-2 = Cx!0; return
	  ]
	  Evec = Evec+1
	] repeatwhile (FontVec+LineHeight < FontVecLim) & (Evec < EvecLim)
	MidasSwat(BadFontChar)
]