// PreFontMake.bcpl -- font load assembly
// last modified by Ramshaw, January 19, 1982 3:48 PM
// - improved previous fix
// last modified by Ramshaw & Williams, January 15, 1982 11:49 AM
// - changed FontMakeUp to read raster file positions straight
// from the PreScratch file one at a time rather than reading
// them into memory all at once if memory is scarce.
// last modified by Butterfield, September 25, 1980 1:21 PM
// - MakeFI, if tridentUsed then PressErrorV(710); - 9/25/80
// stolen from SpruceFontMake and SpruceShow
//
// errors zzz-zzz
//
// 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 "PressParams.df"
get "PressInternals.df"
get "ix.dfs"
get "FontPass.df"
// outgoing procedures
external
[
FontMakeup
MakeFI
]
// outgoing statics
external
[ pFonts//pointer to list of fontLoad structures (FI)
]
static [ pFonts
]
// incoming procedures
external
[
//PRESS
PressError; PressErrorV;
FSGetX
FSGet
FSPut
//WINDOW,FILES
WindowGetPosition
WindowSetPosition
WindowReadBlock
WindowWriteBlock
WindowRead
WindowWrite
WindowNext
WindowInit
WindowClose
//PREBAND
BandRecords
//CURSOR
CursorChar
CursorDigit
//OS
Zero
MoveBlock
//PRESSML
DoubleAdd; DoubleSub; DoubleCop; MulDiv
MulFull;DoubleAddV;DivFull
]
// incoming statics
external
[
BandWindow
PreGodW;PreScratchW
ScratchFile
LeftOverFile1
nFontLoads
ICCtot
Debug
maxBandRecsSoFar
maxPrintPassRecs
maxFontSizeSoFar
ICCUses
nVisibleBands
tridentUsed;
]
// internal statics
static
[ fontLoadList=0
secondPreScratchW
]
// File-wide structure and manifest declarations.
structure FI :
[ nextword
fontLoadword//number of this font load
fontLengthword// number of words for actual font characters
]
// Procedures
let FontMakeup() be
[ CursorChar($F)
let fontBuf = FSGetX(BANDInCoreSize) // Must exist; BandClose just released one
let fontIndex=FSGetX(ICCtot)//For building pointer table
let CDIndex=FSGet(ICCtot*2)//pointers to file pos of characters
let stillSomeSpace=FSGet(1500)
test CDIndex eq 0 % stillSomeSpace eq 0
ifso
[
//core seems tight, we better read file pos’s straight from the
//scratch file
if CDIndex ne 0 then FSPut(CDIndex)
if stillSomeSpace ne 0 then FSPut(stillSomeSpace)
secondPreScratchW=WindowInit(ScratchFile, 1)
CDIndex=0//to remember that we’re working from the file
]
ifnot
[
//core seems freely available
FSPut(stillSomeSpace)
]
let CDPos=vec 1
WindowSetPosition(PreScratchW,table [ 0;4])
WindowReadBlock(PreScratchW,CDPos,2)
WindowSetPosition(PreScratchW,CDPos)
if CDIndex ne 0 then
WindowReadBlock(PreScratchW,CDIndex,ICCtot*2)
//watch out: pFonts has to stay around for Print time
pFonts=FSGetX(nFontLoads*(size FontG/16))
let fi=fontLoadList
while fi ne 0 do
[CursorDigit(fi>>FI.fontLoad)
let q=fi+(size FI/16)//Pointer to ICC bit table
let m=#100000
let rec=WindowNext(BandWindow)
Zero(fontIndex, ICCtot)
WindowWriteBlock(BandWindow, (table [ -1;0;0;0 ]), 4) //Dummy
let fPtr = 0
let charpos=4
for c=0 to ICCtot-1 do
[ if (@q & m) ne 0 then//Char is needed
[fontIndex!c=charpos//Relative pointer
let cp=vec 1
test CDIndex ne 0
ifso MoveBlock(cp, CDIndex+2*c, 2)
ifnot
[
//wasn’t space enough for CDIndex, so will
// read cp from PreScratchW instead
let cpPos=vec 1
MoveBlock(cpPos, CDPos, 2)
DoubleAddV(cpPos, 2*c)
WindowSetPosition(secondPreScratchW, cpPos)
WindowReadBlock(secondPreScratchW, cp, 2)
]
let win=PreScratchW
if cp>>FPOS.File eq FPOSGod then win=PreGodW
if cp>>FPOS.File eq FPOSDNE then PressError(1402)
WindowSetPosition(win, cp)
let nHeight=WindowRead(win)
let Widthm1=WindowRead(win)
compileif DebugSw then
[ if (nHeight > 0) %// (nHeight < tallest) %
(Widthm1 < 0) //%(Widthm1 > widest)
then [ PressError(650);finish]
]
//let siz=OrbitCharSize(-nHeight, Widthm1+1)
let sizV=vec 1
MulFull(-nHeight,Widthm1+1,sizV)
DoubleAddV(sizV,15)
let siz=(DivFull(sizV,16)+2+1)&-2
if (fPtr+siz) > BANDInCoreSize then
[WindowWriteBlock(BandWindow,fontBuf,fPtr)
fPtr = 0
]
fontBuf!fPtr = nHeight
fontBuf!(fPtr+1) = Widthm1
WindowReadBlock(win, fontBuf+fPtr+2,siz-2)
fPtr = fPtr+siz
charpos = charpos+siz
] //end of "if (@q&m) ne 0"
m=m rshift 1
if m eq 0 then [ m=#100000;q=q+1]
] //end of "for c=0 to ICCtot-1"
// Finished writing ICC’s for this font load. Check to see
// if all calculations worked out:
if fPtr then WindowWriteBlock(BandWindow,fontBuf, fPtr)
if charpos ne fi>>FI.fontLength then PressError(690)
WindowWriteBlock(BandWindow, fontIndex, ICCtot)//Index table
let bogus=vec 300;Zero(bogus,300)
WindowWriteBlock(BandWindow,bogus,nVisibleBands)
let recEnd=WindowNext(BandWindow)
let f=fi>>FI.fontLoad*(size FontG/16)+pFonts
f>>FontG.nRecords=recEnd-rec
f>>FontG.bandPos=rec
f>>FontG.fontLength=charpos
fi=fi>>FI.next
] //end of "while fi ne 0"
FSPut(fontBuf)
FSPut(fontIndex)
test CDIndex eq 0
ifso WindowClose(secondPreScratchW)
ifnot FSPut(CDIndex)
]
// -----------------------------------------------------------
// MakeFI()
// -----------------------------------------------------------
// 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 nRecs=maxBandRecsSoFar+BandRecords(maxFontSizeSoFar+ICCtot)
if nRecs gr maxPrintPassRecs then
(tridentUsed? PressErrorV, PressError)(710);
let wds=(ICCtot+15)/16+(size FI/16)
let p=FSGetX(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 oneBits=table [ #100000;#40000;#20000;#10000;#4000;#2000;#1000
#400;#200;#100;#40;#20;#10;4;2;1
]
let q=p+(size FI/16)//Pointer to region for ICC bits
let iccP=ICCUses
[ if iccP-ICCUses ge ICCtot 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=fontLoadList
fontLoadList=p
]