// D I R (Press and font file directory processing)
// errors 600
//
//

get "Spruce.d"
get "SpruceFiles.d"
get "PressFile.d"
get "Streams.d"

// outgoing procedures
external
[
OpenUp
OpenForFonts
CloseDown
PressDirectories
FEEnter
FEEnterLiteral
FontPass
UseEntry// finds font set, font value corresponding to index
]

// incoming procedures
external
[
//SPRUCE
SpruceError
SpruceCondition
DblShift
FSGetX
FSPut

//PARTS
SetPartBounds
GetPositioninPart
SetPositioninPart
SetBytePositioninPart
SkipinPart

//WINDOW,FILES
GetSprucePage
PutSprucePage
WindowCreateStream
WindowClose
WindowGetPosition
WindowSetPosition
WindowReadBlock
WindowWriteBlock
WindowRead
WindowWrite
WindowFlush
FileLeng
InitSpruceFile
ResetSpruceFile

//CURSOR
CursorChar
CursorDigit

//OS
Zero
MoveBlock

//SPRUCEML
DoubleAdd; DoubleSub; DoubleCop; MulDiv
MulFull

DisableComments
FillInNames
Ugt
]

// incoming statics
external
[
Capabilities
ResolutionS; ResolutionB
FontFile; BandFile
FontWindow; BandWindow
DPzero
LogoFont
breakPage
LandscapeDevice
SpruceZone
]

// internal statics
static
[
bestBreakFont
]

// File-wide structure and manifest declarations.

// Definitions for reading font files (see FontFormats)

structure IXH :
[
Typebit 4
Lengthbit 12
]

structure IXN :
[
@IXH
Codeword
Nameword 10
]

structure IX :
[
@IXH//Header, type = IXTypeChars or IXTypeOrbitChars
fambyte//Family number
facebyte//Face code
bcbyte//First char number
ecbyte// and last
sizword// Size in microns
rotation word// Rotation in minutes
saword 2// Starting position in file
lenword 2// and length
resolutionxword// 10* number of bits/inch
resolutionyword
]

structure IXM :
[
@IXH//Header, type = IXTypeMultiChars
fambyte//Family number
facebyte//Face code
bcbyte//First char number
ecbyte// and last
sizword// Size in microns
rotation word// Rotation in minutes
resolutionxword// 10* number of bits/inch
resolutionyword
numSegs word// number of character width segments (1st contains rasters)
segs↑1,4: [// Max 4
sa word 2// starting position in file
len word 2// and length
date word 2 =// date after which these widths are no longer valid
[ date0 word; date1 word ]
]
]

manifest [
//IXH types
IXTypeEnd=0
IXTypeName=1
IXTypeChars=3
IXTypeOrbitChars = 5
IXTypeMultiChars = 6

//length to allocate
IXLMax= (size IXM)/16

HI1174 = #104517 rshift 1 // 104517,,65200 is January 1, 1974 (for range test)
HI123189 = #123546 rshift 1 // 123546,,113400 is December 31, 1989
]

manifest [ // Buffer strategy values for files managed here
nbfPressFile = 10 // ~~ M31 only, for now!! nbf... is "number of buffers for ..."
ncbPressFile = 8 // ncb... is "number of cbs for ..."
nahEL = -3 // nah... is "number of pages to stay ahead for ..."
nahDL = 5

nbfFontFile = 6
ncbFontFile = 5
nahFontWindow = 5

nbfBandFile = 10
ncbBandFile = 5
nahBandWindow = 4 // output ahead value
]

// Procedures

let OpenUp(pDoc) be
[
let PressFile=pDoc>>DocG.PressFile
Zero(lv pDoc>>DocG.nFontLoads,lenDocG-(offset DocG.nFontLoads/16))
InitSpruceFile(PressFile, nbfPressFile, ncbPressFile)
pDoc>>DocG.EL=WindowCreateStream(PressFile, ksTypeReadOnly, wordItem, nahEL)
pDoc>>DocG.DL=WindowCreateStream(PressFile, ksTypeReadOnly, wordItem, nahDL)
InitSpruceFile(FontFile, nbfFontFile, ncbFontFile)
FontWindow=WindowCreateStream(FontFile, ksTypeReadOnly, wordItem, nahFontWindow)
InitSpruceFile(BandFile, nbfBandFile, ncbBandFile)
PutSprucePage(BandFile, GetSprucePage(BandFile, 1, nbfBandFile, false))
BandWindow=WindowCreateStream(BandFile, ksTypeWriteBeforeRead, wordItem, nahBandWindow)
]

