home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / MISC / HYPOC / INDEX.OPL < prev    next >
Encoding:
Text File  |  1994-08-24  |  13.6 KB  |  356 lines
  1. app hyperpoc
  2. enda
  3. rem ---------------------------------
  4. proc index%:(par$)
  5. rem ---------------------------------
  6. rem
  7. rem Description
  8. rem
  9. rem  index% displays the keywords of all cards of the specified stack.
  10. rem  The keywords are ordered in alphabetic order.
  11. rem  You are able to position a cursor to a specific keyword
  12. rem  (cursor keys or a alpha key)
  13. rem  and to press ENTER to move to the first card with that keyword.
  14. rem  Pressing ESC or a hot key will abort index.
  15. rem  par$ indicates the stack to be used:
  16. rem    "c" for the current stack
  17. rem    other for stack selection via dialog box
  18. rem
  19. rem onIdle
  20. rem
  21. rem index% is a good example for use of the onIdle routine.
  22. rem index% itself controls the users interface and does the
  23. rem cursor movements, while onIdle constructs the keyword tree.
  24. rem This makes it possible to move the cursor and select items
  25. rem from a list even during list construction. The cursor movement
  26. rem may at times be a bit slow when the machine is engaged in
  27. rem a card with many keywords.
  28.  
  29. rem memory for keywords
  30. rem
  31. rem We truncate keywords to 20 characters and store a maximum
  32. rem of 250 keywords. You may want to change this.
  33. rem We use a binary tree to sort and store the keywords.
  34. rem nxt%(i%) contains pointers to the left
  35. rem nxt%(i%+250) to the right
  36. rem bck%(i%) to the back.
  37.  
  38. rem it is possible to use cursor keys and other 
  39. rem key even when the keyword list is still unfinished.
  40.  
  41. rem --------------------------for change
  42. global keyw$(250,20),nxt%(500),bck%(250)  rem nearly 7k!
  43. global line1$(20),linez$(20),kcurs$(20),wrd$(20)
  44. rem --------------------------
  45.  
  46. global kn%,nkw%,act%,cw%,ch%
  47.  
  48. rem memory for handling visible list
  49. global wHand%,strl%,nstr%,cntrl%,scurs%,rspace%
  50.  
  51. rem handles for card
  52. global cdHand&,stack$(128)
  53.  
  54. rem local variables
  55. local r%,c%,oldStk$(128),oldCd%,a%,inf%(32),mw%,mh%
  56.  
  57. rem set keyword length, keyword number & number of lines on screen
  58.  
  59. rem ---------------------------------for change
  60.         strl% = 20      rem max stringlength
  61.         kn% = 250       rem max number of different keywords
  62. rem ---------------------------------
  63.  
  64. rem remember current card
  65.         oldStk$ = curStk$
  66.         oldCd% = cuCd%
  67.         r% = -1
  68.         stack$ = curStk$
  69.         if par$ <> "c"
  70. rem ask stackname with current stack as default
  71.                 stack$ = curStk$
  72.                 lock on
  73.                 dinit tx$:(173) : rem "Index"
  74.                 dfile stack$,tx$:(129),16 : rem "Stack"
  75.                 r% = dialog
  76.                 lock off
  77.         endif
  78.         if r%
  79. rem     Create window
  80.                 mw% = gwidth : mh% = gheight
  81.                 wHand% = gcreate(0,0,mw%,mh%,0) : rem first create new window
  82.                 ginfo inf%()  : rem now get font size (machine independent)
  83.                 ch% = inf%(3) : rem get character height
  84.                 cw% = inf%(6) : rem average character width (0)
  85.                 nstr% = (mh%-8)/ch%   rem max number of lines
  86.                 gsetwin (mw%-cw%*(strl%+2))/2,(mh%-ch%*nstr%-8)/2,cw%*(strl%+2),ch%*nstr%+8
  87.                 gvisible on
  88. rem     Define error handler
  89.                 onerr err1
  90. rem     The keyword scanning is actually implemented as onIdle: routine
  91. rem     We simply ask for a key press while switching
  92. rem     animation(1) and music(2) off
  93. rem     but enabling the onIdle: routine(8)
  94. rem     we leave help processing to HyperPoc but specify our own help page.
  95.                 cntrl% = 11
  96.                 helpClue:("keyindex") : rem set Clue to Helppage "Keyindex"
  97.                 linez$ = chr$(255)      rem reset clipping value
  98.                 do
  99.                         c% = getKey%:(cntrl%)
  100.                         if c% = 512     rem list is finished
  101.                                 busy off
  102.                                 cntrl% = 3 rem disable onIdle
  103.                         elseif c% = 256 rem cursor up
  104.                                 btfind:(kcurs$)
  105.                                 if btnavi%:(1,kn%,0) = 0 : continue : endif
  106.                                 kcurs$ = keyw$(act%)
  107.                                 drawcur:
  108.                                 if scurs% = 1
  109.                                         gscroll 0,ch%,3,3,gwidth-6,gheight-ch%-6
  110.                                         gat 3+cw%,3+ch%
  111.                                         gprint kcurs$
  112.                                 else
  113.                                         scurs% = scurs%-1
  114.                                 endif
  115.                                 drawcur:
  116.                         elseif c% = 257 rem cursor down
  117.                                 btfind:(kcurs$)
  118.                                 if btnavi%:(1,0,kn%) = 0 : continue : endif
  119.                                 kcurs$ = keyw$(act%)
  120.                                 drawcur:
  121.                                 if scurs% = nstr%
  122.                                         gscroll 0,-ch%,3,3+ch%,gwidth-6,gheight-ch%-6
  123.                                         gat 3+cw%,3+ch%*nstr%
  124.                                         gprint kcurs$
  125.                                 else
  126.                                         scurs% = scurs%+1
  127.                                 endif
  128.                                 drawcur:
  129.                         elseif c% = 260 rem page up
  130.                                 btfind:(kcurs$)
  131.                                 a% = btnavi%:(nstr%-1,kn%,0)
  132.                                 kcurs$ = keyw$(act%)
  133.                                 if scurs%-a% >= 1
  134.                                         drawcur:
  135.                                         scurs% = scurs%-a%
  136.                                         drawcur:
  137.                                 else
  138.                                         drwblc:
  139.                                 endif
  140.                         elseif c% = 261 rem page down
  141.                                 btfind:(kcurs$)
  142.                                 a% = btnavi%:(nstr%-1,0,kn%)
  143.                                 kcurs$ = keyw$(act%)
  144.                                 if scurs%+a% <= nstr%
  145.                                         drawcur:
  146.                                         scurs% = scurs%+a%
  147.                                         drawcur:
  148.                                 else
  149.                                         drwblc:
  150.                                 endif
  151.                         elseif c% < 256 and c% > 32  rem character
  152.                                 line1$ = lower$(chr$(c%))
  153.                                 kcurs$ = line1$
  154.                                 btfind:(line1$)
  155.                                 drwblc:
  156.                         endif
  157.                 until c% = 13 or c% = 27 or ( c% > 512 and c% < 1024) or c% = 1028
  158.                 if c% = 13
  159.                         cdHand& = 0 rem reset handle for new search
  160. rem we search for cursor value in tree
  161. rem and use the next greater/equal string as keyword to find card.
  162.                         btfind:(kcurs$)
  163.                         r% = findCd%:(stack$,2,keyw$(act%)+"*",addr(cdHand&))
  164. rem we show card 
  165.                         if r% : showCd%:(stack$,r%) : endif
  166.                 endif
  167. bye::
  168.                 busy off
  169.                 gclose wHand%   rem close window
  170.                 return c%
  171. rem     Error handler
  172. err1::
  173. rem     Remember error code and bye bye
  174.                 onerr off
  175.                 c% = err
  176.                 goto bye
  177.         endif
  178. endp
  179.  
  180. rem onIdle: searchs for the next card and displays it.
  181. rem The routine is called continously. When no more
  182. rem cards are found, onIdle returns the code 512
  183. rem which is then returned via getKey%:.
  184.  
  185.  
  186. proc onIdle:
  187. local cNum%,obj%,i%,k%,n%,redr%,p%
  188.         busy tx$:(176) : rem "Scanning"
  189.         cNum% = findCd%:(stack$,1,"",addr(cdHand&))
  190. rem when no more card found, return code 512 to caller
  191.         if cNum% = 0
  192.                 warning:(tx$:(175),0) : rem "Index finished"
  193.                 return 512
  194.         endif
  195. rem search for keywords (mask value 2**10)
  196.         obj% = CdObj%:(stack$,addr(cdHand&),&00000400)
  197.         if obj%
  198.                 i% = 1
  199.                 while nkw% <= kn%
  200. rem extract keywords from comma separated list
  201.                         wrd$ = lower$(left$(extract$:(ObjTxt$,i%),strl%))
  202.                         if len(wrd$) = 0 : break : endif
  203.                         i% = i%+1
  204.                         if nkw%
  205. rem sort keyword into tree
  206.                                 k% = 1
  207.                                 while 1
  208.                                         if wrd$ = keyw$(k%) : break : endif
  209.                                         if wrd$ > keyw$(k%)
  210.                                                 n% = k%+kn%
  211.                                         else
  212.                                                 n% = k%
  213.                                         endif
  214.                                         if nxt%(n%)
  215.                                                 k% = nxt%(n%)
  216.                                         else
  217.                                                 if nkw% = kn%
  218.                                                         warning:(err$(-6),2) : rem "Overflow"
  219.                                                         return 512
  220.                                                 endif
  221.                                                 nkw% = nkw%+1
  222.                                                 nxt%(n%) = nkw%
  223.                                                 keyw$(nkw%) = wrd$
  224.                                                 bck%(nkw%) = k%
  225. rem check if new keyword sorts into the visible area and before cursor
  226.                                                 if wrd$ > line1$ and wrd$ < linez$
  227.                                                         if wrd$ < kcurs$
  228.                                                                 rspace% = rspace%+1
  229.                                                         endif
  230.                                                         redr% = -1
  231.                                                 endif
  232.                                                 break
  233.                                         endif
  234.                                 endwh
  235.                         else
  236.                                 nkw% = 1
  237.                                 keyw$(1) = wrd$
  238.                                 redr% = -1
  239.                         endif
  240.                 endwh
  241. rem if necessary redraw screen
  242.                 if redr%
  243.                         redr% = 0
  244.                         btfind:(line1$) rem pos to line 1
  245.                         if rspace% > 0
  246. rem scroll backwards to keep cursor on screen
  247.                                 btnavi%:(rspace%,0,kn%)
  248.                                 line1$ = keyw$(act%)
  249.                         endif
  250.                         drwblc: rem redraw screen
  251.                 endif
  252.         endif
  253. endp
  254.  
  255. rem this routine redraws all lines in the window
  256.  
  257. proc drwblc:
  258. local j%,done%
  259.         gcls
  260.         gborder 1
  261.         gat 3+cw%,3
  262.         while j% < nstr%
  263.                 j% = j%+1
  264.                 if keyw$(act%) >= kcurs$ and done% = 0
  265.                         done% = 1
  266.                         scurs% = j%
  267.                         drawcur:        rem set cursor
  268.                 endif
  269.                 gat 3+cw%,j%*ch%+3
  270.                 gprint keyw$(act%)
  271.                 if j% < nstr% 
  272.                         if btnavi%:(1,0,kn%) = 0 : break : endif
  273.                 endif
  274.         endwh
  275.         linez$ = keyw$(act%)    rem clipping end value
  276.         rspace% = j% - nstr%    rem space at end of list
  277. endp
  278.  
  279.  
  280. rem position to smallest keyword >= s$
  281.  
  282. proc btfind:(s$)
  283. local n%
  284.         act% = 1
  285.         while s$ <> keyw$(act%)
  286.                 if s$ < keyw$(act%)
  287.                         n% = nxt%(act%)
  288.                 else
  289.                         n% = nxt%(act%+kn%)
  290.                 endif
  291.                 if n% = 0 : break : endif
  292.                 act% = n%
  293.         endwh
  294. endp
  295.  
  296. rem move n% items to left (left%=kn%) or right (right%=kn%)
  297.  
  298. proc btnavi%:(n%,left%,right%)
  299. local b%,state%,cnt%,tc%
  300.         state% = 1 : cnt% = n% : tc% = act%
  301.         while cnt%
  302.                 if state% = 0 and nxt%(tc%+left%)
  303.                         tc% = nxt%(tc%+left%)
  304.                         if nxt%(tc%+left%) = 0
  305.                             cnt% = cnt%-1
  306.                             act% = tc%
  307.                             state% = 1
  308.                         endif
  309.                 elseif state% < 2 and nxt%(tc%+right%)
  310.                         tc%= nxt%(tc%+right%)
  311.                         state% = 0
  312.                         if nxt%(tc%+left%) = 0
  313.                             cnt% = cnt%-1
  314.                             act% = tc%
  315.                         endif
  316.                 elseif bck%(tc%)
  317.                         b% = bck%(tc%)         rem backw
  318.                         if nxt%(b%+left%) = tc%
  319.                                 cnt%=cnt%-1
  320.                                 act% = b%
  321.                                 state% = 1      rem coming from left
  322.                         else
  323.                                 state% = 2      rem coming from right
  324.                         endif
  325.                         tc% = b%
  326.                 else
  327.                         break
  328.                 endif
  329.         endwh
  330.         return n%-cnt% : rem report about actual movement in list
  331. endp
  332.  
  333. proc drawcur:
  334.         gtmode 2
  335.         gat 3,scurs%*ch%+3
  336.         gprint chr$(28)
  337. endp
  338.  
  339. rem edParm$: supports the editing process for index objects.
  340.  
  341. proc edParm$:(parm$)
  342. local p%
  343.         if parm$ = "c"
  344.                 p% = 1
  345.         else
  346.                 p% = 2
  347.         endif
  348.         dinit tx$:(174) : rem "Index for"
  349.         dchoice p%,tx$:(129),tx$:(168) : rem "stack" "current,as selected"
  350.         dialog
  351.         if p% = 1
  352.                 return "c"
  353.         endif
  354. endp
  355.  
  356.