//SilInit.bcpl


get "SysDefs.d"
get "Sil.defs"


static [ @WidthVec; @FileVec; @ItalicsBuff; @Font3Special ]

manifest NameSpacer = ($*n)*256 + $*n



let MakeInitFile() be //get all the stuff that sil needs and place in a binary file
[

let FontNames = vec 50*(10+1); Zero(FontNames,50*(10+1))
for i = 0 to 9 do
[

FontNames!i = FontNames+25+(50*i) //10 length 25 vectors
FontNames!(i+10) = FontNames+25+(50*i)+25 //10 length 25 vectors

]
//let Fontvec = vec 100
let FpVec = vec 10*DirPreambleSize; Zero(FpVec, 10*DirPreambleSize)
let widthBuff = @#335

ParseUserCm(FontNames) //read in fonts indicated in User.cm
OpenFiles(FontNames,FpVec) //get FpHints for libraries
ReadWidths(FontNames,widthBuff)//read in mica widths for fonts


//now we have all the information, open the output files
Zero(fpSilInit,5) //make sure we get a new valid file pointer to Sil.fonts
InitS = OpenFile("Sil.fonts",ksTypeWriteOnly,0,0,fpSilInit)

Puts(InitS,InitRev) //Rev level ID
for i = 0 to 3 do
[
let str = FontNames!i
Puts(InitS,str!0)
for j = 1 to str>>str.length/2 do Puts(InitS,str!j)
Puts(InitS,NameSpacer)
]
for i = 20 to 23 do Puts(InitS,FontNames!i)//these are baseline offsets used for printing
for i = 0 to 3 do Puts(InitS,PrFaceVec!i)
for i = 0 to 3 do Puts(InitS,AlFaceVec!i)
Puts(InitS,0); Puts(InitS,0); Puts(InitS,0); Puts(InitS,0) //unused - for expansion
Puts(InitS,mx); Puts(InitS,my)
Puts(InitS,Font3Special)

//Make up a 16 word table which is FileVec with the computed file pointers in it
let filePtr = FilePos(InitS) + (16+1)*2//this place plus 16 plus 1 word
for i = 0 to 15 do
[
let ptr = WidthVec!i
if ptr eq 0 then loop //widths for this font/face are undefined
let copyOf = 0
if i ne 0 do for j = 0 to i-1 do//check to see if we have a duplicate widths table
[

copyOf = j%#20
let p = WidthVec!j
for w = 32 to 127 do if p!w ne ptr!w then [ copyOf = 0; break ]
if copyOf then break

]
test copyOf ne 0
ifso [ FileVec!i = copyOf; WidthVec!i=0 ]//set file ptr and set widths to unused
ifnot [ FileVec!i = filePtr; filePtr = filePtr + 2*(128+1) ]
]

for i = 0 to 15 do Puts(InitS,FileVec!i)

//now send out the actual widths
//each block of 128 words is preceeded by a -1 for sync checking
for i = 0 to 15 do
[
let ptr = WidthVec!i; if ptr eq 0 then loop //no widths to send
Puts(InitS,-1); for w = 0 to 127 do Puts(InitS,ptr!w)//send out the widths
]
Closes(InitS)

InitS = OpenFile("Sil.fps",ksTypeWriteOnly)

//now write the file pointer file
for i = 0 to 9*DirPreambleSize-1 do Puts(InitS,FpVec!i)
//for i = 0 to 5*DirPreambleSize-1 do Puts(InitS,Libvec!i)
for i = 0 to 5 do Puts(InitS,fpSilInit!i)
Closes(InitS); InitS=0

]

