home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 24
/
CD_ASCQ_24_0995.iso
/
vrac
/
homonlib.zip
/
HOMONREF.TXT
< prev
next >
Wrap
Text File
|
1995-04-13
|
54KB
|
1,218 lines
SUB BorderLines (parm())
'****************************************************************************
'Primarily called from other library functions, the BorderLines() SUB draws
' lines on the top and bottom of a pick screen, advising the user of the
' availability of (or lack of) more items that are not currently shown on the
' screen.
'
' parm(1) = row of top line
' parm(2) = row of bottom line
' parm(3) = top element
' parm(4) = bottom element
' parm(5) = min element
' parm(6) = max element
'
'See functions PickOne$() and PickSome$() for examples of use.
'
'****************************************************************************
SUB Box (row1, col1, row2, col2, boxtype$)
'****************************************************************************
'Draws a box on the screen at the specified coordinates. row1 & col1 are the
' top left corner, row2 & col2 are the bottom right corner. The appearance
' of the box is determined by boxtype$, which can either be one character to
' pick a predefined box type or a string of 11 or more characters to be used
' as the actual box characters. See the function body of Panes() for the
' exact placement of the characters within the string and other options.
'
'Examples of boxtype$: "1" or "S" Draws a single-line box (default)
' "2" or "D" Draws a double-line box
' "3" or "H" Double Horizontal lines, single vertical
' "4" or "V" Double Vertical lines, single horizontal
' "***********" Draws a box made of asterisks
'
'****************************************************************************
SUB BoxCalc (t, l, b, r, tall, wide)
'****************************************************************************
'This function is used by other functions that draw pop-up boxes to calculate
' the box coordinates.
'
'The box coordinates passed as t, l, b and r will be directly modified by the
' sub to contain the desired values.
'
'See EditBox(), PickBox(), ListBox() and Progress() for examples of use.
'
'****************************************************************************
FUNCTION Capitalize$ (orig$)
'****************************************************************************
'Capitalizes the first letter of each word in a string after first converting
' the whole thing to lower case.
'****************************************************************************
SUB Center (row, text$)
'****************************************************************************
'Centers text on the specified row.
'****************************************************************************
FUNCTION ColorSet (hdr1$, hdr2$, parm(), defaults())
'****************************************************************************
'A handy function to let the user set their color preferences.
'
'The hdr1$ and hdr2$ arugments are text strings that will be centered on the
' first two lines of the screen.
'
'The parm() array will be directly modified by ColorSet(). The function will
' return TRUE if any of the colors were changed, FALSE if they are the same
' as when the function was entered. This is useful if the calling program
' needs to know whether to save the new values in some sort of a setup file
' or not.
'
'The defaults() array should mimic the parm() array. It must have subscripts
' ranging from MINCOLOR to MAXCOLOR at least.
'
'Because this function changes colors and has to mess with the screen a bit,
' it does not restore the previous screen or viewport upon exiting. The
' procedure that calls this function must know to repaint the screen and
' restore any active viewport upon returning.
'
'****************************************************************************
FUNCTION CountIn (search$, lookfor$)
'****************************************************************************
'Returns the number of times that a substring is found within a string.
'****************************************************************************
FUNCTION Dice (rolls, sides, add)
'****************************************************************************
'Returns the results of the specified dice roll(s).
'
'If you are a role-playing gamer, you will notice that the syntax of this
' function is similar to "standard gaming notation" of dice. For example,
' "3d6" can be easily translated to Dice(3,6,0), or "2d4+1" as Dice(2,4,1).
'
'****************************************************************************
FUNCTION Dir$ (file$, DirInfo AS DirType)
'****************************************************************************
'Credit for this function must go to Fairchild Computer Services. The code
' has been altered from the original to suit my purposes. The original is
' available on CompuServe as "DIR.ZIP", and comes with some other good stuff.
' It is one of the most useful things I have ever downloaded. Thank you, FCS
' for sharing your knowledge with the rest of us!
'
'I changed the original function by making the DirType variable a passed
' parameter rather than a COMMON SHARED variable, and altering the format of
' the EntryTime & EntryDate values.
'
'The file$ parameter may be passed as an individual filename, or a filespec
' that includes wildcards and/or extended pathnames - just as if you were
' typing "DIR" at the DOS prompt.
'
'The DirType variable will be filled with other information about the file
' found (if any). See DIR.INC for the type declaration.
'
'If any files match the wildcard, the function will return the filename of
' the first matching file. If a single filename was passed, you'll just get
' the same name back and will then know that the file exists. The DirType
' argument will contain the file's other information.
'
'If no files match the wildcard or the single filename does not exist, Dir$()
' will return a null string ("") and the DirType variable will not be updated
' except with an ErrorCode.
'
'To get further matches to a wildcard, continue to call Dir$() with a null
' file$ argument. Keep doing this until a null string is returned. This
' will indicate that no further files match the wildcard.
'
'Example: ' $INCLUDE: 'DIR.INC'
' DIM DirInfo AS DirType
' f$ = Dir$("*.*", DirInfo)
' IF f$ = "" THEN
' PRINT "No files found"
' ELSE
' PRINT "These files were found:"
' DO
' PRINT f$
' f$ = Dir$("", DirInfo)
' LOOP UNTIL f$ = ""
' END IF
'
'If there is a problem (such as an invalid pathname) Dir$() will return the
' string "***ERROR***" and the DirType.ErrorCode will contain a value.
'
'Caution: Don't try to run Dir$() against an empty diskette drive. You'll
' hang the computer. Make sure there's a diskette in there first!
'
'See the functions FileExist(), FileSize&() and DirExist() for more examples.
'
'See the functions in DIRSTUFF.BAS for examples of how to interpret the
' values in the DirType variable.
'
'****************************************************************************
FUNCTION DirAttr$ (a)
'****************************************************************************
'This function takes as its argument the integer received from the Attribute
' field of a DirType variable (See DIR.INC). It then returns a 5-character
' string with letters representing the file or directory's attributes.
'
'If all the attributes were set, the function would return "DRHSA", where:
'
' D = Directory
' R = Read Only
' H = Hidden
' S = System
' A = Archive
'
'If one or more attributes are missing, their location in the string will be
' blank.
'
'Example: " A" = A file with only an archive attribute.
' " RHS " = A read only, hidden, system file (such as IO.SYS).
'
'This code is also useful to see how you can interpret the values on your
' own. And you thought you would never find a use for the bitwise AND!
'
'****************************************************************************
FUNCTION DirDate$ (d&)
'****************************************************************************
'This function converts the long integer value of a DirType.EntryDate into a
' string in the form of MM/DD/YY.
'****************************************************************************
FUNCTION DirExist (dirname$)
'****************************************************************************
'The function will return TRUE if the directory in question exists, FALSE
' otherwise.
'
'The dirname$ argument may be passed with or without a trailing backslash.
'
'Note: A null string passed to the function will be interpreted as the
' current directory and the function will return TRUE.
'
'Caution: Attempting to use this function on an empty diskette drive will
' hang your computer. Make sure there is a disk inserted first.
'
'See function MakeDir() for an example of use.
'
'****************************************************************************
FUNCTION DirTime$ (t)
'****************************************************************************
'This function takes the integer value of a DirType.EntryTime field and
' converts it to a string in the form of HH:MMa.
'****************************************************************************
SUB Drop (text$, row, col)
'****************************************************************************
'Prints text vertically on the screen, dropping from the specified row and
' column position. If the length of the text would continue past row 24,
' printing will stop at that point. See also: SUB Rise()
'****************************************************************************
FUNCTION EditBox$ (msg$(), orig$, parm())
'****************************************************************************
'Basically, it's EdStr$() in a pop-up box. Send an array of text to show
' along with the string to be edited, and the return values are the same as
' EdStr$().
'
' parm(1) = top left row 0=Center
' parm(2) = top left column 0=Center
' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes.
' parm(4) = message justification <0=Left 0=Center >0=Right
' parm(5) = maximum length of the string to be edited 1-77
' parm(6) = initial insert/overwrite mode (Use the SETCURS.INC constants)
' parm(7) = initial character position within the edit string.
' parm(8) = restrict input? (See EDSTR.INC)
'
'Due to the width of the box & shadow, EditBox$() effectively limits the
' maximum length of the EdStr$() to 77 characters.
'
'If a combination of any of the above parameters causes a portion of the box
' to exceed the screen boundaries, a run-time error will occur.
'
'See function EdStr$() for more detailed information.
'
'****************************************************************************
FUNCTION EditBox2$ (msg$, orig$, parm())
'****************************************************************************
'Exactly the same as EditBox$(), but you pass a single text string as a
' message instead of an array. Just saving you a little coding.
'
'See EditBox$() for all the details.
'
'****************************************************************************
FUNCTION EdStr$ (orig$, parm())
'****************************************************************************
'Used to edit an existing string or for input of a new string.
'
'If the user presses ESC during the editing, CHR$(27) will be returned to let
' the calling procedure know it was aborted.
'
'If Enter is pressed to terminate the editing, the edited string will be
' returned.
'
'The settings of the miscellaneous parameters are as follows:
'
' parm(1) = row
' parm(2) = column
' parm(3) = maximum length of the edited string 1-80
' parm(4) = insert/overwrite mode (Use SETCURS.INC constants)
' parm(5) = initial cursor position within string 0=Beginning
' parm(6) = use delimiters? (0=No Non-zero=Yes)
' parm(7) = left delimiter ASCII code. Default = 62 ( > )
' parm(8) = right delimiter ASCII code. Default = 60 ( < )
' parm(9) = use selected colors? 0=Current colors Non-zero=Selected
' parm(10)= used to restrict user input. See EDSTR.INC for values.
'
'EdStr$() works just like you're used to, with all the familiar editing keys:
' Left/right arrows, Backspace, Delete, Insert/overwrite, Home, and End. It
' also has a special service, Alt-X, that deletes from the cursor position to
' the end of the line.
'
'The maximum length of the edited string depends on whether delimiters are
' used or not. Without delimiters, the string may be up to 80 characters
' long. With delimiters, it is reduced to 78.
'
'If you choose to have EdStr$() appear in the highlighted colors, it will
' reset the colors to normal upon exit. If not, the current color setting
' will not be changed at all.
'
'If parm(10) is greater than zero, user input will be limited to certain
' characters. See EDSTR.INC for the constant names. You may add these
' constants together to get different combinations of allowed characters.
'
' Example: parm(10) = EDUPPER + EDALPHA + EDSPACE
'
' This would allow spaces and uppercase letters only.
'
'The combinations allowed for parm(10) are not extensive by any means, but
' for simple input they can be handy.
'
'****************************************************************************
FUNCTION Evaluate$ (formula$)
'****************************************************************************
'This is a special function. It evaluates a "formula" and returns a string
' of the value. If an error is found within the formula (or Evaluate$ is
' just unable to handle it), Evaluate$ will return a string with a leading
' asterisk followed by a description of the error. The best way to see what
' it does is just to experiment. By no means am I sure that this function is
' completely bulletproof, but it will stand up to most expressions whose
' value doesn't exceed a few trillion. This function is a good example of
' recursion if you are interested.
'
'Example: formula$ = "10*4-(36/3)"
' newval$ = Evaluate$(formula$)
' IF left$(newval$,1)="*" then
' PRINT "An error occurred!"
' PRINT newval$ '(Error description)
' ELSE
' PRINT "The value of ";formula$;" is:"; VAL(newval$)
' END IF
'
'Note: MUST be compiled with the /X switch.
'
'****************************************************************************
FUNCTION FileExist (file$)
'****************************************************************************
'Returns TRUE or FALSE depending on whether the specified file exists. If
' used with a wildcard, it will return TRUE if any file matches the wildcard.
'****************************************************************************
FUNCTION FileParts$ (filespec$, operation$)
'****************************************************************************
'Returns a specified part of an extended filename or other filespec type
' string.
'
'The return value depends upon the value of the operation$ argument:
'
'Example: filespec$ = "C:\GAMES\SAVEGAME.001"
' FileParts$(filespec$,"P") --> "C:\GAMES\" (Path)
' FileParts$(filespec$,"F") --> "SAVEGAME.001" (Filename)
' FileParts$(filespec$,"E") --> "001" (Extension)
' FileParts$(filespec$,"N") --> "SAVEGAME" (fileName)
' FileParts$(filespec$,"D") --> "C:" (Drive)
'
' filespec$ = "HOMEWORK.TXT"
' FileParts$(filespec$,"P") --> "" Returns null if the requested
' FileParts$(filespec$,"D") --> "" info is not part of filespec$
'
'Paths are returned with a trailing backslash. Drive letters are returned
' with a trailing colon. Extensions are returned without a leading period.
'
'Quirks: FileParts$() assumes that all pathnames end in a backslash. If you
' pass the function one that does not, it will think that it is a filename:
'
' Example: "C:\GAMES" will be interpreted as a file called "GAMES" in the
' root directory of C:. "C:\GAMES\" would be Ok.
'
'Note: The letter "X" is accepted as well as "E" to get the extension.
'
'****************************************************************************
FUNCTION FileSize& (file$)
'****************************************************************************
'Returns a long integer representing the file size of a single file or the
' combined size of multiple files if a wildcard is passed.
'
'Should the file(s) not be found, the function will return zero.
'
'****************************************************************************
FUNCTION GenMen (choice$(), ok(), parm())
'****************************************************************************
'GenMen() is a general vertical lightbar menu function. It will return the
' element number of the selected item or zero if the user presses ESC.
'
'The ok() array is used to specify which choices are available:
'
' 0=Not available Non-zero=Ok
'
'The ok() array must have subscripts equal to those of choice$() or those
' specified by parm(6 and 7) - See below.
'
' parm(1) = top row
' parm(2) = left column 0=Center
' parm(3) = # blank lines between choices >=0
' parm(4) = allow number keys if < 10 choices? 0=No Non-zero=Yes
' parm(5) = initial selected choice
' parm(6) = minimum choice$() subscript 0=Use actual minimum (LBOUND)
' parm(7) = maximum choice$() subscript 0=Use actual maximum (UBOUND)
'
'If a combination of any of the above parameters cause one or more menu items
' to be placed outside the actual screen area, a run-time error will occur.
'
'parm(4) indicates whether the user can press a number key (1-9) to select an
' option when there are 9 or less choices. Identifying the choices by number
' is the programmer's responsibility if this option is desired. Note: this
' option can only be selected when all the choice$() subscripts are positive.
'
' Example: choice$(1) = " 1) Do this "
' choice$(2) = " 2) Do that "
' choice$(3) = " 3) Do the other "
'
'parm(6 and 7) can specify minimum and maximum elements of the array to use
' if the actual array contains more elements than you want on the menu.
'
' Example: DIM choice$(-10 to 30) This example would create
' (assign values to choice$()...) a lightbar menu using only
' parm(6) = 1 choices 1 through 5,
' parm(7) = 5 ignoring any element below
' picked = GenMen(...) 1 or over 5.
'
'Note: It is not recommended to include subscript zero in the choices sent to
' GenMen(). You will be unable to tell the difference between the user
' selecting element zero and the user pressing ESC. Exception: When element
' zero is some sort of quit or exit option this might be acceptable.
'
'****************************************************************************
FUNCTION GenMen2 (choice$(), parm())
'****************************************************************************
'GenMen2() is identical to GenMen() except that you need not pass the ok()
' array. All elements default to available.
'
'See GenMen() for more information. The parm() settings are identical.
'
'****************************************************************************
FUNCTION GetKey$ (parm()) STATIC
'****************************************************************************
'Used to control user input. It includes a screensaver routine and a way to
' trap hotkeys with polling rather than ON KEY. Use it where you would
' normally place an INKEY$ loop.
'
'Chances are, you will want to modify this function for each program that you
' write. See below for information about how the screensaver works and how
' to add hotkey procedures.
'
'****************************************************************************
FUNCTION HomePath$
'****************************************************************************
'Returns the name of the current DOS directory.
'****************************************************************************
SUB InfoBox (msg$(), parm())
'****************************************************************************
'Displays the text of the msg$() array in a pop-up box. Basically, it is
' just a call to PickBox() with only one option of " Ok ".
'
' parm(1) = top left row 0=Center
' parm(2) = top left column 0=Center
' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes.
' parm(4) = message justification <0=Left 0=Center >0=Right
'
'See function PickBox() for more detailed information.
'
'****************************************************************************
SUB InfoBox2 (msg$, parm())
'****************************************************************************
'Works just like InfoBox() but accepts a single text string rather than an
' array.
'
' parm(1) = top left row 0=Center
' parm(2) = top left column 0=Center
' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes.
' parm(4) = message justification <0=Left 0=Center >0=Right
'
'See functions InfoBox() and PickBox() for more detailed information.
'
'****************************************************************************
FUNCTION IsAlpha (text$)
'****************************************************************************
'Returns TRUE if the text contains only letters and spaces, otherwise FALSE.
'****************************************************************************
FUNCTION IsNum (text$)
'****************************************************************************
'Returns TRUE if the text contains only numeric data, FALSE otherwise.
'
'The function considers a lone minus sign (-) to be an operator, not numeric.
' The same goes for a lone decimal point. Both characters ARE allowed if
' cohabitating with digits (would their mothers approve?).
'
'Examples: IsNum("12") --> TRUE IsNum("ABC") --> FALSE
' IsNum("-6") --> TRUE IsNum(" ") --> FALSE
' IsNum("1.3") --> TRUE IsNum("-") --> FALSE
' IsNum("") --> FALSE IsNum(".") --> FALSE
'
'****************************************************************************
FUNCTION Istr$ (i)
FUNCTION Lstr$ (l&)
FUNCTION Sstr$ (s!)
FUNCTION Dstr$ (d#)
'****************************************************************************
'These functions simply make a string of a number and trim the leading space
' off of it. The four differenct functions are for the different numeric
' variable types: Double precision, Integer, Long integer and Single
' precision.
'
'They are not very complicated, but since I use the combination of LTRIM$()
' and STR$() so often, I might as well make my life easier.
'
'****************************************************************************
FUNCTION Justify$ (orig$, side)
'****************************************************************************
'Moves leading or trailing spaces to the appropriate side of the string,
' while retaining the original length of the string.
'
'The side argument can take one of the following forms:
'
' <0 = Left justify (move leading spaces to the right side)
' 0 = Center justify (spread spaces evenly on both sides)
' >0 = Right justify (move trailing spaces to the left side)
'
'The function works by comparing the size of the original string to the size
' of the string after trimming the appropriate spaces. These spaces are then
' tacked back on to the appropriate side.
'
'Examples: Justify$("Some text ", 0) --> " Some text "
' Justify$("Some more ", 1) --> " Some more"
' Justify$(" Even more!",-1) --> "Even more! "
'
'****************************************************************************
FUNCTION LeadZero$ (number, newlen)
'****************************************************************************
'"Stringifys" an integer and pads it on the left with leading zeros up to the
' desired length.
'
'This function was created mainly due to PRINT USING's inability to add
' leading zeros (But you can add asterisks! Gee, I use that a lot. NOT!!).
' Feel free to create additional functions that work on other data types.
'
'Note: If used on a negative number, the minus sign will be included when
' calculating the new length.
'
' Examples: LeadZero$(5,5) --> "00005"
' LeadZero$(-5,5) --> "-0005"
'
'****************************************************************************
FUNCTION ListBox (title$, choice$(), parm())
'****************************************************************************
'ListBox() works just like PickOne(), but it appears in a pop-up box. It
' returns the element number of the item selected or zero if the user pressed
' ESC. There are no hotkeys in ListBox().
'
'The title$ argument will be centered on the top border of the box. If no
' title is desired, pass a null string.
'
'The width of the box is determined by the longer of the title or longest
' choice$() element.
'
' parm(1) = top row 0=Center
' parm(2) = left column 0=Center
' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes.
' parm(4) = initial selected choice
'
'****************************************************************************
FUNCTION MakeDir (directory$)
'****************************************************************************
'Creates a DOS directory. Unlike the MKDIR command, MakeDir() can create a
' directory more than one level deep or on a different drive.
'
'The directory$ argument may be passed with or without a trailing backslash.
'
'Returns TRUE if successful, FALSE if unable to create the directory. If
' unable to create the directory, MakeDir() DOES NOT clean up after itself by
' removing any partially created subdirectories.
'
'If creating a multi-level subdirectory, it is best to pass the whole
' pathname, including the drive letter.
'
'Examples: MakeDir("GAMES") Creates a subdirectory "GAMES" off the current
' directory.
'
' MakeDir("C:\SCIENCE\DATA") Creates the specified directory. If
' the \SCIENCE directory doesn't exist,
' it will get created too. This would
' crash the MKDIR command.
'
'Note: MUST be compiled with the /X switch due to the RESUME NEXT stuff.
'
'Caution: If using MakeDir() on a floppy drive, MAKE SURE that there is a
' diskette in the drive or your computer will hang.
'
'****************************************************************************
FUNCTION Dmax# (a#, b#)
FUNCTION Dmin# (a#, b#)
FUNCTION Imax (a, b)
FUNCTION Imin (a, b)
FUNCTION Lmax& (a&, b&)
FUNCTION Lmin& (a&, b&)
FUNCTION Smax! (a!, b!)
FUNCTION Smin! (a!, b!)
'****************************************************************************
'The various max() and min() functions simply return the larger or smaller of
' two numbers. There is one set of functions for each of the numeric data
' types.
'
'While useful by themselves, they can be extremely handy when used in pairs:
'
' biggest = Imax(a, Imax(b, c))
'
' smallest! = Smin!(a!, Smin!(b!, c!))
'
'****************************************************************************
FUNCTION PadC$ (orig$, newlen)
FUNCTION PadL$ (orig$, newlen)
FUNCTION PadR$ (orig$, newlen)
FUNCTION PadX$ (orig$, newlen, side, char$)
'****************************************************************************
'Pads a string with a specified character on the specified side(s) up to the
' new length. A more flexible version of the other "Pad" functions (all of
' which are merely translated into calls to PadX$() with a space for the pad
' character!).
'
'The side argument is expressed like so: <0 = Left
' 0 = Center
' >0 = Right
'
'Examples: PadX$("Hello!",10,1," ") --> "Hello! "
' PadX$("$500",10,-1,"*") --> "******$500"
' PadX$("WOW",20,0,"!") --> "!!!!!!!!WOW!!!!!!!!!"
'
'****************************************************************************
SUB Panes (row1, col1, row2, col2, row3, col3, boxtype$)
'****************************************************************************
'Draws a box on the screen at the specified coordinates. row1 & col1 are the
'top left corner, row2 & col2 are the bottom right corner. row3 & col3 are
'parameters specifying where the box is to be split horizontally and/or
'vertically. If either or both row3 or col3 are zero, the box will not be
'split in that direction. Experiment with it.
'
'The appearance of the box is determined by boxtype$, which can either be one
'character to pick a predefined box type or a string of 11 or more characters
'to be used as the actual box characters. See the function body for the
'exact placement of the characters within the string.
'
'Examples of boxtype$: "1" or "S" Draws a single-line box (default)
' "2" or "D" Draws a double-line box
' "3" or "H" Double horizontal lines, single vertical
' "4" or "V" Double vertical lines, single horizontal
' "***********" Draws a box made of asterisks
'
'The box can be drawn as an outline only, not overwriting anything within the
' box's borders or can be filled with a fill character, effectively placing
' the box over whatever was already there. This option is also controlled by
' the boxtype$ argument:
'
'If boxtype$ is specified as a number ("1", "2"...) the box will be drawn as
' an outline only. If boxtype$ is specified as a letter ("S", "D"...) the
' box will be filled with spaces.
'
'If boxtype is a user-supplied string of characters, if it's length is 12 or
' more, the 12th character will be used as the fill character, otherwise the
' box will be drawn as an outline.
'
'****************************************************************************
FUNCTION ParseDie$ (die$)
'****************************************************************************
'This function takes a string in "standard gaming notation" and returns a
' string of the stated dice roll's value.
'
'If the die$ string begins with an asterisk (*), ParseDie$() will interpret
' it as a constant (non-random value) and will return whatever follows the
' asterisk.
'
'If an illegal character is found in the string, the return value will begin
' with an at-sign (@) followed by the string position of the offending
' character. The following characters are recognized by ParseDie$():
'
' *0123456789dD+- (spaces are ignored)
'
'Remember that the Dice() function accepts only integer arguments and returns
' and integer. If the result of the die roll (or any of its parts) exceeds
' the limits of an integer variable (-32,768 to 32,767) a run-time error will
' occur. If you need more, just rewrite these functions using long integers.
'
' Examples: ParseDie$("3d6") --> "3" to "18"
' ParseDie$("1d4+1") --> "2" to "5"
' ParseDie$("*15") --> "15"
' ParseDie$("2d3.1") --> "@4" (Illegal character in 4th pos.)
' ParseDie$("") --> "0"
' ParseDie$(" ") --> "1" to "4" (Defaults to 1d4)
' ParseDie$("2d50000") Crash!
'
'****************************************************************************
FUNCTION PickBox (msg$(), choice$(), parm())
'****************************************************************************
'Allows the user to pick from a horizontal light-bar menu within a pop-up
' message box.
'
'The informational text of the box is contained within the msg$() array.
'
'The choice$() array contains the items the user may pick from. The function
' will return the element number of the item selected, or zero if the user
' presses ESC.
'
' parm(1) = top left row 0=Center
' parm(2) = top left column 0=Center
' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes.
' parm(4) = message justification <0=Left 0=Center >0=Right
' parm(5) = initial selected choice
'
'If a combination of any of the above parameters causes a portion of the box
' to exceed the screen boundaries, a run-time error will occur.
'
'****************************************************************************
FUNCTION PickInfo$ (p$, k, e)
'****************************************************************************
'This function interprets the return string from the PickOne$() and
' PickSome$() functions.
'
'The return value from the Pick function is passed as p$. The integer
' variables passed as k and e will be assigned the value of the keypress and
' element number respectively.
'
'PickInfo$() returns the actual character value of the keypress used to exit
' the Pick function.
'
'See the comments within PickOne$() for a more detailed explanation of the
' Pick functions' return values.
'
'Examples: k$ = PickInfo$("", k, e) --> k$ = CHR$(27)
' k = 27
' (User pressed ESC) e = 0
'
' k$ = PickInfo$("*-59 4", k, e) --> k$ = CHR$(0)+CHR$(59)
' k = -59
' (User pressed F1 on element 4) e = 4
'
' k$ = PickInfo$("19", k, e) --> k$ = CHR$(13)
' k = 13
' (User pressed Enter on element 19) e = 19
'
'Note: This function is a good example of how to get more than one return
' value from a function.
'
'****************************************************************************
FUNCTION PickOne$ (choice$(), parm())
'****************************************************************************
'Allow the user to select an item from an array by highlighting it with the
' cursor keys & pressing Enter. The function returns a string of the item's
' element number, or a null string if the user ESCapes. Other options are
' available, and are specified in parm().
'
' parm(1) = top row
' parm(2) = bottom row
' parm(3) = column width 0=Calculated by the function (recommended)
' parm(4) = initial selected element #
' parm(5) = reset? 0=Subsequent call Non-zero=Reset
'
'Any column width specified in parm(3) will be increased by 2 to allow for
' spaces on either side of each item. Allow for this when supplying this
' value.
'
'parm(6 to 10) are special parameters, designating "hotkeys" that will return
' control to the calling procedure, and return a string of the key pressed
' along with the element number of the currently highlighted item. If no
' hotkey is desired, merely pass a zero for that parameter.
'
'To specify a one-byte INKEY$ code, merely pass the ASCII code of the key.
' If the key is a letter, pass the upper-case ASCII code. To specify a two-
' byte key, pass the negative ASCII code of the second byte.
'
' Examples: To specify the backspace key, pass 8 ( CHR$(8) ).
' To specify the F1 key, pass -59 ( CHR$(0)+CHR$(59) ).
'
'The string returned when a hotkey is pressed will consist of an asterisk
' followed by the hotkey code specified in the parm() array, a space, and the
' current element number.
'
' Example: "*-59 4" would mean that the F1 key was pressed while element #4
' was highlighted.
'
'When returning to the function after processing a hotkey, make sure that
' parm(4) is updated to reflect the current element, and parm(5) is zero.
' If calling the function for the first time, make sure parm(5) is non-zero.
'
'****************************************************************************
FUNCTION PickSome$ (choice$(), tag(), parm())
'****************************************************************************
'PickSome$() works just like the PickOne$() function but also allows for the
' tagging of multiple items. See PickOne$() for general information about
' how these functions work. Additional information on how the tagging works
' is described here.
'
' parm(1) = top row
' parm(2) = bottom row
' parm(3) = column width 0=Calculated by the function (recommended)
' parm(4) = initial selected element #
' parm(5) = reset 0=Subsequent call Non-zero=Reset
' parm(6) = tagging key Default=32 (spacebar)
' parm(7) = tag all key Default=-66 (F8)
' parm(8) = tag none key Default=-67 (F9)
' parm(9) = switch tags key Default=-68 (F10)
' parm(10) can be specified as another hotkey (see PickOne$())
'
'The tagging keys specified by parm(6 to 9) may be disabled by passing -1.
' The default will be assigned if zero is passed.
' The tagging key will toggle an individual item's tag to on (1) or off (0).
' The tag all/tag none keys will set all items' tags to on/off respectively.
' The switch tags key will change all on tags to off, and all off tags to on.
'
'The tag array must be an integer array with subscripts identical to the
' choice$() array. You may pre-tag items or disable items in the array by
' setting elements of tag() to one of the following values:
'
' 0 = Untagged/Off 1 = Tagged/On -1 = Disabled
'
'If an item is disabled, it will be unaffected by any tagging operations and
' will appear in the dimmed color specified by parm(FGD) and/or parm(FGDS).
'
'****************************************************************************
SUB PopBox (t, l, b, r, wide, msg$(), parm())
'****************************************************************************
'This function is used by other pop-up box functions to zap the box onto the
' screen. The procedure that calls this function must have its parm(3 & 4)
' arguments set up like so:
'
' parm(3) = box border type 1-4
' parm(4) = message justification <0=Left 0=Center >0=Right
'
'See EditBox(), PickBox(), and Progress() for examples of use. ListBox() is
' not included because it doesn't have a msg$() array.
'
'****************************************************************************
SUB Progress (cur, msg$(), parm()) STATIC
'****************************************************************************
'Displays a percentage progress bar in a pop-up box. The actual numeric
' progress is also shown. The progress bar is updated in 5% increments.
'
' parm(1) = top left row 0=Center
' parm(2) = top left column 0=Center
' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes.
' parm(4) = message justification <0=Left 0=Center >0=Right
' parm(5) = maximum: (cur/maximum)*100 = percentage complete
'
'The function has three different uses. The first will draw the box on the
' screen. The second usage will update the progress bar in the currently
' displayed box. The third will remove the box from the screen.
'
'The cur argument is used to indicate what you want Progress() to do:
'
' 0 = New box
' >0 = Update current box (cur/maximum)*100 = %
' <0 = Remove box
'
'Only one box may be on screen at any one time. If you specify an operation
' that conflicts with the current status of the sub (like requesting a new
' box when there's already one up) nothing will happen.
'
'Once the box is on screen, you should not do any PRINTing. This should not
' be a problem, as the main usage for this function is for when some major
' processing is going on and you want the user to know that their computer
' is actually doing something.
'
'Another feature of Progress() is the fact that it will always appear for at
' least 1.5 seconds. Have you ever used a program & had some message flash
' by before you got a chance to read it? Pretty annoying, isn't it.
'
'****************************************************************************
SUB RestScreen (filename$)
'****************************************************************************
'Restores a screen saved by SaveScreen().
'
'You should only pass a filename that you know contains data created by the
' SaveScreen() sub. I have no idea what would happen if you used any other
' kind of data. Use at your own risk. If you pass a filename that does not
' exist, a run-time error will occur.
'
'****************************************************************************
FUNCTION Rinstr (start, search$, lookfor$)
'****************************************************************************
'Kind of a "Reverse INSTR" (hence the name). Returns the character position
' of the LAST occurrence of a substring within another.
'
'If the start argument is greater than zero, search$ is truncated to
' (start-1) before the search begins (I would rather have called it "end" but
' that word is taken). The start argument is especially useful for
' subsequent calls to Rinstr, i.e., to find the second-to-last occurrence,
' etc.
'
'Examples: Rinstr(0,"Peter Piper","er") --> 10
' Rinstr(10,"Peter Piper","er") --> 4 (Searches "Peter Pip")
'
'****************************************************************************
SUB Rise (text$, row, col)
'****************************************************************************
'Prints text vertically on the screen, rising from the specified row and
' column position. If the length of the text would continue above row 1,
' printing will stop at that point. See also: SUB Drop()
'
'****************************************************************************
SUB SaveScreen (filename$)
'****************************************************************************
'Saves the current text screen to the specified binary file. If the file
' already exists, it will be overwritten.
'
'This function was only tested in text mode (SCREEN 0). I have no idea what
' it would do in any other screen mode. Use at your own risk.
'
'****************************************************************************
FUNCTION SetCargo$ (c$) STATIC
'****************************************************************************
'This is a general set/get function that operates on a string. To query the
' current value of SetCargo$() without actually changing its value, pass
' CHR$(0) as the argument.
'****************************************************************************
FUNCTION SetCursor (cursortype) STATIC
'****************************************************************************
'A set/get function for turning the cursor on and off and changing its
' appearance.
'
'Be sure to include the SETCURS.INC in the calling program and use its
' constants as arguments to the function.
'
'To inquire on the current setting without changing it, pass a negative
' number as an argument (or anything besides one of the defined constants).
'
'****************************************************************************
SUB SetView (top, bot, parm()) STATIC
'****************************************************************************
'Used to set the current text viewport (VIEW PRINT) and update the changes in
' the parm() array.
'
'To change the current viewport settings, pass the appropriate values in the
' top and/or bot arguments. Setting both values to zero will have the effect
' of releasing the active VIEW PRINT setting and restoring the viewport to
' the entire screen.
'
'To reset the the viewport to the values currently stored in parm() without
' changing either value, pass negative numbers for both arguments.
'
'Examples: SetView 0, 0, parm() --> Sets viewport to the entire screen.
' SetView 4, 24, parm() --> Sets viewport to rows 4 through 24.
' SetView 6, 0, parm() --> Updates the top row of the viewport
' to 6, leaving the current value for
' the bottom row unchanged.
' SetView -1, -1, parm() --> Resets the viewport to the values
' currently stored in parm() without
' changing either value.
'
'****************************************************************************
SUB Slide (text$, lr, row, col, delay)
'****************************************************************************
'Slides text onto the screen to the left or right starting at the specified
' row and column.
'
'The direction is determined by the argument lr, where a zero value equals
' left, non-zero equals right.
'
'delay is measured in 100ths of a second.
'
'****************************************************************************
SUB Spread (text$, row, col, delay)
'****************************************************************************
'Spreads text on the screen in both directions starting from the specified
'coordinates. Delay is measured in 100ths of a second.
'****************************************************************************
FUNCTION Squeeze$ (orig$, char$)
'****************************************************************************
'Removes all occurrences of a substring from within a string.
'
'Example: Squeeze$("Peter Piper","er") --> "Pet Pip"
'
'****************************************************************************
FUNCTION Strip$ (orig$, side, char$)
'****************************************************************************
'Strips leading and/or trailing characters from a string. It works like
' LTRIM$() and RTRIM$() but on other characters in addition to spaces.
'
'The side argument is passed in one of the following ways:
'
' <0 = Strip the left side
' 0 = Strip both sides
' >0 = Strip the right side
'
'Combinations of characters can also be stripped from each side as well as
' individual characters. In this case, the length of char$ would be greater
' than one. The characters to be stripped ARE case sensitive.
'
'Examples: Strip$("00100",-1, "0") --> "100"
' Strip$("AABAa", 0, "A") --> "BAa"
' Strip$("00100", 0, "0") --> "1"
' Strip$(" ", 0, " ") --> ""
' Strip$("ABCDE", 0, "AB") --> "CDE"
' Strip$("ABCDE", 1, "AB") --> "ABCDE"
'
'****************************************************************************
FUNCTION Stuff$ (orig$, position, delnum, char$)
'****************************************************************************
'Inserts and/or deletes character(s) in(to) a string at the specified
' character position. Very simple, but very useful.
'
'The position argument tells the function where to start its operations upon
' the original.
'
'The delnum argument tells it how many (if any) characters to delete starting
' at that position.
'
'The value of char$ determines what gets put into the string at position. If
' null, nothing will get put in, effectively deleting characters from within
' the string.
'
'Examples: Stuff$("QBasic",2,0,"uick") --> "QuickBasic" (Adds characters)
' Stuff$("Landlocked",5,4,"") --> "Landed" (Deletes characters)
' Stuff$("Trifle",4,1,"bb") --> "Tribble" (Replaces characters)
'
'Specifying a delnum of zero and a null char$ will do nothing.
'
'****************************************************************************
SUB TeleType (text$, delay)
'****************************************************************************
'Prints text one character at a time beginning at the current cursor location.
'
'The delay between each character being printed is measured in 1/100ths of a
' second (a delay of 100 would equal one second). If a value of zero or less
' is specified, the delay defaults to 5/100ths of a second. If a key is
' pressed during the SUB, the remainder of the string is printed without any
' delay.
'
'You could easily add some sound to this procedure. I recommend using SOUND
' 20000,1 after each letter except spaces and a delay of at least 7.
'
'****************************************************************************
FUNCTION TempName$ (path$) STATIC
'****************************************************************************
'Used to create a temporary filename. The filename will reside in the
' specified path, or in the current directory if path$ is null.
'
'The path$ argument may be passed with or without a trailing backslash.
'
'The filename will consist of a leading underscore, the current value of the
' system timer, and an extension of ".TMP".
'
'This standardized naming of temporary files will make it easy to delete any
' leftover temporary files all at once with a wildcard.
'
' Example filenames: _4573921.TMP _230117.TMP
'
' Example deletion command: KILL "_*.TMP"
'
'The filename given by TempName$() is stored in a static variable in case the
' function is called more than once in the same 100th of a second (It's not
' as unlikely as you think). This allows you to get two or more temporary
' filenames without having to create each one before getting the next one.
' The function can produce about 20 filenames per second when called in
' rapid succession. When called normally (once), I was unable to measure the
' time it took.
'
'See function HomePath$() for an example of use.
'
'****************************************************************************
FUNCTION VPage (p) STATIC
'****************************************************************************
'This function is used to allocate and release pages of video memory.
'
'To request (allocate) a page, pass zero as the argument. The function will
' return the page number that has been allocated, or zero if none are left.
'
'To release a video page when your procedure is finished with it, pass the
' page number as the argument to the function. The function will note the
' page as being available, and will return zero.
'
'The reason behind the function is so that procedures that need to use or
' swap video pages can do so without fear of using a page that may already
' be in use by another procedure.
'
'The function doesn't actually do anything at all with video pages. It
' merely keeps track of a small array that remembers which pages are in use.
'
'NOTE: This function assumes VGA video with 8 pages (0-7) of video memory for
' screen mode 0. It also assumes that page 0 is always in use, and does not
' bother to keep track of it.
'
'See function ColorSet() or any of the pop-up box functions for examples of
' use.
'
'****************************************************************************
SUB Wipe (row)
'****************************************************************************
'Clears a row on the screen.
'****************************************************************************
SUB WipeArea (row1, col1, row2, col2)
'****************************************************************************
'Clears an area of the screen.
'****************************************************************************
FUNCTION YesNo (msg$(), yesword$, noword$, parm())
'****************************************************************************
'Works like PickBox() but returns TRUE if the yes option is selected or FALSE
' if the no option is selected or ESC is pressed.
'
' parm(1) = top left row 0=Center
' parm(2) = top left column 0=Center
' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes.
' parm(4) = message justification <0=Left 0=Center >0=Right
' parm(5) = initial selected choice as TRUE or FALSE
'
'The function defaults to the words " Yes " and " No ". If these are what
' you want, pass null strings for the optional words. Common alternatives
' might be " Ok " and " Cancel ".
'
'See function PickBox() for more detailed information.
'
'****************************************************************************
FUNCTION YesNo2 (msg$, yesword$, noword$, parm())
'****************************************************************************
'Works like YesNo() but accepts a single message string rather than an array.
'
' parm(1) = top left row 0=Center
' parm(2) = top left column 0=Center
' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes.
' parm(4) = message justification <0=Left 0=Center >0=Right
' parm(5) = initial selected choice as TRUE or FALSE
'
'See functions YesNo() and PickBox() for more detailed information.
'
'****************************************************************************