// Poll module GPOLL.SR
get "BRAVO.DF"
get "CHAR.DF"
get "GINN.DF"
// Incoming procedures
external
[
invalidatedisplay
readfile1
setsel
updatedisplay
invertcaret
swat
docalloc
createdocm
splitwindow
invalidatewindow
getvch
errhlt
marks
newbias
formatx
formaty
specstate
nextspecstate
cppara
locatebug
getchar
endofkeystream
overlay
setmenu
opensomeoverlay
cpc
ugt
setmessage
trycompact
filldisplay
]
// Incoming statics
external [
selection
rgdoc
cominstream
vdlhint
rgyfirst
rgcpfdispl
cpvisible
voldkeys
rgmaccp
vcp
vdoc
vchremain
rgpara
vcpatx
vww
vdl
xbug
ybug
vlook
routine
module
vwwcurrent
];
// Outgoing procedures
external [
bravocom
pollinput
pollstripe
pollmouse
pollkeyset
pollkeyboard
mousedecode
stripedecode
elapsed
];
// Outgoing statics
external
[
vstripe
comt
midkeyset
badkeyset
scrolltimer
scrolltoggle
vkeys
vwindows
vwindowstripe // %%
vmark
vcutpaste
vjumpbar
vblackout
vmscroll
vthing
vwords
vplacekeys
vcoright
novice
vpause
attoplevel // %%
]
// Local statics
static
[
vstripe
comt
midkeyset
badkeyset
scrolltimer
scrolltoggle
vkeys
vwindows
vwindowstripe // %%
vmark
vcutpaste
vjumpbar
vblackout
vmscroll
vthing
vwords
vplacekeys
vcoright
novice
vpause
attoplevel // %%
]
structure BUTTONS:
[
blank bit 8 ;
keyset bit 5 ;
mouse bit 3 ;
];
let bravocom() be
[
let tchar = pollinput() ;
[
let sig = comt ! tchar ;
let whichmodule = module ! sig ;
test whichmodule eq nomodule
ifso tchar = pollinput(tchar)
ifnot [
marks(false) ;
overlay(whichmodule) ;
attoplevel = false ; // %%
tchar = (routine ! sig)(tchar) ;
attoplevel = true ; // %%
if tchar ls 0 then break;
updatedisplay();
setmenu();
marks(true)
newbias(7, 3)
]
] repeat ;
] // end of bravocom
and pollinput(tchar) = valof
[
let timer = nil;
let toggle = 0;
let filled = false
[
tchar = pollkeyboard() ;
if tchar ne skeyboard then break ;
tchar = pollstripe(true) ;
if tchar ne vstripe then break;
tchar = pollmouse() ;
if tchar ne smouse then
[
tchar = tchar + (vstripe-sstripe) lshift 3 ;
break;
];
tchar = pollkeyset() ;
if tchar ne skeyset then break ;
// Background tasks, in priority order.
// After each task: "loop".
if setmenu() then loop ;
if elapsed(2000-800*toggle,2,lv timer,lv toggle) then
[
invertcaret(selection);
loop
]
if opensomeoverlay() then loop
if trycompact() then loop
unless filled do if filldisplay() then
[
filled = true
loop
]
if ugt(rgmaccp ! (rgdoc ! vwwcurrent), #160000) then
[
setmessage(" Document close to maximum size - File it and start new Folder")
loop
]
] repeat ;
filled = false
if toggle eq 2 then invertcaret(selection) ;
resultis tchar;
] // end pollinput
and pollstripe(testmenu) = valof
[
locatebug()
let tstripe = ybug ls ytstripe? sstripefly,
xbug ls xlstripe? sstripeline,
vwindowstripe & xbug gr xrstripe? sstripewindow, // %%
sstripenone ;
if testmenu & tstripe eq sstripenone then
[
formaty(ybug)
formatx(vww,vdl,xbug);
vdoc = rgdoc ! vww
if cpc(vcpatx, rgmaccp ! vdoc) ge 0 then errhlt("ATX")
specstate(vdoc, vcpatx, cppara(vdoc, vcpatx))
nextspecstate()
if (vlook & mmenu) ne 0 then tstripe = sstripemenu
]
resultis (tstripe-sstripeline) + sstripe ;
] // end pollstripe
and pollmouse() = valof
[
resultis smouse +
table[ 7; 5; 6; 4; 3; 1; 2; 0 ] ! (bug >> BUTTONS.mouse) ;
] // end pollmouse
and keystate() = 31 - (bug >> BUTTONS.keyset)
and pollkeyset() = valof
[
let tkeys,tsave,i=nil,nil,nil ;
tkeys = keystate() ;
test vkeys
ifso [
tsave = vkeys ;
vkeys = 0;
]
ifnot [
tsave = tkeys;
scrolltoggle = 0;
];
if tkeys then
[
switchon comt!(skeyset+tkeys) into
[
case srollup:
case srollupfast:
case srolldown:
case srolldownfast:
[
if tsave eq badkeyset then
tsave = keystate() repeatuntil
tsave ne tkeys %
elapsed(vpause,1,lv scrolltimer,
lv scrolltoggle)
vkeys = tsave? badkeyset, 0;
if tsave eq tkeys then break ;
endcase
];
case srollover:
tsave = midkeyset;
default: endcase
];
tkeys = 0 ;
for i = 1 to 10 do
tkeys = tkeys % keystate() ;
if not tkeys then break ;
tsave=tsave%tkeys ;
] repeat ;
resultis skeyset+tsave;
] // end pollkeyset
and pollkeyboard()=valof
[
if endofkeystream() then resultis 0
resultis skeyboard + getchar()
] // end of pollkeyboard
and mousedecode(cmdcode) = smouse + (cmdcode&7)
and stripedecode(cmdcode) = (cmdcode-smouse) rshift 3
and elapsed(millisecs, nstates, ptimer, ptoggle) = valof
[
test @ptoggle eq 0
ifso [
@ptimer = @#430;
@ptoggle = 1;
];
ifnot [
let t = millisecs/40;
if @#430 - @ptimer ge t then
[
@ptimer = @#430;
@ptoggle = @ptoggle + 1 ;
if @ptoggle gr nstates then
@ptoggle = 1 ;
resultis @ptoggle ;
];
];
resultis 0 ;
] // end of elapsed