// PrintSlow.bcpl - Versatec and TC200 Interface
// errors 3200

get "PDInternals.d"

//outgoing procedures
external
	[
	PSlow
	VersatecRoutine;VersatecInit;VersatecClose
	HgRoutine;HgInit;HgClose
	]

//incoming procedures
external
	[ 
//WINDOW
	WindowInit
	WindowClose
	WindowReadBlock
	WindowGetPosition
	WindowSetPosition
	FileVDA

//PDML
	DoubleAdd
	Ugt

//OS
	Zero
	MoveBlock
	Timer

//PDPRINT
	PDError
	DblShift
	FSGet
	FSPut
	MulDiv

//CURSOR
	CursorChar
	CursorDigit
	CursorToggle

//INTERRUPT
	InitializeInterrupt
	FindInterruptMask
	CauseInterrupt
	DestroyInterrupt

//PRINT
	PrintError
	]

//incoming statics
external
	[
	ResolutionS
	ResolutionB
	BitsFile
	nBitsPerScan
	nScans
	VersatecFF
	]

//internal statics
static
	[
	zeroBuf
	lMarginBytes
	rMarginBytes
	vibuf
	vobuf
	videoBytes
	mask
	hgState
	hgByteCount
	dataLate
//Debugging stuff
	slowState
	]

manifest
	[
	vPiClkBit=#10000
	vResetBit=#1000
	vNotPrintBit=#4000
	vFormFeedBit=#100000
	viInterrupt=#421
	DiabloOutput=#177016
	DiabloInput=#177030
	RTC=#430
	]

manifest
	[
	hgInPort=#177100
	hgOutPort=#177101

	hgWriteStrobe=#100000
	hgExtConn=#40000
	hgDevRead=#10000
	hgGS1=#4000
	hgGS2=#2000
	hgReadDirection=#1000
	hgDataStrobe=#400
	hgInitialize=#200
	hgXPrint=#100
	hgLaserOn=#40
	hgDevClutch=#20
	hgPaperCut=#10
	hgDocFeed=#10
	hgSloDrive=#4
	hgSCM00=2
	hgSCM01=1

	hgBufferEmpty=#100000
	hgScanGate=#40000
	hgNPwrOn=#20000
	hgNSelected=#10000
	hgNFuserRdy=#4000
	hgNFilWhlRdy=#2000
	hgNPOWlo=#20000
	hgNDocInTray=#10000
	hgNDocScan=#4000
	hgNXPrint=#2000
	]

structure VSTAT :
	[
	spare bit
	NotOnLine bit
	NoPap bit
	NotReady bit
	spare1 bit 12
	]

// Common printing code for slow (Diablo interface) devices

let PSlow(Routine, pg) be
[
	let slw=pg>>PageG.BitWc
	let bandWidth=pg>>PageG.BandWidth
	let nBands=nScans/bandWidth

	let w=WindowInit(BitsFile,1)
	let pos=vec 1
	pos!0=0; pos!1=pg>>PageG.BitPage
	DblShift(pos, -10)		//Place to begin reading.
	WindowSetPosition(w, pos)
	let nPagesPerBuf=(slw*bandWidth+1023)/1024
	let bufSiz=vec 1
	bufSiz!0=0; bufSiz!1=1024*nPagesPerBuf
	let z=vec 100
	Zero(z, 100)
	zeroBuf=z

//Calculate the margin, etc. areas.  Note that these three numbers
// are for the device-drivers only, and may be modified if necessary.
// Because all calculations for scan-line length are done in
// double-words, it is conceivable that lMarginBytes+videoBytes will
// exceed the scan-line length.  In this case, videoBytes can be reduced,
// because the scan-line length was rounded up to a multiple of 32 bits.
	lMarginBytes=pg>>PageG.BitMargin/8
	videoBytes=slw*2
	let lb=(nBitsPerScan+7)/8
	let tb=lMarginBytes+videoBytes
	if tb gr lb then videoBytes=videoBytes-(tb-lb)

	let interrupt=Routine(0)	//Initialize..., return interrupt tourine
	mask=FindInterruptMask(1)
	let intVec=vec 100
	InitializeInterrupt(intVec, 100, mask, interrupt)

	slowState=1	//%%
	vibuf=0
	for nbufs=0 to 100 do
		[
		let b=FSGet(slw+2)		//Get a buffer
		if b eq 0 then break
		b!0=b
		if vibuf eq 0 then vibuf=b
		b!0=vibuf!0
		vibuf!0=b
		b!1=false				//Empty
		]
	vobuf=vibuf

[Pr						//Here to print a page
	Routine(1)
	slowState=2	//%%
	CauseInterrupt(mask)		//Start things off

	for b=0 to nBands-1 do
	[
	let video=b ge pg>>PageG.FirstBand & b le pg>>PageG.LastBand
	
	for j=0 to bandWidth-1 do
		[
		test video then WindowReadBlock(w, vibuf+2, slw) or
			Zero(vibuf+2, slw)
		let nbuf=vibuf!0
		while nbuf!1 do loop
		CursorToggle((video? 0,1))
		vibuf!1=true		//Mark us full
		vibuf=nbuf
		]
	if video then
		[
		DoubleAdd(pos, bufSiz)
		WindowSetPosition(w, pos)
		]
	]

	while vibuf ne vobuf do loop
	slowState=3	//%%
]Pr repeatuntil Routine(2)

	slowState=4	//%%
	DestroyInterrupt(mask)

	slowState=5	//%%
	[
	let nx=vibuf!0
	FSPut(vibuf)
	vibuf=nx
	] repeatuntil vibuf eq vobuf
	slowState=6	//%%
]

