//  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
[(635)\59b9B
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,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 = " "
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 link>>item.macro eq 1 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
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
[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))
test ((obj>>item.macro eq 0) % (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 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
[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 
[\5b
ShowcntlS = false
let ct = 0
switchon TiltedScreen into
[
case 0:
ct  = table
   [l4268\b
#177400; #177000; #176000; #177000; #177400; #177600; #157700; #107740
 #003760; #001770; #000760; #000340; #000100; #000000; #000000; #000000l5538\b
   ]
endcase
case 1:
ct = table
	[l4268\b
#1777; #0777; #0077; #177; #377; #000777; #001773; #3761
#7740; #017700; #007600; #003400; #000400; #000000; #000000; #000000l5538\b
	]
endcase

case 2:
ct = table
	[l4268\b
#0; #0; #0; #1; #7; #174; #376; #3760
#2177; #15770; #17760; #17740; #17700; #17600; #17760; #17770l5538\b
			]
		endcase
		]
MoveBlock(CursorMap,ct,16)
PlaceSelected = false
]


and UpdateMarkOrig() be 
[\b
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() l4269\b
]


and GetColor(char) =valof
[\b2B
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)
l4269
]


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



\4b165B14b155B203b1B
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 
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
l5538\69b134B
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
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
l6808\113b28B
]

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
test line
ifso if ((xmax-xmin) gr (ymax-ymin)) then loop // horizontal line
ifnot if (xmin ls wxmin)%(xmax gr wxmax) then loop//bkgnd largel6808\113b28B
]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 area 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
				]
		]
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,0,1,0)
DisplayObject(NewItem)
MakeSelected(NewItem)
MoveObjectTo(OriginObject,xmin,ymin)
MoveObjectTo(MarkObject,NewX,NewY)

AddToList(lv FirstItem)l4268
]