app hyperpoc enda rem --------------------------------- proc index%:(par$) rem --------------------------------- rem rem Description rem rem index% displays the keywords of all cards of the specified stack. rem The keywords are ordered in alphabetic order. rem You are able to position a cursor to a specific keyword rem (cursor keys or a alpha key) rem and to press ENTER to move to the first card with that keyword. rem Pressing ESC or a hot key will abort index. rem par$ indicates the stack to be used: rem "c" for the current stack rem other for stack selection via dialog box rem rem onIdle rem rem index% is a good example for use of the onIdle routine. rem index% itself controls the users interface and does the rem cursor movements, while onIdle constructs the keyword tree. rem This makes it possible to move the cursor and select items rem from a list even during list construction. The cursor movement rem may at times be a bit slow when the machine is engaged in rem a card with many keywords. rem memory for keywords rem rem We truncate keywords to 20 characters and store a maximum rem of 250 keywords. You may want to change this. rem We use a binary tree to sort and store the keywords. rem nxt%(i%) contains pointers to the left rem nxt%(i%+250) to the right rem bck%(i%) to the back. rem it is possible to use cursor keys and other rem key even when the keyword list is still unfinished. rem --------------------------for change global keyw$(250,20),nxt%(500),bck%(250) rem nearly 7k! global line1$(20),linez$(20),kcurs$(20),wrd$(20) rem -------------------------- global kn%,nkw%,act%,cw%,ch% rem memory for handling visible list global wHand%,strl%,nstr%,cntrl%,scurs%,rspace% rem handles for card global cdHand&,stack$(128) rem local variables local r%,c%,oldStk$(128),oldCd%,a%,inf%(32),mw%,mh% rem set keyword length, keyword number & number of lines on screen rem ---------------------------------for change strl% = 20 rem max stringlength kn% = 250 rem max number of different keywords rem --------------------------------- rem remember current card oldStk$ = curStk$ oldCd% = cuCd% r% = -1 stack$ = curStk$ if par$ <> "c" rem ask stackname with current stack as default stack$ = curStk$ lock on dinit tx$:(173) : rem "Index" dfile stack$,tx$:(129),16 : rem "Stack" r% = dialog lock off endif if r% rem Create window mw% = gwidth : mh% = gheight wHand% = gcreate(0,0,mw%,mh%,0) : rem first create new window ginfo inf%() : rem now get font size (machine independent) ch% = inf%(3) : rem get character height cw% = inf%(6) : rem average character width (0) nstr% = (mh%-8)/ch% rem max number of lines gsetwin (mw%-cw%*(strl%+2))/2,(mh%-ch%*nstr%-8)/2,cw%*(strl%+2),ch%*nstr%+8 gvisible on rem Define error handler onerr err1 rem The keyword scanning is actually implemented as onIdle: routine rem We simply ask for a key press while switching rem animation(1) and music(2) off rem but enabling the onIdle: routine(8) rem we leave help processing to HyperPoc but specify our own help page. cntrl% = 11 helpClue:("keyindex") : rem set Clue to Helppage "Keyindex" linez$ = chr$(255) rem reset clipping value do c% = getKey%:(cntrl%) if c% = 512 rem list is finished busy off cntrl% = 3 rem disable onIdle elseif c% = 256 rem cursor up btfind:(kcurs$) if btnavi%:(1,kn%,0) = 0 : continue : endif kcurs$ = keyw$(act%) drawcur: if scurs% = 1 gscroll 0,ch%,3,3,gwidth-6,gheight-ch%-6 gat 3+cw%,3+ch% gprint kcurs$ else scurs% = scurs%-1 endif drawcur: elseif c% = 257 rem cursor down btfind:(kcurs$) if btnavi%:(1,0,kn%) = 0 : continue : endif kcurs$ = keyw$(act%) drawcur: if scurs% = nstr% gscroll 0,-ch%,3,3+ch%,gwidth-6,gheight-ch%-6 gat 3+cw%,3+ch%*nstr% gprint kcurs$ else scurs% = scurs%+1 endif drawcur: elseif c% = 260 rem page up btfind:(kcurs$) a% = btnavi%:(nstr%-1,kn%,0) kcurs$ = keyw$(act%) if scurs%-a% >= 1 drawcur: scurs% = scurs%-a% drawcur: else drwblc: endif elseif c% = 261 rem page down btfind:(kcurs$) a% = btnavi%:(nstr%-1,0,kn%) kcurs$ = keyw$(act%) if scurs%+a% <= nstr% drawcur: scurs% = scurs%+a% drawcur: else drwblc: endif elseif c% < 256 and c% > 32 rem character line1$ = lower$(chr$(c%)) kcurs$ = line1$ btfind:(line1$) drwblc: endif until c% = 13 or c% = 27 or ( c% > 512 and c% < 1024) or c% = 1028 if c% = 13 cdHand& = 0 rem reset handle for new search rem we search for cursor value in tree rem and use the next greater/equal string as keyword to find card. btfind:(kcurs$) r% = findCd%:(stack$,2,keyw$(act%)+"*",addr(cdHand&)) rem we show card if r% : showCd%:(stack$,r%) : endif endif bye:: busy off gclose wHand% rem close window return c% rem Error handler err1:: rem Remember error code and bye bye onerr off c% = err goto bye endif endp rem onIdle: searchs for the next card and displays it. rem The routine is called continously. When no more rem cards are found, onIdle returns the code 512 rem which is then returned via getKey%:. proc onIdle: local cNum%,obj%,i%,k%,n%,redr%,p% busy tx$:(176) : rem "Scanning" cNum% = findCd%:(stack$,1,"",addr(cdHand&)) rem when no more card found, return code 512 to caller if cNum% = 0 warning:(tx$:(175),0) : rem "Index finished" return 512 endif rem search for keywords (mask value 2**10) obj% = CdObj%:(stack$,addr(cdHand&),&00000400) if obj% i% = 1 while nkw% <= kn% rem extract keywords from comma separated list wrd$ = lower$(left$(extract$:(ObjTxt$,i%),strl%)) if len(wrd$) = 0 : break : endif i% = i%+1 if nkw% rem sort keyword into tree k% = 1 while 1 if wrd$ = keyw$(k%) : break : endif if wrd$ > keyw$(k%) n% = k%+kn% else n% = k% endif if nxt%(n%) k% = nxt%(n%) else if nkw% = kn% warning:(err$(-6),2) : rem "Overflow" return 512 endif nkw% = nkw%+1 nxt%(n%) = nkw% keyw$(nkw%) = wrd$ bck%(nkw%) = k% rem check if new keyword sorts into the visible area and before cursor if wrd$ > line1$ and wrd$ < linez$ if wrd$ < kcurs$ rspace% = rspace%+1 endif redr% = -1 endif break endif endwh else nkw% = 1 keyw$(1) = wrd$ redr% = -1 endif endwh rem if necessary redraw screen if redr% redr% = 0 btfind:(line1$) rem pos to line 1 if rspace% > 0 rem scroll backwards to keep cursor on screen btnavi%:(rspace%,0,kn%) line1$ = keyw$(act%) endif drwblc: rem redraw screen endif endif endp rem this routine redraws all lines in the window proc drwblc: local j%,done% gcls gborder 1 gat 3+cw%,3 while j% < nstr% j% = j%+1 if keyw$(act%) >= kcurs$ and done% = 0 done% = 1 scurs% = j% drawcur: rem set cursor endif gat 3+cw%,j%*ch%+3 gprint keyw$(act%) if j% < nstr% if btnavi%:(1,0,kn%) = 0 : break : endif endif endwh linez$ = keyw$(act%) rem clipping end value rspace% = j% - nstr% rem space at end of list endp rem position to smallest keyword >= s$ proc btfind:(s$) local n% act% = 1 while s$ <> keyw$(act%) if s$ < keyw$(act%) n% = nxt%(act%) else n% = nxt%(act%+kn%) endif if n% = 0 : break : endif act% = n% endwh endp rem move n% items to left (left%=kn%) or right (right%=kn%) proc btnavi%:(n%,left%,right%) local b%,state%,cnt%,tc% state% = 1 : cnt% = n% : tc% = act% while cnt% if state% = 0 and nxt%(tc%+left%) tc% = nxt%(tc%+left%) if nxt%(tc%+left%) = 0 cnt% = cnt%-1 act% = tc% state% = 1 endif elseif state% < 2 and nxt%(tc%+right%) tc%= nxt%(tc%+right%) state% = 0 if nxt%(tc%+left%) = 0 cnt% = cnt%-1 act% = tc% endif elseif bck%(tc%) b% = bck%(tc%) rem backw if nxt%(b%+left%) = tc% cnt%=cnt%-1 act% = b% state% = 1 rem coming from left else state% = 2 rem coming from right endif tc% = b% else break endif endwh return n%-cnt% : rem report about actual movement in list endp proc drawcur: gtmode 2 gat 3,scurs%*ch%+3 gprint chr$(28) endp rem edParm$: supports the editing process for index objects. proc edParm$:(parm$) local p% if parm$ = "c" p% = 1 else p% = 2 endif dinit tx$:(174) : rem "Index for" dchoice p%,tx$:(129),tx$:(168) : rem "stack" "current,as selected" dialog if p% = 1 return "c" endif endp