home *** CD-ROM | disk | FTP | other *** search
/ Carsten's PPE Collection / Carstens_PPE_Collection_2007.zip / F / FLAG22.ZIP / FLAG2.PPS < prev    next >
Text File  |  1993-09-28  |  13KB  |  350 lines
  1. ;******************************************************************************
  2. ;  FLAG2.PPE version 2.1 released on 9/22/93 by David W. Terry
  3. ;
  4. ; FLAG2.PPE is nearly identical to FLAG.PPE except that it is used to replace
  5. ; the "File List Command" prompt instead of the "more?" prompt.
  6. ;
  7. ; NOTE:  Please DO NOT DISTRIBUTE modified source code without prior permission
  8. ; or without meeting the requirements set forth in FLAG.DOC.
  9. ;******************************************************************************
  10.  
  11. BOOLEAN exitflag ' Flag to determine when we should exit
  12.  
  13. STRING  text     ' The text that the caller types
  14. STRING  key      ' Keystroke text
  15.  
  16. STRING  BS       ' An ASCII backspace character
  17. STRING  BS2      ' An ASCII backspace character
  18. STRING  CR       ' An ASCII carriage return character
  19. STRING  ESC      ' An ASCII esc character
  20.  
  21. INTEGER len      ' Length of the text the caller has typed
  22. INTEGER oldx     ' Last column position of cursor
  23. INTEGER oldy     ' Last row position of cursor
  24. INTEGER newy     ' New row position of cursor
  25. INTEGER upcount  ' A count of the number of lines to move up
  26.  
  27. STRING  filename ' The name of the file that is being flagged
  28. STRING  savetext ' A saved copy - including color codes for restoration
  29. STRING  nprompt  ' The new prompt to be displayed to the caller
  30. STRING  oprompt  ' The original prompt that was used in PCBTEXT
  31.  
  32. INTEGER dotpos   ' Used when validating filenames
  33. INTEGER filelen  ' Used when validating filenames
  34. INTEGER filesize ' Used when validating filenames
  35. DATE    filedate ' Used when validating filenames
  36.  
  37.  
  38. ;***********************************************************************
  39.  
  40. ; Initializations
  41.  
  42. BS     = CHR(8)   ' Backspace Key
  43. BS2    = CHR(127) ' Alternate Backspace Key
  44. CR     = CHR(13)  ' Carriage Return
  45. ESC    = CHR(27)  ' ESC character
  46. len    = 0        ' Initialize to 0 bytes in the input buffer
  47. text   = ""       ' Initialize to an empty input buffer
  48.  
  49. ' Below is the prompt we are going to show the caller.  There are basically
  50. ' two differences between it and the standard prompt:
  51. '
  52. ' 1) It uses @minleft@ instead of @timeleft@.  The reason is that @minleft@
  53. '    shows the caller how many minutes are left AFTER deducting the time
  54. '    estimated for any files currently flagged for download.
  55. ' 2) It removes the (F)lag option, although it will still work (!), and
  56. '    replaces it with (SPACE)=Mark instead.
  57.  
  58. nprompt = "@X0E(H)elp, (1-@NUMDIR@), (@X0FSPACE@X0E)=Mark, File List Command? "
  59. oprompt = "@X0E(H)elp, (1-@NUMDIR@), File List Command"
  60.  
  61. ;***********************************************************************
  62.  
  63. ; Main Program
  64.  
  65. IF (! ANSION()) THEN    ' check to see if caller has ANSI capabilities
  66.   PRINT oprompt         ' if not, display the old prompt and then just
  67.   END                   ' get out and let PCBoard handle the input.
  68. ENDIF
  69.  
  70.                         ' in case the last invocation of flag.ppe saved
  71. RESTSCRN                ' the screen, restore it now
  72.  
  73. CLREOL                  ' clear the current line
  74. PRINT nprompt           ' display the prompt
  75. DEFCOLOR                ' set the default color for user input
  76.  
  77. ' While the user hasn't exited, get keystrokes and act on them.
  78. ' Exiting will occur when the caller presses ENTER.
  79.  
  80. WHILE (!exitflag) DO
  81.  
  82.   key = INKEY()  ' Get a keypress from the user
  83.  
  84.   if (key <> "") THEN  ' If the user pressed a key, then let's process it
  85.  
  86.     ' If it is the FIRST keystroke, signified by the buffer having 0 bytes
  87.     ' in it, then check to see if it is a SPACE.  If so, then we'll go into
  88.     ' MARK mode.  If not, then we'll process the keystrokes the same way that
  89.     ' PCBoard would .. gathering them up into a buffer.  Once the ENTER key
  90.     ' is pressed, we'll exit out and stuff PCBoard's keyboard buffer with the
  91.     ' keystrokes that were collected.
  92.  
  93.     IF (len = 0 & key = " ") THEN
  94.       oldx = getx()
  95.       oldy = gety()
  96.       newy = oldy
  97.  
  98.       ' Let the caller know what he can do while in MARK mode
  99.  
  100.       PRINT CR+"@CLREOL@@X0APress @X0FSPACE@X0A to move up, @X0FENTER@X0A to select, @X0FV@X0A to view, @X0FESC@X0A to exit"+CR
  101.  
  102.       ' Try to find a filename on the screen.  If a filename is found, it
  103.       ' will be signified by the filename being non-blank.
  104.  
  105.       GOSUB findfile
  106.  
  107.       ' If a filename was found, then findfile highlighted it, let's wait for
  108.       ' another keystroke to see if the user whats to mark this one, or move
  109.       ' on to another one, or exit out.  Marking is done by pressing ENTER,
  110.       ' moving to another file is done by pressing SPACE, viewing the file is
  111.       ' done by pressing "V", and exiting is done by pressing ESC.
  112.  
  113.       IF (filename <> "") THEN
  114.         WHILE (key != ESC & key != CR & UPPER(key) != "V") DO
  115.           key = INKEY()
  116.  
  117.           ' If the key pressed was a SPACE then the user has decided to skip
  118.           ' over that file.  So unhighlight it, then try to find another
  119.           ' file.  If a file is found, we'll stay in this loop.  If one is
  120.           ' not found, then we'll restore the original prompt and go back to
  121.           ' waiting for keystrokes in case the caller wants to start over
  122.           ' (marking files) or wants to manually (F)lag them instead.
  123.  
  124.           IF (key = " ") THEN
  125.             GOSUB unhighlight
  126.             GOSUB findfile
  127.             IF (filename = "") THEN
  128.               GOSUB restorecursor
  129.               GOSUB restoreline
  130.               GOTO bottom
  131.             ENDIF
  132.           ENDIF
  133.         ENDWHILE
  134.  
  135.         ' If we've gotten this far, then ESC, CR or V was pressed.  We'll
  136.         ' unhighlight the file, restore the prompt and then, if CR was pressed,
  137.         ' meaning the user wished to MARK that file, then will stuff PCBoard's
  138.         ' keyboard buffer with a FLAG command and the name of the file to flag.
  139.         ' If V was pressed, then we'll instead stuff the buffer with a command
  140.         ' to VIEW the file.
  141.  
  142.         GOSUB unhighlight
  143.         GOSUB restorecursor
  144.  
  145.         IF (key = CR) THEN
  146.           KBDSTUFF "F "+filename+CR
  147.           END
  148.         ELSEIF (UPPER(key) = "V") THEN
  149.           ' save the screen into PCBoard's memory so that we can restore it
  150.           ' when FLAG.PPE is called up again, then issue the view command
  151.           SAVESCRN
  152.           KBDSTUFF "V "+filename+CR
  153.           END
  154.         ENDIF
  155.       ELSE
  156.         GOSUB restorecursor
  157.       ENDIF
  158.  
  159.       GOSUB restoreline
  160.       GOTO  bottom
  161.  
  162.     ELSEIF (key == BS | key == BS2) THEN
  163.  
  164.       ' If the caller pressed backspace or delete, then delete the character
  165.       ' to the left, and remove it from the input buffer.  Of course, if the
  166.       ' caller hasn't typed anything yet, or if the caller has already
  167.       ' backspaced everything out, signified by the len being 0 (meaning there
  168.       ' are 0 bytes in the buffer), then we'll just go to the bottom of the
  169.       ' loop and loop back around waiting for more keystrokes.
  170.  
  171.       IF (len > 0) THEN
  172.         PRINT BS+" "
  173.         len  = len - 1
  174.         text = LEFT(text,len)
  175.       ELSE
  176.         GOTO bottom
  177.       ENDIF
  178.  
  179.     ELSEIF (key == CR) THEN
  180.  
  181.       ' If it's a carriage return append it and prepare to exit
  182.       text = text + key
  183.       exitflag = TRUE
  184.  
  185.     ELSEIF (LEN(key) > 1 | key < " ") THEN
  186.  
  187.       ' Special keys, such as UP, DOWN, etc, return multi-letter values such
  188.       ' as "UP" and "DOWN" when the INKEY() function is called.  Since we just
  189.       ' want to ignore special characters, will drop down to the bottom to
  190.       ' avoid adding them into the buffer or printing them on the screen.
  191.       '
  192.       ' We also want to avoid displaying "control characters" so anything
  193.       ' less than a SPACE should also be skipped.
  194.  
  195.       GOTO bottom
  196.  
  197.     ELSEIF ((key >= " ") & (len < 80)) THEN
  198.  
  199.       ' Here we are just gathering up keystrokes and putting them into an
  200.       ' input buffer.  As long as the keystrokes are greater than or equal to
  201.       ' a SPACE we'll just add them in until a limit of 80 characters is
  202.       ' reached.  PCBoard won't let you type more than 80 characters at that
  203.       ' prompt anyway so we might as well keep the same limit.
  204.  
  205.       text = text + key
  206.       len  = len + 1
  207.  
  208.     ENDIF
  209.  
  210.   ' Print any keystrokes the caller types
  211.  
  212.   PRINT key
  213.   ENDIF
  214.  
  215. :bottom
  216. ENDWHILE
  217.  
  218. ' If we've gotten this far, then the caller has pressed ENTER so we'll stuff
  219. ' whatever the caller has typed into PCBoard's input buffer and let PCBoard
  220. ' process the request.
  221. '
  222. ' But first, if the command begins with V then it is a view files command so
  223. ' save the screen to PCBoard's memory so that the next invocation of FLAG.PPE
  224. ' will restore the screen
  225.  
  226. IF (UPPER(LEFT(text,1)) = "V") THEN
  227.   SAVESCRN
  228. ENDIF
  229.  
  230. KBDSTUFF text
  231. END
  232.  
  233. ;***********************************************************************
  234.  
  235. ' This subroutine restores the cursor position.  It does this by moving the
  236. ' cursor DOWN the number of lines that it had been moved UP.  This is
  237. ' determined by subtracting the new cursor position from the old cursor
  238. ' position and then creating an ANSI command to move the cursor down that
  239. ' many lines and then it clears that line.
  240.  
  241. :restorecursor
  242. IF (newy < oldy) THEN
  243.   PRINT ESC+"["+STRING(oldy-newy)+"B"
  244. ENDIF
  245. newy = oldy
  246. CLREOL
  247. RETURN
  248.  
  249. ;***********************************************************************
  250.  
  251. ' This is a subroutine that redisplays the original prompt and then sets the
  252. ' color to the default for input.
  253.  
  254. :restoreline
  255. PRINT nprompt
  256. DEFCOLOR
  257. RETURN
  258.  
  259. ;***********************************************************************
  260.  
  261. ' This is a subroutine that scans the screen buffer by using the SCRTEXT()
  262. ' function to find any valid filenames in the left most column of the screen.
  263. ' It validates filenames by checking to see if the filename is from 1 to 12
  264. ' characters in length, and that, if a period is in the filename, that it does
  265. ' not have an extension longer than 3 characters, if there is not a period,
  266. ' then the main part of the filename cannot be more than 8 characters, also,
  267. ' the filename cannot have a space, a comma, a colon, a backslash, an asterisk,
  268. ' or the greater than or less than (< and >) characters in it.
  269. '
  270. ' This routine will keep moving up the screen until it finds a valid filename
  271. ' and, if one is not found, it will return with the filename variable empty.
  272. '
  273. ' If a valid filename is found, it is stored in a variable called filename.
  274. ' At the same time, it reads the COLORS that are used to highlight the filename
  275. ' as well so that later, when we "unhighlight" the file, we can put it back
  276. ' the way it was found.  Finally, it highlights the filename by printing the
  277. ' name with a black-on-white color attribute and returns.
  278.  
  279. :findfile
  280. IF (newy = 1) THEN
  281.   filename = ""
  282.   RETURN
  283. ENDIF
  284.  
  285. upcount = 0
  286. WHILE (newy >= 1) DO
  287.   newy     = newy - 1
  288.   upcount  = upcount + 1
  289.  
  290.   ' first check for a valid file size to be sure that it is greater than zero
  291.   ' (0 would indicate that it wasn't a valid file or that the file was marked
  292.   ' as OFFLINE or DELETED)
  293.   filesize = TRIM(SCRTEXT(13,newy,11,FALSE), " ")
  294.   if (filesize > 0) THEN
  295.  
  296.     ' The file size is okay, let's check for a valid date.  This is
  297.     ' done by reading the filedate into a DATE variable which PPL will
  298.     ' then convert to a julian value.  If the date was valid, the julian
  299.     ' value will be greater than zero.  Using this method of checking
  300.     ' the date will work no matter what language (and country code) the
  301.     ' caller is using because PPL will automatically take care of the
  302.     ' proper date separators when evaluating the date that is found.
  303.     filedate = SCRTEXT(24,newy,8,FALSE)
  304.     if (filedate > 0) THEN
  305.  
  306.       filename = RTRIM(SCRTEXT(1,newy,13,FALSE)," ")  ' pull the name of the screen
  307.       filelen  = LEN(filename)
  308.  
  309.       ' check for a valid filename
  310.       IF (filelen >= 1 & filelen <= 12) THEN
  311.         IF (! (INSTR(filename," ") | INSTR(filename,",") | INSTR(filename,":") | INSTR(filename,"\") | INSTR(filename,"*") | INSTR(filename,"<") | INSTR(filename,">"))) THEN
  312.           dotpos = INSTR(filename,".")
  313.           IF ((dotpos = 0 & filelen <= 8) | ((filelen - dotpos) <= 3)) THEN
  314.  
  315.             ' the filename is valid, save the colors as well
  316.             savetext = SCRTEXT(1,newy,13,TRUE)
  317.  
  318.             ' move the cursor up where the filename is
  319.             PRINT ESC+"["+STRING(upcount)+"A"
  320.  
  321.             ' then highlight the filename and return
  322.             COLOR @X70
  323.             PRINT filename+CR
  324.             RETURN
  325.           ENDIF
  326.         ENDIF
  327.       ENDIF
  328.     ENDIF
  329.   ENDIF
  330. ENDWHILE
  331.  
  332. ' no valid filename was found, return with an empty filename
  333. filename = ""
  334.  
  335. ' since no filename was found, the cursor did not really move up so we need
  336. ' to add upcount back into the newy variable.
  337. newy = newy + upcount
  338. RETURN
  339.  
  340. ;***********************************************************************
  341.  
  342. ' This is a subroutine that unhighlights the filename by printing the saved
  343. ' text, which includes color codes as well as the filename.
  344.  
  345. :unhighlight
  346. PRINT savetext+CR
  347. RETURN
  348.  
  349. ;***********************************************************************
  350.