// PreChars.bcpl

// last modified by Butterfield, October 20, 1980 2:42 PM
// - ShowChars, take only as many bits as necessary for high bits
// of position from BEChar.ICC - 10/20
// - ResolutionB, ResolutionS, 1X instead of 10X - 10/13
// - make iccMax external so ScanChars can swap LO chars if UseXM - 9/30
// - ShowChars, keep high bits of bit position in BEChar.ICC - 8/7/80

// errors 900
//
//Functions for dealing with characters during prescan.
//
//ShowChars(n [,char])
//Implements the showchars function, putting characters in
//the band lists. char is optional "immediate" character.
//ShowCharsSet(set)
//Sets current font set.
//ShowCharsFont(font)
//Sets current font number within set.
//ShowCharsSetSpace(dir,val)
//dir is a directive:
//0initialize (beginning of entity)
//1set x value
//2set y value
//3install space in font table (internal use only)
//4remove space from font table (at end of entity)
//ShowCharsInit()
//ShowCharsClose()
//Called at beginning and end of prescan pass.
//PreFSGet(c)
//Like FSGet, but will release font tables if needed to get the core.


get "PressInternals.df"
get "PressParams.df"

// outgoing procedures
external
[
ShowChars
ShowCharsSet
ShowCharsFont
ShowCharsSetSpace
ShowCharsInit
ShowCharsClose
PreFSGet
]

// outgoing statics
external [ iccMax; longLines; ] // used by ScanChars and ScanConvert
static
[
iccMax = 0; // largest possible ICC
longLines = 0; // enables sharing of BEChar.ICC
]

// incoming procedures
external
[
//PRESCAN
CoordsUpdate
CoordsConvert
CoordsBound

//PREOBJECTS
ShowObject//for spline defined characters

//PARTS
CheckAvailinPart

//PREBAND
BandWrite

//WINDOWS
WindowGetPosition
WindowSetPosition
WindowReadBlock
WindowReadByte

//PRESS
PressErrorV
PressError
FSGet
FSGetX
FSPut

//PRESSML
DoubleAdd
DoubleAddV
MulFull;DivFull

//FLOAT
FLDI;FDV;FLDDP;FMP;FTR

//OS
MoveBlock; SetBlock; Zero
]

// incoming statics
external
[
DL//Window on DL
CoordsInvalid//True if next 2 not right:
ResolutionB;ResolutionS
nScanLines
FA
CurSCoord//DP value of S
CurBCoord//DP value of B
CurSMin//Current bounding boxes
CurSMax
CurBMin
CurBMax
BandFree//Pointer where to write
portrait

PreScratchW//Window on scratch file
PreGodW//Window on God file

Report
DPzero
PSStats//Pre scan statistics

//Spruce-like font load stuff
ICCUses
FontSizePageNew
FontSizePageOld
SimplePage//must invalidate this if spline chars
]

// internal statics
static
[
mpFontWTCB//Gets WTCB for a font #
CurFontBc//bc for current font
CurFontEc//ec for current font
CurICCOffset//ICC offset for current font
CurFontW//Pointer to font widths for current font
FontAge//Current age count
SpaceTable//Pointer to ST for "set space" ops.
CurFont//Font # last specified in press file
FontInvalid//Font tables not updated
]

// File-wide structure and manifest declarations.

structure FS ://Font state information
[
mapword 16//mpFontWTCB
WDDPosword 2//File pos in scratch of W directory
AllWTCBIn word//True if all WTCB’s in core
CurSetword//Current font set.
]

structure WTCB ://Width table control block
[//First part identical to format of
@FDES// widths file

CoreAdrword//Address of width table (0=not in core)
Ageword//Age (0= WTCB available)
]

structure ST ://Space table (for "set space" ops)
[
InEffect word//True if "set space" in effect
FSword 2//"Font" S width
FBword 2//"Font" B width
USword 2//"User" S width
UBword 2//"User" B width
XMword //X in micas
YMword//Y in micas
]

manifest [
mpFlen=(size FS/16)+nWTCBSlots*(size WTCB/16)
]


// Procedures

