// Write out an Alto bit map as a one-page PRESS file with a dummy
// font directory.
// Copyright Xerox Corporation 1979
//
//DCBPress(filename,DCBptr [,width,height,leftmargin,topmargin])

get "Streams.d"

manifest [
	Presspassword=27183	// Press password
	]

// Structures

// DDV used to access PRddir -- PR file document directory

structure DDV: [
	passwd	word	// password=27183
	nrecs	word	// total no of records in PR file
	nparts	word	// no of parts
	pdstart	word	// where part directory begins
	pdrecs	word	// no of records
	backp	word	// back pointer
	spare1	word
	spare2	word
	fcopy	word	// first copy to print
	lcopy	word	// last copy to print
	spare3	word 118
	FileStr	word 26
	CreatStr	word 16
	DateStr	word 20
	]

manifest [ DDVlen=size DDV/16 ]

// PD used to read page directory info

structure PD: [
	type	word
	pstart	word
	precs	word
	infile	bit 1		// true or false according to
				// whether part is still in input file
	dirty	bit 1		// to indicate if page is dirty
	padding	bit 14
	]

manifest [ PDlen=size PD/16 ]

// PDV is structure for storing stuff about part directory

structure PDV: [
	npages	word		// count of pages
	pageno	word		// page in vector
	recno	word		// record now in buf
	tbl	word		// table of page data
	buf	word		// address of 256-word buffer
	]

manifest [ PDVlen=size PD/16 ]

// FE used to read Font Directory entries

structure FE: [
	length	word	// length of entry
	set	bit 8
	fno	bit 8
	destm	bit 8	// first char code
	destn	bit 8	// last
	fam	word 10	// name string
	face	bit 8
	source	bit 8	// first char
	siz	word
	rotn	word
	]

manifest [ FElen=size FE/16 ]

// EH used to access Entity Header (now called Trailer)

structure EH: [
	type	bit 8		// entity type
	fontset	bit 8		// font set
	dstart1	word		// byte address of data, high-order
	dstart2	word		// low-order
	dlength1 word		// byte length of data, high-order
	dlength2 word		// low-order
	xe	word		// origin x
	ye	word		// y
	xleft	word		// lh corner
	ybottom	word
	width	word
	height	word
	length	word		// length in words of entity
	]

manifest [ EHlen=size EH/16 ]

// Entity command defs

manifest [
	EShowShort=0
	ESkipShort=#40
	EShowSkip=#100
	ESpaceXShort=#140
	ESpaceYShort=#150
	EFont=#160

	ESpare=#355	// to test for command class

	ESetX=#356
	ESetY=#357
	EShow=#360
	ESkip=#361
	ESkipControl=#362
	EShowCopy=#363
	ESpaceX=#364
	ESpaceY=#365
	EResetSpace=#366
	ESpace=#367
	ESetBright=#370
	ESetHue=#371
	ESetSat=#372
	EShowObject=#373
	EShowDots=#374
	EObjectCopy=#375
	EDotsCopy=#376
	ENop=#377

	ShiftENop=#177400		// ENop, shifted left

	EDotCode=#400
	EDotWindow=1
	EDotSize=2
	EDotsFollow=3
	EDotMode=#1000

	]

external [
	DCBPress

	OpenFile
	Closes
	Puts
	Zero
	SetBlock
	MoveBlock
	WriteBlock
	Allocate
	Free
	sysZone
	UserName
	]

static [
	OutputStream
	PageBuf
	]

manifest [
	lmarg=1024
	bmarg=1024
	ScreenXMax=608
	ScreenYMax=808
	]

structure SV: [
	code	word
	bwidth	word
	nsl	word
	mode	word
	dotsize	word
	pw	word
	ph	word
	window	word
	pb	word
	db	word
	pl	word
	dl	word
	follow	word
	]

manifest [ SVlen=size SV/16 ]

structure DB: [
	next		word
	resolution	bit 1
	background	bit 1
	indentation	bit 6
	width		bit 8
	bitMapAddress	word
	height		word
	]


