// RSilB.bcpl

get "sysdefs.d"
get "Sil.defs"
external ViewMacro

static
[
lastlink
mainl
]

//Macro definition: first, determine whether the macro would be recursive
//if so don’t allow it. While looking over the selected items, determine the
//xmin and ymin for the collection of selected objects
//if this is an overwrite, release the present definition.
//Move all selected objects from the main list to the macro table. Relativize
//the coordinates.
//Add a call on the macro to the main space.

let DefineMacro(char) be
[

let Area = vec 6
if NSelectedItems eq 0 then [ Message = "Nothing Selected"; return ]
if CheckMacro(char,Area) then [ Message = "Bad Macro Definition"; return ]

Message = "Confirm With CR to Overwrite"
Message>>str.length= Mact!char eq 0? 15,28//set Message to "Confirm With CR"
Update()
if Gets(keys) ne $*n then [ Message = "--Aborted"; return ]


//all posible errors have been detected so now we may proceed
//CheckMacro updated the static MacArea with MXmin and MYmin coordinates.
//First, release any present definition.

let MXmin = (Area!Xmin)𫙮 //make macros fall on grid 4
let MYmin = (Area!Ymin)𫙮

FlushList(Mact!char)

//Move objects from the main list to the macro table
lastlink = lv(Mact!char)
mainl = lv(FirstItem)
until mainl eq 0 do
[

if (@mainl)>>item.state ne Selected then
[

mainl = @mainl
loop

]

//add item to macro table after removing from main list

//dl1:
let node = @mainl
@mainl = node>>item.link //unhook from main
node>>item.state = Active
node>>item.link = 0
IncrementCoords(node,-MXmin,-MYmin)
@lastlink = node
lastlink = node

]

//dl2:
NSelectedItems = 1
//add a single character string containing the definition
MakeItem(NewItem,MXmin,MXmin,MYmin,MYmin,14,Selected,1,0,0) //can only define
//macros in user font 7

AppendC(char,lv NewItem>>item.string)
AddToList(lv FirstItem)
MoveObjectTo(OriginObject,MXmin,MYmin)//will set Xmax and Ymax
ZapRebuilder()
Message = " "

]


