// SimpleDisplayStream.bcpl
// Last modified April 13, 1982  10:49 AM by Taft

get "AltoDefs.d"
get "Streams.d"

external
[
// outgoing procedures
CreateSimpleDspStream; SimpleDspSetLMarg; SimpleDspSetRMarg;
SimpleDspGetLinePos; SimpleDspSetLinePos
SimpleDspGetBitPos; SimpleDspSetBitPos; SimpleDspResetLine
SimpleDspEraseBits; SimpleDspDCB; SimpleDspCharWidth

// for OEP declaration only:
SimpleDspPuts; SimpleDspResets; SimpleDspCloses

// incoming procedures
Allocate; Free; Zero; SetBlock; DefaultArgs
Puts; Resets; BitBlt; SysErr; Min; Max

// incoming statics
sysZone
]

//---------------------------------------------------------------------------
structure SDS:		// Simple Display Stream
//---------------------------------------------------------------------------
[
@ST
dcb @DCB
bbt @BBT
zone word
strikeFont word
xPosTable word		// -> strikeFont>>Strike.xPosTable
leftMargin word		// in bits from left edge of bit map
rightMargin word	// in bits from left edge of bit map
]
manifest lSDS = size SDS/16
compileif (offset SDS.dcb & 37B) ne 0 % (offset SDS.bbt & 37B) ne 0 then
   [ Barf("DCB or BBT not even-word aligned") ]

//---------------------------------------------------------------------------
structure Strike:	// Strike (old-format) font
//---------------------------------------------------------------------------
[
oneBit bit		// =1 to mean new style font
index bit
fixed bit
blank bit 13
min word		// Lowest char code
max word		// Highest char code
maxWidth word		// Maximum width

// The rest is called the "strike body", and includes overhead, bitmap, and xPosTable.
length word		// Number of words in strike body
ascent word		//  above baseline
descent word		//  below baseline
xOffset word		//  for kerning (not implemented, always zero)
raster word		// # words per scan line
bitmap word 0		// bit map begins here: raster*height words
// xPosTable ^min,max word  // x-coordinates of the characters in the bit map
]

// Public procedures

//---------------------------------------------------------------------------
let CreateSimpleDspStream(bitmap, width, height, strikeFont,
    zone; numargs na) = valof
//---------------------------------------------------------------------------
// bitmap is the bit map starting address and must be even.
// width is in words and must be even.
// height is in scan lines and must be even.
// strikeFont must be a pointer to a .strike (non-kerned) font.
// Client is responsible for linking DCB into the display list as desired.
[
DefaultArgs(lv na, -4, sysZone)
let sds = Allocate(zone, lSDS, false, true)  // even-word aligned
Zero(sds, lSDS)
SetBlock(sds, SysErr, lST)
sds>>SDS.puts = SimpleDspPuts
sds>>SDS.reset = SimpleDspResets
sds>>SDS.close = SimpleDspCloses
sds>>SDS.dcb.bitmap = bitmap
sds>>SDS.dcb.width = width
sds>>SDS.dcb.height = height rshift 1
sds>>SDS.bbt.dbca = bitmap
sds>>SDS.bbt.dbmr = width
sds>>SDS.rightMargin = width lshift 4
sds>>SDS.bbt.dh = strikeFont>>Strike.ascent + strikeFont>>Strike.descent
sds>>SDS.bbt.sbca = lv strikeFont>>Strike.bitmap
sds>>SDS.bbt.sbmr = strikeFont>>Strike.raster
sds>>SDS.zone = zone
sds>>SDS.strikeFont = strikeFont
sds>>SDS.xPosTable = lv strikeFont>>Strike.bitmap +
 (strikeFont>>Strike.raster * sds>>SDS.bbt.dh)
Resets(sds)
resultis sds
]


// Setting margins:
// Moving margins in from the edges of the bit map causes the regions outside
// the margins not to be touched by any subsequent operation besides Resets.
// This means that the client has complete freedom in defining the contents
// of these regions.

//---------------------------------------------------------------------------
and SimpleDspSetLMarg(sds, margin) be sds>>SDS.leftMargin = margin
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and SimpleDspSetRMarg(sds, margin) be sds>>SDS.rightMargin = margin
//---------------------------------------------------------------------------


// Text line operations:
// The topmost text line is numbered zero.  No bounds checks are done.

//---------------------------------------------------------------------------
and SimpleDspGetLinePos(sds) = sds>>SDS.bbt.dty / sds>>SDS.bbt.dh
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and SimpleDspSetLinePos(sds, line) be
//---------------------------------------------------------------------------
// Positions to the left margin of the specified line.
// Does not actually modify the line.
[
sds>>SDS.bbt.dty = line * sds>>SDS.bbt.dh
sds>>SDS.bbt.dlx = sds>>SDS.leftMargin
]

// Public procedures (cont'd)

// Bit positions are relative to the left edge of the bit map, not relative
// to the left margin.  No bounds checks are done.

//---------------------------------------------------------------------------
and SimpleDspGetBitPos(sds) = sds>>SDS.bbt.dlx
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and SimpleDspSetBitPos(sds, pos) be sds>>SDS.bbt.dlx = pos
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and SimpleDspResetLine(sds) be
//---------------------------------------------------------------------------
// Erases the current line, and leaves the stream positioned at the left margin.
[
sds>>SDS.bbt.dlx = sds>>SDS.rightMargin
SimpleDspEraseBits(sds, sds>>SDS.leftMargin - sds>>SDS.rightMargin)
]

