// DspStreamsB.bcpl -- Companion file is DspStreamsA.asm
// Copyright Xerox Corporation 1979, 1980
// Alto BitBlt removed January 21, 1985 1:15 PM by van Melle
// Last modified November 26, 1980 3:29 PM by Taft

// Definition of DS in Streams.d publishes only the generic stream
// stuff + fdcb, ldcb, scroll, compact, cdcb

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

external
[
// outgoing procedures
CreateDisplayStream// (nlines, pBlock, lBlock, Font [sysFont]
// wWidth [38], options [left+right}, zone
// [sysZone]) -> ds
ShowDisplayStream// (ds, how [, otherS])
GetFont// (ds) -> font
SetFont// (ds, font)
GetBitPos// (ds) -> pos
SetBitPos// (ds, pos)
GetLinePos// (ds) -> lpos
SetLinePos// (ds, lpos) -> true/false
InvertLine// (ds, lpos) -> 0/1
EraseBits// (ds, nbits[, flag])
CharWidth// (fontorstream, charorstring) -> width
GetLmarg// (ds) -> pos
SetLmarg// (ds, pos)
GetRmarg// (ds) -> pos
SetRmarg// (ds, pos)
Scroll// (ds[, char])
ResetLine// (ds)
FontHeight// (font) -> height

// incoming procedures
MoveBlock; SetBlock; Zero; BitBlt; Max; Min; Usc
DefaultArgs; CallSwat; SysErr
Allocate; Free
DisplayPut// (ds, char), in DspStreamsA.asm
Puts

// incoming statics
dsp; sysFont; sysZone
]

// error codes
manifest
[
ecNotEnoughRoom = 1700
ecBadHowCommand = 1701
]

// Display stream (published part is in Streams.D)
// numbered entries used by assembly code
// starred entries may be modified after initialization

structure DSS:
[
@DS// 12 + 2 words ( scroll=12)
lmarg word// * left margin
rmarg word// * right margin
options word// option flags
blksz word// block size for text line
nwrds word// words per full scan line
pfont word// *19 pointer to font
// Following 2 are in order for CONVRT instruction
bwrds word// *20 words per scan line
dba word// *21, destination bit address
bstop word// *22, bit where to stop writing
bsofar word// *23, bits so far in this line
wad word// *24, dest. word address
savac2 word// *25, temp for AC2
fmp word// pointer to full text line of bitmap
bda word// beginning of bitmap data area
tdcb word// * top DCB with data
mwp word// * bitmap writer pointer
nl word// number of lines user has
zone word// zone allocated from
]
manifest lDSS = (size DSS)/16


manifest
[
displayheight = 808
displaywidth = 606
leftmargin = 8
]

structure STRING [ length byte; char ↑1,255 byte ]

//----------------------------------------------------------------------------
let CreateDisplayStream(nl, ssa, esa, font, wWidth, options,
zone; numargs na) = valof
//----------------------------------------------------------------------------
[
DefaultArgs(lv na, -3, sysFont, ((displaywidth+31)/16)&(-2),
DScompactleft+DScompactright, sysZone)
compileif lDSS gr lDS then [ foo = nil ]
esa = ssa + esa
ssa = (ssa+1) & (not 1)
esa = (esa) & (not 1)
let ds = Allocate(zone, lDSS)
ds>>DSS.zone = zone
ds>>DSS.nl = nl
ds>>DSS.pfont = font
ds>>DSS.type = stTypeDisplay
ds>>DSS.nwrds = wWidth
let ht = (xfont(font)!(-2)+1) rshift 1
let bsz = wWidth*ht*2
if Usc(esa-ssa, nl*lDCB+bsz) ls 0 then SysErr(ds, ecNotEnoughRoom)
ds>>DSS.puts = DisplayPut
ds>>DSS.close = ReleaseDs
ds>>DSS.reset = ClearDs
ds>>DSS.scroll = Scroll
ds>>DSS.compact = Compact
let edcb = ssa + nl*lDCB
let ldcb = edcb - lDCB
ds>>DSS.fdcb, ds>>DSS.ldcb = ssa, ldcb
ds>>DSS.blksz = bsz
let bda = edcb
ds>>DSS.fmp = esa - bsz
ds>>DSS.bda = bda
let p = ssa
for i = 1 to nl do
[
p>>DCB.next, p>>DCB.height = p+lDCB, ht
p = p +lDCB
]
ldcb>>DCB.next = 0
let rightmargin = wWidth*16
if rightmargin gr displaywidth then rightmargin = displaywidth
ds>>DSS.lmarg, ds>>DSS.rmarg = leftmargin, rightmargin
ds>>DSS.options = options
SetFont(ds, font)
ClearDs(ds)
resultis ds
]