and ParseUserCm(names) be
[

//now start on user.cm
let cmstr = vec 128
let gotsil = false

let PrNameVec = names
let AlNameVec = names + 10
let BaseLineVec = names + 20
let Ystr = vec 50; Zero(Ystr,50)
let Xstr = vec 50; Zero(Xstr,50)

let s = OpenFile("User.cm",ksTypeReadOnly,1,0,fpUserCm) //open for bytes
if s eq 0 then CallSwat("Can’t open User.cm")
let str = 0
[

switchon ReadUserCmItem(s,cmstr) into
[

case $E: Closes(s);break //end of stream

case $N: test gotsil
ifnot [ gotsil = StEq(cmstr,"SIL",nil); endcase ]
ifso [ Closes(s);break ] //done with User.cm

case $L:
[
str = 0
unless gotsil then endcase
if cmstr>>str.length gr 1 then endcase
let C = cmstr>>str.char↑1
if (C eq $X) % (C eq $x) then [ str = Xstr; endcase ] //found Xcoord entry
if (C eq $Y) % (C eq $y) then [ str = Ystr; endcase ] //found Xcoord entry
if (C ge $0) & (C le $9) then [ str = names!(C-$0); endcase ]
endcase
]

case $P:
[
if str eq 0 then endcase
if not gotsil then CallSwat("Got lost reading User.cm")
let i = 1
let L = cmstr>>str.length
for wd = 0 to 1 do
[

while cmstr>>str.char↑i le $*s do i=i+1
[

if i gr L then break
let char = cmstr>>str.char↑i
if char eq $/ then break //this will get "//" comments
if char le $*s then break
AppendC(char,str)
i = i+1

] repeat
str = str+25

]
]
endcase
]

] repeat

mx = GetNum(Xstr,mx)
my = GetNum(Ystr,my)
if my gr 748 then my = 748 // dont let status be off the bottom of the screen
if mx gr 132 then mx = 132 // dont let status be to far right

]

and OpenFiles(names,FpVec) be
[

let PrNameVec = names
let AlNameVec = names + 10
let BaseLineVec = names + 20
//now have all the font names (without extensions) in namevec, with the
//associated font numbers in idvec. We found cnt font specifiers.

for i = 0 to 3 do if @AlNameVec!i eq 0 then AppendS(PrNameVec!i,AlNameVec!i)

if @AlNameVec!0 eq 0 then CallSwat("No font 0 in user.cm")

//tack ".al" onto alto names
for i = 0 to 3 do
[

let str = AlNameVec!i
if str!0 eq 0 then loop
AlFaceVec!i = -1
for p = str>>str.length to 1 by -1 do
[
let chr = str>>str.char↑p
if (chr eq $I) % (chr eq $i) then AlFaceVec!i = AlFaceVec!i & not 1
if (chr eq $B) % (chr eq $b) then AlFaceVec!i = AlFaceVec!i & not 2
if (chr ge $0) & (chr le $9) then break//point size - done with faces
]
AppendS(".al",AlNameVec!i)
if StEq("Gates32.al",AlNameVec!i,true) then test i eq 3
ifso Font3Special = true
ifnot CallSwat("Gates32 must be Font 3 for Logic Design. ↑P if OK")

]

for i = 5 to 9 do //default library files to sil.lbx if not defined in user.cm
[

let UserCmName = PrNameVec!i
let libName = AlNameVec!(i-1) // make 0-9 contiguous with no 4
test UserCmName>>str.length eq 0

ifso [ AppendS("SIL.LB",libName); AppendN(i,libName) ]

ifnot AppendS(UserCmName,libName)

]
let q = OpenFileFromFp(fpSysDir)
if q eq 0 then CallSwat("Cant open SysDir")

LookUpEntries(q,AlNameVec,FpVec,9,true)
Closes(q)

//if nfound gr (4-cnt) then CallSwat("Can’t find all your .al fonts")
for f = 0 to 3 do
[
let flg = 0
if @AlNameVec!f eq 0 then loop //no font specified
test FpVec!(f*DirPreambleSize) ne 0
ifso flg = true
ifnot if f ne 0 then for i = 0 to f-1 do//see if it is specified by an earlier string
if StEq(AlNameVec!i,AlNameVec!f) then [ flg = i%4; break ]
FpVec!(f*DirPreambleSize) = flg
if flg eq 0 then CallSwat("Cant find font: ",AlNameVec!f)
]

for f = 0 to 3 do
[
let fp = FpVec + (f*DirPreambleSize) + 1
if fp!-1 eq 0 then [ BaseLineVec!f = BaseLineVec!0; loop ] //not used
if fp!-1 gr 0 then [ BaseLineVec!f = BaseLineVec!(fp!-1&3); loop ]//point to font
let st = OpenFileFromFp(fp)
if st eq 0 then CallSwat("Can’t open font n:")
//we are interested only in the height of the font from the top to the
//baseline. This is in bits 1-7 of the second word of the font
Gets(st)
BaseLineVec!f = (Gets(st) rshift 8) & #177
Closes(st)
]

]

//and ReadLibFps(Fpvec,names) be //get fp’s for SIL.LB5 to SIL.LB9 //done before junta
//[

