//SilA.bcpl


get "sysdefs.d"
get "sil.defs"
external GetChar

static//declared external in nsil.defs
[
CurrentFont = 2 //user font 1
CurrentUFont = 1 //user font 1
CurrentFace = 0 //default face from user.cm
CurrentColor = Black //default to Black
YLockFlag = false
OneLevel = true //flag for macro expansion
]

static//not declared external
[
@YLockInc = 0
@YFontInc = 8
]


let DoKeyboard(ch) be
[

let OldString = false
let FForCmsg = "Font, Face, or Color"
let msg = "↑C="
msg>>str.char↑2 = (ch+#100)//change ’C’ in msg to be the current character
switchon ch into
[

case 1: //control A (Reads in and displays an Alternate text file)
FindAnalyzeLine() //find and display the next line
return

case 2: //control B (draw a box. origin and mark are corners)
[

let xmin,xmax,ymin,ymax = nil,nil,nil,nil
let x = OriginObject>>item.xmin
let y = OriginObject>>item.ymin

test NewX ls x

ifso [ xmin = NewX; xmax = x ]
ifnot [ xmin = x; xmax = NewX ]

test NewY ls y

ifso [ ymin = NewY; ymax = y ]
ifnot [ ymin = y; ymax = NewY ]

ClearSelections()
test CtrlShift
ifnot //its a regular box
[

PushCoords(xmin,ymin)
DoDraw(xmax,ymin)
DoDraw(xmax,ymax)
DoDraw(xmin,ymax)
DoDraw(xmin,ymin)

]

ifso //its a background area
[

MakeItem(NewItem,xmin,xmax,ymin,ymax,15,Active)
MakeSelected(NewItem)
MoveObjectTo(OriginObject,xmin,ymin)
//MoveObjectTo(MarkObject,NewX,NewY)
AddToList(lv FirstItem)

]
SetCursor()
Changed = true

]
return

case 3: //control C (copy selected items)
CopySelected()
Changed = true
return

case 4: //control D (delete selected items)
DeleteSelected()
SetCursor()
Changed = true
return

case 5: //control E (expand area defined by last 2 marks)
test Mag eq 1
ifso
[

let dx = NewX gr OldX? NewX-OldX,OldX-NewX
let dy = NewY gr OldY? NewY-OldY,OldY-NewY
Mag = dx gr dy? (Nwrds*16)/dx,ScreenYmax/dy
if Mag gr 9 then Mag = 9
if Mag eq 1 then return //no action
WindowXmin = NewX gr OldX?OldX,NewX
WindowYmin = NewY gr OldY?OldY,NewY

]
ifnot
[

Mag = 1
WindowXmin = 0
WindowYmin = 0

]
SetCursor()
ZapRebuilder()

return

case 6: //control F (set font)
[

let msg = "No Sil.lbx"
let char = GetChar(FForCmsg)
let clr = GetColor(char)
let fnt = GetFont(char)
let face = GetFace(char,CurrentFace,CurrentUFont)
if clr ls 16 then CurrentColor = clr
if face ge 0 then CurrentFace = face
if fnt le 9 then
[

if (fnt ge 5)&(Lprvec!((fnt-5)*DirPreambleSize) eq 0) then
[ msg>>str.char↑10 = char; Message = msg; return ]
CurrentUFont = fnt; CurrentFace = 0
CurrentFont = fnt le 3? 2*fnt,fnt+4

]

]
return

case 7: //control G (set gridsize)
GridMask = -1 lshift (GetChar(msg) & 7)
return

case #10: //control H (expand macro) Font 4 (user) only!
[

test BSkey
ifnot
[

ch = GetChar("Expand Macro")
ClearSelections()
let link = Mact!ch
until link eq 0 do

[ Expand(link,NewX,NewY); link = link>>item.link ]

SelectItemCleanup() //SetCursor()
Changed = true

]
ifso
[

if NSelectedItems ne 1 then return //must be one item selected
OldString = DeleteSelected()
if OldString>>item.font ge 14 do [ UnDelete(); return ]
MoveBlock(NewItem,OldString,Length(OldString))
NewItem>>item.state = Active
DisplayObject(NewItem)
ch = 0//AddText will ignor this character and get the next
endcase

]

]
return
case #11: //control I (input)
if not TABkey then FileIn(true)
SetCursor()
return

case #12: //control J (Jam new font or color into item)
[

JamItems(GetChar(FForCmsg))
Changed = true
return
]

case #13: //control K (reinitialize)
case #21: //control Q (quit)
if Changed then
[

if GetChar("Confirm!! Picture Changed") ne $*n then return

]
if ch eq #21 then finish
SilReInit()
return

case #14: //control L (define macro)
DefineMacro(GetChar("Define Macro"))
SetCursor()
Changed = true

return

case #15: //carriage return
UpdateYCursor()
return

case #16: //control N (complement OneLevel)
OneLevel = not OneLevel
return

case #17: //control O (output file)
if FileOut(0) then Changed = false

SetCursor()
return

case #20: //control P (snapshot)
FileOut("SIL.TEMP")
return

//case #21: //control Q (quit) see cont K (reinitialize)

case #22: //control R (delete all macro definitions)
if GetChar("Confirm to destroy font 4 macros") eq $*n then
[

for i = 0 to 127 do
[

let p = Mact!i
if p eq 0 then loop
FlushList(p)
Mact!i = 0

]

//remove all font 4 (8) macro calls from the picture
let link = lv FirstItem; until @link eq 0 do
[

let tl = @link
if tl>>item.font eq 8 then
[

@link = @tl
@tl = -1
loop

]

link = @link

]

]
ZapRebuilder()
return

case #23: //control S (show objects in cursor)
[

if NSelectedItems eq 0 then return

//copy area around origin into cursor
MakeGrayOK = false //display solid even though selected
Paint(OriginObject,toWhite) //paint white
Paint(MarkObject,toWhite) //paint white

let x = OriginObject>>item.xmin//get coordinates for rebuilder
let y = OriginObject>>item.ymin
ZapRebuilder(x,y,x+16,y+16)
until RebuilderState eq 0 do RebuildSome()
MakeGrayOK = true

let Magx = (x-WindowXmin)*Mag//now make screen coordinates
let Magy = (y-WindowYmin)*Mag

//copy area
let sw = DisplayArea + (Nwrds*Magy)+(Magx rshift 4)
let sb = Magx & #17

PlaceSelected = false
for i = 0 to 15 do
[

CursorMap!i = ((sw!(Nwrds*i)) lshift sb) % (((sw+1)!(Nwrds*i)) rshift (16-sb))
if CursorMap!i ne 0 then PlaceSelected = true

]

if PlaceSelected then
[

ZapRebuilder(x,y,x+16,y+16) //put cleared stuff back
return

]
SetCursor() //if nothing was there

]
return

case #24: //control T (turn on/off ticks)
test TickFlag ifso TickFlag = 0 ifnot TickFlag = #100000
PaintTicks()
ZapRebuilder(0,0,ScreenXmax,ScreenYmax)

return

case #25: //control U (undelete one level)
UnDelete()
SetCursor()
return

case #26: //control V (view macro definitions)
[

let char = GetChar(FForCmsg)
let ufnt = GetFont(char)
let face = GetFace(char,0); let facebit = char & 3//i=1,b=2!!!
let clr = GetColor(char)
if (clr ls 16) % (ufnt ls 4) % (face ge 0) then
[ SelectSpecifiedItems(ufnt,face,facebit,clr); return ]
//let ts = lv(StatusObject>>item.string.length)
NewItem!0 = 0
if ufnt gr 9 then return //bad no.
let mbase = Mact + 128*(ufnt-4)
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)

]
return

case #27: //control W (set LineWidth)
[

let W = GetChar(msg)-$0
if (W ge 1) & (W le 9) then LineWidth = W

]
return

case #30: //control X (move selected objects)
MoveSelected()
Changed = true
return

case #31: //control Y (complement YLockFlag)
YLockFlag = not YLockFlag
if YLockFlag then

[

YLockInc = NewY-(OriginObject>>item.ymin)
if YLockInc ls 0 then YLockInc = -YLockInc

]
return

case #32://control Z (zap screen and rebuild)//see end of ↑R
HardCopy = HardCopy eq 0
ZapRebuilder()
return

case #37: //control "←" (Move Status Line)
if my gr 748 then my = 748//don’t go off the bottom
MoveObjectTo(StatusObject,mx,my)//of the screen
MoveObjectTo(FNameObject,mx,my)
return



default: //probably add text mode
if ch le #40 then return //the character is a control character or space
//the character is a printing character
MakeItem(NewItem,NewX,NewX,NewY,NewY,CurrentFont,Active)
if CurrentUFont ls 3 then NewItem>>item.face = CurrentFace

] //end of the switchon

//the character is a printing character
//if OldString is zero, this is a new object
//if OldString is non-zero, we are editing a copy of an old string

//if the edit is sucessfull then kill the original copy
//if the edit is aborted, UnDelete the original copy

Update("Add Text")
let DidIt = AddText(NewItem,ch)
if OldString then [ UnDelete(); if DidIt then OldString>>item.state=Dead ]
Message = " "

test DidIt
ifso
[

AddToList(lv FirstItem)
SetCursor()
Changed = true
ClearSelections()
MakeSelected(FirstItem)
UpdateYCursor() //moves the mark
MoveObjectTo(OriginObject,FirstItem>>item.xmin,FirstItem>>item.ymin)

]
ifnot
[

Paint(NewItem,toWhite)
ZapRebuilderItem(NewItem)

]

]