//----------------------------------------------------------------------------
and CharWidth(font, char) = valof
//----------------------------------------------------------------------------
[
let w, cw = 0, nil
if (char & 177400b) ne 0 then
[
for i = 1 to char>>STRING.length do
w = w + CharWidth(font, char>>STRING.char↑i)
resultis w
]
if font>>DSS.type eq stTypeDisplay then font = font>>DSS.pfont
if font!-2 ls 0 then font, w = font!-1, 1
[
cw = font!(font!char+char)
if (cw & 1) ne 0 then break
w, char = w+16, cw rshift 1
] repeat
resultis w + cw rshift 1
]

//----------------------------------------------------------------------------
and ResetLine(ds) be
//----------------------------------------------------------------------------
[
SetBitPos(ds, ds>>DSS.rmarg)
EraseBits(ds, ds>>DSS.lmarg-ds>>DSS.rmarg)
]

//----------------------------------------------------------------------------
and FontHeight(font) = xfont(font)!-2
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and xfont(font) = (font!-2 ls 0? font!-1, font)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and ClearDs(ds) be
//----------------------------------------------------------------------------
[
let fdcb, fmp = ds>>DSS.fdcb, ds>>DSS.fmp
let dcb = fdcb
for i = 1 to ds>>DSS.nl do
[
dcb>>DCB.parwd = 0
dcb>>DCB.bitmap = fmp
dcb = dcb +lDCB
]
ds>>DSS.cdcb = fdcb
ds>>DSS.tdcb = fdcb
fdcb>>DCB.width = ds>>DSS.nwrds
ds>>DSS.mwp = ds>>DSS.bda
ClearMap(ds)
]

//----------------------------------------------------------------------------
and ClearMap(ds) be
//----------------------------------------------------------------------------
[
ds>>DSS.cdcb>>DCB.indwidth = ds>>DSS.nwrds
Zero(ds>>DSS.fmp, ds>>DSS.blksz)
SetBitPos(ds, ds>>DSS.lmarg)
]

//----------------------------------------------------------------------------
and ReleaseDs(ds) = valof
//----------------------------------------------------------------------------
[
ShowDisplayStream(ds, DSdelete)
Free(ds>>DSS.zone, ds)
resultis 0
]

//----------------------------------------------------------------------------
and ShowDisplayStream(ds, how, otherDs; numargs na) be
//----------------------------------------------------------------------------
// fdcb and ldcb must be first two elements of DSS structure -- this
// is so that other people can simulate "streams" easily for the
// purposes of using this routine
[
compileif offset DSS.fdcb ne 0 % offset DSS.ldcb ne 16 then [ foo = nil ]
DefaultArgs(lv na, -1, DSbelow, dsp)
let p = nil
switchon how into
[
case DSdelete:
[
p = PrevDCB(ds!0)
if p then p>>DCB.next = (ds!1)>>DCB.next
endcase
]
case DSbelow:
[
(ds!1)>>DCB.next = (otherDs!1)>>DCB.next
(otherDs!1)>>DCB.next = ds!0
endcase
]
case DSabove:
[
p = PrevDCB(otherDs!0)
if p then
[
(ds!1)>>DCB.next = otherDs!0
p>>DCB.next = ds!0
]
endcase
]
case DSalone:
[
(ds!1)>>DCB.next = 0
@displayListHead = ds!0
endcase
]
default: SysErr(ds, ecBadHowCommand)
]
]

//----------------------------------------------------------------------------
and PrevDCB(dcb) = valof
//----------------------------------------------------------------------------
[
let org = displayListHead-(offset DCB.next/16)
while org>>DCB.next ne dcb do
[
if org eq 0 then resultis 0
org = org>>DCB.next
]
resultis org
]

//----------------------------------------------------------------------------
and GetFont(ds) = ds>>DSS.pfont
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and SetFont(ds, pfont) = valof
//----------------------------------------------------------------------------
[
let ht = (xfont(pfont)!(-2)+1) rshift 1
ds>>DSS.pfont = pfont
SetRmarg(ds, ds>>DSS.rmarg)
resultis ht le ds>>DSS.cdcb>>DCB.height
]

//----------------------------------------------------------------------------
and GetBitPos(ds) = ds>>DSS.bsofar
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and SetBitPos(ds, pos) = valof
//----------------------------------------------------------------------------
[
ds>>DSS.bsofar = pos
ds>>DSS.dba = (not pos) & 17b
let cdcb = ds>>DSS.cdcb
ds>>DSS.bwrds = cdcb>>DCB.width
ds>>DSS.wad = cdcb>>DCB.bitmap-cdcb>>DCB.width+pos rshift 4
resultis pos le ds>>DSS.bstop
]

