// pressfinfo.sr
// Bcpl pressfinfo.sr

// last modified
// RML August 18, 1977  10:16 PM - created
// RML September 23, 1977  11:56 AM - add 3 color, first iteration
// RML September 28, 1977  7:59 PM first try at highlighting
// RML September 29, 1977  10:09 AM highlighting bug fix
// RML October 1, 1977  11:10 AM cosmetic highlight changes
// RML October 3, 1977  9:45 AM combine underlining and highlighting.
// RML October 7, 1977  1:09 PM bugs, underlining and highlighting.
// RML October 27, 1977  6:02 PM fix inconsistancy in widths between fonts.widths and font.press
// RML November 8, 1977  5:39 PM Improve press font handling
// RML November 22, 1977  10:04 AM change SetXXX to pressSetOp
// RML November 22, 1977  5:53 PM fix paren bug
// RML November 23, 1977  9:15 AM really fix paren bug!
// RML April 16, 1978  2:46 PM single page color Press file

// Last modified September 25, 1982  3:19 PM by Taft

get "BRAVO1.DF";
get "CHAR.DF";
get "MSG.DF";
get "Q.DF";
get "ALTOFILESYS.D";
get "PRESS.DF";
get "COM.DF";
get "RN1.DF";
get "ST.DF";
get "PCOLOR.DF"


// Incoming Procedures

external	[
	EvenByte
	PutChar
	pressHighlight	//************************
	pressSetColor
	pressSetOp
	pressShowChars
	pressSetSpaceX
	pressUnderline
	updateEtFrame
	pressXpdBorder
	wrapupEntity
	ratio
	assignfe
	assignfs
	array
	errhlta
	setmpfefactive
	abs
	ugt
	movec
	resetmpfunfafe
	MakeFileId
	RealDA
	ActOnPages
	WritePages
	PressInitPutting
	WriteBufs
	SetVab
	];


// Incoming Statics

external	[
	mpcuncatt	// map color unique name to color attributes
	Dl
	El
	Pd
	rgfinfo
	notColoring
	fColor
	vmaccr
	msgtbl
	vpep
	vfc
	mpfunfd
	fsncur
	mpfsnfs
	rgxw
	dnbp
	fillInDA
	DCread
	macfsn
	pgnFirst
	vPress
	];


// Outgoing Procedures

external	[
	finfoToPress;
	PressInitTranslate
	];


// Outgoing Statics

external	[
	lastColor
	mpfunfafe;
	vfe;
	]

static	[
	lastColor
	mpfunfafe;
	vfe;
	] 

structure FD:
	[
	maxmagi	word;
	bangminus1	word;
	rvrgfdd		word;
	]

structure FDH:
	[
	rvmpfargcc	word;
	blank		word;
	blank		word;
	blank		word;
	rvmpfafunfadef	word;
	blank		word;
	blank		word;
	blank		word;
	ampFaLrec2	word;
	blank		word;
	blank		word;
	blank		word;
	height		word;
	bl		word;
	xwmax		word
	rvsbname	word;
	]


// Local manifests

manifest	[
	funfanil = -1
	maxfun	= 11		// in font.df
	fdnil = 0		// in font.df
	pidCpError = 6
	pidCrError = 7
 	];



