// PressInit.bcpl

// last modified by GWilliams, 14 March 1983 4:43 pm PST (Monday)
// - added Geronimo switch.

// last modified by Ramshaw, January 19, 1982  4:08 PM
// - added FontPickyMatch static
// last modified by Ramshaw, March 30, 1981  5:23 PM
// - add LocalFidelity static - 3/30/81
// - substituted an rshift for a divide @ (nScanLines+BANDWidth-1) rshift... 3/20/81
// - PressInit, let the print command "print" Press.bits files - 10/22
// - PressInit, have IndexFile set nPressRecs - 10/22
// - PressInit, let ReadCom loop use the Tridents - 10/20
// - ResolutionB, ResolutionS, 1X instead of 10X - 10/14
// - Add InvertMode for /N (negative) invert global switch - 7/11/80

//  errors 200
//
// PRESS INITIALIZATION
//
//

get "PressInternals.df"
get "PressParams.df"
get "PressFile.df"
get "Streams.d"

// outgoing procedures
external
	[
	PressInit
	]

// outgoing statics
external
	[ ExternalFileList	//name,indexlen,index, ...
	  Transparent
	  TShirtMode
	  InvertMode
	  LocalFidelity
	  FontPickyMatch
	  nPressRecs
	  Geronimo		//Do everything but print the page, see below.
	]
static
	[ ExternalFileList
	  Transparent=false
	  TShirtMode=false
	  InvertMode=false
	  LocalFidelity=false
	  FontPickyMatch=false  //if true, Swat for any font request that
		//can't be "perfectly" matched
	  nPressRecs = 0;
	  Geronimo	= false	//Converts to limit of Press.bits then exits.
	]

// incoming procedures
external
	[
//PRESS
	Press
	PressUserFinishProc
	PressError
	PressTrap
	DblShift

//PRESSINSTALL
	PressInstall
	IndexFile

//METER
	MeterInit

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

//PRESSML
	MulDiv; Ugt
	DoubleAdd; DoubleSub; DoubleCop

//SCAN
	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
	SetPartBounds;SetPositioninPart
	]

// incoming statics
external
	[
	BitsFile
	PressFile
	tridentVec
	tridentUsed
	FileName

	Directive
	UserCopies
	UserPageStart
	UserPageEnd

	ResolutionS	
	ResolutionB	
	PaperDimensionS
	PaperDimensionB
	nScanLines
	nBitsPerScan
	nBands
	printerMaxBitsPerScan
	printerDevice

	XOffset
	YOffset
	ScaleOffset

	ScreenModulus
	ScreenMagnitude
	ScreenAngle

	DPzero
	BESizes
	DoFileMeter
	DoMeter
	Debug
	SoftScan
	Verbose
	UseMicroCode
	DoEtherReport

	PressVersion
	Report

	PressZone
	PermanentBottom
	OverlayTable
	OverlayReloc
	OverlayBottom
	OverlayTop

	RamImage

	PressSavedUFP
	]

