home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Carsten's PPE Collection
/
Carstens_PPE_Collection_2007.zip
/
F
/
FLAG_PPE.ZIP
/
FLAG.PPS
< prev
next >
Wrap
Text File
|
1993-09-09
|
10KB
|
270 lines
BOOLEAN exitflag ' Flag to determine when we should exit
STRING text ' The text that the caller types
STRING key ' Keystroke text
STRING BS ' An ASCII backspace character
STRING BS2 ' An ASCII backspace character
STRING CR ' An ASCII carriage return character
STRING ESC ' An ASCII esc character
INTEGER len ' Length of the text the caller has typed
INTEGER oldx ' Last column position of cursor
INTEGER oldy ' Last row position of cursor
INTEGER newy ' New row position of cursor
STRING filename ' The name of the file that is being flagged
STRING savetext ' A saved copy - including color codes for restoration
STRING prompt ' The prompt to be displayed to the caller
INTEGER dotpos ' Used when validating filenames
INTEGER filelen ' Used when validating filenames
;***********************************************************************
; Initializations
BS = CHR(8) ' Backspace Key
BS2 = CHR(127) ' Alternate Backspace Key
CR = CHR(13) ' Carriage Return
ESC = CHR(27) ' ESC character
len = 0 ' Initialize to 0 bytes in the input buffer
text = "" ' Initialize to an empty input buffer
' Below is the prompt we are going to show the caller. There are basically
' two differences between it and the standard prompt:
'
' 1) It uses @minleft@ instead of @timeleft@. The reason is that @minleft@
' shows the caller how many minutes are left AFTER deducting the time
' estimated for any files currently flagged for download.
' 2) It removes the (F)lag option, although it will still work (!), and
' replaces it with (SPACE)=Mark instead.
prompt = "@X0A(@X0C@MINLEFT@@X0A min left), (H)elp, (V)iew, (@X0FSPACE@X0A)=Mark, More? "
;***********************************************************************
; Main Program
PRINT prompt
DEFCOLOR
' While the user hasn't exited, get keystrokes and act on them.
' Exiting will occur when the caller presses ENTER.
WHILE (!exitflag) DO
key = INKEY() ' Get a keypress from the user
if (key <> "") THEN ' If the user pressed a key, then let's process it
' If it is the FIRST keystroke, signified by the buffer having 0 bytes
' in it, then check to see if it is a SPACE. If so, then we'll go into
' MARK mode. If not, then we'll process the keystrokes the same way that
' PCBoard would .. gathering them up into a buffer. Once the ENTER key
' is pressed, we'll exit out and stuff PCBoard's keyboard buffer with the
' keystrokes that were collected.
IF (len = 0 & key = " ") THEN
oldx = getx()
oldy = gety()
newy = oldy
' Let the caller know what he can do while in MARK mode
PRINT CR+"@CLREOL@@X0DPress SPACE to move up, ENTER to select, V to view, ESC to exit"+CR
' Try to find a filename on the screen. If a filename is found, it
' will be signified by the filename being non-blank.
GOSUB findfile
' If a filename was found, then findfile highlighted it, let's wait for
' another keystroke to see if the user whats to mark this one, or move
' on to another one, or exit out. Marking is done by pressing ENTER,
' moving to another file is done by pressing SPACE, viewing the file is
' done by pressing "V", and exiting is done by pressing ESC.
IF (filename <> "") THEN
WHILE (key != ESC & key != CR & UPPER(key) != "V") DO
key = INKEY()
' If the key pressed was a SPACE then the user has decided to skip
' over that file. So unhighlight it, then try to find another
' file. If a file is found, we'll stay in this loop. If one is
' not found, then we'll restore the original prompt and go back to
' waiting for keystrokes in case the caller wants to start over
' (marking files) or wants to manually (F)lag them instead.
IF (key = " ") THEN
GOSUB unhighlight
GOSUB findfile
IF (filename = "") THEN
GOSUB restoreline
GOTO bottom
ENDIF
ENDIF
ENDWHILE
' If we've gotten this far, then ESC, CR or V was pressed. We'll
' unhighlight the file, restore the prompt and then, if CR was pressed,
' meaning the user wished to MARK that file, then will stuff PCBoard's
' keyboard buffer with a FLAG command and the name of the file to flag.
' If V was pressed, then we'll instead stuff the buffer with a command
' to VIEW the file.
GOSUB unhighlight
GOSUB restoreline
IF (key = CR) THEN
KBDSTUFF "F "+filename+CR
END
ELSEIF (UPPER(key) = "V") THEN
KBDSTUFF "V "+filename+CR
END
ENDIF
ENDIF
ELSEIF (key == BS | key == BS2) THEN
' If the caller pressed backspace or delete, then delete the character
' to the left, and remove it from the input buffer. Of course, if the
' caller hasn't typed anything yet, or if the caller has already
' backspaced everything out, signified by the len being 0 (meaning there
' are 0 bytes in the buffer), then we'll just go to the bottom of the
' loop and loop back around waiting for more keystrokes.
IF (len > 0) THEN
PRINT BS+" "
len = len - 1
text = LEFT(text,len)
ELSE
GOTO bottom
ENDIF
ELSEIF ((key >= " ") & (len < 80)) THEN
' Here we are just gathering up keystrokes and putting them into an
' input buffer. As long as the keystrokes are greater than or equal to
' a SPACE we'll just add them in until a limit of 80 characters is
' reached. PCBoard won't let you type more than 80 characters at that
' prompt anyway so we might as well keep the same limit.
text = text + key
len = len + 1
ELSEIF (key == CR) THEN
' If it's a carriage return append it and prepare to exit
text = text + key
exitflag = TRUE
ENDIF
' Print any keystrokes the caller types
PRINT key
ENDIF
:bottom
ENDWHILE
' If we've gotten this far, then the caller has pressed ENTER so we'll stuff
' whatever the caller has typed into PCBoard's input buffer and let PCBoard
' process the request.
KBDSTUFF text
END
;***********************************************************************
' This is a subroutine that restores the prompt. It's first chore is to UNDO
' any cursor movement that may have occured while the caller was marking files
' for download. It does this by moving the cursor back down until it is on
' the same line it started on. Then it clears the explanation line (the one
' that tells the caller how to mark files), prings the original prompt on the
' screen, and sets the color back to default.
:restoreline
WHILE (newy < oldy) DO
PRINT ESC+"[B"
newy = newy + 1
ENDWHILE
CLREOL
PRINT prompt
DEFCOLOR
RETURN
;***********************************************************************
' This is a subroutine that moves the cursor UP one line, and records that it
' was moved in the "newy" variable which holds the current Y position
:moveup
PRINT ESC+"[A"
newy = newy - 1
RETURN
;***********************************************************************
' This is a subroutine that scans the screen buffer by using the SCRTEXT()
' function to find any valid filenames in the left most column of the screen.
' It validates filenames by checking to see if the filename is from 1 to 12
' characters in length, and that, if a period is in the filename, that it does
' not have an extension longer than 3 characters, if there is not a period,
' then the main part of the filename cannot be more than 8 characters, also,
' the filename cannot have a space in it.
'
' This routine will keep moving up the screen until it finds a valid filename
' and, if one is not found, it will return with the filename variable empty.
'
' If a valid filename is found, it is stored in a variable called filename.
' At the same time, it reads the COLORS that are used to highlight the filename
' as well so that later, when we "unhighlight" the file, we can put it back
' the way it was found. Finally, it highlights the filename by printing the
' name with a black-on-white color attribute and returns.
:findfile
GOSUB moveup
WHILE (newy >= 1) DO
filename = RTRIM(SCRTEXT(1,newy,13,FALSE)," ") ' pull the name of the screen
filelen = LEN(filename)
' check for a valid filename
IF (filelen >= 1 & filelen <= 12) THEN
IF (! INSTR(filename," ")) THEN
dotpos = INSTR(filename,".")
IF ((dotpos = 0 & filelen <= 8) | ((filelen - dotpos) <= 3)) THEN
' the filename is valid, save the colors as well
savetext = SCRTEXT(1,newy,13,TRUE)
' then highlight the filename and return
COLOR @X70
PRINT filename+CR
RETURN
ENDIF
ENDIF
ENDIF
' so far no valid filename found, move up the screen another line
GOSUB moveup
ENDWHILE
' no valid filename was found, return with an empty filename
filename = ""
RETURN
;***********************************************************************
' This is a subroutine that unhighlights the filename by printing the saved
' text, which includes color codes as well as the filename.
:unhighlight
PRINT savetext+CR
RETURN
;***********************************************************************