home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PCBOARD / TAPEFLAG.ZIP / TAPEFLAG.PPS < prev    next >
Text File  |  1994-03-05  |  21KB  |  612 lines
  1. ;******************************************************************************
  2. ;  TAPEFLAG.PPE version 1.0 released on 3/5/94 by Steve Prater
  3. ;
  4. ; TAPEFLAG.PPE is a replacement for PCBoard's internal "more?" prompt, gives
  5. ; PCBoard v15.1 the easiest-to-use system for flagging and viewing files of
  6. ; any BBS around.  It gives callers the ability to point and shoot when
  7. ; flagging or viewing files.  It now gives you the ability to restore files
  8. ; from a tape drive.
  9. ;
  10. ; This PPE is a modification to David Terry's FLAG.PPE v3.0 and is distributed
  11. ; along with the original code in accordance with the requirements set forth
  12. ; in David Terry's FLAG.PPE v 3.0 documentation.
  13. ;******************************************************************************
  14.  
  15. ' check to see if caller has ANSI capabilities and, if not, display the old
  16. ' prompt and exit - let PCBoard handle the input.
  17.  
  18. ;***********************************************************************
  19.  
  20. IF (! ANSION()) THEN
  21.   DISPFILE PPEPATH()+"FLAGOLD",LANG
  22.   END
  23. ENDIF
  24.  
  25. BOOLEAN exitflag       ' Flag to determine when we should exit
  26. BOOLEAN rip            ' Flag to indicate RIPscrip is in use
  27.  
  28. STRING  text           ' The text that the caller types
  29. STRING  key            ' Keystroke text
  30. STRING  tape           ' drive and path to tape restore software
  31. STRING  restoreline    ' Command line used with tape restore software
  32.                        ' read from .CFG file
  33. STRING  restoreline1   ' command line passed to tape software
  34. STRING  restoredir     ' Directory to restore files to
  35. STRING  RestoreCMD     ' command to make tape operate in restore mode
  36. STRING  volnum         ' tape volume number
  37. STRING  ppepath        ' path to PPE file
  38. STRING  rc             ' Stores return code from shell function
  39.  
  40. STRING  BS             ' An ASCII backspace character
  41. STRING  BS2            ' An ASCII backspace character
  42. STRING  CR             ' An ASCII carriage return character
  43. STRING  ESC            ' An ASCII esc character
  44.  
  45. BYTE    len            ' Length of the text the caller has typed
  46. BYTE    oldy           ' Last row position of cursor
  47. BYTE    newy           ' New row position of cursor
  48. BYTE    filedir        ' File directory of files being scanned
  49.  
  50. STRING  filenames(23)  ' The names of the files found on the screen
  51. STRING  filename       ' The name of the file that is being processed
  52. STRING  fileimage      ' Includes the color codes for restoration of text
  53. STRING  warningfile    ' full path and file name of lenth of time to restore
  54.                        ' warning file.
  55. STRING  nodeloc        ' hold path & filename of node.loc file
  56. STRING  tapeconf       ' sysop's tape specific conference number
  57. STRING  dirnum         ' File directory in use
  58. STRING  ansiline       ' individual line read from WARNINGFILE
  59. STRING  multinode      ' Y or N for allow multiple node access
  60. STRING  allowednode    ' node # allowed if not multiple node
  61.  
  62. INTEGER curconf        ' Current Conference user is in
  63. INTEGER n              ' integer used for counting reps in loops
  64. ;***********************************************************************
  65.  
  66. ; Initializations
  67.  
  68. BS     = CHR(8)   ' Backspace Key
  69. BS2    = CHR(127) ' Alternate Backspace Key
  70. CR     = CHR(13)  ' Carriage Return
  71. ESC    = CHR(27)  ' ESC character
  72. len    = 0        ' Initialize to 0 bytes in the input buffer
  73. text   = ""       ' Initialize to an empty input buffer
  74.  
  75. ;***********************************************************************
  76.  
  77. ; Main Program
  78.                              ' Open and read configuation file
  79. GOSUB config:
  80.  
  81. :MAIN
  82.                              ' in case the last invocation of flag.ppe saved
  83. RESTSCRN                     ' the screen, restore it now
  84.  
  85. CLREOL                       ' clear the line for input
  86. GOSUB displayprompt          ' display the new prompt
  87. GOSUB scanforfiles           ' build filenames array
  88.  
  89. ' While the user hasn't exited, get keystrokes and act on them.
  90. ' Exiting will occur when the caller presses ENTER.
  91.  
  92. WHILE (!exitflag) DO
  93.  
  94.   key = INKEY()  ' Get a keypress from the user
  95.  
  96.   if (key <> "") THEN  ' If the user pressed a key, then let's process it
  97.  
  98.     ' If it is the FIRST keystroke, signified by the buffer having 0 bytes
  99.     ' in it, then check to see if it is a SPACE.  If so, then we'll go into
  100.     ' MARK mode.  If not, then we'll process the keystrokes the same way that
  101.     ' PCBoard would .. gathering them up into a buffer.  Once the ENTER key
  102.     ' is pressed, we'll exit out and stuff PCBoard's keyboard buffer with the
  103.     ' keystrokes that were collected.
  104.  
  105.     IF (len = 0 & key = " ") THEN
  106.       oldy = GETY()
  107.       newy = 0
  108.  
  109.       PRINT CR
  110.       CLREOL
  111.       PRINT CR
  112.       CLREOL
  113.       PRINT ESC+"[s"  ' save the current cursor position
  114.  
  115.       ' Let the caller know what he can do while in MARK mode
  116.       DISPFILE PPEPATH()+"FLAGBAR",GRAPH+LANG
  117.  
  118.       ' Move the cursor back to the first column
  119.       PRINT CR
  120.  
  121.       ' Find the first filename on the screen.
  122.       GOSUB findfile
  123.  
  124.       ' If a filename was found, then findfile highlighted it.  Now wait for
  125.       ' another keystroke to see if the user whats to mark this one, or move
  126.       ' on to another one, or exit out.  Marking is done by pressing ENTER,
  127.       ' moving to another file is done by pressing SPACE, viewing the file is
  128.       ' done by pressing "V", and exiting is done by pressing ESC.
  129.  
  130.       IF (filename <> "") THEN
  131.         WHILE (key != ESC & key != CR & UPPER(key) != "V") DO
  132.           key = INKEY()
  133.  
  134.           ' If the key pressed was a SPACE then the user has decided to skip
  135.           ' over that file.  So unhighlight it, then try to find another
  136.           ' file.  If a file is found, we'll stay in this loop.  If one is
  137.           ' not found, then we'll restore the original prompt and go back to
  138.           ' waiting for keystrokes in case the caller wants to start over
  139.           ' (marking files) or wants to manually (F)lag them instead.
  140.  
  141.           IF (key = " ") THEN
  142.             GOSUB unhighlight
  143.             GOSUB findfile
  144.             IF (filename = "") THEN
  145.               GOSUB restorecursor
  146.               GOSUB displayprompt
  147.               GOTO  bottom
  148.             ENDIF
  149.           ENDIF
  150.         ENDWHILE
  151.  
  152.         ' If we've gotten this far, then ESC, CR or V was pressed.  We'll
  153.         ' unhighlight the file, restore the prompt and then, if CR was pressed,
  154.         ' meaning the user wished to MARK that file, then will stuff PCBoard's
  155.         ' keyboard buffer with a FLAG command and the name of the file to flag.
  156.         ' If V was pressed, then we'll instead stuff the buffer with a command
  157.         ' to VIEW the file.
  158.  
  159.         GOSUB unhighlight
  160.         GOSUB restorecursor
  161.  
  162.         IF (key = CR) THEN
  163.  
  164.      'This subroutine checks the current conf. and restores the file 
  165.      'from tape if the user is in the tape specific conference, or
  166.      'else reads it in directly from the hard disk if the user is in 
  167.      'any other conference.
  168.      
  169.             GOSUB restorefromtape  
  170.      
  171.         ELSEIF (UPPER(key) = "V") THEN
  172.           ' save the screen into PCBoard's memory so that we can restore it
  173.           ' when FLAG.PPE is called up again, then issue the view command
  174.           SAVESCRN
  175.           KBDSTUFF "V "+filename+CR
  176.           END
  177.         ENDIF
  178.       ELSE
  179.         GOSUB restorecursor
  180.       ENDIF
  181.  
  182.       GOSUB displayprompt
  183.       CONTINUE
  184.  
  185.     ELSEIF (key == BS | key == BS2) THEN
  186.  
  187.       ' If the caller pressed backspace or delete, then delete the character
  188.       ' to the left, and remove it from the input buffer.  Of course, if the
  189.       ' caller hasn't typed anything yet, or if the caller has already
  190.       ' backspaced everything out, signified by the len being 0 (meaning there
  191.       ' are 0 bytes in the buffer), then we'll just loop back around waiting
  192.       ' for more keystrokes
  193.  
  194.       IF (len > 0) THEN
  195.         PRINT BS+" "
  196.         len  = len - 1
  197.         text = LEFT(text,len)
  198.       ELSE
  199.         CONTINUE
  200.       ENDIF
  201.  
  202.     ELSEIF (key == CR) THEN
  203.  
  204.       ' If it's a carriage return then set the flag to exit
  205.       exitflag = TRUE
  206.  
  207.     ELSEIF (LEN(key) > 1 | key < " ") THEN
  208.  
  209.       ' Special keys, such as UP, DOWN, etc, return multi-letter values such
  210.       ' as "UP" and "DOWN" when the INKEY() function is called.  Since we just
  211.       ' want to ignore special characters, we'll use the CONTINUE statement to
  212.       ' jump back to the top of the loop
  213.       '
  214.       ' We also want to avoid displaying "control characters" so anything
  215.       ' less than a SPACE should also be skipped.
  216.  
  217.       CONTINUE
  218.  
  219.     ELSEIF ((len = 0) & ((key = "?") | (UPPER(key) = "H"))) THEN
  220.  
  221.       ' If the user typed "?" or "H" then we want to display a help file.
  222.       ' First we'll save the current screen, then display the help file, and
  223.       ' then restore the saved screen after the caller has read the help file.
  224.  
  225.       SAVESCRN
  226.       NEWLINE
  227.       DISPFILE PPEPATH()+"FLAGHLP",GRAPH+LANG
  228.       NEWLINE
  229.       WAIT
  230.       RESTSCRN
  231.       CONTINUE
  232.  
  233.     ELSEIF ((key >= " ") & (len < 80)) THEN
  234.  
  235.       ' Here we are just gathering up keystrokes and putting them into an
  236.       ' input buffer.  As long as the keystrokes are greater than or equal to
  237.       ' a SPACE we'll just add them in until a limit of 80 characters is
  238.       ' reached.  PCBoard won't let you type more than 80 characters at that
  239.       ' prompt anyway so we might as well keep the same limit.
  240.  
  241.       text = text + key
  242.       len  = len + 1
  243.  
  244.     ENDIF
  245.  
  246.     PRINT key    ' Print any keystrokes the caller types
  247.   ENDIF
  248.  
  249. :bottom
  250. ENDWHILE
  251.  
  252. ' If we've gotten this far, then the caller has pressed ENTER so we'll stuff
  253. ' whatever the caller has typed into PCBoard's input buffer and let PCBoard
  254. ' process the request.
  255. '
  256. ' But first, if the command begins with V then it may be a view files command.
  257. ' Verify that assumption by checking to see if the user typed "V" and pressed
  258. ' ENTER (check length equal to 1) or if the user typed "V filename" (check
  259. ' for length greater than or equal to 3 for "F f")
  260.  
  261. text = RTRIM(text," ")
  262.  
  263. IF (UPPER(LEFT(text,1)) = "V") THEN
  264.   IF (LEN(text) = 1) THEN
  265.     CLREOL
  266.     filename = ""
  267.     PROMPTSTR 240,filename,12,MASK_FILE(),FIELDLEN
  268.     filename = RTRIM(filename," ");
  269.     IF (LEN(filename) = 0) THEN
  270.       CLREOL
  271.       KBDSTUFF CR
  272.       END
  273.     ENDIF
  274.     NEWLINE
  275.  
  276.     ' the lines below could be used to specify a different "default extension"
  277.     ' for archive files in different conferences - uncomment and adapt as
  278.     ' necessary to suit your needs
  279.     '
  280.     ' IF (INSTR(filename,".") = 0) THEN
  281.     '   IF (CURCONF() = 30) THEN
  282.     '     filename = filename + ".ARJ"
  283.     '   ELSEIF (CURCONF() = 50) THEN
  284.     '     filename = filename + ".ZOO"
  285.     '   ENDIF
  286.     ' ENDIF
  287.  
  288.     text = "V "+filename
  289.     ' save the screen to PCBoard's memory so that the next invocation of
  290.     ' FLAG.PPE will restore the screen
  291.     SAVESCRN
  292.   ELSEIF (LEN(text) >= 3) THEN
  293.     ' save the screen to PCBoard's memory so that the next invocation of
  294.     ' FLAG.PPE will restore the screen
  295.     CLREOL
  296.  
  297.     ' the lines below could be used to specify a different "default extension"
  298.     ' for archive files in different conferences - uncomment and adapt as
  299.     ' necessary to suit your needs
  300.     '
  301.     ' IF (INSTR(filename,".") = 0) THEN
  302.     '   IF (CURCONF() = 30) THEN
  303.     '     text = text + ".ARJ"
  304.     '   ELSEIF (CURCONF() = 50) THEN
  305.     '     text = text + ".ZOO"
  306.     '   ENDIF
  307.     ' ENDIF
  308.  
  309.     SAVESCRN
  310.   ELSE
  311.     KBDSTUFF CR
  312.     END
  313.   ENDIF
  314. ENDIF
  315.  
  316. KBDSTUFF text+CR
  317. END
  318.  
  319.  
  320. ;***********************************************************************
  321. '
  322. ' This subroutine restores the cursor position.  It does this using an ANSI
  323. ' command that simply restores a previously saved cursor position.  In
  324. ' addition, we'll clear the line before returning.
  325.  
  326. :restorecursor
  327. PRINT ESC+"[u"
  328. CLREOL
  329. RETURN
  330.  
  331.  
  332. ;***********************************************************************
  333. '
  334. ' This is a subroutine that displays the new prompt and then sets the color to
  335. ' the default for input.
  336.  
  337. :displayprompt
  338. DISPFILE PPEPATH()+"FLAGNEW",LANG
  339. DEFCOLOR
  340. RETURN
  341.  
  342.  
  343. ;***********************************************************************
  344. '
  345. ' This is a subroutine that checks the filenames() array to locate the next
  346. ' file on screen.  If RIPscrip is used, then special commands (which are
  347. ' passed via a mouse-click from the caller's terminal, are used to identify
  348. ' which file is desired.
  349. '
  350. ' If a valid filename is found, it is stored in a variable called filename.
  351. ' Also, it calls another subroutine to highlight the filename on the screen.
  352.  
  353. :findfile
  354. IF (rip) THEN
  355.   newy = 0
  356.   key = ""
  357.   WHILE (newy = 0) DO
  358.     key = INKEY()      ' watch for the next character
  359.     newy = ASC(key)
  360.     IF (newy >= 129 & newy <= 151) THEN
  361.       newy = newy - 128
  362.       IF (filenames(newy) <> "") THEN
  363.         GOSUB highlight
  364.         filename = filenames(newy)
  365.         RETURN
  366.       ELSE
  367.         newy = 0
  368.       ENDIF
  369.     ENDIF
  370.   ENDWHILE
  371. ELSE
  372.   WHILE (newy < oldy) DO
  373.     newy = newy + 1
  374.     IF (filenames(newy) <> "") THEN
  375.       GOSUB highlight
  376.       filename = filenames(newy)
  377.       RETURN
  378.     ENDIF
  379.   ENDWHILE
  380. ENDIF
  381.  
  382. ' no valid filename was found, return with an empty filename
  383. filename = ""
  384. RETURN
  385.  
  386.  
  387. ;***********************************************************************
  388. '
  389. ' This is a subroutine that highlights the filename moving the cursor to the
  390. ' correct line and then changing the color to black on white and printing the
  391. ' filename.  Prior to highlighting the filename, it saves a color image of the
  392. ' filename so that, when it comes time to unhighlight the file, the image can
  393. ' be restored.
  394.  
  395. :highlight
  396. ' move the cursor back to where it started, at the bottom, and then move
  397. ' it up to the appropriate line on the screen.
  398. PRINT ESC+"[u"+ESC+"["+STRING(oldy-newy)+"A"
  399.  
  400. ' get the file image (text & attributes) for later restoration
  401. fileimage = SCRTEXT(1,newy,13,TRUE)
  402.  
  403. ' then highlight the filename and return
  404. COLOR @X70
  405. PRINT filenames(newy)+CR
  406. RETURN
  407.  
  408.  
  409. ;***********************************************************************
  410. '
  411. ' This is a subroutine that unhighlights the filename by printing the file
  412. ' image, which includes color codes as well as the filename.
  413.  
  414. :unhighlight
  415. PRINT fileimage+CR
  416. RETURN
  417.  
  418.  
  419. ;***********************************************************************
  420. '
  421. ' This subroutine scans the screen at startup to see and fills an array called
  422. ' filenames() with the names of all files found on screen.  If RIPscrip is in
  423. ' use, it will also send out RIPscrip commands to define the location of the
  424. ' filenames on screen so that the caller can use a mouse to point and click.
  425.  
  426. :scanforfiles
  427. IF (GRAFMODE() = "R") THEN
  428.   rip = TRUE
  429. ENDIF
  430.  
  431. ' NOTE:  This loop is unnecessary because PPL automatically initializes
  432. '        all array elements to 0 or blank
  433. '
  434. ' FOR newy=1 TO 23
  435. '   filenames(newy) = ""   ' initialize the array elements
  436. ' NEXT
  437.  
  438. newy = 1
  439. WHILE (newy > 0) DO
  440.   ' get a filename off the screen ... if a filename is found, the filename
  441.   ' variable will be updated, if no more filenames are found, newy will be
  442.   ' set to 0.
  443.   SCRFILE newy, filename
  444.  
  445.   IF (newy <> 0) THEN
  446.     ' store the filename that was found into an array
  447.     filenames(newy) = filename
  448.  
  449.     ' If in RIPscrip mode, define the mouse region where the filename is
  450.     ' located.  The coordinates are defined in X,Y coordinates of 0,newy and
  451.     ' 13,newy+1.  The X coordinate (0 to 13) defines the length of the name.
  452.     ' The Y coordinate (newy to newy+1) defines the height of the name.
  453.     ' An 8x8 font is assumed.  The CHR(newy+128) is a "command" that we will
  454.     ' be using to communicate back to FLAG.PPE the position of the file being
  455.     ' selected via mouse click.
  456.     IF (rip) THEN
  457.       MOUSEREG 0,1,newy,13,newy+1,8,8,TRUE,FALSE," "+CHR(newy+128)
  458.     ENDIF
  459.     INC newy
  460.   ENDIF
  461. ENDWHILE
  462.  
  463. ' finish up the mouse region definitions
  464. IF (rip) THEN
  465.   MPRINT "!|#|#|#"+CR+chr(10)
  466. ENDIF
  467. RETURN
  468.  
  469. ;***********************************************************************
  470. ;
  471. ;   This subroutine restores the tagged file from tape if the user
  472. ;   is currently located in conference #1           
  473.  
  474. :restorefromtape
  475. let dirnum =" "
  476. SAVESCRN                           ' save screen so we can restore it 
  477.                                    ' after displaying warning file
  478. IF (CURCONF() = tapeconf) THEN     ' if user is in the tape conference then
  479.                                    ' goto the tape restore mode or else goto
  480.                                    ' the regular FLAG mode
  481.     inputtext "What directory Number are you looking at @X09(1-18)@X07",dirnum,@X07,2
  482.     PRINT CR
  483.     CLREOL
  484.     GOSUB CHECKNODE                '  see if multinode access is allowed.
  485.     GOSUB LOCKNODE                 ' see if tape drive is already in use
  486.                                    ' Now OPEN and dsiplay the time warning file
  487.     FOPEN 2, warningfile(),O_RD,S_DN
  488.         IF (FERR(2)) then
  489.             PRINTLN "Error....Exiting...."
  490.             END
  491.         ENDIF
  492.         let n = 1
  493.         FGET 2, ansiline
  494.         println ansiline
  495.         while (!FERR(2)) do
  496.            inc n
  497.            FGET 2, ansiline
  498.            println ansiline
  499.         endwhile
  500.     Fclose 2
  501.     
  502.     let nodeloc = ppepath()+"node.loc"
  503.     FCREATE 2, nodeloc,O_WR,S_DB
  504.       fput 2, "Tape drive locked!  Restoring File "+filename+"."
  505.     fclose 2
  506.         if (dirnum() < 10) then
  507.             LET restoreline1=" "+restorecmd+" "+restoreline+dirnum+"A\"+filename+" "+restoredir+" /v="+volnum
  508.         elseif (dirnum() > 9) then
  509.             let restoreline=left(restoreline(), len(restoreline) - 1)
  510.             LET restoreline1=" "+restorecmd+" "+restoreline+dirnum+"A\"+filename+" "+restoredir+" /v="+volnum
  511.         elseif (dirnum() > 99) then
  512.             let restoreline=left(restoreline(), len(restoreline) - 2)
  513.             LET restoreline1=" "+restorecmd+" "+restoreline+dirnum+"A\"+filename+" "+restoredir+" /v="+volnum
  514.         endif        
  515.     shell false,rc,tape,restoreline1
  516.     delete nodeloc
  517.             RESTSCRN
  518.     PRINT CR
  519.     CLREOL
  520.     KBDSTUFF "F "+filename+CR
  521. ELSEIF (CURCONF() <> 1) THEN
  522.     KBDSTUFF "F "+filename+CR
  523. ENDIF
  524. return
  525.  
  526. ;***********************************************************************
  527. ;    This routine opens and reads the FLAG1.CFG file
  528. ;  
  529. ;
  530. :CONFIG
  531. ;
  532. let n() = 0
  533. FOPEN 1, ppepath()+PPEname()+".CFG",O_RD,S_DN
  534.    IF (FERR(1)) then
  535.       PRINTLN "Error....Exiting...."
  536.       END
  537.    ENDIF
  538.    let n() = N + 1
  539.    FGET 1, dirnum
  540.    let n() = N + 1
  541.    FGET 1, tape
  542.    let n() = N+1
  543.    FGET 1, restorecmd
  544.    let n() = N+1
  545.    FGET 1, restoreline
  546.    let n() = N+1
  547.    FGET 1, restoredir
  548.    let n() = N+1
  549.    FGET 1, volnum
  550.    let n() = N+1
  551.    FGET 1, warningfile
  552.    let n() = N+1
  553.    FGET 1, tapeconf
  554.    let n() = N+1
  555.    FGET 1, multinode
  556.    let n() = N+1
  557.    FGET 1, allowednode
  558.    FcLOSE 1
  559. RETURN
  560.  
  561. *****************************************************************************
  562. '   
  563. :locknode
  564. '
  565. '  This routine checks to see if the tape drive is in use by another node.
  566. '  If so, it displays the locked node message.
  567. '
  568. '
  569. if (exist(ppepath()+"node.loc")) then
  570.     Println "@CLS@@X00@X07"
  571.     Println "@X0F                @X47╔══════════════════════════════════════════════╗"
  572.     Println "@X0F                @X47║  Sorry, the tape drive is in use by another  ║"
  573.     Println "@X0F                @X47║  node.  Please try again later!     Thanks!  ║"
  574.     Println "@X0F                @X47╚══════════════════════════════════════════════╝"
  575.     println "@XFF "
  576.     println
  577.     wait
  578.     goto MAIN
  579. endif
  580. return
  581. '
  582. *****************************************************************************
  583. '   
  584. :checknode
  585. '
  586. '  This routine checks to see if multinode access is allowed.  If not, it 
  587. '  determines what node is allowed access.
  588. '
  589. '
  590. 'if multinode =  "Y" then
  591. if (multinode = "Y") then
  592. '    n = 1                'This is just because it HAD to evaluate something
  593.     return
  594. endif
  595.  
  596. if (PCBNODE() = allowednode) then
  597. '    n=1                 'This is just because it HAD to evaluate something
  598.     return
  599.  elseif (PCBNODE() <> allowednode) then
  600. '    n=1                 'This is just because it HAD to evaluate something
  601.      Println "@CLS@@X00@X07"
  602.     Println "@X0F              @X47                                                   "
  603.     Println "@X0F              @X47   Sorry, You must call back on node "+Allowednode+" to restore  "
  604.     Println "@X0F              @X47   files from tape!                   Thanks!      "
  605.     Println "@X0F              @X47                                                   "
  606.     println "@XFF "
  607.     println
  608.     wait
  609.     goto MAIN
  610. endif
  611. return
  612.