home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / pages2.zip / PAGES.SRC < prev    next >
Text File  |  1986-11-25  |  10KB  |  338 lines
  1. * pages.src
  2. * pages procedures file
  3. * Andrew Schulman, 12 Humboldt St., Cambridge MA 02140
  4. * 11/16/86
  5. * revised 11/18/86:  replaced pack with list while .not. deleted()
  6. * revised 11/19/86:  added check for .not. deleted() before clearing screen
  7. * revised 11/21/86:  no recursion:  pages & caller share variable thisfile
  8. * revised 11/21/86:  any len(line) ok: list off trim(substr(line,1,length))
  9. *                    but added test for field name line
  10. * revised 11/24/86:  added parameter SWITCH_OK:  let calling program
  11. *                    determine if OK to go to another file
  12.  
  13. procedure PAGES
  14. parameters FILENAME, MYTOP, DEPTH, START, SHOWPAGE, SHOWRULE, SWITCH_OK
  15.  
  16. **************************** error checking *************************
  17. if DEPTH + START > 22 .or. START > 22 .or. SHOWPAGE > START .or. ;
  18.    SHOWRULE > START
  19.    @3,0 say "PAGES won't fit on screen or SHOWPAGE/SHOWRULE won't show"
  20.    @4,0 say "Correct example:  do PAGES with 'pages.src', 1, 19, 3, 1, 2"
  21.    return
  22. endif
  23. if .not. file(FILENAME)
  24.    @START,0 say "PAGES can't find " + FILENAME
  25.    return
  26. endif
  27.  
  28. ****************************** definitions ************************
  29. * below are scan codes for PC keys: note that these shouldn't be variables,
  30. * which is what they are here, but shouldn't be dropped in code as "magic
  31. * numbers" either.  dBase needs something like #define in C.  There IS a
  32. * keyword "define" in DB++ preprocessor I'm writing.  Also user-defined
  33. * functions and procedures INSIDE same file as non-procedures.  Readers are
  34. * invited to send me their "wish lists."  Right now I'm writing the pre-
  35. * processor in dBase so that dBase programmers can modify it.  Parsing in
  36. * dBase relies heavily on functions substr() and at() and works fine but is
  37. * slow!  Might just write it in C.  Anyway...
  38. up = 5
  39. down = 24
  40. pgUp = 18
  41. pgDn = 3
  42. homekey = 1
  43. endkey = 6
  44.  
  45. ****************************** set up ******************************
  46. store space(10) to whichpage, phrase, otherfile
  47.  
  48. msgline = START + DEPTH + 1
  49. @START,0 clear to msgline-2,79
  50. @START,0 say "Working...."
  51. do BLINKY
  52.  
  53. set heading off
  54. load curson
  55. load cursoff
  56. call cursoff
  57. * DEMO.PRG checked to make sure these existed; your calling program should too
  58.  
  59. use line
  60. if field(1) <> "LINE"
  61.    @START,0 say "Please use LINE.DBF that comes with PAGES"
  62.    do BYE_BYE with ""
  63.    return
  64. endif
  65. length = iif(len(line) < 78, len(line), 78)
  66. set safety off
  67. zap
  68. set safety on
  69. append from &FILENAME sdf
  70. go bottom
  71. del_num = 0
  72. do while len(trim(line)) < 1 .and. recno() > 1
  73.    delete
  74.    del_num = del_num + 1
  75.    skip -1
  76. enddo
  77. * don't pack
  78. * wish I could use APPEND FROM &FILENAME FOR LEN(TRIM(LINE)) > 0 SDF,
  79. * because of interesting way FOR condition works during APPEND,
  80. * but that would kill blank lines in middle of file; not just at tail-end
  81.  
  82. tot = reccount() - del_num
  83.  
  84. if tot < 1
  85.    do WAIT_MSG with "File is empty"
  86.    do BYE_BYE with ""
  87.    return
  88. endif
  89.  
  90. page = 1
  91. size = tot + 1 - MYTOP
  92. p = size / DEPTH
  93. q = int(p)
  94. pages = iif(p - q = 0, q, q + 1)
  95. end = iif(size < DEPTH, 1, size - DEPTH + START)
  96. didsearch = .F.
  97. foundit = 0
  98. overlap = 0     && this can be changed to anything < DEPTH
  99.  
  100. if SHOWRULE > 0
  101.    @SHOWRULE,0 to SHOWRULE,78 double
  102. endif
  103. @msgline-1,0 to msgline-1,78 double
  104.  
  105. prompt = iif(pages = 1, "", "Prev, Next, Begin, End, Search, Repeat, #, ") + ;
  106.          iif(SWITCH_OK, "File, ", "") + "or Quit? "
  107.  
  108. FILENAME = ""
  109. thisfile = ""
  110. * FILENAME is pages2's copy of PUBLIC thisfile, declared in calling program
  111. * demo2.prg and passed to pages2 as parameter.  Looks like we have to
  112. * change BOTH because passed as parameter???
  113. * extract from LIST MEMORY:
  114. *    THISFILE    pub   (hidden)  C  ""
  115. *    FILENAME    priv  @  THISFILE
  116. *    THISFILE    priv  C  ""
  117.  
  118. ***************************** main loop ***********************************
  119. goto MYTOP
  120. do while .not. eof()
  121.    thispage = "Page " + str(page,2) + " of " + str(pages,2)
  122.    do SHOW_REV with thispage, SHOWPAGE, 66
  123.    if recno() <> MYTOP
  124.       skip overlap + 1
  125.    endif
  126.  
  127.    if .not. deleted()
  128.       @START,0 clear to msgline-2,79
  129.       @START-1,79        && see Liskin, Adv dBase III, p.286, for why
  130.       list off trim(substr(line,1,length)) next DEPTH while .not. deleted()
  131.    endif
  132.    ** all the work is done here
  133.    ** nonprocedural list is 20% faster than procedural do-while loop
  134.    ** and there is another 20% improvement when you trim line
  135.    ** if you wanted to show line numbers, you could:
  136.    ** list trim(substr(line,1,70)) next DEPTH while .not. deleted()
  137.  
  138.    if foundit > 0
  139.       saverec = min(recno(), tot - 1)
  140.       goto foundit
  141.       set color to N/W+
  142.       @START,1 say trim(line)  && why trouble if first few lines?
  143.       set color to
  144.       goto saverec
  145.       foundit = 0
  146.    endif
  147.  
  148.    do MSG with prompt
  149.    ink = 0
  150.    do while ink = 0
  151.       ink = inkey()
  152.    enddo
  153.    which = upper(chr(ink))
  154.    num = val(which)
  155.  
  156.    beforerec = recno()
  157.  
  158.    if pages = 1
  159.       do case
  160.          case which = 'F' .and. SWITCH_OK
  161.             do NEW_FILE
  162.             if len(trim(thisfile)) > 0
  163.                return
  164.             endif
  165.          case which = 'Q'
  166.             do BYE_BYE with ""
  167.             return
  168.          otherwise
  169.             do WAIT_MSG with "Only one page"
  170.             do GO_HOME
  171.       endcase
  172.    else
  173.       do case
  174.          case which = 'B' .or. ink = homekey
  175.             do GO_HOME
  176.          case which = 'E' .or. ink = endkey
  177.             do GO_END
  178.          case which = 'P' .or. ink = up .or. ink = pgUp
  179.             do GO_PREV
  180.          case which = 'N' .or. ink = down .or. ink = pgDn
  181.             do GO_NEXT
  182.          case num > 0   && it's a page number
  183.             do GO_PAGE with num
  184.          case which = '#'   && if can't get to page with 1 digit
  185.             do ACCEPTVAR with "Go to page #", whichpage
  186.             mypage = val(whichpage)
  187.             do GO_PAGE with mypage
  188.          case which $ "SR"
  189.             do SEARCH
  190.          case which = 'F' .and. SWITCH_OK
  191.             do NEW_FILE
  192.             if len(trim(thisfile)) > 0
  193.                return
  194.             endif
  195.          case which = 'Q'
  196.             do BYE_BYE with ""
  197.             return
  198.          otherwise
  199.             do GO_NEXT
  200.       endcase
  201.    endif
  202. enddo
  203. return
  204.  
  205. *************************** procedures ******************************
  206. procedure ACCEPTVAR
  207. parameters msg, var
  208.    @msgline,0
  209.    @msgline,len(msg)
  210.    do BLINKY
  211.    @msgline-1,79
  212.    accept msg to temp
  213.    var = temp
  214.    * var has to be declared PUBLIC
  215. return
  216.  
  217. procedure BLINKY     && our own blinking cursor: don't call curson
  218.    set color to w*
  219.    ?? '_'
  220.    set color to
  221. return
  222.  
  223. procedure BYE_BYE
  224.    parameter sendmessag
  225.    close databases
  226.    call curson
  227.    FILENAME = sendmessag  && send message back to caller
  228.    thisfile = sendmessag
  229.    @msgline,0
  230. return
  231.  
  232. procedure GO_END
  233.    goto end
  234.    page = pages
  235. return
  236.  
  237. procedure GO_HOME
  238.    goto MYTOP
  239.    page = 1
  240. return
  241.  
  242. procedure GO_NEXT
  243.    goto iif(eof(), recno() - DEPTH + 1, recno())
  244.    page = iif(page < pages - 1, page + 1, pages)
  245. return
  246.  
  247. procedure GO_PAGE
  248. parameter pg
  249.    pg = iif(pg <= 1, 1, int(pg))
  250.    goto iif(pg >= pages, end, ((pg - 1) * DEPTH) + MYTOP - iif(pg = 1, 0, 1))
  251.    page = iif(pg >= pages, pages, pg)
  252. return
  253.  
  254. procedure GO_PREV
  255.    prev = iif(recno() > (DEPTH*2+1), recno()-(DEPTH*2), MYTOP)
  256.    goto prev
  257.    page = iif(page > 1, page - 1, 1)
  258. return
  259.  
  260. procedure MSG
  261. parameter msg
  262.    @msgline,0 clear
  263.    @msgline,0 say msg
  264.    do BLINKY
  265. return
  266.  
  267. procedure NEW_FILE
  268.    saverec = iif(recno() - DEPTH > 1, recno() - DEPTH, 1)
  269.    do ACCEPTVAR with "New filename to switch to? ", otherfile
  270.    if file(otherfile)
  271.       do MSG with "Switching file..."
  272.       do BYE_BYE with otherfile
  273.       return
  274.       * depends on calling program PUBLIC variable thisfile
  275.       * this way, pages sends message to calling program rather
  276.       * than recursively calling itself as in previous version of PAGES
  277.    else
  278.       do WAIT_MSG with "No such file"
  279.       goto saverec
  280.    endif
  281. return
  282.  
  283. procedure SEARCH
  284.    if which = 'S'
  285.       do ACCEPTVAR with "Search for ", phrase
  286.    endif
  287.    if which = 'S' .or. (which = 'R' .and. didsearch)
  288.       do MSG with "Searching for " + phrase + "..."
  289.    endif
  290.    saverec = iif(recno() - DEPTH > 1, recno() - DEPTH, 1)
  291.    if .not. eof()
  292.       goto saverec + 1
  293.    endif
  294.    if which = 'S'
  295.       locate for at(phrase, line) > 0
  296.       didsearch = .T.
  297.    else if which = 'R'
  298.       if didsearch
  299.          continue
  300.       else
  301.          do WAIT_MSG with "Must do SEARCH before REPEAT"
  302.       endif
  303.    endif
  304.    **** replaced do-while loop with locate/continue
  305.    if .not. found()
  306.       if didsearch
  307.          do WAIT_MSG with "Not found"
  308.       endif
  309.       goto saverec
  310.    else
  311.       foundit = recno()
  312.       skip -1 && back up so they can see it
  313.       page = int(((recno() - MYTOP) / DEPTH) + 1)
  314.    endif
  315. return
  316.  
  317. procedure SHOW_REV
  318. parameters msg, row, col
  319.    @row,col
  320.    @row,col get msg
  321.    clear gets
  322. return
  323.  
  324. procedure WAIT_MSG
  325. parameter msg
  326.    @msgline,len(msg)+32
  327.    do BLINKY
  328.    @msgline-1,79
  329.    wait msg + " ... Press any key to continue "
  330.    @msgline,0
  331. return
  332.  
  333. ** missing:  need procedure INVAL_SCR to see if screen really needs to
  334. ** be redrawn.  Right now, redraws each time through main loop, even if
  335. ** nothing has changed.
  336.  
  337. ** if you're examining source code from within PAGES, please remember to
  338. ** return to file called PAGES.DAT