//SilB.bcpl   --  last modified January 23, 1978 by R. bates


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

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
[(635)
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)&#177774 //make macros fall on grid 4
let MYmin = (Area!Ymin)&#177774

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
[l4268
if (@mainl)>>item.state ne Selected then
[l5538
mainl = @mainl
loopl6808
]

//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 = nodel5538
]

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

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

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
[l4268
if link>>item.state eq Selected then
[l5538
RememberArea(Area,link)
if link>>item.font eq 8 then
if RecursiveDefinition(link,char) then resultis true
tested = tested-1
if tested eq 0 then resultis falsel6808
]
link = link>>item.linkl5538
]
resultis falsel4268

]

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
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
[l4268
let tc = ptr>>item.string.char^i
if tc eq char then resultis true
let tp = Mact!tc
until tp eq 0 dol5538
[l5538
let xp = tp; tp=tp>>item.link
if RecursiveDefinition(xp,char) then resultis true
l6808
]l5538
]
resultis falsel4268
]

and CleanUp() be //called by Finish
[
SetKeyboardProc()
@#420 = 0 //turn off display
l4268
]

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))
ifso
[l4268
MoveBlock(NewItem,obj,Length(obj))
IncrementCoords(NewItem,x0,y0)
if DisplayArea ne 0 then [ NewItem>>item.state=Active;MakeSelected(NewItem) ]
AddToList(lv FirstItem)l5538
]

ifnot
[l4268
//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.l4268
let sl = obj>>item.string.length
if sl eq 0 then return //ignore zero length strings
let xsofar = 0
let mtbase = Mact+((obj>>item.font)-8)*128

for i = 1 to sl do
[l5538
let chxmax = 0
let mptr = mtbase!(obj>>item.string.char^i)
until mptr eq 0 do
[l6808
Expand(mptr,x+xsofar,y)
let tx = mptr>>item.xmax
if tx gr chxmax then chxmax = tx
mptr = mptr>>item.linkl8078
]
xsofar = xsofar+chxmaxl6808
]l5538
]l4268
]

and SetCursor() be 
[
let ct = table
[l4268
#177400; #177000; #176000; #177000; #177400; #177600; #157700; #107740
#003760; #001770; #000760; #000340; #000100; #000000; #000000; #000000l5538
]
MoveBlock(CursorMap,ct,16)
PlaceSelected = falsel4269
]


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
[l4268
let link = tlink; tlink=tlink>>item.link
let font = link>>item.font 
if font ls 14 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
l5538
if delx ne 0 then  //things to skip on an horizontal translation
[l5538
//totally inside window - therefore probably moved. leave alone
if ((xmin ge wxmin) & (xmax le wxmax)) then loop
test font eq 14
ifso if ((ymax-ymin) gr (xmax-xmin)) then loop // vertical line
ifnot if (ymin ls wymin)%(ymax gr wymax) then loop//bkgnd large
l6808
]

if dely ne 0 then  //things to skip on a vertical translation
[l5538
//totally inside window - therefore probably moved. leave alone
if ((ymin ge wymin) & (ymax le wymax)) then loop
test font eq 14
ifso if ((xmax-xmin) gr (ymax-ymin)) then loop // horizontal line
ifnot if (xmin ls wxmin)%(xmax gr wxmax) then loop//bkgnd largel6808
]l5538

//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 delx gr 0 then //translation was to the right
[l5538
//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+delxl6808
]

if delx ls 0 then //translation was to the left
[l5538
//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+delxl6808
]

if dely gr 0 then //translation was to the down (+y)
[l5538
//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+delyl6808
]

if dely ls 0 then //translation was to the up (-y)
[l5538
//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+delyl6808
]
l5538
]

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
[l4268
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 = OldYl5538
]

ifnot  //the line is to be vertical
[l4268
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 = OldXl5538
]

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

AddToList(lv FirstItem)l4268
]