// 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 ]