and OpenForFonts(pDoc) be
[
let PressFile = pDoc>>DocG.PressFile
WindowClose(pDoc>>DocG.EL)
WindowClose(pDoc>>DocG.DL)
]

and CloseDown(pDoc) be
[
DisableComments()
WindowClose(FontWindow)
ResetSpruceFile(FontFile)
WindowClose(BandWindow)
ResetSpruceFile(BandFile)
ResetSpruceFile(pDoc>>DocG.PressFile)
]

and PressDirectories(pDoc) be
[
CursorChar($D)

// D O C U M E N T DIRECTORY

CursorDigit(0)
let PressFile=pDoc>>DocG.PressFile
let fileCode = PressFile>>SPruceFile.fileCode
let EL=pDoc>>DocG.EL

let DocDir = nil
// Fill in creator, file name, date -- set up DocDir
let code = FillInNames(EL, pDoc, 0, lv DocDir)
if code then
[
let host = pDoc>>DocG.FileHost
SpruceCondition(code, ECFileTerminate, fileCode, host rshift 8, hostŹ)
]
let PressLength = vec 1
FileLeng(PressFile, PressLength, wordItem)
DoubleSub(PressLength, table [ 0;PressRecordSize ])
DblShift(PressLength, LogPressRecordSize)
if PressLength!0 then SpruceCondition(601, ECFileTerminate, fileCode)
let nPressRecs=PressLength!1+1
unless DocDir>>DDV.nRecs eq nPressRecs then SpruceCondition(603, ECFileTerminate, fileCode)
let nParts=DocDir>>DDV.nParts
unless nParts*(size PE/16) le
DocDir>>DDV.pdRecs*PressRecordSize then
SpruceCondition(604, ECFileTerminate, fileCode)

let firstCopy=DocDir>>DDV.fCopy
let lastCopy=DocDir>>DDV.lCopy

// P A R T DIRECTORY

CursorDigit()
//Find the font part and count "pages" in the document.
SetPartBounds(EL, DocDir>>DDV.pdStart, DocDir>>DDV.pdRecs)
SetPositioninPart(EL, DPzero)//Start reading parts here
WindowGetPosition(EL, lv pDoc>>DocG.partStart)//For later reference

let FontPart=vec size PE/16//To hold font part goodies
let fontfound=false
let nPages=0
let thisPage=0
for i=1 to nParts do
[
let Part=vec size PE/16
WindowReadBlock(EL, Part, size PE/16)
if Part>>PE.Type eq PETypeFont then//Font part
[
MoveBlock(FontPart, Part, size PE/16)
fontfound=true
]
if Part>>PE.Type eq PETypePage then//Page part (ignore other parts)
[
thisPage=thisPage+1
if thisPage ge pDoc>>DocG.UserPageStart &
thisPage le pDoc>>DocG.UserPageEnd then
nPages=nPages+1
]
]
unless fontfound then SpruceCondition(605, ECFileTerminate, fileCode)

if pDoc>>DocG.nCopies eq 0 then
pDoc>>DocG.nCopies=lastCopy-firstCopy+1
if (pDoc>>DocG.nCopies < 0) % ( pDoc>>DocG.nCopies >1000) then SpruceCondition(607, ECFileTerminate, fileCode)
if pDoc>>DocG.duplex do
[
let nSheets = nPages/2
test nSheets > 300 then [ pDoc>>DocG.duplex = false; SpruceCondition(625, ECWarning) ]
or if nSheets*(pDoc>>DocG.nCopies) >300 do [ SpruceCondition(626, ECWarning); pDoc>>DocG.nCopies = 300/nSheets ]
]
if breakPage then nPages=nPages+((Capabilities&mPimFiles) eq 0? 1, (Capabilities & mBlackHousing) eq 0? 3,4 )
pDoc>>DocG.nPages=nPages
pDoc>>DocG.nFontLoads=0
pDoc>>DocG.nParts=nParts

compileif ReportSw then
[
Report>>REP.nPages=nPages
Report>>REP.nCopies=lastCopy-firstCopy+1
]

FSPut(DocDir)//No need for this any more

// F O N T DIRECTORY

CursorDigit()
SetPartBounds(EL, FontPart>>PE.pStart, FontPart>>PE.pRecs)
SetPositioninPart(EL, DPzero)

// Go through directory, entering fonts in the fontList (FN’s)
// that are requested in the Press file.
bestBreakFont=0
let v=vec FElen
[fe
let len=WindowRead(EL)
if len ne FElen then
[//Cannot process these font entries
if len eq 0 then break
SpruceCondition(609, ECWarning)
for i=2 to FElen do WindowRead(EL)
loop
]
v!0=len
WindowReadBlock(EL, v+1, len-1)
let bad=false
if v>>FE.source ne v>>FE.destm then bad=true
if v>>FE.set gr 63 % v>>FE.fno gr 15 then bad=true
test bad then
[
SpruceCondition(606, ECFileTerminate, fileCode)
loop
] or FEEnter(pDoc, v)
]fe repeat
test bestBreakFont eq 0 then
FEEnterLiteral(pDoc, "Helvetica", 12, 0, 64, 0)
or FEEnterLiteral(pDoc, lv bestBreakFont>>FN.name,
-bestBreakFont>>FN.siz, bestBreakFont>>FN.face, 64, 0)
FEEnter(pDoc, LogoFont)
// Alto Resolution Dots
// ~~ expensive if not needed -- is there a way to wait?
// ~~ Landscape mode only, for now -- size -32 for Portrait
FEEnterLiteral(pDoc, "Dots", (LandscapeDevice? -256, -32), 0, 64, 2)

// F O N T B O O K scan
CursorDigit()
FontPass(pDoc)
]

