// PressTranslate.sr
// Bcpl PressTranslate.sr

// last modified
// RML September 23, 1977  4:16 PM - 1st color iteration
// RML September 24, 1977  2:09 PM - mask correction
// RML November 4, 1977  3:04 PM - fix PrintedBy
// RML November 21, 1977  11:15 AM - add vPress
// RML April 18, 1978  6:00 PM go to single page color Press file
// RML April 18, 1978  6:16 PM delete firstTime

// Last modified October 27, 1979  5:04 PM by Taft
// Last modified January 8, 1980  4:49 PM by PCL add color table

get "BRAVO1.DF";
get "Q.DF"
get "MSG.DF";
get "DISPLAY.DF";
get "ALTOFILESYS.D";
get "COM.DF";
get "HARDCOPY.DF"
get "PRESS.DF"
get "PCOLOR.DF"

// Incoming Procedures

external	[
	CpFormatPage
	DlPosition
	doublesub
	endofkeystream
	EvenByte
	finfoToPress
	getchar
	invalidatesel
	move
	movec
	MyFrame
	pressDocumentDirectory
	pressFontDirectory
	PressInitTranslate
	pressSetColor
	PutChar
	PutWds
	QLength
	LengthQ
	selectwholeww
	setsel
	setMpCunCatt
	setupdate
	ult
	WritePressBufs
	];


// Incoming Statics

external	[
	lastColor
	mpWwWwd
	pgnFirst
	vcp
	rgmaccp
	selmain
	macbp
	rgvpa
	rgbs
	rglastused
	dcpendofdoc
	];


// Outgoing Procedures

external	[
	PressTranslate
	wrapupEntity
	];


// Outgoing Statics

external	[
	mpcuncatt	// map color unique name to color attributes

	Dl
	El
	ElTrailer
	fsncur
	notColoring	// true if Color to be overridden
	fColor
	Pd
	vPress
	vcpagehc;
	vframe;
	vlabel
	mpfsnfs;
	vfunfamissing
	vffunfamissing
	vpep
	]; 


// Local Statics

static	[
	beginByteDl
	beginPart		// record number
	beginPartsDirectory	// likewise
	
	fColor
	mpcuncatt	// map color unique name to color attributes
	
	Dl			// ptr's to these  "streams"
	El
	ElTrailer
	fsncur
	notColoring	
	Pd
	recsPartDirectory	// record size, Pd
	vPress
	vcpagehc;
	vframe;
	vlabel
	mpfsnfs;
	vfunfamissing
	vffunfamissing
	vpep
	];




manifest	[
	cpnil	= -1
 	];



// T R A N S L A T E 
//
let PressTranslate(ww, cp, piFirstPrint, fptrPress, ho,
		fNoTrunc) = valof
[
notColoring = ho>>HO.nColor eq 0
fColor = false

//let colorTbl = vec 2*16
let colorTbl = vec 2*32
mpcuncatt = setMpCunCatt(colorTbl)

let x, xState = -1, false
let y, yState = -1, false
let font, fontState = -1, false
let space, spaceState = -1, false
let hue, hueState = 0, false	// set for black
let value, valueState = 0, false
let chroma, chromaState = 0, false
vPress = lv x

let t = vec 1
beginByteDl = t

let cpError = nil		// manifest pidCpError in finfo.sr
let crError = nil		// manifest pidCrError in finfo.sr

let wwd = mpWwWwd ! ww
let doc = wwd>>WWD.doc


let cfaPress = vec lCFA; move(fptrPress, cfaPress, lFP)

vpep = PressInitTranslate(ww, cfaPress)
Dl = lv vpep>>PRESS.aqbufDl
El = lv vpep>>PRESS.aqbufEl
Pd = lv vpep>>PRESS.aqbufPd

vcp = 0		//  not used locally; i.e. in this module
let tcp = nil

let t = vec lElTrailer
ElTrailer = t

let cpMac = rgmaccp ! doc - dcpendofdoc;
vffunfamissing = false


let dpi = -piFirstPrint	// pages to skip
let nParts = 0
vframe = MyFrame()	// in case of abort
vlabel = aborth;
	[
	initPressPart()

	(mpfsnfs ! fsncur) >> FS.mpfefactive = 0;
	cpError = cpnil
	tcp = CpFormatPage(ww, cp, modehc, ho,
		 	piFirstPrint+dpi,
			FPressAbortPage,
		(dpi ls 0 ? 0, finfoToPress), pttomicamlt,
					 pttomicadiv)
	if tcp eq cpnil then
		resultis rtrnfromhc(ww, abComTerm);
	if tcp eq cpnil-1 then
		resultis rtrnfromhc(ww, abmsg);

	if cpError ne cpnil then
		[
		selmain>>SEL.cpfirst = cpError +
				crError
		selmain>>SEL.cplast = cpError + crError
		invalidatesel(selmain)
		wwd>>WWD.cpFDispl = cpError
		setupdate(ww)
		resultis rtrnfromhc(ww, abmsg)
		]

	unless dpi ls 0 do
		nParts = nParts +
			wrapupPressPart(beginPart)
	cp = tcp
	dpi = dpi+1
	] repeatwhile ult(cp, cpMac)

endoftx:

unless dpi gr 0 do
	resultis rtrnfromhc(ww, abBadPage);

ho>>HO.fColor = fColor ne cBlackx
wrapupPressDoc(nParts, ho, fNoTrunc,ww);
vcpagehc = vcpagehc+dpi	//???????????
resultis rtrnfromhc(ww, abnil);

aborth:
resultis rtrnfromhc(ww, abmsg);
]

