//SilC.bcpl


get "sysdefs.d"
get "Sil.defs"

static
[
Lprvec
mousedown = false
TABkey//added to disable the TAB key as opposed to Cont I
BSkey//added to differentiate between ↑H and the BS key
CtrlShift//added to decode both control & shift keys down at the same time
SelArea//pointer to ’item’ indicated total area of selected items
LbMissing
]

//update Status area
let Update(str; numargs na) be
[

let ts = lv (StatusObject>>item.string.length)
ts!0 = 0 //set string length to zero

if na ne 0 then Message = str
if Message eq 0 then return
unless Message eq NewItem do //display normal status parameters
[

AppendS("GLMF: ",ts)
AppendN((not GridMask)+1,ts)
AppendN(LineWidth,ts)
AppendN(Mag,ts)
AppendN(CurrentUFont,ts)
if CurrentUFont ls 3 then
[

let face = (CurrentFace xor PrFaceVec!CurrentUFont)
if (face & 2) ne 0 then AppendC($b,ts)
if (face & 1) ne 0 then AppendC($i,ts)

]
AppendC($*s,ts)
AppendC((OneLevel? $T,$F),ts)
AppendC((YLockFlag? $T,$F),ts)
AppendN(RebuilderState,ts)

//The following string has char 1 for color 0, char 2 for color 1 etc
let ColorStr = "NRYGCVMWDOLTAUPS"
AppendC(ColorStr>>str.char↑(CurrentColor+1),ts)

AppendS(" Space: ",ts)
AppendN(SpaceTop-NewItem,ts)

AppendS(" Selections: ",ts)
AppendN(NSelectedItems,ts)

//if any mouse button is down, display the cursor
//coordinates rather than those of the mark
AppendS(" X: ",ts)
AppendN(mousedown?(CursorX/Mag)+WindowXmin,NewX,ts)

AppendS(" Y: ",ts)
AppendN(mousedown?(CursorY/Mag)+WindowYmin,NewY,ts)
AppendS(" ",ts)

]
AppendS(Message,ts)

let xHardCopy = HardCopy; HardCopy=0
Paint(StatusObject,toWhite)
DisplayObject(StatusObject) //show
HardCopy = xHardCopy

]

//Find the single item which is nearest to x,y and select it.
//Select the item with the smallest perimeter

and SelectItem(x,y,ClearPrevious) be
[

unless CtrlShift then RememberArea(SelArea,0)
let st = 0
let perim = 10000
let p = FirstItem
until p eq 0 do
[

let tp = p; p=p>>item.link
if tp>>item.state gr Selected then loop
if ClearPrevious then MakeUnSelected(tp)
//if Mag ne 1 then if tp>>item.font ls 8 then loop //only do macros or lines

if tp>>item.xmin gr x then loop
if tp>>item.xmax ls x then loop
if tp>>item.ymin gr y then loop
if tp>>item.ymax ls y then loop

let nperim = tp>>item.ymax-tp>>item.ymin+tp>>item.xmax-tp>>item.xmin
if nperim gr perim then loop
perim = nperim
st = tp

]

test st

ifso

[

test CtrlShift

ifso MakeUnSelected(st)
ifnot MakeSelected(st)

SelectItemCleanup()

]

ifnot
[
MoveObjectTo(OriginObject,x,y)
if ClearPrevious then NSelectedItems = 0//Should already be 0, but clear anyway
]

]



and SelectArea(x,y) be
//select everything active in the rectangle bounded by x,y, and NewX,NewY. Clear all selections as we go.
[

RememberArea(SelArea,0)
let xmin = x ls NewX? x,NewX
let xmax = x ls NewX? NewX,x
let ymin = y ls NewY? y,NewY
let ymax = y ls NewY? NewY,y

let link = FirstItem
until link eq 0 do
[

let tl = link; link = link>>item.link
if tl>>item.state gr Selected then loop
MakeUnSelected(tl)
//if Mag ne 1 then if tl>>item.font ls 8 then loop //macros & lines only in mag.

if tl>>item.xmin ls xmin then loop
if tl>>item.xmax gr xmax then loop
if tl>>item.ymin ls ymin then loop
if tl>>item.ymax gr ymax then loop
MakeSelected(tl)

]
SelectItemCleanup()

]

// Move selected bounding box to grid boundary. Otherwise, "move" command will
// destroy any alignment information (e.g., IC macro defined on different grid)

