// PD test program

// PD-writing utilities

get "streams.d"
get "PDFile.d"

external
	[
	PDInit
	PDNewPage
	PDFinish
	PDRectangle
	PDTrapezoid
	PDSetPos
	PDSetColor
	PDPriority
	PDSetColorP
	PDString

	LoadFont
	LoadColor

	OpenFile
	ReadBlock
	WriteBlock
	Puts
	Gets
	Closes

	FilePos
	SetFilePos

	DoubleAdd
	SetBlock
	Zero
	MulDiv
	CallSwat
	]

static
	[
	fontTable
	nBands
	colorTable
	bandTable
	pds		//stream for PD
	loadAddr
	sMin; sMax; fMin; fMax
	priority
	color
	currentS; currentF
	originalEndCode
	pageEndCode
	]

structure STR:
	[
	length byte
	char ↑1,127 byte
	]

// An entry in a band is a BE
structure BE:
	[
	ptr	word		//Pointer to next BE this band (a ring)
	siz	word		//Size of thing to be written in PD file
	// here is PD file object to be written
	]

structure BAND:
	[
	ptr	word		//Pointer to last entry in band
	color	word
	priority	word
	]

structure CHR:
	[
	sWidth	word
	sOffset	word
	fOffset	word
	loadAddr	word
	]
static
	[
	bandWidth=16
	toner=tonerBlack
	strip
	feed
	imageFSize
	imageSSize
	]	

manifest
	[
	bc=32
	ec=127
	EndCode=#335
	]

let PDInit(fn, resol, portrait, ptoner, pfeed, pstrip; numargs na) be
[
	if na ls 2 % resol eq 0 then resol=384
	if na ls 3 then portrait=false
	if na ls 4 then ptoner=tonerBlack
	if na ls 5 then pfeed=true
	if na ls 6 then pstrip=true
	toner=ptoner; feed=pfeed; strip=pstrip

	originalEndCode=@EndCode

	let v=vec size PDH/16
	v>>PDH.password=PDPasswd
	v>>PDH.version=1
	v>>PDH.deviceCode=1
	v>>PDH.sResolution=resol
	v>>PDH.fResolution=resol
	test portrait then
		[
		imageSSize=11*resol
		imageFSize=MulDiv(17, resol, 2)
		] or [
		imageSSize=MulDiv(17, resol, 2)
		imageFSize=11*resol
		]
	v>>PDH.imageSSize=imageSSize
	v>>PDH.imageFSize=imageFSize
	v>>PDH.bandSSize=bandWidth
	v>>PDH.maxLoadWord.high=0
	v>>PDH.maxLoadWord.low=#40000
	v>>PDH.copies=1

	pds=OpenFile(fn, ksTypeWriteOnly, wordItem)
	WriteBlock(pds, v, size PDH/16)

	loadAddr=0
	fontTable=GetFS((ec-bc+1)*4)
	loadAddr=LoadFont(pds, "ACtemp", bc, ec, loadAddr, fontTable)

	colorTable=GetFS(64)
	Zero(colorTable, 64)

	nBands=MulDiv(17, resol, 2*bandWidth)

	pageEndCode=@EndCode

	PDNewPageAux()
]

and PDNewPage(ptoner, pfeed, pstrip; numargs na) be
[
	FlushPage()

	if na ls 1 then ptoner=tonerBlack
	if na ls 2 then pfeed=true
	if na ls 3 then pstrip=true
	toner=ptoner; feed=pfeed; strip=pstrip

	PDNewPageAux()
]

and PDNewPageAux() be
[
	@EndCode=pageEndCode

	bandTable=GetFS(nBands*(size BAND/16))
	Zero(bandTable, nBands*(size BAND/16))

	priority=0
	color=0
	fMin=30000; fMax=0; sMin=30000; sMax=0
]

and FlushPage() be
[
	let fBand=sMin/bandWidth
	let lBand=sMax/bandWidth
	if fBand gr lBand then return //no output

	let v=vec (size StartImage/16)+3
	v!0=0
	v>>Command.typ=typControl
	v>>Command.com=startImage
	let w=v+1
	w>>StartImage.x=0
	w>>StartImage.M=leftOverMode
	w>>StartImage.F=feed
	w>>StartImage.S=strip
	w>>StartImage.toner=toner
	w>>StartImage.passBands=fBand
	w>>StartImage.nBands=lBand-fBand+1
	w>>StartImage.fMinPage=fMin
	w>>StartImage.fSizePage=fMax-fMin+1
	WriteBlock(pds, v, (size StartImage/16)+(size Command/16))

	for b=fBand to lBand do
	[
		let pb=bandTable+b*(size BAND/16)
		let pe=pb>>BAND.ptr
		if pe then
		[
			let pf=pe>>BE.ptr		//Pointer to first element in list
			[
			WriteBlock(pds, pf+(size BE/16), pf>>BE.siz)	//That's the actual entry
			if pf eq pe then break
			pf=pf>>BE.ptr
			] repeat
		]
		v>>Command.typ=typControl
		v>>Command.com=endBand
		WriteBlock(pds, v, size Command/16)
	]

]