//----------------------------------------------------------------------------
and GetLmarg(ds) = ds>>DSS.lmarg
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and SetLmarg(ds, pos) be
//----------------------------------------------------------------------------
[
ds>>DSS.lmarg = pos
SetBitPos(ds, pos)
]

//----------------------------------------------------------------------------
and GetRmarg(ds) = ds>>DSS.rmarg
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and SetRmarg(ds, pos) be
//----------------------------------------------------------------------------
[
ds>>DSS.rmarg = pos
let d, font = 0, ds>>DSS.pfont
if font!-2 ls 0 then d, font = 1, font!-1
ds>>DSS.bstop = pos-(font!(-1) & 377b)-d
]

//----------------------------------------------------------------------------
and GetLinePos(ds) = (ds>>DSS.cdcb-ds>>DSS.fdcb)/lDCB
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and SetLinePos(ds, lpos) = valof
//----------------------------------------------------------------------------
[
let dcb = ds>>DSS.fdcb+lpos*lDCB
if lpos ge ds>>DSS.nl resultis false
if dcb>>DCB.indentation ne 0 resultis false
if dcb>>DCB.width eq 0 resultis false
ds>>DSS.cdcb = dcb
ds>>DSS.bwrds = dcb>>DCB.width
SetBitPos(ds, ds>>DSS.bsofar)
resultis true
]

//----------------------------------------------------------------------------
and InvertLine(ds, lpos) = valof
//----------------------------------------------------------------------------
[
let dcb = ds>>DSS.fdcb+lpos*lDCB
let b = dcb>>DCB.background
dcb>>DCB.background = b+1
resultis b
]

//----------------------------------------------------------------------------
and Scroll(ds, char; numargs na) = valof
//----------------------------------------------------------------------------
[
if na ge 2 switchon char into
[
case $*N: endcase // cr
case $*T:// tab
[
let sp8 = CharWidth(ds, $*S)*8
let lm=ds>>DSS.lmarg
unless SetBitPos(ds, ((ds>>DSS.bsofar-lm)/sp8+1)*sp8+lm) then
Puts(ds, $*S)
resultis char
]
case $*L: case 0:// null, lf
resultis char
case -1:// about to burp lines up one
case -2:// about to lose data off top of screen
resultis true
default:
[
test char ls 40b
ifso [ Puts(ds, $↑); Puts(ds, char+100b) ]
ifnot
[
// If a character with width=0 causes Scroll to be called,
// it can only be because the character doesn’t exist in the font.
let w = CharWidth(ds, char)
let rpos = w+ds>>DSS.bsofar
// Check inside machine code is only for whether
// currentpos+max width will exceed bstop.
// This check is more careful.
if w ne 0 then test rpos gr ds>>DSS.rmarg
ifso if (ds>>DSS.options&DSstopright) eq 0 endcase
ifnot
[
let ostop = ds>>DSS.bstop
ds>>DSS.bstop = rpos+20
Puts(ds, char)//always succeeds
ds>>DSS.bstop = ostop
]
]
resultis char
]
]
let scrolled = false
let cdcb, ldcb = ds>>DSS.cdcb, ds>>DSS.ldcb
test cdcb eq ldcb
ifnot
[
unless Compact(ds) resultis char
cdcb = cdcb>>DCB.next
ds>>DSS.cdcb = cdcb
]
ifso
[
let dcb = ds>>DSS.fdcb
if dcb eq ds>>DSS.tdcb then
[
unless ScrollOK(ds) resultis char
unless FreeBitMap(ds) goto one
]
unless Compact(ds) resultis char
// We are about to scroll. Do NOT call user scroll routine here to
// tell him of it, because if he does anything with the stream,
// the world will die, as the stream is temporarily in a bad state.
scrolled = true
while dcb ne ldcb do
[
MoveBlock(dcb+1, dcb+(lDCB+1), lDCB-1) // assumes next in word 0
dcb = dcb+lDCB
]
ds>>DSS.tdcb = ds>>DSS.tdcb-lDCB
one: cdcb>>DCB.indwidth = ds>>DSS.nwrds
cdcb>>DCB.bitmap = ds>>DSS.fmp
]
test cdcb>>DCB.bitmap eq ds>>DSS.fmp
ifso ClearMap(ds)
ifnot ResetLine(ds)
if scrolled then (ds>>DSS.scroll)(ds, -1)
if char ne $*N then Puts(ds, char)
resultis char
]

