// RSilInit.bcpl

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


static [ @WidthVec; @FileVec; @ItalicsBuff; @Font3Special ]
static [ XMstart = 1000 ]
static [ LeftMargin = 28 ]

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*(15+1); Zero(FontNames,50*(15+1))
for i = 0 to 14 do
[

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

]
//let Fontvec = vec 100
let FpVec = vec 15*DirPreambleSize; Zero(FpVec, 15*DirPreambleSize)

ParseUserCm(FontNames) //read in fonts indicated in User.cm
OpenFiles(FontNames,FpVec) //get FpHints for libraries
//let BoundingBox = vec 16
let BoundingBox = vec 28// 4*7
let widthBuff = @#335
// Check if Extended Memory is working
let data = @1000
ReadWidths(FontNames,widthBuff,BoundingBox)//read in mica widths for fonts
let newdata = @1000
if data ne newdata then
[
CallSwat("Extended Memory Problem. ↑k to abort and reboot ALTO.")
]

//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("RSil.fonts",ksTypeWriteOnly,0,0,fpSilInit)

Puts(InitS,InitRev) //Rev level ID
for i = 0 to 6 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 = 40 to 46 do Puts(InitS,FontNames!i)//these are baseline offsets used for printing
for i = 0 to 6 do Puts(InitS,FontOrientation!i)
Puts(InitS,LeftMargin)// left margin for making press file
//Puts(InitS,BottomMargin)// bottom margin for making press file
for i = 0 to 6 do Puts(InitS,PrFaceVec!i)
for i = 0 to 6 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 (32 now) word table which is FileVec with the computed file pointers in it
let filePtr = FilePos(InitS) + (32+1)*2//this place plus 32 plus 1 word
for i = 0 to 31 do
[
// ptr now pointers to extended memory
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%#40// changed from 20 to 40
let p = WidthVec!j
for w = 32 to WidthSize-1 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*(WidthSize+1) ]
]

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

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

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

//now write the file pointer file
//for i = 0 to 9*DirPreambleSize-1 do Puts(InitS,FpVec!i)
// 13, 14 are not used
for i = 0 to 12*DirPreambleSize-1 do Puts(InitS,FpVec!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 AlNameVec = names + 15
let BaseLineVec = names + 40
let Ystr = vec 50; Zero(Ystr,50)
let Xstr = vec 50; Zero(Xstr,50)
let Lstr = vec 50; Zero(Lstr,50)// Left Margin
let Bstr = vec 50; Zero(Bstr,50)// Bottom Margin
LeftMargin = 28// init default
BottomMargin = 0

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,"RSIL",nil); endcase ]
ifso [ Closes(s);break ] //done with User.cm

// font is 0 to 6uses names!0 to namew!6
// lib is L5 to L9uses names!8 to namew!12
case $L:
[
str = 0
unless gotsil then endcase
if cmstr>>str.length gr 2 then
[
if StEq("LeftMargin",cmstr,true) then str = Lstr
if StEq("BottomMargin",cmstr,true) then str = Bstr
endcase
]
if cmstr>>str.length gr 2 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 $6) then [ str = names!(C-$0); endcase ]
if (C eq $L) % (C eq $l) then
[
// Read macro libary. Limited to 5 entries because Lprvec
// is defined as #20 to #60
// library file is defined by sht-cnt 5 6 7 8 & 9
// names!7 = define macro !8 = lib5, !9 = lib6 etc
let C = cmstr>>str.char↑2
if (C ge $5) & (C le $9) then [ str = names!(C-$4+7) ]
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

LeftMargin = GetNum(Lstr,LeftMargin)
BottomMargin = GetNum(Bstr,LeftMargin)
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 + 15
let BaseLineVec = names + 40
//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 6 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
Zero(FontOrientation,8)
for i = 0 to 6 do
[

let str = AlNameVec!i
if str!0 eq 0 then loop
AlFaceVec!i = -1
let ttable = 0
let rotated = CheckRotation(str) // returns 0, 1, 2, or 3
if StEq("ChemTimes8",str,true) then ttable = 1
if StEq("TimesRomanE8",str,true) then ttable = 2
FontOrientation!i = rotated + ( ttable lshift 8 )

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 = 8 to 12 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("RSIL.LB",libName); AppendN(i-3,libName) ]

ifnot AppendS(UserCmName,libName)

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

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

//if nfound gr (4-cnt) then CallSwat("Can’t find all your .al fonts")
for f = 0 to 6 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 6 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
[
// Font is now stored in the extended memory

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

let data = Gets(st)
xmstore(adr,data)
adr = adr+1

]
FontVec!number = (XMstart)+2
XMstart = adr //increment XMstart
Closes(st)
]


