// PDPrint.bcpl -- main program
// derived from Press.bcpl 2/7/83

//  errors 100

get "PDInternals.d"
get "PDFile.d"

// outgoing procedures
external
	[
	PDPrint
	WritePageStructure
	PDUserFinishProc
	PDError
	PDErrorV
	PDTrap
	Scream

	GetTime
	FSGet
	FSGetX
	FSPut
	FSPutZ

	DblShift

	SwappedOut
	]

// outgoing statics
external
	[
//Files, disks
	BitsFile		//Files for all to use
	ScratchFile
	LeftOverFile1
	LeftOverFile2
	MeterFile
	PDFile
	RunFile
	tridentUsed		//Non-zero if Trident used (actually, # heads on disk)
	tridentVec		//Table of trident disk structures

//User's wishes
	Directive		//Says what to do
	UserCopies		//Number of copies to make
	UserPageStart		//First page to reprint
	UserPageEnd		//Last page to reprint
	XOffset			//User's specifications of how to perturb pages
	YOffset

// PD File information
	PDHerald

// Output device information & paper sizes
	printerDevice		//Code for which device to use
	rosDevice		//Code for which ROS is in printer
	nPrinterColors		//1, 3, or 4
	useStandardQueue	//Puffin/Pimlico use standard 3 or 4 color Q
	ResolutionS		// number of bits/inch in S
	ResolutionB		// number of bits/inch in B
	PaperDimensionS		//10* inches
	PaperDimensionB
	nScans			//Number of scan lines on a page
	nBitsPerScan		//Number of bits per scan line on a page

// Printer controls
	ScanMarginAdjust	//Adjustments to add to user input
	BitMarginAdjust
	mirrorX			//True if flip in x (TShirtMode)
	invertMode		//True if invert black/white
	PaperSpeedInches

	VersatecFF		//Extra form-feeds (256*before+after)

	SLOTScanLength		//in bits, to give to 3100 interface
	SLOTDouble
	SLOTTimeOut

//Miscellaneous other stuff
	PDWindow		//Window open on PD file
	FileName		//Name of PD file
	DPzero			//Double precision zero
	DoMeter			//Gather statistics
	DoFileMeter		//True if gather stats on each file transfer
	Debug			//Debugging flag
	Verbose			//If true, squeal on every error
	PDSavedUFP
	PDVersion		//Version number =a.b = a*256+b
	UseRam			//True if running on Alto II, else false
	UseXM			//Try to use extended memory

//Free storage stuff
	PDZone			//Zone to use for all free storage
	PermanentBottom		//Bottom of "permanent" free storage
	OverlayTable		//ovt!i = page of ith overlay
	OverlayBottom		//Place to put first word of overlay
	OverlayTop		//Place where last word of overlay is
	OverlayReloc		//Pointer to relocation table for overlay
	]
static
	[
	BitsFile
	ScratchFile
	LeftOverFile1
	LeftOverFile2
	BandFile
	MeterFile
	PDFile
	RunFile
	tridentUsed
	tridentVec

	Directive
	UserCopies
	UserPageStart
	UserPageEnd
	XOffset
	YOffset

	PDHerald

	printerDevice
	rosDevice
	nPrinterColors
	useStandardQueue
	ResolutionS
	ResolutionB
	PaperDimensionS
	PaperDimensionB
	nScans
	nBitsPerScan

	ScanMarginAdjust
	BitMarginAdjust
	invertMode
	mirrorX
	PaperSpeedInches

	VersatecFF

	SLOTScanLength
	SLOTDouble
	SLOTTimeOut

	PDWindow
	FileName
	DPzero
	DoMeter
	DoFileMeter
	Debug
	Verbose
	PDSavedUFP
	PDVersion = 1 * 256 + 1;
	UseXM
	UseRam

	PDZone
	PermanentBottom
	OverlayTable
	OverlayBottom
	OverlayTop
	OverlayReloc
	]

// incoming procedures
external
	[
//Main procedures for the various passes.
	PDInit

	ConvertInit
	Convert
	ConvertClose

	PrintInit
	Print
	PrintClose
	SlotRam
	PrintRam

//WINDOW,FILES
	WindowInit
	WindowClose
	WindowGetPosition
	WindowSetPosition
	WindowReadBlock
	WindowWriteBlock	
	WindowReadByte
	WindowRead
	WindowWrite
	WindowFlush
	FileStuff
	FileWritePage

//METER
	MeterBlock
	MeterClose

//OS
	MoveBlock
	lvUserFinishProc
	StartIO
	SysErr

//PDML
	DoubleAdd; DoubleSub; DoubleCop; MulDiv
	Ugt

//ALLOC
	InitializeZone
	AddToZone
	Allocate
	Free

//MAKEPATTERNS
	MakePatterns

//LOADRAM
	LoadRam
	SetBLV

//TFS
	TFSSilentBoot	//around all the time (tfsa)
	]

// incoming statics
external
	[
	UserName
	]

