// S C A N
//  errors 800
//
// ScanPressPage(pDoc, page, part)
// ScanBreakPage(pDoc, page, pass)
//

get "Spruce.d"
get "sprucefiles.d"
get "PressFile.d"

// outgoing procedures
external
	[
	ScanPressPage
	ScanBreakPage
	]

// incoming procedures
external
	[
//SHOW
	ShowCharacters
	ShowCharactersImmediate
	ShowRectangle
	ShowX
	ShowY
	ShowXY
	ShowCharSet
	ShowCharFont
	ShowCharSetSpace
	ShowOnCopy
	ShowDots
	FSGetRelease

//WINDOW
	WindowRead
	WindowReadBlock
	WindowReadByte
	WindowSetPosition

//PARTS
	SetPartBounds
	SetPositioninPart
	SetBytePositioninPart
	GetPositioninPart
	SkipinPart

//SPRUCE
	SpruceError
	SpruceCondition
	DblShift
	FSGetX
	FSGet
	FSPut
	DisableComments
	ChooseMailboxBin

//SPRUCEML
	DoubleAdd; DoubleSub; DoubleCop
	TGr

//OS
	MoveBlock
	SetBlock; Zero
	]

// incoming statics
external
	[
	printerName
	printerDevice
	breakPage
	printDateString
	Version; MinorVersion; SpruceVersion; SpruceMinorVersion

	Capabilities
	comments
	commentFree
	LogoText
	numComments
	BinSerials
	]

// internal statics
static
	[
	Entity
	]

// File-wide structure and manifest declarations.

structure EHC :			//EH + some stuff
[
	@EH
	next	word			//Pointer to next entity
	ELCPos	word 2		//Part pos of entity commands
]

// Procedures

