// Select Module GSELECT.SR Select and Scroll commands

get "BRAVO.DF"
get "CHAR.DF"
get "GINN.DF"

// Incoming Procedures

external [
	ratio;
	updatedisplay;
	formatx;
	formaty;
	backnlines;
	setbug;
	mousedecode
	pollmouse
	pollstripe
	pollkeyset
	cpvisible
	resetmessage
	elapsed
	setmenu
	cpparabounds
	cpmin
	lastparacp
	cpc
	selectsel
	pointable
	nextunpointablecp
	nearestpointablecp
	marks
	locatebug
	stillselecting
	buggedsomething
	newbias
	hidemark
	cpmax // %%
	];

// Incoming Statics

external [
	vturning
	vjumpbar
	vwindows
	vmscroll
	vwords
	mdoc
	vcp;
	vdlhint;
	rgmaccp;
	rgcplast;
	rgupdate;
	rgcpfirst;
	rgxfirst;
	rgdoc;
	rgdlfirst;
	rgdllast;
	rgmaxdl;
	rgcpfdispl;
	rgxlast;
	vwidth;
	vdoc;
	vcpatx;
	vx;
	vww;
	vdl;
	vheight;
	vbetwixt;
	vstripe;
	comt;
	abs
	selection;
	selaux;
	cursorstate ;
	vwwcurrent
	vcpfirst
	vcplast
	vxfirst
	vxlast
	mww
	vpause
	rgprogram
	sww
	xbug;
	ybug;
	cpleft
	cpright
	xleft
	xright
	cptex
	cpb
	cpe
	mcpfirst;
	mcplast;
	mxfirst;
	mxlast;
	origdl
	origww
	inmargin
	];

// Outgoing Procedures

external [
	select
	mark
	thing
	rollup
	rolldown
	rollupfast
	rolldownfast
	rollupfar
	rolldownfar
	roll
	flyaway
	];

// Outgoing statics

// Local Statics

let showsel1(sel, cp1, x1, cp2, x2 ; numargs N) be
[
mcpfirst = cp1
mxfirst = N ge 3? x1, -1
mcplast = N ge 4? cp2, cp1-1
mxlast = N ge 5? x2, -1
showsel(sel)
]

and showsel2(sel, cp2, x2 ; numargs N) be
[
mcplast = cp2
mxlast = N eq 3? x2, -1
showsel(sel)
]

and showsel(sel) be
	[
	let troll = selecton comt ! pollkeyset() into
		[
		case srollup: rollup;
		case srolldown: rolldown;
		case srollupfast: rollupfast;
		case srolldownfast: rolldownfast;
		default: false
		];

//	if vmscroll & not troll & ((pollmouse()-smouse)&2) eq 2 then
//		troll = rollfunc(ybug, vww) ;

	let tchanged =
		sel >> SEL.cpfirst ne mcpfirst %
		sel >> SEL.cplast ne mcplast %
		sel >> SEL.doc ne rgdoc ! vww %
		(vwwcurrent ne vww & vww ne mww & vww ne wwsys) %
		sel >> SEL.ulmode ls 0 ;

	sel >> SEL.type = schar;
	sel >> SEL.ulmode = sel eq selection? 1,2 ;
	sel >> SEL.cpfirst = mcpfirst;
	sel >> SEL.cplast = mcplast;
	sel >> SEL.xfirst = mxfirst;
	sel >> SEL.xlast = mxlast;
	sel >> SEL.ww = vww;
	sel >> SEL.doc = rgdoc ! vww;

	if vwindows & sel eq selection & vww ne mww &
	    vww ne vwwcurrent then
		[
		vwwcurrent = vww ;
		setmenu()
		]

	if troll then
		[
		troll(-1) ;
		updatedisplay();
		]

	if troll % tchanged then
		[
		marks(true)
		marks(false) ;
		];

	] // end showsel

and postjump(success) = valof
	[
	if success then
		[
		rgcpfdispl ! vww = vcp;
		// rgxlast ! (rgdlfirst ! vww) = -1; // LT
		rgupdate ! vww = true
		vpause = vdoc eq mdoc? 500, 100
		vturning = true
		];
	resultis 0 ;
	] // end of postjump

and roll(cmdcode) = 0 // was mouse scroller
// valof
//	[
//	unless buggedsomething(true,-1,false,-1) do resultis 0 ;
//	vpause = vdoc eq mdoc? 1500, 100
//	marks(false) ;
//	resultis rollfunc(ybug, vww)(1, false) ;
//	] // end of roll

// and rollfunc(y, w) = y ls (rgyfirst!w + rgylast!w) rshift 1?
//	rolldown, rollup
 
and rolldown(cmdcode) = rolldown1(1, cmdcode gr 0)  ;

and rolldownfast(cmdcode) = rolldown1(6, cmdcode gr 0)  ;

and rolldownfar(cmdcode) = rollfar(cmdcode gr 0, false)  ;