// internal statics
static
	[
	FSTrap			//To flag storage coming and going.
	nPages
	Pages
	]

// File-wide structure and manifest declarations.
manifest
	[
	hgOutPort=#177101
	]


// Procedures

let PDPrint(layout, userParams, cfa) be 
 [
   DPzero= table [ 0;0 ]

//First, call initialization routine.  It will call PDPrint(0) when it is finished.
   if layout ne 0 then PDInit(userParams, cfa)

//Here, the zone in use is still the "permanent" zone.  So allocate what
// you need.
   PDHerald=FSGetX(lPDHerald)
   Pages=FSGetX(nPagesAtOnce*lPageG)
if (Directive&dirPDScan) ne 0 then
	[
	PDWindow=WindowInit(PDFile)
	WindowReadBlock(PDWindow, PDHerald, lPDHerald)
	if PDHerald>>PDH.password ne PDPasswd then PDError(100)
	if PDHerald>>PDH.version ne 1 then PDError(101)
	UserCopies=Max(UserCopies,PDHerald>>PDH.copies)
	if PDHerald>>PDH.sResolution ne ResolutionS then PDError(102)
	if PDHerald>>PDH.fResolution ne ResolutionB then PDError(103)
	if PDHerald>>PDH.imageSSize ugr nScans then PDError(104)
	if PDHerald>>PDH.imageFSize ugr nBitsPerScan then PDError(105)
	]

//Now switch to a real zone that can allocate and free
   FSInit()

if (Directive&dirPatterns) ne 0 then
	[
	Overlay(0)
	MakePatterns()
	]

//SCAN CONVERSION & PRINTING PASSES
// These are dovetailed to handle the finite capacity of the disk for buffering
// scan-converted pages.  The basic idea is to scan-convert until the disk fills
// and then print.

   let PrintInited=false		//True if printer set up
   let veryFirstPrinting=true
   let ScanInited=false		//True if scan-converter set up
   let convertResult=-2	//So pre-made patterns work right

// ***** L O O P    F I L L I N G    D I S K *****
[DiskLoop					//Loop filling up disk buffers
let BitPagePos = 1	//leave room for WritePageStructure
nPages=0

// ***** L O O P    O N    P A G E S (Scan Conversion) *****
   if (Directive&dirPDScan) ne 0 then
   [Convert
   while nPages le nPagesAtOnce do
	[PageLoop				//Loop scan converting pages
		unless ScanInited then
		   [
		   if PrintInited then PrintClose(false)
		   PrintInited=false
		   Overlay(1)
PassC:	   	   ConvertInit()
		   ScanInited=true
		   ]
		let p=Pages+nPages*lPageG
		p>>PageG.BitPage=BitPagePos
// Returns -1 if not enough room in bits file, -2 if end of file, else number
// of bits file records used to record the scan-converted data
		convertResult=Convert(p)
		if convertResult eq -1 & nPages eq 0 then PDError(106)
		if convertResult ls 0 then break //Done filling available disk file
		BitPagePos=BitPagePos+convertResult
		nPages=nPages+1
// Must not start a new "feed" page if there are not enough pages
// for each color
		if p>>PageG.strip ne 0 &
			nPagesAtOnce-nPages ls nPrinterColors then break
	]PageLoop

	WritePageStructure(Pages, nPages)
   ]Convert

// ***** L O O P    O N    P A G E S  (Printing) *****
   if (Directive&(dirPrint%dirDisplay)) ne 0 then
   [Print
	ReadPageStructure(Pages, lv nPages)
	let oldPrinterDevice=printerDevice
	if (Directive&dirDisplay) ne 0 then printerDevice=-1
	let lastPage=Min(UserPageEnd,nPages)
	for copy=1 to UserCopies do
	for printPage=UserPageStart to lastPage do
	[PageLoop
		let p=Pages+(printPage-1)*lPageG
// Printing routine will decide whether to print blank pages (those
// with FirstBand le LastBand).
		unless PrintInited then
		   [
		   if ScanInited then ConvertClose()
		   ScanInited=false
		   test printerDevice gr printerOrbitLast
		    then Overlay(2, lv SlotRam)
		    or Overlay(2, lv PrintRam)
PassP:
			PrintInit(veryFirstPrinting,	p,
				lastPage-UserPageStart+1, UserCopies)
		   PrintInited=true
		   veryFirstPrinting=false
		   ]
		let stop=(printPage eq lastPage)&(copy eq UserCopies)
		Print(p, stop, OverlayTop+1, PermanentBottom-1)
	]PageLoop
	printerDevice=oldPrinterDevice
   ]Print
]DiskLoop repeatuntil convertResult eq -2

   if PrintInited then PrintClose(true)

//And finish statistics:
   compileif MeterSw then [ MeterClose() ]

   finish				//!!!
]

and WritePageStructure(Pages, nPages) be
[
	let b=WindowInit(BitsFile)
	WindowWrite(b, nPages)
	WindowWriteBlock(b, Pages, nPages*lPageG)
	WindowClose(b)
]

