// P L A Y O U T       (PREPRESS)
// catalog number ???
// modified by GMcD 1430, 12 March 76: new mmglyphs

get "ix.dfs"

// outgoing procedures
external
	[
	PlayOut
	PlayOutFont
	]

// outgoing statics
//external
//	[
//	]
//static
//	[
//	]

// 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
// OS
	MoveBlock; SetBlock; Zero
	]

// 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
	Strike		//Pointer to strike memory
	StrikeRaster	//# words per scan line in strike
	StrikeX		//Last x used in Strike
	]

// 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) be [
	let sw,wf = 0, 0

	[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)	//CDtemp

	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
[
	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 CD
	let CD=FSGetX(nc*2)			//For CD parts
	WindowReadBlock(wf,CD,nc*2)

	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=0
	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.
		nLegalChars=nLegalChars+1
		let h=pch>>CharWidth.H
		let w=pch>>CharWidth.W
		let ox=pch>>CharWidth.XL
		let oy=pch>>CharWidth.YB
		if ox ls minx then minx=ox
		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
		let wx=RoundDp(lv pch>>CharWidth.WX)
		if fpch ne 0 & fpch ne wx then VarPitch=#100000
		fpch=wx
//Following computation will assume that the offset (minx) for the entire
// font is 0.  We will fix up this assumption below.
		strikeWidth=strikeWidth+((w gr wx)? w,wx)
		ALextnno=ALextnno+(wx-1)/16
//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.
// 
	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=vec 500	//For files with maps at front...

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:		[
//strikeWidth may be too small if minx is <0 because each char will
// be offset in its box. Use nLegalChars+1 because of illegal char.
		strikeWidth=strikeWidth+(-minx)*(nLegalChars+1)
		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=maxx-minx+1
		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=minx
// 4 is for illegal character
		StrikeRaster=(strikeWidth+4+15)/16
		let StrikeSize=StrikeRaster*Height
		w>>StrikeBody.raster=StrikeRaster
		w>>StrikeBody.length=(size StrikeBody/16)+
				StrikeSize+nLegalChars+1
		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,CD+(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)
		] ; 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 exc=(wx-1)/16
		let h=pch>>CharWidth.H
		let disp=Height+miny-pch>>CharWidth.YB-h
		for i=0 to exc do [	//Write an FCD
		  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
		MoveBlock(lv w>>CharWidth.WX, (table [ 0;4 ] ), 2)
		w>>CharWidth.XL=0
		w>>CharWidth.YB=0
		w>>CharWidth.W=4
		w>>CharWidth.H=maxx
		ShowLine(0,0,false,4)
		ShowLine(0,maxx-1,false,4)
		ShowLine(0,0,true,maxx)
		ShowLine(3,0,true,maxx)
		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(CD); FSPut(WT)
]

and

//Window w is positioned at the beginning of a CD
// 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 [
	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=rightmost-minx
//	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+((wx gr wide)? wx,wide)
	if StrikeX/16 gr StrikeRaster then Scream("Strike")
]
\1431i2I