and rolldown1(dist, frommainloop) = valof
	[
	if frommainloop & not buggedsomething(true,-1,false, -1) then
		resultis 0;
	resultis scrolldown(dist);
	] // end of rolldown1

and scrolldown(n) = valof
	[
	vcp = rgcpfdispl ! vww;
	unless vcp do resultis postjump(false);
		[
		n = n-backnlines(vww, vcp, n);
		] repeatuntil (vcp eq 0) % (n eq 0);
	resultis postjump(true) ;
	] // end of scrolldown

and rollup(cmdcode) = rollup1(1, cmdcode gr 0) ;

and rollupfast(cmdcode) = rollup1(3, cmdcode gr 0) ;

and rollupfar(cmdcode) = rollfar(cmdcode gr 0, true) ;

and rollup1(dist, frommainloop) = valof
	[
	if frommainloop & not buggedsomething(true,-1,false, -1) then
		resultis 0;
	if vww eq mww then // %%
		[
		if not vwindows then resultis 0
		dist = 1
		if cpc(rgcplast ! (rgdllast ! vww),
			lastparacp(vdoc)-2) gr 0 then resultis 0
		]
	if cpc(rgcplast ! (rgdlfirst ! vww),
		lastparacp(vdoc)-2) gr 0 then resultis 0
	vdl = (rgdlfirst ! vww) + dist-1 ;
	if vdl gr rgdllast ! vww then vdl = rgdllast ! vww ;
	resultis scrollup() ;
	] // end of rollup1

and scrollup() = valof
	[
	if vdl ls 0 then resultis postjump(false);
	vcp = cpmin(1 + rgcplast ! vdl, lastparacp(vdoc)-2)
	resultis postjump(true) ;
	] // end of scrollup


and rollfar(frommainloop, toend) = valof
	[
	// if frommainloop & not buggedsomething(true,-1,false, -1)
		// then resultis 0 ;
	let tdoc = rgdoc ! vwwcurrent ;
	let tcp = toend? lastparacp(vdoc)-1, 0 ;
	cpvisible(vwwcurrent, tcp)
	if toend then
		[
		vww = vwwcurrent ;
		scrolldown(rgmaxdl!vww - rgdlfirst!vww -1) ;
		]
	resultis 0 ;
	]

and flyto(x1, x2) be
	[
	while stillselecting(-1,0,true,-1) do
		test vww eq wwsys
		ifso setbug(sinvert-spage) // inverted
		ifnot setbug(-1) 
	if vww ne wwsys then return
	locatebug()
	let x = xbug
	let tdoc = rgdoc ! vwwcurrent ;
	let teodc = lastparacp(tdoc)-1
	if cpc(teodc, 66) gr 0 then teodc = teodc - 66 // %%
	let tcp = x ls x1? 0, x gr x2? teodc, ratio(teodc, x-x1, x2-x1)
	cpvisible(vwwcurrent, tcp)
	]

and flyaway(cmdcode) = valof
	[
	resetmessage()
	flyto(pagebarxfirst, pagebarxlast) ;
	resultis 0
	]

// SELECT ENTITY :

and select(cmdcode) = designate(cmdcode, selection, caretdes, caretdes)

and thing(cmdcode) = valof
	[
	designate(cmdcode, selection, parades, chardes)
	resultis 0
	]

and mark(cmdcode) = valof
	[
	let ans = designate(cmdcode, selaux, parades, chardes)
	if ans eq -2 then hidemark()
	resultis 0
	]

and designate(cmdcode, sel, lineproc, charproc) = valof
[
newbias(7, 3)
resetmessage()
unless buggedsomething(false,-1,false,-1) do resultis 0 ;
if rgdlfirst ! vww gr rgdllast ! vww then resultis 0 ;
origdl = vdl ;
origww = vww
buggedentity(0)
let proc = inmargin? lineproc, charproc
resultis proc(cmdcode, sel, ybug, false)
]

and caretdes(cmdcode, sel, origy, dummy) = valof
[
let ty = origy
buggedentity(1)
let cpnew = inmargin? cpleft, vcpatx
let xnew = inmargin? xleft, vx
if cpc(cpnew, cpb) gr 0 then
	[
	cpnew = cpb
	xnew = -1
	]
unless pointable(vdoc, cpnew, cpnew-1) do
	[
	cpnew = nearestpointablecp(vdoc, cpnew,
		rgcpfirst ! (rgdlfirst ! vww),
		rgcplast ! (rgdllast ! vww))
	if cpnew eq -1 then resultis 0
	xnew = -1
	]
let origcp = cpnew
let origcpleft = cpleft
let limit = cpmin(cpb, nextunpointablecp(vdoc, cpnew))
showsel1(sel, cpnew, xnew)
	[
	unless stillselecting(ty, sel, false, -1) do break
	buggedentity(1)
	cpnew = (inmargin? cpleft, vcpatx) - 1
//	test inmargin & (ybug gr origy + 8 % cpc(cpleft, origcpleft) gr //0)
//	ifso	test parades(cmdcode, sel, origy, true)
//		ifso showsel1(sel, origcp)
//		ifnot resultis 0
//	ifnot	test cpc(cpnew, mcpfirst) ls 0
	test cpc(cpnew, mcpfirst) ls 0
		ifso showsel1(sel, origcp)
		ifnot	showsel2(sel, cpmin(cpnew, limit-1))
	if inmargin % cpc(cpleft, origcpleft) gr 0 then ty =-1
	] repeat
resultis 0
]

