//Sil.bcpl  last modified February 19, 1981 by R. Pasco

get "sysdefs.d"
get "sil.defs"

static  //All declaired common and external in nsil.defs
[
OriginObject; MarkObject; StatusObject; FNameObject
Message; Herrald
Blink = 10; FlashSense =0; UpdateStatus=0; TickFlag=false
LineWidth = 1; Mag=1; GridMask = #177774; HardCopy=false
FirstItem; NewItem; NSelectedItems = 0
Changed = false; VirginSinceBuild = false
MakeGrayOK = true //flag 
PlaceSelected = false
MaxStringHeight

CursorX; CursorY  //X & Y location of Cursor in Bit-Map coordinates
mx = 0; my = 0//default location of StatusObject (may be altered by "X/Y: val" in user.cm)
OldX = 0; OldY = 0; NewX = 0; NewY = 0
RebArea //total area for rebuilding on first pass
RwArea //total area for rebuilding on second pass
WindowXmin=0; WindowYmin=0

RebuilderState = 0; RestartRebuilder = false; RebuilderLink = 0
Sweeping; Slink; Clink

MouseBuffer; Dcb=0; Mact; FontVec; PrFaceVec; AlFaceVec; MaskTable
DisplayArea=0//set to zero so  FileIn display calls are inhibeted in press mode
SilZone
SpaceBase //base of space
SpaceTop  //top of space with 128 words above for "NewItem" to expand into
]

external [ @OnBits; @OffBits; @SetBPtr; @SetBMask ]  
static [ @OnBits; @OffBits; @SetBPtr; @SetBMask ]  
//static [ @SaveFlag=0 ]    //TEMPORARY CODE TO MAKE SIL.BOOT -- DORADO  
//external [ sysZone; lvSysZone; SaveState; MyFrame; EnableInterrupts ]  //DORADO  


let Main() be
[(635)
Herrald = "SIL of February 19, 1981"			//as modified by R. Pasco
let xDcb = InitBlocks()  //set up miscillaneous buffers for SIL
Zero(DisplayArea,(Nwrds*ScreenYmax))  //this wapes out InitBlock etc. code
Dcb = xDcb
Junta(levKeyboard,InitSil)l4268
]

l4268
and InitSil(arg) be
[l2998

//use remaining space for the stack//AddText of a macro is worst - 900 works
SpaceBase = @#335 //EndCode
@#335 = (lv arg) -1200 //set EndCode
//@#335 = (lv arg) -1400 //MORE SPACE FOR D1 VERSION -- DORADO
//if (@#335-SpaceBase) ls 2000 then CallSwat("Insufficient Object Storage")

SilReInit()
if FNameObject>>item.string.length then FileIn(false) 
SilMain()	//never returnsl4268
]

// Called to re-initialize SIL, both at beginning and at ^K time.
and SilReInit() be
[
Message = Herrald

//Close stream on Alternate input if this is a cont K on an initialised screen
if (FirstItem eq 0) & AltS ne 0 then [ Closes(AltS); AltS=0 ; AltLineCnt=0 ]l4269

//clear buffers of width table for non default font faces
for f = 0 to 15 do if FileVec!f ne true then WidthVec!f = 0
SpaceTop = @#335 - 128

SetCursor()
Zero(Mact,Mtsize)

FirstItem=0
NewItem=SpaceBase
RebuilderState = 0
NSelectedItems = 0
Changed = false
Mag = 1
LbMissing = -1
WindowXmin = 0
WindowYmin = 0
ZapRebuilder()

//Initialize the storage compactor
Clink = SpaceBase
Slink = lv FirstItem
Sweeping = truel4269
]