and AddText(obj,ch) =valof
[

let firstchar = true
[

let font = obj>>item.font
let length = obj>>item.string.length
switchon ch into
[

case #21: //control Q (abort line)
length = 0 //now let controll fall through ↑W

case #27: //control W (backspace)
[

if obj>>item.string.char↑(length-1) eq #40 then break
length=length-1; if length le 0 then break

] repeat //now let controll fall through ↑A

//↑Q and ↑W fall through and call ReWriteObj in thie case statement
case #01: //control A (backspace)
case #10: //BS (backspace)
ReWriteObj(obj,length -1) //set to zero if lengh is 0
endcase

case #177: //DEL returns false
resultis false

case $*N: case #33: //CR or ESC (terminate input)
resultis (length gr 0)

case #23: // control S - convert last character into Control character
obj>>item.string.char↑length = (obj>>item.string.char↑length)%
ReWriteObj(obj)
endcase

case #0: //must be a call from "BS" command -- do nothing
endcase

default: //add ch to string (if it is defined) and display it
if firstchar do ReWriteObj(obj,0) //init str if 1st ch not one of the above
if ch ls #40 then endcase //don’t allow control characters
if font eq 8 then if Mact!ch eq 0 then endcase //undefined user macro

if font gr 8 then //library macro--may have to read it in
[

let mptr = Mact+(128*(font-8))+ch
if @mptr eq 0 then //have to read it
[

//first, we must save our object in case reading in the macro
//definition uses space in storage
//This is a crock, but we know that the font will
//be gr 8 only if AddText was called from DoKeyboard.
//in this case, obj = NewItem, and we can fiddle it.
let save = vec 128
MoveBlock(save,NewItem,128)
@mptr = -1
LibUpdate(font) //the reason for the crock is that this
//procedure can change NewItem
MoveBlock(NewItem,save,128) //put it back
obj = NewItem
if @mptr eq 0 then endcase //couldn’t find it

]

]

AppendC(ch,lv obj>>item.string.length)
DisplayObject(obj) //display new string
if font ls 8 then YFontInc = (FontVec!CurrentUFont)!-2

]
while Endofs(keys) do
[
if MouseBuffer>>OsBUF.In ne MouseBuffer>>OsBUF.Out do break
RebuildSome()
]
if Endofs(keys) then [ ch = $*n; loop ] //simulate CR on mouse action pending
ch = Gets(keys)
firstchar=false

] repeat
]

