// 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% is #of characters - 1
case ESkipShort/8:
case ESkipShort/8+1:
case ESkipShort/8+2:
case ESkipShort/8+3:
for ch=1 to (Com%)+1 do WindowReadByte(DL)
endcase
//Show characters and skip one: Com% is number-1
case EShowSkip/8:
case EShowSkip/8+1:
case EShowSkip/8+2:
case EShowSkip/8+3:
ShowCharacters(DL, (Com%)+1)
WindowReadByte(DL)
endcase
//Set space x&y short: (Com+new byte)䕱 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)
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