// P L A Y O U T       (PREPRESS)
// Bcpl/f PlayOut.Bcpl

//Modified August 18, 1980  9:35 PM by Lyle Ramshaw, 
//  Fixed calculation of Length field in .Strike header.
//  The old code used "nLegalChars" where it should have been
//  just "nc", since even non-existent characters have pointers
//  in the index table.

//Modified June 17, 1980  3:05 PM by Lyle Ramshaw, 
//  The ALextnno variable isn't needed by Show at all, but
//  is used to determine how much storage to allocate;  thus,
//  it is important that it not be complete garbage...

//Modified May 23, 1980  11:06 AM by Lyle Ramshaw, PARC
// Made MakeAL pay attention to the "Clipped" flag as well,
// so that rotated AL fonts will get the right rasters at
// least (for HSIL, an XEOS hack).

//Modified April 22, 1980  10:33 AM by Lyle Ramshaw, PARC
// Due to introduction of the new .KS format for Kerned Strikes,
// the Kerned flag is hereby decommissioned.  MakeStrike now
// has a "Clipped" flag instead:  if Clipped is false (the default)
// the widths of overhanging characters are artificially
// increased just enough to eliminate overhang.  If Clipped is
// true, the overhanging bits are ignored, and the width
// is not affected.  

//Modified March 1, 1980  9:54 PM by Lyle Ramshaw
//  Fixing the width calculations in the MakeStrike code.  Whoever
// wrote that code seems to have assumed that the X component of the width
// vector and the X length of the bounding box were measured from the
// same origin:  but they aren't.  Hence the need for a fix.

// modified January 15, 1980  6:11 PM by Kerry A. LaPrade, XEOS
//  Abort out of show command with DEL key.
//
// modified by Lyle Ramshaw, October 2, 1979  4:04 PM: 
//			fix bug in VarPitch computation

get "GoodFoo.d"
get "ix.dfs"

// outgoing procedures
external
	[
	PlayOut
	PlayOutFont
	]

// outgoing statics
external
	[ @Clipped
	]
static
	[ @Clipped=false	//true if overhanging bits should be removed
	]

// incoming procedures
external
	[
//WINDOW
	WindowSetPosition
	WindowGetPosition
	WindowReadBlock
	WindowWriteBlock
	WindowRead
	WindowWrite
	WindowCopy
	WindowClose

//PREPRESS
	PrePressWindowInit
	IllCommand
	ReadIXTempFile
	SetPosRelative
	GetPosRelative
	GetResolution
	NoFile
	Scream

//UTIL
	FSGetX
	FSPut
	MulDiv
	RoundDp

//SCAN
	ReadCom
	TypeForm

//FLOAT
	FLD;FST;FTR;FLDI;FNEG;FAD;FSB;FML;FDV;FCM;FSN
	FLDV;FSTV;FLDDP;FSTDP;DPAD;DPSB
	DPCop
	]

// incoming statics
//external
//	[
//	]

// internal statics
static
	[
	@Bits		//Pointer to scan-converted bits
	@nBitsWords	//Number of words of bits
	@Height		//Real height of font
	@WordWidth	//Number of words wide of max char
	@disHeight	// Even version of Height
	@disWordWidth	// Even version of WordWidth
	@StrikeMaxWX	// maximum x dimension of block in the Strike
	@Strike		//Pointer to strike memory
	@StrikeRaster	//# words per scan line in strike
	@StrikeX		//Last x used in Strike
	@illCharWX	// WX of illegal character
	]

// File-wide structure and manifest declarations.

manifest  DBptr=#420

structure DB: [
	next word
	resolution bit 1
	background bit 1
	indentation bit 6
	width bit 8
	bitMapAddress word
	height word
	]
manifest lDB = size DB/16

structure StrikeHeader: [
	oneBit bit
	index bit
	fixed bit
	blank bit 13
	min word
	max word
	maxwidth word
	]
structure StrikeBody: [
	length word
	ascent word
	descent word
	xoffset word
	raster word
	]

// Procedures
let
//Play out characters.
// Fileflag is:
//	0	Show chars on screen
//	1	Make CU file
//	2	Make AL file
//	3	Make STRIKE file (use mastermaker switch in PlayOutFont)