// F I N F O   T O   P R E S S
//
let finfoToPress(fm, cp, xFirst, xLast, y) = valof
[
let newfun, newofset = nil, nil;
let widthch = nil;
let fa, newfa = -1, nil;
let fe = nil;
let cchPgbrk = 0;
let tfun = -1;
let fefirst = fenil
let twidthmax = nil
let underlining = 0

let cShow = 0

let fmsg = msgtbl;
let xCurrent = xFirst
let xRunStart = nil

let tchremain = 0;
let delta = 0
let ofset = 0
let firstSpace = true	

let changePending = false

//let lastColor = cBlackx	// shouldn't this guy be global???

let ptr = lv vPress ! vPressX 
ptr >> vPRESS.value = -1
ptr >> vPRESS.State = false

pressSetOp(vPressX, xCurrent)
pressSetOp(vPressY, y)

updateEtFrame(xFirst, xLast, y)

if ((rgfinfo ! (vmaccr-1))<<FINFO.char eq chcr) then
	vmaccr = vmaccr-1
let tlast = vmaccr
while vmaccr gr 0 do 	// This may get worse, later!
	[
	unless 	((rgfinfo ! (vmaccr-1))<<FINFO.char eq chsp) do break
	vmaccr = vmaccr-1
	]

if vmaccr ls 1 then
	[	// preserve something
	vmaccr = tlast
	]

for cr = 0 to vmaccr-1 do	// for each character
	[
	let finfo = rgfinfo ! cr;
	let ch = finfo<<FINFO.char
	let dx = rgxw ! cr

	if finfo<<FINFO.newmsg % ch eq $*T % changePending then	// something changed
		[			// look at Looks
		changePending = false
		if finfo<<FINFO.newmsg then
			[
			fmsg = fmsg+2;
			if fmsg ! 0 eq -1 then
				break;
			if (fmsg>>FMSG.look1)<<LOOK1.vanish then
				[
				// non-printing-what does this mean ?
				// np in the sense that there is no
				//	graphic-but put there by
				//	the user-and thus takes up
				//	space in the line, OR
				// np in the sense that it is some
				//	sort of control char-hence
				//	no line space
	
				// choosing latter for now
				loop
				]
			]

			// Color goodies
		let tColor = ch eq $*T? cBlackx, (fmsg>>FMSG.look2)<<LOOK2.tc
		unless lastColor eq tColor do
			[ // Have to do highlighting first,
 			  // because of the way Press and the
			  // printers work.
			if underlining then
				[
				((lastColor eq cBlackx) % notColoring ? pressUnderline, pressHighlight)  (xRunStart, xCurrent,y, lastColor)
				underlining = 0
				pressSetColor(cBlackx)
				]
			pressShowChars(cShow)
			cShow = 0

			pressSetColor(tColor)	// later !
			lastColor = tColor
			fColor = fColor % lastColor
			] 

			// Font change
		newfun = (fmsg>>FMSG.look2)<<LOOK2.fun;
		if mpfunfd!newfun eq fdnil then
			newfun = 0  // undefined font, substitute font 0
		newfa = (fmsg>>FMSG.look1)<<LOOK1.modchar

		if (tfun ne newfun) % (fa ne newfa) then
			[	// font change
			if underlining then
				[
				((lastColor eq cBlackx) % notColoring ? pressUnderline, pressHighlight)  (xRunStart, xCurrent,y, lastColor)
				underlining = 0
				pressSetColor(cBlackx)
				]
			pressShowChars(cShow)
			cShow = 0

			let tfunfa = newfun lshift 2 + newfa
			tfun = newfun;
			fa = newfa;
			let fd = mpfunfd ! tfun
			let fdh = lv fd>>FD.rvrgfdd + fd>>FD.maxmagi
			twidthmax = fdh>>FDH.xwmax 
			fe = mpfunfafe ! tfunfa;
			if fe eq fenil then
				[  // Hasn't occured before
				fe = assignfe(fsncur, tfun, fa);
				]
			if fe eq fenil then	// Different font set
				[
				unless fsncur le fsndef do
					[
					EvenByte(Dl)
					wrapupEntity(fsncur)
				// Initialize for next entity
					pressSetOp(vPressX, xCurrent)
					pressSetOp(vPressY, y)
					pressSetColor(lastColor)
					]
				fsncur = assignfs(fsncur, tfun, fa, array);
				if fsncur eq fsnnil then 
					[
//				as above
					if cp eq cpnil then
						[ cp = 0; cr = 0; ]
					fm ! pidCpError = cp
					fm ! pidCrError = cr
					resultis 2
					]
				fe = mpfunfafe ! tfunfa;
				if fe eq fenil then
					errhlta(182);
				]
			if fefirst eq fenil then fefirst = fe
			setmpfefactive(mpfsnfs ! fsncur, fe)
			pressSetOp(vPressFont, fe)

			if tfun eq maxfun+2 then
			 // Private Data Stamp
				[ // triggered by seeing 
				  // keyhole font
				PutChar(ch,Dl)
				unless notColoring do
					fColor = fColor % cRedx
				pressSetColor(cRedx)
				pressShowChars(1)
					// Don't ask !
				pressXpdBorder(xFirst-270,y+130)
				loop
				]
			]	// end font futz

		newofset = (fmsg>>FMSG.look2)<<LOOK2.ofset;
		if newofset<<LOOK2.ofsetsgn then
			newofset = newofset % ofsetsgnext;
		if ofset ne newofset then
			[	// change y-offset
			ofset = newofset;
			delta = ratio(abs(ofset), pttomicamlt, pttomicadiv);
			if ofset ls 0 then delta = -delta
			if underlining then
				[
				((lastColor eq cBlackx) % notColoring ? pressUnderline, pressHighlight)  (xRunStart, xCurrent,y, lastColor)
				underlining = 0
				pressSetColor(cBlackx)
				]
			pressShowChars(cShow)
			cShow = 0

			pressSetOp(vPressY, y+delta)
			]
		]	// end NEWMSG



	unless underlining eq  finfo<<FINFO.lowbar do
		[
		test underlining ifso
			// at this point, have handled underlining and color change - see color , above.
			[ // stopping 
			((lastColor eq cBlackx) % notColoring ? pressUnderline, pressHighlight)  (xRunStart, xCurrent,y, lastColor)
			pressSetColor(cBlackx)
			pressShowChars(cShow)
			cShow = 0

			pressSetColor(lastColor)
			]
		ifnot	[ // starting
			pressShowChars(cShow)
			cShow = 0
			]
		xRunStart = xCurrent
		underlining = finfo<<FINFO.lowbar
		]

	if ch eq $*T then 
		[
		// non-printing
		if underlining then
			[
			((lastColor eq cBlackx) % notColoring ? pressUnderline, pressHighlight)  (xRunStart, xCurrent+dx,y, lastColor)
			xRunStart = xCurrent+dx	// ???
			pressSetColor(cBlackx)
			]
		pressShowChars(cShow)
		cShow = 0

		xCurrent = xCurrent + dx
		pressSetOp(vPressX, xCurrent)
		changePending = true
		loop
		]

	if ch eq chsp then
		unless dx eq vPress ! vPressSpace do
			[
			unless firstSpace do
				[
				if underlining then
					[
					((lastColor eq cBlackx) % notColoring ? pressUnderline, pressHighlight)  (xRunStart, xCurrent,y, lastColor)
					xRunStart = xCurrent // ???
					pressSetColor(cBlackx)
					]
				pressShowChars(cShow)
				cShow = 0
				]
			firstSpace = false
			pressSetOp(vPressSpace, dx)
			]

	test ch eq chpgbrk ifso
		cchPgbrk = cchPgbrk + 1;
	ifnot	[
		PutChar(ch, Dl)
		cShow = cShow+1
		]
	xCurrent = xCurrent + dx
	]	// for loop thru line of cr's

if underlining then
	[
	((lastColor eq cBlackx) % notColoring ? 
	pressUnderline , pressHighlight)   (xRunStart, xCurrent,y, lastColor)
	pressSetColor(cBlackx)
	]
pressShowChars(cShow)

vfe = fefirst		// who he ?
resultis cchPgbrk
]


