// GMENU.SR

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

// Incoming Procedures

external [
	qwritecass
	qfile
	setbug
	stillselecting
	pollstripe
	mousedecode
	readsel
	stsize
	stequal
	overlay
	swat
	stput
	stget
	setlf
	updatedisplay
	getvch
	setformata
	putvch
	insertb
	setpcsiz
	selectsel
	hidemark
	freedl
	copydnww
	bubblingww
	createdisplay
	invalidatewindow
	errhlt
	stripeline
	stripewindow
	stripenone
	stripefly
	stripemenu
	pollmouse
	qdprint
	];

// Incoming Statics

external [
	vdpon
	vcassstop
	vcasson
	vdoc
	vcpfirst
	vstripe
	vcplast
	rgmenu
	module
	routine
	selection
	selaux
	rgdoc
	vwwcurrent
	ddoc
	rgsfile
	rgsdoc
	sdoc
	rgdirty
	vdpstop
	vmenumessage
	mdoc
	nmenuitems
	menumessage
	vcp
	vchremain
	vinsertk
	vcpput
	cpscrt
	vpc
	rgylast
	rghpused
	rgdlfirst
	rgdllast
	pbmfirstfree
	macww
	vdpspacing
	rgview
	vdpheadings
	rgcpfdispl
	vdppagenums
	vdprepaginate
	comt
	mpdldcb // %%
	];

// Outgoing Procedures

external [
	cassette
	casswrite
	print
	start
	stop
	insertstring
	setmessage
	resetmessage
	setmenu
	getdoc
	confirm
	dirflip
	makemenuitems
	bugmenu
	];

// Outgoing Statics

external
	[
	messagereset
	vturning
	rgdirpage
	]

// Local Statics

static	[
	messagereset
	vturning
	rgdirpage
	]

// Manifests

manifest	[
	msgsize  = 70
	]

// Structures

structure DCB: // %%
	[
	next	word;
	mode	bit 1;
	bw	bit 1;
	htab	bit 6;
	nwrds	bit 8;
	sa	word;
	slc	word;
	];

let bugmenu(cmdcode) = valof
	[
	let still = true
	let tdoc = vdoc
	let tcpfirst = vcpfirst
	resetmessage()
	setbug(sinvert-smenu)
	while stillselecting(-1,0,true,-1) do
		[
		vstripe = pollstripe(true)
		still = vstripe-sstripe eq sstripemenu-sstripeline &
			vcpfirst eq tcpfirst & vdoc eq tdoc
		setbug(still? sinvert-smenu, -1)
		]
	unless still do resultis 0
	vdoc = tdoc
	resultis menuitem(mousedecode(cmdcode)-smouse)? 0, -1
	]

and menuitem(mousebutton) = valof
[
let string = vec sbfnaml
readsel(string,vdoc,vcpfirst,vcplast,(sbfnaml lshift 1)-1);
for i = 0 to maxmitems-1 do
	if stequal(string,rgmenu!i) then
		[
		overlay(module ! (maxsig+i))
		resultis (routine ! (maxsig+i))(vcpfirst,
			selecton mousebutton into
				[
			case 2: selection;
			case 1: selaux;
			default: 0
				]
			);
		]
]

and setmessage(string) be
[
let ving = vec (msgsize+3)/2
let len = stsize(string)
if len gr msgsize then swat()
let t = (msgsize-len) rshift 1
ving >> lh = t+len+1 ;
for i = 0 to t do stput(ving, i, chsp)
for i = 1 to len do stput(ving, t+i, stget(string, i))
setlf(lfsys,idbanner2,ving)
updatedisplay()
mpdldcb ! 0 >> DCB.bw = 1 ; // %%
messagereset = false
]

and resetmessage() be
[
unless messagereset do
	[
	setlf(lfsys, idbanner2, "  ")
	updatedisplay()
	mpdldcb ! 0 >> DCB.bw = 0 ; // %%
	messagereset = true
	]
]

and setmenu() = valof
[
let tdoc = rgdoc ! vwwcurrent;
if rgdirty ! tdoc then
	[
	vdpon = false
	vcasson = false
	]
let tmenumessage =
	tdoc eq ddoc?
		rgcpfdispl!vwwcurrent?	// %%
			rgsfile!(rgsdoc!vwwcurrent)? mmdir,
			mmnodoc,
		rgsfile!(rgsdoc!vwwcurrent)? mmdirnocab,	// %%
		mmnodocnocab,	// %%
	tdoc eq sdoc? mmnull,
	rgdirty ! tdoc? mmdirty,
	vdpon?	vdpstop? mmprint,
		mmstop,
	vcasson? vcassstop? mmcassette,
		mmstop,
	mmclean;
if tmenumessage ne vmenumessage then
	[
	unmakemenuitems(mdoc, 0, nmenuitems ! vmenumessage) // $$
	vmenumessage = tmenumessage ;
	setlf(lfmenu, idmenu1, menumessage ! vmenumessage) ;
	makemenuitems(mdoc, 0, nmenuitems ! vmenumessage) ;
	updatedisplay()
	resultis true
	]
resultis false
]