//----------------------------------------------------------------------------
and Compact(ds) = valof
//----------------------------------------------------------------------------
[
let dcb = ds>>DSS.cdcb
let ht = dcb>>DCB.height*2
let onw = dcb>>DCB.width
let nw = ((ds>>DSS.options&DScompactright) ne 0? (ds>>DSS.bsofar+15) rshift 4, onw)
let old = dcb>>DCB.bitmap// = ds>>DSS.fmp
let d = 0
if (ds>>DSS.options&DScompactleft) ne 0 then
[
while d ne nw do
[
let p = old+ds>>DSS.blksz+d
for i = 1 to ht do
[
p = p-onw
if @p ne 0 then goto used
]
d = d+1
]
used: ]
// unless (nw eq onw) & (d eq 1) do
nw, old = (nw-d+1)&(-2), old+d
let p = GetMapSpace(ds, nw*ht)
test p eq 0
ifsodcb>>DCB.indwidth = 0 // not enough room
ifnot test p eq -1
ifso resultis false // don’t scroll
ifnot
[
let new = p
if nw ne 0 then for i = 1 to ht do
[
MoveBlock(new, old, nw)
old, new = old+onw, new+nw
]
dcb>>DCB.width = nw
dcb>>DCB.indentation = d
]
dcb>>DCB.bitmap = p
resultis true
]

//----------------------------------------------------------------------------
and GetMapSpace(ds, nw) = valof
//----------------------------------------------------------------------------
[
let wp = nil
let bda = ds>>DSS.bda
[
wp = ds>>DSS.mwp
let rp = ds>>DSS.tdcb>>DCB.bitmap
let fmp = ds>>DSS.fmp
if rp eq fmp then wp = bda
test wp-bda gr rp-bda //Subtractions try to keep < 15 bit nums
ifso
[
if fmp-wp ge nw break //u/b gr
ds>>DSS.mwp = ds>>DSS.bda
if rp eq ds>>DSS.bda then
[
unless ScrollOK(ds) resultis -1
FreeBitMap(ds)
]
]
ifnot
[
if rp-wp ge nw break //u/b gr
unless ScrollOK(ds) resultis -1
unless FreeBitMap(ds) resultis 0// not enough room
]
] repeat
ds>>DSS.mwp = wp+nw
resultis wp
]

//----------------------------------------------------------------------------
and ScrollOK(ds) = valof
//----------------------------------------------------------------------------
[
if (ds>>DSS.options & DSstopbottom) ne 0 resultis false
resultis (ds>>DSS.scroll)(ds, -2)
]

//----------------------------------------------------------------------------
and FreeBitMap(ds) = valof
//----------------------------------------------------------------------------
[
let dcb = ds>>DSS.tdcb
if dcb>>DCB.bitmap eq ds>>DSS.fmp resultis false
ds>>DSS.tdcb = dcb +lDCB
dcb>>DCB.indwidth = 0
resultis true
]

//----------------------------------------------------------------------------
and EraseBits(ds, nBits, flag; numargs na) = valof
//----------------------------------------------------------------------------
[// replacement for OS EraseBits absent Alto bitblt
// ignores third arg flag
let newPos = Max(ds>>DSS.bsofar+nBits, 0)
let bm = ds>>DSS.cdcb>>DCB.bitmap
let rasterwidth = ds>>DSS.cdcb>>DCB.width
let dlx = Max(0, ds>>DSS.bsofar + Min(nBits, 0))
let dw = newPos eq 0? ds>>DSS.bsofar,
newPos gr ds>>DSS.cdcb>>DCB.width*16?
ds>>DSS.cdcb>>DCB.width*16 - ds>>DSS.bsofar, Max(nBits, -nBits)
let dh = ds>>DSS.cdcb>>DCB.height*2
let masks = table [
#000000; #100000; #140000; #160000;
#170000; #174000; #176000; #177000;
#177400; #177600; #177700; #177740;
#177760; #177770; #177774; #177776
]
let lmask = @(masks + (dlx & 15))
let firstword = dlx rshift 4
let rmask = @(masks + ((dlx + dw) & 15)) xor -1
let nwords = ((dlx + dw) rshift 4) - firstword
if nwords eq 0
then lmask = lmask % rmask
let base = bm+firstword
for i = 0 to dh-1
do [
let addr = base
@addr = @addr & lmask
if nwords
then [
for j = 2 to nwords
do [ addr = addr+1; @addr = 0 ]
addr = addr+1
@addr = @addr & rmask
]
base = base+rasterwidth
]
SetBitPos(ds, newPos)
resultis newPos
]