let ScanPressPage(pDoc, page, part) be
[
	let EL=pDoc>>DocG.EL
	let DL=pDoc>>DocG.DL

	let frec=part>>PE.pStart	//First record
	let nrec=part>>PE.pRecs
	SetPartBounds(EL, frec, nrec)	//Limit the EL
	SetPartBounds(DL, frec, nrec)

	let t=vec 1
	t!0=0; t!1=nrec
	DblShift(t,-LogPressRecordSize)	//Length of page part
	let s=vec 1
	s!0=0; s!1=part>>PE.Padding+1	//Prepare to read length entry
	DoubleSub(t,s)			// t is pos in part
	SetPositioninPart(EL,t)

//Now read all entities
	let Elist=0
		[
		let Elen=vec 1
		Elen!0=0; Elen!1=WindowRead(EL)
		if Elen!1 eq 0 then break	//Last entity has length 0

		let c=vec 1
		GetPositioninPart(EL,c)	// c => just beyond entity

		let p=FSGetRelease(size EHC/16)
		p>>EHC.next=Elist		//Chain new one on list
		Elist=p

		let d=vec 1
		DoubleCop(d,c)
		DoubleSub(d,table [ 0;size EH/16 ]) // d => beginning of EH
		SetPositioninPart(EL,d)	//At beginning of EH
		WindowReadBlock(EL,p,size EH/16) //Read EH

		DoubleSub(c,Elen)		// c is head of entity commands
		DoubleCop(lv p>>EHC.ELCPos,c)	//Save it

		DoubleSub(c, table [ 0;1 ])	//Next length position
		SetPositioninPart(EL,c)
	  ] repeat

//Process all entities in order
	while Elist do
		[
		SetPositioninPart(EL,lv Elist>>EHC.ELCPos)
		ShowEntity(Elist, EL, DL)		//Go interpret the entity
		let n=Elist>>EHC.next
		FSPut(Elist)
		Elist=n
		]
]
and ShowEntity(e, EL, DL) be
 [
	let alternativeDone = false	// true after have done one, before <alt 0> seen
	let fileCode = EL>>SS.spruceFile>>SPruceFile.fileCode
	Entity=e

//Set up for reading DL for this entity
	SetBytePositioninPart(DL,lv e>>EH.Dstart)	//Position DL

//Coordinate defaults
	ShowXY(e>>EH.Xe, e>>EH.Ye)

//Font defaults
	ShowCharSet(e>>EH.Fontset)	//Set
	ShowCharFont(0)

//Reset-space
	ShowCharSetSpace(0)

	let ByteCount=-(e>>EH.Length-(size EH/16))*2
//	 if (ByteCount & #140000) then SpruceCondition(803, ECFileTerminate, fileCode)
//		ByteCount = -(ByteCount*2)

while ByteCount ls 0 do
	[
	let Com=WindowReadByte(EL); ByteCount=ByteCount+1
	test Com le EShortMax then

switchon Com rshift 3 into
[
//Show characters short: Com is # of characters - 1
case EShowShort/8:
case EShowShort/8+1:
case EShowShort/8+2:
case EShowShort/8+3:
	ShowCharacters(DL, Com+1)
	endcase

//Skip characters short: Com&#37 is #of characters - 1
case ESkipShort/8:
case ESkipShort/8+1:
case ESkipShort/8+2:
case ESkipShort/8+3:
	for ch=1 to (Com&#37)+1 do WindowReadByte(DL)
   endcase

//Show characters and skip one: Com&#37 is number-1
case EShowSkip/8:
case EShowSkip/8+1:
case EShowSkip/8+2:
case EShowSkip/8+3:
	ShowCharacters(DL, (Com&#37)+1)
	WindowReadByte(DL)
	endcase

//Set space x&y short: (Com+new byte)&#17777 is length
case ESpaceXShort/8:
case ESpaceYShort/8:
	[
	ByteCount=ByteCount+1
	let oth=WindowReadByte(EL)
	oth=oth+(Com&3) lshift 8
	ShowCharSetSpace( (((Com rshift 3) eq ESpaceXShort/8)? 1,2),oth)
	]
	endcase

//Font change
case EFont/8:
case EFont/8+1:
	ShowCharFont(Com&#17)
	endcase
default: endcase
]
or switchon Com into
[
//OnlyOnCopy: next byte is copy number
case EOnlyOnCopy:
	[
	ByteCount=ByteCount+1
	ShowOnCopy(WindowReadByte(EL))
	]
	endcase

//Set x: next word is new x as signed integer
case ESetX:
	ShowX(e>>EH.Xe+WindowRead(EL))
	ByteCount=ByteCount+2
	endcase

//Set y: neyt word is new y as signed integer
case ESetY:
	ShowY(e>>EH.Ye+WindowRead(EL))
	ByteCount=ByteCount+2
	endcase

//Show characters: next entity byte is # of characters
case EShow:
	ShowCharacters(DL, WindowReadByte(EL))
	ByteCount=ByteCount+1
	endcase

//Skip characters: next entity byte is number
case ESkip:
	SkipinPart(DL,0,WindowReadByte(EL))
	ByteCount=ByteCount+1
	endcase

//Skip control bytes: skip next three bytes
case ESkipControl:
	SkipinPart(DL,0,WindowRead(EL))
	WindowReadByte(EL)		//Type of control info
	ByteCount=ByteCount+3
	endcase

//Skip control bytes immediate: skip in EL
case ESkipControlImmediate:
	[
	let dist = WindowReadByte(EL)
	SkipinPart(EL, 0, dist)
	ByteCount = ByteCount+dist+1
	endcase
	]

//Alternative: like Skip control byte, ditto immediate unless this is first acceptable alternative
case EAlternative:
	[
	let mask, elB, elB1, dlB, dlB1 = nil, nil, nil, nil, nil
	WindowReadBlock(EL, lv mask, 5) // 10 bytes
	ByteCount = ByteCount+10
	test mask eq 0 % alternativeDone % (mask&CanDoMask) ne mask then
		[ // skip
		SkipinPart(EL, 0, elB1) // Assume single precision!!! ~~
		ByteCount = ByteCount+elB1 // ~~ for this reason!!
		SkipinPart(DL, 3, lv dlB) // No such assumption for DL -- could be dots
		unless mask do alternativeDone = false // end of alternative group
		]
	  or alternativeDone = true // and now do the alternative!
	endcase
	]

//Show character immediate
case EShowImmediate:
	[
	let x=WindowReadByte(EL)
	ByteCount=ByteCount+1
	ShowCharactersImmediate(lv x, 1, 2)
	]
	endcase

//Set space x
case ESpaceX:
	ShowCharSetSpace(1,WindowRead(EL))
	ByteCount=ByteCount+2
	endcase

//Set space y
case ESpaceY:
	ShowCharSetSpace(2,WindowRead(EL))
	ByteCount=ByteCount+2
	endcase

//Reset-space
case EResetSpace:
	ShowCharSetSpace(4)
	ShowCharSetSpace(0)
	endcase

//Space
case ESpace:
	[
	let x=40b
	ShowCharactersImmediate(lv x, 1, 2)
	]
	endcase

//Brightness, hue and saturation not yet implemented
case ESetBright:
case ESetHue:
case ESetSat:
	WindowReadByte(EL)
	ByteCount=ByteCount+1
	SpruceCondition(805, ECWarning, fileCode)
	endcase

//Show object
case EShowObject:
	[
	let n=WindowRead(EL)
	ByteCount=ByteCount+2
	SkipinPart(DL, 1, n)
	SpruceCondition(806, ECWarning, fileCode)
	]
	endcase

//Show dots (two flavors)
case EShowDots:
case EShowDotsOpaque:
	[
	let c=vec 1
	c!0=WindowRead(EL)
	c!1=WindowRead(EL)
	ByteCount=ByteCount+4
	if Com eq EShowDots then [ ShowDots(DL, c, false); endcase ]
	// opaque not supported
	SkipinPart(DL, 2, c)
	SpruceCondition(807, ECWarning, fileCode)
	]
	endcase

//Show rectangle (rule)
case EShowRectangle:
	ShowRectangle(WindowRead(EL),
		WindowRead(EL))
	ByteCount=ByteCount+4
	endcase

//Nop
case ENop:
	endcase
default:
	SpruceCondition(801, ECFileTerminate, fileCode)
	endcase
]				//switchon
]					//while loop

	if ByteCount ne 0 then SpruceCondition(802, ECFileTerminate, fileCode)
	ShowCharSetSpace(4)			//Put widths back in font
	ShowOnCopy(0)				//Clear conditioning
 ]
// Break-page maker

// For three color and four color printers, create three (or four) color separated images.
// On three-color printers, black is the sum of all three toners;  on the four-color puffin there
// is a black developer housing.  On black printers, this routine returns unless it is the first pass.

and ScanBreakPage(pDoc, page, pass) be
[
manifest [
	textLeft=30; textFirst=70; textSpace=4

	commentLeft = 15; commentFirst = textFirst - 8*textSpace; commentSpace = 2

	logoLeft = 15; logoRight = 60; logoTop = 95; logoBottom = 10
	]
	let blackPass, magentaPass, yellowPass, cyanPass = true, true, true, true
	test breakPage eq 1  ifso
		[
		if pass ne 1 return
		]
	ifnot
		[
		magentaPass = pass eq 1
		yellowPass = pass eq 2
		cyanPass = pass eq 3
		if breakPage eq 4 do blackPass = pass eq 4   // for threecolor all passes are black
		]
	let f = commentFree		// Temporarily disable comment entries
	DisableComments()

	ShowCharSetSpace(0)
	ShowCharSet(64)		// Font set reserved for break page
	ShowCharFont(0)		// Normal printing
if blackPass do
	[
	BreakString("Printer ", textLeft, textFirst)
	BreakString(printerName)
	BreakString("Spruce version ", textLeft, textFirst-textSpace)
	BreakNumber(Version)
	BreakString(".")
	BreakNumber(MinorVersion)
	BreakString(" -- spooler version ")
	BreakNumber(SpruceVersion)
	BreakString(".")
	BreakNumber(SpruceMinorVersion)
	]
if blackPass % cyanPass do BreakString("File: ", textLeft, textFirst-3*textSpace)
if cyanPass do 	BreakString(lv pDoc>>DocG.FileStr)
if blackPass do
	[
	BreakString("Creation date: ", textLeft, textFirst-4*textSpace)
	BreakString(lv pDoc>>DocG.DateStr)
	BreakString("Printing date: ", textLeft, textFirst-5*textSpace)
	BreakString(printDateString)
	]
if blackPass % magentaPass % yellowPass do  BreakString("For: ", textLeft, textFirst-6*textSpace)
if magentaPass % yellowPass do 	BreakString(lv pDoc>>DocG.CreatStr)
if blackPass do
	[
	if (lv pDoc>>DocG.ByStr)>>STR.length ne 0 do 
		[
		BreakString("  By: ")
		BreakString(lv pDoc>>DocG.ByStr)
		]
	BreakString("", textLeft, textFirst-7*textSpace)
	 let p=(pDoc>>DocG.nPages-breakPage)/breakPage
	 let c=pDoc>>DocG.nCopies
	 let s = p
	if pDoc>>DocG.duplex then s= (p + 1)/2
	 BreakNumber(s*c+1)
	 BreakString(" total sheets = ")
	 BreakNumber(p)
	 BreakString((p eq s? ( p eq 1? " page, ", " pages, "), (p eq 1? " side, ", " sides, ")))
	 BreakNumber(c)
	 BreakString((c eq 1? " copy.", " copies."))

	if numComments then for i = 0 to numComments do
		[
		let comment = comments!i
		unless comment loop
		BreakString(comments+comment, commentLeft, commentFirst-i*commentSpace)
		]
	//Now sprinkle top of break page with first letter of "For" name
	let p=lv pDoc>>DocG.CreatStr
	let s=vec 2
	s>>STR.length=2
	let firstChar=p>>STR.char^1
	s>>STR.char^1=(firstChar ge $a)? firstChar-$a+$A,firstChar
	s>>STR.char^2=$*s
	BreakString(s,12,100)
	for i=0 to 5 do BreakString(s)
	BreakString(p,42,100)
	test (Capabilities & mMailbox) eq 0 
	  ifso 	[
		BreakTwoDigits(BinSerials!0,35,85)
		]
	  ifnot	[
		ShowOnCopy(1011)  //1011 is  mailbox half of split output
		BreakString("MORE IN OVERFLOW BIN", textLeft, commentFirst-(numComments + 1)*commentSpace)
		BreakTwoDigits(BinSerials!(ChooseMailboxBin(firstChar)),35,85)
		ShowOnCopy(1012) //1012 is overflow half of split output
		BreakString("MORE IN MAILBOX", textLeft, commentFirst-(numComments + 1)*commentSpace)
		BreakTwoDigits(BinSerials!0,35,85)
		ShowOnCopy(1001)  //1001 is pure mailbox output
		BreakTwoDigits(BinSerials!(ChooseMailboxBin(firstChar)),35,85)
		ShowOnCopy(1002)  //1002 is pure overflow output
		BreakTwoDigits(BinSerials!0,35,85)
		ShowOnCopy(0)
		]
	if (Capabilities & mDuplex) ne 0 do   //believed to be archaic and unused!!
		[
		ShowOnCopy(1003)
		BreakString("Probable two-sided print problem", textLeft, commentFirst-(numComments + 1)*commentSpace)
		ShowOnCopy(0)
		]
	]  //end of "if black pass"
// Now pepper the logo around...
	ShowCharFont(1)
	if cyanPass do for x=0 to 1 do for y=0 to 1 do
		BreakString(LogoText, logoLeft+x*(logoRight-logoLeft),
			logoBottom+y*(logoTop-logoBottom))

// And print some strong vertical lines for easy identification:
	// Red
if magentaPass % yellowPass do for x= 2 to 76 by 74 do for y=4 to 78 by 37 do
		[
		for j=0 to 6 by 2 do
			[
			ShowXY((x+j)*254, y*254)		// x=
			ShowRectangle(254, 28*254)		// 
			]
		]
	commentFree = f		// reenable comments if were enabled before
]

and BreakString(str, x, y; numargs n) be
[
	if n ne 1 then ShowXY(x*254, y*254)	// x,y in tenths of inches
    // any errors rendering these strings will be ignored
	let len = str>>STR.length
	ShowCharactersImmediate(str, 1, len+1)
]

and BreakNumber(n) be
[
	let nn=n/10
	if nn then BreakNumber(nn)
	nn=(n rem 10)+$0+400b
	BreakString(lv nn)
]

and BreakTwoDigits(n,x,y) be
[
	let s=vec 1
	s!0=1000b+((n/10)+$0)
	s!1=((n rem 10)+$0) lshift 8
	BreakString(s,x,y)
]

// DCS, ,July 27, 1977  10:42 PM minor mods (WindowRead2Bytes -> WindowRead (!))
// September 30, 1977  12:32 AM, implement ShowDots (not opaque tho)
// October 3, 1977  6:46 AM, handle three-color break page
// October 10, 1977  2:52 PM, add "Version", externally settable
// December 16, 1977  11:23 AM, narrower spacing between comments
// January 20, 1978  4:43 PM, remove PimlicoAlt
// January 20, 1978  5:34 PM, disable Durango
// May 15, 1978  10:08 PM, be less paternalistic about errors in BreakString
// June 7, 1978  9:40 PM, add skipcontrolbytesimmediate, alternative features
// June 14, 1978  8:43 PM, repair DL skip in alternative
// July 31, 1978  11:38 PM, make break page verticals .1" shorter to avoid breakup
// September 14, 1978  5:25 PM, add printer name, new version stuff
// October 3, 1978  5:20 PM, new calling sequence to ShowCharacters . . . for fast (mu) inner loop
// October 16, 1978 1:18 PM, puffin turned on - BWB
// December 6, 1978  11:46 AM  add Penguin, use Capabilities to select nBreaks
// March 7, 1979  1:56 PM make four color break pages
// May 22, 1979  12:18 PM fix break page maker
// August 1, 1979  3:18 PM, mBlack became mBlackHousing ??!!
// August 5, 1979  7:44 AM, add "By" to break page and correct sheet count for twosided print
// August 7, 1979  2:49 PM, fix same
// August 24, 1979  1:53 PM, add ShowOnCopy stuff for Penguin print-time break page messages
// September 24, 1979  10:21 AM, remove log and proprietary stuff from breakpage
// November 18, 1979  9:49 PM, add logo text from user.cm
// January 18, 1980  12:11 PM, decide number of sheets from DocG.duplex
// May 9, 1980, 4:15 PM, check size of entity list in ShowEntity. error 803
//July 16, 1980,4:21 PM use breakPage for count of images on break page
// January 28, 1981, 12:30 PM, added  Sproull mods to break page
// February 2, 1981  5:07 PM,  begin to implement break page design by Stu Card
// February 2, 1981  11:00 PM,  change the bars a little
// February 5, 1981  11:16 AM,  first cut at BinSerials handling
// February 5, 1981  5:18 PM,  break up error 800 into 805-808