// 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 :
 [ next	word
   fontLoad	word	//number of this font load
   fontLength	word	// 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
]

e6(1800)\42f1 400f0 6f1 38f0 1f1 12f0