// S E L E C T . S R

get "BRAVO1.DF";
get "CHAR.DF";
get "MSG.DF";
get "CALC.DF";
get "SELECT.DF";
get "DISPLAY.DF";
get "mcur.df"

// Incoming procedures

external
[
endofkeystream
underline
errhlta
innum
setsel
ult
updateunderline
ratio
backdylines
finddl
updatewindow
formaty
formatx
ugt
move
outnum
bravochar
divmod;
resetts;
getchar;
gets;
puts;
tsmakegood;
cpparabounds;
blink;
clearcaret;
deactivateomseq;
mpDlDld;
BeamLoc;
CallersFrame;
invalidateband
invalidatesel
invalidatewindow
// ValidateDisplay
LruInc
SetSelReplay;
]

// Incoming statics

external
[
selmain;
tsread;
tsstream;
rgmaccp;
cominstream;
vww;
vdoc;
rgyfirst;
vcp;
vdl;
rgcpfirst;
vcpfirst;
vcpatxdl;
vcpatxdr;
vcplast;
vxdfirst;
vxd;
vxdlast;
vxdwidth;
tsflush;
tscorrect;
outstream;
mpfnof;
fnts;
vselcaret;
mpWwWwd;
vRtcVertInt;
macww;
vmcur
mcurReset
ozonel
vfVertInt
vmeasurestatus
fddlrutimer
]

// Outgoing procedures

external
[
select;
setbug;
outsel;
waitbug;
nobug;
RoundRatio
]

// Outgoing statics

external
[
seljump;
bugstate;
xbias;
ybias;
cursorstate;
vlt
]

// Outgoing statics

static
[
seljump;
i;
bugstate;
xbias;
ybias;
cursorstate;
vlt
]

// Local stuctures

structure BUTTONS:
[
blank bit 13;
one bit 1;
three bit 1;
two bit 1;
];


manifest[ dydBumpArrow = 8; dxdBumpArrow = 13 ]

// S E L E C T
// SPE catalogue no. 118