// R T R N F R O M H C
//
and rtrnfromhc(ww, ab) = valof
[

for bp = 0 to macbp-1 do		//make bufs avail to vmem
	[
	if rgvpa ! bp eq -1 then
		[
		(rgbs ! bp) << BS.dirty = false
		rglastused ! bp = 0
		]
	]

resultis ab;
]


// F A B O R T
//
and FPressAbortPage() = valof
[
if endofkeystream()
	then resultis false;
if getchar() ne #177 then	// del
	resultis false
resultis true;
]



//**********    For Pressery, see    **************//
// Sproull, Bob,and Newman, William; January 26, 1977
// "Press File Format", on <GR-DOCS>Press.Ears
//******************************************//

// I N I T P R E S S P A R T 
//
and initPressPart() be
[	// all else either 0 or filled in by wrapupPressPart
	// may have to be called from within finfoToPress
	// to handle multiple font sets.
	
movec(ElTrailer,ElTrailer+lElTrailer-1,0)
DlPosition(beginByteDl)
move(beginByteDl, lv ElTrailer>>ELTRAILER.beginByte, 2)

beginPart = (lv vpep>>PRESS.acfaCur)>>CFA.fa.pageNumber-pgnFirst

ElTrailer>>ELTRAILER.left = pressMaxX
ElTrailer>>ELTRAILER.bottom  = pressMaxY

pressSetColor(cBlackx)
lastColor = cBlackx
]

// W R A P U P E N T I T Y
//
and wrapupEntity(curfsn) be
[
let tw = vec 1
DlPosition(tw)	// where we are, in bytes

	//******** finish up this Entity ********//
EvenByte(El)
		// Entity Trailer
	
	// length of this Dl
doublesub(tw,lv ElTrailer>>ELTRAILER.beginByte,
	lv ElTrailer>>ELTRAILER.byteLength)

	// offset of this Dl in Part
doublesub(lv ElTrailer>>ELTRAILER.beginByte, beginByteDl,
	lv ElTrailer>>ELTRAILER.beginByte)

ElTrailer>>ELTRAILER.height  = ElTrailer>>ELTRAILER.height - 
ElTrailer>>ELTRAILER.bottom

ElTrailer>>ELTRAILER.fontSet = curfsn

ElTrailer>>ELTRAILER.entityLength = QLength(El)/2 -
	 	ElTrailer>>ELTRAILER.entityLength + 12

for i = 0 to lElTrailer-1 do
	PutWds(ElTrailer!i,El)

	// next Dl starts here
move(tw, lv ElTrailer>>ELTRAILER.beginByte, 2)
	// next El, here
ElTrailer>>ELTRAILER.entityLength = QLength(El)/2

ElTrailer>>ELTRAILER.left = pressMaxX
ElTrailer>>ELTRAILER.bottom = pressMaxY
ElTrailer>>ELTRAILER.width = 0
ElTrailer>>ELTRAILER.height = 0

// reset optimizing variables
for i = 0 to (vPressl rshift 1) -1 by 2 do
	[
	vPress ! i = -1
	vPress ! (i+1) = false
	]
vPress ! vPressHue = 0
vPress ! vPressValue = 0
vPress ! vPressChroma = 0
]

// W R A P U P P R E S S P A R T
//
and wrapupPressPart(firstPagePart) = valof
[	//********* finish up Data list *********//
	// in this implementation, the Data list
	// always occupies an integral number of pages-
	// which is ok, provided the word proceeding
	// entity information proper is zero.
	//********************************//
EvenByte(Dl)	// align Data List

	//******** finish up this Entity ********//
wrapupEntity(fsncur)

PutWds(0,Dl)	// guarantees a 0 as first wd of El
WritePressBufs(Dl,vpep)

let ElPadding = El>>Qelement.remainput/2	// For Pd
WritePressBufs(El,vpep)

	//******* Update Part Directory ********//
PutWds(0,Pd)	// Pd type-printed page
PutWds(firstPagePart,Pd)	// where part starts

let pg = (lv vpep>>PRESS.acfaCur) >>
 	CFA.fa.pageNumber-pgnFirst-firstPagePart
PutWds(pg,Pd)
PutWds(ElPadding,Pd)
		// Bully, eh what !
resultis 1
]

// P R E S S P A R T D I R E C T O R Y
//
and pressPartDirectory() be
[
beginPartsDirectory = 
	(lv vpep>>PRESS.acfaCur)>>CFA.fa.pageNumber-pgnFirst
recsPartDirectory = LengthQ(Pd)
WritePressBufs(Pd,vpep)
]

// W R A P U P P R E S S D O C
//
and wrapupPressDoc(pages,ho,trunc,ww) be
[
pressFontDirectory()
pressPartDirectory()
pressDocumentDirectory(pages, ho, trunc,
	beginPartsDirectory,recsPartDirectory,ww)
	// To wrap up the file
pgnFirst = (lv vpep>>PRESS.acfaCur)>>CFA.fa.pageNumber;
(lv vpep>>PRESS.acfaCur)>>CFA.fa.pageNumber=-1
]

// The end - of pressTranslate.sr