and ReadWidths(names,widthBuff,BoundingBox) be
[

external [ EncodeFace; LookupFontName ]
let ExtendedMem= XMstart
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,WidthSize)
for f = 0 to 6 do
[

let bufbb = BoundingBox + f*4
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 rotation = CheckRotation(str)
switchon rotation into
[
case 1: str>>str.length = str>>str.length - 3
length = length - 3; endcase
case 2:str>>str.length = str>>str.length - 4
length = length - 4; endcase
case 3: str>>str.length = str>>str.length - 4
length = length - 4; endcase
case 0:
default: endcase
]

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

let rot = 0// use rotation zero for reading the width
//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,rot,Widths,bufy,bufbb) then
[
MoveWidths(Widths, ExtendedMem)
WidthVec!(4*f) = ExtendedMem
ExtendedMem = ExtendedMem + WidthSize
]

FaceCode = EncodeFace($M,$I,$R)
if LookupFontName(S,Face,FaceCode,PtSize,rot,Widths,bufy,bufbb) then
[
MoveWidths(Widths, ExtendedMem)
WidthVec!(4*f+1) = ExtendedMem
ExtendedMem = ExtendedMem + WidthSize
]

FaceCode = EncodeFace($B,$R,$R)
if LookupFontName(S,Face,FaceCode,PtSize,rot,Widths,bufy,bufbb) then
[
MoveWidths(Widths, ExtendedMem)
WidthVec!(4*f+2) = ExtendedMem
ExtendedMem = ExtendedMem + WidthSize
]
FaceCode = EncodeFace($B,$I,$R)
if LookupFontName(S,Face,FaceCode,PtSize,rot,Widths,bufy,bufbb) then
[
MoveWidths(Widths, ExtendedMem)
WidthVec!(4*f+3) = ExtendedMem
ExtendedMem = ExtendedMem + WidthSize
]

if rot eq 0 then// always true; just load the bounding box for MRR
[
let f = EncodeFace($M,$R,$R)
let a = LookupFontName(S,Face,f,PtSize,rot,Widths,bufy,bufbb)
]

//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*WidthSize -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

]


and MoveWidths(Widths, ExtendedMem) be
[
let addr = ExtendedMem
for i = 0 to WidthSize-1 do
[
let data = Widths!i
//undefined chars get zero width (undefined characters are assigned #100000)
data = data & #77777
xmstore(addr,data)
addr = addr + 1
]
]



and CheckRotation(string) = valof
[

// 1 = 90, 2 = 180, 3 = 270
let rotationdegree = 0
let len = string>>str.length
let c1 = string>>str.char↑len
let c2 = string>>str.char↑(len-1)
let c3 = string>>str.char↑(len-2)
let c4 = string>>str.char↑(len-3) % #40 // make lower case
if c1 ne $0 then resultis rotationdegree
if ( c2 eq $9 & (c3 eq $R % c3 eq $r)) then rotationdegree = 1
if ( c2 eq $8 & c3 eq $1 & c4 eq $r ) then rotationdegree = 2
if ( c2 eq $7 & c3 eq $2 & c4 eq $r ) then rotationdegree = 3
resultis rotationdegree
]