//Routines for placing entries in fontList (FN’s) from Press
// file font entries.

and FEEnter(pDoc, fe) be
[
test fe>>FE.siz gr 0 then fe>>FE.siz=MulDiv(fe>>FE.siz, 635, 18) // *2540/72
or fe>>FE.siz=-fe>>FE.siz
unless LandscapeDevice do fe>>FE.rotn = fe>>FE.rotn + 90*60 // rotate 90

let p=pDoc>>DocG.fontList
let found=false
while p ne 0 do
[
let dif=fe>>FE.siz-p>>FN.siz
if dif ge -2 & dif le 2 &
StrEq(lv fe>>FE.fam, lv p>>FN.name) &
fe>>FE.rotn eq p>>FN.rotation &
fe>>FE.face eq p>>FN.face then
[//Found it!
found=true; break
]
p=p>>FN.next
]

//If we get here, it is necessary to insert a band (sic) new entry
unless found then
[
p=FSGetX(size FN/16, SpruceZone, 0)
p>>FN.next=pDoc>>DocG.fontList; pDoc>>DocG.fontList=p
p>>FN.face=fe>>FE.face
p>>FN.siz=fe>>FE.siz
p>>FN.rotation=fe>>FE.rotn
compileif size FE.fam/16 ne 10 % size FN.name/16 ne 10 then [ foo=nil ]
MoveBlock(lv p>>FN.name, lv fe>>FE.fam, 10)
if DefaultFontName(lv p>>FN.name) &
p>>FN.siz gr 350 & p>>FN.siz ls 500 &
(bestBreakFont eq 0 % p>>FN.siz gr bestBreakFont>>FN.siz)
then bestBreakFont=p
]

let u=p>>FN.pressUses+1
p>>FN.pressUses=u
let use = UseEntry(p, u)
use>>FNUse.uSet=fe>>FE.set
use>>FNUse.uFont=fe>>FE.fno
]

// Enter a font literally from name and size. This is necessary
// to get break-page fonts (fontset 64).

and FEEnterLiteral(pDoc, nam, siz, face, set, font) be
[
let fe=vec size FE/16
fe>>FE.set=set; fe>>FE.fno=font
MoveBlock(lv fe>>FE.fam, nam, size FE.fam/16)
fe>>FE.face=face
fe>>FE.siz=siz
fe>>FE.rotn=0
FEEnter(pDoc, fe)
]

and UseEntry(fn, index) = valof
[
// index assumed positive
// yields pointer to index’th set/font pair, generating new blocks if necessary
index = index - 1
let curUse = lv fn>>FN.useList
for i = 0 to index rshift lnMaxPressUses do // always happens at least once
[
let nextUse = @curUse
unless nextUse do
[
nextUse = FSGetX(size USeBlock/16)
nextUse!0 = 0
@curUse = nextUse
]
curUse = nextUse
]
resultis lv curUse>>USeBlock.fnUse↑((index&maskMaxPressUses)+1)
]

// Recognize a default font name

and DefaultFontName(n) = StrEq(n, "Helvetica")%StrEq(n, "TimesRoman")

// Compare two strings, ignoring case