let select(sel1, sel2, FContinue, FProc; numargs carg) be
[
TweekSel(sel1)
let fmCaller = CallersFrame() + 4
let xabug,ybug = nil,nil;
let dy = nil; // Used in case statement [sjump]
let selnew,seljump = vec sell,vec sell;
seljump >> SEL.ww = 0
let selold = sel1;
let dybug = nil;
let dywindow = nil;
let tchar = nil;
let maccp = nil;
let tcpfirst = nil;
let tcplast = nil;
let tlevel = nil;
let ttype = nil;
let wwdJump = nil
let dld = nil
let dydDlFirst = nil
let fFirstCy= true
seljump >> SEL.type = snone;
selnew >> SEL.type = snone;
selnew >> SEL.ulmode = selold >> SEL.ulmode
selnew >> SEL.cpfirstorig = selold >> SEL.cpfirst;
selnew >> SEL.cplastorig = selold >> SEL.cplast;
selnew >> SEL.xdfirstorig = -1;
selnew >> SEL.xdlastorig = -1;
let lvtoggle = (lv (vselcaret >> SEL.toggle));
@lvtoggle = 0;
let timer = nil;
cursorstate = -1
let tmcurReset = table
[ 0;
0; 0; #20000; #34000; #37000; #37600; #37740; #37770; #37770; #37740; #37600; #37000; #34000; #20000; 0; 0;
-1; -1; #120001; #134001; #137001; #137601; #137741; #137771; #137771; #137741; #137601; #137001; #134001; #120001; -1; -1;
0; 0;
]
mcurReset = tmcurReset
if tsread then
SetSelReplay(sel1)
if tsread then
return;

[
unless (carg ge 3 ? FContinue(selold, fmCaller),
endofkeystream()) do break;
// let ydNow = BeamLoc(vRtcVertInt)
// test ydNow gr rgyfirst ! macww ifso
// setbug(sreset)
// ifnotsetbug(sjump)
// loop
xabug = rv(xbugloc)+xbias;
i = bug >> BUTTONS.one eq 0 ? 1,
(bug >> BUTTONS.two eq 0 ? 2,
(bug >> BUTTONS.three eq 0 ? 3,0));
if xabug ls xaudleft then i = i+4;
if xabug ls xajump then i = i+4;
selnew >> SEL.type = table [
snone; schar; sword; sstar;
snone; sline; sph; sstar;
snone; sjump; sjump; sjump ] ! i;
bugstate = table [
snone; snone; snone; snone;
sline; sline; sline; snone;
sjump; sup; sreset; sdown ] ! i;

test selnew >> SEL.type eq snone ifso
[ if vfVertInt & vmeasurestatus then
[ vfVertInt= 0
test fFirstCy ifso
fFirstCy = false
ifnot
[ vlt>>LT.cCyc= vlt>>LT.cCyc + 1
if vlt>>LT.cCyc eq 3600 then
[
vlt>>LT.cCyc = 0
vlt>>LT.cMin = vlt>>LT.cMin + 1
]
]
]
]
ifnot
[ vfVertInt = 0; fFirstCy = true; ];
if i eq 7 & selold >> SEL.type eq sline then
bugstate = sline;
if i ls 8 & selold >> SEL.type eq sph then
bugstate = sph;
test bugstate eq sreset ifso
[ let wwd = mpWwWwd ! vww; let ydFirst = rgyfirst ! vww;
mcurReset >> MCUR.aclocOther.x = clocHwr >> CLOC.x
mcurReset >> MCUR.aclocOther.y = ydFirst+RoundRatio(rgyfirst ! (vww+1)-ydFirst,wwd>>WWD.cpFDispl,rgmaccp ! (wwd>>WWD.doc));
vmcur = mcurReset
cursorstate = -1
]
ifnot[ vmcur = 0
setbug(bugstate);
]
if vselcaret >> SEL.type eq scaret then
blink(lvtoggle,lv timer,once);
let dydToTipArrow = selecton bugstate into
[
case sline:4
case sreset:8
case snone:-4
default:0
]
ybug = rv(ybugloc)+dydToTipArrow// +ybias-4;

L2001:
// ** to com.sr **if sel1 eq selmain then waitthings();
formaty(ybug);
if (vdl eq -1) then loop
let tDoc = (mpWwWwd ! vww)>>WWD.doc
if rgmaccp ! (tDoc) eq 0 then loop;
test selnew >> SEL.type eq sstar ifso
[ if selold >> SEL.doc ne tDoc
then loop;
ttype = selold >> SEL.type;
]
ifnotttype = selnew >> SEL.type
switchon ttype into
[

case snone:
if seljump >> SEL.type eq snone then loop;
underline(uloff,selold);
updateunderline();
vww = seljump >> SEL.ww;
wwdJump = mpWwWwd ! vww;
vdoc = wwdJump>>WWD.doc;

dld = mpDlDld((mpWwWwd ! vww) >> WWD.dlFirst)
dydDlFirst = dld >> DLD.dYdBm+dld >> DLD.ld
dy = ybug-rgyfirst ! vww-dydDlFirst;
switchon seljump >> SEL.type into
[

case sreset:dybug = ybug-rgyfirst ! vww;
dywindow = rgyfirst ! (vww+1)-rgyfirst ! vww;
if dybug gr dywindow then
dybug = dywindow;
vcp = valof
[ if dybug ls 10 then
resultis 0;
if ybug gr (rgyfirst ! (vww+1))-10 then
resultis rgmaccp ! vdoc-1;
resultis RoundRatio(rgmaccp ! vdoc,dybug,dywindow);
]
backdylines(vww,vcp,0);
endcase;

case sdown:
vcp = wwdJump>>WWD.cpFDispl;
[
dy = dy-backdylines(vww,vcp,dy);
] repeatuntil (vcp eq 0) % (dy le 0)
endcase;

case sup:vdl = finddl(vww,seljump >> SEL.cpfirst);
if vdl ls 0 then loop;
vcp = rgcpfirst ! vdl;
if vcp eq wwdJump>>WWD.cpFDispl then
if dy gr 0 & ult(dld>>DLD.cpLast+1,rgmaccp!vdoc) then
vcp = dld>>DLD.cpLast + 1
endcase;

]; // end switchon

if (ozonel ne 0) then
[ deactivateomseq("",0)
]
if ult(vcp,wwdJump>>WWD.cpFDispl) then
[ let cpLastDispl = (mpDlDld(wwdJump>>WWD.dlLast))>>DLD.cpLast
let dcpDispl = cpLastDispl-wwdJump>>WWD.cpFDispl
if ult(dcpDispl rshift 1,wwdJump>>WWD.cpFDispl-vcp) then
invalidatewindow(seljump >> SEL.ww)
]
wwdJump>>WWD.cpFDispl = vcp;
(mpDlDld(wwdJump>>WWD.dlFirst))>>DLD.xdLast = -1
seljump >> SEL.type = snone;
updatewindow(vww);
underline(selold >> SEL.ulmode,selold);
loop;

case sjump:seljump >> SEL.type = bugstate;
seljump >> SEL.ww = vww;
seljump >> SEL.cpfirst = rgcpfirst ! vdl;
loop;

case schar:formatx(vww,vdl,xabug);
vcpfirst = vcpatxdl;
vcplast = vcpatxdr;
vxdfirst = vxd;
vxdlast = vxd+vxdwidth-1
goto setorig;

case sword:formatx(vww,vdl,xabug);
goto setorig;

case sline:dld = mpDlDld(vdl)
vcpfirst = rgcpfirst ! vdl;
vcplast = dld>>DLD.cpLast;
vxdfirst = dld>>DLD.xdFirst;
vxdlast = dld>>DLD.xdLast;
goto setorig;

case sph:cpparabounds(tDoc,rgcpfirst ! vdl,lv vcpfirst,lv tcplast,lv vcplast);
vxdfirst = -1
vxdlast = -1;
goto setorig;

setorig:seljump >> SEL.type = snone;
//vfhp = fhpsel;
test selnew >> SEL.type eq sstar ifnot
[ selnew >> SEL.cpfirstorig = vcpfirst;
selnew >> SEL.cplastorig = vcplast;
selnew >> SEL.xdfirstorig = vxdfirst;
selnew >> SEL.xdlastorig = vxdlast;
]
ifsotest ult(vcpfirst,selold >> SEL.cpfirstorig) ifso
[
// vcpfirst = vcpfirst;
vcplast = selold >> SEL.cplastorig;
// vxdfirst = vxdfirst;
vxdlast = selold >> SEL.xdlastorig;
]
ifnot[ vcpfirst = selold >> SEL.cpfirstorig;
// vcplast = vcplast;
vxdfirst = selold >> SEL.xdfirstorig;
// vxdlast = vxdlast;
]
] // end switchon

selnew >> SEL.type = ttype;
selnew >> SEL.cpfirst = vcpfirst;
selnew >> SEL.cplast = vcplast;
selnew >> SEL.xdfirst = vxdfirst;
selnew >> SEL.xdlast = vxdlast;
selnew >> SEL.ww = vww;
selnew >> SEL.doc = tDoc;

if sel2 & not ugt(selnew >> SEL.cpfirst,sel2 >> SEL.cplast) &
not ugt(sel2 >> SEL.cpfirst,selnew >> SEL.cplast) &
(selnew >> SEL.doc eq sel2 >> SEL.doc)
then loop;

ifselold >> SEL.type eq ttype &
selold >> SEL.cpfirst eq vcpfirst &
selold >> SEL.cplast eq vcplast &
selold >> SEL.doc eq tDoc then loop;

if carg eq 4 then
unless FProc(selnew, fmCaller) do loop

(mpWwWwd ! (selnew >> SEL.ww))>>WWD.lru = LruInc(lv fddlrutimer)
underline(uloff,selold);
move(selnew,selold,sell);
underline(selold >> SEL.ulmode,selold);
updateunderline( );
loop;
] repeat; // end repeat
TweekSel(sel1)
clearcaret(lvtoggle);
vselcaret >> SEL.type = snone;
if carg le 2 then
outsel(sel1 >> SEL.type,sel1 >> SEL.ww,sel1 >> SEL.cpfirst,sel1 >>
SEL.cplast);
] // end select.

