home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
QBAS
/
IMB9008.ZIP
/
TABLMNGR.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-07-12
|
6KB
|
152 lines
DEFINT A-Z
'----------------------------------------------------------------
'Routines to manage a table of values in RAM
'----------------------------------------------------------------
'$INCLUDE: 'TABLMNGR.BI'
'Fixed-length table manager
CONST True = -1, False = 0, MaxTblSize = 32767
'----------------------------------------------------------------
'Create a symbol based on parameters for table
'----------------------------------------------------------------
FUNCTION SymCreate$ (Sym$, Parms AS SymbolTableParameters)
SymCreate$ = Parms.Delim + SymPad$(UCASE$(Sym$), Parms)
END FUNCTION
'----------------------------------------------------------------
'Create a table based on the parameters
'----------------------------------------------------------------
FUNCTION SymCreateTbl (Tbl$, Parms AS SymbolTableParameters, Nbr)
IF Nbr < 1 THEN Nbr = 1
Parms.TblLength = ((Parms.SWidth + LEN(Parms.Delim)) * Nbr)
IF Parms.TblLength <= MaxTblSize THEN
Tbl$ = SPACE$(Parms.TblLength)
FOR I = 0 TO Nbr - 1
TblOffset = (Parms.SWidth + LEN(Parms.Delim))
MID$(Tbl$, I * TblOffset + 1, 1) = Parms.Delim
NEXT I
Parms.NbrEntries = 0
Parms.NbrEmpty = Nbr
SymCreateTbl = True
ELSE
Parms.NbrEntries = 0
Parms.NbrEmpty = 0
Parms.TblLength = 0
SymCreateTbl = False
END IF
END FUNCTION
'----------------------------------------------------------------
'Define a symbol for the table
'----------------------------------------------------------------
FUNCTION SymDefine (Tbl$, Sym$, Parms AS SymbolTableParameters)
'If Symbol$ not blank and not previously defined and
'it doesn't contain the delimiter then add symbol
SymDefine = False
IF INSTR(Sym$, Parms.Delim) = 0 THEN
SymTest = SymDefined(Tbl$, Sym$, Parms) 'Check if defined
IF LEN(LTRIM$(RTRIM$(Sym$))) <> 0 AND NOT SymTest THEN
S$ = SymCreate(Sym$, Parms)
SymEmptyEntry$ = SymCreate$("", Parms)
SymLen = Parms.SWidth + 1
'Find an empty table entry or
'Adds entry to end of table
SPos = SymPos(Tbl$, "", Parms) 'Find first empty entry
IF SPos = 0 THEN 'Add to end of string
IF Parms.TblLength + SymLen > MaxTblSize THEN
EXIT FUNCTION
END IF
Tbl$ = Tbl$ + S$
Parms.TblLength = Parms.TblLength + SymLen
ELSE
MID$(Tbl$, SPos, SymLen) = S$ 'Set entry
Parms.NbrEmpty = Parms.NbrEmpty - 1
END IF
Parms.NbrEntries = Parms.NbrEntries + 1
SymDefine = True
END IF
END IF
END FUNCTION
'----------------------------------------------------------------
'Check to see if symbol defined in the table
'----------------------------------------------------------------
FUNCTION SymDefined (Tbl$, Sym$, Parms AS SymbolTableParameters)
IF SymPos(Tbl$, Sym$, Parms) = 0 THEN
SymDefined = False
ELSE
SymDefined = True
END IF
END FUNCTION
'----------------------------------------------------------------
'Display a table on the screen
'----------------------------------------------------------------
SUB SymDisplayTbl (Tbl$, Parms AS SymbolTableParameters)
PRINT " Number of active symbol entries = "; Parms.NbrEntries
PRINT " Number of empty symbol entries = "; Parms.NbrEmpty
PRINT "Press any key to see the table"
WHILE INKEY$ = "": WEND
PRINT
NbrSyms = Parms.TblLength \ (Parms.SWidth + 1)
FOR SymNbr = 1 TO NbrSyms
Sym$ = SymGet(Tbl$, SymNbr, Parms)
IF Sym$ <> "" THEN PRINT SymNbr, "|"; Sym$; "|"
IF INKEY$ <> "" THEN EXIT SUB
NEXT SymNbr
END SUB
'----------------------------------------------------------------
'Get a symbol based on the position number from table
'----------------------------------------------------------------
FUNCTION SymGet$ (Tbl$, SymNbr, Parms AS SymbolTableParameters)
SymGet$ = ""
IF SymNbr > 0 THEN
BegPos = (Parms.SWidth + 1) * (SymNbr - 1) + 2
SymGet$ = LTRIM$(RTRIM$(MID$(Tbl$, BegPos, Parms.SWidth)))
END IF
END FUNCTION
'----------------------------------------------------------------
'Pad a symbol with spaces on the end for maximum symbol length
'----------------------------------------------------------------
FUNCTION SymPad$ (Sym$, Parms AS SymbolTableParameters)
SymPad$ = LEFT$(Sym$ + SPACE$(Parms.SWidth), Parms.SWidth)
END FUNCTION
'----------------------------------------------------------------
'Find the position of symbol in the string table
'----------------------------------------------------------------
FUNCTION SymPos (Tbl$, Sym$, Parms AS SymbolTableParameters)
IF INSTR(Sym$, Parms.Delim) = 0 THEN
SymPos = INSTR(Tbl$, SymCreate$(Sym$, Parms))
ELSE
SymPos = 0 'Cannot have delimiter in symbol
END IF
END FUNCTION
'----------------------------------------------------------------
'Remove a symbol from the table
'----------------------------------------------------------------
FUNCTION SymUnDefine (Tbl$, Sym$, Parms AS SymbolTableParameters)
SymUnDefine = False
IF INSTR(Sym$, Parms.Delim) = 0 THEN 'Check this first
IF SymDefined(Tbl$, Sym$, Parms) THEN
SymEmptyEntry$ = SymCreate$("", Parms)
'Find the table location for Symbol$
SPos = SymPos(Tbl$, Sym$, Parms) 'Find empty entry
MID$(Tbl$, SPos) = SymEmptyEntry$ 'Clear entry
SymUnDefine = True
Parms.NbrEntries = Parms.NbrEntries - 1
Parms.NbrEmpty = Parms.NbrEmpty + 1
END IF
END IF
END FUNCTION