home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / readtx.zip / READTXT.PRG < prev    next >
Text File  |  1993-05-12  |  18KB  |  580 lines
  1. //───────────────────────────────────────────────────
  2. //
  3. //        Program  READTXT.PRG
  4. //        Function(S) READTEXT()
  5. //                    SHOWLINS()
  6. //                    ML_BOX()
  7. //                    RS_BOX()
  8. //                    ParseSlash()
  9. //                    Centr()
  10. //                    O_ERROR()
  11. //
  12. //           Uses: TEXT.$db
  13. //
  14. //    Other Files: &TEXTFILE
  15. //
  16. //    Originally written by Eric Engelmann for the US Army.
  17. //
  18. //    Extensively modifed by TED LONG 11/92
  19. //    Orlando, Fl   (407) 380-8882
  20. //──────────────────────────────────────────────────────
  21. //
  22. // Substitute for Buerg's List program with Clipper.  Allows user
  23. //    to examine any text type file, such as generated report files
  24. //    (or source code files, if you have set up your error handler
  25. //     to call this program with the name of the error program),
  26. //    without having to use the RUN or ! command with its very high
  27. //    RAM overhead requirements.
  28. //    The program works by appending a DBF file from a text file (SDF)
  29. //    It then uses the SCROLL function to move the current picture of
  30. //    text on the screen.
  31. //
  32. //
  33. //───────────────────────────────────────────────────────────────────
  34. //  Extensive changes were made to the original. The entire screen was
  35. //  changed along with additional key trapping.
  36. //  Also, optimized for clipper 5.01.
  37. //───────────────────────────────────────────────────────────────
  38. //    1) Converted to a function from a proc
  39. //    2) Save and restore prior screens
  40. //    3) Create text.$$$ on the fly and delete when finished
  41. //    4) Reformated the source code with Snap
  42. //    5) Fixed the color problems with the opening screen
  43. //    6) Added a real help screen
  44. //───────────────────────────────────────────────────────────────
  45. STATIC offset, boxbott, scr_row, boxtop, getstr
  46.  
  47. //───────────────────────────
  48. FUNCTION READTEXT(textfile)
  49. //───────────────────────────
  50. LOCAL getlist   := {}, darray := {}
  51. LOCAL oldcolor  := SETCOLOR()
  52. LOCAL oldscreen := SAVESCREEN(0,0,24,79)
  53. LOCAL oldsele   := SELECT()
  54. LOCAL toprec    := 1          &&Record number on diplay at top line of box.
  55. LOCAL lastrec, keystroke, newrec, oldtop, mphrase, newcolor, flag, readscr
  56. LOCAL readfile := parseslash( textfile )
  57.  
  58. boxbott   := 23         &&Bottom row of display box.
  59. offset    := 1          &&Starting position to display for each line of text.
  60. scr_row   := 1          &&Screen row.
  61. boxtop    := 1          &&Top row of display box.
  62.  
  63. SET SCOREBOARD OFF
  64. // save the old color attributes
  65. // SET COLOR TO SOMETHING OTHER THAN WHITE ON BLACK
  66. IF ISCOLOR()
  67.    IF oldcolor = "" .OR. oldcolor = 'W/N'
  68.       newcolor := 'W/+B'
  69.    ELSE
  70.       newcolor := oldcolor
  71.    ENDI
  72. ELSE
  73.    newcolor := 'w/n'
  74. ENDI
  75.  
  76. SETCOLOR(newcolor)
  77.  
  78. ML_BOX(10, 'Please wait while the File is prepared for display...')
  79.  
  80. AADD(darray,{"LINE", "C", 220 , 0 } )
  81. DBCREATE('TEXT.$DB', darray )
  82.  
  83. USE TEXT.$db NEW EXCLUSIVE
  84. APPEND FROM &textfile. SDF
  85. GO TOP
  86. LASTREC := RECCOUNT()
  87.  
  88. // Present the database in a window.
  89. CLS
  90.  
  91. // Paint first screen.
  92. SHOWLINS()
  93.  
  94. SETCOLOR("I")
  95. @ 00,00 SAY SPACE(80)
  96. @ 00,00 SAY 'File: '+ALLTRIM( readfile )
  97. @ 00,70 SAY DTOC(DATE())
  98. @ 24,00 SAY SPACE(80)
  99. @ 24,00 SAY SPACE(30)+'Keys: '+CHR(24)+CHR(25)+CHR(26)+CHR(27)+;
  100. '/PgDn/PgUp/Home/End    ESC=Exit F1=HELP'
  101. @ 24, 00 SAY 'Command  '
  102. SETCOLOR(newcolor)
  103.  
  104. flag    := .F.
  105.  
  106. DO WHILE .T.
  107.    SETCOLOR("I")
  108.    @ 0,19 SAY 'Line: '+STR(toprec,6,0)
  109.    @ 24, 09 SAY ""
  110.    SETCOLOR(newcolor)
  111.    
  112.    keystroke := INKEY(0)
  113.  
  114.    DO CASE
  115.       // User pressed ESC, and wants out.
  116.    CASE LASTKEY() == 27
  117.       USE
  118.       FCLOSE("TEXT.$DB")
  119.       FERASE("TEXT.$db")
  120.       SETCOLOR(oldcolor)
  121.       CLS
  122.       SELECT(oldsele)
  123.       RESTSCREEN(0,0,24,79,oldscreen)
  124.       RETURN NIL
  125.  
  126.       // User wants to pan right.
  127.    CASE keystroke = 4
  128.       IF offset< 240
  129.          offset := offset+20
  130.       ENDIF
  131.  
  132.       GO toprec
  133.       showlins()
  134.       
  135.       // User wants to pan left.
  136.    CASE keystroke = 19
  137.       IF offset>=21
  138.          offset := offset-20
  139.       ENDIF (offset>=21)
  140.       GO toprec
  141.       showlins()
  142.  
  143.       // User wants top of file.
  144.    CASE keystroke = 1
  145.       GO 1
  146.       toprec := 1
  147.       showlins()
  148.  
  149.       // User wants end of file.
  150.    CASE keystroke = 6
  151.       IF LASTREC>=boxbott-boxtop
  152.          GO LASTREC-(boxbott-boxtop)
  153.       ELSE
  154.          GO 1
  155.       ENDIF (lastrec>=boxbott-boxtop)
  156.       toprec := RECNO()
  157.       showlins()
  158.       
  159.       // User wants to page down a screen.
  160.    CASE keystroke = 3
  161.       IF toprec+boxbott-boxtop <= LASTREC
  162.          toprec := toprec+boxbott-boxtop
  163.       ELSE
  164.          toprec := LASTREC
  165.       ENDIF (toprec+boxbott-boxtop <= lastrec)
  166.       GO toprec
  167.       showlins()
  168.       
  169.       // User wants to page up a screen.
  170.    CASE keystroke = 18
  171.       newrec := toprec-(boxbott-boxtop)
  172.       IF newrec>0
  173.          toprec := newrec
  174.       ELSE
  175.          toprec := 1
  176.       ENDIF (newrec>0)
  177.       GO toprec
  178.       showlins()
  179.  
  180.       // User chose uparrow.
  181.    CASE keystroke = 5
  182.       IF toprec>1
  183.          SCROLL(boxtop,0,boxbott,79,-1)
  184.          // Got to the new record.
  185.          toprec := toprec-1
  186.          GO toprec
  187.          @ boxtop,0 SAY SUBSTR(FIELD->line,offset,79)
  188.       ELSE
  189.          // If we are at the first record already, do nothing.
  190.       ENDIF (toprec>1)
  191.       
  192.       // User chose down arrow.
  193.    CASE keystroke = 24
  194.       IF toprec-boxtop+boxbott<LASTREC
  195.          SCROLL(boxtop,0,boxbott,79,1)
  196.          toprec := toprec+1
  197.          GO toprec+boxbott-boxtop
  198.          @ boxbott,0 SAY SUBSTR(FIELD->line,offset,79)
  199.       ENDIF (toprec-boxtop+boxbott<lastrec)
  200.       
  201.       // User claims he needs help.
  202.    CASE keystroke = 28 .OR. keystroke = 72 .OR. keystroke = 104 .OR. keystroke = 63
  203.        readscr := SAVESCREEN(0,0,24,79)
  204.  
  205.        IF !ISCOLOR()
  206.          CLS
  207.        ENDI
  208.  
  209.        RS_BOX(6,8,18,72)
  210.        CENTR(6, "┤ HELP SCREEN ├")
  211.        @ 07, 09 SAY ' Cursor Left    - Pans the screen left'
  212.        @ 08, 09 SAY ' Cursor Right   - Pans the screen right'
  213.        @ 09, 09 SAY ' Cursor up/down - Move to the next or previous line'
  214.        @ 10, 09 SAY ' Page-Up        - Move up one screen page'
  215.        @ 11, 09 SAY ' Page-Down      - Move down one screen page'
  216.        @ 12, 09 SAY ' Home           - Go to the top of the document'
  217.        @ 13, 09 SAY ' End            - Go to the bottom of the document'
  218.        @ 14, 09 SAY ' F  Find Text   - Non case sensitive find'
  219.        @ 15, 09 SAY ' C  Find Text   - Case sensitive find'
  220.        @ 16, 09 SAY ' N  Next        - Next find'
  221.        @ 17, 09 SAY ' P  Print       - Print viewed document'
  222.        INKEY(0)
  223.        RESTSCREEN(0,0,24,79, readscr)
  224.    CASE keystroke = 112 .OR. keystroke = 80
  225.       IF ISPRINTER()
  226.          SET CONSOLE OFF
  227.          TYPE &TEXTFILE. TO PRINT
  228.          SET CONSOLE ON
  229.       ELSE
  230.          O_ERROR("PRINTER IS NOT READY......")
  231.       ENDI
  232.  
  233.       // User wants to locate a string.
  234.    CASE keystroke = 70 .OR. keystroke = 102
  235.       oldtop    := toprec
  236.       GO toprec
  237.       SETCOLOR("I")
  238.       @ 24,0 SAY SPACE(80)
  239.  
  240.       getstr := REPLICATE(" ",25)
  241.       @ 24,00 SAY "Search for ? " GET getstr
  242.       READ
  243.  
  244.       IF !EMPTY(getstr)
  245.         getstr  := LOWER(TRIM(getstr))
  246.         mphrase := CHR(34)+TRIM(getstr)+CHR(34)
  247.         LOCATE NEXT 1000000 FOR getstr $ LOWER(FIELD->line)
  248.         IF EOF()
  249.            @ 24,0 SAY SPACE(80)
  250.            @ 24,0 SAY mphrase+' not found. Press any key....'
  251.            keystroke := INKEY(0)
  252.            toprec    := oldtop
  253.            GO toprec
  254.         ELSE
  255.            toprec := RECNO()
  256.         ENDIF (eof())
  257.         flag := .T.
  258.       ENDI
  259.  
  260.       SETCOLOR(newcolor)
  261.       showlins()
  262.       SETCOLOR("I")
  263.       @ 24,0 SAY SPACE(80)
  264.       @ 24, 00 SAY SPACE(30)+'Keys: '+CHR(24)+CHR(25)+CHR(26)+CHR(27)+;
  265.       '/PgDn/PgUp/Home/End    ESC=Exit F1=HELP'
  266.       @ 24, 00 SAY 'Command  '
  267.       SETCOLOR(newcolor)
  268.  
  269.    CASE keystroke = 67 .OR. keystroke = 99
  270.       getstr := REPLICATE(" ",25)
  271.       oldtop := toprec
  272.       GO toprec
  273.       SETCOLOR("I")
  274.       @ 24,0 SAY SPACE(80)
  275.       @ 24,00 SAY "Search for ? " GET getstr
  276.       READ
  277.  
  278.       mphrase := CHR(34)+TRIM(getstr)+CHR(34)
  279.       IF !EMPTY(getstr)
  280.         getstr := TRIM(getstr)
  281.         LOCATE NEXT 1000000 FOR getstr $ FIELD->line
  282.         IF EOF()
  283.            @ 24,0 SAY SPACE(80)
  284.            @ 24,0 SAY mphrase + ' not found. Press any key....'
  285.            keystroke := INKEY(0)
  286.            toprec    := oldtop
  287.            GO toprec
  288.         ELSE
  289.            toprec := RECNO()
  290.          ENDIF (eof())
  291.         flag := .T.
  292.       ENDI
  293.  
  294.       SETCOLOR(newcolor)
  295.       showlins()
  296.       SETCOLOR("I")
  297.       @ 24,0 SAY SPACE(80)
  298.       @ 24, 00 SAY SPACE(30)+'Keys: '+CHR(24)+CHR(25)+CHR(26)+CHR(27)+;
  299.       '/PgDn/PgUp/Home/End    ESC=Exit F1=HELP'
  300.       @ 24, 00 SAY 'Command  '
  301.       SETCOLOR(newcolor)
  302.  
  303.       // User wants to find the next occurrence.
  304.    CASE keystroke = 78 .OR. keystroke = 110
  305.       IF flag
  306.         CONTINUE
  307.         IF EOF()
  308.            SETCOLOR("I")
  309.            @ 24,0 SAY SPACE(80)
  310.            @ 24,0 SAY mphrase + '- Next occurrence not found. Press any key....'
  311.            keystroke := INKEY(0)
  312.            toprec := oldtop
  313.            GO toprec
  314.         ELSE
  315.            toprec := RECNO()
  316.         ENDIF (eof())
  317.  
  318.         SETCOLOR(newcolor)
  319.         showlins()
  320.         SETCOLOR("I")
  321.         @ 24,0 SAY SPACE(80)
  322.         @ 24, 00 SAY SPACE(30)+'Keys: '+CHR(24)+CHR(25)+CHR(26)+CHR(27)+;
  323.         '/PgDn/PgUp/Home/End    ESC=Exit F1=HELP'
  324.         @ 24, 00 SAY 'Command  '
  325.         SETCOLOR(newcolor)
  326.      ENDI
  327.  
  328.    ENDCASE
  329.    
  330. ENDDO
  331. RETURN NIL
  332.  
  333. //──────────────────────────────────────────────────────────────────────
  334. //
  335. //       Function: SHOWLINS()
  336. //
  337. //      Called by: READTXT.PRG
  338. //
  339. //─────────────────────────────────────────────────────────────────────
  340. STATIC FUNCTION showlins()
  341. //──────────────────
  342. LOCAL lastrow
  343.  
  344. @ boxtop, 0 CLEAR TO boxbott,79
  345. scr_row := boxtop
  346. DO WHILE .NOT. EOF() .AND. scr_row <= boxbott
  347.    @ scr_row,0 SAY SUBSTR(FIELD->line, offset,79)
  348.    SKIP
  349.    scr_row := scr_row+1
  350. ENDDO
  351. lastrow := scr_row-1
  352. RETURN .T.
  353.  
  354. //───────────────────────────────────
  355. // Function ParseSlash()
  356. //        By Ted Long
  357. //───────────────────────────────────
  358. STATIC FUNCTION ParseSlash(cFname)
  359. //───────────────────────────────────
  360. LOCAL posa, posb
  361.  
  362. cFname := ALLTRIM( cFname )
  363.  
  364. // If the filename is included within a path, the parse out the filename
  365. posa := RAT("\",cFname)
  366. IF posa > 0
  367.    cFname := SUBSTR(cFname, posa + 1, LEN( cfname) )
  368. endif
  369.  
  370. RETURN cFname
  371.  
  372. //───────────────────────────────────────────────────────────────────────
  373. //      Function: ML_BOX()
  374. //
  375. //        By Ted Long
  376. //
  377. //      usage: m_box(5,"character string")
  378. //      What it does: centers a message on the screen with a box.
  379. //      Starting at the specific line number
  380. //───────────────────────────────────────────────────────────────────────
  381. STATIC FUNCTION ML_box(mrow, M_string)
  382. //─────────────────────────────
  383. LOCAL length, beg_it, end_it
  384.  
  385. IF LEN(ALLTRIM(M_string)) >= 76
  386.    length := 76
  387.    M_string := SUBSTR(M_string,1,76)
  388. ELSE
  389.    length := ROUND(LEN(ALLTRIM(M_string)),0)
  390. ENDI
  391.  
  392. beg_it := ROUND((80-length)/2,0)-2
  393. end_it := ROUND(((80-length)/2)+length,0)+1
  394.  
  395. RS_BOX( mrow-1, beg_it, mrow+1, end_it )
  396. @ mrow-1, 34 SAY "┤  Message  ├"
  397. @ mrow,(beg_it +2) SAY ALLTRIM(M_string)
  398. RETURN NIL
  399.  
  400. //───────────────────────────────────────────────────────────────────────
  401. //        Function: RS_BOX()
  402. //
  403. //        By Ted Long
  404. //
  405. //        A REAL SHADOW BOX (NON-DESTRUCTIVE SHADOW ON BOTTOM AND RIGHT)
  406. //
  407. //         USAGE: C_BOX(n1 ,n2 , n3, n4, n5)
  408. //         WHERE:  n1 := BEGINING ROW
  409. //                 n2 := BEGINING COL
  410. //                 n3 := ENDING ROW
  411. //                 n4 := ENDING COLUMN
  412. //                 n5 := BOX TYPE  (optional)
  413. //
  414. //                 BOX OPTIONS   1 := ┌─┐│┘─└│     2 := ╔═╗║╝═╚║
  415. //                               3 := ╒═╕│╛═╘│     4 := ╓─╖║╜─╙║
  416. //                               5 := "█▀███▄██ ████"
  417. //
  418. //                               DEFAULT :=  ┌─┐│┘─└│
  419. //───────────────────────────────────────────────────────────────────────
  420. // I'm sure that this is the fastet non-destructive shadowbox available
  421. // that is written in 100% Clipper. Speed gets damn close to ASM
  422. //───────────────────────────────────────────────────────────────────────
  423. STATIC FUNCTION RS_BOX(beg_row, beg_col, end_row, end_col, b_type, color)
  424. //───────────────────────────────────────────────────────────────────────
  425. LOCAL mboxer, horiz, vert, h, v, origcolor
  426.  
  427. //───────────────────────────────────────────────────────────────
  428. // check to see if the parameters passed are greater than possible
  429. // shadow box coordinates on a 80 X 25 Screen
  430. //───────────────────────────────────────────────────────────────
  431. DO CASE
  432.    CASE beg_row < 0 .or. beg_row > 23
  433.       RETURN NIL
  434.    CASE beg_col < 0 .or. beg_col > 77
  435.       RETURN NIL
  436.    CASE end_row < 2 .or. end_row > 23
  437.       RETURN NIL
  438.    CASE end_col < 0 .or. end_col > 77
  439.       RETURN NIL
  440. ENDCASE
  441.  
  442. origcolor := SETCOLOR()
  443.  
  444. //───────────────────────────────────────────────────────────────
  445. // Spec out the box type. Default is type 1 or a single line box
  446. //───────────────────────────────────────────────────────────────
  447. DO CASE
  448. CASE b_type == 1
  449.    mboxer := "┌─┐│┘─└│"
  450. CASE b_type == NIL
  451.    mboxer := "┌─┐│┘─└│"
  452. CASE b_type == 2
  453.    mboxer := "╔═╗║╝═╚║ "
  454. CASE b_type == 3
  455.    mboxer := "╒═╕│╛═╘│ "
  456. CASE b_type == 4
  457.    mboxer := "╓─╖║╜─╙║ "
  458. CASE b_type == 5
  459.    mboxer := "█▀███▄██ ████"
  460. CASE b_type == 6
  461.    mboxer := "             "
  462. OTHERWISE
  463.    mboxer := "┌─┐│┘─└│"
  464. ENDCASE
  465.  
  466. //───────────────────────────────────────────────────────────────
  467. // Create a transparent shadow by replacing every other char within the
  468. // savescreen memvars with CHR(07) [ white on black ] for both the
  469. // vertical and horizontal axis.  REPLACED the loop with REPLICATE()
  470. // and TRANSFORM() 03/91
  471. //───────────────────────────────────────────────────────────────
  472. //   Save and transform the Right Vertical axis
  473. //───────────────────────────────────────────────────────────────
  474.  
  475. vert := SAVESCREEN(beg_row+1, end_col+1, end_row+1, end_col+2)
  476. v    := TRANSFORM(vert, REPLICATE("X"+CHR(07), LEN(vert)))
  477.  
  478. //───────────────────────────────────────────────────────────────
  479. //   Save and transform the Bottom horizontal axis
  480. //───────────────────────────────────────────────────────────────
  481.  
  482. horiz := SAVESCREEN(end_row+1, beg_col+2, end_row+1, end_col+2)
  483. h     := TRANSFORM(horiz, REPLICATE("X"+CHR(07), LEN(horiz)))
  484.  
  485. //───────────────────────────────────────────────────────────────
  486. // restore the screen with the vertical and horizontal axis (memvar)
  487. // changed for white on black
  488. //───────────────────────────────────────────────────────────────
  489. RESTSCREEN(beg_row+1, end_col+1, end_row+1, end_col+2, v)
  490. RESTSCREEN(end_row+1, beg_col+2, end_row+1, end_col+2, h)
  491.  
  492. //─────────────────────────
  493. // do da box
  494. //─────────────────────────
  495. IF color != NIL
  496.   SETCOLOR(color)
  497. ENDI
  498.  
  499. @ (beg_row), (beg_col), (end_row), (end_col)  BOX "         "
  500. @ (beg_row), (beg_col), (end_row), (end_col)  BOX mboxer
  501.  
  502. SETCOLOR(origcolor)
  503.  
  504. RETURN NIL
  505.  
  506. //──────────────────────────────────────────────────────────────────
  507. //  Function  O_error()
  508. //
  509. //  By Ted Long
  510. //──────────────────────────────────────────────────────────────────
  511. STATIC FUNCTION o_error( Amessage, color, whatline, defaultval, boxtype )
  512. //──────────────────────────────────────────────────────────────────
  513. local width, oldcolor, oldscreen, thecolor, choice, retval, i, a
  514. local maxlength
  515.  
  516. oldcolor  := setcolor()
  517.  
  518. if( iscolor(), thecolor := "+W/R,+W/N", thecolor := "w/n" )
  519. if( !empty(color), thecolor := color,  )
  520. if( whatline == nil, whatline  := 10,  )
  521. if( defaultval == nil,  defaultval := .T., )
  522. if( defaultval == nil,  defaultval := .T., )
  523. if( boxtype == nil,  boxtype := 1, )
  524.  
  525. if valtype( Amessage ) == "C"
  526.   Amessage  := { alltrim( Amessage ) }
  527. endi
  528.  
  529. // Determine the maximum length element of the array
  530. a         := 1
  531. maxlength := 1
  532.  
  533. for i = 1 to len( Amessage )
  534.   a := max( len( Amessage[ i ]), maxlength )
  535.   maxlength := a
  536. next
  537.  
  538. width     := int(max(74 - maxlength, 0)) / 2
  539. oldscreen := savescreen(whatline, width, whatline + maxlength + 4 , 82 - width)
  540.  
  541. setcolor(thecolor)
  542.  
  543. TONE(200,2)
  544.  
  545. RS_BOX(whatline, width, whatline + len( Amessage ) + 3, 80 - width, boxtype )
  546.  
  547. for i = 1 to len( Amessage )
  548.   centr(whatline + i, Amessage[i] )
  549. next
  550.  
  551. centr(whatline + len( aMessage ) + 2,"** Press any key **")
  552. inkey(0)
  553.  
  554. restscreen(whatline, width, whatline + maxlength + 4 , 82 - width, oldscreen)
  555. setcolor(oldcolor)
  556.  
  557. return( retval )
  558.  
  559. //───────────────────────────────────────────────────────────────
  560. //       Function: CENTR()
  561. //
  562. //       By Ted Long
  563. //
  564. //       usage: CENTR(5,"character string")
  565. //       What it does: centers a char string on the screen.
  566. //       Starting at the specific line number
  567. //───────────────────────────────────────────────────────────────
  568. STATIC FUNCTION CENTR(disp_row, m_string, cColor)
  569. //───────────────────────────────────────────────────────────────
  570. LOCAL length, beg, dacolor
  571.  
  572. if(cColor == NIL, dacolor := setcolor(), dacolor := cColor)
  573.  
  574. length := ROUND(LEN(ALLTRIM(m_string)),0)
  575.  
  576. beg := ROUND((80-length)/2,0)-2
  577. @ disp_row,(beg +2) SAY ALLTRIM(m_string) COLOR dacolor
  578.  
  579. RETURN NIL
  580.