// S H O W
// errors 700
//
// ICC assignment coding:
// 0 => not yet assigned in this font load
// 1 => assigned in this font load, but not yet used on this page
// -1 => transition from 1 when used (i.e., used on this page; old)
// -2 => transition from 0 when used (i.e., used on this page; new)
//get "Spruce.d" makes dictionary too big
get "SpruceInLdOutLdEC.d" // InLd/OutLd messages for spooler <-> service communication
// get "SprucePrinters.d" // only use mPimFiles
get "Sprucedoc.d"
get "Sprucefont.d"
get "Spruceband.d"
get "spruceShow.d"
get "Sprucefiles.d"
get "PressFile.d"
// defined here
external
[
ShowInit
ShowClose
ShowPage
FSGetRelease
ShowCharSet
ShowCharFont
ShowCharSetSpace
ShowCharacters
ShowCharactersImmediate
ShowRectangle
ShowX
ShowY
ShowXY
ShowOnCopy
ShowDots
]
// external
external
[
//SpruceUtils
EmergencyAverted
EmergencyOver
FSGet
FSGetX
FSPut
SpruceError
SpruceCondition
Max
IsOverlayPresent
// SPRUCEDIR
UseEntry
//SPRUCEML
OrbitCharSize
DoubleAdd
Min
MulDiv
MulDivNR // no rounding (truncate)
MulDivRU // always round up
GetCode0
GetCode1
DoubleCop
DoubleSub
RowRotate // (inBuf-1, outBuf-1, wordsPerRow)
SafeAdd // fails on unsigned overflow
//CURSOR
CursorChar
CursorDigit
CursorClear
//BAND
BandInit
BandClose
BandBeginPage
BandEndPage
BandFlush
//BAND ml
BandEnter
SetupShowFonts // ML linkages to microcode, setting up semi-permanent values
SetupShowChars // ML linkages to microcode, setting up base values for one string
ShowChars // ML linkages to microcode, process one string
// PARTS
SkipinPart
//WINDOW FILES
CurrentPos
FileStuff
WindowReadBlock
WindowGetPosition
WindowNextPage
WindowPositionPtr
WindowSetPosition
WindowReadByte
WindowRead
SetupWindowStream
//OS
Zero
oneBits
MoveBlock
CallSwat
]
// incoming statics
external
[
BandFile; BandWindow
DebugSystem
FontWindow
maxPrintPassRecs
logBandRecordSize
nVisibleBands
onlyOnCopy
partNumber
LandscapeDevice
Capabilities
printerDevice
ResolutionS
ResolutionB
XOffset
YOffset
FA
PermanentBottom
OverlayBottom
OverlayTable
SpruceZone
emergencyStorage
xmFonts
]
// external for ShowChars microcode specifications -- see below
external
[
BandFree; BandAvail; fspn; fspo; ICCUses; ICCOffset; bc; ec
WidthPointer; BandTable
CurS; CurB; CopyTable // not part of contiguous entries, but part of ShowChars linkage
]
// internal statics
static
[
mpFontFN
nFontLoads
maxBandRecsSoFar //Size of band records before this page begun
maxFontSizeSoFar //Size of font storage before this page begun
FontSizePageNew //Total size of new chars assigned this page
FontSizePageOld //Total size of chars on this page previously assinged
currentFontSet
currentFont
fontComplaintGiven
Installed; InEffect; SpaceS; SpaceB // for setting variable space widths
pDoc //Pointer to document we are working on
showCount = 0
// specifications for ShowChars Microcode -- see SprintStatics.bj
BandTable
CopyTable
ICCUses
ICCOffset
bc
ec
WidthPointer
fspn
fspo
BandFree
BandAvail
// not within controlled address area, but also supplied to microcode
CurS
CurB
]
// ****** These codes must match those in ShowCharMc. They must also match the
// ****** positions of a dispatch table in the machine language linkage to ShowChars
manifest // microcode return codes
[
MUDone = 0 // entire string complete
MUCharRange = 1 // character not found in font
MUOffPage = 2 // character would be placed off page
// MUBufFull = 3 // band buffer must be flushed before next char shown (ML does)
]
manifest mPimFiles = 1 // from SprucePrinters.d (no room)
structure [ Bytes↑1, 2 byte ]
// -----------------------------------------------------------
// ShowInit(doc) ShowClose()
// -----------------------------------------------------------
let ShowInit(doc) be
[
CursorChar($S); CursorDigit(0)
pDoc=doc
let nPages=pDoc>>DocG.nPages
let Pages=FSGetX(nPages*(size PageG/16))
pDoc>>DocG.Pages=Pages
// Position band file down far enough to let header be put
// out that contains DocG, PageG and FontG structures:
let bandInitPos=vec 1
bandInitPos!0=0
bandInitPos!1=(size DocG/16)+nPages*(size PageG/16+size FontG/16)
WindowSetPosition(BandWindow, bandInitPos)
// Now compute number of records available to printing pass
let csiz=(PermanentBottom-OverlayBottom-bandInitPos!1)
// the calculation below doesn't allow for discarding the Print Overlay initialization ~~~~
csiz=csiz-(OverlayTable!(OVPrint+1)-OverlayTable!OVPrint)*256-loSize-10
let ovdev=selecton printerDevice into
[
case printerDover: OVDover
case printerPenguin: OVPenguin
case printerSequoia: OVSequoia
case printerPimlico: OVPimlico
case printerPuffin: OVPuffin
]
csiz=csiz-(OverlayTable!(ovdev+1)-OverlayTable!ovdev)*256
if IsOverlayPresent(OVT80) then
csiz = csiz-(OverlayTable!(OVT80+1)-OverlayTable!OVT80)*256
if (DebugSystem丠) ne 0 then csiz = csiz-2000 // measure table size
maxPrintPassRecs=csiz rshift logBandRecordSize
let icc=pDoc>>DocG.ICCtotal
ICCUses=FSGetX(icc)
Zero(ICCUses, icc) // 0=> not assigned
mpFontFN=FSGetX(22)
Zero(mpFontFN, 16)
CurS= (mpFontFN+16+1)&(-2) // even-aligned
CurB=CurS+2
Installed, InEffect, SpaceS, SpaceB = false, false, 0, 0
nFontLoads=0
onlyOnCopy = 0
maxFontSizeSoFar=4 // Account for dummy char
maxBandRecsSoFar = 0
BandInit()
]
and ShowClose() be
[
MakeFI() //Flush last font load.
FSPut(ICCUses)
FSPut(mpFontFN)
BandClose()
pDoc>>DocG.nFontLoads=nFontLoads
FSGetRelease(0) //Release all font width tables
]
// -----------------------------------------------------------
// ShowPage(func, page, arg [, pass])
// -----------------------------------------------------------
and ShowPage(func, page, arg, pass; numargs na) be
[
// If pass argument is present, it should be forwarded to "func" as "arg"
// For a three color printer, produce three
// color-separated pages, one per pass.
CursorClear(); CursorDigit()
test na eq 4 then [ arg=pass; if (Capabilities&mPimFiles) ne 0 then pass = -1 ]
or pass = -1
if pass le 1 then
[
BandBeginPage()
FontSizePageOld=0
FontSizePageNew=0
]
// Call main function to spit out visible stuff
func(pDoc, page, arg)
// Finish writing the bands, and compute the length
unless pass le 1 return // problem with real color puffin ~~~~~~~
BandEndPage(page)
// If this page can be folded into the last one (for purposes of
// font planning), it must be the case
// that maxBandRecs+nFontRecs (2*maxBandRecs+nFontRecs if a Dover) is small enough to fit
// (le maxPrintPassRecs).
// If xmFonts (using bank 1 for fonts), then fonts must fit in bank 1, and ICC table must
// fit in with maxBand. . .
let ICCtotal=pDoc>>DocG.ICCtotal
let m=maxBandRecsSoFar //Not including this page
let nBandRecs=page>>PageG.nRecords
if nBandRecs gr m then m=nBandRecs
let nFontRecs, s = nil, maxFontSizeSoFar
unless SafeAdd(lv s, FontSizePageNew)&SafeAdd(lv s, xmFonts? #1000, ICCtotal) do FontOverflow()
let nFontRecs = xmFonts? BandRecords(ICCtotal), BandRecords(s)
// If it does not fit, push out the earlier font load
if nFontRecs+m*(printerDevice ne printerDover? 1,2) gr maxPrintPassRecs then
[
if maxBandRecsSoFar then MakeFI() //Subroutine to push out current font load
maxFontSizeSoFar=FontSizePageOld; unless SafeAdd(lv maxFontSizeSoFar, 4) do
FontOverflow()
for i=0 to ICCtotal-1 do if ICCUses!i gr 0 then ICCUses!i=0
maxBandRecsSoFar=0
]
page>>PageG.fontLoad=nFontLoads
for i=0 to ICCtotal-1 do if ICCUses!i ls 0 then ICCUses!i=1
unless SafeAdd(lv maxFontSizeSoFar, FontSizePageNew) do FontOverflow()
if nBandRecs gr maxBandRecsSoFar then
maxBandRecsSoFar=nBandRecs
]
and FontOverflow() be SpruceCondition(712, ECFileTerminate, partNumber) // Too many char shapes
// -----------------------------------------------------------
// MakeFI() BandRecords(siz) FSGetRelease(siz)
// -----------------------------------------------------------
// Make a font load entry (FI) that describes which ICC's
// will be needed for this particular font load. The needed ICC's
// are found by examining the ICC use table.
and MakeFI() be
[
let ICCtotal, s= pDoc>>DocG.ICCtotal, ICCtotal
unless xmFonts%SafeAdd(lv s, maxFontSizeSoFar) do FontOverflow()
if xmFonts then [ let t = maxFontSizeSoFar; unless SafeAdd(lv s, #1000) do FontOverflow() ]
let nRecs=maxBandRecsSoFar+BandRecords(s)
if nRecs gr maxPrintPassRecs then SpruceCondition(710, ECFileTerminate, partNumber)
let wds=(ICCtotal+15)/16+(size FI/16)
let oldBlock = pDoc>>DocG.fontLoadList
let oldLen = oldBlock? -(oldBlock!-1)-1,0
let p = FSGet(wds+oldLen)
test p then [ if oldBlock do
[
let new = p+wds
MoveBlock(new, oldBlock, oldLen)
while oldBlock>>FI.next eq (oldBlock + wds) do
[ new>>FI.next = new + wds; oldBlock = oldBlock>>FI.next; new = new>>FI.next ]
FSPut(pDoc>>DocG.fontLoadList) //release old block
pDoc>>DocG.fontLoadList =p+wds
] ]
or p=FSGetRelease(wds)
Zero(p, wds)
p>>FI.fontLoad=nFontLoads; nFontLoads=nFontLoads+1
p>>FI.fontLength=maxFontSizeSoFar
// Now build bit table for all ICC's used up to but not including
// this page (i.e., coding=1 or -1)
let q=p+(size FI/16) //Pointer to region for ICC bits
let iccP=ICCUses
[
if iccP-ICCUses ge ICCtotal then break
for i=0 to 15 do
[
let u=iccP!i
if u eq 1 % u eq -1 then @q=@q % oneBits!i
]
q=q+1; iccP=iccP+16
] repeat
// Thread on the queue
p>>FI.next=pDoc>>DocG.fontLoadList
pDoc>>DocG.fontLoadList=p
]
and BandRecords(siz) = valof
[
let r=1 lshift logBandRecordSize
resultis (siz+r-1) rshift logBandRecordSize
]
and FSGetRelease(siz, aligned; numargs na) = valof // +++fast microcode
[
if na<2 then aligned = false // +++fast microcode
let p=0
if siz then p=FSGet(siz+(aligned? 2, 0)) // +++fast microcode
if p ne 0 then test not aligned then resultis p // +++fast microcode
or [ // +++fast microcode -- align to even address, store real addr in prev. odd word
let q = p; p=(p+2)&(-2) // +++fast microcode
p!-1 = q; resultis p // +++fast microcode
] // +++fast microcode
let q=pDoc>>DocG.fontList // ALL were aligned! // +++fast microcode
while q ne 0 do
[
if q>>FN.widthPtr ne 0 &
q>>FN.widthPtr-(q>>FN.bc*(size CharWidth/16)) ne WidthPointer then
[
FSPut((q>>FN.widthPtr)!(-1)) // +++fast microcode -- use stored pointer
q>>FN.widthPtr=0
if siz break
]
q=q>>FN.next
]
if q eq 0 then
[
if siz eq 0 then [ EmergencyOver(); resultis nil ]
// dip into the emergency till (needed, given statement following?)
if EmergencyAverted(SpruceZone) loop
// last chance -- force band flush, see if things can get better
BandFlush(); if emergencyStorage loop // else No room for widths!
SpruceCondition(700,ECFileTerminate, pDoc>>DocG.PressFile>>SPruceFile.fileCode)
]
] repeat
// -----------------------------------------------------------
// ShowCharSet(set) ShowCharFont(font)
// -----------------------------------------------------------
// Font setup. First function is called when a font set is given.
// Simply fills in mpFontFN with pointers to the FN structures
// for the given fonts. The method is to search all known fonts.
and ShowCharSet(set) be
[
currentFontSet=set
Zero(mpFontFN, 16)
let p=pDoc>>DocG.fontList
while p ne 0 do
[
for i=1 to p>>FN.pressUses do
[
let use = UseEntry(p, i);
if use>>FNUse.uSet eq set then
mpFontFN!(use>>FNUse.uFont)=p
]
p=p>>FN.next
]
]
// Establish a particular font number. Sets up statics:
// bc,ec: Range of good character codes
// ICCOffset: Thing to add to a character code to get icc
// WidthPointer: Pointer to base of CharWidth structures
and ShowCharFont(font) be
[
currentFont=font
ShowCharSetSpace(4) //Remove current space, if any
WidthPointer=0 //So FSGetRelease will not see it
let p=mpFontFN!font
if p eq 0 then
[
fontComplaintGiven=false
bc=256+1; ec=-1 //No characters legal
return
]
bc=p>>FN.bc; ec=p>>FN.ec
ICCOffset=p>>FN.ICCOffset-bc
let w=p>>FN.widthPtr
if w eq 0 then
[
let len=(ec-bc+1)*(size CharWidth/16)
w=FSGetRelease(len, true)
p>>FN.widthPtr=w
WindowSetPosition(FontWindow, lv p>>FN.widthSa)
WindowReadBlock(FontWindow, w, len)
]
WidthPointer=w-bc*(size CharWidth/16)
unless p>>FN.widest for i = bc to ec do
[
let q = WidthPointer+i*(size CharWidth/16)
p>>FN.widest = Max(p>>FN.widest, q>>CharWidth.DS)
p>>FN.tallest = Max(p>>FN.tallest, q>>CharWidth.DB)
]
ShowCharSetSpace(3) //Install current space, if any
SetupShowFonts() // Install font-based parameters in microcode registers
]
// -------------------------------------------------------------------------
and ShowCharactersImmediate(adr, firstChar, numChars) be
// -------------------------------------------------------------------------
[
let s = FSGetX(lFSx, SpruceZone, 0)
s>>FSx.gets = WindowReadByte
SetupWindowStream(s, adr, firstChar, (numChars+3)&2)
ShowCharactersFromStream(s, numChars-firstChar)
FSPut(s)
]
// -------------------------------------------------------------------------
and ShowCharacters(s, numChars) be
// -------------------------------------------------------------------------
[
let charsPerPage = s>>SS.spruceFile>>SPruceFile.pageSize lshift 1
[
if numChars eq 0 return
let pos, leftThisPage=nil, nil
[
// ~~ fraught with peril in error situations, on T-80 system particularly
// ~~ will probably work forever, though
pos = CurrentPos(s); leftThisPage = charsPerPage-pos
if leftThisPage>0 break
WindowNextPage(s)
] repeat
let n = Min(numChars, leftThisPage)
numChars = numChars-n
ShowCharactersFromStream(s, n)
WindowPositionPtr(s, pos+n)
] repeat
]
// -------------------------------------------------------------------------
and ShowCharactersFromStream(s, numChars) be
// -------------------------------------------------------------------------
[
if emergencyStorage eq 0 then BandFlush()
showCount = showCount-1; // if showCount eq 0 then CallSwat("This one")
// Assume font is set up (see above)
// Also assumes CurS, CurB are double precision coordinates for the next position
if ec<0 then
[
unless fontComplaintGiven then
SpruceCondition(701, ECWarning, currentFontSet, currentFont)
fontComplaintGiven=true
return
]
SetupShowChars(numChars, lv s>>FS.fsp) // setup font, count, stream parameters
let c, band = nil, nil
[
let condition = 703
switchon ShowChars(lv c) into
[
case MUDone: break
case MUCharRange: unless c endcase
condition = 702
case MUOffPage: // condition=703
SpruceCondition(condition, ECWarning, mpFontFN!currentFont, c)
endcase
// case MUBufFull: BandFlush(); endcase // (Done within ShowChars ML)
default: SpruceError(102) // terrible thing
]
] repeat
unless SafeAdd(lv FontSizePageNew, fspn)&SafeAdd(lv FontSizePageOld, fspo) do FontOverflow()
]
// approximation to Setup routine -- real one is ML linkage to microcode
// -------------------------------------------------------------------------
// and SetupShowChar(specs, numChars, streamFsp) be // SetupShowChar, SetupShowFont
// -------------------------------------------------------------------------
// [ // see SprintStatics.bj for specs layout
// rICCUses=ICCUses
// rICCOffSet=ICCOffSet
// rbcM1=bc-1
// rec=ec
// rWidthPointer=WidthPointer
// rBandTable=BandTable
// rnVisibleBands=nVisibleBands
// above happens in SetupShowFonts, once per font change -- below happens before each ShowChars loop
// rCurS0=CurS!0; rCurS1=CurS!1
// rCurB0=CurB!0; rCurB1=CurB!1
// ronlyOnCopy=onlyOnCopy
// rfspn, rfspo = 0, 0
// rbyteIdx= 0-streamFsp>>FSp.charPtr-1; 0 if 1st is odd, 1 else
// rbase=streamFsp>>FSp.wordPtr+byteIdx; word containing first byte
// rdata = @base
// rct=numChars
// ]
// approximation to ShowChars routine -- real one is ML linkage to microcode
// -------------------------------------------------------------------------
// and ShowChars(lvC, lvBand) = valof
// -------------------------------------------------------------------------
// [
//
// rBandFree=BandFree
// rBandAvail=BandAvail
// loop:
// rct = rct-1; if rct<0 goto FullReturn
// let c = Gets(stream) // simulated using ct, base, byteIdx
// if c le bcM1 goto RangeError
// if c > ec goto RangeError
// icc=ICCOffset+c
// let p=WidthPointer + c lsh 3 // *size charWidth/16, that is
// b←CurB0+p!5 // CharWidth.OB
// let t = CurS0+p!4
// lineBand = t rrot 4 // band is top 12 bits, line in band is bottom 4
// AC2 (ds) = p!6 // CharWidth.DS
// AC1 (db) = p!7 // CharWidth.DB
// if b>4096 goto OffPage
// if db < 0 goto OffPage
// band←lineBand&7777
// if band>nVisibleBands goto OffPage
// BandFree!0 = 100000+icc
// BandFree!1 = (lineBand&170000)+b
// DoubleAdd(CurS(0, 1), lv p.WS)
// DoubleAdd(CurB(0, 1), lv p.WB)
// let uses, a = lv ICCUses!icc, @uses
// if a ge 0 then
// [
// (AC0, AC1) = AC1*AC2+63 // db*ds+63, via MUL instr.
// let siz = (AC0, AC1) RSH 4 // / 16
// test a eq 0 then fspn = fspn+siz or fspo = fspo+siz
// @uses = a-2
// ]
// BandEnter(band, size BEChar/16)
// if onlyOnCopy goto OnCopy
// goto loop
// FullReturn:
// let t = specs.CurS; t!0 = CurS0; t!1 = CurS1
// let t = specs.CurB; t!0 = CurB0; t!1 = CurB1
// specs.fspn = fspn
// specs.fspo = fspo
// res = MUDone; goto AlwaysRet
// RangeError: res=MURangeError; goto AlwaysRet
// OffPage: res = MUOffPage; goto AlwaysRet
// OnCopy: res = MUOnCopy; goto AlwaysRet // need updated BandAvail, etc.! Restore returning!
// BufFull: res = MUBufFull; goto alwaysRet
// AlwaysRet:
// specs.BandFree = BandFree
// specs.BandAvail = BandAvail
// AC2←band; AC1←c // (@lvC = AC1; @lvBand = AC2)
// resultis res
// ] repeat // loops on std. case, above
// -------------------------------------------------------------------------
// ShowRectangle(width, height)
// -------------------------------------------------------------------------
and ShowRectangle(width, height) be
[
// width is dX, height is dY relative to Press File Page
// X and WidthM1 below refer to scan direction (left to right for Landscape)
// Y and mHeight refer to bit direction (bottom to top for Landscape)
// ~~ Portrait-Landscape treatments not optimized
if emergencyStorage eq 0 then BandFlush()
if width eq 0 % height eq 0 return
BandFree>>BERectangle.H=BERectangleH
let smin=CurS!0
let bmin=CurB!0
let dB = MulDivRU(ResolutionB, height, 25400) // delta-B if Landscape
let dS = MulDivRU(ResolutionS, width, 25400) // delta-S if Landscape
unless LandscapeDevice do // Portrait, transform
[
let temp = dS; dS = dB; dB = temp
smin = smin-dS+1 // Must start rectangle at [ +height, 0 ]
]
BandFree>>BERectangle.WidthM1=dS-1
BandFree>>BERectangle.mHeight=-dB
BandFree>>BERectangle.X=smin
BandFree>>BERectangle.Y=bmin
let band=smin rshift 4
test smin ge 0 & band ls nVisibleBands & bmin ge 0 then
BandEnter(band, size BERectangle/16)
or SpruceCondition(704, ECWarning)
]
// -------------------------------------------------------------------------
// ShowDots(DL, nn, opaque) Get parameters
// -------------------------------------------------------------------------
and ShowDots(DL, nn, opaque) be // opaque is false
[
let finalPos = vec 1
WindowGetPosition(DL, finalPos) // for backing out if invalid specs.
DoubleAdd(finalPos, nn)
// enable dot font
let savedSet, savedFont = currentFontSet, currentFont
ShowCharSet(64); ShowCharFont(2); ShowCharSetSpace(4) // No proportional spacing
let in, out = 0, 0
// Standard Return sequence
if false then
Resultis: //(errorCode)
[
let errorCode = GetCode0() // error code, passed as argument, 0: no error
let arg = GetCode1() // ~~ these are not adequate for multi-args
if in then FSPut(in-1)
if out&LandscapeDevice then FSPut(out)
// ~~ should check that dots end DL, errorCode = 780
if errorCode then SpruceCondition(errorCode, ECWarning, arg)
WindowSetPosition(DL, finalPos)
ShowCharSet(savedSet); ShowCharFont(savedFont) // will reinstate proportional, if needed
return
]
let code, mode, lines, dots, pl, pd, dl, dd, width, height =
nil, 3, nil, nil, 0, 0, -1, -1, nil, nil
let seen = 0 // flag for parts
// gather parameters
[
let a = WindowRead(DL)
let al = a𫓸
let ar = a±
switchon al into
[
case DDotCode:
[
if ar ge 1 & ar le 16 then code = ar
dots = WindowRead(DL)
lines = WindowRead(DL)
seen = seen%1
endcase
]
case DDotMode:
mode = ar; seen = seen%2; endcase
default: break
case 0: switchon ar into
[
case DSampleProps: SkipinPart(DL, 2, WindowRead(DL)); endcase
case DDotWindow:
pd, dd = WindowRead(DL), WindowRead(DL)
pl, dl = WindowRead(DL), WindowRead(DL)
seen = seen%4; endcase
case DDotSize:
width = WindowRead(DL)
height = WindowRead(DL)
seen = seen % 8; endcase
case DDotsFromPressFile:
case DDotsFromFile:
Resultis(808) // not implemented
case DDotsFollow:
seen = seen%16; break
]; endcase
]
] repeat
let required = seen& (1+8+16)
unless required eq (1+8+16) do Resultis(740+required)
unless (seen&4) ne 0 do [ dd = dots; dl = lines ]
// ShowDots (cont) Checking, setup for main loop
// Consistency checking
if pd+dd>dots % pl+dl>lines % dl eq 0 % dd eq 0 then Resultis(720)
for i = 0 to 7 do if (lv lines)!i < 0 then Resultis(720)
// Alto resolution restrictions
unless mode eq 3 do Resultis(732)
if width/dots ne 32 % (width/dots)*dots ne width then Resultis(730) // 32 mica dots
if (dots) ne 0 then Resultis(731) // integral # words
let CurX, CurY, ResolutionX, ResolutionY = nil, nil, nil, nil // X-Y versions for S-B values
test LandscapeDevice then
[ CurX, CurY, ResolutionX, ResolutionY = CurS, CurB, ResolutionS, ResolutionB ]
or [ CurX, CurY, ResolutionX, ResolutionY = CurB, CurS, ResolutionB, ResolutionS ]
// Auxiliary values
let base = vec 2
WindowGetPosition(DL, base, charItem)
let oldCurX = vec 1
let savedCurX, savedCurY = vec 1, vec 1
DoubleCop(oldCurX, CurX)
DoubleCop(savedCurX, CurX); DoubleCop(savedCurY, CurY)
// More auxiliary values -- line oriented
let lineBase = pl+dl-1 // index of bottom line
let groups = (dl+7)/8
let groupLines = (groups-1)*8 // floor (dl|8) // 8 line groupings for loading into rotation array
// More -- dots oriented
// pl, pd, dl, dd window extended in dot direction to word boundaries during some calculations
// variables representing this extended window or processing related thereto have suffix W
let dotsBytes = dots rshift 3 // raster width in bytes
let dotsWords = dotsBytes rshift 1 // in words
let pdBytes = pd rshift 3 // nearest byte to unextended window
let pdBytesW0, pdBytesW = 0, (pd rshift 4) lshift 1 // dp byte index to extended window
let pdW = pdBytesW lshift 3 // pd to extended window
let pdDifW = pd-pdW // dots from pdW to pd
let pdBytesDifW = pdBytes-pdBytesW
let pdMaskW = -1 rshift pdDifW // mask to clear dots in pdDifW range (portrait mode)
let ddWordsW = (pdDifW+dd+15) rshift 4 // word width of extended window
let ddBytesW = ddWordsW lshift 1
let ddBytes = (dd+7) rshift 3
let ddW = ddBytesW lshift 3
let ddMaskW = -1 lshift (ddW-dd-pdDifW) // mask to clear dots from dd to ddW (portrait mode)
// Set values based on use of vertical or horizontal dot patterns
let addOp, firstChar, charsPerLine, nLinesm1 = nil, nil, nil, nil
test LandscapeDevice then
[ addOp, firstChar, charsPerLine, nLinesm1 = DoubleAdd, pdDifW, dd+pdDifW, 0 ]
or [ addOp, firstChar, charsPerLine, nLinesm1 =
DoubleSub, pdBytesDifW, ddBytes+pdBytesDifW, 7
// move X left pdDifW Altos, to compensate for pdDifW white bits due to word-alignment
// pdDifW lshift 5 is pdDifW*32, 32 micas/dot
savedCurX!0 = Max(0, savedCurX!0-MulDiv(pdDifW lshift 5, ResolutionB, 25400))
]
in, out = FSGetRelease(ddWordsW*8+2)+1, (LandscapeDevice? FSGetRelease(ddWordsW*8), in)
// dots buffer for portrait device needs "guard words" for MaskEdges routine
Zero(in, ddWordsW*8)
let dyPrinterDots = vec 2; dyPrinterDots!1 = 0
let pos = vec 2;
// ShowDots (cont.) Show the Dots
for group = 0 to groups-1 do
[
let gL = group*8
let linesInGroup = Min(8, dl-groupLines+gL)
let firstWord = in+((8-linesInGroup)*ddWordsW) // usually = in
for i = 0 to linesInGroup-1 do
[
pos!0, pos!1 = 0, dotsBytes*(pl+i)
DoubleAdd(pos, base)
DoubleAdd(pos,lv pdBytesW0)
WindowSetPosition(DL, pos, charItem)
WindowReadBlock(DL, firstWord+i*ddWordsW, ddWordsW)
]
test LandscapeDevice then RowRotate(in-1, out-1, ddWordsW) // See SpruceMl, RowRotateMC
or MaskEdges(out, ddWordsW, pdMaskW, ddMaskW)
for i = nLinesm1 by -1 to 0 do // nLinesm1 = 7 or 0
[
DoubleCop(CurX, savedCurX)
@dyPrinterDots = MulDiv((groupLines-gL+i)*32, ResolutionY, 25400)
DoubleCop(CurY, savedCurY)
addOp(CurY, dyPrinterDots)
// ****** RowRotate does not at present wipe out ShowChars' permanent registers. If it
// ****** needs to, someday, add the following line. See SpruceMc, ShowCharsMc, RowRotateMc
// ****** SetupShowFonts()
ShowCharactersImmediate(out+(nLinesm1-i)*ddWordsW, firstChar, charsPerLine)
]
pl = pl + linesInGroup
]
DoubleCop(CurX, oldCurX)
DoubleCop(CurY, savedCurY)
// ~~ Should check to be sure last line ends DL, else result 780
Resultis(0)
]
and MaskEdges(buf, wPL, leftMask, rightMask) be for i = 0 to 8 do
[
let ptr = lv buf!(wPL*i)
// buf must have one "guard word" preceding word 0 and one following word 8*wPL-1
ptr!(-1) = (ptr!(-1))&rightMask
ptr!0 = (ptr!0)&leftMask
]
// -----------------------------------------------------------
// ShowXY(x, y) ShowX(x) ShowY(y)
// -----------------------------------------------------------
// Coordinate conversions
and ShowXY(x, y) be
[
ShowX(x)
ShowY(y)
]
// ~~ Portrait-Landscape treatments not optimized
and ShowX(x) be test LandscapeDevice then
[
CurS!0=MulDivNR(ResolutionS, x+XOffset, 25400)
CurS!1=0
]
or [
CurB!0=MulDivNR(ResolutionB, x+XOffset, 25400)+(FA lshift 4)
CurB!1 = 0
]
and ShowY(y) be test LandscapeDevice then
[
CurB!0=MulDivNR(ResolutionB, y+YOffset, 25400)+(FA lshift 4)
CurB!1=0
]
or [
// ~~ nVisibleBands lshift (4) is only an approx. to nScanLines
CurS!0=(nVisibleBands lshift LogBANDWidth)-1-
MulDivRU(ResolutionS, y+YOffset, 25400)
CurS!1 = 0
]
// -----------------------------------------------------------
// ShowCharSetSpace(how, arg) ShowOnCopy(copyNo)
// -----------------------------------------------------------
// Routine for handling "set space" commands.
// how=0 Initialize for an entity
// how=1 arg=X space
// how=2 arg=Y space
// how=3 Install values in current font if set space is in effect
// how=4 Remove values from current font if installed in it
and ShowCharSetSpace(how, arg) be
[
let savedSpaces=table [ 0;0;0;0 ]
switchon how into [
case 0: InEffect=false; docase 4;
// In the cases below, reverse scan and bit dimensions if Portrait device, and
// negate Y argument (since scan proceeds in -y)
// Compute 16 times the appropriate width setting:
case 1:unless LandscapeDevice docase 20 // reverse dimensions
case 10: SpaceS=MulDiv(ResolutionS, ((arg < 0)? -arg, arg), 25400/16)
if arg < 0 do SpaceS = -SpaceS
InEffect=true; docase 3;
case 2: unless LandscapeDevice do [ arg = -arg; docase 10]
case 20: SpaceB=MulDiv(ResolutionB, ((arg < 0)? -arg, arg), 25400/16)
if arg < 0 do SpaceB = -SpaceB
InEffect=true; docase 3;
case 3:
[
if InEffect eq false % bc gr #40 % ec ls #40 then return
let p=WidthPointer+#40*(size CharWidth/16)
compileif offset CharWidth.WS ne 0 % offset CharWidth.WB ne 32
then [ foo=nil ]
unless Installed do MoveBlock(savedSpaces, p, 4)
Zero(p, 4)
// ~~ not 100% absolutely sure this works for negative values
p!0=SpaceS rshift 4+(SpaceS<0? #170000, 0); p!1=SpaceS lshift 12
p!2=SpaceB rshift 4+(SpaceB<0? #170000, 0); p!3=SpaceB lshift 12
Installed=true
return
]
case 4:
[
unless Installed return
Installed=false
let p=WidthPointer+#40*(size CharWidth/16)
MoveBlock(p, savedSpaces, 4)
return
]
]
]
and ShowOnCopy(copy) be
[
if onlyOnCopy then for band = 0 to nVisibleBands-1 do
[ // for each band, change proto-branch to branch
let branchCount = CopyTable!band
unless branchCount loop
BandFree>>BEControl.H = 0
BandFree>>BEControl.type = BEBranchH
BandFree>>BEControl.onCopy = onlyOnCopy
BandFree>>BEControl.displacement = branchCount
BandEnter(band, lenBEControl)
]
Zero(CopyTable, nVisibleBands)
onlyOnCopy = copy
]
// --------------------------
// BandEnter(band, len)
// --------------------------
// Must be called to make a new band entry official.
// New band information has been placed in the table beginning at BandFree.
// BandAvail is set to allow it to overflow by one maximum-sized entry
// Insert new entry at the head of this band's list. If only-on-copy is in effect, include this entry
// in the count for this band.
// This routine is actually coded in assembly language
compileif false then [
let BandEnter(band, len) be
[
BandFree!-1 = BandTable!band
BandTable!band = entry
BandFree = BandFree+len+1
BandAvail = BandAvail+len+1
if onlyOnCopy then CopyTable!band = CopyTable!band+len
if BandAvail ge 0 then BandFlush()
]
] // compileif false
compileif false then [ // Now RowRotate in RowRotateMc does it -- interface in SpruceML
let RotateEight(in, out, widthInWords) be
test microRotate then RowRotate(in-1, out-1, widthInWords)
or for wColumn = 0 to widthInWords-1 do
[
let sa = vec 8
let bits = table [ 1; 2; 4; #10; #20; #40; #100; #200 ]
for i = 0 to 7 do sa!i = in!(i*widthInWords)
for pairs = 0 to 7 do
[
let wd, once = 0, 0
[
for i = 0 to 7 do
[
let t = sa!i
if t < 0 then wd = wd + bits!i
sa!i = t lshift 1
]
if once break; once = true; wd = wd lshift 8
] repeat
@out = wd
out = out+1
]
in = in + 1
]
] // compileif false
// DCS, July 27, 1977 10:39 PM, repair duplicate error code problem
// September 15, 1977 11:15 PM, Deal with Portrait mode devices
// September 26, 1977 8:23 AM, handle Only On Copy
// September 27, 1977 3:01 PM, Move BandEnter to ML
// October 3, 1977 6:55 AM, handle three-color break page
// October 3, 1977 7:30 AM, dots
// October 12, 1977 11:39 AM, big page problems (maxBandRecs, etc.)
// October 16, 1977 3:05 PM, add "vertical dot" shapes, clear vbl space settings each doc.
// October 17, 1977 11:54 AM, move XOffset, YOffset from DocG to statics, version 4.(0,0)
// October 17, 1977 9:29 PM, add FN.tallest, widest, v4.(0,0)
// October 18, 1977 9:59 AM, ignore rectangles with zero dimensions,
// fix allocation problem with portrait dots, v4.(0,2)
// October 18, 1977 1:14 PM, dots bug when file is large, v4.(0,2)
// December 16, 1977 11:28 AM, null chars do not cause "not in font" complaint; too
// commonly used as fill character
// January 27, 1978 2:02 PM, allocate left over table below bands
// February 15, 1978 8:51 AM, remove restriction on number of references to one font
// March 6, 1978 7:28 PM, add microcode RotateEight, using microRotate static to enable
// March 11, 1978 1:34 PM, use FSGetRelease to minimize memory crashes
// March 28, 1978 12:48 AM, FSGetRelease really checks for WidthPointer equality
// April 13, 1978 8:47 AM, ShowDots was using proportional "spacing"
// May 9, 1978 10:13 AM, accommodate IXTypeMultiChars
// June 7, 1978 10:22 PM, allow pd, dd to be on arbitrary bit boundaries, disable RotateEight
// June 9, 1978 8:33 AM, finish masking and offsetting operations for Portrait dots
// September 22, 1978 8:47 PM, use SafeAdd to protect against undetected single-precision overflow
// October 3, 1978 4:56 PM, add fast ShowCharacters inner loop (microcode)
// October 4, 1978 11:25 AM, request even alignment for width tables
// October 24, 1978 8:27 AM, use CopyTable approach to "only-on-copy"
// November 10, 1978 2:36 PM, better bad char error message -- font identified by name
// November 24, 1978 1:40 PM, repair bugs in only on copy code
// December 6, 1978 11:56 AM use Capabilities instead of printerDevice to determine pass
// April 25, 1979 2:39 PM change ~~.d names
// if monitoring Dover performance (DebugSystem丠), reduce
// maxPrintPassRecs by measureTable size (see SpruceMeasure, SpruceMeasureMl), by Swinehart
// if xmFonts, don't count actual font load contribution to bank 0 memory
// overflow (font load termination) tests, but do check font load size for bank 1 overflow
// July 31, 1979 10:37 AM, change ~~.d files so dictionary isn't too big
// November 14, 1979 4:04 PM, preserve sign thru MulDiv in ShowCharSetSpace
// February 11, 1980 10:11 AM, double buffer maxBandRecs only for Dover, consolidate FI chain
// (was causing corefragmentation and needless "page too complex" aborts).
// February 5, 1981 5:19 PM, change error 800 to 808 (more informative)
//