// QDPRINT.SR

get "ginn.df"
get "char.df"
get "bravo.df"

// Incoming procedures

external
	[
	invalidatewindow
	cpmax
	cppagenum
	discardpages
	macpage
	makepage
	cpvisible
	updatedisplay
	establishww
	disestablishww
	ult
	stcopy
	stappend
	cpmin
	stnum
	stsize
	stget
	divmod
	specstate
	nextspecstate
	pollinput
	pollstripe
	stripemenu
	stripeline
	stripenone
	stripewindow
	stripefly
	pollmouse
	setmenu
	bugmenu
	setmessage
	getvch
	format
	macpara
	cppara
	]

// Incoming statics

external
	[
	vwwcurrent
	ddoc
	vlookremark
	selaux
	vxrightmarg
	vxleftmarg
	vchangemarker
	vlookmarker
	vquad
	vxfirst
	vjw
	vjn
	vdoc
	vpara
	vlook
	comt
	vstripe
	rgdoc
	vchremain
	vcp
	rgmaccp
	vcplastd
	rgcpfdispl
	]

// Outgoing procedures

external
	[
	qdprint
	qcheckstop
	]

// Outgoing statics

external
	[
	vdpon
	vdpstop
	]

// Local statics

static
	[
	checkstop
	xcur
	ycur
	tabvec
	vdpon
	vdpstop
	spacing
	headings
	pagenums
	repaginate
	maxpy
	]

// Local manifests

manifest
	[
	pin= 177030b	//printer input address
	pout= 177016b	//output address
	carriage= 4000b	//carriage strobe and ready bit
	daisy= 10000b	//daisy strobe and ready
	ribbonlift= 20000b	//ribbonlift
	prcheck= 40000b	//check bit
	pfeed= 100000b	//paper feed bit
	rest= 40000b	//restore bit
	ready= 2000b	//ready bit
	allready= 116000b	//or of ready bits
	maxw= 132	//paper maximum width
	tabinc= 8	//tabs every 8 spaces
	pagelength=66*dpheight	//max lines per page
	]

let qdprint(space,head,page,repage)=valof
[
spacing = space
headings = head
pagenums = page
repaginate = repage
checkstop = 0
xcur=0
ycur=0
maxpy = (headings? 58,pagenums? 57,54)*dpheight
if not qrestore() then
	[
	setmessage(" Printer won't restore")
	resultis true
	]
let tv= vec maxw	//vector for tab locations
for i=0 to maxw-1 do tv!i=0
tabvec=tv
for j=0 to maxw-1 by tabinc do qsettab(j)
vdpstop = false
setmenu()
setmessage(" Bug Stop to terminate printing")
qprintpages(vwwcurrent)
qfeed(pagelength-ycur)
vdpon = false
vdpstop = false
resultis true
]

and qprintpages(ww) be
[
let doc = rgdoc ! ww
let chars = vec maxw
let looks = vec maxw
let cp = rgcpfdispl ! ww
let cpl = rgmaccp!doc - 2
let pagenum = cppagenum(doc,cpmax(cp-1,0))+1
if repaginate then discardpages(doc, pagenum, macpage(doc))
vchremain = 0
vdoc = doc
    [ // begin repeat
    if cp ne 0 then
	[
    	pagenum = pagenum+1
	if repaginate then makepage(doc, cp)
	]
    ycur=0
    let pagetop = true
    while ycur ls maxpy do
	[
	if not ult(cp, cpl) then
		[
		setmessage(" Printing finished")
		return
		]
	qclearline(chars, looks)
	if pagetop then
		[
		if headings then
			[
			if not qfeed(dpheight) then return
			]
		if pagenums then
			[
			let txnow = (dprmarg/dppitch) - 7
			let st = vec 5
			let stn = vec 2
			stcopy(st, "Page ")
			stnum(stn, pagenum)
			stappend(st, stn)
			let len = stsize(st)
			for i = 0 to len-1 do
				[
				let ch = stget(st,i)
				chars ! (txnow+i) = ch eq chsp? 0,ch
				]
			test pagenum eq 1
			ifso	if not qfeed(dpheight) then return
			ifnot	if not qprintline(chars, looks, 1)
					then return
			for i = 1 to 3 do
				if not qfeed(dpheight) then return
			]
		qclearline(chars, looks)
		pagetop = false
		]
	establishww(ww, devdp)
	format(doc, cp, devdp)
	vcp = cp
	vchremain = 0
	cp = cpmin(vcplastd, cpl)+1
	vcp = specstate(vdoc, vcp, vpara)
	let changecp = nextspecstate()
	disestablishww()
	let remainder = nil
	let xnow = divmod(vxfirst, dppitch, lv remainder)
	xnow = xnow + (remainder le (dppitch/2)? 0,1)
	if (vlookmarker) & vchangemarker then
		chars ! ((dplmarg/dppitch)-2) = $|
	while vcp ls cp do
		[
		let char = getvch()
		if vcp-1 eq changecp then
			[
			changecp = nextspecstate()
			if changecp eq -1 then char = chcr
			]
		if ((vlook & mvanish) ne 0) %
		    (((vlook & mremark) ne 0) & (not vlookremark))
			then loop
		if char eq chcr then break
		switchon char into
			[
		case chsp: // justification is incorrect in format
			looks!xnow=vlook
			xnow=xnow+1
			endcase
		case chtab: // not in a formatted document
			xnow= rv (tabvec+xnow)
			endcase
		default:
			chars!xnow=char
			looks!xnow=vlook
			xnow=xnow+1
			endcase
			]
		] // end while
	if not qprintline(chars, looks, spacing) then return
	] // end while
    if not qfeed(pagelength-ycur) then return
    invalidatewindow(ww)
    rgcpfdispl ! ww = cp
    updatedisplay()
    ] repeat
]