//let namevec = vec 5
//let libvec = vec 125 //5 25 word vectors
//Zero(libvec,125)
//for i = 0 to 4 do namevec!i = libvec+(25*i)
//for i = 5 to 9 do //see if a font was specified, and default to Sil.lbx if not
//[

//let libName = names!i
//if libName>>str.length eq 0 then
//[

//AppendS("SIL.LB",libName)
//AppendN(i,libName)

//]

//]
//let q = OpenFileFromFp(fpSysDir)
//if q eq 0 then CallSwat("Can’t Open SysDir")
//LookUpEntries(q,names+5,Fpvec,5,true)
//Closes(q)

//]


and ReadFont(number,fp) be
[

let st = OpenFileFromFp(fp)
if st eq 0 then
[
let str = "Can’t open font n, run Sil/I again."; str>>str.char↑17 = number+$0
CallSwat(str)
]
let adr = @#335 //load font at EndCode
until Endofs(st) do
[

@adr = Gets(st)
adr = adr+1

]
FontVec!number = (@#335)+2
@#335 = adr //increment EndCode
Closes(st)

]

and ReadWidths(names,widthBuff) be
[

external [ EncodeFace; LookupFontName ]
let Widths = widthBuff
let bufy = vec 256
let bufbb = vec 4
let S = OpenFile("Fonts.Widths",ksTypeReadOnly)
if S eq 0 then CallSwat("Can’t open Fonts.Widths")
Zero(Widths,16*128)
for f = 0 to 3 do
[

let str = names!f
let Face = vec 25; Face!0 = 0
let length = str>>str.length
if length eq 0 then loop //skip fonts not specified in user.cm
if (str>>str.char↑1 & #137) ne $X then AppendC(str>>str.char↑1,Face)
let Fptr = 2
[

if str>>str.char↑Fptr le #100 then break
AppendC(str>>str.char↑Fptr,Face)
Fptr = Fptr+1; if Fptr gr length then break
] repeat
let PtSize = GetNum(str,0)
PrFaceVec!f = 0
[
Fptr = Fptr+1; if Fptr gr length then break
switchon str>>str.char↑Fptr into
[

case $B:
case $b: PrFaceVec!f = PrFaceVec!f % 2; endcase
case $I:
case $i: PrFaceVec!f = PrFaceVec!f % 1; endcase
case $.: break
default: endcase

]
] repeat

//now look up all the faces: normalize the entries by the default face
let FaceCode = EncodeFace($M,$R,$R)
if LookupFontName(S,Face,FaceCode,PtSize,0,Widths,bufy,bufbb) then
WidthVec!(4*f) = Widths
Widths = Widths+128

FaceCode = EncodeFace($M,$I,$R)
if LookupFontName(S,Face,FaceCode,PtSize,0,Widths,bufy,bufbb) then
WidthVec!(4*f +1) = Widths
Widths = Widths+128

FaceCode = EncodeFace($B,$R,$R)
if LookupFontName(S,Face,FaceCode,PtSize,0,Widths,bufy,bufbb) then
WidthVec!(4*f +2) = Widths
Widths = Widths+128

FaceCode = EncodeFace($B,$I,$R)
if LookupFontName(S,Face,FaceCode,PtSize,0,Widths,bufy,bufbb) then
WidthVec!(4*f +3) = Widths
Widths = Widths+128


//CallSwat if no widths for the default face exists
if WidthVec!(4*f+PrFaceVec!f) eq 0 then CallSwat("Can’t find widths for",str)

]
//undefined chars get zero width (undefined characters are assigned #100000)
for w = 0 to 16*128 -1 do widthBuff!w = widthBuff!w & #77777
Closes(S)

]

and GetNum(str,initval) =valof
[

if str>>str.length eq 0 then resultis initval
let minus=false
let val=0
if str>>str.char↑1 eq $- then minus = true
for cnt = 1 to str>>str.length do
[

let char =str>>str.char↑cnt
if char ge $0 & char le $9 then val = val*10 + char - $0

]
val = val & #77777 //make sure val is positive

resultis minus? -val,val //and assign sign

]

and StEq(s1,s2,ulEqual; numargs na) = valof //string compare
[

if s1>>str.length ne s2>>str.length then resultis false
ulEqual=(na ne 2)? 177737b,-1
for i = 1 to s1>>str.length do
if ((s1>>str.char↑i xor s2>>str.char↑i)&ulEqual) ne 0 then resultis false
resultis true

]