PlayOut(fileflag,wf,sw;numargs na) be
 [ switchon na into
	[ case 1: sw=0;wf=0;endcase
	  case 2: wf=PrePressWindowInit(wf,false);sw=0;endcase
	  default: wf=PrePressWindowInit(wf,false)
				sw=PrePressWindowInit(sw,true)
				endcase
	]

	[ParamLoop
	let switches = vec 10; let str=vec 20
	if ReadCom(str, switches) eq 0 then break
	test switches!0 eq 0 then sw =
		PrePressWindowInit(str, true)
	or test switches!1 eq $S then wf =
		PrePressWindowInit(str, false)
	or if switches!1 eq $O then sw =
		PrePressWindowInit(str, true)
	]ParamLoop repeat

	if (fileflag ne 0) & (sw eq 0) then IllCommand()
	if wf eq 0 then  wf=PrePressWindowInit(-1,false)	//ACtemp

	let fn=vec IXLName
	let ix=vec IXLMax
	ReadIXTempFile(wf,fn,ix)		//Read directory
	let v = vec 4
//Make up vector (only really needed for fileflag=3)
		v!0 = fileflag
		v!1 = 0  // ASSUME no rotations. rotations will require a
		// a new procedure since filefilag is our only parameter.
		// (see mmfonts.c, the use of the switch)
		v!4 = 0
	PlayOutFont(v,ix,wf,sw)
	if fileflag then WindowClose(sw,-1)
	WindowClose(wf)
]

and

//PlayOutFont(opvec,ix,wf,sw)
//	opvec!0 is file type:
//		0	Show chars on screen (sw=0)
//		1	Make CU file
//		2	Make AL file
//		3	Make MasterMaker file
//			(opvec!1= rotation type
//			(opvec!2_ 
//			(opvec!3_ 
//			(opvec!4= trantab
//			if trantab=0, nothing special; otherwise,
//			trantab is a 256-word table, trantab!i is char#
//			to put in that position on output file
//			This is for dummy font mapping .. WARNING:
//			only bc to ec (from REAL font) will be put out.
//	ix is IX entry for the font, in file wf
//	sw is file to write goodies on