and SelectItemCleanup() be
[

let g = ((not GridMask)+1)*Mag
SelArea!Xmin = (SelArea!Xmin*g)/g
SelArea!Ymin = (SelArea!Ymin*g)/g
SelArea!Xmax = (SelArea!Xmax*g+g-1)/g
SelArea!Ymax = (SelArea!Ymax*g+g-1)/g
if NSelectedItems then MoveObjectTo(OriginObject,SelArea!Xmin,SelArea!Ymin)
ZapRebuilderItem(SelArea)

]

and MakeSelected(ptr) be
[

if ptr>>item.state ne Selected then
[

NSelectedItems = NSelectedItems+1
ptr>>item.state = Selected

]

RememberArea(SelArea,ptr)
Paint(ptr,toSelected)

ZapRebuilderItem(ptr)

]

and MakeUnSelected(ptr) be
[

if ptr>>item.state ne Selected then return
NSelectedItems = NSelectedItems-1
ptr>>item.state = Active
DisplayObject(ptr)

]


and LibUpdate(font) be
[

//ftap is a 128 entry table indexed with ftap>>str.char↑n so the vec is 64 (not 128)
let ftab = vec 64; Zero(ftab,64)
let mbase = ((font-8)*128) + Mact //starting loc in Mact for this font
let need = false
for i = 0 to 127 do if (mbase!i) eq -1 then//see if we need the file
[

mbase!i = 0
ftab>>str.char↑i = 1
need = true

]
if (need eq false)%(font eq LbMissing) then return //nothing to do or can’t do it!!!

let s = OpenSilFile(0,Lprvec+DirPreambleSize*(font-9)+1,ksTypeReadOnly,wordItem)
if s eq 0 then
[

let str = "Can’t find Sil.lbx file; ↑P to proceed without macros"
str>>str.char↑18 = $0 + font-4
CallSwat(str)
LbMissing = font; return

]

[

let pw = Gets(s); if pw ne #34562 then CallSwat("Bad Library Password")
until Endofs(s) do
[

let mname = Gets(s)
if mname eq -1 then break //past the macro definitions = done
let fnt = ReadItem(s) //reads item into NewItem

//do we want this macro definition?
if ftab>>str.char↑mname eq 0 then loop //no
if ftab>>str.char↑mname eq 2 then ftab>>str.char↑mname = 1 //we
//found that we needed this def. earlier in the
//present pass. Now we have it

if fnt eq 8 then //this block of the definition contains macro calls.
//fix them up
[

NewItem>>item.font = font //put these defs in the current font
for i = 1 to NewItem>>item.string.length do //for each call
[

let nch = NewItem>>item.string.char↑i
if ((mbase!nch) ne 0)%((ftab>>str.char↑nch) ne 0) then loop
ftab>>str.char↑nch = 2 //mark this macro "newly required"

]

]
AddToList(lv(mbase!mname))

]
//have read through the file. There are 2 things to decide:
//(1) is another pass over the file necessary?
//(2) would another pass be fruitful?

let passagain = false
for i = 0 to 127 do //scan ftab
[

switchon ftab>>str.char↑i into
[

case 0: loop //not interesting
case 1: if mbase!i ne 0 then [ ftab>>str.char↑i = 0; endcase ]
endcase //we won’t find it ever.

case 2: passagain = true; ftab>>str.char↑i = 1 //we might find
//it on another pass
endcase

]

]

if passagain then [ Resets(s); loop ]
break

] repeat
Closes(s)

]

//The following procedures handle mouse and cursor linkage,
//checking for mouse button activity, and timing 1sec intervals
//for blinking the origin and the mark

