home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / MISC / SCBANK / SRC / SYS$SCH.OPL < prev    next >
Encoding:
Text File  |  1994-12-21  |  8.0 KB  |  337 lines
  1. rem on escape return to chosen menu item, not just first
  2. proc mainhelp:
  3.     local hfile$(128)
  4.     hfile$="\opd\*.hlp"
  5.     dinit
  6.     dfile hfile$,"Help file:",16
  7.     if dialog
  8.         schelp%:(hfile$)
  9.     endif
  10. endp
  11.  
  12. proc getinfo:(here%)
  13.     position here%
  14.     tpos%=here%
  15.     items%=D.n%
  16. rem info:(tpos%,items%)
  17. endp
  18.  
  19. proc info:(a%,b%)
  20. alert(num$(a%,10),num$(b%,10))
  21. endp
  22.  
  23. proc biggest%: rem find size of largest record
  24.     local i%,big%
  25.     position tpos%
  26.     gstyle 1
  27.     big%=gtwidth("Help:"+D.text$)
  28.     i%=0
  29.     do
  30.         position tpos%+i%
  31.         if (D.n%<>-1)
  32.             gstyle 1
  33.         else
  34.             gstyle 0
  35.         endif
  36.         big%=max(gtwidth(D.text$),big%)
  37.         i%=i%+1
  38.     until (i%>items%)
  39.     return (big%+32)
  40. endp
  41.  
  42. proc sizehelp: rem determine size of main window
  43.     local info%(32),tamm$(10),w%,h%
  44.     w%=biggest%:
  45.     helpnx%=(scwidth%-w%)/2
  46.     helpmx%=w%
  47.     ginfo info%()
  48.     linehi%=info%(3)+2 rem how high is this font
  49.     lined%=info%(4)+2 rem font descent
  50.     linea%=info%(5)+1 rem font ascent
  51.     helpmy%=schight%-20
  52.     helplen%=(helpmy%-(linehi%+10))/linehi%
  53.     helplen%=min(items%,helplen%) rem no biggerthan we need
  54.     helpmy%=helplen%*linehi%+linehi%+10+6 rem make sue we don't have any left over
  55.     helpny%=(schight%-helpmy%)/2
  56.     gsetwin helpnx%,helpny%,helpmx%,helpmy%
  57.     dohelp:("Help")
  58. endp
  59.  
  60. proc select:
  61.     local i%,tmpidx% rem s3z
  62.     position tpos%+filepos%+1
  63. rem alert(num$(d.n%,10),d.text$)
  64.     if (D.n%<>-1)
  65.         level%=level%+1
  66.         tmpidx%=call($0081,0,(level%+1)*2) rem s3z
  67.         i%=0 rem s3z
  68.         while (i%<level%) rem s3z
  69.             pokew tmpidx%+i%*2,peekw(lvlidx%+i%*2) rem s3z
  70.             i%=i%+1 rem s3z
  71.         endwh rem s3z
  72.         pokew tmpidx%+level%*2,D.n% rem s3z
  73.         call($0381,0,lvlidx%) rem s3z
  74.         lvlidx%=tmpidx% rem s3z
  75. rem s3a        lvlidx%=realloc(lvlidx%,(level%+1)*2)
  76. rem s3a        pokew uadd(lvlidx%,level%*2),D.n%
  77.         getinfo:(D.n%)
  78.         sizehelp:
  79.         helpdisp:(0,1)
  80.     endif
  81. endp
  82.  
  83. proc schelp%:(hfile$)
  84. rem title position
  85.     global tpos%
  86.     global items%
  87.     global filepos%,scrpos%
  88. rem help level
  89.     global level%,lvlidx%
  90. rem remember where we are moving from
  91.     global oldpos%
  92.     global helplen%
  93. rem font info
  94.     global linehi%,lined%,linea%
  95. rem screensizes
  96.     global scwidth%,schight%
  97.     global search$(20),helpwin%
  98.     global filenm$(128)
  99.     global helpnx%,helpmx%,helpny%,helpmy%
  100.     local k%,mod%,h$(26),hu$(26),a$(6),a%(6),t$(1),file$(128),pname$(6)
  101.     local i%,tmpidx% rem s3z
  102.     if (scwidth%=0)
  103. rem s3a        scwidth%=480 : schight%=160
  104.         scwidth%=240 : schight%=80 rem s3z
  105.     endif
  106. rem s3a    helpwin%=gcreate(2,12,1,schight%-16,1,1)
  107.     helpwin%=gcreate(2,12,1,schight%-16,1) rem s3z
  108.     guse helpwin%
  109. rem set up levels
  110.     level%=0
  111. rem s3a    lvlidx%=alloc(2)
  112.     lvlidx%=call($0081,0,2) rem s3z
  113.     pokew lvlidx%,1
  114.     trap open hfile$,D,n%,text$
  115.     if err
  116.         helperr:(err,hfile$)
  117.         return -1
  118.     endif
  119.     getinfo:(1)
  120.     sizehelp:
  121.     helpdisp:(0,1)
  122.     filepos%=0
  123.     scrpos%=1
  124.     while 1
  125.         position tpos%+filepos%+1
  126.         if (D.n%=-1)
  127.             gat 8,(scrpos%-1)*linehi%+linehi%+10+linea%
  128.             gprint ""
  129.         else
  130.             gat 8,(scrpos%-1)*linehi%+linehi%+10
  131.             gfill gtwidth("■ "+D.text$),linehi%,2
  132.             gat 7,(scrpos%-1)*linehi%+linehi%+10
  133.             ggmode 0
  134.             gborder $400,gtwidth("■ "+D.text$)+2,linehi%
  135.         endif
  136.         getevent a%()
  137.         if (D.n%=-1)
  138.             gat 8,(scrpos%-1)*linehi%+linehi%+10+linea%
  139.             gprintb "",gtwidth("")-1
  140.         else
  141.             gat 8,(scrpos%-1)*linehi%+linehi%+10
  142.             gfill gtwidth("■ "+D.text$),linehi%,2
  143.             gat 7,(scrpos%-1)*linehi%+linehi%+10
  144.             ggmode 1
  145.             gborder $400,gtwidth("■ "+D.text$)+2,linehi%
  146.             ggmode 0
  147.         endif
  148.         if ((a%(1) and $400)<>0) rem not keypress
  149.         else rem a keypress sc should optimise this
  150.             k%=a%(1)
  151.             mod%=a%(2) and $00ff
  152.             if (k%=13)
  153.                 select:
  154.             endif
  155.             if (k%=27) rem escape
  156.                 level%=level%-1
  157.                 if ((level%=-1)or(mod%=4))
  158.                     gclose helpwin%
  159.                     close
  160. rem s3a                    freealloc (lvlidx%)
  161.                     call($0381,0,lvlidx%) rem s3z
  162.                     return 0
  163.                 endif
  164.                 tmpidx%=call($0081,0,(level%+1)*2) rem s3z
  165.                 i%=0 rem s3z
  166.                 while (i%<=level%) rem s3z
  167.                     pokew tmpidx%+i%*2,peekw(lvlidx%+i%*2) rem s3z
  168.                     i%=i%+1 rem s3z
  169.                 endwh rem s3z
  170.                 call($0381,0,lvlidx%) rem s3z
  171.                 lvlidx%=tmpidx% rem s3z
  172. rem s3a                lvlidx%=realloc(lvlidx%,(level%+1)*2)
  173. rem s3a                getinfo:(peekw(uadd(lvlidx%,level%*2)))
  174.                 getinfo:(peekw(lvlidx%+level%*2)) rem s3z
  175.                 sizehelp:
  176.                 helpdisp:(0,1)
  177.             endif
  178.             if (k%=262) rem home
  179.                 helpdisp:(0,1)
  180.             elseif (k%=263) rem end
  181.                 helpdisp:(count,helplen%)
  182.             elseif ((k%=257)and(filepos%<items%-1)) rem down arrow
  183.                 if (scrpos%=helplen%)
  184.                     helpdisp:(filepos%+1,helplen%)
  185.                 else
  186.                     scrpos%=scrpos%+1
  187.                     filepos%=filepos%+1
  188.                 endif
  189.             elseif ((k%=261)and(filepos%<items%-1)) rem page down
  190.                 if (scrpos%=helplen%)
  191.                     helpdisp:(filepos%+(helplen%-1),helplen%)
  192.                 else
  193.                     filepos%=filepos%-scrpos%+helplen%
  194.                         scrpos%=helplen%
  195.                 endif
  196.             elseif ((k%=256)and(filepos%>0)) rem up arrow
  197.                 if (scrpos%=1)
  198.                     helpdisp:(filepos%-1,1)
  199.                 else
  200.                     scrpos%=scrpos%-1
  201.                     filepos%=filepos%-1
  202.                 endif
  203.             elseif ((k%=260)and(filepos%>0)) rem page up
  204.                 if (scrpos%=1)
  205.                     helpdisp:(filepos%-(helplen%-1),1)
  206.                 else
  207.                     filepos%=filepos%-scrpos%+1
  208.                     scrpos%=1
  209.                 endif
  210.             endif
  211.         endif
  212.     endwh
  213. endp
  214.  
  215. proc helperr:(val%,file$)
  216.     alert ("Error "+err$(val%),file$)
  217.     busy off
  218. endp
  219.  
  220. proc helpdisp:(from%,posit%) rem display current screen of entries
  221.     local i%,j%,k%,pos%,oldpos%,lposit%,ppos%,qpos%,opos%,rpos%,disp$(255)
  222. rem alert(num$(from%,10),num$(posit%,10))
  223.     lposit%=posit%
  224. rem remember where we were
  225.     oldpos%=filepos%
  226. rem if position beyond start of file, should be unecessary
  227.     if (from%<0)
  228.         filepos%=0
  229. rem if position beyond end of file, should be unecessary
  230.     elseif (from%>items%-1)
  231.         filepos%=items%-1
  232.     else
  233.         filepos%=from%
  234.     endif
  235. rem if the gap between screenpos and end of screen is greater than
  236. rem gap from file position and end of file then fill up resultant gap on screen
  237.     if (helplen%-lposit%)>(items%-filepos%-1)
  238. rem if there is enough left over to move downto fill whole screen
  239.         if (helplen%<items%)
  240.             lposit%=helplen%-(items%-filepos%-1)
  241.         else
  242. rem move down the spare stuff
  243.             lposit%=filepos%+1
  244.         endif
  245.     endif
  246. rem simple check for small files
  247.     if (lposit%>items%)
  248.         lposit%=items%
  249.     endif
  250. rem stop positioning beyond end of screen, should be unnecessary
  251.     if (lposit%>helplen%)
  252.         lposit%=helplen%
  253.     endif
  254. rem i counts position on screen j counts how many printed
  255.     i%=0:j%=1
  256.     gupdate off
  257. rem top of display is current - start
  258.     pos%=filepos%-lposit%+1
  259.     if (pos%<0)
  260.         pos%=0
  261.         lposit%=filepos%+1
  262.     endif
  263.     position pos%+1+tpos%
  264.     gat 14,linehi%+10
  265.     if ((scrpos%=1)and(lposit%=1)and(filepos%=oldpos%-1))
  266.         gscroll 0,linehi%,14,linehi%+10,helpmx%-29,helpmy%-(linehi%+10)-6-linehi%
  267.         j%=helplen%
  268.     elseif ((scrpos%=helplen%)and(lposit%=helplen%)and(filepos%=oldpos%+1))
  269.         gscroll 0,-linehi%,14,linehi%+linehi%+10,helpmx%-29,helpmy%-(linehi%+10)-6-linehi%
  270.         j%=helplen%
  271.         while (i%<helplen%-1)
  272.             i%=i%+1
  273.         endwh
  274.     else
  275.         gfill helpmx%-20,helpmy%-(linehi%+10)-6,1
  276.     endif
  277. rem alert(num$(pos%,10))
  278.     gstyle 0
  279.     if (pos%<>0)
  280.         gat (gwidth-14),linehi%+10+linea% :gprint ""
  281.     else
  282.         gat (gwidth-14),linehi%+10+linea% :gprintb " ",6
  283.     endif
  284.     k%=i%
  285.     while ((j%<=helplen%)and(pos%+k%<items%))
  286. rem alert(num$(pos%+k%+1,10))
  287.         position pos%+k%+1+tpos%
  288.         disp$=D.text$
  289.         if (D.n%=-1)
  290.             gstyle 0
  291.             ppos%=18
  292.         else
  293.             gstyle 1
  294.             disp$="■ "+disp$
  295.             ppos%=8
  296.         endif
  297.         gat ppos%,(i%*linehi%+linehi%+10+linea%) :gprint disp$
  298.         i%=i%+1
  299.         j%=j%+1
  300.         k%=k%+1
  301.     endwh
  302.     gstyle 0
  303.     if (((pos%+k%)<>items%)and(j%=helplen%+1))
  304.         gat (gwidth-14),helpmy%-lined% :gprint chr$($0d)
  305.     else
  306. rem s3a        gat (gwidth-14),helpmy%-lined%-3 :gprintb " ",6
  307.         gat (gwidth-14),helpmy%-lined% :gprintb " ",6 rem s3z
  308.     endif
  309.     if (D.n%=-1)
  310.         gstyle 0
  311.     else
  312.         gstyle 1
  313.     endif
  314.     if (lposit%>(i%))
  315.         scrpos%=i%
  316.     else
  317.         scrpos%=lposit%
  318.     endif
  319.     if scrpos%<1
  320.         scrpos%=1
  321.     endif
  322.     gupdate on
  323.     position filepos%+1+tpos%
  324. endp
  325.  
  326. proc dohelp:(m$)
  327.     local tsize%,i%
  328.     gcls
  329. rem s3a    gxborder 1,1
  330.     gborder 1
  331.     tsize%=linehi%+2
  332.     gstyle 1
  333.     position tpos%
  334.     gat 16,tsize%-lined%+6 :gprintb m$+":"+D.text$,helpmx%-32,3
  335.     gat 5,tsize%+6 :glineby gwidth-10,0
  336. endp
  337.