// SpruceInUtil -- Spooler and Printer file installation utilities 
//  errors 280

 //   get "Spruce.d" makes too many "get" files ~~not used anyway!!!!

    get "Sprucefiles.d"
	get "SpruceMisc.d"
    get "AltoFileSys.d"
    get "Disks.d"
    get "Bfs.d"
    get "isf.d"
	get "pressfile.d"

compileif newname SpruceSw then [ manifest [ SpruceSw = true ] ] // ~~
external // defined here
	[
	CreateFPRD
	GetLogoInfo
	GetPrinterNames
	MakeValidSpruceFile
	SetupDrive
	StatusOf31s
	ValidateSpruceFile
	]

external // external
	[
	// Spruce Files
	CreateSpruceFile
	DiskObject
	ForgetSpruceFile
	InitSpruceFile
	ResetSpruceFile

	// Spruce Utils  and  UtilsRes
	FSGetX
	FSPut
	Max
	Min
	SpruceError

	// TFS
	DiskFindHole
	ReleaseDiskPage
	AssignDiskPage
	TFSInit

	// ISF
	InitFmap

	// Pre-Junta OS
	DeleteFile
	FileLength
	GetCurrentFa
	OpenFile
	PositionPage
	ReadBlock
	ReadLeaderPage
	RealDiskDA
	VirtualDiskDA
	WriteBlock
	WriteLeaderPage

	// OS
	Closes
	DefaultArgs
	MoveBlock
	ReturnFrom
	Zero

	// BFS
	BFSInit
	BFSFindHole
	BFSSetStartingVDA

	//StringUtils
	CopyString
	StringCompare

	ReadUserCmItem

	// Statics
	drive1Disk
	LogoFont
	LogoText
	SpruceZone
	sysDisk
	tridentDisk
	tridentDrive
	statusOf31s
	]

// ------------------------------------------------------
let ValidateSpruceFile(lvSpruceFile, numPages) = valof
// ------------------------------------------------------
//	At present, used only by MakeValidSpruceFile(), below. lvSpruceFile is the address of a static. If
// non-zero, it is asserted to denote a SPruceFile structure. Returns true if the denoted structure is
// valid using these criteria: the deviceCode specifies a currently available device, the file hint works,
// and the file is numPages long (numPages=-1 disables the test).
//	On failure, eliminate the file structure, if any, and return 0.
	[
	// criteria:
	//   static has a value; fp works; numPages = number of pages in file
	//   deviceCode (disk) is current legal option
	// not checked: SPruceFile structure thoroughly for reasonable fields; map agrees with numPages
	// penalty for failure: SpruceFile forgotten, static cleared, resultis false
	let sF = @lvSpruceFile; unless sF resultis false
	let deviceCode = sF>>SPruceFile.deviceCode
	if DiskObject(deviceCode) & (numPages eq -1 % sF>>SPruceFile.numPages eq numPages) then
	    [
	    InitSpruceFile(sF); ResetSpruceFile(sF) // set disk in map, etc., then invalidate
	    let map = sF>>SPruceFile.map
	    let nCh = nil
	    let nP = PagesInFileIfFile(0, lv map>>FM.fp, map>>FM.disk, lv nCh)
	    if nP eq sF>>SPruceFile.numPages & nCh eq sF>>SPruceFile.numChars resultis true
	    ]
	ForgetSpruceFile(sF); @lvSpruceFile = 0
	resultis false
	]

// ------------------------------------------------------
and MakeValidSpruceFile(lvSpruceFile, name, numPages, deviceCode, baseZone; numargs na) = valof
// ------------------------------------------------------
//	Utility for creating files (using the OS) and creating their SPruceFile structure.  lvSpruceFile is
// a static address. A non-zero value denotes a SPruceFile. If it checks out, return true. Otherwise create
// a file with the name and length given, on the given device. If either deviceCode or numPages is -1,
// the file must exist for this function to succeed (none will be created). It may have any valid device
// and/or size, depending on defaulted argument(s). baseZone is as in CreateSpruceFile.
//	Fills the static at @lvSpruceFile with file result, if any, or 0. Returns true (contents OK) only if
// file previously existed and had proper length and device code (or checking was not required.)
//	Will delete a prevous file to reallocate one of the proper length (to help assure contiguity.) 
    [
    DefaultArgs(lv na, 4, SpruceZone)
    let sF = @lvSpruceFile
    if sF then
	[
	unless numPages eq -1 do sF>>SPruceFile.numPages = numPages
	unless deviceCode eq -1 do sF>>SPruceFile.deviceCode = deviceCode
	if ValidateSpruceFile(lvSpruceFile, numPages) resultis true // a natural!
	]
    let devTry = deviceCode ge 0? deviceCode, DISK31 // default, if none specified
    let okFile = false // Alto file itself OK
    let disk = DiskObject(devTry)
    unless disk resultis false // and @lvSpruceFile has been zeroed by above validation
    let fp = vec lFP
	let nCh = nil
    let nP = PagesInFileIfFile(name, fp, disk, lv nCh)
    if nP ne -1 then
	[
	if numPages eq -1 then numPages = nP
	test nP eq numPages then okFile = true or
		unless deviceCode eq -1 do DeleteFile(name, 0, 0, SpruceZone, 0, disk)
	]
    unless okFile do
	[
	if numPages eq -1 % deviceCode eq -1  resultis false
	let contiguous = AllocContigArea(disk, numPages)
	// ~~ need way of reporting nature of false results with static 0
	Zero(fp, lFP)
	let ns = OpenFile(name, ksTypeWriteOnly, 0, 0, fp, 0, SpruceZone, 0, disk)
	unless ns resultis false // ~~ need way to report failure
	PositionPage(ns, numPages+1, true) // make the file the right size
	if contiguous then RecordContigArea(ns, disk); Closes(ns)
	]
    sF = CreateSpruceFile(fp, numPages, SpruceZone, devTry, baseZone)
    unless sF do SpruceError(260) // very unexpected
    @lvSpruceFile = sF
    resultis okFile
    ]

