// P R E P R E S S -- The real thing!
// catalog number ???
//
//Command decoder and dispatcher.
get "ix.dfs"
get "altofilesys.d"
get "streams.d"
// outgoing procedures
external
[
ReadParams
CheckParams
PrePressWindowInit
SwappedOut
]
// outgoing statics
external
[
fam
face
InputFileName
siz
rotation
resolutionx
resolutiony
incline
OutputFileName
params
bigfilename
xfp
yfp
]
static
[
fam
face
InputFileName=0
siz
rotation
resolutionx
resolutiony
incline
OutputFileName=0
params
bigfilename
xfp
yfp
]
// incoming procedures
external
[
//Main command-processing procedures (Convert is in this file)
Convert
PlayOut
SFTOSD
Extract
MergeDelete
Rename
WidthCalc
List
FEdit
Grow
OrbitFormat
Scale
MMFonts
Coordinate
MakeWidths
ImposeWidths
ReadCU
Rotate
//File window stuff.
WindowInit
WindowClose
WindowSetPosition
WindowGetPosition
WindowReadBlock
WindowWriteBlock
WindowRead
WindowWrite
WindowCopy
// PrePressUtil
FSInit
FSGetX
FSPut
Scream
NoFile
IllCommand
EncodeFace
//Character conversion subroutines.
ConvertAChar
ConvertAWidth
SetSCVTransform
//Scan
TypeForm
PrintNumber
ReadNumber
StrCop
StrEq
ReadComInit
ReadCom
//For opening files
OpenFile
sysDisk
Dvec
//Float
FLD;FST;FTR;FLDI;FNEG;FAD;FSB;FML;FDV;FCM;FSN
FLDV;FSTV;FLDDP;FSTDP;DPAD;DPSB; DPCop
//TFS + RAM
LoadRam; DiskRamImage
TFSInit
TFSClose
// OS
OpenFileFromFp
Closes
ReadBlock
JumpToFa
]
// incoming statics
external
[
prePressZone
]
// internal statics
static
[
tridentDisk // non-zero if look for things on Trident
tridentNeeded
cfa
]
// File-wide structure and manifest declarations.
structure STR: [
length byte
char↑1,255 byte
]
manifest strlen=10 //Number of words
// Procedures
let Main(nil,nil,cfaIn) be [
TypeForm("PrePress 1.5, August 5, 1977*n")
cfa=cfaIn
let famvec=vec 12 //Vector for family name
fam=famvec
fam!0=0
let bigvec=vec 12 //Vector for big file name
bigfilename=bigvec
bigfilename!0=0
let fpvec=vec 4
xfp=fpvec
yfp=fpvec+2
ReadComInit()
let str=vec 10
let sw=vec 10
ReadCom(str, sw) //Bypass "PREPRESS"
let swt=false
if sw!0 ne 0 then swt=sw!1
if swt eq $T then //Try trident disk
[
tridentNeeded=true
LoadRam(DiskRamImage, true)
]
@#335=LoadRam
unless ReadCom(str,sw) then IllCommand()
// Now interpret switches on the command name:
let fileCode=0
let fast=false
let swt=0
for i=1 to sw!0 do
[
swt=sw!i
switchon swt into [
case $C: fileCode=1; endcase
case $S: fileCode=2; endcase
case $W: fileCode=3; endcase
case $F: fast=true; endcase
default: endcase
]
]
let defFileCode=(fileCode? fileCode, 1)
// Look up the command itself; need only type enough to disambiguate.
let commandCode=Disambiguate(str) //Look it up.
if commandCode eq 0 then IllCommand()
if commandCode ge 10 then ReadParams()
if commandCode ge 30 & fileCode eq 0 then IllCommand()
switchon commandCode into [
case 1: Overlay(3); SFTOSD(swt eq $U); endcase
case 2: Overlay(2); PlayOut(0); endcase
case 3: Overlay(2); PlayOut(1); endcase
case 4: Overlay(2); PlayOut(2); endcase
//case 5: Overlay(2); MMFonts(swt); endcase
case 6: Overlay(2); PlayOut(3); endcase
case 7: Overlay(2); MakeWidths(); endcase
case 8: Overlay(2); ReadCU(); endcase
case 9: Overlay(2); Rotate(); endcase
case 10: Overlay(2); Grow(true); endcase
case 11: Overlay(2); Grow(false); endcase
case 12: Overlay(4); FEdit(swt eq $N); endcase
case 13: Overlay(3); Convert(swt eq $T); endcase
case 14: Overlay(1); MergeDelete(defFileCode,0); endcase
case 15: Overlay(1); List(defFileCode, not fast); endcase
case 16: Overlay(2); Coordinate(); endcase
case 17: Overlay(2); OrbitFormat(); endcase
case 18: Overlay(2); Scale(); endcase
case 19: Overlay(2); ImposeWidths(defFileCode); endcase
case 30: Overlay(1); Extract(fileCode); endcase
case 31: Overlay(1); MergeDelete(fileCode,1); endcase
case 32: Overlay(1); MergeDelete(fileCode,2); endcase
case 33: if fileCode eq 3 then IllCommand()
Overlay(1); WidthCalc(fileCode); endcase
case 34: Overlay(1); Rename(fileCode); endcase
default: Scream("Unknown command")
]
if tridentDisk then TFSClose(tridentDisk)
]
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: "ReadSf"
case 2: "Show"
case 3: "MakeCu"
case 4: "MakeAl"
// case 5: "MakeMM"
case 6: "MakeStrike"
case 7: "ReadWidths"
case 8: "ReadCu"
case 9: "Rotate"
case 10: "Grow"
case 11: "Shrink"
case 12: "Edit"
case 13: "Convert"
case 14: "Delete"
case 15: "List"
case 16: "Coordinate"
case 17: "OrbitFormat"
case 18: "Scale"
case 19: "ImposeWidths"
case 30: "Extract"
case 31: "Merge"
case 32: "Supercede"
case 33: "Width"
case 34: "Rename"
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 0
]
and
//Read family, face, size, rotation, resolution etc from
// command line.
ReadParams() = valof [
params=0 //Mask of what is params
siz=0 //Set defaults
rotation=0
incline=0
resolutionx=2000
resolutiony=2000
let str=vec 20; let sw=vec 10
[ if ReadCom(str,sw) eq 0 then break //End of line
for i=1 to sw!0 do switchon sw!i into
[
case $N: [ //Name
StrCop(str,fam)
params=params%gotname
endcase
]
case $F: [ //Face
face=EncodeFace(str>>STR.char↑1,
str>>STR.char↑2,
str>>STR.char↑3)
if face eq -1 then
TypeForm("Illegal face in command.*N*L")
params=params%gotface
endcase
]
case $S: [ //Source file name
InputFileName = FSGetX(20)// small names only!
StrCop(str,InputFileName)
endcase
]
case $O: [ // output file name
OutputFileName = FSGetX(20)// small names only!
StrCop(str,OutputFileName)
endcase
]
case $P: [ //Size in points
ReadNumber(str)
FLDI(2,635);FML(1,2);FLDI(2,18);FDV(1,2)
siz=FTR(1)
params=params%gotsize
endcase
]
case $M: [ //Size in micas
siz=ReadNumber(str)
params=params%gotsize
endcase
]
case $R: [ //Rotation in degrees
ReadNumber(str)
FLDI(2,60)
FML(1,2) //convert to minutes
rotation=FTR(1)
params=params%gotrotation
endcase
]
case $I: [ //Incline
incline=ReadNumber(str)
params=params%gotincline
endcase
]
case $B: [ //Big file name
StrCop(str,bigfilename)
endcase
]
// resol/D sets both x,y resolutions; resol/E sets y only
case $D: case $E: [ //Device
let res=0
let c=str>>STR.char↑1
test $0 le c & c le $9 then res=ReadNumber(str)
or
[
if StrEq(str,"XGP") then res=2000
if StrEq(str,"ALTO") then res=720
if StrEq(str,"SLOT") then res=5000
if StrEq(str,"EARS") then res=5000
if StrEq(str,"DOVER") then res=3500
if res eq 0 do Scream("Illegal device.")
]
resolutiony=res
if sw!i eq $D then resolutionx=res
params=params%gotresolution
endcase
]
case $X: case $Y: [ //Factors
ReadNumber(str)
FST(1, yfp)
if sw!i eq $X then FST(1, xfp)
params=params%gotfactors
endcase
]
default: IllCommand()
]
] repeat
]
and
CheckParams(p)= valof [
let ans=((p&(not params)) eq 0)
if ans eq false then TypeForm("Insufficient parameters.*N")
resultis ans
]
and
PrePressWindowInit(n,rw,lvnam; numargs nargs) = valof [
if nargs eq 1 then rw=true
let nam=selecton n into [
case 0: "PrePress.Scratch"
case 1: "CD"
case 2: "SD"
case 3: "WD"
case -1: "CDtemp"
case -2: "SDtemp"
case -3: "WDtemp"
default: n ]
if n gr 0 & n le 3 & bigfilename!0 ne 0 then nam=bigfilename
if nargs gr 2 then @lvnam=nam
//Look for files on Trident first if tridentDisk exists (ne 0)
let typ=(rw ne 0)? ksTypeReadWrite, ksTypeReadOnly
let disk=tridentDisk
let zone=prePressZone
let ver=verLatest
for diskNo=0 to 1 do
[
if disk ne 0 then
[
let s=OpenFile(nam, typ, 2, ver, 0, 0, zone, 0, disk)
if s then resultis WindowInit(s)
]
disk=sysDisk
ver=0
zone=0
]
if nam eq n then resultis 0
NoFile(nam)
finish
]
// Overlay-reading routines. Given number of overlay, read it in.
// Starts from cfa passed to main routine.
and Overlay(ovNum) be
[
let s=OpenFileFromFp(lv cfa>>CFA.fp)
JumpToFa(s, lv cfa>>CFA.fa)
let dope=vec 16
let overlayBottom=@#335
for i=1 to ovNum do
[
ReadBlock(s, dope, 16)
let len=((dope!4+255)&(-256))-16
ReadBlock(s, overlayBottom, len)
]
Closes(s)
let reloc=overlayBottom+dope!3-16
let nRel=reloc!0*2
for p=1 to nRel by 2 do @(reloc!p)=reloc!(p+1)+overlayBottom
@#335=reloc
FSInit(2000)
// If he asked for trident disk, and if routines are loaded in this
// overlay, give it to him!
if tridentNeeded ne 0 & TFSInit ne SwappedOut then
tridentDisk=TFSInit(prePressZone, 1) //Create
]
and SwappedOut() be Scream("Called swapped out procedure")