// DspStreamsB.bcpl -- Companion file is DspStreamsA.asm
// Copyright Xerox Corporation 1979, 1980
// 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
ifso dcb>>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
//----------------------------------------------------------------------------
[
if na ls 3 then flag = 0
let newPos = Max(ds>>DSS.bsofar+nBits, 0)
let bbt = vec lBBT; bbt = (bbt+1)&(-2); Zero(bbt, lBBT)
bbt>>BBT.function = flag ls 0? 16B, 14B // invert, replace
bbt>>BBT.dbca = ds>>DSS.cdcb>>DCB.bitmap
bbt>>BBT.dbmr = ds>>DSS.cdcb>>DCB.width
bbt>>BBT.dlx = Max(0, ds>>DSS.bsofar + Min(nBits, 0))
bbt>>BBT.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)
bbt>>BBT.dh = ds>>DSS.cdcb>>DCB.height*2
SetBlock(lv bbt>>BBT.gray, flag ne 0, 4)
BitBlt(bbt)
SetBitPos(ds, newPos)
resultis newPos
]