and ReWriteObj(obj,length; numargs nargs) be
[

if length ls 0 then length=0
Paint(obj,toWhite)
ZapRebuilderItem(obj)
if nargs gr 1 then obj>>item.string.length = length
DisplayObject(obj)

]

and DeleteSelected() =valof
[

if NSelectedItems eq 0 then resultis 0
let link = FirstItem
let lastDeleted = 0
let Area = vec 6
RememberArea(Area,0) //initialize Area

until link eq 0 do
[

let tl = link; link = link>>item.link
let st = tl>>item.state
if st eq Active then loop
if st eq Dead then loop
if st eq Selected then
[

RememberArea(Area,tl) //expand the Area
NSelectedItems = NSelectedItems-1
Paint(tl,toWhite)
lastDeleted = tl

]
tl>>item.state = st+1 //some old deleted items become dead

]

ZapRebuilderItem(Area)
PushCoords(Area!Xmin,Area!Ymin) //set mark
MoveObjectTo(MarkObject,NewX,NewY) //position the mark
resultis lastDeleted

]


and UnDelete() be
[

ClearSelections()
let link = FirstItem
until link eq 0 do
[

let st = link>>item.state
if (st gr Selected) & (st ne Dead) then
[

st = st-1
link>>item.state = st
if st eq Selected then
[

RememberArea(SelArea,link) //expand the Area
NSelectedItems = NSelectedItems+1

]

]
link = link>>item.link
]

SelectItemCleanup()

]


and UpdateYCursor() be //increment the mark y coordinate by YLockInc or by the
//height of the last thing added to the picture