//---------------------------------------------------------------------------
and SimpleDspEraseBits(sds, nBits, flag; numargs na) be
//---------------------------------------------------------------------------
// Erases nBits relative to the current position (positive => right, negative => left)
// and adjusts the current position by nBits.  No bounds checks are done.
// Flag=0 or omitted sets the erased region to zero; flag=1 sets it to all ones;
// flag=-1 complements the region.
[
if na ls 3 then flag = 0
let newPos = sds>>SDS.bbt.dlx + nBits
sds>>SDS.bbt.dlx = Min(sds>>SDS.bbt.dlx, newPos)
sds>>SDS.bbt.dw = Max(nBits, -nBits)
sds>>SDS.bbt.function = flag ls 0? 16B, 14B  // invert, replace
SetBlock(lv sds>>SDS.bbt.gray, flag ne 0, 4)
BitBlt(lv sds>>SDS.bbt)
Zero(lv sds>>SDS.bbt.gray, 4)
sds>>SDS.bbt.dlx = newPos
]


// Miscellaneous:

//---------------------------------------------------------------------------
and SimpleDspDCB(sds) = lv sds>>SDS.dcb
//---------------------------------------------------------------------------
// Returns the address of the DCB, which the caller may fiddle with.

//---------------------------------------------------------------------------
and SimpleDspCharWidth(sds, char) = valof
//---------------------------------------------------------------------------
// Returns the width of the character in the font associated with sds.
[
let strikeFont = sds>>SDS.strikeFont
let xIndex = char - strikeFont>>Strike.min
   [ // repeat
   if xIndex ls 0 % char gr strikeFont>>Strike.max then
      xIndex = strikeFont>>Strike.max-strikeFont>>Strike.min+1
   let width = (sds>>SDS.xPosTable)!(xIndex+1) - (sds>>SDS.xPosTable)!xIndex
   if width ne 0 then resultis width
   xIndex = -1
   ] repeat
]

// Stream object operations

//---------------------------------------------------------------------------
and SimpleDspPuts(sds, char) be
//---------------------------------------------------------------------------
[
let strikeFont = sds>>SDS.strikeFont
switchon char into
   [
   case $*n:
      [
      let newY = sds>>SDS.bbt.dty + sds>>SDS.bbt.dh
      test (newY + sds>>SDS.bbt.dh) gr (sds>>SDS.dcb.height lshift 1)
         ifso ScrollUp(sds)
         ifnot sds>>SDS.bbt.dty = newY
      SimpleDspResetLine(sds)
      endcase
      ]
   default:
      [
      let xIndex = char - strikeFont>>Strike.min
      if xIndex ls 0 % char gr strikeFont>>Strike.max then
         xIndex = strikeFont>>Strike.max-strikeFont>>Strike.min+1
      let xOffset = (sds>>SDS.xPosTable)!xIndex
      let width = (sds>>SDS.xPosTable)!(xIndex+1) - xOffset
      if width eq 0 then
         [ char = strikeFont>>Strike.max+1; docase char ]
      if (sds>>SDS.bbt.dlx + width) gr sds>>SDS.rightMargin then
         [ Puts(sds, $*n); docase char ]
      sds>>SDS.bbt.dw = width
      sds>>SDS.bbt.slx = xOffset
      sds>>SDS.bbt.function = 1  // paint, from source block
      BitBlt(lv sds>>SDS.bbt)
      sds>>SDS.bbt.dlx = sds>>SDS.bbt.dlx + width
      endcase
      ]
   ]
]

//---------------------------------------------------------------------------
and SimpleDspResets(sds) be
//---------------------------------------------------------------------------
[
Zero(sds>>SDS.dcb.bitmap, sds>>SDS.dcb.width*sds>>SDS.dcb.height*2)
sds>>SDS.bbt.dlx = sds>>SDS.leftMargin
sds>>SDS.bbt.dty = 0
]

//---------------------------------------------------------------------------
and SimpleDspCloses(sds, char) be
//---------------------------------------------------------------------------
// Removes DCB from the display list (if present) and destroys stream.
[
let dcb = @displayListHead
   [ // repeat
   if dcb eq 0 then break
   if dcb>>DCB.next eq lv sds>>SDS.dcb then
      [ dcb>>DCB.next = sds>>SDS.dcb.next; break ]
   dcb = dcb>>DCB.next
   ] repeat
Free(sds>>SDS.zone, sds)
]

// Internal procedures

//---------------------------------------------------------------------------
and ScrollUp(sds) be
//---------------------------------------------------------------------------
[
let bbt = vec lBBT; bbt = (bbt+1) & -2
Zero(bbt, lBBT)
bbt>>BBT.dbca = sds>>SDS.bbt.dbca
bbt>>BBT.dbmr = sds>>SDS.bbt.dbmr
bbt>>BBT.dlx = sds>>SDS.leftMargin
bbt>>BBT.dw = sds>>SDS.rightMargin - sds>>SDS.leftMargin
bbt>>BBT.dh = (sds>>SDS.dcb.height lshift 1) - sds>>SDS.bbt.dh
bbt>>BBT.sbca = sds>>SDS.bbt.dbca
bbt>>BBT.sbmr = sds>>SDS.bbt.dbmr
bbt>>BBT.slx = sds>>SDS.leftMargin
bbt>>BBT.sty = sds>>SDS.bbt.dh
// bbt>>BBT.function = 0  // replace, from source block
BitBlt(bbt)
]