and PDFinish() be
[
	FlushPage()

	let v=vec 10
	v!0=0
	v>>Command.typ=typControl
	v>>Command.com=endDocument
	WriteBlock(pds, v, size Command/16)
	Closes(pds)
	@EndCode=originalEndCode
]

and GetFS(siz) = valof
[
	let p=@EndCode
	@EndCode=p+siz
	resultis p
]

and BandMake(siz, typ, com) = valof
[
	let p=GetFS(siz+(size Command/16)+(size BE/16))
	p>>BE.ptr=0
	p>>BE.siz=siz+(size Command/16)
	let q=p+(size BE/16)
	q>>Command.typ=typ
	q>>Command.com=com
	q>>Command.rest=0		//Cosmetic
	resultis q+(size Command/16)
]

and BandEnterAux(pb, p) be
[
	p=p-(size BE/16)-(size Command/16)
	test pb>>BAND.ptr eq 0 then
	[
		p>>BE.ptr=p
		pb>>BAND.ptr=p
	] or [
		let t=pb>>BAND.ptr
		p>>BE.ptr=t>>BE.ptr	//I will now pointer to first
		t>>BE.ptr=p	//and previous last will point to me
		pb>>BAND.ptr=p
	]
]

and BandEnter(sMin, p) be
[
	let b=sMin/bandWidth
	let pb=bandTable+b*(size BAND/16)
	if priority ne pb>>BAND.priority then
		[
		pb>>BAND.priority=priority
		let s=BandMake(1, typControl, setPriority)
		s!0=priority
		BandEnterAux(pb, s)
		]
	if color ne pb>>BAND.color then
		[
		pb>>BAND.color=color
		let s=nil
		test color eq 63 % color eq 0 then
		[
			s=BandMake(0, typControl, ((color eq 0)? setColorInk, setColorClear))
		] or [
			if colorTable!color eq 0 then
				[
				colorTable!color=loadAddr
				loadAddr=LoadColor(pds, color, loadAddr)
				]
			s=BandMake((size ColorTileRef/16), typControl, setColorTile)
			s>>ColorTileRef.addr.high=0
			s>>ColorTileRef.addr.low=colorTable!color
		]
		BandEnterAux(pb, s)
		]
	BandEnterAux(pb, p)
]

// Return true if point lies outside image area

and BandWiden(s, f) = valof
[
	if s ugr imageSSize then resultis true
	if f ugr imageFSize then resultis true
	if s uls sMin then sMin=s
	if s ugr sMax then sMax=s
	if f uls fMin then fMin=f
	if f ugr fMax then fMax=f
	resultis false
]

and PDRectangle(sMin, sSize, fMin, fSize) be
[
	if BandWiden(sMin, fMin) %
	  BandWiden(sMin+sSize-1, fMin+fSize-1) then return
	let p=BandMake((size MaskRectangle/16), typImaging, maskRectangle)
	p>>MaskRectangle.sMin=sMin
	p>>MaskRectangle.sSize=sSize
	p>>MaskRectangle.fMin=fMin
	p>>MaskRectangle.fSize=fSize
	BandEnter(sMin, p)
]

and PDTrapezoid(sMin, sSize, fMin, fSize, fMinLast, fSizeLast) be
[
	if BandWiden(sMin, fMin) %
	  BandWiden(sMin+sSize-1, fMin+fSize-1) %
	  BandWiden(sMin, fMinLast) %
	  BandWiden(sMin, fMinLast+fSizeLast-1) then return
	let p=BandMake((size MaskTrapezoid/16), typImaging, maskTrapezoid)
	p>>MaskTrapezoid.sMin=sMin
	p>>MaskTrapezoid.sSize=sSize
	p>>MaskTrapezoid.fMin=fMin
	p>>MaskTrapezoid.fSize=fSize
	p>>MaskTrapezoid.fMinLast=fMinLast
	p>>MaskTrapezoid.fSizeLast=fSizeLast
	BandEnter(sMin, p)
]

and PDSetPos(s, f) be [ currentS=s; currentF=f ]

and PDSetColor(c) be [ color=c ]

and PDPriority() be [ priority=priority+1 ]

and PDSetColorP(c) be [ PDSetColor(c); PDPriority() ]

and PDChar(c) be
[
	if c ls bc % c gr ec then return
	let pc=fontTable+(c-bc)*(size CHR/16)
	if pc>>CHR.loadAddr eq -1 then return	// non-existent char
	let sMin=currentS+pc>>CHR.sOffset
	let fMin=currentF+pc>>CHR.fOffset
	if BandWiden(sMin, fMin) %
	  BandWiden(sMin+100, fMin+100) then
		[ currentS=currentS+pc>>CHR.sWidth; return ]	//Kludge
	let s=BandMake((size MaskSamplesRef/16), typImaging, maskSamplesRef)
	s>>MaskSamplesRef.sMin=sMin
	s>>MaskSamplesRef.fMin=fMin
	s>>MaskSamplesRef.addr=pc>>CHR.loadAddr
	let t=s-(size Command/16)
	t>>Command.rest=0
	BandEnter(sMin, s)
	currentS=currentS+pc>>CHR.sWidth
]

and PDString(s) be
[
	for i=1 to s>>STR.length do PDChar(s>>STR.char↑i)
]