// diablo.sr


get "DIABLO.DF"


// Outgoing Procedures

external	[
	FDiabloInit
	DiabloMoveXd
	DiabloMoveYd
	DiabloPrintChar
	]


// Outgoing Statics

external	[
	vxdDiablo
	vydDiablo
	]


// Incoming Procedures

external	[
	errhlta
	]


// Incoming Statics

external	[
	vfwheel
	]


// Local Statics

static	[
	vxdDiablo = 0
	vydDiablo = 0
	vtwait = 1
	vfFirstprint
	]


// Local Structures

// structure


// Local Manifests

// manifest


// F   D I A B L O   I N I T

let FDiabloInit(ydInit; numargs cArg) = valof
[
if cArg ls 1 then ydInit = 0
unless vfwheel do
	[
	rv diabloout = rest
	rv diabloout = 0
	unless FDiabloWait(allready, vtwait) do resultis false
	]
vxdDiablo = 0
vydDiablo = ydInit
vfFirstprint = true
resultis true
] // end DiabloInit


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

and DiabloStrobe(type, arg) be
[
if vfwheel then return
if (rv diabloin & prcheck) eq 0 then errhlta(201)
unless FDiabloWait(ready % type, vtwait) do errhlta(202)
arg = arg % ribbonlift
rv diabloout = arg
rv diabloout = arg % type
rv diabloout = arg
] // end DiabloStrobe


// F   D I A B L O   W A I T

and FDiabloWait(mask, twait) = valof
[
if vfwheel then resultis true
let c = 1
while (rv diabloin & mask) ne 0 do
	[
	if c eq 0 then resultis false
	c = c + 1
	for i = 0 to twait do []
	]
resultis true
] // end FDiabloWait


// D I A B L O   M O V E   X D

and DiabloMoveXd(dxd) be
[
if dxd eq 0 then return
if dxd gr #1777 % dxd ls -(#1777) then
	[
	let tdxd = AShift(dxd, -1)
	DiabloMoveXd(tdxd)
	DiabloMoveXd(dxd - tdxd)
	return
	]
vxdDiablo = vxdDiablo + dxd
// if vxdDiablo ls 0 % vxdDiablo ge xdMax then errhlt("xdb")
DiabloStrobe(carriage, (dxd ls 0 ? #2000 - dxd, dxd))
] // end DiabloMoveXd


// D I A B L O   M O V E   Y D

and DiabloMoveYd(dyd) be
[
vydDiablo = vydDiablo + dyd
// if vydDiablo ls 0 % vydDiablo ge ydMax then errhlt("ydb")
MoveYd(-dyd)
] // end DiabloMoveYd


// M O V E   Y D

and MoveYd(dyd) be
[
if dyd eq 0 then return
if dyd gr #1777 % dyd ls -(#1777) then
	[
	let tdyd = AShift(dyd, -1)
	MoveYd(tdyd)
	MoveYd(dyd - tdyd)
	return
	]
DiabloStrobe(paper, (dyd ls 0 ? #2000 - dyd, dyd))
] // end MoveYd


// A   S H I F T

and AShift(w, d) = (d ge 0 ? w lshift d,
	(w ge 0 ? w rshift -d, not (not w) rshift -d))
// end AShift


// D I A B L O   P R I N T   C H A R

and DiabloPrintChar(ch) be
[
if ch ls #40 then return
DiabloStrobe(daisy, ch)
// this is bogus
if vfFirstprint then
	[
	DiabloStrobe(daisy, ch)
	DiabloStrobe(daisy, ch)
	vfFirstprint = false
	]
] // end DiabloPrintChar