and StrEq(a, b) = valof
[
if a>>STR.length ne b>>STR.length then resultis false
for i=1 to a>>STR.length do
if ((a>>STR.char↑i xor b>>STR.char↑i) &(not #40)) ne 0 then resultis false
resultis true
]

// F O N T pass: scan the font directory, looking for things.

and FontPass(pDoc) be
[
//First, look up all entires in the font file
AssignFromFontFile(pDoc)

//Now, sort fontList by ascending address in the font file
// This is intended to cut down on file thrashing.
let changes=nil
[
changes=false
let prev=(lv pDoc>>DocG.fontList)-offset FN.next
[
let p=prev>>FN.next
let n=p>>FN.next
if p eq 0 % n eq 0 then break
let a=vec 2
DoubleCop(a, lv n>>FN.sa)
DoubleSub(a, lv p>>FN.sa)
if a!0 ls 0 then
[//Exchange p,n
p>>FN.next=n>>FN.next
n>>FN.next=p
prev>>FN.next=n
p=n
changes=true
]
if a!0 eq 0 & a!1 eq 0 then
[//Assigned to same font in font file: merge
for i=1 to n>>FN.pressUses do
[
let c=p>>FN.pressUses+1
p>>FN.pressUses=c
let uP, uN = UseEntry(p, c), UseEntry(n, i)
uP>>FNUse.uSet=uN>>FNUse.uSet
uP>>FNUse.uFont=uN>>FNUse.uFont
]
p>>FN.next=n>>FN.next//Remove from list
let u = n>>FN.useList
while u do [ let nextU = @u; FSPut(u); u = nextU ]
FSPut(n)
p=prev//Look again
]
prev=p
] repeat
] repeatuntil changes eq false

//Assign ICC’s for all fonts
let ICCbase=0
let p=pDoc>>DocG.fontList
while p ne 0 do
[
p>>FN.ICCOffset=ICCbase
ICCbase=ICCbase+p>>FN.ec-p>>FN.bc+1
p=p>>FN.next
]
pDoc>>DocG.ICCtotal=ICCbase
]

and AssignFromFontFile(pDoc) be
[
WindowSetPosition(FontWindow, DPzero)
let v=vec IXLMax
// range check for Press file date -- if not between 1974 and 1989, set to 1-1-01
let hiDate = pDoc>>DocG.date0 rshift 1 // approx. days since 1901
unless HI1174 le hiDate & hiDate le HI123189 do Zero(lv pDoc>>DocG.date, 2)
hiDate = pDoc>>DocG.date0
let familyNames = FSGetX(100, SpruceZone, 0)
let warningIssued = false

[re
v!0=WindowRead(FontWindow)
WindowReadBlock(FontWindow, v+1, v>>IXH.Length-1)
let typ=v>>IXH.Type
switchon typ into
[
case IXTypeEnd: break
case IXTypeName:
[
let code = v>>IXN.Code
let p=pDoc>>DocG.fontList
while p ne 0 do
[
if StrEq(lv p>>FN.name, lv v>>IXN.Name) %
(p>>FN.match eq 0 & DefaultFontName(lv v>>IXN.Name)) then
[
p>>FN.match=1
p>>FN.fam=v>>IXN.Code
]
p=p>>FN.next
]
if code > 99 endcase
let n = FSGetX(10)
MoveBlock(n, lv v>>IXN.Name, 10)
familyNames!code = n
endcase
]
case IXTypeChars:
//unless warningIssued do SpruceCondition(620, ECWarning)
//warningIssued = true
case IXTypeOrbitChars:
case IXTypeMultiChars:
[
let p=pDoc>>DocG.fontList
while p ne 0 do
[0
let m=Match(v, p)
if m ge p>>FN.match then
[1
p>>FN.match=m
p>>FN.bc=v>>IX.bc; p>>FN.ec=v>>IX.ec
p>>FN.newFam = v>>IX.fam
p>>FN.newFace = v>>IX.face
p>>FN.newSize = v>>IX.siz
p>>FN.newRot = v>>IX.rotation
DoubleCop(lv p>>FN.sa, lv v>>IX.sa)
DoubleCop(lv p>>FN.widthSa, lv v>>IX.sa)
if typ eq IXTypeMultiChars then // sa, widthSa settings are more complicated
[2
DoubleCop(lv p>>FN.sa, lv v>>IXM.segs↑1.sa) // rasters from first entry
warningIssued = false // use this as "found" flag
// date in font file is expiration date. As of that instant the entry has expired
for i = v>>IXM.numSegs to 1 by -1 do
[3
let hiExpDate = v>>IXM.segs↑i.date0
if Ugt(hiExpDate, hiDate) %
hiExpDate eq hiDate & Ugt(v>>IXM.segs↑i.date1, pDoc>>DocG.date1) then
[4
warningIssued = true
DoubleCop(lv p>>FN.widthSa, lv v>>IXM.segs↑i.sa)
break
]4
]3
unless warningIssued do SpruceError(630) // We’re in terrible shape
]2
]1
p=p>>FN.next
]0
]re repeat
let p = pDoc>>DocG.fontList
while p do
[
let subst = (p>>FN.pressUses > 1 % p>>FN.pressUses eq 1 &
(p>>FN.useList)>>USeBlock.fnUse↑1.uSet ne 64) & p>>FN.match < 1000-2
if subst then [ subst = FSGetX(size FN/16); MoveBlock(subst, p, size FN/16) ]
let newFam = p>>FN.newFam
if p>>FN.fam ne newFam then MoveBlock(lv p>>FN.name, familyNames!newFam, 10)
p>>FN.fam = newFam; p>>FN.face = p>>FN.newFace
p>>FN.siz = p>>FN.newSize; p>>FN.rotation = p>>FN.newRot
if subst then [ SpruceCondition(640,ECWarning, p, subst); FSPut(subst) ]
p = p>>FN.next
]
for i = 0 to 99 do if familyNames!i then FSPut(familyNames!i); FSPut(familyNames)
]

// Note distance function of size*resolution -- this allows rough
// matches from all sorts of font sets!

and Match(ix, fn) = valof
[
// Compute "point size" of char in scan-lines.
// Maximum difference contribution = 100
let rx = ix - (ix>>IXH.Type eq IXTypeMultiChars? (offset IX.resolutionx-offset IXM.resolutionx)/16, 0)
let fontSiz=MulDiv(rx>>IX.resolutionx, ix>>IX.siz, 25400)
let reqSiz=MulDiv(ResolutionS, fn>>FN.siz, 25400)
let dif=(fontSiz-reqSiz)
if dif ls 0 then dif=-dif
if dif gr 100 then dif=100

// Rotation: contribution = 400
if ix>>IX.rotation ne fn>>FN.rotation then dif=dif+400
// Face: contribution = 200
if ix>>IX.face ne fn>>FN.face then dif=dif+200
// Family: contribution = 200
if ix>>IX.fam ne fn>>FN.fam then dif=dif+200
resultis 1000-dif
]

// DCS, July 27, 1977 10:04 PM, derived (loosely) from "Press" version
//(only minor file open/close changes)
// August 1, 1977 10:54 PM, use file name from Press file if it exists.
// August 4, 1977 9:45 PM, adjust # BandFile buffers to nMaxMergeInputs+1
// August 26, 1977 8:17 AM, add Interpret -- main file interpretation control
// August 26, 1977 10:37 AM, remove Interpret again
// September 25, 1977 11:43 AM, handle portrait mode device in font requests
// September 30, 1977 11:42 PM, three color break page
// October 3, 1977 8:36 AM, add dots font
// October 16, 1977 2:48 PM, add "vertical dots" for landscape mode device
// October 27, 1977 4:45 PM, Pimlico!
// December 7, 1977 10:07 AM, report poor font matches in Verbose mode
// December 9, 1977 4:30 PM, don’t report break font first choice not found
// December 21, 1977 4:19 PM, add OpenForFonts, better buffer management
// February 3, 1978 3:41 PM, fuzz up font match a bit
// February 15, 1978 8:46 AM, remove restriction on number of refs to single font
// May 9, 1978 10:11 AM, accommodate IXTypeOrbitChars, IXTypeMultiChars, to allow
//accommodation of multiple fonts.widths in Press file creation
// June 9, 1978 8:48 AM, date in multi-widths entry is expiration date, not effective date
// June 14, 1978 6:32 PM, repair expiration date comparisons
// September 22, 1978 9:21 PM, report host on hopeless Press files.
// October 15, 1978 3:22 PM, modify buffering for use with fast files
// October 25, 1978 6:30 AM, tune up buffering
// October 31, 1978 8:11 AM, adjust buffering values for Band, Press files (reduce)
// November 10, 1978 2:08 PM, offer better error reporting on font substitution
// December 6, 1978 11:04 AM use Capabilities instead of printerDevice to determine number of break pages
// March 20, 1979 1:58 PM four color puffin
// August 1, 1979 3:05 PM, mBlack became mBlackHousing!!??
// August 24, 1979 1:10 PM, reasonableness check on nCopies; protect against penguin aux tray overflow
// November 16, 1979 2:23 PM, get logo font from LogoFont
// January 18, 1980 12:16 PM, use DocG.duplex
//