PlayOutFont(opvec,ix,wf,sw) be
[
   if ix>>IX.Type ne IXTypeChars then
			Scream("PlayOutFont called with wrong input type")
	WindowSetPosition(wf,lv ix>>IX.sa)
	let bc=ix>>IX.bc
	let ec=ix>>IX.ec
	let nc=ec-bc+1
	let siz=ix>>IX.siz

	let WT=FSGetX(nc*CharWidthsize)
	WindowReadBlock(wf,WT,nc*CharWidthsize)
	let off=vec 1
	WindowGetPosition(wf,off)		//Offset for AC
	let AC=FSGetX(nc*2)			//For AC parts
	WindowReadBlock(wf,AC,nc*2)

	StrikeMaxWX=0
	let minx=0; let miny=1000
	let maxx=0; let maxy=-1000
	let ALextnno=0				//Count extensions for AL
	let Wtotal=0; let HWtotal=0
	let VarPitch=false; let fpch=nil;  let SeenALegal=false
	let strikeWidth=0
	let nLegalChars=0

	for ch=0 to nc-1 do 
		[
		let pch=WT+ch*CharWidthsize
		unless pch>>CharWidth.H eq HNonExCode then
		[			// Find out max size.
		let h=pch>>CharWidth.H
		let w=pch>>CharWidth.W
		if (h eq 0)%(w eq 0) then  //sanitize empty character
			[
			pch>>CharWidth.H=0
			pch>>CharWidth.W=0
			pch>>CharWidth.XL=0
			pch>>CharWidth.YB=0
			]
		let ox=pch>>CharWidth.XL
		let oy=pch>>CharWidth.YB
		if ox ls minx then minx=ox
if (opvec!0 eq 3)&(ox ls 0) then Scream("Illegal x offset (<0)")
		if oy ls miny then miny=oy
		if ox+w-1 gr maxx then maxx=ox+w-1
		if oy+h-1 gr maxy then maxy=oy+h-1
		]
		]

	//now, loop through again to handle various width details
	for ch=0 to nc-1 do 
		[
		let pch=WT+ch*CharWidthsize
		unless pch>>CharWidth.H eq HNonExCode then
		[		
		nLegalChars=nLegalChars+1
		let h=pch>>CharWidth.H
		let w=pch>>CharWidth.W
		let ox=pch>>CharWidth.XL
		let oy=pch>>CharWidth.YB
		let wx=RoundDp(lv pch>>CharWidth.WX)
let myWidth, effectiveWidth=nil,nil
let extcnt=0
switchon opvec!0 into
	[
  case 2:	effectiveWidth=(Clipped?wx,Max(wx, w+ox-minx))
				extcnt=(effectiveWidth-1)/16	
				myWidth=(Clipped?wx, Max(wx,extcnt*16))
				endcase
  case 3:  myWidth=(Clipped?wx,Max(w+ox, wx))	//.Strike
				endcase
  default:  myWidth=wx
				endcase
	]
strikeWidth=strikeWidth+myWidth
StrikeMaxWX=Max(StrikeMaxWX, myWidth)
		if SeenALegal & (fpch ne myWidth) then VarPitch=#100000
		unless SeenALegal do [ SeenALegal=true;  fpch=myWidth ]
		ALextnno=ALextnno+extcnt
//Calculate the number of words and half-words required if this char
// is stored in full bit-map form (a la Alto)
		let hw=(h+15)/16
		let hhw=(h+7)/8
		hw=hw*w
		hhw=hhw*w		//* number of scan lines
		Wtotal=Wtotal+hw
		HWtotal=HWtotal+hhw
		]
		]

//Now we are in a position to calculate various things.
// 
	if (opvec!0 eq 3) then
		[
		illCharWX=(VarPitch ? 6,fpch)
		minx=0  //Strike spaces by origin and width vec.
		if (miny gr 0) then miny=0  //For illchar
		if (maxy ls 2) then maxy=2  //For illchar
		]
	Height=maxy-miny+1		//Bounding box.
	WordWidth=(maxx-minx+1+15)/16	//No of words.
	disHeight=(Height+1)&#177776	//Even, for display
	disWordWidth=(WordWidth+1)&#177776 //Even, for display
	nBitsWords=disWordWidth*disHeight

//Type some stuff
	TypeForm("Height=",10,Height,". Width=",10,WordWidth," words.*N*L")
	TypeForm("SC: words: ",10,Wtotal,", bytes: ",10,HWtotal,".*N*L")
	TypeForm("(0,0) point is at ",10,-minx,$,,10,-miny,0)

	Bits=FSGetX(nBitsWords, true)
	Zero(Bits, nBitsWords)	//Zero it out.
	let display=FSGetX(lDB, true)
	display>>DB.next=0
	display>>DB.resolution=1	//Low resolution to see it
	display>>DB.background=0
	display>>DB.indentation=3
	display>>DB.width=disWordWidth
	display>>DB.bitMapAddress=Bits
	display>>DB.height=disHeight	//2* for double resolution.
	if disWordWidth gr 18 then	//Use high resolution.
		[
		display>>DB.resolution=0
		display>>DB.height=disHeight/2
		]

//Now link it in!
	let olddisplayp=@DBptr
	while olddisplayp>>DB.next ne 0 do
		olddisplayp=olddisplayp>>DB.next
	olddisplayp>>DB.next=display


//Do initial file processing
let fptr=nil
let curALextnno=nil
let trantab=nil
let mpCharPos=FSGetX(259+ALextnno)	//For files with maps at front...
Zero(mpCharPos, 259+ALextnno)

switchon opvec!0 into [
case 0:		endcase
case 1:		WindowWrite(sw,Height)		//Height first
		WindowWrite(sw,WordWidth)
		endcase
case 2:		[
		//First two words are max height,
		// then:
		// VariablePitch bit 1
		// BaseLine bit 7
		// MaxWidth bit 8
		WindowWrite(sw,maxy-miny+1)
		WindowWrite(sw,VarPitch+(maxx-minx+1)+((maxy+1) lshift 8))
		// Point everything at the dummy character
		for i=0 to 255+ALextnno do
			[
			mpCharPos!i=256+ALextnno-i //Dummy char ptrs
			WindowWrite(sw,0)
			]
		// Put out dummy character
		WindowWrite(sw,1);WindowWrite(sw,0)
		fptr=256+ALextnno+2
		curALextnno=0
		] ; endcase;
case 3:		[
// Use nLegalChars+1 because of illegal char.
		let v=vec (size StrikeHeader/16)
		Zero(v, size StrikeHeader/16)
		v>>StrikeHeader.oneBit = 1
		unless VarPitch then v>>StrikeHeader.fixed=1
		v>>StrikeHeader.maxwidth=StrikeMaxWX
		v>>StrikeHeader.min=bc
		v>>StrikeHeader.max=ec
		WindowWriteBlock(sw, v, size StrikeHeader/16)
		let w=vec (size StrikeBody/16)
		Zero(w, size StrikeBody/16)
		w>>StrikeBody.ascent=maxy+1
		w>>StrikeBody.descent=-miny
		w>>StrikeBody.xoffset=0	//always zero according to new rules
		StrikeRaster=(strikeWidth+illCharWX+15)/16
		let StrikeSize=StrikeRaster*Height
		w>>StrikeBody.raster=StrikeRaster
		w>>StrikeBody.length=(size StrikeBody/16)+
				StrikeSize+nc+2
		WindowWriteBlock(sw, w, size StrikeBody/16)
		Strike=FSGetX(StrikeSize)
		Zero(Strike, StrikeSize)
		StrikeX=0
		trantab=opvec!4
		] ; endcase
		]

//Now cycle through characters again, scan converting.

for ch=bc to ec do
	[
	let pch=WT+(ch-bc)*CharWidthsize
	unless pch>>CharWidth.H eq HNonExCode then
	[
	SetPosRelative(wf,off,AC+(ch-bc)*2)
	ShowChar(wf,ch,pch>>CharWidth.XL-minx,
		pch>>CharWidth.YB-miny) //Put on screen.
	let wx=RoundDp(lv pch>>CharWidth.WX) //Round width

switchon opvec!0 into [
	case 0:	[		//Wait...
//		let foo=nil
//		TypeForm("Widths: ",3,lv pch>>CharWidth.WX,$,,
//			3,lv pch>>CharWidth.WY," ??",1,lv foo)
		TypeForm("Widths: ",3,lv pch>>CharWidth.WX,$,,
			3,lv pch>>CharWidth.WY," ??")
		Wl("")
                  if Gets(keys) eq 177b then break
		] ; endcase
	case 1:	[		//Write stuff on file.
		WindowWrite(sw,ch)
		WindowWrite(sw,wx) //width
		let p=Bits
		for i=1 to Height do
		   [
		   WindowWriteBlock(sw,p,WordWidth)
		   p=p+disWordWidth
		   ]
		] ; endcase
	case 2:	[
		let effectiveWidth, exc=nil,nil
		effectiveWidth=
			(Clipped?wx,Max(wx, pch>>CharWidth.W+pch>>CharWidth.XL-minx))
		exc=(effectiveWidth-1)/16	
		wx=(Clipped?wx, Max(wx,exc*16))
		let h=pch>>CharWidth.H
		let disp=Height+miny-pch>>CharWidth.YB-h
		for i=0 to exc do [	//Write an FAC
		  let p=Bits+i+(disp*disWordWidth)
		  for j=1 to h do
			[ WindowWrite(sw,p!0); p=p+disWordWidth ]
		  fptr=fptr+h
		  test i eq 0
		  ifso [ mpCharPos!ch=fptr-ch ]
		  ifnot [ let t=256+curALextnno
			mpCharPos!t=fptr-t
			curALextnno=curALextnno+1 ]
		  test i eq exc
		  ifso [ WindowWrite(sw,wx*2+1) ]
		  ifnot [ WindowWrite(sw,(curALextnno+256)*2) ]
		  WindowWrite(sw,disp*256+h)
		  fptr=fptr+2
		  wx=wx-16
		]
		] ; endcase
	case 3:	[
		let tc=ch-bc
		mpCharPos!tc=StrikeX
		RecordGlyph(opvec,pch,sw,minx,miny) //Record char
		for i=tc+1 to 258 do mpCharPos!i=StrikeX
		] ; endcase
	] //switchon
	]
] //for ch


//Now do post loop processing
	switchon opvec!0 into
	[
case 2:		[
		let old=vec 1
		WindowGetPosition(sw, old)
		WindowSetPosition(sw, table [ 0;2 ] )
		WindowWriteBlock(sw, mpCharPos, 256+ALextnno)
		if curALextnno ne ALextnno then
		   Scream("Extension counts do not match!")
		WindowSetPosition(sw, old)
		endcase
		]
case 3:		[
		Zero(Bits, nBitsWords)	//Prepare illchar
		let w=vec size CharWidth/16
		let illx=vec 1
		illx!0=illCharWX;  illx!1=0;
		MoveBlock(lv w>>CharWidth.WX, illx, 2)
		MoveBlock(lv w>>CharWidth.WY, (table [ 0;0 ] ), 2)
		w>>CharWidth.XL=1
		w>>CharWidth.YB=0
		w>>CharWidth.W=Min(4,illCharWX-1)
		w>>CharWidth.H=maxy+1
		ShowLine(1,0,true,maxy+1)
		ShowLine(2,0,true,maxy+1)
		ShowLine(3,0,true,maxy+1)
		ShowLine(4,0,true,maxy+1)
		RecordGlyph(opvec,w,sw,0,0)	//And write it out
		mpCharPos!(nc+1)=StrikeX
		WindowWriteBlock(sw, Strike, StrikeRaster*Height)
		WindowWriteBlock(sw, mpCharPos, nc+2)
		FSPut(Strike)
		endcase
		]
default:		endcase
	]



	olddisplayp>>DB.next=0		//No more display.

	FSPut(Bits); FSPut(display)
	FSPut(AC); FSPut(WT)
]

