home *** CD-ROM | disk | FTP | other *** search
/ Carsten's PPE Collection / Carstens_PPE_Collection_2007.zip / F / FLAG_PPE.ZIP / FLAG.PPS < prev    next >
Text File  |  1993-09-09  |  10KB  |  270 lines
  1. BOOLEAN exitflag ' Flag to determine when we should exit
  2.  
  3. STRING  text     ' The text that the caller types
  4. STRING  key      ' Keystroke text
  5.  
  6. STRING  BS       ' An ASCII backspace character
  7. STRING  BS2      ' An ASCII backspace character
  8. STRING  CR       ' An ASCII carriage return character
  9. STRING  ESC      ' An ASCII esc character
  10.  
  11. INTEGER len      ' Length of the text the caller has typed
  12. INTEGER oldx     ' Last column position of cursor
  13. INTEGER oldy     ' Last row position of cursor
  14. INTEGER newy     ' New row position of cursor
  15.  
  16. STRING  filename ' The name of the file that is being flagged
  17. STRING  savetext ' A saved copy - including color codes for restoration
  18. STRING  prompt   ' The prompt to be displayed to the caller
  19. INTEGER dotpos   ' Used when validating filenames
  20. INTEGER filelen  ' Used when validating filenames
  21.  
  22. ;***********************************************************************
  23.  
  24. ; Initializations
  25.  
  26. BS     = CHR(8)   ' Backspace Key
  27. BS2    = CHR(127) ' Alternate Backspace Key
  28. CR     = CHR(13)  ' Carriage Return
  29. ESC    = CHR(27)  ' ESC character
  30. len    = 0        ' Initialize to 0 bytes in the input buffer
  31. text   = ""       ' Initialize to an empty input buffer
  32.  
  33. ' Below is the prompt we are going to show the caller.  There are basically
  34. ' two differences between it and the standard prompt:
  35. '
  36. ' 1) It uses @minleft@ instead of @timeleft@.  The reason is that @minleft@
  37. '    shows the caller how many minutes are left AFTER deducting the time
  38. '    estimated for any files currently flagged for download.
  39. ' 2) It removes the (F)lag option, although it will still work (!), and
  40. '    replaces it with (SPACE)=Mark instead.
  41.  
  42. prompt = "@X0A(@X0C@MINLEFT@@X0A min left), (H)elp, (V)iew, (@X0FSPACE@X0A)=Mark, More? "
  43.  
  44. ;***********************************************************************
  45.  
  46. ; Main Program
  47.  
  48. PRINT prompt
  49. DEFCOLOR
  50.  
  51. ' While the user hasn't exited, get keystrokes and act on them.
  52. ' Exiting will occur when the caller presses ENTER.
  53.  
  54. WHILE (!exitflag) DO
  55.  
  56.   key = INKEY()  ' Get a keypress from the user
  57.  
  58.   if (key <> "") THEN  ' If the user pressed a key, then let's process it
  59.  
  60.     ' If it is the FIRST keystroke, signified by the buffer having 0 bytes
  61.     ' in it, then check to see if it is a SPACE.  If so, then we'll go into
  62.     ' MARK mode.  If not, then we'll process the keystrokes the same way that
  63.     ' PCBoard would .. gathering them up into a buffer.  Once the ENTER key
  64.     ' is pressed, we'll exit out and stuff PCBoard's keyboard buffer with the
  65.     ' keystrokes that were collected.
  66.  
  67.     IF (len = 0 & key = " ") THEN
  68.       oldx = getx()
  69.       oldy = gety()
  70.       newy = oldy
  71.  
  72.       ' Let the caller know what he can do while in MARK mode
  73.  
  74.       PRINT CR+"@CLREOL@@X0DPress SPACE to move up, ENTER to select, V to view, ESC to exit"+CR
  75.  
  76.       ' Try to find a filename on the screen.  If a filename is found, it
  77.       ' will be signified by the filename being non-blank.
  78.  
  79.       GOSUB findfile
  80.  
  81.       ' If a filename was found, then findfile highlighted it, let's wait for
  82.       ' another keystroke to see if the user whats to mark this one, or move
  83.       ' on to another one, or exit out.  Marking is done by pressing ENTER,
  84.       ' moving to another file is done by pressing SPACE, viewing the file is
  85.       ' done by pressing "V", and exiting is done by pressing ESC.
  86.  
  87.       IF (filename <> "") THEN
  88.         WHILE (key != ESC & key != CR & UPPER(key) != "V") DO
  89.           key = INKEY()
  90.  
  91.           ' If the key pressed was a SPACE then the user has decided to skip
  92.           ' over that file.  So unhighlight it, then try to find another
  93.           ' file.  If a file is found, we'll stay in this loop.  If one is
  94.           ' not found, then we'll restore the original prompt and go back to
  95.           ' waiting for keystrokes in case the caller wants to start over
  96.           ' (marking files) or wants to manually (F)lag them instead.
  97.  
  98.           IF (key = " ") THEN
  99.             GOSUB unhighlight
  100.             GOSUB findfile
  101.             IF (filename = "") THEN
  102.               GOSUB restoreline
  103.               GOTO bottom
  104.             ENDIF
  105.           ENDIF
  106.         ENDWHILE
  107.  
  108.         ' If we've gotten this far, then ESC, CR or V was pressed.  We'll
  109.         ' unhighlight the file, restore the prompt and then, if CR was pressed,
  110.         ' meaning the user wished to MARK that file, then will stuff PCBoard's
  111.         ' keyboard buffer with a FLAG command and the name of the file to flag.
  112.         ' If V was pressed, then we'll instead stuff the buffer with a command
  113.         ' to VIEW the file.
  114.  
  115.         GOSUB unhighlight
  116.         GOSUB restoreline
  117.  
  118.         IF (key = CR) THEN
  119.           KBDSTUFF "F "+filename+CR
  120.           END
  121.         ELSEIF (UPPER(key) = "V") THEN
  122.           KBDSTUFF "V "+filename+CR
  123.           END
  124.         ENDIF
  125.  
  126.       ENDIF
  127.  
  128.     ELSEIF (key == BS | key == BS2) THEN
  129.  
  130.       ' If the caller pressed backspace or delete, then delete the character
  131.       ' to the left, and remove it from the input buffer.  Of course, if the
  132.       ' caller hasn't typed anything yet, or if the caller has already
  133.       ' backspaced everything out, signified by the len being 0 (meaning there
  134.       ' are 0 bytes in the buffer), then we'll just go to the bottom of the
  135.       ' loop and loop back around waiting for more keystrokes.
  136.  
  137.       IF (len > 0) THEN
  138.         PRINT BS+" "
  139.         len  = len - 1
  140.         text = LEFT(text,len)
  141.       ELSE
  142.         GOTO bottom
  143.       ENDIF
  144.  
  145.     ELSEIF ((key >= " ") & (len < 80)) THEN
  146.  
  147.       ' Here we are just gathering up keystrokes and putting them into an
  148.       ' input buffer.  As long as the keystrokes are greater than or equal to
  149.       ' a SPACE we'll just add them in until a limit of 80 characters is
  150.       ' reached.  PCBoard won't let you type more than 80 characters at that
  151.       ' prompt anyway so we might as well keep the same limit.
  152.  
  153.       text = text + key
  154.       len  = len + 1
  155.  
  156.  
  157.     ELSEIF (key == CR) THEN
  158.  
  159.       ' If it's a carriage return append it and prepare to exit
  160.       text = text + key
  161.       exitflag = TRUE
  162.  
  163.     ENDIF
  164.  
  165.   ' Print any keystrokes the caller types
  166.  
  167.   PRINT key
  168.   ENDIF
  169.  
  170. :bottom
  171. ENDWHILE
  172.  
  173. ' If we've gotten this far, then the caller has pressed ENTER so we'll stuff
  174. ' whatever the caller has typed into PCBoard's input buffer and let PCBoard
  175. ' process the request.
  176.  
  177. KBDSTUFF text
  178. END
  179.  
  180. ;***********************************************************************
  181.  
  182. ' This is a subroutine that restores the prompt.  It's first chore is to UNDO
  183. ' any cursor movement that may have occured while the caller was marking files
  184. ' for download.  It does this by moving the cursor back down until it is on
  185. ' the same line it started on.  Then it clears the explanation line (the one
  186. ' that tells the caller how to mark files), prings the original prompt on the
  187. ' screen, and sets the color back to default.
  188.  
  189. :restoreline
  190. WHILE (newy < oldy) DO
  191.   PRINT ESC+"[B"
  192.   newy = newy + 1
  193. ENDWHILE
  194.  
  195. CLREOL
  196. PRINT prompt
  197. DEFCOLOR
  198. RETURN
  199.  
  200. ;***********************************************************************
  201.  
  202. ' This is a subroutine that moves the cursor UP one line, and records that it
  203. ' was moved in the "newy" variable which holds the current Y position
  204.  
  205. :moveup
  206. PRINT ESC+"[A"
  207. newy = newy - 1
  208. RETURN
  209.  
  210. ;***********************************************************************
  211.  
  212. ' This is a subroutine that scans the screen buffer by using the SCRTEXT()
  213. ' function to find any valid filenames in the left most column of the screen.
  214. ' It validates filenames by checking to see if the filename is from 1 to 12
  215. ' characters in length, and that, if a period is in the filename, that it does
  216. ' not have an extension longer than 3 characters, if there is not a period,
  217. ' then the main part of the filename cannot be more than 8 characters, also,
  218. ' the filename cannot have a space in it.
  219. '
  220. ' This routine will keep moving up the screen until it finds a valid filename
  221. ' and, if one is not found, it will return with the filename variable empty.
  222. '
  223. ' If a valid filename is found, it is stored in a variable called filename.
  224. ' At the same time, it reads the COLORS that are used to highlight the filename
  225. ' as well so that later, when we "unhighlight" the file, we can put it back
  226. ' the way it was found.  Finally, it highlights the filename by printing the
  227. ' name with a black-on-white color attribute and returns.
  228.  
  229. :findfile
  230. GOSUB moveup
  231. WHILE (newy >= 1) DO
  232.   filename = RTRIM(SCRTEXT(1,newy,13,FALSE)," ")  ' pull the name of the screen
  233.   filelen  = LEN(filename)
  234.  
  235.   ' check for a valid filename
  236.   IF (filelen >= 1 & filelen <= 12) THEN
  237.     IF (! INSTR(filename," ")) THEN
  238.       dotpos = INSTR(filename,".")
  239.       IF ((dotpos = 0 & filelen <= 8) | ((filelen - dotpos) <= 3)) THEN
  240.  
  241.         ' the filename is valid, save the colors as well
  242.         savetext = SCRTEXT(1,newy,13,TRUE)
  243.  
  244.         ' then highlight the filename and return
  245.         COLOR @X70
  246.         PRINT filename+CR
  247.         RETURN
  248.       ENDIF
  249.     ENDIF
  250.   ENDIF
  251.  
  252.   ' so far no valid filename found, move up the screen another line
  253.   GOSUB moveup
  254. ENDWHILE
  255.  
  256. ' no valid filename was found, return with an empty filename
  257. filename = ""
  258. RETURN
  259.  
  260. ;***********************************************************************
  261.  
  262. ' This is a subroutine that unhighlights the filename by printing the saved
  263. ' text, which includes color codes as well as the filename.
  264.  
  265. :unhighlight
  266. PRINT savetext+CR
  267. RETURN
  268.  
  269. ;***********************************************************************
  270.