// Versatec - specific routines

and VersatecInit() be
	for i=1 to VersatecFF/256 do VersatecFormFeed()

and VersatecClose() be
	  for i=1 to (VersatecFF&#377) do VersatecFormFeed()

and VersatecRoutine(i) = valof [ switchon i into
[
case 0:	[					//Starting up
	rMarginBytes=nBitsPerScan/8-lMarginBytes-videoBytes
	if rMarginBytes ls 0 then PDError(1702)
	PulseV(vPiClkBit+vNotPrintBit,vResetBit)		//Reset
//Set up for interrupts (was going to use interval timer!!)
//		let vInterval=26*VersatecMsSl	//Number of 38-microseconds
//		vIntCnt=-1
//		while vInterval gr 1024 do [ vInterval=vInterval/2; vIntCnt=vIntCnt*2 ]
//		vIntCnt=vIntCnt+1		//Because of the way we count
//		vInterval=vInterval lshift 6	//Move to left position

	@WriteVersatecLine=PrintVersatecTrap
	resultis VersatecInterrupt
	]
case 1:	[					//Before each page
	AwaitVReady(1)			//Find Versatec ready
	PulseV(vPiClkBit+vNotPrintBit,vResetBit)		//Reset
	@viInterrupt=@viInterrupt%mask
	] ; endcase
case 2:	[					//End of the page
	@viInterrupt=@viInterrupt&(not mask)
	resultis AwaitVReady(1)
	]
] ]

and VersatecInterrupt() be
[
	if DiabloInput>>VSTAT.NotReady then return
	if vobuf!1 eq false then return	//Buffer not yet ready
	WriteVersatecLine(zeroBuf, lMarginBytes)
	WriteVersatecLine(vobuf+2, videoBytes)
	WriteVersatecLine(zeroBuf, rMarginBytes)
	vobuf!1=false		//Empty
	vobuf=vobuf!0		//Next buffer
]

// Write a buffer to the Versatec. 
// **** This procedure also in microcode ****

and WriteVersatecLine(buf, nBytes) be
[
	for i=1 to nBytes do
	[
		let val=nil
		test (i&1) ne 0 then val=(not @buf) rshift 8 or
			[ val=(not @buf)Ź buf=buf+1 ]
		PulseV(val+vPiClkBit+vNotPrintBit,vPiClkBit)
	]
]

and VersatecFormFeed() be
[
	AwaitVReady(1)			//Find Versatec ready
	PulseV(vPiClkBit+vNotPrintBit,vResetBit)		//Reset
	AwaitVReady(1)
	PulseV(vPiClkBit+vNotPrintBit,vFormFeedBit)
	AwaitVReady(30)
]

// Returns true if no fixing to Versatec required.

and AwaitVReady(seconds) = valof
[
	let looped=-1
[
	looped=looped+1
	if looped then PulseV(vPiClkBit+vNotPrintBit,vResetBit)
	let ready=false
	let tim=@RTC
		[
		if DiabloInput>>VSTAT.NotReady eq 0 then [ ready=true; break ]
		if (@RTC-tim) gr 27*seconds then break
		] repeat
	if DiabloInput>>VSTAT.NotOnLine then [ PrintError(2); loop ]
	if DiabloInput>>VSTAT.NoPap then [ PrintError(1); loop ]
	unless ready then PrintError(0)
	break
] repeat
	resultis looped eq 0
]

// Mercury - specific routines. Note that the use of the interval timer
// is proper only on Alto II with ALTOIICODE3 with SIT instruction fixed
// or an XM Alto.

and HgInit() be
[
	[
		if HgReadS(hgExtConn, hgNPwrOn) eq 0 then break
		PrintError(0)	//Power or unit not there
	] repeat
	[
		if HgReadS(hgExtConn+hgGS2, hgNPOWlo) eq 0 then break
		PrintError(1)	//Paper or Web low
	] repeat
	let hse=4096-MulDiv(85, ResolutionB, 10)
	let vsp=4096-ResolutionS * 10
// Set HSE & VSP
	PulseH(hgGS1+hgGS2+(hse & #377), hgWriteStrobe)
	MsWait(2)
	PulseH(hgGS1+(hse rshift 8)+((vsp&#17) lshift 4), hgWriteStrobe)
	MsWait(2)
	PulseH(hgGS2+(vsp rshift 4), hgWriteStrobe)
	MsWait(2)
	[
		if HgReadS(0, hgNSelected) eq 0 then break	//Sets ExtConn
		PrintError(2)	//Unit will not select
	] repeat
	PulseH(hgExtConn, hgDataStrobe)	//Zero data for now...
	[
		PulseH(hgExtConn+hgXPrint+hgLaserOn+hgSloDrive, hgWriteStrobe)
		MsWait(100)	//Wait for fuser spike to wreak havoc
		if HgReadS(hgGS2, hgNXPrint) eq 0 then break
	] repeat
	for i=1 to 25 do	MsWait(1000)
	[
		if HgReadS(0, hgNFuserRdy) eq 0 then break
		PrintError(3)	//Fuser not ready
	] repeat
	[
		if HgReadS(0, hgNFilWhlRdy) eq 0 then break
		PrintError(4)	//Filter wheel not ready
	] repeat
	PulseH(hgExtConn+hgXPrint+hgLaserOn+hgDevClutch, hgWriteStrobe)
	MsWait(14 * ResolutionS) //delay 1" at start of first page
]

//PulseH(code,thing-to-XOR)
and PulseH(code,thingToXOR) be
[	PulseH=table [ #55001;	//Sta 3,1,2
			#135000;	//Mov 1,3
			#117520;	//Andzl 0,3
			#107000;	//Add 0,1
			#166400;	//Sub 3,1	(1 <= 0 xor 1)
			#34406;	//Lda 3,.+6
			#41400;	//Sta 0,0,3
			#45400;	//Sta 1,0,3
			#41400;	//Sta 0,0,3
			#35001;	//Lda 3,1,2
			#1401;	//Jmp 1,3
			hgOutPort ]	//Memory address
	PulseH(code,thingToXOR)
]

//PulseV(code,thing-to-XOR)
and PulseV(code,thingToXOR) be
[	PulseV=table [ #55001;	//Sta 3,1,2
			#135000;	//Mov 1,3
			#117520;	//Andzl 0,3
			#107000;	//Add 0,1
			#166400;	//Sub 3,1	(1 <= 0 xor 1)
			#34406;	//Lda 3,.+6
			#41400;	//Sta 0,0,3
			#45400;	//Sta 1,0,3
			#41400;	//Sta 0,0,3
			#35001;	//Lda 3,1,2
			#1401;	//Jmp 1,3
			DiabloOutput ]	//Memory address
	PulseV(code,thingToXOR)
]

and HgClose() be
[
	PulseH(hgExtConn+hgXPrint+hgPaperCut, hgWriteStrobe)
	MsWait(300)	// let cutter start
	PulseH(hgExtConn+hgXPrint, hgWriteStrobe)
	for i=1 to 11 do MsWait(14 * ResolutionS)	// 11 inches
	PulseH(hgExtConn+hgXPrint+hgPaperCut, hgWriteStrobe)
	MsWait(300)	// let cutter start
	PulseH(hgExtConn+hgXPrint, hgWriteStrobe)
	MsWait(14 * ResolutionS)	// 1 inch
	PulseH(hgExtConn+hgXPrint+hgPaperCut, hgWriteStrobe)
	MsWait(300)	// let cutter start
	PulseH(hgExtConn+hgXPrint, hgWriteStrobe)
	for i=1 to 11 do MsWait(14 * ResolutionS)	// 11 inches
	PulseH(hgExtConn+hgXPrint+hgPaperCut, hgWriteStrobe)
	MsWait(300)	// let cutter start
	PulseH(0, hgWriteStrobe)	//Turn it off
]

and HgRoutine(i) = valof [ switchon i into
[
case 0:	[
	PulseH(hgExtConn+hgXPrint+hgLaserOn+hgDevClutch, hgWriteStrobe)
	MsWait(2)
	PulseH(hgExtConn+hgXPrint+hgLaserOn+hgDevClutch, hgWriteStrobe)
	MsWait(200)
	@HgWriteBytes=PrintHgTrap
	resultis HgInterrupt
	]
case 1:	[
	dataLate=-1
	hgState=0
	@#423=mask
	] ; endcase
case 2:	[
	( table [ #61007; #1401 ] )(0)	//Turn off interval timer
	@#423=0
	PulseH(hgExtConn+hgXPrint+hgLaserOn+hgDevClutch+hgPaperCut, hgWriteStrobe)	// start cutter
	MsWait(300)	//	delay for it to start
	PulseH(hgExtConn+hgXPrint+hgLaserOn+hgDevClutch, hgWriteStrobe)
	MsWait(14 * ResolutionS)	// 1 inch
	PulseH(hgExtConn+hgXPrint+hgLaserOn+hgDevClutch+hgPaperCut, hgWriteStrobe)	//start cutter
	MsWait(300)	//delay for it start
	PulseH(hgExtConn+hgXPrint+hgLaserOn+hgDevClutch+hgSloDrive, hgWriteStrobe)
	resultis true			//Done OK
	]
] ]

and HgReadS(gs2, mask; numargs n) = valof
[
	if n eq 1 then mask=-1
	@hgOutPort=(hgExtConn+hgDevRead+hgReadDirection) xor gs2
	resultis @hgInPort & mask
]

and MsWait(x) be
[
	let a=vec 1
	Timer(a)
	a!0=not a!0
	a!1=not a!1

	[
	let b=vec 1
	Timer(b)
	DoubleAdd(b, a)
	if b!1 gr x then return
	] repeat
]

// State variable for interrupt code is as follows:
// 0	Hunting for ScanGate to go off
// 1	Putting out leading margin
// 2	Putting out video

and HgInterrupt() be
[
switchon hgState into [
case 0:	test (@hgInPort & hgScanGate) eq 0 then endcase or
	[
	if vobuf!1 eq false then [ dataLate=dataLate+1; endcase ]
	PulseH(hgExtConn+hgXPrint+hgLaserOn+hgDevClutch+hgInitialize, hgWriteStrobe)
	PulseH(hgExtConn+hgXPrint+hgLaserOn+hgDevClutch, hgWriteStrobe)
	hgByteCount=lMarginBytes
	hgState=1
	]
case 1:	[
	hgByteCount=HgWriteBytes(hgByteCount,zeroBuf+100)
	test hgByteCount ne 0 then endcase or
		[ hgByteCount=videoBytes; hgState=2 ]
	]
case 2:	[
	hgByteCount=HgWriteBytes(hgByteCount,vobuf+2+(videoBytes rshift 1))
	test hgByteCount ne 0 then endcase or
		[ hgByteCount=1; hgState=3 ]
	]
case 3:	[
	hgByteCount=HgWriteBytes(hgByteCount, zeroBuf+1)
	if hgByteCount eq 0 & (@hgInPort & hgScanGate) eq 0 then 
		[
		vobuf!1=false
		vobuf=vobuf!0
		hgState=0
		]
	] ; endcase
]

//Now reset timer
//This code is for an ALTO 1 only
//	let RS= table [ #40411;	//Sta 0,.+11
//			#61003;	//RCLK
//			#20407;	//Lda 0,.+7
//			#123000;	//Add 1,0
//			#42404;	//Sta 0,@.+4
//			#102520;	//Subzl 0,0
//			#61007;	//SIT
//			#1401;	//Jmp 1,3
//			#525;	//Interval timer location
//			0 ]		//Temporary
//	RS(2000&#177700)		//About 1 ms.

//This code is for an ALTO II only
	let RS= table [ #40413;	//Sta 0,.+13
			#61003;	//RCLK
			#20411;	//Lda 0,.+11
			#123000;	//Add 1,0
			#24410;	//Lda 1,.+10 load mask for bits 4-13
			#123400;	//And 1,0 and them off
			#42404;	//Sta 0,@.+4
			#102520;	//Subzl 0,0
			#61007;	//SIT
			#1401;	//Jmp 1,3
			#525;	//Interval timer location
			#0;		//Temporary
			#7774 ]	//time mask for alto 2
	RS(125&#7774)		//About 1 ms.
]

// Write a bunch of bytes to the Hg
//	nBytes = number of bytes to write
//	pBuffer = pointer to one beyond end of buffer
// **** this routine is in microcode ****

and HgWriteBytes(nBytes, pBuffer) = valof
[
	let p=pBuffer-((nBytes+1) rshift 1)
	[
	if nBytes eq 0 then resultis 0
	if (@hgInPort & hgBufferEmpty) ne 0 then resultis nBytes
	let val=@p
	test (nBytes&1) eq 0 then val=val rshift 8 or p=p+1
	PulseH(hgExtConn+(val&#377), hgDataStrobe)
	nBytes=nBytes-1
	] repeat
]