// ------- Utilities for above functions, CreateFPRD  -------
// ------------------------------------------------------
and PagesInFileIfFile(name, fp, disk, lvNCh; numargs na) = valof
// ------------------------------------------------------

//	If there's a file with the given fp, or with the given name, return its length in pages -- else -1.
//	If fp contents are zero and name exists, fill fp via OpenFile.
	[
	if name then Zero(fp, lFP)
	let s = OpenFile(name, ksTypeReadOnly, 0, 0, fp, 0, SpruceZone, 0, disk)
	let fa = vec lFA; let fpos = vec 1    // fpos only so FileLength has a place
	unless s resultis -1; FileLength(s, fpos); GetCurrentFa(s, fa); Closes(s)
	let np, nCh = fa>>FA.pageNumber, fa>>FA.charPos
	@lvNCh = fa>>FA.charPos
	if nCh eq 0 & np>0 then nCh, np = 1 lshift (disk>>DSK.lnPageSize+1), np-1
	if na ge 4 & lvNCh then @lvNCh = nCh
	resultis np
	]

// ------------------------------------------------------
and AllocContigArea(disk, numPages) = valof
// ------------------------------------------------------
//	Allocate contiguous area of given size. Spruce likes contigous files.
    [
    let bVDA=(disk eq tridentDisk? DiskFindHole, BFSFindHole)(disk,numPages+2) //leader, empty end
    if bVDA eq -1 resultis false
    test disk eq tridentDisk then ReleaseDiskPage(disk, AssignDiskPage(disk, bVDA-1))
	or BFSSetStartingVDA(disk,bVDA)
    resultis true
    ]

// ------------------------------------------------------
and RecordContigArea(s, disk) be
// ------------------------------------------------------
//	Mark file contiguous
	[
	let p = FSGetX(1200)
	ReadLeaderPage(s, p); p>>LD.consecutive=true; WriteLeaderPage(s, p)
	FSPut(p)
	]

// ------------------------------------------------------
and CreateFPRD(name, createIfMissing) = valof
// ------------------------------------------------------
//	Allocates a 256-page boot file with the given name, if necessary, and creates the funny mangled
// fp required by InLd and OutLd (leaderVirtualDa entry is the REAL disk address for the first DATA
// page in the boot file.)
	[
	let fprd = FSGetX(lFP, SpruceZone, 0)
	let s = OpenFile(name,(createIfMissing? ksTypeReadWrite, ksTypeReadOnly),0,0,fprd)
	unless s resultis 0
	FileLength(s) // Go to EOF, minimize work of PositionPage
	if  PositionPage(s, 256, createIfMissing) resultis 0 // exists but is not long enough
	PositionPage(s, 1)
	let fa = vec lFA
	GetCurrentFa(s, fa)
	Closes(s)
	// Raw disk address for data page 1
	RealDiskDA(sysDisk, fa>>FA.da, lv fprd>>FP.leaderVirtualDa)
	resultis fprd
	]

// ------- Functions for creating, deleting, disk structures  -------
// ------------------------------------------------------
and SetupDrive(deviceCode, zone, allocate; numargs na) = valof
// ------------------------------------------------------
//	deviceCode =
//		DISK31: create sysDisk, use statusOf31s to determine file system setup
//		DISK31B: create drive1Disk, if possible
//		DISKT80: create tridentDisk, if possible
//	In any case, if the relevant static is already set, forget it -- wipers-out of these
//	structures must clear the statics
    [
    if na<3 then allocate = false
    let lvDisk = selecton deviceCode into
	[ case DISK31: lv sysDisk; case DISK31B: lv drive1Disk; case DISKT80: lv tridentDisk ]
    if @lvDisk resultis @lvDisk
    let disk = deviceCode eq DISKT80? TFSInit(zone, allocate, tridentDrive, 0, not allocate),
	    			       BFSInit(zone, allocate, deviceCode, 0, not allocate, SpruceZone)
    if disk&deviceCode eq DISK31&statusOf31s eq 2 then disk>>BFSDSK.nDisks = 2
    @lvDisk = disk
    resultis disk
    ]