and MouseProc(tab) =valof//called from kbd interrupt at 60hz
[

let ki = tab>>KBTRANS.KeyIndex
let cs = (lv(tab>>KBTRANS.KeyState))!2 //control and shift keys

//window and mask cursor
if @MouseX ls 0 then @MouseX = 0
if @MouseX gr ScreenXmax then @MouseX = ScreenXmax

if @MouseY ls 0 then @MouseY = 0
if @MouseY gr ScreenYmax then @MouseY = ScreenYmax

let g= ((not GridMask)+1)*Mag


CursorX = (@MouseX/g)*g
CursorY = (@MouseY/g)*g
@DispCursorX = CursorX + 16
@DispCursorY = CursorY + BlankLines

//check for mouse down at all
mousedown =7 & (lv(tab>>KBTRANS.KeyState))!4 //mouse buttons

//turn off display if rebuilding and user asked for it
@#420 = (RebuilderState ne 0)&((((lv(tab>>KBTRANS.KeyState))!1)&1) ne 0)? 0,Dcb
//do timer
Blink = Blink-1

//Check for keyboard or mouse change and return if none
if tab>>KBTRANS.GoingDown eq 0 then resultis true

//Check for mouse button change
let Event = selecton ki into
[

case 77: Mark //mark
case 79: Draw //Draw
case 78: Select //Select
default: 0

]

if Event then
[

if (cs & #4000) ne 0 then Event = Event + Ctrl
if (cs & #0100) ne 0 then Event = Event + Shift
MakeMouseEvent(Event)
CtrlShift = 0

]

//note special keyboard key states
BSkey = (lv(tab>>KBTRANS.KeyState))!0 & 1
TABkey = cs & #20000
if (cs & #4000) ne 0 then //gets "left-shift" key only
CtrlShift = cs & #0100 //Shift was down during last control character


resultis true

]

and MakeMouseEvent(type) be
[

let in = MouseBuffer>>OsBUF.In + 2
if in ge MouseBuffer>>OsBUF.Last then in = MouseBuffer>>OsBUF.First
if in eq MouseBuffer>>OsBUF.Out then return //buffer full. Throw event away

(MouseBuffer>>OsBUF.In)>>Mevent.type = type
(MouseBuffer>>OsBUF.In)>>Mevent.curx = (CursorX/Mag)+WindowXmin
(MouseBuffer>>OsBUF.In)>>Mevent.cury = (CursorY/Mag)+WindowYmin

MouseBuffer>>OsBUF.In = in

]

and GetMouseEvent() = valof //assumes buffer not empty
[

let out = MouseBuffer>>OsBUF.Out + 2
if out ge MouseBuffer>>OsBUF.Last then out = MouseBuffer>>OsBUF.First
let type = (MouseBuffer>>OsBUF.Out)>>Mevent.type
mx= (MouseBuffer>>OsBUF.Out)>>Mevent.curx
my = (MouseBuffer>>OsBUF.Out)>>Mevent.cury
MouseBuffer>>OsBUF.Out = out
resultis type

]

and Compact() be
[
//The compactor has two states: sweeping, in which it traces the
//item list and removes dead blocks (or blocks which are
//not selected but are off the screen) from the chain, and compacting, in
//which it starts at the bottom of storage and moves up, removing the
//space occupied by dead blocks

test Sweeping
ifso
[

if Slink>>item.link eq 0 then //done with this pass
[

Slink = lv FirstItem
Sweeping = false
return

]
if (
((@Slink)>>item.ymin eq (@Slink)>>item.ymax) %
((@Slink)>>item.xmin eq (@Slink)>>item.xmax) %
((@Slink)>>item.state eq Dead) %
(
((@Slink)>>item.state ne Selected)&
(
((@Slink)>>item.xmin ge ScreenXmax) %
((@Slink)>>item.ymin ge ScreenYmax) %
((@Slink)>>item.xmin ls 0) %
((@Slink)>>item.ymin ls 0)
)
)
) then //kill the object
[

let t = (@Slink)>>item.link
(@Slink)>>item.link = -1
@Slink = t
return

]

Slink = @Slink
return

]

ifnot //(sweeping)
[

if Clink ge NewItem then //done with a pass
[

Clink = SpaceBase
Sweeping = true
return

]

let lcb=Length(Clink)
test Clink>>item.link eq -1
ifso //this block is dead, flush it
[

//coalesce available blocks
until (@(Clink+lcb) ne -1) do lcb = lcb+Length(Clink+lcb)

Adjust(lv FirstItem,lcb) //decrement all pointers in the main list

for i=0 to Mtsize-1 do Adjust(lv (Mact!i),lcb) //and in Mact

//adjust the screen rebuilder pointer
if Usc(RebuilderLink,Clink) eq 1 then RebuilderLink = RebuilderLink-lcb

MoveBlock(Clink,Clink+lcb,NewItem-(Clink+lcb)+1) //Blt down


NewItem = NewItem-lcb //adjustment
UpdateStatus = true//tell FlashMark to update STATUS display

]

ifnot Clink = Clink+lcb

]

]


and Adjust(ptr,delta) be //decrement all pointers in the list which are greater than Clink.
[

let t = ptr
ptr = ptr>>item.link
test Usc(ptr,Clink) eq 1 then t>>item.link = ptr-delta
or if ptr eq 0 then return

] repeat