let DCBPress(fn,dcb,uwid,uhigh,uleft,utop; numargs nargs) be [

	OutputStream=OpenFile(fn, ksTypeWriteOnly)
	PageBuf=Allocate(sysZone, 256)
	let ht=dcb>>DB.height*2	// height
	let ww=dcb>>DB.width	// word width
	let bw=ww*16		// total width in bits
	switchon nargs into [
case 2:		uwid=bw
case 3:		uhigh=ht
case 4:		uleft=0
case 5:		utop=0
		endcase
	]
	if utop gr ht then utop=0	//Do something!
	if utop+uhigh gr ht then uhigh=ht-utop
	if uleft gr bw then uleft=0
	if uleft+uwid gr bw then uwid=bw-uleft

//Prepare to write first part of DL
	let btbl=table [
		EDotCode; 0; 0;
		EDotMode+3;
		EDotSize; 0; 0;
		EDotWindow; 0; 0; 0; 0;
		EDotsFollow ]
	let svec=vec SVlen-1
	MoveBlock(svec,btbl,SVlen)
	svec>>SV.bwidth=bw
	svec>>SV.nsl=ht
	svec>>SV.pw=32*uwid
	svec>>SV.ph=32*uhigh
	svec>>SV.pl=utop
	svec>>SV.dl=uhigh
	svec>>SV.pb=uleft
	svec>>SV.db=uwid
	WriteBlock(OutputStream,svec,SVlen)
	WriteBlock(OutputStream,dcb>>DB.bitMapAddress,ht*ww) // write bits

//Now write an entity describing the dots
	let eh=vec EHlen
	let ev=vec 6
	MakeDotEntity(ev,eh,uwid,uhigh,SVlen+ww*ht)
	Puts(OutputStream,0)
	WriteBlock(OutputStream,ev,7)		//7 word entity
	WriteBlock(OutputStream,eh,EHlen)
	let nw=SVlen+ht*ww+1+7+EHlen		// words written
	let fp=nw&#377
	let pad=(fp eq 0 ? 0, 256-fp)
	Zero(PageBuf,256)
	WriteBlock(OutputStream,PageBuf,pad)	// padding
	WriteFontDir()
	WritePageDir(nw,pad)
	WriteDocDir(nw,pad,fn)
	Closes(OutputStream)
	Free(sysZone, PageBuf)
	]


and MakeDotEntity(ev,eh,wid,ht,len) be [

	let evt=table [ ShiftENop+ESetX; 0; ShiftENop+ESetY;0;
		ShiftENop+EShowDots; 0 ]
	let x=((ScreenXMax-wid)/2)&#177760
	let y=((ScreenYMax-ht)/2)&#177760
	Zero(eh,EHlen)
	eh>>EH.dlength2=len lshift 1
	eh>>EH.xe=(x lshift 5)+lmarg
	eh>>EH.ye=(y lshift 5)+bmarg
	eh>>EH.width=wid lshift 5
	eh>>EH.height=ht lshift 5
	eh>>EH.length=EHlen+7
	MoveBlock(ev,evt,6)
	ev!6=len
	]

and WriteFontDir() be [

	let ftbl=table [
		FElen; 0; 127; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 10; 0;
		FElen; 1; 127; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 256; 10; 0;
		FElen; 2; 127; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 512; 10; 0;
		FElen; 3; 127; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 24; 0; ]
	Zero(PageBuf,256)
	MoveBlock(PageBuf,ftbl,4*FElen)
	for i=0 to 2 do MoveBlock(lv (PageBuf+i*FElen)>>FE.fam,"HELVETICA",5)
	MoveBlock(lv (PageBuf+3*FElen)>>FE.fam,"LOGO",3)
	WriteBlock(OutputStream,PageBuf,256)
	]

and WritePageDir(nw,pad) be [

	let pdtbl=table [ 0; 0; 0; 0; 1; 0; 1; 0 ]
	let pgs=(nw+pad) rshift 8
	Zero(PageBuf,256)
	MoveBlock(PageBuf,pdtbl,8)
	PageBuf>>PD.precs=pgs
	PageBuf>>PD.padding=pad
	(PageBuf+PDlen)>>PD.pstart=pgs
	WriteBlock(OutputStream,PageBuf,256)
	]

and WriteDocDir(nw,pad,fnam) be [

	let ddtbl=table [ Presspassword; 0; 2; 0; 1; -1; -1; -1; 1; 1 ]
	Zero(PageBuf,256)
	MoveBlock(PageBuf,ddtbl,10)
	let pgs=(nw+pad) rshift 8
	PageBuf>>DDV.nrecs=pgs+3
	PageBuf>>DDV.pdstart=pgs+1
	MoveBlock(lv PageBuf>>DDV.FileStr,fnam,size DDV.FileStr/16)
	MoveBlock(lv PageBuf>>DDV.CreatStr,UserName,UserName!-1)
	WriteBlock(OutputStream,PageBuf,256)
	]