// 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  PressInit(userParams, cfa) = valof
 [
	TypeForm("Press ", 10, PressVersion/256, $., 10, PressVersion&#377, 0)

//Following hint for "Press.State" is overwritten at PressInstall 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 Press.
   let dDirective=0
   let doInstall=false
   ReadComInit()
   let str=vec 20
   let sw=vec 5
   ReadCom(str,sw)			//Bypass "PRESS" command
   for i=1 to sw!0 do switchon sw!i into
		[
		case $I: doInstall=true; endcase
		case $S: dDirective=dDirective%#040000
		case $C: dDirective=dDirective%#020000
		case $P: dDirective=dDirective%#010000; endcase
		default: endcase
		]
   Directive=#170000
   if dDirective then Directive=dDirective

//Very first thing to do is load the RAM:
   let errs=LoadRam(RamImage, true)
   unless errs eq 0 then PressError(210)
   SetBLV(#177776)			//Prepare for a silent boot when finishing.
   PressSavedUFP=@lvUserFinishProc
   @lvUserFinishProc=PressUserFinishProc //Will boot to restore tasks to ROM

   if doInstall then PressInstall(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("Press.State",ksTypeReadOnly,0,0,hintState)
   if s eq 0 % Gets(s) ne hintState!lFP then PressInstall(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 $O: SoftScan=not SoftScan;endcase	//flip ORbit flag
		case $T: Transparent=not Transparent;endcase
		case $M: DoMeter= not DoMeter; endcase
		case $U: UseMicroCode= not UseMicroCode; endcase
		case $V: Verbose= not Verbose; endcase
		case $F: FontPickyMatch=not FontPickyMatch;endcase
		case $R: TShirtMode=not TShirtMode;endcase
		case $N: InvertMode=not InvertMode;endcase
		case $L: LocalFidelity=not LocalFidelity;endcase
		case $G: Geronimo = true; endcase
		default: endcase
		]

   if Debug%TShirtMode%InvertMode then SoftScan=true

//Look for other command modifiers:
   UserCopies=0
   UserPageStart=1
   UserPageEnd=1000

   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+8*3
   Zero(tridentVec,8*3)
	@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 8*3-1 do
	 [ tridentVec!t=TFSInit(pz,true,(2-(t rem 3))*#400 + (7-(t/3)),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 rpPressFile = nil;
   while ReadCom(str,sw) do
	[
	let j=Disambiguate(str)
	unless j then PressError(201, str)
	let num=0
	if j ls 20 then
		[
		unless ReadCom(str,sw) then PressError(202)
		num=ReadNumber(str)	//Leaves fp result in ac1
		]
	switchon j into
	   [
	   case 1: UserCopies=num; endcase
	   case 2: UserPageStart=num; 		//No endcase!!
	   case 3: UserPageEnd=num; endcase
	   case 4:	[
			ResolutionB = num;
			ResolutionS=ResolutionB
			] ; endcase
	   case 5: ScreenModulus=num;endcase
	   case 6: ScreenMagnitude=num;endcase
	   case 7: ScreenAngle=num rem 90;endcase
	   case 8: XOffset=Inches(); endcase
	   case 9: YOffset=Inches(); endcase
	   case 10: ScaleOffset=num; endcase

	   case 20:			// Find and index the PRESS file:
			[
			let p = vec 3000;
			unless ReadCom(str,sw) then PressError(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, FILEPress, str)
			if plen eq 0 then PressError(200, str)

//Salt away the indexed file:
			PressFile=cp
			MoveBlock(cp, p, plen)
			cp=cp+plen
			@rp=lv PressFile
			rpPressFile = rp;
			rp=rp+1
			] ; endcase
	   case 21: Directive=#010000 ; endcase //Reprint
	   case 22: Directive=#1 ; endcase	//Patterns
	   case 23: Directive=#2  ; endcase	//Test
	   ]
	]

   if Debug then
	[
	DoFileMeter=true
	DoEtherReport=false
	]

   if PressFile eq 0 & (Directive&#160000) ne 0 then PressError(203)
   if UserPageStart ls 1 then UserPageStart=1
   if UserPageEnd ls UserPageStart then UserPageEnd=UserPageStart

   nScanLines = MulDiv(ResolutionS, PaperDimensionS, 10);
   nBands=(nScanLines+BANDWidth-1) rshift LogBANDWidth;//divide by power of 2
   nBitsPerScan = MulDiv(ResolutionB, PaperDimensionB, 10);
   if nBitsPerScan gr printerMaxBitsPerScan then
	[
	PressError(205)		//Warning only -- he may be using non-standard
	nBitsPerScan=printerMaxBitsPerScan	//resolution
	]
//Init the ORbit, if necessary
switchon printerDevice into
 [ case printerDover: case printerSequoia: case printerPimlicoAlt:
   case printerPimlico: case printerDurango:
	case printerPuffin: case printerPenguin:
	 OrbitInit()
   default:
 ]

//check for file directory part (referencing external files as in GetDotsFromFile)
if PressFile ne 0 then
   [PR
   let PressSpace=vec 2000
   PressZone=InitializeZone(PressSpace,2000)
   let PressLength=vec 1
// FileStuff(PressFile, PressLength);  // can't use since can be on Trident
   PressLength!0 = 0; PressLength!1 = nPressRecs;
   DblShift(PressLength, -LogPressRecordSize);
   DoubleSub(PressLength,table [ 0;PressRecordSize ])
   if PressLength!0 ls 0 then PressError(100)

   let EL=WindowInit(PressFile)
   WindowSetPosition(EL,PressLength)	//Get to doc dir.
   let DocDir=vec PressRecordSize
   WindowReadBlock(EL,DocDir,PressRecordSize)

   DblShift(PressLength,LogPressRecordSize)
// let nPressRecs=PressLength!1+1

   test PressLength!0 eq 0 & DocDir>>DDV.Passwd eq PressPasswd
    ifnot
      [
      WindowSetPosition(EL, table [ 0; 3; ]);
      unless WindowRead(EL) eq PressPasswd then  // not a Press.bits file
       [ if PressLength!0 then PressError(101); PressError(102); ]
      BitsFile = PressFile; PressFile = 0; Directive = #010000;  // just print
      @rpPressFile = rpPressFile;
      ]
    ifso
      [
      unless DocDir>>DDV.nRecs eq nPressRecs then PressError(103)
      unless DocDir>>DDV.nParts*(size PE/16) le
       DocDir>>DDV.pdRecs*PressRecordSize then PressError(104)
      //old code, commented out by Lyle Ramshaw
	//if (DocDir>>DDV.SoftScan eq 0)%(DocDir>>DDV.SoftScan eq -1) then
	//DocDir>>DDV.SoftScan = DocDir!10;// assume old ddv, used to be here
      if (DocDir>>DDV.SoftScan eq $n)%(DocDir>>DDV.SoftScan eq $N) then
       InvertMode=true
      if (DocDir>>DDV.SoftScan eq $r)%(DocDir>>DDV.SoftScan eq $R) then
       TShirtMode=true
      if (DocDir>>DDV.SoftScan eq $s)%(DocDir>>DDV.SoftScan eq $S) then
       SoftScan=true
      if (DocDir>>DDV.SoftScan eq $t)%(DocDir>>DDV.SoftScan eq $T) then
       Transparent=true
      //Find the file part (if it exists)
      SetPartBounds(EL,DocDir>>DDV.pdStart,DocDir>>DDV.pdRecs)
      SetPositioninPart(EL,table [ 0;0])	//Start reading parts here

      let filefound=false
      let FilePart=vec size PE/16
      for i=1 to DocDir>>DDV.nParts do
         [
         WindowReadBlock(EL,FilePart,size PE/16)
         if FilePart>>PE.Type eq PETypeFile then	//File part
          [ filefound=true;break
          ]
         ]
      ExternalFileList=0
      @rp=lv ExternalFileList
      rp=rp+1
      if filefound then //do indexing operations
         [
         ExternalFileList=cp
         SetPartBounds(EL,FilePart>>PE.pStart,FilePart>>PE.pRecs)
         SetPositioninPart(EL,table [ 0;0])
            [ //repeat loop for all files mentioned
            let fName=vec 40
            fName!0=WindowRead(EL)
            if fName!0 eq 0 then break	//no more
            for i=1 to (fName!0 rshift 9) do fName!i=WindowRead(EL)
            //Strip off "[server]<dir>subdir>" if necessary
            StripServerDir(fName)	// Added by EMV
            //Salt away the file name:
            let plen=(fName!0 rshift 9)+1
            MoveBlock(cp, fName, plen)
            cp=cp+plen
            let p=vec 3000
            plen=IndexFile(p, FILEExternal, fName)
            if plen eq 0 then PressError(200, fName)
            //Salt away the indexed file:
            cp!0=plen
            MoveBlock(cp+1, p, plen)
            cp=cp+plen+1
            ] repeat //for all files 
         ] //end of if filefound
      ]  // end of ifso
   ]PR

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

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

and

PressInitAux() 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 8*3-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=PressTrap
   PressZone=z

//Set up vector for reporting things in:
   compileif ReportSw then
	[
	Report=Allocate(PressZone, size REP/16)
	Zero(Report, size REP/16)
	Report>>REP.Version=PressVersion
	Report>>REP.Directive=Directive
	]

//Re-Initialize Trident disk because it contains addresses ...
// No longer needed -- don't reference the addresses
//   if tridentDisk then TFSSetDisk(tridentDisk, 0, tridentDrive)

   compileif MeterSw then [ if DoMeter then MeterInit() ]

   OverlayTop=PressInit
   OverlayBottom=PressInit

   Press(0)					//And run Press!
]

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: "Pages"
		case 3: "To"
		case 4: "Resolution"
		case 5: "Screen"
		case 6: "Amplitude"
		case 7: "Angle"
		case 8: "XOffset"
		case 9: "YOffset"
		case 10: "Scale"

		case 20: "Print"
		case 21: "Reprint"
		case 22: "Patterns"
		case 23: "Test"
		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
]

// Floating AC1 has a value in inches -- convert to micas:

and Inches() = valof
[
	FLDI(0, 2540)
	FML(1, 0)
	resultis FTR(1)
]

// Routine added by Evelyn Van Orden on 10 January 1980:
// Changed by Evelyn Van Orden on 21 January 1980:

and StripServerDir(name) be
[
	// Change "[server]<dir>subdir>filename" to "filename"
	let sptr = name>>STR.length
	while (name>>STR.char^sptr ne $> &
	       name>>STR.char^sptr ne $] & sptr ge 1) do
	   sptr = sptr - 1
	let diff = name>>STR.length - sptr
	for i = 1 to diff do
	   name>>STR.char^i = name>>STR.char^(i+sptr)
	name>>STR.length = diff 	
](1800)