//R E A D P R E S S
// program to read press file, and report contents back to user
// ReadPress/F puts output on file as well (ReadPress.Lst)
//Bldr readpress readops gp 	
// Copyright Xerox Corporation 1979

//outgoing procedures	(for readops)
external [
	GetByte;GetWord;OddByte;GetReset;DLEven
	Show;Shown;Showch;ShowFloat;Error
	DoubleCop; DoubleSub; MulFull; DoubleShr
	]

//incoming procedures
external [
	SetupReadParam;ReadParam	//from gp
	
//PrintFloat
	PrintFloat

//Readops
	ReadObject;ReadPart
	]

// OS procedures
external [
	OpenFile
	ReadBlock
	SetFilePos
	FileLength
	Puts
	Gets
	Closes

	CreateDisplayStream
	ShowDisplayStream
	GetFixed
	Wns
	Wss
	DoubleAdd
	keys
	]

//outgoing statics
external [
	PressFile
	]
static [
	PressFile
	MyDsp;LinesPrinted;PWord;PByte
	ListFile
	]

//internal manifest and structure declarations
manifest [
	NUMLINES=40
	Presspassword=27183	// Press password
	]

// Structures
structure str:
	[
	n byte
	ch^1,255 byte
	]

structure
	[
	lh	byte
	rh	byte
	]


// DDV used to access PRddir -- PR file document directory
structure DDV: //used to access PRddir -- PR file document directory
 [	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
 ]
manifest DDVlen=size DDV/16 

// PD used to read page directory info