// S E T B U G
// SPE catalogue no.

and setbug(newcursorstate) be
[

if cursorstate ne newcursorstate then
[
// xbias = 0; ybias = 4
// if (cursorstate eq snone % cursorstate eq -1) & newcursorstate ne sreset then
// [
// xbias = 13; ybias = 8;
// rv(ybugloc) = rv(ybugloc)-ybias;
// rv(xbugloc) = rv(xbugloc)-xbias;
// ]
// if (cursorstate ne sreset % cursorstate eq -1) & newcursorstate eq snone then
// [
// rv(ybugloc) = rv(ybugloc)+ybias;
// rv(xbugloc) = rv(xbugloc)+xbias;
// xbias = 0; ybias = 0;
// ]
test (newcursorstate eq sline) & (cursorstate eq snone) ifso
[ rv(ybugloc) = rv(ybugloc)-dydBumpArrow;
rv(xbugloc) = rv(xbugloc)-dxdBumpArrow;
]
ifnot[ if (newcursorstate eq snone) & (cursorstate ne -1) then
//& (cursorstate eq sline)
[ rv(ybugloc) = rv(ybugloc)+dydBumpArrow;
rv(xbugloc) = rv(xbugloc)+dxdBumpArrow;
]
]
cursorstate = newcursorstate;
xbias = (cursorstate eq snone) ? 0,13

let cursor = selecton cursorstate into
[


case snone:table
[
#100000; #140000; #160000;
#170000; #174000; #176000;
#177000; #170000; #154000;
#114000; #006000; #006000;
#003000; #003000; #001400;
#001400;
]

case sline:table[
#000000; #000000; #000000;
#000000; #001777; #000776;
#000374; #001770; #007560;
#036140; #170100; #140000;
#000000; #000000; #000000;
#000000;
]

case sreset:table[
#000000; #017770; #017770;
#014030; #014030; #014030;
#014030; #014030; #014030;
#014030; #014030; #014030;
#014030; #017770; #017770;
#000000;
]

case sdown:table[
#007760; #007760;
#007760; #007760; #007760;
#007760; #007760; #007760;
#077776; #037774; #017770;
#007760; #003740; #001700;
#000600; #000000;
]

case sup:table[
#000600; #001700; #003740;
#007760; #017770; #037774;
#077776; #007760; #007760;
#007760; #007760; #007760;
#007760; #007760; #007760;
#007760;
]

case sjump:table[
#000400; #001600; #003700;
#007740; #017760; #001600;
#001600; #001600;
#001600; #001600; #017760;
#007740; #003700; #001600;
#000400; #000000;
]
case sph:table[
0; #3700; #7200;
#7200; #7200; #7200;
#7200; #3200;
#1200; #1200; #1200;
#1200; #1200; 0;
0; 0;
]
] // end selecton

move(cursor,curmap,16);
] // end if
] // end setbug

