// 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:
//	0	initialize (beginning of entity)
//	1	set x value
//	2	set y value
//	3	install space in font table (internal use only)
//	4	remove 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
 [
	map	word 16		//mpFontWTCB
	WDDPos	word 2		//File pos in scratch of W directory
	AllWTCBIn word		//True if all WTCB's in core
	CurSet	word		//Current font set.
 ]

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

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

structure ST :			//Space table (for "set space" ops)
 [
	InEffect word		//True if "set space" in effect
	FS	word 2		//"Font" S width
	FB	word 2		//"Font" B width
	US	word 2		//"User" S width
	UB	word 2		//"User" B width
	XM	word 		//X in micas
	YM	word		//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:
//	0	Initialize (set values to 0)
//	1	Set x
//	2	Set y
//	3	Install values in current font table if possible
//	4	Remove 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
     ]
 ]



   

(1800)\17f1 60f0 164f1 78f0 9f1 33f0 13f1 11f0