structure PD: //used to read page directory info
 [	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

structure PDV: //for storing stuff about part directory
 [	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

structure FE: //used to read Font Directory entries
 [	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

structure ET: //used to access Entity Trailer
 [	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 [ ETlen=size ET/16 ]

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

let start() be
 [
	let str=vec 30; let sw=vec 26
	SetupReadParam(str, sw)
	if sw!0 ne 0 & ((sw!1 eq $F)%(sw!1 eq $f)) then
		[
		ListFile=OpenFile("ReadPress.Lst",0,1)
		]
	PressFile=ReadParam("IW","Press file name -- ")

	let MyDspSize=30*14*30
	MyDsp=CreateDisplayStream(NUMLINES,GetFixed(MyDspSize),MyDspSize)
	ShowDisplayStream(MyDsp)
	LinesPrinted=0

	let end=vec 1
	FileLength(PressFile,end)
	if (end!1&#777) ne 0 then
		Error("Illegal Press file: file does not end on page boundary")

	let doc=vec 1
	let page=vec 1;page!0=0;page!1=256*2
	DoubleCop(doc,end)
	DoubleSub(doc,page)
	Show("Document directory:*n")
	SetFilePos(PressFile,doc)
	let docDir=vec 256
	ReadBlock(PressFile,docDir,256)

	Show("   Password ")
	let pass=docDir!0
	test pass eq Presspassword then Show("OK*N")
	 or [ Show("illegal (=");Shown(pass);Show(")*n")]
	let numRecs=docDir!1
	Show("   Number of records: ");Shown(numRecs)
	for i=1 to 9 do DoubleShr(doc)
	let realRecLen=doc!1+1
	if realRecLen ne numRecs then	//Wrong
	 [ Show("  WRONG! Correct number is ");Shown(realRecLen)]
	let numParts=docDir!2
	Show("*n   Number of parts: ");Shown(numParts)
	let partStart=docDir!3
	Show("*n   Part directory starts in record ");Shown(partStart)
	let partLen=docDir!4
	Show("*n   Part directory length (in records) ");Shown(partLen)
	Show("*n   First copy ");Shown(docDir!8)
	Show("*n   Last copy ");Shown(docDir!9)
	Show("*n   File name: ");Show(docDir+#200)
	Show("*n   Creator's name: ");Show(docDir+#232)
	Show("*n   Creation date: ");Show(docDir+#252)
	Show("*n")

	let partStartv=vec 1
	MulFull(partStart,512,partStartv)

	SetFilePos(PressFile,partStartv)
	let parts=GetFixed(4*numParts)
	ReadBlock(PressFile,parts,4*numParts)
	for i=0 to (numParts-1)*4 by 4 do
	if parts!i eq 1 then ReadFont(parts+i)

	for i=1 to numParts do
	 [
		SetFilePos(PressFile,partStartv)
		ReadPart(i)
	 ]

	test ListFile then Closes(ListFile) or
		[
		Show("*n*nHit any character to finish*n")
		Gets(keys)
		]
 ]


and ReadFont(PartDir) be
 [
	let fontDir=vec 1
	MulFull(PartDir!1,512,fontDir)
	SetFilePos(PressFile,fontDir)
	let entrylen=Gets(PressFile)
	GetReset()
	Show("*nFont Directory*n")
	until entrylen eq 0 do
		[
		Show("*n   Set: ");Shown(GetByte())
		Show("*n   Font-no: ");Shown(GetByte())
		Show("*n   m: ");Shown(GetByte())
		let n=GetByte()
		Show("*n   n: ");Shown(n)
		let fam=vec 10
		fam!0=Gets(PressFile)
		test n eq #377 & fam!0 eq 0 then //special format
			ReadObject(entrylen-4) or
			[
			ReadBlock(PressFile,fam+1,9)
			Show("*n   Family name: ");Show(fam)
			Show("*n   Face: ");Shown(GetByte())
			Show("*n   Source: ");Shown(GetByte())
			Show("*n   Size: ");Shown(Gets(PressFile))
			Show("*n   Rotation: ");Shown(Gets(PressFile))
			Show("*n")
			]
		entrylen=Gets(PressFile)
		]
 ]
	

and GetReset() be PByte=0

and OddByte() = (PByte ne 0)

and GetByte() = valof
 [
	if PByte eq 0 then 
		[
		PWord=Gets(PressFile)
		PByte=1
		resultis PWord<<lh
		]
	PByte=0
	resultis PWord<<rh
 ]

and GetWord() = (GetByte() lshift 8)+GetByte()

and DoubleCop(a, b) be
[
	a!0=b!0; a!1=b!1
]

and DoubleSub(a, b) be
[
	let c=vec 2
	c!0=not b!0; c!1=not b!1
	DoubleAdd(c, table [ 0;1 ] )
	DoubleAdd(a, c)
]

and DoubleShr(a) be
[
	a!1=(a!1 rshift 1)+(a!0 lshift 15)
	a!0=a!0 rshift 1
]

and MulFull(a, b, lvres) be
[
	let m=vec 1; m!0=0; m!1=a
	DoubleCop(lvres, table [ 0;0 ] )
	while b ne 0 do
		[
		if (b&1) ne 0 then DoubleAdd(lvres, m)
		DoubleAdd(m, m)
		b=b rshift 1
		]
]


and Show(s,count;numargs n) be
[
	if n eq 1 then count=s>>str.n
	for i=1 to count do
		[
		let ch=s>>str.ch^i
		Puts(MyDsp, ch)
		if ListFile then Puts(ListFile, ch)
		if ch eq $*n & ListFile eq 0 then
			[
			LinesPrinted=LinesPrinted+1
			if LinesPrinted ge (NUMLINES-1) then
				[
				Wss(MyDsp,"More?")
				let ch=Gets(keys)
				LinesPrinted=0
				if (ch eq $n)%(ch eq $N) then 
				 [ if ListFile then Closes(ListFile);finish
				 ]
				Wss(MyDsp,"  Yes*n")
				]
			]
		]
]

and ShowFloat(AC) be
 [ PrintFloat(MyDsp,AC)
   if ListFile then PrintFloat(ListFile,AC)
 ]

and Showch(c) be
[
	let a=vec 1
	a>>str.n=1; a>>str.ch^1=c
	Show(a)
]

and Shown(n, rad;numargs na) be
[
	if na ne 2 then rad=-10
	Wns(MyDsp, n, rad)
	if ListFile then Wns(ListFile, n, rad)
]

and Error(s) be
[
	Show(s)
	if ListFile then Closes(ListFile)
	Show("*n Hit any key to finish")
	Gets(keys)
	finish
]

and DLEven() be
[
	if OddByte() then Show("*n ERROR -- DL has odd byte count for object or dots ")
]