and SilMain() be
[
if MouseBuffer>>OsBUF.In ne MouseBuffer>>OsBUF.Out thenl4268
[l4268
Message = " "
switchon GetMouseEvent() into
[l5538
case Mark:
PushCoords(mx,my)
MoveObjectTo(MarkObject,mx,my)
endcase

case CtrlDraw:
PushCoords(mx,my)
MoveObjectTo(MarkObject,mx,my)
CopySelected()
Changed = true
endcase
l6808
case CtrlMark:
case CtrlShMark:
PushCoords(mx,my)
MoveObjectTo(MarkObject,mx,my)
MoveSelected()
Changed = true
endcase

case Draw:
ClearSelections()
DoDraw(mx,my)
SetCursor()
Changed = truel6808
endcase

case Select:
SelectItem(mx,my,true)
SetCursor()
endcase

case ShiftSelect:
SelectArea(mx,my)
SetCursor()
endcase

case CtrlSelect:
case CtrlShSelect:
SetCursor()
SelectItem(mx,my,false)
endcase

case ShiftMark:
MoveObjectTo(OriginObject,mx,my)
endcase

case ShiftDelete:
SelectItem(mx,my,true)
DeleteSelected()
SetCursor()
Changed = true
endcase

case ShiftUndelete:
UnDelete()
SetCursor()
endcasel6808
]
l5538
UpdateStatus = true
]l4268

if not Endofs(keys) then [ DoKeyboard(Gets(keys)); UpdateStatus=true ]l4268
RebuildSome()
if RebuilderState eq 0 then Compact() //do a little bit
if VirginSinceBuild & Changed then RemoveBuildMark()

//if SaveFlag then MakeBootFile()//  -- DORADO
l4268
] repeat


//and MakeBootFile() be//  -- DORADO
//[ let x = nil; SaveFlag=0
//let t2 = table [ #030013; #002014 ]  //lda 2,13; jmp@14@#12 = t2
//@#12 = t2; @#13 = MyFrame(); @#14 = D1Prog
//x = SaveState("Sil.boot",1); if x ne 2 then return
//D1Prog: EnableInterrupts(); SetBlock(0,#67400, #12)l4269
//]

and FlashMark() be
[
let Obj = OriginObject  // inits Origin object first time through, Mark the second
Blink=10
[  //this loop is excuted once for OriginObject and one for MarkObjectl4268
if MakeGrayOK  eq 0 then break  //keep the screen vergin
test FlashSense
ifso Paint(Obj,toWhite) //turn off Object
ifnot
[l5538
//Obj>>item.state = Active
if Obj>>item.xmax gr ScreenXmax then
		MoveObjectTo(Obj,ScreenXmax-4,Obj>>item.ymin)
if Obj>>item.ymax gr ScreenYmax then
		MoveObjectTo(Obj,Obj>>item.xmin,ScreenYmax-8)
DisplayObject(Obj) //turn on Object
unless mousedown do Blink = 30l6808
]l5538
if Obj eq MarkObject then break
Obj = MarkObject  //now do the same for Mark
] repeatl4268

FlashSense = not FlashSense
if (mousedown % UpdateStatus) & FlashSense then [ UpdateStatus = false; Update() ]
if NSelectedItems eq 0 then SetCursor()
if (TickFlag ne 0) & (RebuilderState eq 0) do PaintTicks()

]

