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

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

//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)
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((OneLevel? $T,$F),ts)
AppendC((YLockFlag? $T,$F),ts)

//The following string has char 1 for color 0, char 2 for color 1 etc

AppendS(" Space: ",ts)

AppendS(" Selections: ",ts)

//if any mouse button is down, display the cursor
//coordinates rather than those of the mark
AppendS(" X: ",ts)

AppendS(" Y: ",ts)
AppendS(" ",ts)

let xHardCopy = HardCopy; HardCopy=0
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
test CtrlShift
ifso MakeUnSelected(st)
ifnot MakeSelected(st)
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.
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
//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

// 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)

and MakeSelected(ptr) be
if ptr>>item.state ne Selected then
NSelectedItems = NSelectedItems+1
ptr>>item.state = Selected



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

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
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"
//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

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

//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
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
if Slink>>item.link eq 0 then //done with this pass
Slink = lv FirstItem
Sweeping = false
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

Slink = @Slink

ifnot //(sweeping)
if Clink ge NewItem then //done with a pass
Clink = SpaceBase
Sweeping = true

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