and StatusOf31s() = sysDisk>>BFSDSK.nDisks eq 2? 2, 0

// here because no room in SpruceInstall
and GetPrinterNames(pNameTab) be
[ compileif SpruceSw then [
   CopyString(pNameTab!0, "Printr1")
   CopyString(pNameTab!1, "Printr2")
   CopyString(pNameTab!2, "Printr3")
   CopyString(pNameTab!3, "Printr4")
   CopyString(pNameTab!4, "Printr5")
   let userCm = OpenFile("User.Cm", ksTypeReadOnly, charItem, 0, 0, 0, SpruceZone)
   if userCm do
	[
	let buf = FSGetX(128)
	let needSpruce, pparm = true, -1
		[
		switchon ReadUserCmItem(userCm, buf) into
			[
			case $E: break; endcase
			case $N: needSpruce = StringCompare(buf, "Spruce"); endcase
			case $L: unless needSpruce do
				for i = 0 to 4 do [ unless StringCompare(buf, pNameTab!i) then pparm = i ]
				endcase
			case $P: case $S: if pparm ge 0 do
				[
				if buf>>STR.length > 7 then buf>>STR.length = 7
				CopyString(pNameTab!pparm, buf)
				]
				pparm = -1
				endcase
			] 
		] repeat
	]	// storage recovered by FSInit in SpruceInstall
] ]

and GetLogoInfo() be
[ compileif SpruceSw then [
  LogoFont = FSGetX(FElen)
  MoveBlock(lv LogoFont>>FE.fam, "HELVETICA", 3)
  LogoFont>>FE.length = FElen
  LogoFont>>FE.siz = 24
  LogoFont>>FE.face = 0
  LogoFont>>FE.fno = 1
  LogoFont>>FE.set = 64
  LogoFont>>FE.rotn = 0
  LogoText = FSGetX(3)
  CopyString(LogoText, "  ")		// no logo unless user.cm entry
  let userCm = OpenFile("User.Cm", ksTypeReadOnly, charItem, 0, 0, 0, SpruceZone)
   if userCm do
  [
  let buf = FSGetX(128)
  let needSpruce, which = true, 0
    [
    switchon ReadUserCmItem(userCm, buf) into
      [
      case $E: break; endcase
      case $N: needSpruce = StringCompare(buf, "Spruce"); endcase
      case $L: unless needSpruce do
        unless StringCompare(buf, "LogoFont") do [ which = 1; endcase ]
        unless StringCompare(buf, "LogoText") do [ which = 2; endcase ]
        which = 0; endcase
      case $P: case $S: if which eq 1 do
        [
        let  char, gotFam, fSize, fFace = nil, false, 0, 0
        for i = 1 to buf>>STR.length  do
          [
          char = buf>>STR.char^i
          if (char ge $0) & (char le $9) do
            [
            unless gotFam do 
              [ buf>>STR.length = Min((i-1), 19);MoveBlock(lv LogoFont>>FE.fam, buf, (buf>>STR.length +2)/2); gotFam =true ]
            fSize = fSize*10 +(char-$0); loop
            ]
          unless gotFam loop
          fFace = fFace + selecton char into
            [
            case $B: 1
            case $C: 6
            case $E: 12
            case $I: 1
            case $L: 2
            default: 0
            ]
          ]
       LogoFont>>FE.siz = fSize
       LogoFont>>FE.face = fFace
      endcase
       ]
   if which eq 2 do [ let i = (buf>>STR.length + 1)/2; LogoText = FSGetX(i);
MoveBlock(LogoText, buf, i) ]
endcase ]
] repeat ] ] ]


// -------- History . . .

// DCS, September 8, 1978  3:47 PM, Derived (loosely) from SpruceInUtil
// September 8, 1978  6:24 PM, finish first round ~~ no reasonable error explanations
// September 14, 1978  10:51 AM, DiskObject to SpruceFiles
// September 18, 1978  9:15 AM, CreateSpruceFile now uses OS to make right size -- pull
// 		cfa nonsense.
// September 18, 1978  9:55 AM, inherit CreateFPRD from SpruceUtils
// September 19, 1978  5:40 PM, format, document
// September 22, 1978  11:10 AM, don't set up drive1 if there isn't one (OpenFile fails)
// October 16, 1978  9:16 AM, modify for fast file
// October 27, 1978  5:07 PM, use BFSInit for SetupDrive, delete CloseDrive1 (use BFSClose if needed)
// November 5, 1978  12:25 PM, use new BFS features to create contiguous files
// May 11, 1979  1:31 PM fix call to PagesInFileIfFile in MakeValidSpruceFile
// September 7, 1979  1:39 PM, replace TFSSetStartingVDA with ReleaseDiskPage... for OS17
// September 26, 1979  1:19 PM, add GetPrinterNames
// November 16, 1979  11:37 AM, add GetLogoInfoz20598(1792)
// May 1, 1980, 9:42 AM, add fpos parameter to FileLength call in PagesInFileIfFile
// z20598