[

NewY = NewY+ (YLockFlag? YLockInc, YFontInc + (not GridMask/2)&GridMask)
MoveObjectTo(MarkObject,NewX,NewY)

]



and MoveSelected() be
//move all selected items such that the origin is at the mark. If there are
//no selected items, or if the origin and the mark are coincident, do nothing
//when done, interchange the positions of the origin and the mark
[

if NSelectedItems eq 0 then return

PushCoords(OriginObject>>item.xmin,OriginObject>>item.ymin)

let Area = vec 6
RememberArea(Area,0) //initialize Area

let delx = OldX - NewX
let dely = OldY - NewY

if (delx eq 0) & (dely eq 0) then return

let link = FirstItem
until link eq 0 do

[

if link>>item.state eq Selected do
[

RememberArea(Area,link) //expand the Area
MoveObjectTo(link, link>>item.xmin+delx, link>>item.ymin+dely)

]

link=link>>item.link

]

MoveObjectTo(OriginObject,OldX,OldY)
MoveObjectTo(MarkObject,NewX,NewY)
if ((delx eq 0)%(dely eq 0)) & not (PlaceSelected % CtrlShift ) then MoveLineEndpoints(Area!Xmin-1,Area!Ymin-1,Area!Xmax+1,Area!Ymax+1,delx,dely)

]



and CopySelected() be
//copy all selected items such that the origin is at the mark. If there are
//no selected items, or if the origin and the mark are coincident, do nothing
[

if NSelectedItems eq 0 then return

let delx = NewX - OriginObject>>item.xmin
let dely = NewY - OriginObject>>item.ymin

if (delx eq 0) & (dely eq 0) then return

let link = FirstItem
until link eq 0 do

[

let tl = link; link = link>>item.link
if tl>>item.state ne Selected then loop
if (tl>>item.xmin+delx ls 0) % (tl>>item.ymin+dely ls 0) then
[ MakeUnSelected(tl); loop ]

[

MoveBlock(NewItem,tl,Length(tl)) //NewItem will be Selected
tl>>item.state = Active
ZapRebuilderItem(tl)
IncrementCoords(NewItem,delx,dely)
DisplayObject(NewItem)
AddToList(lv FirstItem)
]

]

MoveObjectTo(OriginObject,NewX,NewY)

]

and JamItems(char) be
[ //NSelectedItems

let clr = GetColor(char)
let ufnt = GetFont(char)
let face = GetFace(char,0)
if (ufnt gr 3) & (face eq -1) & (clr ge 16) then return
let link = FirstItem
until link eq 0 do
[

let Tlink = link; link = link>>item.link

if Tlink>>item.state ne Selected then loop
if clr ls 16 then [ Tlink>>item.color = clr; loop ]//it must be a color
Paint(Tlink,toWhite)//paint out object
ZapRebuilderItem(Tlink)//fill in over area
let txtfont = Tlink>>item.txtfont
if (txtfont le 3)%(NSelectedItems eq 1) then
[

let defface = PrFaceVec!(Tlink>>item.txtfont)
test ufnt le 3
ifso Tlink>>item.txtfont = ufnt
ifnot Tlink>>item.face = GetFace(char, Tlink>>item.face, txtfont)

]
DisplayObject(Tlink)//now repaint string

]

]

and SelectSpecifiedItems(ufnt,face,facebit,clr) be
[ //sub-set of selected items if CtrlShift is down, otherwise select from all

if CtrlShift eq 0 then ClearSelections()
let link = FirstItem
until link eq 0 do
[

if link>>item.state eq (CtrlShift? Selected,Active) then
[

let txtfont = link>>item.txtfont
let itemface = link>>item.face xor PrFaceVec!txtfont
test ( (txtfont le 3) & ((itemface&facebit) eq face) ) % (link>>item.color eq clr) % (txtfont eq ufnt)
ifso if CtrlShift eq 0 then MakeSelected(link)

ifnot if CtrlShift ne 0 then MakeUnSelected(link)

]
link = link>>item.link

]
SelectItemCleanup()

]


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 GetFont(char) =valof
resultis ((char ge $0) & (char le $9))? char-$0, $9


and GetFace(char,oldface,font; numargs nargs) =valof
[

let normalizer = nargs ge 3? PrFaceVec!font,0
oldface = oldface xor normalizer
let val = selecton char into
[

case $b: oldface % 2
case $B: oldface & #177775
case $i: oldface % 1
case $I: oldface & #177776
default: -1

]
resultis val xor normalizer

]

and GetChar(msg) =valof
[

Update(msg)
Message = " "
resultis Gets(keys)

]