and ReadPageStructure(Pages, lvnPages) be
 [	let b=WindowInit(BitsFile)
	@lvnPages=WindowRead(b)
	WindowReadBlock(b, Pages, @lvnPages*lPageG)
	WindowClose(b)
 ]


//Miscellaneous

and PDError(code, p1, p2, p3, p4) be
 [
   (table [ #77403; #1401 ])("PDPrint.Errors", lv code)
 ]

and PDErrorV(code, p1, p2, p3, p4) be
 [
   if Verbose then PDError(code, p1, p2, p3, p4)
 ]

and PDTrap() be PDError(107)

and Scream(String) be PDError(108)

and GetTime(ptr, ref; numargs n) = valof
 [
   let time=@#430
   if n eq 1 then [ @ptr=time-@ptr ]
   if n eq 2 then [ @ptr=@ptr+(time-ref) ]
   resultis time
 ]

and DblShift(dblwordlv,amount) = valof
 [
   test amount ls 0 then	//Left shift
    [
      amount=-amount
      let temp=(dblwordlv!1) rshift (16-amount)
      @dblwordlv=(@dblwordlv lshift amount)+temp
      dblwordlv!1=(dblwordlv!1) lshift amount
    ]
   or
    [
      let temp=@dblwordlv lshift (16-amount)
      @dblwordlv=@dblwordlv rshift amount
      dblwordlv!1=((dblwordlv!1) rshift amount)+temp
    ]
   resultis dblwordlv!1	//low order 16 bits
 ]

and Max(a,b) = (a gr b)? a,b
and Min(a,b) = (a gr b)? b,a

//Free storage functions
//
// FSGet(size)
//	Tries to get a block of size "size".  Returns pointer or zero.
// FSGetX(size)
//	Like FSGet, but complains if core unavailable.
// FSPut(ptr)
//	Release block seized by FSGet or FSGetX
// FSPutZ(lvptr)
//	Release block pointed to by @lvptr and zero pointer
//

and FSInit(permBot; numargs n) be
 [
//Maximum size of an individual block is 32K. But we can give two blocks
// to FS package.  They will never be merged.
   if n eq 0 then permBot=PermanentBottom
   let len=permBot-OverlayTop-1
   let flen=len
   if Ugt(flen, #77776) then flen=#77776
   PDZone=InitializeZone(OverlayTop+1, flen, SysErr, (Debug? SysErr,0))
   if len-flen gr 30 then
	[
	let b=OverlayTop+1+flen+10
	AddToZone(PDZone, b, len-flen-10)
	]
 ]

and FSGet(Size) = valof
 [
   let ptr=Allocate(PDZone, Size, -1)
   if ptr ne 0 & ptr eq FSTrap then PDError(111)
   resultis ptr
 ]

and FSGetX(Size) = valof
 [
   let p=FSGet(Size)
   if p eq 0 then PDError(110)
   resultis p
 ]

and FSPut(ptr) be 
 [
   if ptr eq FSTrap then PDError(111)
   Free(PDZone, ptr)
 ]

and FSPutZ(lvptr) be
[
   FSPut(@lvptr)
   @lvptr=0
]

and PDUserFinishProc() be
 [
   if printerDevice eq printerHg then @hgOutPort = 0
   StartIO(#100000)		// Silent boot because BLV set at init time.
   @lvUserFinishProc=PDSavedUFP
 ]

and Overlay(i, lvInitRam; numargs n) be
 [
   let p=OverlayReloc
   for i=1 to OverlayReloc!0 do
	[
	@(p!1)=SwappedOut
	p=p+2
	]

   let pn=OverlayTable!i
   PDZone=InitializeZone(PermanentBottom-2000,2000)
   let R=WindowInit(RunFile)
   let pos=vec 1
   pos!0=0; pos!1=pn-1
   DblShift(pos, -8)
   WindowSetPosition(R, pos)

   let dope=vec 16
   WindowReadBlock(R, dope, 16)
   let len=dope!4-16
   WindowReadBlock(R, OverlayBottom, len)
   OverlayReloc=OverlayBottom+dope!3-16
   let nRel=OverlayReloc!0 *2
   for p=1 to nRel by 2 do
	[
	@(OverlayReloc!p)=OverlayReloc!(p+1)+OverlayBottom
	]

   OverlayTop=OverlayBottom+len

//If there is an initialization routine, call it.  Then move reloc table down over
// it so we can find them when doing the next overlay.
   if n ne 1 then
	[
	let bot=@lvInitRam
	if UseRam then
		[
		if tridentUsed then TFSSilentBoot()
		LoadRam(bot, true)
		SetBLV(#177776)	//Prepare for silent boot on finish.
		if tridentUsed then StartIO(#40)
		]
	MoveBlock(LoadRam, OverlayReloc, nRel+1)
	OverlayReloc=LoadRam
	OverlayTop=OverlayReloc+nRel+1
	]
   FSInit()
 ]

and SwappedOut() be PDError(120)