and

//Window w is positioned at the beginning of a AC
// character.  Scan-convert it into the "bits"
// array.  
// (x0,y0) is the address in the Bits array of the lower left corner
// of the bounding box.

ShowChar(w,c,x0,y0) be [
	Zero(Bits, nBitsWords)	//Zero it out

	let d=WindowRead(w)		//FHEAD
	let hw=d<<FHEAD.hw
	let ns=d<<FHEAD.ns
	let wp=(Height-y0-1)*disWordWidth+Bits

	let x=x0

	for i=0 to ns-1 do
		[			//Process a scan line x+i
		let wx=wp+(x rshift 4)	//High bits (word #)
		let lbx=x rem 16		//Bit position
		let NewBit=#100000 rshift lbx
		for j=1 to hw do
		   [
		   d=WindowRead(w)
		   for k=0 to 15 do
			[
			if (d&#100000) ne 0 then @wx=@wx%NewBit
			d=d lshift 1
			wx=wx-disWordWidth
			]
		   ]
		x=x+1
		]
]

and 

ShowBit(x,y,val; numargs n) = valof [
	if y ls 0 % y ge Height then resultis 0
	if x ls 0 % x ge disWordWidth*16 then resultis 0
	let a=(Height-y-1)*disWordWidth+(x rshift 4)+Bits
	let m=#100000 rshift (x&#17)
	if n eq 2 then resultis (@a &m)
	@a=@a%m
]

and

ShowLine(x,y,vert,n) be [
	for i=1 to n do
		[
		ShowBit(x,y,nil)
		test vert then y=y+1 or x=x+1
		]
]

and


// Master-Maker glyph maker

RecordGlyph(opvec,cw,wind,minx,miny) be [
	if minx ne 0 then Scream("Problem with x offset in MakeStrike.")
	let rot=opvec!1
	let wb=cw>>CharWidth.W
	let ws=cw>>CharWidth.H
	let ob=cw>>CharWidth.XL
	let os=cw>>CharWidth.YB
	let wx=RoundDp(lv cw>>CharWidth.WX)
	let rightmost=ob+wb
	let wide=(Clipped? Min(rightmost,wx), rightmost)
//	minx=ob-minx		//lower left of char box rel to
//	miny=os-miny		// screen area
//	let rotateit=false
//	if (rot&1) ne 0 then
//		[
//		rotateit=true
//		let t=nil
//		t=wb; wb=ws; ws=t
//		t=ob; ob=os; os=t
//		]
//s and b are relative to the bounding box of the character
// (so addr in screen area is b+minx s+miny)
	let b,s=nil,nil
//Following line not right for rotations
	b=0; s=Height-1

//	switchon rot into
//	[
//	case 0:	b=0; s=ws-1; endcase
//	case 1:	ob=-wb-ob; b=wb-1; s=ws-1; endcase
//	case 2:	ob=-wb-ob; os=-ws-os; b=wb-1; s=0; endcase
//	case 3: os=-ws-os; b=0; s=0; endcase
//	]
//
	let porg=(StrikeX rshift 4)+Strike
	let ts=s
	for i=1 to Height do
	[
	   let tb=b
	   let tx=StrikeX&#17
	   let tp=porg
	   for j=1 to wide do
		[
		let biton=ShowBit(tb,ts)
		if biton then @tp=@tp%(#100000 rshift tx)
		tx=tx+1
		if tx eq 16 then [ tx=0; tp=tp+1 ]
		tb=tb+((b ne 0)? -1,1)
		]
	   ts=ts+((s ne 0)? -1,1)
	   porg=porg+StrikeRaster
	]
	StrikeX=StrikeX+(Clipped? wx, Max(wx,rightmost))
	if StrikeX/16 gr StrikeRaster then Scream("Strike overflow.")
]
(635)\3111i2I