and qprintline(chars, looks, spaces) = valof
[
if not qprv(chars, looks) then resultis false
if not qfeed(dpheight*spaces) then resultis false
resultis true
]

and qprv(chars, looks) = valof
[
let xr=-1	// index of rightmost print position
let xl=0	//index of leftmost print position
for i=0 to maxw do
	[
	if chars!i ne 0 do
		[
		xr=i
		if xl eq 0 do xl=i
		]
	]
if xr ls 0 do resultis true	// nothing to print
test xcur ge (((xl+xr)/2)*dppitch)
ifso	resultis qpv(chars,looks,xr,xl,-1)
ifnot	resultis qpv(chars,looks,xl,xr,1)
]

and qpv(chars, looks, f, l, inc) = valof
[
qmove((f*dppitch-xcur))
f = f-inc
	[
	f = f+inc
	let char = (chars ! f) & 177b
	let look = (looks ! f)
	let notasp = char ne 0
	if notasp then if not qstrobe(char, daisy) then resultis false
	if (look ne 0) then
		[
		if ((look & mbold) ne 0) & notasp then
			for i = 1 to 7 do if not qstrobe(char, daisy)
				then resultis false
		if ((look & mitalic) ne 0) %
		   	 ((look & mul) ne 0) then
				if not qstrobe($←, daisy) then
					resultis false
		if ((look & mremark) ne 0) %
		   	 ((look & mvanish) ne 0) then
				if not qstrobe($↑, daisy) then
					resultis false
		]
	if not qmove(inc*dppitch) then resultis false
	] repeatwhile f ne l
resultis true
]

and qmove(d) = valof
[
xcur = xcur + d
resultis qstrobe(d ls 0? (2000b-d),d, carriage)
]

and qfeed(d) = valof
[
ycur = ycur + d
resultis qstrobe(d ls 0? (2000b-d),d, pfeed)
]

and qstrobe(a, typebit) = valof
[
checkstop = checkstop+1	// pollstripe takes time so don't always check
if checkstop eq 9 then
	[
	checkstop = 0
	unless qcheckstop(lv vdpstop) do
		[
		setmessage(" Printing terminated")
		resultis false
		]
	]
let timer=1
if ((rv pin) & prcheck) eq 0 then
	[
	setmessage(" Printer check")
	resultis false
	]
	[
	if ((rv pin) & (ready % typebit)) eq 0 then break
	if timer eq 0 then
		[
		setmessage(" Printer hung")
		resultis false
		]
	timer=timer+1
	] repeat
a=a % ribbonlift
rv pout=a
rv pout=a%typebit
rv pout=a
resultis true
]

and qrestore() = valof
[
let again = true
rv pout= rest	//strobe the printer
rv pout= 0
let time=1
	[
	if time eq 0 then
		[
		test again
		ifso again = false
		ifnot resultis false
		]
	if ((rv pin) & allready) eq 0 then resultis true
	time = time+1
	] repeat
]

and qsettab(t) be
[
if t eq 0 then return
let x=t-1
let v= rv(tabvec+t)
	[
	rv (tabvec+x) = t
	if x eq 0 then return
	x=x-1
	] repeatuntil rv (tabvec+x) ne v
]

and qclearline(chars, looks) be
[
for i=0 to maxw do
	[
	chars ! i = 0
	looks ! i = 0
	]
]

and qcheckstop(lvstop) = valof
[
let tdoc = vdoc
let char = pollstripe(true)
if char ne vstripe then
	[
	selecton comt ! char into
		[
	case sstripeline: stripeline
	case sstripewindow: stripewindow
	case sstripenone: stripenone
	case sstripefly: stripefly
	case sstripemenu: stripemenu
		] (char)
	]
if comt ! char eq sstripemenu then
	[
	char = pollmouse()
	if char ne smouse then
		[
		char = char + (vstripe-sstripe) lshift 3
		if comt!char eq sbugmenu then bugmenu(char)
		]
	if @lvstop then resultis false
	]
vdoc = tdoc
resultis true
]