// PDInit.bcpl -- PDPrint initialization
// derived from PressInit.bcpl 2/7/83

//  errors 200

get "PDInternals.d"
get "Streams.d"

// outgoing procedures
external
	[
	PDInit
	]

// incoming procedures
external
	[
//PDPrint
	PDPrint
	PDUserFinishProc
	PDError
	PDTrap
	DblShift

//PDINSTALL, PDINSTALLUTILS
	PDInstall
	IndexFile

//METER
	MeterInit

//Used for initialization of files, etc. -- removed by Junta
	OpenFile
	Closes
	Gets
	Endofs
	ReadBlock
	Junta
	MyFrame
	CallersFrame
	GotoLabel

//PDML
	MulDiv; Ugt
	DoubleAdd; DoubleSub; DoubleCop

//SCANSTRINGS
	TypeForm
	ReadComInit
	ReadCom
	ReadNumber

//ALLOC
	InitializeZone
	Allocate

//OS
	MoveBlock
	Zero
	lvUserFinishProc
	StartIO

//LOADRAM
	LoadRam
	SetBLV

//TFS
	TFSInit
	TFSSetDisk
	TFSCreateDDMgr

//FLOAT
	FLDI; FML; FTR

//PrintOrbitInit
	OrbitInit

//WINDOW and misc.
	WindowInit;WindowRead;WindowClose;WindowSetPosition
	WindowReadBlock
	FileStuff
	]

// incoming statics
external
	[
	BitsFile
	PDFile
	tridentVec
	tridentUsed
	FileName

	Directive
	UserCopies
	UserPageStart
	UserPageEnd
	XOffset
	YOffset

	printerDevice
	ResolutionS	
	ResolutionB	
	PaperDimensionS
	PaperDimensionB
	nScans
	nBitsPerScan

	DPzero
	DoMeter
	DoFileMeter
	Debug
	Verbose
	mirrorX
	invertMode

	PDVersion
	Report
	UseRam

	PDZone
	PermanentBottom
	OverlayTable
	OverlayReloc
	OverlayBottom
	OverlayTop

	RamImage

	PDSavedUFP

	AltoVersion
	]

// internal statics
static
	[ tridentDiskBase
	]

// File-wide structure and manifest declarations.

//manifests copied from AltoFileSys.d and SysDefs.d because Bcpl
// dictionary was getting too big:
manifest [
	lFP=5
	levBFSbase=5
	levDirectory=9
	lTFSDSK=100
	]

structure STR[
	length byte
	char^1,255 byte
	]

// Procedures