and parades(cmdcode, sel, origy, wascaret) = valof
[
if wascaret then
	[
	relocatebug(origy)
	buggedentity(0)
	]
let origcpleft = cpleft
let cp1 = rgprogram!vdoc? cpleft, cptex
let cp2 = rgprogram!vdoc? cpright, cpe
if rgprogram ! vdoc & cpc(cp2, cpb) ge 0 then resultis wascaret
unless pointable(vdoc, cp1, cp2) do resultis wascaret
let origcp2 = cp2
let limit = nextunpointablecp(vdoc, cp2)
showsel1(sel, cp1, -1, cp2)
	[
	unless stillselecting(-1, sel, false, -1) do break
	buggedentity(0)
	cp1 = rgprogram!vdoc? cpleft, cptex
	cp2 = rgprogram!vdoc? cpright, cpe
	if cpc(cp2, limit) ge 0 then loop
	test wascaret & cpc(cpleft, origcpleft) ls 0
	ifso	resultis true // true if draws back up
	ifnot	test cpc(cp1, mcpfirst+1) ls 0
		ifso showsel2(sel, origcp2)
		ifnot showsel2(sel, cp2)
	] repeat
resultis 0
]

and chardes(cmdcode, sel, origy, dummy) = valof
[
let ty = origy
if inmargin then resultis parades(cmdcode, sel, origy, false)
let cpnew = inmargin? cpleft, vcpatx
if cpc(cpnew+1, cpb) gr 0 then resultis -2
if sel eq selaux & cpc(xbug, xright) gr 0 then resultis -2
unless pointable(vdoc, cpnew, cpnew) do resultis -2
let xnew = vx
let xnew2 = vx+vwidth-1
let origcp = cpnew
let origcpleft = cpleft
let limit = cpmin(cpb, nextunpointablecp(vdoc, cpnew))
showsel1(sel, cpnew, xnew, cpnew, xnew2)
	[
	unless stillselecting(ty, sel, false, -1) do
		[
		if not vwords then break
		let wordmode = false
		let ti, tg = 0, 0
		until elapsed(250, 1, lv ti, lv tg) do
		    if pollmouse() eq mousedecode(cmdcode) then
			[ wordmode = true ; break ]
		unless wordmode do break;
		test worddes(cmdcode, sel, origy, true)
		ifso showsel1(sel, origcp, -1, origcp)
		ifnot resultis 0
		]
	buggedentity(0)
	cpnew = inmargin? cpleft, vcpatx
	xnew = vx
	xnew2 = vx+vwidth-1
	test cpc(cpnew, mcpfirst+1) ls 0
	ifso showsel1(sel, origcp, -1, origcp)
	ifnot	test cpc(cpnew, limit) ls 0
		ifso showsel2(sel, cpnew, xnew2)
		ifnot showsel2(sel, limit-1)
	if cpc(cpleft, origcpleft) gr 0 then ty =-1
	] repeat
resultis 0
]

and worddes(cmdcode, sel, origy, waschar) = valof
[
let ty = origy
if waschar then
	[
	unless buggedsomething(false, origy, false, -1) do resultis true
	buggedentity(0)
	]
if cpc(vcpfirst+1, cpb) gr 0 then resultis waschar
unless pointable(vdoc, vcpfirst, vcplast) do resultis waschar
let origcpfirst = vcpfirst
let origcpleft = cpleft
let limit = cpmin(cpb, nextunpointablecp(vdoc, vcplast))
showsel1(sel, vcpfirst, vxfirst, vcplast, vxlast)
	[
	unless stillselecting(ty, sel, false, -1) do break
	buggedentity(0, origy)
	test waschar & cpc(vcpfirst, origcpfirst) ls 0
	ifso	resultis true
	ifnot	test cpc(vcplast, limit) ls 0
		ifso showsel2(sel, vcplast, vxlast)
		ifnot showsel2(sel, limit-1)
	if cpc(cpleft, origcpleft) gr 0 then ty =-1
	] repeat
resultis 0
]

and buggedentity(between, origy) =  valof
[
vstripe = pollstripe(false);
inmargin = vstripe eq sstripe
cpleft = rgcpfirst ! vdl ;
xleft = rgxfirst ! vdl ;
cpright = rgcplast ! vdl ;
xright = rgxlast ! vdl ;
cpparabounds(vdoc, cpleft, lv cptex, lv cpb, lv cpe)
vbetwixt = between
formatx(vww,vdl,xbug);
vbetwixt = 0
setbug(inmargin? sline, schar)
]

and relocatebug(y) be
	[
	ybug = y
	formaty(ybug)
	vdoc = rgdoc ! vww ;
	]