// O R B I T F O R M A T  (PREPRESS)
// catalog number ???
//
// Puts CDtemp file into Orbit font format, and types out size of
// character encodings.

get "ix.dfs"

// outgoing procedures
external
	[
	OrbitFormat
	]

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

// incoming procedures
external
	[
//WINDOW
	WindowRead
	WindowReadBlock
	WindowWrite
	WindowWriteBlock

//MAPCDTEMP
	MapCDtemp

//PREPRESSUTIL
	FSGetX
	FSPut
	Scream
	TypeForm

//OS
	Noop
	DoubleAdd
	Zero
	SetBlock
	MoveBlock
	]

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

// internal statics
static
	[
	pack=true
	]

// File-wide structure and manifest declarations.

let OrbitFormat() be
[
	let v=vec 1
	v!0=0
	MapCDtemp(Noop, OrbitOne, v)
	TypeForm(10, v!0, " words of font storage.")
]

and OrbitOne(p, si, so, arg) be
[
	let masks=vec 16
	for i=0 to 15 do masks!i=(-1) rshift i

//Find out dimensions of char
	let a=WindowRead(si)
	let hw= a<<FHEAD.hw
	let ns=a<<FHEAD.ns
	let hb=p>>CharWidth.H
// Place here "hb=16*hw" if you want unpacked fonts.
	unless pack then [ hb=16*hw; p>>CharWidth.H=hb ]
//
	let hhw=(hb+15)/16
	if hhw ne hw then Scream("Character height inconsistency")
// sizeNeeded _ (hb*ns+15)/16
	let mul=vec 1
	DoubleMul(mul, hb, ns)
	DoubleAdd(mul, table [ 0;15 ] )
	let sizeNeeded=(mul!0 lshift 12)+(mul!1 rshift 4)
	if sizeNeeded then
		[
		sizeNeeded=(sizeNeeded+3)&(-2)		//Account for header; even num
		let pbits=FSGetX(sizeNeeded+1)	//1 extra because of p!1 below
		pbits!0=-hb		//Height
		pbits!1=ns-1	//Width
		let p=pbits+2
		let ob=0

		for i=1 to ns do
			[
			for j=1 to hw do
				[
				let w=WindowRead(si)
				p!0=(p!0&(not masks!ob))+(w rshift ob)
				p!1=(p!1&(masks!ob))+(w lshift (16-ob))
				p=p+1
				]
			ob=ob+hb
			p=p-hw+ob/16
			ob=ob&#17
			]
		WindowWriteBlock(so, pbits, sizeNeeded)
		arg!0=arg!0+sizeNeeded
		FSPut(pbits)
		]
]

and DoubleMul(res, a, b) be
[
	let ad=vec 1
	ad!0=0; ad!1=a
	res!0=0; res!1=0
	for i=1 to b do DoubleAdd(res, ad)
]