// diablotranslate.sr


get "BRAVO1.DF"
get "CHAR.DF"
get "ST.DF"
get "DISPLAY.DF"
get "VM.DF"
get "COM.DF"
get "HARDCOPY.DF"
get "RN1.DF"
get "DIABLO.DF"


// Outgoing Procedures

external	[
	DiabloTranslate
	]


// Outgoing Statics

// external


// Incoming Procedures

external	[
	endofkeystream
	getchar
	FDiabloInit
	establishfun
// 	setmag
	invalidatewindow
	errhlta
	CpFormatPage
	ult
	MoveX
	SetRegionSys
	stnum
	SetRegionW
	setupdate
	updatedisplay
	bravochar
	FinfoToDiablo
	PositionYd
	]


// Incoming Statics

external	[
	vxwChuldiablo
	vrgcc2
	vxDiablo
	mpWwWwd
	mpfnof
	rgmaccp
	vydDiablo
	vrlwsys
	vxleftmargstd
	dcpendofdoc
	]


// Local Statics

// static


// Local Structures

// structure


// Local Manifests

manifest	[
	chulDiablo = #137		// get from font width description
	piMax = 20
	]


// F   D I A B L O   A B O R T   P A G E

let FDiabloAbortPage() = valof
[
if endofkeystream() then resultis false
let ch = getchar()
if ch ne chsp & ch ne chdel then resultis false
resultis true
] // end FDiabloAbortPage


// D I A B L O   T R A N S L A T E

and DiabloTranslate(ww, cp, pi, ho) = valof
[
unless FDiabloInit(ydMax - ydPerinch) do
	resultis abWontRestore
establishfun(0, 0, modehc)
vxwChuldiablo = vrgcc2 ! chulDiablo
vxDiablo = 0

let wwd = mpWwWwd ! ww
// let tmag = wwd>>WWD.mag;  wwd>>WWD.mag = 101;
let tfHd = wwd>>WWD.fHd;  wwd>>WWD.fHd = true;
let txdUd = wwd>>WWD.xdUd;  wwd>>WWD.xdUd = vxleftmargstd rshift 5;
// setmag(ww);
invalidatewindow(ww);
if mpfnof ! fnfontw eq -1 then
	errhlta(206);

let doc = wwd>>WWD.doc
let cpMac = rgmaccp ! doc - dcpendofdoc
let piLast = piNil
let mppicp = vec piMax
mppicp ! 0 = cp
for tpi = 1 to piMax-1 do mppicp ! tpi = cpnil
cp = cpnil
let fContinuous = false
let ch = nil
let cchPgbrk = nil
let sb = vec 5
let ridPgn = nil
let ab = abnil
let fGetint = nil
	[
startpage:
	test cp eq cpnil ifso
		[
		cp = pi ls piMax ? mppicp ! pi, cpnil
		if cp eq cpnil then
			[
			let tpi = 0
			while tpi ls piMax & mppicp ! tpi ne cpnil do
				tpi = tpi + 1
			tpi = tpi - 1
			cp = mppicp ! tpi
			while tpi ls pi do
				[
				cp = CpFormatPage(ww, cp, modehc,
					ho, tpi, FDiabloAbortPage, 0, pttodmlt, pttoddiv)
				if cp eq cpnil-1 then
					[
					ab = abmsg
					goto resetmag
					]
				if cp eq cpnil then
					[
					ab = abComTerm
					goto resetmag
					]
				unless ult(cp, cpMac) do
					goto badpage
				mppicp ! tpi = cp
				tpi = tpi + 1
				]
			]
		]
	ifnot if pi ls piMax then mppicp ! pi = cp
	unless ult(cp, cpMac) do
		break
	if fContinuous then goto printpage
	MoveX(-vxDiablo)

// this sets y origin:
// (assumes print head positioned 1" down from top of page)
	vydDiablo = ydMax - ydPerinch

// "Ready to print page n"
	SetRegionSys(risysstate, 161)
	stnum(sb, ho>>HO.pgnFirst+pi)
	SetRegionW(vrlwsys, 0, sb)
	ridPgn<<RID.nrl = 1
	ridPgn<<RID.ri = 0
	SetRegionSys(risyspast, 162, ridPgn)
	wwd>>WWD.cpFDispl = cp
	setupdate(ww)
	updatedisplay()

	ch = bravochar()
	SetRegionSys(risysstate, rinil)
	SetRegionSys(risyspast, rinil)
	updatedisplay()
	switchon (ch ge $A & ch le $Z) ? ch+#40, ch into
		[
	case chsp:
	case chcr:
		endcase

	case $c:
		SetRegionSys(risysstate, 163)
		updatedisplay()
		if bravochar() ne chcr then loop
		fContinuous = true
		endcase

//	case $g:
//		augmentomseq("M↑")
//		fGetint = FGetUserInt(lv pi, 164)
//		deactivateomseq("M↑", "M↑")
//		unless fGetint do
//			goto badpage
//		pi = pi - ho>>HO.pgnFirst
//		cp = cpnil
//		loop

	case $r:
		unless piLast eq piNil do
			[
			pi = piLast
			cp = cpnil
			]
		loop

	case chdel:
		ab = abComTerm
		goto resetmag

	default:
		ab =  abIllOpt
		goto resetmag
		]

printpage:
	cp = CpFormatPage(ww, cp, modehc, ho, pi, FDiabloAbortPage,
		FinfoToDiablo, pttodmlt, pttoddiv)
	DiabloPageEject()
	if cp eq cpnil-1 then
		[
		ab = abmsg
		goto resetmag
		]
	test cp eq cpnil ifso
		fContinuous = false
	ifnot	[
		piLast = pi
		pi = pi + 1
		]
	loop

badpage:
	ab = abBadPage
	goto resetmag
	] repeat

resetmag:
// wwd>>WWD.mag = tmag
wwd>>WWD.fHd = tfHd
wwd>>WWD.xdUd = txdUd
invalidatewindow(ww)
resultis ab
] // end DiabloTranslate


// D I A B L O   P A G E   E J E C T

and DiabloPageEject() be
[
PositionYd(0)
vydDiablo = ydMax
] // end DiabloPageEject