let ShowCharsInit() be
[
SpaceTable=FSGetX(size ST/16)
SpaceTable>>ST.InEffect=false//Init "set space" table
FontAge=0
let a=FSGetX(mpFlen)//Get core for font map & WTCB’s
Zero(a,mpFlen)//Make all WTCB’s "avail"
mpFontWTCB=a
a>>FS.AllWTCBIn=false//This may change below
a>>FS.CurSet=-1//Will not compare with legal set.
WindowSetPosition(PreScratchW, table [ 0;2] )
WindowReadBlock(PreScratchW,lv a>>FS.WDDPos,2) //Read position
WindowSetPosition(PreScratchW,lv a>>FS.WDDPos)
let p=a+(size FS/16)//Prepare to init WTCB’s

for i=1 to nWTCBSlots do
[
WindowReadBlock(PreScratchW,p,size FDES/16)//Read in entry
if p>>WTCB.WTPos.File ne FPOSDNE &//If not an indirect
p>>WTCB.ICCPos.File ne FPOSDNE then PressError(900) //Complain if ICC table
p>>WTCB.Age=1
if p>>WTCB.set eq 64 then
[
a>>FS.AllWTCBIn=true
break
]
p=p+(size WTCB/16)
]
]

and ShowCharsClose() be
[
FSPut(SpaceTable)
let p=mpFontWTCB+(size FS/16)
for i=1 to nWTCBSlots do
[
let c=p>>WTCB.CoreAdr
if c then FSPut(c)
p=p+(size WTCB/16)
]
FSPut(mpFontWTCB)
]

//ShowChars -- main routine for putting characters in bands
// This routine might want to be coded open for speed (e.g., call
// on CoordsBound), but is not for now!
//