// O U T S E L
//
and outsel(type,ww,cpfirst,cplast) be
[
if tscorrect then return;
if type eq snone then
[
puts(fnts,$’);
tsmakegood();
return;
]
let maccp = rgmaccp ! ((mpWwWwd ! ww)>>WWD.doc)
unless ult(cpfirst,maccp) & ult(cplast,maccp) then errhlta(108);
puts(fnts,${);
outnum(fnts,type,8);
puts(fnts,$,);
outnum(fnts,ww,8);
puts(fnts,$,);
outnum(fnts,cpfirst,8);
puts(fnts,$,);
outnum(fnts,cplast,8);
puts(fnts,$});
tsmakegood();
]
// W A I T B U G
// SPE catalogue no.

and waitbug() = valof
[
let tchar = nil;
if tsread then
[
tchar = gets(fnts);
if tchar eq ctrlc then
resultis false;
test tchar eq chat ifso
[ tchar = gets(fnts);
unless tchar eq $E do errhlta(109);
resetts();
tsread = false;
tscorrect = false;
]
ifnot[
rv(ybugloc) = innum(fnts,8);
resultis true;
]
]
[
if not endofkeystream() then
[ tchar = getchar();
if tchar eq ctrlc then
[ puts(fnts,ctrlc);
tsmakegood();
resultis false;
]
]
] repeatuntil (rv(bug) & 7) ne 7;
if tscorrect then resultis true;
puts(fnts,$y);
outnum(fnts,rv ybugloc,8);
puts(fnts,$,);
tsmakegood();
resultis true;
] // end waitbug


// N O B U G
//
and nobug() = (rv(bug) & 7) eq 7


and once() = false;


// R O U N D R A T I O

and RoundRatio(x, a, b) = ratio(x, a, b) + (ratio(x, a lshift 1, b) & 1)

and TweekSel(sel) be
[ unless sel >> SEL.ww ls macww then
[ sel >> SEL.ww = macww-1
sel >> SEL.doc = (mpWwWwd ! (macww-1)) >> WWD.doc
let maccp = rgmaccp ! (sel >> SEL.doc)
sel >> SEL.cplast = maccp-1
sel >> SEL.cpfirst = 0
invalidatesel(sel)
]
]