let  PDInit(userParams, cfa) = valof
 [
	TypeForm("PDPrint ", 10, PDVersion/256, $., 10, PDVersion&#377, 0)

//Following hint for "PDPrint.State" is overwritten at PDInstall time by fiddling with
// the .Run file.  This is the primary mechanism for getting at the installed state
// reasonably quickly.  In addition to the FP, there is a "magic" number that is
// written as the first word on the state file.  This is to try to guard against un-
// installed systems running wild.
   let hintState=table [ 0;0;0;0;0;0 ]
   compileif lFP+1 ne 6 then [ foo=nil ]

//See if we are installing PDPrint.
   let doInstall=false
   ReadComInit()
   let str=vec 20
   let sw=vec 5
   ReadCom(str,sw)		//Bypass "PDPRINT" command
   for i=1 to sw!0 do switchon sw!i into
	[
	case $I: doInstall=true; endcase
	default: endcase
	]

//Very first thing to do is load the RAM:
   UseRam=(AltoVersion rshift 12) le 3
   if UseRam then
	[
	let errs=LoadRam(RamImage, true)
	unless errs eq 0 then PDError(210)
	SetBLV(#177776)			//Prepare for a silent boot when finishing.
	PDSavedUFP=@lvUserFinishProc
	@lvUserFinishProc=PDUserFinishProc //Will boot to restore tasks to ROM
	]

   if doInstall then PDInstall(cfa, hintState)

//Now set up a temporary zone to hold things that will ultimately
// reside in "permanent" storage at the top of memory.
	let rpb=@#335		//Get bottom of stack.
	let cpb=rpb+100		//That many statics.
	let rp=rpb
	let cp=cpb

//Now initialize state vectors and scalars.  For the vectors, remember
// a relocation table so that things can be moved to high memory after
// the Junta.

   let s=OpenFile("PDPrint.State",ksTypeReadOnly,0,0,hintState)
   if s eq 0 % Gets(s) ne hintState!lFP then PDInstall(cfa, hintState) //Not installed!
   let passCount=Gets(s); ReadBlock(s, cp, passCount)	//Default settings
	[
	let adr=Gets(s)
	if adr eq 0 then break
	let len=Gets(s)
	test len eq 0
	 ifso @adr=Gets(s) 
	 ifnot [
		ReadBlock(s, cp, len)
		@adr=cp
		cp=cp+len
		@rp=adr
		rp=rp+1
		]
	] repeat
   Closes(s)

//Now finish global switch processing.  This is done after the statics are restored in case
// some things want to be reset.
   for i=1 to sw!0 do switchon sw!i into
		[
		case $D: Debug= not Debug; endcase
		case $M: DoMeter= not DoMeter; endcase
		case $V: Verbose= not Verbose; endcase
		case $R: mirrorX=not mirrorX;endcase
		case $N: invertMode=not invertMode;endcase
		default: endcase
		]

//Look for other command modifiers:
   UserCopies=1
   UserPageStart=1; UserPageEnd=2000

   let p=vec 3000			//For indexing file
   let pz=InitializeZone(p, 3000)		//Just to set up Allocate,Free to Call0,Call1

//Init the trident disk, if it is there.
//there are Trident drive nos 0-7, each with up to 3 file systems
//allow user to grab any or all
	tridentVec=cp;cp=cp+NTridentDrives*NPartitions
   Zero(tridentVec,NTridentDrives*NPartitions)
	@rp=lv tridentVec
	rp=rp+1
   if tridentUsed then
	[
	let ddmgr=TFSCreateDDMgr(pz)
	tridentDiskBase=cp	//save to put in permanent area
	@rp=lv tridentDiskBase
	rp=rp+1
	for t=0 to NTridentDrives*NPartitions-1 do
	 [ tridentVec!t=TFSInit(pz,true,(NPartitions-1-(t rem NPartitions))*#400 + (NTridentDrives-1-(t/NPartitions)),ddmgr)
		if tridentVec!t eq 0 then loop
		MoveBlock(cp, tridentVec!t, lTFSDSK)
		cp=cp+lTFSDSK
	 ]
	if tridentDiskBase eq cp then	//no trident drives working
		[
		TypeForm("Trident drive is not on-line.  Check it out!")
		finish
		]
	]

//Finish processing the command line:
   let rpPDFile = nil;
   Directive=0
   while ReadCom(str,sw) do
	[
	let j=Disambiguate(str)
	unless j then PDError(201, str)
	let num=0
	if j ls 20 then
		[
		unless ReadCom(str,sw) then PDError(202)
		num=ReadNumber(str)	//Leaves fp result in ac1
		]
	switchon j into
	   [
	   case 1: UserCopies=num; endcase	//Copies
	   case 2:	[
			ResolutionB = num;		//Resolution
			ResolutionS=ResolutionB
			] ; endcase
	   case 3: XOffset=num; endcase	//Xoffset
	   case 4: YOffset=num; endcase	//Yoffset
	   case 5: UserPageStart=num; UserPageEnd=num; endcase	//Page
	   case 6: UserPageEnd=num; endcase	//To

	   case 20:			// Print -- Find and index the PD file:
			[
			Directive=dirPrint%dirPDScan
			let p = vec 3000;
			unless ReadCom(str,sw) then PDError(207)
//Salt away the file name:
			FileName=cp
			let plen=(str!0 rshift 9)+1
			MoveBlock(cp, str, plen)
			cp=cp+plen
			@rp=lv FileName
			rp=rp+1

			plen=IndexFile(p, FILEPD, str)
			if plen eq 0 then PDError(200, str)

//Salt away the indexed file:
			PDFile=cp
			MoveBlock(cp, p, plen)
			cp=cp+plen
			@rp=lv PDFile
			rpPDFile = rp;
			rp=rp+1
			] ; endcase
	   case 21: Directive=dirPrint ; endcase //Reprint
	   case 22: Directive=dirPatterns%dirPrint ; endcase	//Patterns
	   case 23: Directive=Directive&(not dirPrint)  ; endcase	//NoPrint
	   case 24: Directive=(Directive&(not dirPrint))%dirDisplay ; endcase //Display
	   ]
	]

   if Debug then DoFileMeter=true

   if PDFile eq 0 & Directive eq 0 then PDError(203)

   nScans = MulDiv(ResolutionS, PaperDimensionS, 10);
   nBitsPerScan = MulDiv(ResolutionB, PaperDimensionB, 10);

//Init the Orbit, if necessary
   if printerDevice le printerOrbitLast then OrbitInit()

//Save length of "permanent" area:
   cpb!-1=cp-cpb
   if Ugt(rp, cpb-1) then PDError(204)
   @rp=0				//Terminate relocation list

//Get rid of the operating system:
   Junta(levBFSbase, PDInitAux)
   ]

and

PDInitAux() be
[
//Move "permanent" things up from where we saved them temporarily.
   let rp=@#335
   let cp=rp+100
   let len=cp!-1
   let PermanentTop=MyFrame()-3000	//3000 words of stack space
   @#335=PermanentTop
   PermanentBottom=PermanentTop-len
   MoveBlock(PermanentBottom, cp, len)
   while @rp ne 0 do
	[
	@@rp=@@rp+PermanentBottom-cp
	rp=rp+1
	]

//fix up the trident disk table
	if tridentUsed then
	 [ for t=0 to NTridentDrives*NPartitions-1 do
		 if tridentVec!t ne 0 then 
		  [ tridentVec!t=tridentDiskBase
			 tridentDiskBase=tridentDiskBase+lTFSDSK
		  ]
	 ]

//Now allocate any more permanent things you can think of....
   let z=vec 2
   z>>ZN.Allocate=PermanentAllocate
   z>>ZN.Free=PDTrap
   PDZone=z

   compileif MeterSw then [ if DoMeter then MeterInit() ]

   OverlayTop=PDInit
   OverlayBottom=PDInit

   PDPrint(0)					//And run PDPrint!
]

and 

PermanentAllocate(zone, siz) = valof
[
	PermanentBottom=PermanentBottom-siz
	resultis PermanentBottom
]

and

Disambiguate(str) = valof
[
	let len=str>>STR.length
	let matchNo=nil
	let matchCnt=0
	for i=1 to 100 do
	[
	  let s=selecton i into
		[
		case 1: "Copies"
		case 2: "Resolution"
		case 3: "XOffset"
		case 4: "YOffset"
		case 5: "Page"
		case 6: "To"

		case 20: "Print"
		case 21: "Reprint"
		case 22: "Patterns"
		case 23: "NoPrint"
		case 24: "Display"
		default: 0
		]
	   if s eq 0 % len gr s>>STR.length then loop
	   let match=true
	   for j=1 to len do
		if ((str>>STR.char^j xor s>>STR.char^j)&(not #40)) ne 0 then
			match=false
	   if match then
		[
		matchCnt=matchCnt+1
		matchNo=i
		]
	]
	if matchCnt eq 1 then resultis matchNo
	resultis false
]