and PaintTicks() be  //Static TickFlag must equal 0 or #100000
[
for i = DisplayArea by (Nwrds*16) to DisplayArea+(Nwrds*(ScreenYmax-1)) dol4268
for j = 0 to Nwrds-1 do @(i+j) = ((@(i+j))& #77777) + TickFlagl5538
]


//the following procedure displays an object relative to x0,y0, and fills
//in the max coordinates of the object.  It will not display the object
//if it is totally off the screen (the object is marked Dead so the compactor
//can get it).  If the object is deleted (gr Selected) it is not displayed.


and DisplayObject(ptr,x0,y0; numargs nargs) be
[
if (ptr>>item.state gr Selected) then return
if nargs ls 3 then [ x0=0; y0=0 ]
let font = ptr>>item.font
if font ge 14 then //the object is a line or area
[l4268
Paint(ptr,toBlack,x0,y0) //display it black
returnl5538
]

let x= x0+ptr>>item.xmin
let y = y0+ptr>>item.ymin

if (x ls 0)%(y ls 0) then return

let MagFlag = (Mag ne 1) & (ptr ne StatusObject)&(ptr ne FNameObject)
//return if the item is entirely off the magnified screen area.
if MagFlag do
[
	if (
	((ptr>>item.xmax+x0) ls WindowXmin) %
	((ptr>>item.ymax+y0) ls WindowYmin) %
	((x-WindowXmin)*Mag ge ScreenXmax) %
	((y-WindowYmin)*Mag ge ScreenYmax)
	) then return
]l4268


if font ls 8 then  //normal character string
[l4268
font = font/2  //set font to "user font" = 0 to 3
//first see if the widths table for this font and face are in core
let face = ptr>>item.face xor PrFaceVec!font
let FF = font*4 + face
if HardCopy then if WidthVec!FF eq 0 do
	//check for widths not in file, or not enough space for widths
	test (FileVec!FF eq 0)%((SpaceTop-NewItem) ls 200)l5538
ifso WidthVec!FF = FontVec!font + 128//can't do it so default
ifnot  //look up in Sil.init
[
	let ptr = SpaceTop; SpaceTop = SpaceTop-128
	unless InitS do
		InitS = OpenSilFile(0,fpSilInit,ksTypeReadOnly,wordItem)
	let Fptr = FileVec!FF
	if Fptr ls 32 then Fptr = FileVec!(Fptr & #17)
	SetFilePos(InitS,0,Fptr-2)
	if Gets(InitS) ne -1 then CallSwat("Sil.Init oproblem")
	for w = 0 to 127 do ptr!w = Gets(InitS)
	WidthVec!FF = ptr
]l6808




//Cvrt returns the width of the string in bits, and sets
//MaxStringHeight to the height of the tallest character in
//the string.  Cvrt will not convert the character if the width
//would exceed the sixth parameter, nor if the height would
//exceed the seventh parameter.  If either situation obtains, the
//convert instruction is emulated so that the width and height
//are calculated correctly

let lwa = DisplayArea + ((y-1)*Nwrds)
let sw = Cvrt( lv(ptr>>item.string), x, y, lwa, FontVec!font, face & AlFaceVec!font, WidthVec!FF, MagFlag, Nwrds)

ptr>>item.xmax = ptr>>item.xmin + sw //the italic overhang is fixed in Cvrt
ptr>>item.ymax = ptr>>item.ymin+MaxStringHeight
if ptr>>item.state eq Selected then Paint(ptr,toSelected,x0,y0)
returnl5538
]

//the item is a string of macro characters (internal font # 8-13)

let mbase = Mact+ 128*(font-8) //base of the 128 word region of Mact 
//used by this font
let sl = ptr>>item.string.length
if sl eq 0 then return //zero length strings are ignored
let xsofar = 0
let biggesty = 0
for i = 1 to sl do
[l4268
let chxmax = 0
let mptr = mbase! (ptr>>item.string.char^i)
if (mptr eq 0)%(mptr eq -1) then
[l5538
let v = "Font:n Char:m - ^P to proceed"
v>>str.char^6 = font-4+$0
v>>str.char^13 = ptr>>item.string.char^i
CallSwat("Undefined Macro",v)
ptr>>item.state = Dead
return
l6808
]

until mptr eq 0 do //grind down the list of objects in the macro
[l5538
mptr>>item.state = ptr>>item.state//pass the state on for Paint
DisplayObject(mptr,x+xsofar,y)
let tx = mptr>>item.xmax
let ty = mptr>>item.ymax
if tx gr chxmax then chxmax = tx
if ty gr biggesty then biggesty = ty
mptr = mptr>>item.linkl6808
]
xsofar = xsofar+chxmax //grind down the stringl5538
]

ptr>>item.xmax = ptr>>item.xmin+xsofar
ptr>>item.ymax = ptr>>item.ymin+biggestyl4269
]

//and BcplDoItalics(CharHeight,ptr) be  //this is done in CVRT.asm
//[
//let CharHeight = (CharDef!1)&#377
//let ptr = ItalicsBuff-CharHeight
//MoveBlock(ptr,CharDef-CharHeight,CharHeight+2)
//for i = CharHeight-1 to 4 by -1 do [ rv ptr = (rv ptr) rshift (i rshift 2); ptr = ptr+1 ]l4269
//]

//and MagnifiedConvert(frame,CharDef) =valof  //called from CVRT.asm if Mag gr 1
//[
//frame is a AC2 of the CVRT proceedure which just called us
////The following manifest constants represent the offsets of the desired parameters
//manifest [ currXposn=#20; Ystart = 6; xBoldFlg = #25 ]
//let HD = CharDef!1 rshift 8  //number of scanlines to skip
//let XH = CharDef!1 & #377  //number of scanlines to Convert
//let y = (frame!Ystart+HD-WindowYmin)*Mag
//let x= (frame!currXposn-WindowXmin)*Mag
//let z = x/16
//let width = Mag+ (frame!xBoldFlg ne 0? Mag/2, 0)
//OnBits = (MaskTable!width)
//SetBPtr = DisplayArea + (y*Nwrds)
//for sl = -XH to -1 do
//[
//	if y gr ScreenYmax-Mag then break
//	external PaintBitsl4268
//	if y ge 0 then PaintBits(x,CharDef!sl)
//	SetBPtr = SetBPtr + (Mag*Nwrds)l4269
//]l4269
//resultis CharDef!0
//]
//

//the following procedure fills in a rectangular area defined by an
//object with black, gray, or white.  If the object is fully off the screen
//nothing is done.  If the object is partially off the screen, the
//region is clipped so that it stays in the bitmap

and Paint(ptr,shading,x0,y0; numargs nargs) =valof
//  toWhite=0; toSelected=1; toBlack=-1; toBackground=-2
[
if nargs ls 4 then [ x0=0; y0=0 ]
let xmin=ptr>>item.xmin+x0
let xmax=ptr>>item.xmax+x0
let ymin=ptr>>item.ymin+y0
let ymax=ptr>>item.ymax+y0
//if were just masking off bits then mask off an extra one for safety
if shading ge 0 then xmax=xmax+1
let height = ymax - ymin//this is not the Magnified height or width
let width = xmax - xmin
let font = ptr>>item.font

if (Mag ne 1) then if (ptr ne StatusObject)&(ptr ne FNameObject) do
[l4268
xmin = (xmin-WindowXmin)*Mag
ymin = (ymin-WindowYmin)*Mag
test (ptr eq OriginObject) % (ptr eq MarkObject)
ifso //set max's with out magnifying
[l5538
xmax = xmin+width
ymax = ymin+heightl6808
]l5538
ifnot //set max's with magnification
[l5538
xmax = xmin+width*Mag
ymax = ymin+height*Magl6808
]l5538
]


//clip
if (xmin ge ScreenXmax)%(ymin ge ScreenYmax)%(xmax ls 0)%(ymax ls 0) then resultis false
if xmin ls 0 then xmin = 0
if ymin ls 0 then ymin = 0
if xmax gr ScreenXmax then xmax = ScreenXmax
if ymax gr ScreenYmax then ymax = ScreenYmax

//now compute width and height after magnification and clipping
width = xmax - xmin


let BitsTable = tablel4268
[
-1; -1; -1; -1;  //mask for shading all on or all off
#52525; #125252; #52525  //mask for shading selected
#100200;#20040;#4010;#1002;#100200;#20040;#4010  //mask for shading areas
]l5538

OnBits = 0
if shading eq toBlack then OnBits=font eq 15? BitsTable+7 +(ymin & 3),BitsTable 

OffBits = 0
if (ptr>>item.state eq Selected) & MakeGrayOK then OffBits=BitsTable+4 +(ymin & 1) 

//add extra bit to width if painting white to be sure and get all of italics characters
if shading eq toWhite then OffBits = BitsTable  //set off bits to all ones

let startbit = xmin & #17
SetBPtr = DisplayArea + (ymin*Nwrds) + (xmin rshift 4)
let L = width gr 16? 16,width
SetBMask = (MaskTable ! L) rshift startbit


external PaintBlockl4268
PaintBlock(ymax - ymin,width+startbit)
//[l4268
//SetBPtr = startword
//PaintBlock(height)
//for i = 1 to height do
//[l5538
//BitSplat:
//if OnBits then @SetBPtr = @SetBPtr % (SetBMask & OnBits!(i&3))
//if OffBits then @SetBPtr = @SetBPtr & not (SetBMask & OffBits!(i&1))
//SetBPtr=SetBPtr+Nwrdsl6808
//]

//width = width-16
//if width le 0 then break
//startword = startword+1
//SetBMask= width ls 16? MaskTable!width, -1l5538
//] repeat
resultis truel4268
]




and PushCoords(x,y) be //stack marks
[
OldX = NewX
NewX = x

OldY = NewY
NewY = yl4268
]

and ClearSelections() be //zips through objects and makes selected ones active
[
let link = FirstItem
until link eq 0 do
[l4268
if link>>item.state eq Selected then
[l5538
link>>item.state = Active
DisplayObject(link)
ZapRebuilderItem(link) 
//just in case this selection had caused something else
//to be painted gray
l6808
]
link = link>>item.linkl5538
]
RememberArea(SelArea,0)  //initialize Selected Area
NSelectedItems = 0
l4268
]

//fill in an item with everything but the link and string
and MakeItem(ptr,xmin,xmax,ymin,ymax,font,state) be
[
ptr>>item.link = 0
ptr!Xmin = xmin	//ptr>>item.xmin = xmin
ptr!Ymin = ymin	//ptr>>item.ymin = ymin
ptr!Xmax = xmax	//ptr>>item.xmax = xmax
ptr!Ymax = ymax	//ptr>>item.ymax = ymax
ptr!5 = 0 			 //ptr>>item.string = 0
ptr>>item.font = font
ptr>>item.state = state
ptr>>item.color = CurrentColorl4269
]


and RememberArea(area,item) be
[
if item eq 0 then
	[
	area!Xmin = ScreenXmax
	area!Ymin = ScreenYmax
	area!Xmax = 0
	area!Ymax = 0l4269
	return
	]
if item>>item.xmin ls area!Xmin then area!Xmin = item>>item.xmin
if item>>item.ymin ls area!Ymin then area!Ymin = item>>item.ymin
if item>>item.xmax gr area!Xmax then area!Xmax = item>>item.xmax
if item>>item.ymax gr area!Ymax then area!Ymax = item>>item.ymaxl4269
]

//given a pointer to an object, change its position
and MoveObjectTo(obj,x,y) be
[
Paint(obj,toWhite)	//paint it white

//let the rebuilder fill in over the moved object
ZapRebuilderItem(obj) 
//if the x,y coordinates are <0, then kill the object
//if ((x ls 0) % (y ls 0)) then
//[l4268
//if obj>>item.state eq Selected then NSelectedItems = NSelectedItems-1
//obj>>item.state = Dead
//returnl5538
//]

IncrementCoords(obj, x-obj>>item.xmin,  y-obj>>item.ymin )
DisplayObject(obj) //display it in its new position
l4268
]


//The screen rebuilder has three states: 
//0 means idle, 1 means rebuilding selected items (gray), and 2 means
//rebuilding Active items (black).   ZapRebuilder is
//passed a bounding rectangle.  If the state is =0, it sets the state to
//1, and saves the rectangle.  If the state is >0, it expands the
//bounding rectangle appropriately.  In either case, it
//sets RestartRebuilder, which will cause the rebuilder to start at FirstItem
//when it is next started. The rebuilder starts in state 1, and as it
//goes, it keeps track of the largest area which it has painted gray
//during pass 1.  At the end of pass 1, it puts this information in
//the bounding rectangle, so that unselected things within the gray
//area will be painted black properly.


and ZapRebuilderItem(p) be
  ZapRebuilder(p>>item.xmin, p>>item.ymin, p>>item.xmax, p>>item.ymax)

and ZapRebuilder(xmin,ymin,xmax,ymax; numargs na) be
[
if na eq 0 then
[l4268
xmin=0; ymin=0
xmax=ScreenXmax; ymax=ScreenYmax
Zero(DisplayArea,Nwrds*ScreenYmax)l5538
]
let fake = vec 6
fake!Xmin = xmin
fake!Ymin = ymin
fake!Xmax = xmax
fake!Ymax = ymax
test RebuilderState eq 0
ifso
[l4268
RememberArea(RebArea,0)
RememberArea(RebArea,fake)
RebuilderState = 1; UpdateStatus=truel5538
]

ifnot  RememberArea(RebArea,fake)

RestartRebuilder = truel4268
]

and RebuildSome() be
[
l4268
if (Blink&#177700) ne 0 then FlashMark()	//i.e. ls 0 or gr 64
if RebuilderState eq 0 then return  //nothing to do
if RestartRebuilder then
[l4268
RememberArea(RwArea,0)

RestartRebuilder = false
RebuilderState = 1 //do selected items
RebuilderLink = FirstIteml5538
]
if RebuilderLink eq 0 then 	//done with this passl4268
[l4268
UpdateStatus = true
RebuilderState = RebuilderState+1
if RebuilderState gr 2 then RebuilderState = 0
RebuilderLink = FirstItem
if RebuilderState eq 2 then RememberArea(RebArea,RwArea)
loopl5538
]
let t = RebuilderLink; RebuilderLink = RebuilderLink>>item.link
let st = t>>item.state
unless (((st eq Selected) & (RebuilderState eq 1)) % ((st eq Active) & (RebuilderState eq 2))) then loop


if (t>>item.xmin gr RebArea!Xmax) % (t>>item.xmax ls RebArea!Xmin) % (t>>item.ymax ls RebArea!Ymin) % (t>>item.ymin gr RebArea!Ymax) then loopl4268
DisplayObject(t) //display it
//check for object which was just painted gray bigger than
//the present 'maximum gray' window
if RebuilderState eq 1 then RememberArea(RwArea,t)

if MouseBuffer>>OsBUF.In ne MouseBuffer>>OsBUF.Out then return	//user input
if not Endofs(keys)  then return	//user inputl4268
] repeat
 l2998