// PD test program

// Load a font from an AC file.

get "streams.d"

external
	[
	LoadFont
	LoadColor

	OpenFile
	ReadBlock
	WriteBlock
	Puts
	Gets
	Closes

	FilePos
	SetFilePos

	DoubleAdd
	SetBlock
	Zero
	]

structure IX:
	[
	typ	bit 4
	length	bit 12
	]

structure IXCHR:
	[
	@IX
	family byte
	face byte
	bc	byte
	ec	byte
	siz word
	rotation	word
	segmentSA	word 2
	segmentLength word 2
	resolutionX	word
	resolutionY	word
	]

structure CharData:
	[
	Wx	word 2
	Wy	word 2
	BBox	word
	BBoy	word
	BBdx	word
	BBdy	word
	]

// nextLoadAddr=LoadFont(s, "ACfile name", bc, ec, firstLoadAddr, dopeVec)
//		Loads the AC file into the load, starting at firstLoadAddr.
//		Writes PD codes on stream s.
//		Character codes loaded are [bc..ec]
//		dopeVec is indexed by (charCode-bc)*4 to find:
//			Width word	(in S direction)
//			BBox word		(offset in S direction)
//			BBoy word		(offset in F direction)
//			LoadAddr word	(load address) (-1 means char does not exist)

let LoadFont(s, fn, bc, ec, firstLoadAddr, dopeVec) = valof
[
	let si=OpenFile(fn, ksTypeReadOnly, wordItem)
	let v=vec 20

	[	ReadBlock(si, v, 1)
		if v>>IX.length gr 1 then ReadBlock(si, v+1, v>>IX.length-1)
	] repeatuntil v>>IX.typ eq 3

	let fbc=v>>IXCHR.bc
	let fec=v>>IXCHR.ec

	let sa=lv v>>IXCHR.segmentSA
	DoubleAdd(sa, sa)	//convert word to byte position
	SetFilePos(si, sa)
	SetBlock(dopeVec, -1, 4*(ec-bc+1))

	for i=fbc to fec do
		[
		ReadBlock(si, v, size CharData/16)
		if i ge bc & i le ec then
			[
			let p=dopeVec+(i-bc)*4
			p!0=@(lv v>>CharData.Wx)
			p!1=v>>CharData.BBox
			p!2=v>>CharData.BBoy
			]
		]

	let fp=vec 1
	FilePos(si, fp)
	let relPos=vec 512
	ReadBlock(si, relPos, (fec-fbc+1)*2)

	for i=bc to ec do if i ge fbc & i le fec then
		[
		let p=relPos+2*(i-fbc)
		let q=dopeVec+(i-bc)*4
		if p!0 ne -1 then
			[
			DoubleAdd(p, p)	//Convert to byte position
			DoubleAdd(p, fp)
			SetFilePos(si, p)
			let w=Gets(si)
			let height=(w rshift 10)
			let sSize=w&#1777
			let wordLen=height*sSize+2
			Puts(s, 7*256)		//storeLoad
			Puts(s, firstLoadAddr); Puts(s, 0)
			Puts(s, wordLen)
			Puts(s, sSize)
			Puts(s, height*16)
			for i=1 to height*sSize do Puts(s, Gets(si))
			q!3=firstLoadAddr
			firstLoadAddr=firstLoadAddr+wordLen
			]
		]

	Closes(si)
	resultis firstLoadAddr
]

// Loads a color tile into the load
//	colorVal=0 means black, 63 is white

and LoadColor(s, colorVal, firstLoadAddr) = valof
[
	let SetBit(v, x, y) be
		[
		let m=#100000 rshift y
		v!x=v!x % m
		]

	let v=vec 16
	Zero(v, 16)

	let halfToneTable = table
		[
		44; 39; 31; 17; 09; 25; 37; 52;
		20; 26; 33; 41; 49; 35; 28; 12;
		00; 10; 50; 57; 61; 46; 22; 02;
		06; 18; 42; 58; 62; 54; 14; 04;
		08; 24; 36; 53; 45; 38; 30; 16;
		48; 34; 29; 13; 21; 27; 32; 40;
		60; 47; 23; 03; 01; 11; 51; 56;
		62; 55; 15; 05; 07; 19; 43; 59
		]

	for x=0 to 7 do for y=0 to 7 do
		[
		let p=x*8+y
		if colorVal le halfToneTable!p then
			[
			SetBit(v, x, y); SetBit(v, x+8, y)
			SetBit(v, x, y+8); SetBit(v, x+8, y+8)
			]
		]

	Puts(s, 7*256)		//storeLoad
	Puts(s, firstLoadAddr); Puts(s, 0)
	Puts(s, 21)
	Puts(s, 0); Puts(s, 0); Puts(s, 0)
	Puts(s, 16); Puts(s, 16)
	for i=0 to 15 do Puts(s, v!i)
	resultis firstLoadAddr+21
]