// I N I T T R A N S L A T E
//
and PressInitTranslate(ww, cfaPress) = valof
[
macfsn = 1;
mpfunfafe =array((14)*4); // 14 SHOULD BE MAXFUN BUT NO ROOM FOR DF FILE
mpfsnfs = array(maxfsn);
mpfsnfs ! 0 = array(lnfs)

let fsdef = mpfsnfs ! 0;
let mpfefn = lv(fsdef>>FS.rvmpfefn);
movec(mpfefn, mpfefn+15, fnnil)

let mpfefunfa = lv(fsdef>>FS.rvmpfefunfa);
movec(mpfefunfa, mpfefunfa+15, funfanil)

fsncur = fsndef
(mpfsnfs ! fsncur)>>FS.mpfefactive = 0
resetmpfunfafe(fsncur)

movec(dnbp ! 0, dnbp ! 0 +#377, 0)

let fileId = vec 3;
MakeFileId(fileId, lv cfaPress>>CFA.fp)
let rgda = vec 3; movec(rgda, rgda+2, fillInDA)
rgda ! 0 = RealDA(cfaPress>>CFA.fp.leaderVirtualDa)
ActOnPages(0, rgda, fileId, 0, 1, DCread, 0, 0, dnbp ! 0)

		// this is a very greasy area !!
cfaPress>>CFA.fa.pageNumber = 1	// is this necessary ?
cfaPress>>CFA.fa.da = rgda ! 1
pgnFirst = 1


resultis PressInitPutting(cfaPress,
		 	rgda ! 0,  // daPrev
			rgda ! 1) // daPgn1
]