and ShowChars(n,ch; numargs args) be
[ if FontInvalid then//Font changed since last char
[ ShowCharsFontReal(CurFont)//Update CurFontxx entries
FontInvalid=false
]
if CurFontW eq 0 then return//Illegal font or set; complaint already given
if CoordsInvalid then CoordsUpdate()//Coordinates changed since last time
if args eq 1 then CheckAvailinPart(DL,0,n)//Make sure n bytes avail

for i=1 to n do//Main character loop
[ if args eq 1 then ch=WindowReadByte(DL)
test ch ge CurFontBc & ch le CurFontEc then
[
compileif (size CharWidthp/16) ne 8 then [ foo=0 ]
let p=(ch lshift 3)+CurFontW//Pointer to entry

test p>>CharWidthp.DB ls 0 then
[ unless p>>CharWidthp.DB eq DBSplineCode then
[ PressErrorV(901, ch); loop ]
SimplePage=false
WindowSetPosition(PreScratchW,lv p>>CharWidthp.OS)
//CurSCoord, CurBCoord are in dots, convert them to micas
let resx,resy=nil,nil
let coordx,coordy=vec 1,vec 1
test portrait then //invert funny CoordsConvert function
[ MoveBlock(coordy,CurSCoord,2);coordy!0=(nScanLines-1)-coordy!0
MoveBlock(coordx,CurBCoord,2);coordx!0=coordx!0-(FA*16)
resx=ResolutionB;resy=ResolutionS
]
or
[ resx=ResolutionS;resy=ResolutionB;coordx=CurSCoord
MoveBlock(coordy,CurBCoord,2);coordy!0=coordy!0-(FA*16)
]
FLDI(0, 2540); FLDI(1, resx); FDV(0, 1);
FLDDP(2,coordx);FMP(2,0)
FLDI(0, 2540); FLDI(1, resy); FDV(0, 1);
FLDDP(3,coordy);FMP(3,0)
ShowObject(p>>CharWidthp.DS,FTR(2),FTR(3))
]
or if p>>CharWidthp.DB ne 0 then
[Visible
let s=CurSCoord!0+p>>CharWidthp.OS//Min S val of char box
let b=CurBCoord!0+p>>CharWidthp.OB//Min b val of char box

//Update page bounding box. If any part of the character would lie
// off the page, ignore it.
unless CoordsBound(s,s+p>>CharWidthp.DS-1,b,b+p>>CharWidthp.DB-1)
then [ PressErrorV(904, ch); loop ]

//Make up band entry for the character
let icc=ch+CurICCOffset
BandFree>>BEChar.Cbit=1
BandFree>>BEChar.Bit=b
BandFree>>BEChar.ICC=icc
if (b & #170000) ne 0 then
[
let maxTable = table [ 16383; 8191; 8191; 4095; 4095; 4095; 4095;
2047; 2047; 2047; 2047; 2047; 2047; 2047; 2047; ]
let max = maxTable!(b rshift 12 - 1); // used as a mask too!
if longLines eq 0 % longLines gr max then longLines = max;
if iccMax gr longLines then PressError(905);
let reverseTable = table [ 8;4;12;2;10;6;14;1;9;5;13;3;11;7;15; ]
BandFree>>BEChar.ICC = icc +
reverseTable!(b rshift 12 - 1) lshift 11;
]
BandFree>>BEChar.Sr=s//Will save only low 4 bits
BandWrite(s,size BEChar/16)//Go write it.
//Given that we used the character, must perhaps augment sizes
if ICCUses!icc ge 0 then
[ let a=ICCUses!icc
//let siz=OrbitCharSize(p>>CharWidthp.DS,p>>CharWidthp.DB)
let sizV=vec 1
MulFull(p>>CharWidthp.DS,p>>CharWidthp.DB,sizV)
DoubleAddV(sizV,15)
let siz=(DivFull(sizV,16)+2+1)&-2
test a eq 0 then FontSizePageNew=FontSizePageNew+siz
or FontSizePageOld=FontSizePageOld+siz
ICCUses!icc=a-2
]Visible

//And bump widths for next time.
DoubleAdd(CurSCoord,lv p>>CharWidthp.WS)
DoubleAdd(CurBCoord,lv p>>CharWidthp.WB)
] or PressErrorV(901, ch)
]
compileif ReportSw then [ DoubleAddV(lv Report>>REP.nChars, n)]
compileif MeterSw then
[ PSStats>>PSStat.CharCount=PSStats>>PSStat.CharCount+n
]
]

//ShowCharsSet(set)
// Called to set the font-set at the beginning of an entity. The basic
// idea of this routine is to scan the WTCB’s for all fonts in the set
// that have tables in core, and build mpFontWTCB accordingly. This
// reduces the time required by ShowCharsFontReal.

and ShowCharsSet(set) be
[
if set eq mpFontWTCB>>FS.CurSet then return//Set up already
mpFontWTCB>>FS.CurSet=set
Zero(mpFontWTCB,16)//Zero the font map
let p=mpFontWTCB+(size FS/16)
for i=1 to nWTCBSlots do
[
if p>>WTCB.Age ne 0 & p>>WTCB.set eq set then
[//This set, so fill it in.
let f=p>>WTCB.font
test p>>WTCB.WTPos.File ne FPOSDNE
then mpFontWTCB!f=p or
[
let q=mpFontWTCB+(size FS/16)
for i=1 to nWTCBSlots do
[
if q>>WTCB.Age ne 0 & q>>WTCB.set eq p>>WTCB.AuxSet &
q>>WTCB.font eq p>>WTCB.AuxFont then
[
mpFontWTCB!f=q
break
]
q=q+(size WTCB/16)
]
]
]
p=p+(size WTCB/16)
]
]

//ShowCharsFont
// Called when font changes in press file. The new font is only saved,
// however, since it may not be the real one (chief example is the
// default font at the beginning of the entity=0). Real work is done
// by ShowCharsFontReal, below

and ShowCharsFont(font) be
[
CurFont=font
FontInvalid=true//Will be caught by ShowChars
]

//ShowCharsFontReal
// This routine updates the CurFontxx entries from information in
// core. If width table for required font is not in core, "fault".
// One of the complexities of this routine is that if a "set space"
// is in effect, the spaces must be removed from the current font,
// and installed in the new font.

and ShowCharsFontReal(font) be
[//Come here to set up current font
if font ls 0 % font gr 15 then [ FontErr(font); return ]
let sp=SpaceTable>>ST.InEffect
if sp then ShowCharsSetSpace(4)//Remove them!
let a=mpFontWTCB!font//Get WTCB for this font
let c=a>>WTCB.CoreAdr//And core address of widths
if a eq 0 % c eq 0 then
[
FontFault(font)//Go get it.
a=mpFontWTCB!font
c=a>>WTCB.CoreAdr
]
test a eq 0 then
[
FontErr(font)
]
or
[
FontAge=FontAge+1//Mark that we have used it.
a>>WTCB.Age=FontAge
CurFontBc=a>>WTCB.bc//Smallest legal char code
CurFontEc=a>>WTCB.ec//Largest legal char code
CurICCOffset=a>>WTCB.ICCBase-CurFontBc
let fontIccMax = CurICCOffset + CurFontEc - CurFontBc;
if fontIccMax gr iccMax then iccMax = fontIccMax;
if longLines & iccMax gr longLines then PressError(905);
CurFontW=c-CurFontBc*(size CharWidthp/16)
if sp then ShowCharsSetSpace(3)//Install space again
]
]

and FontErr(font) be
[
CurFontW=0//Illegal font or set
PressErrorV(903, mpFontWTCB>>FS.CurSet, font)
]
//FontFault
// Called by ShowCharsFontReal when the font table needed is not
// in core or when the WTCB for the font needed is not available.

and FontFault(font) be
[
let a=mpFontWTCB
let b=a!font//Current WTCB
if b eq 0 then//No WTCB for it!
[
b=FontReadWTCB(a>>FS.CurSet, font)
if b eq 0 then return//Illegal font!!
if b>>WTCB.WTPos.File eq FPOSDNE then
[
b=FontReadWTCB(b>>WTCB.AuxSet,b>>WTCB.AuxFont)
]
a!font=b
]
let nc=b>>WTCB.ec-b>>WTCB.bc+1
let WTlen=nc*(size CharWidthp/16)
let WT=PreFSGet(WTlen)//Go get core, releasing if needed
let win=PreScratchW//Decide where to read from
if b>>WTCB.WTPos.File eq FPOSGod then win=PreGodW
WindowSetPosition(win,lv b>>WTCB.WTPos)
WindowReadBlock(win,WT,WTlen)
b>>WTCB.CoreAdr=WT//Install it!
]

//FontReadWTCB
// Called from FontFault to read in a WTCB for a desired set and font.
// Gets a free WTCB from those available. Returns pointer to WTCB.

and FontReadWTCB(set,font) = valof
[
let a=mpFontWTCB
if a>>FS.AllWTCBIn then resultis 0//Illegal font if no WTCB!!
let q=FontGetWTCB(false)//Go get a free block.
WindowSetPosition(PreScratchW,lv a>>FS.WDDPos)
[
WindowReadBlock(PreScratchW,q,size FDES/16)//Read a block
if q>>WTCB.set eq set & q>>WTCB.font eq font then break
if q>>WTCB.set eq 64 then resultis 0//Not found.
] repeat
q>>WTCB.Age=FontAge
resultis q
]

//FontGetWTCB
// Called to find a free WTCB entry. In so doing, it may have to "toss
// out" an old one (Age entries determine this). If "freemorecore" is true,
// the routine simply tries to find the oldest WTCB that still has core
// attached, and releases the core (it does NOT invalidate the WTCB).

and FontGetWTCB(freemorecore) = valof
[
let a=mpFontWTCB+(size FS/16)
let best=a
for i=1 to nWTCBSlots do
[
let better=(a>>WTCB.Age ls best>>WTCB.Age)
test freemorecore then
[
if a>>WTCB.CoreAdr ne 0 & (better ne 0 % best>>WTCB.CoreAdr eq 0)
then best=a
]
or if better then best=a
a=a+(size WTCB/16)
]
let c=best>>WTCB.CoreAdr
if c ne 0 then FSPut(c)
best>>WTCB.CoreAdr=0
unless freemorecore then
[//Invalidate WTCB, any pointers
best>>WTCB.Age=0
for i=0 to 15 do
if mpFontWTCB!i eq best then mpFontWTCB!i=0
]
resultis best
]

//PreFSGet
// Gets core, like FSGet, but will release font tables if necessary in
// order to satisfy the request.

and PreFSGet(c) = valof
[
for i=1 to 100 do
[
let b=FSGet(c)
if b then resultis b
FontGetWTCB(true)//Release some font tables
]
PressError(902)
]

//ShowCharsSetSpace
// Called to operate on the width of the "space" character for the
// "set space x" etc. commands. Dir is:
//0Initialize (set values to 0)
//1Set x
//2Set y
//3Install values in current font table if possible
//4Remove values from current font table.
// The entry "InEffect" is true whenever the "set space" spacings
// are thought to be in effect.

and ShowCharsSetSpace(dir,val) be
[
//Note: following code depends upon ST and CharWidthp having B and S
// entries in the corresponding order:
compileif offset CharWidthp.WB - offset CharWidthp.WS ne 32 then [ foo=0 ]
compileif offset ST.FB - offset ST.FS ne 32 then [ foo=0 ]

let s=SpaceTable
let p=CurFontW+#40*(size CharWidthp/16)
let spacelegal=(CurFontBc le #40) & (#40 le CurFontEc)
test dir eq 0 then
[
s>>ST.InEffect=false
compileif size ST - offset ST.US ls 6*16 then [ foo=0 ]
Zero(lv s>>ST.US,6)//Depends on order of things.
] or
test dir eq 4 then
[
if s>>ST.InEffect & spacelegal then
MoveBlock(lv p>>CharWidthp.WS,lv s>>ST.FS,4)
s>>ST.InEffect = false
] or
[
if dir eq 1 then s>>ST.XM=val
if dir eq 2 then s>>ST.YM=val
if dir ne 3 then CoordsConvert(s>>ST.XM,s>>ST.YM,lv s>>ST.US,lv s>>ST.UB,false)
unless s>>ST.InEffect then
MoveBlock(lv s>>ST.FS,lv p>>CharWidthp.WS,4)
if spacelegal then
MoveBlock(lv p>>CharWidthp.WS,lv s>>ST.US,4)//Install
s>>ST.InEffect=true
]
]