and makemenuitems(doc, cp, nitems) be
[
unmakemenuitems(doc, cp, nitems) // $$
vcp = cp
vchremain = 0
for i = 1 to nitems do
	[
	until isletter(getvch(), false) do loop
	let cp1 = vcp-1
	while isletter(getvch(), true) do loop
	let cp2 = vcp-2
	setformata(doc, cp1, cp2, $m, $i)
	]
]

// $$[

and unmakemenuitems(doc, cp, nitems) be
[
vdoc = doc
vcp = cp
vchremain = 0
while getvch() eq $*T do loop ; // %%
while getvch() ne $*T do loop ;
setformata(doc, cp, vcp-1, $M, $I, $B) ;
]

// $$]

and isletter(char, evenlower) =
    ($A le char & char le $Z) % (evenlower & $a le char & char le $z)

and insertstring(doc,cp,string) be
[
if vinsertk then errhlt("INK")
let ppcd = vec 2;
let vpa=nil
let stringl=stsize(string)
unless stringl do return // ** LT fix !!! important !!!
vcpput = cpscrt;
for i = 0 to stringl-1 do
	putvch(stget(string,i))
vpa << VPA.fn = fnscr;
vpa << VPA.fp = cpscrt << PCD.p;
ppcd >> PCD.vpaddr = vpa;
ppcd >> PCD.rc = cpscrt << PCD.rc;
ppcd >> PCD.live = 0;
insertb(doc,cp,ppcd,stringl);
cpscrt=cpscrt+stringl
setpcsiz(doc,vpc,stringl)
]

and dirflip(tww) = valof
[
let tdoc,watchout=nil,nil // LT watchout
tdoc=rgdoc!tww
if tdoc eq sdoc then resultis 1;
test tdoc eq ddoc
ifso watchout = getdoc(tww,rgsdoc!tww)
ifnot getdoc(unifydoc(tww,tdoc),ddoc)
if watchout then selectsel(selection, tww, 0)
if selaux>>SEL.doc ne sdoc then hidemark() ;
resultis 1
]

and unifydoc(www, doc) = valof
	[
	let crd = false ;
	let ww = www
	rgsdoc ! ww = doc
	while rgdoc ! (ww-1) eq doc do ww = ww-1
	www = ww
	while rgdoc ! (ww+1) eq doc do
		[
		let w = ww + 1 ;
		rgylast ! (w-1) = rgylast ! w;
		rghpused ! w = 0;
		for dl = rgdlfirst ! w to rgdllast ! w do
			[
			pbmfirstfree = 1; freedl(dl);
			];
		for tw = w to macww-2 do
			copydnww(tw,tw+1);
		bubblingww(w, -1)
		macww = macww-1;
		crd = true ;
		]
	if crd then createdisplay()
	resultis www
	]

and getdoc(www,doc) = valof
[
let watchout = selection >> SEL.doc eq rgdoc ! www ;
if doc ne ddoc then rgdirpage ! www = rgcpfdispl ! www
for ww=1 to macww-2 do
    if rgsdoc!ww eq rgsdoc!www then
	[
	rgdoc ! ww = doc
	rgcpfdispl ! ww = 0
	invalidatewindow(ww)
	];
rgview ! doc = 0
if doc eq ddoc then
	[
	vturning = true
	rgcpfdispl ! www = rgdirpage ! www
	]
resultis watchout
]

and print(char, sel) = valof
[
vdpstop = true
vdpon = true
vdpspacing = 1
vdpheadings = false
vdppagenums = false
vdprepaginate = false
setmenu()
setmessage(" First bug desired options, then bug Start")
resultis 1
]

and start(char,sel) = valof
[
overlay(devicemodule)
test vdpon
ifso	qdprint(vdpspacing, vdpheadings, vdppagenums, vdprepaginate)
ifnot	if vcasson then qwritecass()
if vdprepaginate then
	[
	overlay(dirtymodule)
	let tchar,tsel = nil,nil
	qfile(tchar,tsel)
	vdprepaginate = false
	]
resultis 1
]

and stop(char, sel) = valof
[
vdpstop = true
vdpon = false
vcassstop = true
vcasson = false
resultis 1
]

and cassette(char, sel) = valof
[
vcassstop = true
vcasson = true
setmenu()
setmessage(" First mount cassette, then bug Start")
resultis 1
]

and casswrite(char, sel) = valof
[
overlay(devicemodule)
qwritecass()
resultis 1
]

and confirm(dummy) = true