and CheckMacro(char,Area) = valof
[

if ((char eq #177)%(char ls #41)) then resultis true //abort on DEL or control
RememberArea(Area,0)
let tested = NSelectedItems
let link = FirstItem
until link eq 0 do
[

if link>>item.state eq Selected then
[

RememberArea(Area,link)
//if link>>item.font eq 8 then
if link>>item.macro eq 1 then
if RecursiveDefinition(link,char) then resultis true
tested = tested-1
if tested eq 0 then resultis false

]
link = link>>item.link

]
resultis false

]

and RecursiveDefinition(ptr,char) = valof //checks whether the string object
//pointed to by ptr contains (itself or in any lower level) the character char
[

//if ptr>>item.font ne 8 then resultis false
if ptr>>item.macro ne 1 then resultis false
let sl = ptr>>item.string.length
if sl eq 0 then resultis true //zero length strings aren’t right
for i = 1 to sl do
[

let tc = ptr>>item.string.char↑i
if tc eq char then resultis true
let tp = Mact!tc
until tp eq 0 do

[

let xp = tp; tp=tp>>item.link
if RecursiveDefinition(xp,char) then resultis true

]

]
resultis false

]

and CleanUp() be //called by Finish
[

SetKeyboardProc()
@#420 = 0 //turn off display

]

and Expand(obj,x0,y0) be //expand macro at x0,y0
[

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

//we make a copy of the object if: (1) it is not a macro, or
// (2) if OneLevel = true
//otherwise, we expand the macro string

//test ((obj>>item.font ls 8)%(obj>>item.font ge 14) % (OneLevel))
test ((obj>>item.macro eq 0) % (OneLevel))
ifso
[

MoveBlock(NewItem,obj,Length(obj))
IncrementCoords(NewItem,x0,y0)
if DisplayArea ne 0 then [ NewItem>>item.state=Active;MakeSelected(NewItem) ]
AddToList(lv FirstItem)

]

ifnot
[

//the object is a macro string- each character’s entry in Mact
//is the head of a list of blocks comprising the character. The
//coordinates of the blocks are relative to the upper left of the character.

let sl = obj>>item.string.length
if sl eq 0 then return //ignore zero length strings
let xsofar = 0
let font = obj>>item.font
let mfont = 0
if font ne 14 then mfont = font - 7
//let mtbase = Mact+((obj>>item.font)-8)*128
let mtbase = Mact+mfont*128
for i = 1 to sl do
[

let chxmax = 0
let mptr = mtbase!(obj>>item.string.char↑i)
until mptr eq 0 do
[

Expand(mptr,x+xsofar,y)
let tx = mptr>>item.xmax
if tx gr chxmax then chxmax = tx
mptr = mptr>>item.link

]
xsofar = xsofar+chxmax

]

]

]



and SetCursor() be
[

ShowcntlS = false
let ct = 0
switchon TiltedScreen into
[
case 0:
ct = table
[

#177400; #177000; #176000; #177000; #177400; #177600; #157700; #107740
#003760; #001770; #000760; #000340; #000100; #000000; #000000; #000000

]
endcase
case 1:
ct = table
[

#1777; #0777; #0077; #177; #377; #000777; #001773; #3761
#7740; #017700; #007600; #003400; #000400; #000000; #000000; #000000

]
endcase

case 2:
ct = table
[

#0; #0; #0; #1; #7; #174; #376; #3760
#2177; #15770; #17760; #17740; #17700; #17600; #17760; #17770

]
endcase
]
MoveBlock(CursorMap,ct,16)
PlaceSelected = false
]


and UpdateMarkOrig() be
[

test TiltedScreen eq 0
ifso [
MakeItem(OriginObject,0,4,0,2,14,Active, 0,1,0)// 4 by 2
MakeItem(MarkObject,0,2,0,7,14,Active, 0,1,0) // 2 by 7
]
ifnot
[
MakeItem(OriginObject,0,2,0,4,14,Active,0,1,0)// 2 by 4 high
MakeItem(MarkObject,8,15,0,2,14,Active,0,1,0) // 7 wide by 2
]
SetCursor()

]


and GetColor(char) =valof
[

let colormap = table
[
Aqua; $b; Cyan; Brown; $e; $f; Green; $h
$i; $j; $k; Lime; Magenta; Black; Orange; Pink
$q; Red; Smoke; Turquoise; UltraViolet; Violet; White; $x; Yellow //; $z
]
char = char % #40
if (char ls $a) % (char gr $y) then resultis char
resultis colormap!((char % #40)-$a)

]


and ViewMacro(char,ufnt) be
[
let macrofont = -1
if ufnt eq 7 & CtrlShift eq 0 then macrofont = 0
if ufnt ge 5 & ufnt le 9 & CtrlShift ne 0 then macrofont = ufnt -4
NewItem!0 = 0
//if ufnt gr 9 then return //bad no.
//let mbase = Mact + 128*(ufnt-4)
if macrofont eq -1 then return// bad number
let mbase = Mact + 128*(macrofont)
AppendC(char,NewItem)
AppendS(": ",NewItem)
for i = 0 to 127 do if mbase!i ne 0 then
[
if i ls #40 do [ AppendC($↑,NewItem); i=i+$@ ]//shouldn’t happen!
AppendC(i,NewItem)
]
Update(NewItem)
]

and MoveLineEndpoints(wxmin,wymin,wxmax,wymax,delx,dely) be
[

//a group of objects contained in the window described by the first
//four parameters has been moved by an amount given by the last
//two parameters, one of which is guaranteed to be zero. We
//move the endpoints of all lines which intrude into the window.
let nwxmin,nwymin,nwxmax,nwymax = wxmin,wymin,wxmax,wymax //new area for ZapRebuilder
let movedlines = false //indicates that at least one endpoint was actually adjusted

let tlink = FirstItem
until tlink eq 0 do
[

let link = tlink; tlink=tlink>>item.link
let font = link>>item.font
let line = link>>item.line eq 1
let area = link>>item.area eq 1
let notline = not ( line % area )
if notline then loop //not a line
if link>>item.state ge Selected then loop //selected things have already been moved

let xmin = link>>item.xmin
let ymin = link>>item.ymin
let xmax = link>>item.xmax
let ymax = link>>item.ymax

if ((ymin gr wymax) % (ymax ls wymin)) then loop //not in window in y
if ((xmin gr wxmax) % (xmax ls wxmin)) then loop //not in the window in x

if delx ne 0 then //things to skip on an horizontal translation
[

//totally inside window - therefore probably moved. leave alone
if ((xmin ge wxmin) & (xmax le wxmax)) then loop
//test font eq 14
test line
ifso if ((ymax-ymin) gr (xmax-xmin)) then loop // vertical line
ifnot if (ymin ls wymin)%(ymax gr wymax) then loop//bkgnd large

]

if dely ne 0 then //things to skip on a vertical translation
[

//totally inside window - therefore probably moved. leave alone
if ((ymin ge wymin) & (ymax le wymax)) then loop
//test font eq 14
test line
ifso if ((xmax-xmin) gr (ymax-ymin)) then loop // horizontal line
ifnot if (xmin ls wxmin)%(xmax gr wxmax) then loop//bkgnd large

]

//we only get here if there is something to do
Paint(link,toWhite) //we are going to modify this line, so paint it white
movedlines = true
//if font eq 15 then ZapRebuilderItem(link) //must repaint backgrounds
if area then ZapRebuilderItem(link) //must repaint backgrounds
if delx gr 0 then //translation was to the right
[

//lengthen the right end of the line
if xmax ls wxmax then link>>item.xmax = xmax+delx

//shorten the left end unless the line would disappear
if xmin gr wxmin then
if (xmax-xmin) gr delx then link>>item.xmin = xmin+delx
nwxmax = wxmax+delx

]

if delx ls 0 then //translation was to the left
[

//lengthen the left end of the line (delx is negative)
if xmin gr wxmin then link>>item.xmin = xmin+delx

//shorten the right end unless the line would disappear
if xmax ls wxmax then
if (xmax-xmin) gr -delx then link>>item.xmax = xmax+delx
nwxmin = wxmin+delx

]

if dely gr 0 then //translation was to the down (+y)
[

//lengthen the bottom end of the line
if ymax ls wymax then link>>item.ymax = ymax+dely

//shorten the top end unless the line would disappear
if ymin gr wymin then
if (ymax-ymin) gr dely then link>>item.ymin = ymin+dely
nwymax = wymax+dely

]

if dely ls 0 then //translation was to the up (-y)
[

//lengthen the top end of the line
if ymin gr wymin then link>>item.ymin = ymin+dely

//shorten the bottom end unless the line would disappear
if ymax ls wymax then
if (ymax-ymin) gr -dely then link>>item.ymax = ymax+dely
nwymin = wymin+dely

]
]
if movedlines then ZapRebuilder(nwxmin,nwymin,nwxmax,nwymax)
]

and DoDraw(x,y) be//draw a line between the previous mark and x,y, which becomes the current mark
[

let lw = (Mag eq 1)?LineWidth,0 //put lines exactly where the user specifies in magnify mode
PushCoords(x,y)
let delx = OldX-NewX; if delx ls 0 then delx = -delx
let dely = OldY-NewY; if dely ls 0 then dely = -dely

let xmin,xmax,ymin,ymax = nil,nil,nil,nil
test delx ge dely
ifso //the line is to be horizontal
[

ymin = OldY; ymax = OldY+LineWidth
test NewX ge OldX
ifso [ xmin = OldX; xmax = NewX ] //the new line was drawn left to right
ifnot [ xmin = NewX; xmax = OldX+lw ] //the new line was drawn right to left

NewY = OldY

]

ifnot //the line is to be vertical
[

xmin = OldX; xmax = OldX+LineWidth
test NewY ge OldY
ifso [ ymin = OldY; ymax = NewY ] //the line is drawn from top to bottom
ifnot [ ymin = NewY; ymax = OldY+lw ] //the line is drawn from bottom to top

NewX = OldX

]

MakeItem(NewItem,xmin,xmax,ymin,ymax,14,Active,0,1,0)
DisplayObject(NewItem)
MakeSelected(NewItem)
MoveObjectTo(OriginObject,xmin,ymin)
MoveObjectTo(MarkObject,NewX,NewY)

AddToList(lv FirstItem)

]