// 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 GetLogoInfo

// May 1, 1980, 9:42 AM, add fpos parameter to FileLength call in PagesInFileIfFile
//