by S3KshuN8 » Fri Jan 03, 2014 11:59 pm
Here is some more (BASIC):
- Code: Select all
' ---------------------------------------------------------------------------
' OPTIONAL FUNCTION DECLARATIONS
' ---------------------------------------------------------------------------
'
' PRIMARY Tool
'
DECLARE FUNCTION CheckMate&& (Op AS _INTEGER64, InString AS STRING) ' NOT yet coded! '
'
' PRIMARY Tool
'
DECLARE FUNCTION Check& (Op AS LONG, InString AS STRING)
'
' Check&() Aliases
DECLARE FUNCTION CharV% (InString AS STRING) ' Single Char Value
DECLARE FUNCTION Value% (InString AS STRING) ' +/-/ñ Short Integer
DECLARE FUNCTION Integrate& (InString AS STRING) ' +/-/ñ Long Integer
'
' PRIMARY Tool
'
DECLARE FUNCTION Build$ (Op AS INTEGER, inINT AS INTEGER, inDBL AS LONG)
'
' Build$() Aliases
DECLARE FUNCTION SChar$ (inINT AS INTEGER) ' Single Char (Short INT)
DECLARE FUNCTION DChar$ (inINT AS INTEGER) ' Double Char (Short INT)
DECLARE FUNCTION ReadS$ (inINT AS INTEGER) ' Read Short Integer
DECLARE FUNCTION GetUS$ (inINT AS INTEGER) ' Get UNSIGNED Short
DECLARE FUNCTION FChar$ (inDBL AS LONG) ' Five Char (Long INT)
DECLARE FUNCTION ReadL$ (inDBL AS LONG) ' Read Long Integer
DECLARE FUNCTION GetUL$ (inDBL AS LONG) ' Get UNSIGNED Long
'
' Related Functions
DECLARE FUNCTION ReadD$ (inDFP AS DOUBLE) ' Read Double as Integer
DECLARE FUNCTION GetUD$ (inDFP AS DOUBLE) ' Get Double as UNSIGNED
'
' PRIMARY Tool
'
DECLARE FUNCTION Convert$ (Op AS INTEGER, InString AS STRING)
'
' Convert() Aliases
DECLARE FUNCTION Squeeze$ (InString AS STRING)
DECLARE FUNCTION Stretch$ (InString AS STRING)
'
' Base-10-Format Arithmetic
'
DECLARE FUNCTION BTen$ (InTop AS STRING, Op AS STRING, InBot AS STRING) ' old one done in 4.5 '
DECLARE FUNCTION BaseTen$ (InTop AS STRING, Op AS STRING, InBot AS STRING) ' WIP using QB64 '
'
' Base-64 String Arithmetic
'
DECLARE FUNCTION Fixed$ (Size AS INTEGER, InTop AS STRING, Op AS STRING, InBot AS STRING)
DECLARE FUNCTION VLFP$ (InTop AS STRING, Op AS STRING, InBot AS STRING) ' UNFinished '
'
And the functions themselves:
- Code: Select all
' ---------------------------------------------------------------------------
' FUNCTION BaseTen$ (InTop$, Op$, InBot$) Base-10-Format String Math
' ---------------------------------------------------------------------------
'
' Valid Base-Ten-Format strings begin with a sign symbol ("+" or "-") and must contain exactly one decimal point. No other non-numeric characters are
' allowed. (Leading or trailing spaces, commas, currency symbols, duplicate signs or decimal points, and so forth, will cause string testing to fail.)
'
' ---------------------------------------------------------------------------
' FUNCTION BaseTen$ (InTop$, Op$, InBot$) Base-10-Format String Math
' ---------------------------------------------------------------------------
FUNCTION BaseTen$ (InTop AS STRING, Op AS STRING, InBot AS STRING)
BaseTen$ = "" ' function unfinished
'; Step One: Test both strings and get Decimal Point locations ;'
OpCode&& = 10
TDP&& = CheckMate&&(OpCode&&, InTop$)
BDP&& = CheckMate&&(OpCode&&, InBot$)
IF TDP&& < 0 OR BDP&& < 0 THEN EXIT FUNCTION
'; Step Two: Process both signs for later (at this point it is known that the left character is an explicit sign) ;'
'ASC(241)===character designating an explicitly unsigned number';(43)==="+";(45)==="-";'
SELECT CASE ASC(LEFT$(InTop$, 1))
CASE 43
TSign&& = 1
CASE 45
TSign&& = -1
CASE 126 OR 241
'both will work as the designation of an unsigned number';(126)==="~" tilde , (241)==="ñ" ASC(241);'
TSign&& = ASC(LEFT$(InTop$, 1)) 'Preserves the original'
CASE ELSE
'only the four above are considered valid sign designations'
TSign&& = 0 'indicating an error'
END SELECT
SELECT CASE ASC(LEFT$(InBot$, 1))
CASE 43
BSign&& = 1
CASE 45
BSign&& = -1
CASE 126 OR 241
'both will work as the designation of an unsigned number';(126)==="~" tilde , (241)==="ñ" ASC(241);'
BSign&& = ASC(LEFT$(InBot$, 1))
CASE ELSE
'only the four above are considered valid sign designations'
BSign&& = 0 'indicating an error'
END SELECT
IF TSign&& = 0 OR BSign&& = 0 THEN EXIT FUNCTION
'; Step Three: Calculate the number of elements required to express the value of each string as an array ;'
'; Step Four: DIM the three arrays (TOP, BOT, TOT) and then push the string data in, lined up at the decimal point. ;'
'; Step Five: Perform the requested Op$ on the arrays ;'
'; Step Six: Convert the TOT from array data to a Base-Ten-Format string and then ERASE all three arrays used ;'
BaseTen$ = "" ' function unfinished
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION BTen$ (InTop$, Op$, InBot$) Base-10-Format String Math
' ---------------------------------------------------------------------------
' Valid Base-10-Format strings begin with a sign symbol ("+" or "-") and must
' contain exactly one decimal point. No other non-numeric characters are
' allowed. (Leading or trailing spaces, commas, currency symbols, duplicate
' signs or decimal points, and so forth, will cause string testing to fail.)
'
' ---------------------------------------------------------------------------
' FUNCTION BTen$ (InTop$, Op$, InBot$) Base-10-Format String Math
' ---------------------------------------------------------------------------
FUNCTION BTen$ (InTop AS STRING, Op AS STRING, InBot AS STRING)
TDP& = Check&(10, InTop$)
BDP& = Check&(10, InBot$)
IF TDP& < 0 OR BDP& < 0 THEN EXIT FUNCTION
TSign& = Check&(11, InTop$)
BSign& = Check&(11, InBot$)
' Calculate Array Size
IF Op$ = CHR$(43) OR Op$ = CHR$(45) THEN
' "+" (Add) OR "-" (Subtract)
Temp& = 9
ELSEIF Op$ = CHR$(42) OR Op$ = CHR$(50) THEN
' "*" (Multiply) OR "2" (SQRT Multiply)
Temp& = 7
ELSE
EXIT FUNCTION
END IF
' LSA (Left Side of Array)
LSA& = TDP& - 2
TLS& = LSA& \ Temp&
IF LSA& MOD Temp& > 0 THEN
TLS& = TLS& + 1
DO WHILE (TLPad& + LSA&) MOD Temp& > 0
TLPad& = TLPad& + 1
LOOP
END IF
LSA& = BDP& - 2
BLS& = LSA& \ Temp&
IF LSA& MOD Temp& > 0 THEN
BLS& = BLS& + 1
DO WHILE (BLPad& + LSA&) MOD Temp& > 0
BLPad& = BLPad& + 1
LOOP
END IF
IF TLS& >= BLS& THEN LSA& = TLS& ELSE LSA& = BLS&
' RSA (Right Side of Array)
RSA& = LEN(InTop$) - TDP&
TRS& = RSA& \ Temp&
IF RSA& MOD Temp& > 0 THEN
TRS& = TRS& + 1
DO WHILE (TRPad& + RSA&) MOD Temp& > 0
TRPad& = TRPad& + 1
LOOP
END IF
RSA& = LEN(InBot$) - BDP&
BRS& = RSA& \ Temp&
IF RSA& MOD Temp& > 0 THEN
BRS& = BRS& + 1
DO WHILE (BRPad& + RSA&) MOD Temp& > 0
BRPad& = BRPad& + 1
LOOP
END IF
IF TRS& >= BRS& THEN RSA& = TRS& ELSE RSA& = BRS&
IF Op$ = CHR$(43) OR Op$ = CHR$(45) THEN
' "+" (Add) OR "-" (Subtract)
DIM Result(1 TO (LSA& + RSA&)) AS LONG
IF (Op$ = CHR$(43) AND TSign& = BSign&) OR (Op$ = CHR$(45) AND TSign& <> BSign&) THEN
' Add Absolute Values and Return Top Sign
' Left Side
FOR I& = 1 TO LSA&
' Top
IF I& <= (LSA& - TLS&) THEN
''' Result(I&) = Result(I&) + 0
ELSEIF I& = (1 + LSA& - TLS&) THEN
Result(I&) = VAL(MID$(InTop$, 2, (9 - TLPad&)))
TDP& = 11 - TLPad&
ELSE
Result(I&) = VAL(MID$(InTop$, TDP&, 9))
TDP& = TDP& + 9
END IF
' Bottom
IF I& <= (LSA& - BLS&) THEN
''' Result(I&) = Result(I&) + 0
ELSEIF I& = (1 + LSA& - BLS&) THEN
Result(I&) = Result(I&) + VAL(MID$(InBot$, 2, (9 - BLPad&)))
BDP& = 11 - BLPad&
ELSE
Result(I&) = Result(I&) + VAL(MID$(InBot$, BDP&, 9))
BDP& = BDP& + 9
END IF
NEXT I&
' Right Side
TDP& = TDP& + 1: BDP& = BDP& + 1
FOR I& = (LSA& + 1) TO (LSA& + RSA&)
' Top
IF I& > (LSA& + TRS&) THEN
''' Result(I&) = Result(I&) + 0
ELSEIF I& = (LSA& + TRS&) THEN
Result(I&) = (10 ^ TRPad&) * VAL(RIGHT$(InTop$, (9 - TRPad&)))
ELSE
Result(I&) = VAL(MID$(InTop$, TDP&, 9))
TDP& = TDP& + 9
END IF
' Bottom
IF I& > (LSA& + BRS&) THEN
''' Result(I&) = Result(I&) + 0
ELSEIF I& = (LSA& + BRS&) THEN
Result(I&) = Result(I&) + (10 ^ BRPad&) * VAL(RIGHT$(InBot$, (9 - BRPad&)))
ELSE
Result(I&) = Result(I&) + VAL(MID$(InBot$, BDP&, 9))
BDP& = BDP& + 9
END IF
NEXT I&
' Carry
FOR I& = (LSA& + RSA&) TO 2 STEP -1
IF Result(I&) >= 1000000000 THEN
Result(I& - 1) = Result(I& - 1) + 1
Result(I&) = Result(I&) - 1000000000
END IF
NEXT I&
' Return Sign
IF TSign& = 1 THEN RetStr$ = CHR$(43) ELSE RetStr$ = CHR$(45)
ELSE
' Compare Absolute Values
IF TDP& > BDP& THEN
Compare& = 1
ELSEIF TDP& < BDP& THEN
Compare& = -1
ELSE
IF LEN(InTop$) > LEN(InBot$) THEN Compare& = LEN(InBot$) ELSE Compare& = LEN(InTop$)
FOR I& = 2 TO Compare&
IF VAL(MID$(InTop$, I&, 1)) > VAL(MID$(InBot$, I&, 1)) THEN
Compare& = 1
EXIT FOR
ELSEIF VAL(MID$(InTop$, I&, 1)) < VAL(MID$(InBot$, I&, 1)) THEN
Compare& = -1
EXIT FOR
END IF
NEXT I&
IF Compare& > 1 THEN
IF LEN(InTop$) > LEN(InBot$) THEN
Compare& = 1
ELSEIF LEN(InTop$) < LEN(InBot$) THEN
Compare& = -1
ELSE
Compare& = 0
END IF
END IF
END IF
' Conditional Subtraction
IF Compare& = 1 THEN
' Subtract Bottom from Top and Return Top Sign
' Top
Result(1) = VAL(MID$(InTop$, 2, (9 - TLPad&)))
TDP& = 11 - TLPad&
FOR I& = 2 TO LSA&
Result(I&) = VAL(MID$(InTop$, TDP&, 9))
TDP& = TDP& + 9
NEXT I&
TDP& = TDP& + 1
FOR I& = (LSA& + 1) TO (LSA& + TRS& - 1)
Result(I&) = VAL(MID$(InTop$, TDP&, 9))
TDP& = TDP& + 9
NEXT I&
Result(LSA& + TRS&) = 10& ^ TRPad& * VAL(RIGHT$(InTop$, (9 - TRPad&)))
' Bottom
BDP& = (LEN(InBot$) - 17) + BRPad&
FOR I& = (LSA& + BRS&) TO (1 + LSA& - BLS&) STEP -1
IF I& = LSA& THEN BDP& = BDP& - 1
IF I& = (LSA& + BRS&) THEN
Temp& = (10& ^ BRPad&) * VAL(RIGHT$(InBot$, (9 - BRPad&)))
ELSEIF I& = (1 + LSA& - BLS&) THEN
Temp& = VAL(MID$(InBot$, 2, (9 - BLPad&)))
ELSE
Temp& = VAL(MID$(InBot$, BDP&, 9))
BDP& = BDP& - 9
END IF
IF Result(I&) < Temp& THEN
' Borrow
FOR J& = (I& - 1) TO 1 STEP -1
IF Result(J&) = 0 THEN
Result(J&) = 999999999
ELSE
Result(J&) = Result(J&) - 1
EXIT FOR
END IF
NEXT J&
Result(I&) = Result(I&) + 1000000000
END IF
Result(I&) = Result(I&) - Temp&
NEXT I&
' Return Sign
IF TSign& = 1 THEN RetStr$ = CHR$(43) ELSE RetStr$ = CHR$(45)
ELSEIF Compare& = -1 THEN
' Subtract Top from Bottom and Return Bottom Sign
' Bottom
Result(1) = VAL(MID$(InBot$, 2, (9 - BLPad&)))
BDP& = 11 - BLPad&
FOR I& = 2 TO LSA&
Result(I&) = VAL(MID$(InBot$, BDP&, 9))
BDP& = BDP& + 9
NEXT I&
BDP& = BDP& + 1
FOR I& = (LSA& + 1) TO (LSA& + BRS& - 1)
Result(I&) = VAL(MID$(InBot$, BDP&, 9))
BDP& = BDP& + 9
NEXT I&
Result(LSA& + BRS&) = 10& ^ BRPad& * VAL(RIGHT$(InBot$, (9 - BRPad&)))
' Top
TDP& = (LEN(InTop$) - 17) + TRPad&
FOR I& = (LSA& + TRS&) TO (1 + LSA& - TLS&) STEP -1
IF I& = LSA& THEN TDP& = TDP& - 1
IF I& = (LSA& + TRS&) THEN
Temp& = (10& ^ TRPad&) * VAL(RIGHT$(InTop$, (9 - TRPad&)))
ELSEIF I& = (1 + LSA& - TLS&) THEN
Temp& = VAL(MID$(InTop$, 2, (9 - TLPad&)))
ELSE
Temp& = VAL(MID$(InTop$, TDP&, 9))
TDP& = TDP& - 9
END IF
IF Result(I&) < Temp& THEN
' Borrow
FOR J& = (I& - 1) TO 1 STEP -1
IF Result(J&) = 0 THEN
Result(J&) = 999999999
ELSE
Result(J&) = Result(J&) - 1
EXIT FOR
END IF
NEXT J&
Result(I&) = Result(I&) + 1000000000
END IF
Result(I&) = Result(I&) - Temp&
NEXT I&
' Build Return Sign
IF BSign& = 1 THEN RetStr$ = CHR$(43) ELSE RetStr$ = CHR$(45)
ELSE
' Result will always be 0
LSA& = 1: RSA& = 1
RetStr$ = CHR$(43)
END IF
END IF
' Generate Return String
RetStr$ = RetStr$ + LTRIM$(STR$(Result(1)))
FOR I& = 2 TO LSA&
RetStr$ = RetStr$ + RIGHT$(STRING$(8, 48) + LTRIM$(STR$(Result(I&))), 9)
NEXT I&
RetStr$ = RetStr$ + CHR$(46)
FOR I& = (LSA& + 1) TO (LSA& + RSA&)
RetStr$ = RetStr$ + RIGHT$(STRING$(8, 48) + LTRIM$(STR$(Result(I&))), 9)
NEXT I&
ERASE Result
ELSEIF Op$ = CHR$(42) THEN
' * (Multiply)
DIM TArray(1 TO (LSA& + RSA&)) AS LONG
DIM BArray(1 TO (LSA& + RSA&)) AS LONG
DIM ResDBL(0 TO (LSA& + RSA&)) AS DOUBLE
' Push String Data Into Array
FOR I& = 1 TO LSA&
IF I& <= (LSA& - TLS&) THEN
''' TArray(I&) = TArray(I&) + 0
ELSEIF I& = (1 + LSA& - TLS&) THEN
TArray(I&) = VAL(MID$(InTop$, 2, (7 - TLPad&)))
TDP& = 9 - TLPad&
ELSE
TArray(I&) = VAL(MID$(InTop$, TDP&, 7))
TDP& = TDP& + 7
END IF
IF I& <= (LSA& - BLS&) THEN
''' BArray(I&) = BArray(I&) + 0
ELSEIF I& = (1 + LSA& - BLS&) THEN
BArray(I&) = VAL(MID$(InBot$, 2, (7 - BLPad&)))
BDP& = 9 - BLPad&
ELSE
BArray(I&) = VAL(MID$(InBot$, BDP&, 7))
BDP& = BDP& + 7
END IF
NEXT I&
TDP& = TDP& + 1: BDP& = BDP& + 1
FOR I& = (LSA& + 1) TO (LSA& + RSA&)
IF I& > (LSA& + TRS&) THEN
''' TArray(I&) = TArray(I&) + 0
ELSEIF I& = (LSA& + TRS&) THEN
TArray(I&) = 10 ^ TRPad& * VAL(RIGHT$(InTop$, (7 - TRPad&)))
ELSE
TArray(I&) = VAL(MID$(InTop$, TDP&, 7))
TDP& = TDP& + 7
END IF
IF I& > (LSA& + BRS&) THEN
''' BArray(I&) = BArray(I&) + 0
ELSEIF I& = (LSA& + BRS&) THEN
BArray(I&) = 10 ^ BRPad& * VAL(RIGHT$(InBot$, (7 - BRPad&)))
ELSE
BArray(I&) = VAL(MID$(InBot$, BDP&, 7))
BDP& = BDP& + 7
END IF
NEXT I&
' Multiply from Arrays to Array
FOR I& = (LSA& + TRS&) TO (1 + LSA& - TLS&) STEP -1
FOR J& = (LSA& + BRS&) TO (1 + LSA& - BLS&) STEP -1
Temp# = 1# * TArray(I&) * BArray(J&)
IF (I& + J&) MOD 2 = 0 THEN
TL& = INT(Temp# / 10000000)
TR& = Temp# - 10000000# * TL&
ResDBL(((I& + J&) \ 2) - 1) = ResDBL(((I& + J&) \ 2) - 1) + TL&
ResDBL((I& + J&) \ 2) = ResDBL((I& + J&) \ 2) + 10000000# * TR&
ELSE
ResDBL((I& + J&) \ 2) = ResDBL((I& + J&) \ 2) + Temp#
END IF
IF ResDBL((I& + J&) \ 2) >= 100000000000000# THEN
Temp# = ResDBL((I& + J&) \ 2)
TL& = INT(Temp# / 100000000000000#)
ResDBL(((I& + J&) \ 2) - 1) = ResDBL(((I& + J&) \ 2) - 1) + TL&
ResDBL((I& + J&) \ 2) = Temp# - 100000000000000# * TL&
END IF
NEXT J&
NEXT I&
ERASE TArray, BArray
' Generate Return String
IF (TSign& * BSign&) = 1 THEN RetStr$ = CHR$(43) ELSE RetStr$ = CHR$(45)
RetStr$ = RetStr$ + LTRIM$(STR$(ResDBL(0)))
FOR I& = 1 TO (LSA&)
RetStr$ = RetStr$ + RIGHT$(STRING$(13, 48) + LTRIM$(STR$(ResDBL(I&))), 14)
NEXT I&
RetStr$ = LEFT$(RetStr$, LEN(RetStr$) - 7) + CHR$(46) + RIGHT$(RetStr$, 7)
FOR I& = (LSA& + 1) TO (LSA& + RSA&)
RetStr$ = RetStr$ + RIGHT$(STRING$(13, 48) + LTRIM$(STR$(ResDBL(I&))), 14)
NEXT I&
ERASE ResDBL
ELSEIF Op$ = CHR$(50) THEN
' 2 (SQRT Multiply)
DIM IArray(1 TO (LSA& + RSA&)) AS LONG
DIM ResDBL(0 TO (LSA& + RSA&)) AS DOUBLE
' Push String Data Into Array
FOR I& = 1 TO LSA&
IF I& <= (LSA& - TLS&) THEN
''' IArray(I&) = IArray(I&) + 0
ELSEIF I& = (1 + LSA& - TLS&) THEN
IArray(I&) = VAL(MID$(InTop$, 2, (7 - TLPad&)))
TDP& = 9 - TLPad&
ELSE
IArray(I&) = VAL(MID$(InTop$, TDP&, 7))
TDP& = TDP& + 7
END IF
NEXT I&
TDP& = TDP& + 1
FOR I& = (LSA& + 1) TO (LSA& + RSA&)
IF I& > (LSA& + TRS&) THEN
''' IArray(I&) = IArray(I&) + 0
ELSEIF I& = (LSA& + TRS&) THEN
IArray(I&) = 10 ^ TRPad& * VAL(RIGHT$(InTop$, (7 - TRPad&)))
ELSE
IArray(I&) = VAL(MID$(InTop$, TDP&, 7))
TDP& = TDP& + 7
END IF
NEXT I&
' SQRT Multiply from Array to Array
FOR I& = (LSA& + TRS&) TO 1 STEP -1
FOR J& = I& TO 1 STEP -1
Temp# = 1# * IArray(I&) * IArray(J&)
IF I& <> J& THEN Temp# = Temp# * 2
IF (I& + J&) MOD 2 = 0 THEN
TL& = INT(Temp# / 10000000)
TR& = Temp# - 10000000# * TL&
ResDBL(((I& + J&) \ 2) - 1) = ResDBL(((I& + J&) \ 2) - 1) + TL&
ResDBL((I& + J&) \ 2) = ResDBL((I& + J&) \ 2) + 10000000# * TR&
ELSE
ResDBL((I& + J&) \ 2) = ResDBL((I& + J&) \ 2) + Temp#
END IF
IF ResDBL((I& + J&) \ 2) >= 100000000000000# THEN
Temp# = ResDBL((I& + J&) \ 2)
TL& = INT(Temp# / 100000000000000#)
ResDBL(((I& + J&) \ 2) - 1) = ResDBL(((I& + J&) \ 2) - 1) + TL&
ResDBL((I& + J&) \ 2) = Temp# - 100000000000000# * TL&
END IF
NEXT J&
NEXT I&
ERASE IArray
' Generate Return String
IF (TSign& * BSign&) = 1 THEN RetStr$ = CHR$(43) ELSE RetStr$ = CHR$(45)
RetStr$ = RetStr$ + LTRIM$(STR$(ResDBL(0)))
FOR I& = 1 TO (LSA&)
RetStr$ = RetStr$ + RIGHT$(STRING$(13, 48) + LTRIM$(STR$(ResDBL(I&))), 14)
NEXT I&
RetStr$ = LEFT$(RetStr$, LEN(RetStr$) - 7) + CHR$(46) + RIGHT$(RetStr$, 7)
' Don't usually want the full right side for this, just enough to check the
' actual result against the expected result, which is probably an integer.
' Uncomment the three lines below when trying to find an oddball square root.
'FOR I& = (LSA& + 1) TO (LSA& + RSA&)
' RetStr$ = RetStr$ + RIGHT$(STRING$(13, 48) + LTRIM$(STR$(ResDBL(I&))), 14)
'NEXT I&
ERASE ResDBL
END IF
' Trim Leading and Trailing Zeroes
DO WHILE MID$(RetStr$, 2, 1) = CHR$(48) AND MID$(RetStr$, 3, 1) <> CHR$(46)
RetStr$ = LEFT$(RetStr$, 1) + RIGHT$(RetStr$, LEN(RetStr$) - 2)
LOOP
DO WHILE RIGHT$(RetStr$, 1) = CHR$(48) AND RIGHT$(RetStr$, 2) <> CHR$(46) + CHR$(48)
RetStr$ = LEFT$(RetStr$, LEN(RetStr$) - 1)
LOOP
BTen$ = RetStr$
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION Build$ (Op%, inINT%, inDBL&) Multi-Purpose String Builder
' ---------------------------------------------------------------------------
'
' * Op% = Operation(s) to perform
' Expected variable(s) [0 = variable ignored]
'
' { 000000 } = Determine Sign
' (0, inINT%, inDBL&)
' Returns: "+" if both input variables are positive
' "-" if an input variable is negative
'
' { 000001 } = Char Value of inINT%
' (1, {0-63}, 0)
' Returns: One Base-64 Char OR
' "<" if inINT% is below 0
' ">" if inINT% is above 63
'
' { 000002 } = Limited Value of inINT%
' (2, {0-4095}, 0)
' Returns: Two Base-64 Chars OR
' "<" if inINT% is below 0
' ">" if inINT% is above 4095
'
' { 000003 } = Signed Value of inINT%
' (3, inINT%, 0)
' Returns: {"-800" - "-001"} if inINT% is negative
' { "000" - "7||"} if inINT% is positive
'
' { 000004 } = UNSIGNED Value of inINT%
' (4, inINT%, 0)
' Returns: {"ñ000" - "ñF||"}
'
' { 000005 } = Limited Value of inDBL&
' (5, 0, {0-1073741823})
' Returns: Five Base-64 Chars OR
' "<" if inDBL& is below 0
' ">" if inDBL& is above 1073741823
'
' { 000006 } = Signed Value of inDBL&
' (6, 0, inDBL&)
' Returns: {"-200000" - "-000001"} if inDBL& is negative
' { "000000" - "1|||||"} if inDBL& is positive
'
' { 000007 } = UNSIGNED Value of inDBL&
' (7, 0, inDBL&)
' Returns: {"ñ000000" - "ñ3|||||"}
'
' Additional operations to be added later.
' (i.e. combined values, Reciprocal$, SQRT$, Pi$, etc.)
'
' ---------------------------------------------------------------------------
' FUNCTION Build$ (Op%, inINT%, inDBL&) Multi-Purpose String Builder
' ---------------------------------------------------------------------------
FUNCTION Build$ (Op AS INTEGER, inINT AS INTEGER, inDBL AS LONG)
' Minimum Stack: 128 (aliases +24)
SELECT CASE Op%
CASE 0
' { 000000 } = Determine Sign
' (0, inINT%, inDBL&)
' Returns: "+" if all input variables are positive
' "-" if one or more input variables is negative
IF inINT% >= 0 AND inDBL& >= 0 THEN
RetStr$ = CHR$(43)
ELSE
RetStr$ = CHR$(45)
END IF
CASE 1
' { 000001 } = Char Value of inINT%
' (1, {0-63}, 0)
' Returns: One Base-64 Char OR
' "<" if inINT% is below 0
' ">" if inINT% is above 63
SELECT CASE inINT%
CASE IS < 0
RetStr$ = CHR$(60)
CASE 0 TO 9
RetStr$ = CHR$(inINT% + 48)
CASE 10 TO 35
RetStr$ = CHR$(inINT% + 55)
CASE 36 TO 61, 63
RetStr$ = CHR$(inINT% + 61)
CASE 62
RetStr$ = CHR$(95)
CASE IS > 63
RetStr$ = CHR$(62)
END SELECT
CASE 2
' { 000002 } = Limited Value of inINT%
' (2, {0-4095}, 0)
' Returns: Two Base-64 Chars OR
' "<" if inINT% is below 0
' ">" if inINT% is above 4095
SELECT CASE inINT%
CASE IS < 0
RetStr$ = CHR$(60)
CASE 0 TO 4095
Y% = inINT% \ 64
Z% = inINT% MOD 64
SELECT CASE Y%
CASE 0 TO 9
RetStr$ = CHR$(Y% + 48)
CASE 10 TO 35
RetStr$ = CHR$(Y% + 55)
CASE 36 TO 61, 63
RetStr$ = CHR$(Y% + 61)
CASE 62
RetStr$ = CHR$(95)
END SELECT
SELECT CASE Z%
CASE 0 TO 9
RetStr$ = RetStr$ + CHR$(Z% + 48)
CASE 10 TO 35
RetStr$ = RetStr$ + CHR$(Z% + 55)
CASE 36 TO 61, 63
RetStr$ = RetStr$ + CHR$(Z% + 61)
CASE 62
RetStr$ = RetStr$ + CHR$(95)
END SELECT
CASE IS > 4095
RetStr$ = CHR$(62)
END SELECT
CASE 3
' { 000003 } = Signed Value of inINT%
' (3, inINT%, 0)
' Returns: {"-800" - "-001"} if inINT% is negative
' { "000" - "7||"} if inINT% is positive
SELECT CASE inINT%
CASE -32768
RetStr$ = CHR$(45) + CHR$(56) + STRING$(2, 48)
CASE -32767 TO -1
X% = ABS(inINT%)
Y% = X% \ 4096
Z% = X% MOD 4096
RetStr$ = CHR$(45) + CHR$(Y% + 48) + Build$(2, Z%, 0)
CASE 0 TO 32767
Y% = inINT% \ 4096
Z% = inINT% MOD 4096
RetStr$ = CHR$(Y% + 48) + Build$(2, Z%, 0)
END SELECT
CASE 4
' { 000004 } = UNSIGNED Value of inINT%
' (4, inINT%, 0)
' Returns: {"ñ000" - "ñF||"}
SELECT CASE inINT%
CASE -32768 TO -1
Z& = 65536 + inINT%
Y% = Z& \ 4096
Z% = Z& MOD 4096
SELECT CASE Y%
CASE 0 TO 9
Y% = Y% + 48
CASE 10 TO 15
Y% = Y% + 55
END SELECT
RetStr$ = CHR$(241) + CHR$(Y%) + Build$(2, Z%, 0)
CASE 0 TO 32767
Y% = inINT% \ 4096
Z% = inINT% - 4096 * Y%
RetStr$ = CHR$(241) + CHR$(Y% + 48) + Build$(2, Z%, 0)
END SELECT
CASE 5
' { 000005 } = Limited Value of inDBL&
' (5, 0, {0-1073741823})
' Returns: Five Base-64 Chars OR
' "<" if inDBL& is below 0
' ">" if inDBL& is above 1073741823
SELECT CASE inDBL&
CASE IS < 0
RetStr$ = CHR$(60)
CASE 0 TO 1073741823
Z& = inDBL&
X% = Z& \ 16777216
Z& = Z& MOD 16777216
Y% = Z& \ 4096
Z% = Z& MOD 4096
RetStr$ = Build$(1, X%, 0) + Build$(2, Y%, 0) + Build$(2, Z%, 0)
CASE IS > 1073741823
RetStr$ = CHR$(62)
END SELECT
CASE 6
' { 000006 } = Signed Value of inDBL&
' (6, 0, inDBL&)
' Returns: {"-200000" - "-000001"} if inDBL& is negative
' { "000000" - "1|||||"} if inDBL& is positive
SELECT CASE inDBL&
CASE IS = (0 - 2 ^ 31)
RetStr$ = CHR$(45) + CHR$(50) + STRING$(5, 48)
CASE -2147483647 TO -1
Z& = ABS(inDBL&)
X% = Z& \ 16777216
Z& = Z& MOD 16777216
Y% = Z& \ 4096
Z% = Z& MOD 4096
RetStr$ = CHR$(45) + Build$(2, X%, 0) + Build$(2, Y%, 0) + Build$(2, Z%, 0)
CASE 0 TO 2147483647
Z& = inDBL&
X% = Z& \ 16777216
Z& = Z& MOD 16777216
Y% = Z& \ 4096
Z% = Z& MOD 4096
RetStr$ = Build$(2, X%, 0) + Build$(2, Y%, 0) + Build$(2, Z%, 0)
END SELECT
CASE 7
' { 000007 } = UNSIGNED Value of inDBL&
' (7, 0, inDBL&)
' Returns: {"ñ000000" - "ñ3|||||"}
SELECT CASE inDBL&
CASE IS = (0 - 2 ^ 31)
RetStr$ = CHR$(241) + CHR$(50) + STRING$(5, 48)
CASE -2147483647 TO -1
DIM ZZ(0) AS DOUBLE
ZZ(0) = 4294967296# + inDBL&
X% = INT(ZZ(0) / 16777216)
ZZ(0) = ZZ(0) - 16777216# * X% 'MOD causes an overflow here
Z& = ZZ(0): ERASE ZZ
Y% = Z& \ 4096
Z% = Z& MOD 4096
RetStr$ = CHR$(241) + Build$(2, X%, 0) + Build$(2, Y%, 0) + Build$(2, Z%, 0)
CASE 0 TO 2147483647
Z& = inDBL&
X% = Z& \ 16777216
Z& = Z& MOD 16777216
Y% = Z& \ 4096
Z% = Z& MOD 4096
RetStr$ = CHR$(241) + Build$(2, X%, 0) + Build$(2, Y%, 0) + Build$(2, Z%, 0)
END SELECT
CASE ELSE
'RetStr$ = ""
END SELECT
Build$ = RetStr$
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION CharV% (InString$) Simplified Check&() Operation
' ---------------------------------------------------------------------------
FUNCTION CharV% (InString AS STRING)
CharV% = Check&(65, InString$)
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION Check& (Op&, InString$) Multi-Purpose String Tester
' ---------------------------------------------------------------------------
'
' * Op& = Type of string to expect and/or operation to perform
'
' { 000 } = Test Single Character for "0"
' { 001 } = Test Single Character for [ "0" ; "1" ]
' { 002 } = Test Single Character for [ "0" ; "1" ; "2" ; "3" ]
' { 003 } = Test Single Character for [ "0" "1" "2" "3" "4" "5" "6" "7" ]
' { 004 } = Test Single Character for [ 0 1 2 3 4 5 6 7 8 9 A B C D E F ]
' { 005 } = Test Single Character for [ "0" - "9", "A" - "V" ]
' { 006 } = Test Single Character for [ "0"-"9","A"-"Z","a"-"z","_","|" ]
' { 007 } = Test Single Character for ASCII value { 000 - 127 }
' { 008 } = Test Single Character for ASCII value { 128 - 255 }
'
' { 009 } = ( 9) Test String for Exclusive Base-10
' { 00A } = (10) Test Base-10-Format String ( *!* ALTERS InString$ *!* )
'
' { 00B } = (11) Read Sign ("+", "-", or "ñ")
' { 00C } = (12) Read and Strip Sign ( *!* ALTERS InString$ *!* )
' { 00D } = (13) Find Decimal Point
'
' { 00G } = (16) Test Hexadecimal String ( all { "0" - "9", "A" - "F" } )
' { 00O } = (24) Test Octal String ( all { "0" to "7" } )
' { 00W } = (32) Test Base-32 String ( all { "0" - "9", "A" - "V" } )
' { 010 } = (64) Test Base-64 String ( all { 0-9,A-Z,a-z, "_","|" } )
'
' { 011 } = (65) Read Base-64 String ( 1 Char only)
' { 012 } = (66) Read Base-64 String ( 2 Chars only)
' { 014 } = (68) Read Base-64 String ( 4 Chars only)
' { 015 } = (69) Read Base-64 String ( 5 Chars only)
' { 01A } = (74) Read Base-64 String (10 Ch. HIGH DWORD OVERWRITES Op& ! )
'
' { 023 } = Test Short-INT compatibility (131)
' ( { -800 to +7|| } implicitly signed,
' { ñ000 to ñF|| } explicitly unsigned )
'
' { 026 } = Test Long-INT compatibility (134)
' ( { -200000 to +1||||| } implicitly signed,
' { ñ000000 to ñ3||||| } explicitly unsigned )
'
' { 02B } = Test 64-bit-INT compatibility (139)
' ( { -80000000000 to +7|||||||||| } implicitly signed,
' { ñ00000000000 to ñF|||||||||| } explicitly unsigned )
'
' { 033 } = Return integer value of Short-INT compatible string (195)
' ( { -800 to +7|| } implicitly signed,
' { ñ000 to ñF|| } explicitly unsigned )
'
' { 036 } = Return integer value of Long-INT compatible string (198)
' ( { -200000 to +1||||| } implicitly signed,
' { ñ000000 to ñ3||||| } explicitly unsigned )
'
' { 03B } = ********** RESERVED FOR FORWARD COMPATIBILITY ********** (203)
' { 03B } = Return integer value of 64-bit-INT compatibile string (203)
' ( { -80000000000 to +7|||||||||| } implicitly signed,
' { ñ00000000000 to ñF|||||||||| } explicitly unsigned )
'
' { 100 } = Test VLFP-Format String (4096)
' { 101 - 1|| } are reserved for VLFP processing
'
' Unlisted values are not used and will return [ Check& = 0 - Op& ].
' Different Op& values produce various return values.
' Refer to the in-code comments for details.
'
' ---------------------------------------------------------------------------
' FUNCTION Check& (Op&, InString$) Multi-Purpose String Tester
' ---------------------------------------------------------------------------
FUNCTION Check& (Op AS LONG, InString AS STRING)
RetVal& = LEN(InString$)
SELECT CASE Op&
CASE 0
' {000} Test char for "0"
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 1 THEN
RetVal& = -3
ELSEIF ASC(InString$) = 48 THEN
RetVal& = 1
ELSE
RetVal& = -1
END IF
CASE 1
' {001} Test char for [ "0" ; "1" ] (binary)
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 1 THEN
RetVal& = -3
ELSE
SELECT CASE ASC(InString$)
CASE 48, 49
RetVal& = 1
CASE ELSE
RetVal& = -1
END SELECT
END IF
CASE 2
' {002} Test char for [ 0 1 2 3 ] (two-bit)
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 1 THEN
RetVal& = -3
ELSE
SELECT CASE ASC(InString$)
CASE 48 TO 51
RetVal& = 1
CASE ELSE
RetVal& = -1
END SELECT
END IF
CASE 3
' {003} Test char for [ 0 1 2 3 4 5 6 7 ] (octal)
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 1 THEN
RetVal& = -3
ELSE
SELECT CASE ASC(InString$)
CASE 48 TO 55
RetVal& = 1
CASE ELSE
RetVal& = -1
END SELECT
END IF
CASE 4
' {004} Test char for [ 0 1 2 3 4 5 6 7 8 9 A B C D E F ] (hex)
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 1 THEN
RetVal& = -3
ELSE
SELECT CASE ASC(InString$)
CASE 48 TO 57, 65 TO 70
RetVal& = 1
CASE ELSE
RetVal& = -1
END SELECT
END IF
CASE 5
' {005} Test char for [ "0"-"9","A"-"V" ] (Base-32)
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 1 THEN
RetVal& = -3
ELSE
SELECT CASE ASC(InString$)
CASE 48 TO 57, 65 TO 86
RetVal& = 1
CASE ELSE
RetVal& = -1
END SELECT
END IF
CASE 6
' {006} Test char for [ "0"-"9","A"-"Z","a"-"z","_","|" ] (Base-64)
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 1 THEN
RetVal& = -3
ELSE
SELECT CASE ASC(InString$)
CASE 48 TO 57, 65 TO 90, 97 TO 122, 95, 124
RetVal& = 1
CASE ELSE
RetVal& = -1
END SELECT
END IF
CASE 7
' {007} Test char for ASCII value { 000 - 127 }
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 1 THEN
RetVal& = -3
ELSEIF ASC(InString$) < 128 THEN
RetVal& = 1
ELSE
RetVal& = -1
END IF
CASE 8
' {008} Test char for ASCII value { 128 - 255 }
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 1 THEN
RetVal& = -3
ELSEIF ASC(InString$) > 127 THEN
RetVal& = 1
ELSE
RetVal& = -1
END IF
CASE 9
' {009} Test String for Exclusive Base-10
' Returns:
' {& > 0} = String Length; {& < 0} = FAILED at negative offset
IF RetVal& = 0 THEN RetVal& = -1
FOR I& = 1 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 48 TO 57
' keep going
CASE ELSE
RetVal& = 0 - I&
EXIT FOR
END SELECT
NEXT I&
CASE 10
' {00A} Test String for Base-10-Format ( *!* ALTERS InString$ *!* )
' Returns:
' {& > 0} = DP offset; {& < 0} = FAILED at negative offset
'
' After testing passes, the string is trimmed
' of nonessential leading and trailing zeroes.
IF RetVal& = 0 THEN
RetVal& = -1
ELSE
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 43, 45 ' "+", "-"
FOR I& = 2 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 46 ' "."
IF DPC% > 0 THEN
RetVal& = 0 - I&
EXIT FOR
ELSE
DPC% = DPC% + 1
RetVal& = I&
END IF
CASE 48 TO 57
' keep going
CASE ELSE
RetVal& = 0 - I&
EXIT FOR
END SELECT
NEXT I&
CASE ELSE
RetVal& = -1
END SELECT
IF DPC% = 0 AND RetVal& > 0 THEN
RetVal& = 0 - RetVal&
ELSEIF RetVal& = 2 THEN
InString$ = LEFT$(InString$, 1) + CHR$(48) + RIGHT$(InString$, LEN(InString$) - 1)
RetVal& = RetVal& + 1
END IF
IF RetVal& = LEN(InString$) THEN InString$ = InString$ + CHR$(48)
DO WHILE ASC(RIGHT$(InString$, 1)) = 48 AND RetVal& < (LEN(InString$) - 1)
InString$ = LEFT$(InString$, LEN(InString$) - 1)
LOOP
DO WHILE ASC(MID$(InString$, 2, 1)) = 48 AND RetVal& > 3
InString$ = LEFT$(InString$, 1) + RIGHT$(InString$, LEN(InString$) - 2)
RetVal& = RetVal& - 1
LOOP
END IF
CASE 11
' {00B} Read Sign ("+", "-", or "ñ")
' Returns:
' Explicit: +1 = Positive; -1 = Negative; 0 = Unsigned;
' Implied: +64 = Positive; -64 = NULL String
IF RetVal& = 0 THEN RetVal& = -64
FOR I& = 1 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 32
RetVal& = 64
' keep going
CASE 43
RetVal& = 1
EXIT FOR
CASE 45
RetVal& = -1
EXIT FOR
CASE 241
RetVal& = 0
EXIT FOR
CASE ELSE
RetVal& = 64
EXIT FOR
END SELECT
NEXT I&
CASE 12
' {00C} Read and Strip Sign ( *!* ALTERS InString$ *!* )
' Returns:
' Explicit: +1 = Positive; -1 = Negative; 0 = Unsigned;
' Implied: +64 = Positive; -64 = NULL String
InString$ = LTRIM$(RTRIM$(InString$))
IF LEN(InString$) = 0 THEN
RetVal& = -64
ELSE
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 43
RetVal& = 1
CASE 45
RetVal& = -1
CASE 241
RetVal& = 0
CASE ELSE
RetVal& = 64
END SELECT
IF ABS(RetVal&) < 2 THEN InString$ = RIGHT$(InString$, LEN(InString$) - 1)
END IF
CASE 13
' {00D} Find Decimal Point
' Returns:
' {& > 0} = DP offset; 0 = No DP; {& < 0} = Negative offset of last DP found
RetVal& = 0
FOR I& = 1 TO LEN(InString$)
IF ASC(MID$(InString$, I&, 1)) = 46 THEN
IF DPC% = 0 THEN
DPC% = DPC% + 1
RetVal& = I&
ELSE
RetVal& = 0 - I&
END IF
END IF
NEXT I&
CASE 16
' {00G} Test Hexadecimal String
' Returns:
' {& > 0} = String Length; {& < 0} = FAILED at negative offset
IF RetVal& = 0 THEN RetVal& = -1
FOR I& = 1 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 48 TO 57, 65 TO 70
' keep going
CASE ELSE
RetVal& = 0 - I&
EXIT FOR
END SELECT
NEXT I&
CASE 24
' {00O} Test Octal String
' Returns:
' {& > 0} = String Length; {& < 0} = FAILED at negative offset
IF RetVal& = 0 THEN RetVal& = -1
FOR I& = 1 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 48 TO 55
' keep going
CASE ELSE
RetVal& = 0 - I&
EXIT FOR
END SELECT
NEXT I&
CASE 32
' {00W} Test Base-32 String
' Returns:
' {& > 0} = String Length; {& < 0} = FAILED at negative offset
IF RetVal& = 0 THEN RetVal& = -1
FOR I& = 1 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 48 TO 57, 65 TO 86
' keep going
CASE ELSE
RetVal& = 0 - I&
EXIT FOR
END SELECT
NEXT I&
CASE 64
' {010} Test Base-64 String
' Returns:
' {& > 0} = String Length; {& < 0} = FAILED at negative offset
IF RetVal& = 0 THEN RetVal& = -1
FOR I& = 1 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 48 TO 57, 65 TO 90, 97 TO 122, 95, 124
' keep going
CASE ELSE
RetVal& = 0 - I&
EXIT FOR
END SELECT
NEXT I&
CASE 65
' {011} Read Base-64 String (1 Char only)
' Returns:
' {0-|} = Value of String; -1 = Test FAILED; -2 = Too Short; -3 Too Long
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 1 THEN
RetVal& = -3
ELSE
RetVal& = ASC(InString$)
SELECT CASE RetVal&
CASE 48 TO 57
RetVal& = RetVal& - 48
CASE 65 TO 90
RetVal& = RetVal& - 55
CASE 97 TO 122, 124
RetVal& = RetVal& - 61
CASE 95
RetVal& = 62
CASE ELSE
RetVal& = -1
END SELECT
END IF
CASE 66 TO 69
' use identical code
'
' {012} (66) Read Base-64 String (2 Chars only) Returns:
' {0-||} = Value of String; -1 = Test FAILED; -2 = Too Short; -3 Too Long
'
' {014} {68} Read Base-64 String (4 Chars only) Returns:
' {0-||||} = Value of String; -1 = Test FAILED; -2 = Too Short; -3 Too Long
'
' {015} (69) Read Base-64 String (5 Chars only) Returns:
' {0-|||||} = Value of String; -1 = Test FAILED; -2 = Too Short; -3 Too Long
'
' {013} and {016} (67, 70) will work but are left undcoumented because they
' produce overflow errors if the string's value exceeds integer limitations.
IF RetVal& < (Op& - 64) THEN
RetVal& = -2
ELSEIF RetVal& > (Op& - 64) THEN
RetVal& = -3
ELSEIF RetVal& = Check&(64, InString$) THEN
RetVal& = 0: DPC% = 0
FOR I% = LEN(InString$) TO 1 STEP -1
RetVal& = RetVal& + Check&(65, MID$(InString$, I%, 1)) * 64 ^ DPC%
DPC% = DPC% + 1
NEXT I%
ELSE
RetVal& = -1
END IF
CASE 70 ' Galleon's Code, with ESC panic button effect added on L8R ' thx Galleon!! '
SCREEN 12
DO WHILE INKEY$ <> CHR$(27)
CLS
t$ = TIME$: h = VAL(t$): m = VAL(MID$(t$, 4, 2)): s = VAL(MID$(t$, 7, 2))
PRINT t$
CIRCLE STEP(0, 0), 200, 8
DRAW "c15ta" + STR$((h MOD 12) * -30) + "nu133"
DRAW "c15ta" + STR$(m * -6) + "nu200"
DRAW "c12ta" + STR$(s * -6) + "nu200"
_DISPLAY
_LIMIT 1
LOOP
_AUTODISPLAY
CLS
' this really needs to be moved out of here! I'm thinking along the lines of a new routine TBIL
CASE 74
' {01A} Read Base-64 String (10 Chars only - HIGH DWORD OVERWRITES Op& ! )
' Returns:
' {0-|||||} = LOW DWORD value; -1 = Test FAILED; -2 = Too Short; -3 Too Long
'
' Op& receives the HIGH DWORD value (left half) only after testing passes.
' When called using a literal [Check(74,...], the HIGH DWORD value is lost.
IF RetVal& < 10 THEN
RetVal& = -2
ELSEIF RetVal& > 10 THEN
RetVal& = -3
ELSEIF RetVal& = Check&(64, InString$) THEN
RetVal& = 0: Op& = 0: DPC% = 0
FOR I% = 5 TO 1 STEP -1
RetVal& = RetVal& + Check&(65, MID$(InString$, I% + 5, 1)) * 64 ^ DPC%
Op& = Op& + Check&(65, MID$(InString$, I%, 1)) * 64 ^ DPC%
DPC% = DPC% + 1
NEXT I%
ELSE
RetVal& = -1
END IF
CASE 131
' {023} Test Short-INT compatibility
'( { -800 to +7|| } signed,
' { ñ000 to ñF|| } explicitly unsigned )
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = Too Short; -3 = Too Long
'
' Explicitly unsigned and negative strings will fail with lengths
' below four. Example: -1 must be written as "-001"
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 4 THEN
RetVal& = -3
ELSEIF RetVal& = 1 THEN
RetVal& = Check&(6, InString$)
ELSEIF RetVal& = 2 THEN
FOR I% = 1 TO LEN(InString$)
RetVal& = Check&(6, MID$(InString$, I%, 1))
IF RetVal& = -1 THEN EXIT FOR
NEXT I%
ELSEIF RetVal& = 3 THEN
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 48 TO 55 ' {0-7}
FOR I% = 2 TO LEN(InString$)
RetVal& = Check&(6, MID$(InString$, I%, 1))
IF RetVal& = -1 THEN EXIT FOR
NEXT I%
CASE ELSE
RetVal& = -1
END SELECT
ELSEIF RetVal& = 4 THEN
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 43 ' "+"
RetVal& = Check&(131, RIGHT$(InString$, 3))
CASE 45 ' "-"
IF ASC(MID$(InString$, 2, 1)) = 56 THEN
IF ASC(MID$(InString$, 3, 1)) = 48 AND ASC(RIGHT$(InString$, 1)) = 48 THEN RetVal& = 1 ELSE RetVal& = -1
ELSE
RetVal& = Check&(131, RIGHT$(InString$, 3))
END IF
CASE 241 ' "ñ"
IF Check&(4, MID$(InString$, 2, 1)) = 1 AND Check&(64, RIGHT$(InString$, 2)) = 2 THEN RetVal& = 1 ELSE RetVal& = -1
CASE ELSE
RetVal& = -1
END SELECT
END IF
CASE 134
' {025} Test Long-INT compatibility
'( { -200000 to +1||||| } signed,
' { ñ000000 to ñ3||||| } explicitly unsigned )
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = Too Short; -3 = Too Long
'
' Explicitly unsigned and negative strings will fail with lengths
' below seven. Example: -1 must be written as "-000001"
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 7 THEN
RetVal& = -3
ELSEIF RetVal& = 1 THEN
RetVal& = Check&(6, InString$)
ELSEIF RetVal& < 6 AND RetVal& > 1 THEN
FOR I% = 1 TO LEN(InString$)
RetVal& = Check&(6, MID$(InString$, I%, 1))
IF RetVal& = -1 THEN EXIT FOR
NEXT I%
ELSEIF RetVal& = 6 THEN
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 48, 49 ' "0" or "1"
FOR I% = 2 TO LEN(InString$)
RetVal& = Check&(6, MID$(InString$, I%, 1))
IF RetVal& = -1 THEN EXIT FOR
NEXT I%
CASE ELSE
RetVal& = -1
END SELECT
ELSEIF RetVal& = 7 THEN
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 43 ' "+"
RetVal& = Check&(134, RIGHT$(InString$, 6))
CASE 45 ' "-"
IF ASC(MID$(InString$, 2, 1)) = 50 THEN
FOR I% = 3 TO LEN(InString$)
RetVal& = Check&(0, MID$(InString$, I%, 1))
IF RetVal& = -1 THEN EXIT FOR
NEXT I%
ELSE
RetVal& = Check&(134, RIGHT$(InString$, 6))
END IF
CASE 241 ' "ñ"
IF Check&(2, MID$(InString$, 2, 1)) = 1 AND Check&(64, RIGHT$(InString$, 5)) = 5 THEN RetVal& = 1 ELSE RetVal& = -1
CASE ELSE
RetVal& = -1
END SELECT
END IF
CASE 139
' {02B} Test 64-bit-INT compatibility
'( { -80000000000 to +7|||||||||| } signed,
' { ñ00000000000 to ñF|||||||||| } explicitly unsigned )
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = Too Short; -3 = Too Long
'
' Explicitly unsigned and negative strings will fail with lengths
' below eleven. Example: -1 must be written as "-0000000001"
IF RetVal& = 0 THEN
RetVal& = -2
ELSEIF RetVal& > 12 THEN
RetVal& = -3
ELSEIF RetVal& = 1 THEN
RetVal& = Check&(6, InString$)
ELSEIF RetVal& < 11 AND RetVal& > 1 THEN
FOR I% = 1 TO LEN(InString$)
RetVal& = Check&(6, MID$(InString$, I%, 1))
IF RetVal& = -1 THEN EXIT FOR
NEXT I%
ELSEIF RetVal& = 11 THEN
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 48, 45 ' {0-7}
FOR I% = 2 TO LEN(InString$)
RetVal& = Check&(6, MID$(InString$, I%, 1))
IF RetVal& = -1 THEN EXIT FOR
NEXT I%
CASE ELSE
RetVal& = -1
END SELECT
ELSEIF RetVal& = 12 THEN
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 43 ' "+"
RetVal& = Check&(139, RIGHT$(InString$, 11))
CASE 45 ' "-"
IF ASC(MID$(InString$, 2, 1)) = 50 THEN
FOR I% = 3 TO LEN(InString$)
RetVal& = Check&(0, MID$(InString$, I%, 1))
IF RetVal& = -1 THEN EXIT FOR
NEXT I%
ELSE
RetVal& = Check&(139, RIGHT$(InString$, 11))
END IF
CASE 241 ' "ñ"
IF Check&(4, MID$(InString$, 2, 1)) = 1 AND Check&(64, RIGHT$(InString$, 10)) = 10 THEN RetVal& = 1 ELSE RetVal& = -1
CASE ELSE
RetVal& = -1
END SELECT
END IF
CASE 195
' {033} Return integer value of Short-INT compatible string
' Returns: ( 0 indicates failure )
' { -800 to +7|| } signed,
' { ñ000 to ñF|| } explicitly unsigned
'
' Explicitly unsigned and negative strings will fail with lengths
' below four. Example: -1 must be written as "-001"
IF RetVal& = 0 THEN
' return 0
ELSEIF RetVal& > 4 THEN
RetVal& = 0
ELSEIF RetVal& = 1 THEN
RetVal& = Check&(65, InString$)
IF RetVal& < 0 THEN RetVal& = 0
ELSEIF RetVal& = 2 THEN
RetVal& = Check&(66, InString$)
IF RetVal& < 0 THEN RetVal& = 0
ELSEIF RetVal& = 3 THEN
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 48 TO 55
RetVal& = Check&(67, RIGHT$(InString$, 3))
IF RetVal& < 0 THEN RetVal& = 0
CASE ELSE
RetVal& = 0
END SELECT
ELSEIF RetVal& = 4 THEN
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 43 ' "+"
RetVal& = Check&(195, RIGHT$(InString$, 3))
CASE 45 ' "-"
IF ASC(MID$(InString$, 2, 1)) = 56 THEN
IF ASC(MID$(InString$, 3, 1)) = 48 AND ASC(RIGHT$(InString$, 1)) = 48 THEN RetVal& = -32768 ELSE RetVal& = 0
ELSE
RetVal& = 0& - Check&(195, RIGHT$(InString$, 3))
END IF
CASE 241 ' "ñ"
IF Check&(4, MID$(InString$, 2, 1)) = 1 THEN
RetVal& = Check&(67, RIGHT$(InString$, 3))
IF RetVal& < 0 THEN
RetVal& = 0
ELSE
SELECT CASE Check&(65, MID$(InString$, 2, 1))
CASE 0 TO 7
' RetVal& = RetVal&
CASE 8 TO 15
' stupid 2's complement
RetVal& = 0& - (65536 - RetVal&)
END SELECT
END IF
END IF
CASE ELSE
RetVal& = 0
END SELECT
END IF
CASE 198
' {036} Return integer value of Long-INT compatible string
' Returns: ( 0 indicates failure )
' { -200000 to +1||||| } signed,
' { ñ000000 to ñ3||||| } explicitly unsigned
'
' Explicitly unsigned and negative strings will fail with lengths
' below seven. Example: -1 must be written as "-000001"
IF RetVal& = 0 THEN
' return 0
ELSEIF RetVal& > 7 THEN
RetVal& = 0
ELSEIF RetVal& > 0 AND RetVal& < 6 THEN
RetVal& = RetVal& + 64
RetVal& = Check&(RetVal&, InString$)
IF RetVal& < 0 THEN RetVal& = 0
ELSEIF RetVal& = 6 THEN
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 48, 49
RetVal& = Check&(70, RIGHT$(InString$, 6))
IF RetVal& < 0 THEN RetVal& = 0
CASE ELSE
RetVal& = 0
END SELECT
ELSEIF RetVal& = 7 THEN
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 43 ' "+"
RetVal& = Check&(198, RIGHT$(InString$, 6))
CASE 45 ' "-"
IF ASC(MID$(InString$, 2, 1)) = 50 THEN
IF Check&(69, RIGHT$(InString$, 5)) = 0 THEN RetVal& = -2147483648# ELSE RetVal& = 0
ELSE
RetVal& = 0& - Check&(198, RIGHT$(InString$, 6))
END IF
CASE 241 ' "ñ"
DPC% = ASC(MID$(InString$, 2, 1)) - 48
IF DPC% = 0 OR DPC% = 1 THEN
RetVal& = Check&(70, RIGHT$(InString$, 6))
IF RetVal& < 0 THEN RetVal& = 0
ELSEIF DPC% = 2 OR DPC% = 3 THEN
RetVal& = Check&(69, RIGHT$(InString$, 5))
IF RetVal& < 0 THEN
RetVal& = 0
ELSE
' stupid 2's complement
DIM TFP(0) AS DOUBLE
TFP(0) = (64# ^ 5 * DPC%) + RetVal&
TFP(0) = 0# - (4294967296# - TFP(0))
RetVal& = TFP(0)
ERASE TFP
END IF
END IF
CASE ELSE
RetVal& = 0
END SELECT
END IF
CASE 203
' {03B} ***** RESERVED FOR FORWARD COMPATIBILITY *****
' {03B} Return integer value of 64-bit-INT compatibile string
' Returns: ( 0 indicates failure )
' { -80000000000 to +7|||||||||| } signed,
' { ñ00000000000 to ñF|||||||||| } explicitly unsigned
'
' Explicitly unsigned and negative strings will fail with lengths
' below eleven. Example: -1 must be written as "-0000000001"
RetVal& = 0
'#' this will by necessity split the string passed to it into the top half returned by Op& and the bottom half returned by Check&
'#' the other option is to give the entire set of SUBs a rewrite to enable all of the functionality of QB64 (beyond my skill set)
'#' (but it is my ultimate goal to achieve)
CASE 4096
' {100} Test VLFP-Format String
' Returns: Value of SI$ (Signs$) Field { 0 - 4095 } OR
' Format FAILURE:
' -1 = Bad Char; -2 Too Short; -4 = Bad Prefix; -8 = Field Separator
' Length Mismatch FAILURES:
' -16 = {LL$}; -32 = {ML$}; -64 = {RL$}; -128 = Over; -256 = Under
FOR I& = 1 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 48 TO 57, 65 TO 90, 97 TO 122, 95, 124
' keep going
CASE ELSE
RetVal& = -1
EXIT FOR
END SELECT
NEXT I&
IF RetVal& < 0 THEN
'return -1 from above
ELSEIF RetVal& < 40 THEN
RetVal& = -2
ELSEIF LEFT$(InString$, 6) <> CHR$(86) + CHR$(76) + CHR$(70) + CHR$(80) + CHR$(95) + CHR$(101) THEN
RetVal& = -4
ELSEIF MID$(InString$, 7, 1) + MID$(InString$, 10, 1) + MID$(InString$, 16, 1) + MID$(InString$, 22, 1) + MID$(InString$, 28, 1) + MID$(InString$, 34, 1) + MID$(InString$, 40, 1) <> STRING$(7, 95) THEN
RetVal& = -8
ELSE
DIM TMP(0 TO 3) AS LONG
TMP(0) = RetVal& '= LEN(InString$)
TMP(1) = 16777216 * Check&(65, MID$(InString$, 11, 1)) + 262144 * Check&(65, MID$(InString$, 12, 1)) + 4096& * Check&(65, MID$(InString$, 13, 1)) + 64& * Check&(65, MID$(InString$, 14, 1)) + Check&(65, MID$(InString$, 15, 1))
TMP(2) = 16777216 * Check&(65, MID$(InString$, 29, 1)) + 262144 * Check&(65, MID$(InString$, 30, 1)) + 4096& * Check&(65, MID$(InString$, 31, 1)) + 64& * Check&(65, MID$(InString$, 32, 1)) + Check&(65, MID$(InString$, 33, 1))
TMP(3) = 16777216 * Check&(65, MID$(InString$, 35, 1)) + 262144 * Check&(65, MID$(InString$, 36, 1)) + 4096& * Check&(65, MID$(InString$, 37, 1)) + 64& * Check&(65, MID$(InString$, 38, 1)) + Check&(65, MID$(InString$, 39, 1))
'^^^^^^^ uses less stack than [ Check&(69,...) ]
RetVal& = 0
IF TMP(1) + 40 > TMP(0) THEN RetVal& = RetVal& - 16
IF TMP(2) + 40 > TMP(0) THEN RetVal& = RetVal& - 32
IF TMP(3) + 40 > TMP(0) THEN RetVal& = RetVal& - 64
IF RetVal& = 0 AND TMP(0) < 40 + TMP(1) + TMP(2) + TMP(3) THEN RetVal& = -128
IF TMP(0) > 40 + TMP(1) + TMP(2) + TMP(3) THEN RetVal& = -256
ERASE TMP
IF RetVal& = 0 THEN RetVal& = 64& * Check&(65, MID$(InString$, 8, 1)) + Check&(65, MID$(InString$, 9, 1))
END IF
CASE 4097 TO 4099
' { 101 - 1|| } are reserved for VLFP processing
' Returns: (not currently used)
RetVal& = 0 - Op&
CASE 4100
' { 101 - 1|| } are reserved for VLFP processing
' {104} Returns: {SI$} (Signs$ value)
RetVal& = 64 * Check&(65, MID$(InString$, 8, 1)) + Check&(65, MID$(InString$, 9, 1))
CASE 4101
' { 101 - 1|| } are reserved for VLFP processing
' {105} Returns: {LL$} (LeftLEN$ value)
RetVal& = 16777216 * Check&(65, MID$(InString$, 11, 1)) + 262144 * Check&(65, MID$(InString$, 12, 1)) + 4096& * Check&(65, MID$(InString$, 13, 1)) + 64& * Check&(65, MID$(InString$, 14, 1)) + Check&(65, MID$(InString$, 15, 1))
CASE 4102
' { 101 - 1|| } are reserved for VLFP processing
' {106} Returns: {LZ$} (LeftZeroes$ value)
RetVal& = 16777216 * Check&(65, MID$(InString$, 17, 1)) + 262144 * Check&(65, MID$(InString$, 18, 1)) + 4096& * Check&(65, MID$(InString$, 19, 1)) + 64& * Check&(65, MID$(InString$, 20, 1)) + Check&(65, MID$(InString$, 21, 1))
CASE 4103
' { 101 - 1|| } are reserved for VLFP processing
' {107} Returns: {MZ$} (MidZeroes$ value)
RetVal& = 16777216 * Check&(65, MID$(InString$, 23, 1)) + 262144 * Check&(65, MID$(InString$, 24, 1)) + 4096& * Check&(65, MID$(InString$, 25, 1)) + 64& * Check&(65, MID$(InString$, 26, 1)) + Check&(65, MID$(InString$, 27, 1))
CASE 4104
' { 101 - 1|| } are reserved for VLFP processing
' {108} Returns: {ML$} (MiddleLEN$ value)
RetVal& = 16777216 * Check&(65, MID$(InString$, 29, 1)) + 262144 * Check&(65, MID$(InString$, 30, 1)) + 4096& * Check&(65, MID$(InString$, 31, 1)) + 64& * Check&(65, MID$(InString$, 32, 1)) + Check&(65, MID$(InString$, 33, 1))
CASE 4105
' { 101 - 1|| } are reserved for VLFP processing
' {109} Returns: {RL$} (RightLEN$ value)
RetVal& = 16777216 * Check&(65, MID$(InString$, 35, 1)) + 262144 * Check&(65, MID$(InString$, 36, 1)) + 4096& * Check&(65, MID$(InString$, 37, 1)) + 64& * Check&(65, MID$(InString$, 38, 1)) + Check&(65, MID$(InString$, 39, 1))
CASE 4106 TO 4159
' { 101 - 1|| } are reserved for VLFP processing
' Returns: (not currently used)
RetVal& = 0 - Op&
CASE 4160
' { 101 - 1|| } are reserved for VLFP processing ( *!* ALTERS InString$ *!* )
' {110} Trim padded zeroes and nonsense {[L:M]Z$}
' Returns: 0 OR [Check&(4096,...)] Error Code
' Uses less stack to duplicate CASE 4096 than to call it from here.
FOR I& = 1 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 48 TO 57, 65 TO 90, 97 TO 122, 95, 124
' keep going
CASE ELSE
RetVal& = -1
EXIT FOR
END SELECT
NEXT I&
IF RetVal& < 0 THEN
'return -1 from above
ELSEIF RetVal& < 40 THEN
RetVal& = -2
ELSEIF LEFT$(InString$, 6) <> CHR$(86) + CHR$(76) + CHR$(70) + CHR$(80) + CHR$(95) + CHR$(101) THEN
RetVal& = -4
ELSEIF MID$(InString$, 7, 1) + MID$(InString$, 10, 1) + MID$(InString$, 16, 1) + MID$(InString$, 22, 1) + MID$(InString$, 28, 1) + MID$(InString$, 34, 1) + MID$(InString$, 40, 1) <> STRING$(7, 95) THEN
RetVal& = -8
ELSE
DIM TMP(-1 TO 5) AS LONG
TMP(0) = RetVal& '= LEN(InString$)
TMP(1) = 16777216 * Check&(65, MID$(InString$, 11, 1)) + 262144 * Check&(65, MID$(InString$, 12, 1)) + 4096& * Check&(65, MID$(InString$, 13, 1)) + 64& * Check&(65, MID$(InString$, 14, 1)) + Check&(65, MID$(InString$, 15, 1))
TMP(2) = 16777216 * Check&(65, MID$(InString$, 17, 1)) + 262144 * Check&(65, MID$(InString$, 18, 1)) + 4096& * Check&(65, MID$(InString$, 19, 1)) + 64& * Check&(65, MID$(InString$, 20, 1)) + Check&(65, MID$(InString$, 21, 1))
TMP(3) = 16777216 * Check&(65, MID$(InString$, 23, 1)) + 262144 * Check&(65, MID$(InString$, 24, 1)) + 4096& * Check&(65, MID$(InString$, 25, 1)) + 64& * Check&(65, MID$(InString$, 26, 1)) + Check&(65, MID$(InString$, 27, 1))
TMP(4) = 16777216 * Check&(65, MID$(InString$, 29, 1)) + 262144 * Check&(65, MID$(InString$, 30, 1)) + 4096& * Check&(65, MID$(InString$, 31, 1)) + 64& * Check&(65, MID$(InString$, 32, 1)) + Check&(65, MID$(InString$, 33, 1))
TMP(5) = 16777216 * Check&(65, MID$(InString$, 35, 1)) + 262144 * Check&(65, MID$(InString$, 36, 1)) + 4096& * Check&(65, MID$(InString$, 37, 1)) + 64& * Check&(65, MID$(InString$, 38, 1)) + Check&(65, MID$(InString$, 39, 1))
'^^^^^^^ uses less stack than [ Check&(69,...) ]
RetVal& = 0
IF TMP(1) + 40 > TMP(0) THEN RetVal& = RetVal& - 16
IF TMP(4) + 40 > TMP(0) THEN RetVal& = RetVal& - 32
IF TMP(5) + 40 > TMP(0) THEN RetVal& = RetVal& - 64
IF RetVal& = 0 AND TMP(0) < 40 + TMP(1) + TMP(4) + TMP(5) THEN RetVal& = -128
IF TMP(0) > 40 + TMP(1) + TMP(4) + TMP(5) THEN RetVal& = -256
IF RetVal& = 0 AND 2 > 64& * Check&(65, MID$(InString$, 8, 1)) + Check&(65, MID$(InString$, 9, 1)) THEN
IF TMP(0) = 40 THEN
' zero LZ$ and MZ$ (without an "Illegal Function Call")
TMP(2) = 0
TMP(3) = 0
ELSE
' Left Side
DO WHILE TMP(1) > 1 AND ASC(MID$(InString$, 41, 1)) = 48
InString$ = LEFT$(InString$, 40) + RIGHT$(InString$, LEN(InString$) - 41)
TMP(1) = TMP(1) - 1
LOOP 'this two-step avoids a possible IFC with [do while TMP(1) > 0 ...]
IF TMP(1) = 1 AND ASC(MID$(InString$, 41, 1)) = 48 THEN
InString$ = LEFT$(InString$, 40) + RIGHT$(InString$, LEN(InString$) - 41)
TMP(1) = TMP(1) - 1
END IF
IF TMP(1) = 0 THEN
TMP(2) = 0
ELSE
DO WHILE TMP(2) < 1073741823 AND ASC(MID$(InString$, 40 + TMP(1), 1)) = 48
InString$ = LEFT$(InString$, 39 + TMP(1)) + RIGHT$(InString$, LEN(InString$) - 39 + TMP(1))
TMP(1) = TMP(1) - 1
TMP(2) = TMP(2) + 1
LOOP
END IF
' Right Side
TMP(-1) = TMP(4) + TMP(5)
TMP(0) = 41 + TMP(1)
IF TMP(-1) = 0 THEN
TMP(3) = 0
ELSEIF MID$(InString$, TMP(0), TMP(-1)) = STRING$(TMP(-1), 48) THEN
InString$ = LEFT$(InString$, TMP(0) - 1)
TMP(3) = 0
TMP(4) = 0
TMP(5) = 0
ELSE
IF TMP(5) > 0 AND RIGHT$(InString$, TMP(5)) = STRING$(TMP(5), 48) THEN
InString$ = LEFT$(InString$, LEN(InString$) - TMP(5))
TMP(-1) = TMP(-1) - TMP(5)
TMP(5) = 0
END IF
IF TMP(5) = 0 THEN
DO WHILE TMP(4) > 0 AND ASC(RIGHT$(InString$, 1)) = 48
InString$ = LEFT$(InString$, LEN(InString$) - 1)
TMP(-1) = TMP(-1) - 1
TMP(4) = TMP(4) - 1
LOOP
END IF
IF TMP(4) > 0 THEN
DO WHILE TMP(3) < 1073741823 AND TMP(4) > 1 AND ASC(MID$(InString$, TMP(0), 1)) = 48
TMP(-1) = TMP(-1) - 1
InString$ = LEFT$(InString$, TMP(0) - 1) + RIGHT$(InString$, TMP(-1))
TMP(3) = TMP(3) + 1
TMP(4) = TMP(4) - 1
LOOP 'have to two-step again, in case {RL$} is 0
IF TMP(3) < 1073741823 AND TMP(4) = 1 AND ASC(MID$(InString$, TMP(0), 1)) = 48 THEN
TMP(-1) = TMP(-1) - 1
InString$ = LEFT$(InString$, TMP(0) - 1) + RIGHT$(InString$, TMP(-1))
TMP(3) = TMP(3) + 1
TMP(4) = TMP(4) - 1
END IF
END IF
END IF
END IF
MID$(InString$, 11, 5) = Build$(5, 0, TMP(1))
MID$(InString$, 17, 5) = Build$(5, 0, TMP(2))
MID$(InString$, 23, 5) = Build$(5, 0, TMP(3))
MID$(InString$, 29, 5) = Build$(5, 0, TMP(4))
MID$(InString$, 35, 5) = Build$(5, 0, TMP(5))
END IF
ERASE TMP
END IF
CASE 4161
' { 101 - 1|| } are reserved for VLFP processing ( *!* ALTERS InString$ *!* )
' {111} Deflate repeating section
' Returns: 0 OR [Check&(4096,...)] Error Code
' Uses less stack to duplicate CASE 4096 than to call it from here.
FOR I& = 1 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 48 TO 57, 65 TO 90, 97 TO 122, 95, 124
' keep going
CASE ELSE
RetVal& = -1
EXIT FOR
END SELECT
NEXT I&
IF RetVal& < 0 THEN
'return -1 from above
ELSEIF RetVal& < 40 THEN
RetVal& = -2
ELSEIF LEFT$(InString$, 6) <> CHR$(86) + CHR$(76) + CHR$(70) + CHR$(80) + CHR$(95) + CHR$(101) THEN
RetVal& = -4
ELSEIF MID$(InString$, 7, 1) + MID$(InString$, 10, 1) + MID$(InString$, 16, 1) + MID$(InString$, 22, 1) + MID$(InString$, 28, 1) + MID$(InString$, 34, 1) + MID$(InString$, 40, 1) <> STRING$(7, 95) THEN
RetVal& = -8
ELSE
DIM TMP(-1 TO 5) AS LONG
TMP(0) = RetVal& '= LEN(InString$)
TMP(1) = 16777216 * Check&(65, MID$(InString$, 11, 1)) + 262144 * Check&(65, MID$(InString$, 12, 1)) + 4096& * Check&(65, MID$(InString$, 13, 1)) + 64& * Check&(65, MID$(InString$, 14, 1)) + Check&(65, MID$(InString$, 15, 1))
TMP(2) = 16777216 * Check&(65, MID$(InString$, 17, 1)) + 262144 * Check&(65, MID$(InString$, 18, 1)) + 4096& * Check&(65, MID$(InString$, 19, 1)) + 64& * Check&(65, MID$(InString$, 20, 1)) + Check&(65, MID$(InString$, 21, 1))
TMP(3) = 16777216 * Check&(65, MID$(InString$, 23, 1)) + 262144 * Check&(65, MID$(InString$, 24, 1)) + 4096& * Check&(65, MID$(InString$, 25, 1)) + 64& * Check&(65, MID$(InString$, 26, 1)) + Check&(65, MID$(InString$, 27, 1))
TMP(4) = 16777216 * Check&(65, MID$(InString$, 29, 1)) + 262144 * Check&(65, MID$(InString$, 30, 1)) + 4096& * Check&(65, MID$(InString$, 31, 1)) + 64& * Check&(65, MID$(InString$, 32, 1)) + Check&(65, MID$(InString$, 33, 1))
TMP(5) = 16777216 * Check&(65, MID$(InString$, 35, 1)) + 262144 * Check&(65, MID$(InString$, 36, 1)) + 4096& * Check&(65, MID$(InString$, 37, 1)) + 64& * Check&(65, MID$(InString$, 38, 1)) + Check&(65, MID$(InString$, 39, 1))
'^^^^^^^ uses less stack than [ Check&(69,...) ]
RetVal& = 0
IF TMP(1) + 40 > TMP(0) THEN RetVal& = RetVal& - 16
IF TMP(4) + 40 > TMP(0) THEN RetVal& = RetVal& - 32
IF TMP(5) + 40 > TMP(0) THEN RetVal& = RetVal& - 64
IF RetVal& = 0 AND TMP(0) < 40 + TMP(1) + TMP(4) + TMP(5) THEN RetVal& = -128
IF TMP(0) > 40 + TMP(1) + TMP(4) + TMP(5) THEN RetVal& = -256
IF RetVal& = 0 AND 2 > 64& * Check&(65, MID$(InString$, 8, 1)) + Check&(65, MID$(InString$, 9, 1)) THEN
TMP(0) = TMP(0) - TMP(5)
DO WHILE TMP(4) > 0 AND RIGHT$(InString$, 1) = MID$(InString$, TMP(0), 1)
' move repeating Chars out of middle section
InString$ = LEFT$(InString$, LEN(InString$) - 1)
TMP(4) = TMP(4) - 1
LOOP
' test for multiple repeats here ******************************************************* WORK IN PROGRESS
'INSERT SUBFUNCTION CODE HERE *********************************************************************************************
'INSERT SUBFUNCTION CODE HERE *********************************************************************************************
'INSERT SUBFUNCTION CODE HERE *********************************************************************************************
'INSERT SUBFUNCTION CODE HERE *********************************************************************************************
MID$(InString$, 11, 5) = Build$(5, 0, TMP(1))
MID$(InString$, 17, 5) = Build$(5, 0, TMP(2))
MID$(InString$, 23, 5) = Build$(5, 0, TMP(3))
MID$(InString$, 29, 5) = Build$(5, 0, TMP(4))
MID$(InString$, 35, 5) = Build$(5, 0, TMP(5))
END IF
ERASE TMP
END IF
CASE 4162
' { 101 - 1|| } are reserved for VLFP processing ( *!* ALTERS InString$ *!* )
' {112} Find an exact repeat (changes String value)
' Returns: 0 OR [Check&(4096,...)] Error Code
' Uses less stack to duplicate CASE 4096 than to call it from here.
FOR I& = 1 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 48 TO 57, 65 TO 90, 97 TO 122, 95, 124
' keep going
CASE ELSE
RetVal& = -1
EXIT FOR
END SELECT
NEXT I&
IF RetVal& < 0 THEN
'return -1 from above
ELSEIF RetVal& < 40 THEN
RetVal& = -2
ELSEIF LEFT$(InString$, 6) <> CHR$(86) + CHR$(76) + CHR$(70) + CHR$(80) + CHR$(95) + CHR$(101) THEN
RetVal& = -4
ELSEIF MID$(InString$, 7, 1) + MID$(InString$, 10, 1) + MID$(InString$, 16, 1) + MID$(InString$, 22, 1) + MID$(InString$, 28, 1) + MID$(InString$, 34, 1) + MID$(InString$, 40, 1) <> STRING$(7, 95) THEN
RetVal& = -8
ELSE
DIM TMP(-1 TO 5) AS LONG
TMP(0) = RetVal& '= LEN(InString$)
TMP(1) = 16777216 * Check&(65, MID$(InString$, 11, 1)) + 262144 * Check&(65, MID$(InString$, 12, 1)) + 4096& * Check&(65, MID$(InString$, 13, 1)) + 64& * Check&(65, MID$(InString$, 14, 1)) + Check&(65, MID$(InString$, 15, 1))
TMP(2) = 16777216 * Check&(65, MID$(InString$, 17, 1)) + 262144 * Check&(65, MID$(InString$, 18, 1)) + 4096& * Check&(65, MID$(InString$, 19, 1)) + 64& * Check&(65, MID$(InString$, 20, 1)) + Check&(65, MID$(InString$, 21, 1))
TMP(3) = 16777216 * Check&(65, MID$(InString$, 23, 1)) + 262144 * Check&(65, MID$(InString$, 24, 1)) + 4096& * Check&(65, MID$(InString$, 25, 1)) + 64& * Check&(65, MID$(InString$, 26, 1)) + Check&(65, MID$(InString$, 27, 1))
TMP(4) = 16777216 * Check&(65, MID$(InString$, 29, 1)) + 262144 * Check&(65, MID$(InString$, 30, 1)) + 4096& * Check&(65, MID$(InString$, 31, 1)) + 64& * Check&(65, MID$(InString$, 32, 1)) + Check&(65, MID$(InString$, 33, 1))
TMP(5) = 16777216 * Check&(65, MID$(InString$, 35, 1)) + 262144 * Check&(65, MID$(InString$, 36, 1)) + 4096& * Check&(65, MID$(InString$, 37, 1)) + 64& * Check&(65, MID$(InString$, 38, 1)) + Check&(65, MID$(InString$, 39, 1))
'^^^^^^^ uses less stack than [ Check&(69,...) ]
RetVal& = 0
IF TMP(1) + 40 > TMP(0) THEN RetVal& = RetVal& - 16
IF TMP(4) + 40 > TMP(0) THEN RetVal& = RetVal& - 32
IF TMP(5) + 40 > TMP(0) THEN RetVal& = RetVal& - 64
IF RetVal& = 0 AND TMP(0) < 40 + TMP(1) + TMP(4) + TMP(5) THEN RetVal& = -128
IF TMP(0) > 40 + TMP(1) + TMP(4) + TMP(5) THEN RetVal& = -256
IF RetVal& = 0 AND 2 > 64& * Check&(65, MID$(InString$, 8, 1)) + Check&(65, MID$(InString$, 9, 1)) THEN
'INSERT SUBFUNCTION CODE HERE *********************************************************************************************
'INSERT SUBFUNCTION CODE HERE *********************************************************************************************
'INSERT SUBFUNCTION CODE HERE *********************************************************************************************
'INSERT SUBFUNCTION CODE HERE *********************************************************************************************
MID$(InString$, 11, 5) = Build$(5, 0, TMP(1))
MID$(InString$, 17, 5) = Build$(5, 0, TMP(2))
MID$(InString$, 23, 5) = Build$(5, 0, TMP(3))
MID$(InString$, 29, 5) = Build$(5, 0, TMP(4))
MID$(InString$, 35, 5) = Build$(5, 0, TMP(5))
END IF
ERASE TMP
END IF
CASE 4163
' { 101 - 1|| } are reserved for VLFP processing ( *!* ALTERS InString$ *!* )
' {113} Extrapolate a repeat (changes String value)
' Returns: 0 OR [Check&(4096,...)] Error Code
' Uses less stack to duplicate CASE 4096 than to call it from here.
FOR I& = 1 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 48 TO 57, 65 TO 90, 97 TO 122, 95, 124
' keep going
CASE ELSE
RetVal& = -1
EXIT FOR
END SELECT
NEXT I&
IF RetVal& < 0 THEN
'return -1 from above
ELSEIF RetVal& < 40 THEN
RetVal& = -2
ELSEIF LEFT$(InString$, 6) <> CHR$(86) + CHR$(76) + CHR$(70) + CHR$(80) + CHR$(95) + CHR$(101) THEN
RetVal& = -4
ELSEIF MID$(InString$, 7, 1) + MID$(InString$, 10, 1) + MID$(InString$, 16, 1) + MID$(InString$, 22, 1) + MID$(InString$, 28, 1) + MID$(InString$, 34, 1) + MID$(InString$, 40, 1) <> STRING$(7, 95) THEN
RetVal& = -8
ELSE
DIM TMP(-1 TO 5) AS LONG
TMP(0) = RetVal& '= LEN(InString$)
TMP(1) = 16777216 * Check&(65, MID$(InString$, 11, 1)) + 262144 * Check&(65, MID$(InString$, 12, 1)) + 4096& * Check&(65, MID$(InString$, 13, 1)) + 64& * Check&(65, MID$(InString$, 14, 1)) + Check&(65, MID$(InString$, 15, 1))
TMP(2) = 16777216 * Check&(65, MID$(InString$, 17, 1)) + 262144 * Check&(65, MID$(InString$, 18, 1)) + 4096& * Check&(65, MID$(InString$, 19, 1)) + 64& * Check&(65, MID$(InString$, 20, 1)) + Check&(65, MID$(InString$, 21, 1))
TMP(3) = 16777216 * Check&(65, MID$(InString$, 23, 1)) + 262144 * Check&(65, MID$(InString$, 24, 1)) + 4096& * Check&(65, MID$(InString$, 25, 1)) + 64& * Check&(65, MID$(InString$, 26, 1)) + Check&(65, MID$(InString$, 27, 1))
TMP(4) = 16777216 * Check&(65, MID$(InString$, 29, 1)) + 262144 * Check&(65, MID$(InString$, 30, 1)) + 4096& * Check&(65, MID$(InString$, 31, 1)) + 64& * Check&(65, MID$(InString$, 32, 1)) + Check&(65, MID$(InString$, 33, 1))
TMP(5) = 16777216 * Check&(65, MID$(InString$, 35, 1)) + 262144 * Check&(65, MID$(InString$, 36, 1)) + 4096& * Check&(65, MID$(InString$, 37, 1)) + 64& * Check&(65, MID$(InString$, 38, 1)) + Check&(65, MID$(InString$, 39, 1))
'^^^^^^^ uses less stack than [ Check&(69,...) ]
RetVal& = 0
IF TMP(1) + 40 > TMP(0) THEN RetVal& = RetVal& - 16
IF TMP(4) + 40 > TMP(0) THEN RetVal& = RetVal& - 32
IF TMP(5) + 40 > TMP(0) THEN RetVal& = RetVal& - 64
IF RetVal& = 0 AND TMP(0) < 40 + TMP(1) + TMP(4) + TMP(5) THEN RetVal& = -128
IF TMP(0) > 40 + TMP(1) + TMP(4) + TMP(5) THEN RetVal& = -256
IF RetVal& = 0 AND 2 > 64& * Check&(65, MID$(InString$, 8, 1)) + Check&(65, MID$(InString$, 9, 1)) THEN
'INSERT SUBFUNCTION CODE HERE *********************************************************************************************
'INSERT SUBFUNCTION CODE HERE *********************************************************************************************
'INSERT SUBFUNCTION CODE HERE *********************************************************************************************
'INSERT SUBFUNCTION CODE HERE *********************************************************************************************
MID$(InString$, 11, 5) = Build$(5, 0, TMP(1))
MID$(InString$, 17, 5) = Build$(5, 0, TMP(2))
MID$(InString$, 23, 5) = Build$(5, 0, TMP(3))
MID$(InString$, 29, 5) = Build$(5, 0, TMP(4))
MID$(InString$, 35, 5) = Build$(5, 0, TMP(5))
END IF
ERASE TMP
END IF
CASE 4164 TO 4443
' { 101 - 1|| } are reserved for VLFP processing
' Returns: (not currently used)
RetVal& = 0 - Op&
CASE 4444
' { 101 - 1|| } are reserved for VLFP processing ( *!* ALTERS InString$ *!* )
' {15S} Align to 4-byte boundary with padded zeroes
' Returns: 0 OR [Check&(4096,...)] Error Code
' Uses less stack to duplicate CASE 4096 than to call it from here.
FOR I& = 1 TO RetVal&
SELECT CASE ASC(MID$(InString$, I&, 1))
CASE 48 TO 57, 65 TO 90, 97 TO 122, 95, 124
' keep going
CASE ELSE
RetVal& = -1
EXIT FOR
END SELECT
NEXT I&
IF RetVal& < 0 THEN
'return -1 from above
ELSEIF RetVal& < 40 THEN
RetVal& = -2
ELSEIF LEFT$(InString$, 6) <> CHR$(86) + CHR$(76) + CHR$(70) + CHR$(80) + CHR$(95) + CHR$(101) THEN
RetVal& = -4
ELSEIF MID$(InString$, 7, 1) + MID$(InString$, 10, 1) + MID$(InString$, 16, 1) + MID$(InString$, 22, 1) + MID$(InString$, 28, 1) + MID$(InString$, 34, 1) + MID$(InString$, 40, 1) <> STRING$(7, 95) THEN
RetVal& = -8
ELSE
DIM TMP(0 TO 5) AS LONG
TMP(0) = RetVal& '= LEN(InString$)
TMP(1) = 16777216 * Check&(65, MID$(InString$, 11, 1)) + 262144 * Check&(65, MID$(InString$, 12, 1)) + 4096& * Check&(65, MID$(InString$, 13, 1)) + 64& * Check&(65, MID$(InString$, 14, 1)) + Check&(65, MID$(InString$, 15, 1))
TMP(2) = 16777216 * Check&(65, MID$(InString$, 17, 1)) + 262144 * Check&(65, MID$(InString$, 18, 1)) + 4096& * Check&(65, MID$(InString$, 19, 1)) + 64& * Check&(65, MID$(InString$, 20, 1)) + Check&(65, MID$(InString$, 21, 1))
TMP(3) = 16777216 * Check&(65, MID$(InString$, 23, 1)) + 262144 * Check&(65, MID$(InString$, 24, 1)) + 4096& * Check&(65, MID$(InString$, 25, 1)) + 64& * Check&(65, MID$(InString$, 26, 1)) + Check&(65, MID$(InString$, 27, 1))
TMP(4) = 16777216 * Check&(65, MID$(InString$, 29, 1)) + 262144 * Check&(65, MID$(InString$, 30, 1)) + 4096& * Check&(65, MID$(InString$, 31, 1)) + 64& * Check&(65, MID$(InString$, 32, 1)) + Check&(65, MID$(InString$, 33, 1))
TMP(5) = 16777216 * Check&(65, MID$(InString$, 35, 1)) + 262144 * Check&(65, MID$(InString$, 36, 1)) + 4096& * Check&(65, MID$(InString$, 37, 1)) + 64& * Check&(65, MID$(InString$, 38, 1)) + Check&(65, MID$(InString$, 39, 1))
'^^^^^^^ uses less stack than [ Check&(69,...) ]
RetVal& = 0
IF TMP(1) + 40 > TMP(0) THEN RetVal& = RetVal& - 16
IF TMP(4) + 40 > TMP(0) THEN RetVal& = RetVal& - 32
IF TMP(5) + 40 > TMP(0) THEN RetVal& = RetVal& - 64
IF RetVal& = 0 AND TMP(0) < 40 + TMP(1) + TMP(4) + TMP(5) THEN RetVal& = -128
IF TMP(0) > 40 + TMP(1) + TMP(4) + TMP(5) THEN RetVal& = -256
IF RetVal& = 0 AND 2 > 64& * Check&(65, MID$(InString$, 8, 1)) + Check&(65, MID$(InString$, 9, 1)) THEN
' First, insert a leading zero only if {LL$} = 0
IF TMP(0) MOD 4 > 0 AND TMP(1) = 0 THEN
InString$ = LEFT$(InString$, 40) + CHR$(48) + RIGHT$(InString$, TMP(0) - 40)
TMP(0) = TMP(0) + 1
TMP(1) = TMP(1) + 1
END IF
' Second, push out left zeroes as long as {LZ$} > 0
DO WHILE TMP(0) MOD 4 > 0 AND TMP(2) > 0
InString$ = LEFT$(InString$, 40 + TMP(1)) + CHR$(48) + RIGHT$(InString$, TMP(4) + TMP(5))
TMP(0) = TMP(0) + 1
TMP(1) = TMP(1) + 1
TMP(2) = TMP(2) - 1
LOOP
' Third, push out right zeroes as long as {MZ$} > 0
DO WHILE TMP(0) MOD 4 > 0 AND TMP(3) > 0
InString$ = LEFT$(InString$, 40 + TMP(1)) + CHR$(48) + RIGHT$(InString$, TMP(4) + TMP(5))
TMP(0) = TMP(0) + 1
TMP(3) = TMP(3) - 1
TMP(4) = TMP(4) + 1
LOOP
' Complete String alignment with leading zeroes
DO WHILE TMP(0) MOD 4 > 0
InString$ = LEFT$(InString$, 40) + CHR$(48) + RIGHT$(InString$, TMP(0) - 40)
TMP(0) = TMP(0) + 1
TMP(1) = TMP(1) + 1
LOOP
' Refresh the header
MID$(InString$, 11, 5) = Build$(5, 0, TMP(1))
MID$(InString$, 17, 5) = Build$(5, 0, TMP(2))
MID$(InString$, 23, 5) = Build$(5, 0, TMP(3))
MID$(InString$, 29, 5) = Build$(5, 0, TMP(4))
MID$(InString$, 35, 5) = Build$(5, 0, TMP(5))
END IF
ERASE TMP
END IF
CASE 4445 TO 8191
' { 101 - 1|| } are reserved for VLFP processing
' Returns: (not currently used)
RetVal& = 0 - Op&
CASE ELSE
RetVal& = 0 - Op&
END SELECT
Check& = RetVal&
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION CheckMate&& (Op AS _INTEGER64, InString AS STRING) QB64-specific eventual replacement for the old Check& routine, 08-20-2011 to ??
' ---------------------------------------------------------------------------
' {__Alpha_Project__} (Pacifica Central Computer Integrated OS enVironment) [08-20-2011]
'||__forget_everything_you_think_you_know_about_computers_because_I_am_GoinG_boldly_where_no_one_has_ever_gone_before__|| '; <-= ;' =-> I owe it all to those who paved the Way for me to begin this _particular_ AdVenture in the first place! ''''#'
'||__
'#'...'Galleon'Pete'Cyperium'Clippy'et al'...'#' include/exclude at your best assessment
'
' * Op&& (Base-64) = Type of string to expect and/or operation to perform
'
' { 000000000000 } = Test Single Character for "0"
' { 000000000001 } = Test Single Character for "1" ' ! This is different behavior than old Check& ! '
' { 000000000002 } = Test Single Character for [ "0" ; "1" ; "2" ; "3" ]
' { 000000000003 } = Test Single Character for [ "0" "1" "2" "3" "4" "5" "6" "7" ]
' { 000000000004 } = Test Single Character for [ 0 1 2 3 4 5 6 7 8 9 A B C D E F ]
' { 000000000005 } = Test Single Character for [ "0" - "9", "A" - "V" ]
' { 000000000006 } = Test Single Character for [ "0"-"9","A"-"Z","a"-"z","_","|" ]
' { 000000000007 } = Test Single Character for ASCII value { 000 - 127 }
' { 000000000008 } = Test Single Character for ASCII value { 128 - 255 }
'
' { 000000000009 } = ( 9) Test String for Exclusive Base-10
' { 00000000000A } = (10) Test Base-10-Format String ( *!* ALTERS InString$ *!* )
'
'#'~WIP~'; all below has not been ported over yet. ;'~WIP~'#'
'#'~WIP~'; all below has not been ported over yet. ;'~WIP~'#'
'#'~WIP~'; all below has not been ported over yet. ;'~WIP~'#'
'
' { 00000000000B } = (11) Read Sign ("+", "-", or "ñ")
' { 00000000000C } = (12) Read and Strip Sign ( *!* ALTERS InString$ *!* )
' { 00000000000D } = (13) Find Decimal Point
'
' { 00000000000G } = (16) Test Hexadecimal String ( all { "0" - "9", "A" - "F" } )
' { 00000000000O } = (24) Test Octal String ( all { "0" to "7" } )
' { 00000000000W } = (32) Test Base-32 String ( all { "0" - "9", "A" - "V" } )
' { 000000000010 } = (64) Test Base-64 String ( all { 0-9,A-Z,a-z, "_","|" } )
'
' { 000000000011 } = (65) Read Base-64 String ( 1 Char only)
' { 000000000012 } = (66) Read Base-64 String ( 2 Chars only)
' { 000000000014 } = (68) Read Base-64 String ( 4 Chars only)
' { 000000000015 } = (69) Read Base-64 String ( 5 Chars only)
' { 00000000001A } = (74) Read Base-64 String (10 Ch. HIGH DWORD OVERWRITES Op& ! )
'
' { 000000000023 } = Test Short-INT compatibility (131)
' ( { -800 to +7|| } implicitly signed,
' { ñ000 to ñF|| } explicitly unsigned )
'
' { 000000000026 } = Test Long-INT compatibility (134)
' ( { -200000 to +1||||| } implicitly signed,
' { ñ000000 to ñ3||||| } explicitly unsigned )
'
' { 00000000002B } = Test 64-bit-INT compatibility (139)
' ( { -80000000000 to +7|||||||||| } implicitly signed,
' { ñ00000000000 to ñF|||||||||| } explicitly unsigned )
'
' { 000000000033 } = Return integer value of Short-INT compatible string (195)
' ( { -800 to +7|| } implicitly signed,
' { ñ000 to ñF|| } explicitly unsigned )
'
' { 000000000036 } = Return integer value of Long-INT compatible string (198)
' ( { -200000 to +1||||| } implicitly signed,
' { ñ000000 to ñ3||||| } explicitly unsigned )
'
' { 00000000003B } = ********** RESERVED FOR FORWARD COMPATIBILITY ********** (203)
' { 00000000003B } = Return integer value of 64-bit-INT compatibile string (203)
' ( { -80000000000 to +7|||||||||| } implicitly signed,
' { ñ00000000000 to ñF|||||||||| } explicitly unsigned )
'
' { 000000000100 } = Test VLFP-Format String (4096)
' { 101 - 1|| } are reserved for VLFP processing
'
' Unlisted values are not used and will return [ CheckMate&& = 0 ].
' Different Op&& values produce various return values. Refer to the in-code comments for details.
'
'__||
' ---------------------------------------------------------------------------
' FUNCTION CheckMate&& (Op AS _INTEGER64, InString AS STRING) QB64-specific eventual replacement for the old Check& routine, 08-20-2011 to ??
' ---------------------------------------------------------------------------
FUNCTION CheckMate&& (Op AS _INTEGER64, InString AS STRING)
RetVal&& = 0: RetVal&& = LEN(InString$)
SELECT CASE Op&&
CASE IS < 0
'not currently used'
RetVal&& = 0
CASE 0
' {000} Test char for "0"
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal&& = 0 THEN
RetVal&& = -2
ELSEIF RetVal&& > 1 THEN
RetVal&& = -3
ELSEIF ASC(InString$) = 48 THEN
RetVal&& = 1
ELSE
RetVal&& = -1
END IF
CASE 1
' {001} Test char for "1"
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal&& = 0 THEN
RetVal&& = -2
ELSEIF RetVal&& > 1 THEN
RetVal&& = -3
ELSEIF ASC(InString$) = 49 THEN
RetVal&& = 1
ELSE
RetVal&& = -1
END IF
CASE 2
' {002} Test char for [ 0 1 2 3 ] (two-bit)
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal&& = 0 THEN
RetVal&& = -2
ELSEIF RetVal&& > 1 THEN
RetVal&& = -3
ELSE
SELECT CASE ASC(InString$)
CASE 48 TO 51
RetVal&& = 1
CASE ELSE
RetVal&& = -1
END SELECT
END IF
CASE 3
' {003} Test char for [ 0 1 2 3 4 5 6 7 ] (octal)
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal&& = 0 THEN
RetVal&& = -2
ELSEIF RetVal&& > 1 THEN
RetVal&& = -3
ELSE
SELECT CASE ASC(InString$)
CASE 48 TO 55
RetVal&& = 1
CASE ELSE
RetVal&& = -1
END SELECT
END IF
CASE 4
' {004} Test char for [ 0 1 2 3 4 5 6 7 8 9 A B C D E F ] (hex)
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal&& = 0 THEN
RetVal&& = -2
ELSEIF RetVal&& > 1 THEN
RetVal&& = -3
ELSE
SELECT CASE ASC(InString$)
CASE 48 TO 57, 65 TO 70
RetVal&& = 1
CASE ELSE
RetVal&& = -1
END SELECT
END IF
CASE 5
' {005} Test char for [ "0"-"9","A"-"V" ] (Base-32)
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal&& = 0 THEN
RetVal&& = -2
ELSEIF RetVal& > 1 THEN
RetVal&& = -3
ELSE
SELECT CASE ASC(InString$)
CASE 48 TO 57, 65 TO 86
RetVal&& = 1
CASE ELSE
RetVal&& = -1
END SELECT
END IF
CASE 6
' {006} Test char for [ "0"-"9","A"-"Z","a"-"z","_","|" ] (Base-64)
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal&& = 0 THEN
RetVal&& = -2
ELSEIF RetVal&& > 1 THEN
RetVal&& = -3
ELSE
SELECT CASE ASC(InString$)
CASE 48 TO 57, 65 TO 90, 97 TO 122, 95, 124
RetVal&& = 1
CASE ELSE
RetVal&& = -1
END SELECT
END IF
CASE 7
' {007} Test char for ASCII value { 000 - 127 }
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal&& = 0 THEN
RetVal&& = -2
ELSEIF RetVal&& > 1 THEN
RetVal&& = -3
ELSEIF ASC(InString$) < 128 THEN
RetVal&& = 1
ELSE
RetVal&& = -1
END IF
CASE 8
' {008} Test char for ASCII value { 128 - 255 }
' Returns:
' 1 = Passed; -1 = Test FAILED; -2 = NULL String; -3 = Too Long
IF RetVal&& = 0 THEN
RetVal&& = -2
ELSEIF RetVal&& > 1 THEN
RetVal&& = -3
ELSEIF ASC(InString$) > 127 THEN
RetVal&& = 1
ELSE
RetVal&& = -1
END IF
CASE 9
' {009} Test String for Exclusive Base-10
' Returns:
' {& > 0} = String Length; {& < 0} = FAILED at negative offset
IF RetVal&& = 0 THEN RetVal&& = -1
FOR I&& = 1 TO RetVal&&
SELECT CASE ASC(MID$(InString$, I&&, 1))
CASE 48 TO 57
' keep going
CASE ELSE
RetVal&& = 0 - I&&
EXIT FOR
END SELECT
NEXT I&&
CASE 10
' {00A} Test String for Base-10-Format ( *!* ALTERS InString$ *!* )
' Returns:
' {& > 0} = DP offset; {& < 0} = FAILED at negative offset
'
' After testing passes, the string is given missing leading and trailing zeroes then trimmed of any nonessential leading and trailing zeroes.
IF RetVal&& = 0 THEN
RetVal&& = -1 '! should _actually_ be -0 !'
ELSEIF RetVal&& = 1 THEN
RetVal&& = -1 'too small'
ELSE
'#' DPC% (Decimal Point Counter) ("There can be only one") '#'
DPC% = 0
SELECT CASE ASC(LEFT$(InString$, 1))
CASE 43, 45, 126, 241 '; "+", "-", "~", "ñ" ;'
FOR I&& = 2 TO LEN(InString$) 'don't use RetVal&& here because of the code below which redirects RetVal&& to hold the DP offset'
SELECT CASE ASC(MID$(InString$, I&&, 1))
CASE 46 ' "."
IF DPC% > 0 THEN
RetVal&& = 0 - I&&
EXIT FOR
ELSE
DPC% = DPC% + 1
RetVal&& = I&&
END IF
CASE 48 TO 57 ';ASCII 0-9;'
' keep going '
CASE ELSE
RetVal&& = 0 - I&&
EXIT FOR
END SELECT
NEXT I&&
CASE ELSE
RetVal&& = -1 '#'; Per the Base-Ten-Format of strings, the sign is EXplicit at the LEFT ;'#'
END SELECT
'# RetVal&& now contains the DP offset instead of LEN (or is negative, indicating an error condition)
IF RetVal&& < 0 THEN
'Take no action, just return the error condition.'
' ELSEIF RetVal&& = 0 OR RetVal&& = 1 THEN 'Both hypothetically impossible.'
' RetVal&& = -2 '!An unexpected error has occured!'
ELSEIF DPC% = 0 THEN
RetVal&& = 0&& - LEN(InString$) '! FAILs because the decimal point is also EXplicit within the string !'
ELSEIF RetVal&& = 2 THEN 'Insert the implied leading zero.'
Work$ = LEFT$(InString$, 1) + "0" + RIGHT$(InString$, LEN(InString$) - 1)
InString$ = Work$
RetVal&& = 3 'refresh DP offset'
END IF
IF RetVal&& = LEN(InString$) THEN 'Append the implied trailing zero.'
InString$ = InString$ + "0"
END IF
'# Trim any nonessential zeroes. (R then L)
DO WHILE RIGHT$(InString$, 1) = "0" AND RetVal&& < LEN(InString$) - 1
InString$ = LEFT$(InString$, LEN(InString$) - 1)
LOOP
DO WHILE MID$(InString$, 2, 1) = "0" AND RetVal&& > 3
Work$ = LEFT$(InString$, 1) + RIGHT$(InString$, LEN(InString$) - 2)
InString$ = Work$
RetVal&& = RetVal&& - 1
LOOP
END IF
'#'~WIP~'#'
'#'~WIP~'#'
'#'~WIP~'#'
'#'~WIP~'#'
'#'~WIP~'#'
CASE ELSE
'not currently used'
RetVal&& = 0
END SELECT
CheckMate&& = RetVal&&
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION Convert$ (Op%, InString$) Makes Strings from Other Strings
' ---------------------------------------------------------------------------
'
' Op% Input Expected Output Produced
'
' { 000 } = Four Base-64 Characters = Three ASCII bytes
' { 001 } = Three ASCII bytes = Four Base-64 Characters
' { 002 } = 4 * Base-64 Characters = 3 * ASCII bytes
' { 003 } = 3 * ASCII bytes = 4 * Base-64 Characters
'
' { ??? } = Standard ASCII text = Base-64 Textish
' { ??? } = Base-64 Textish = Standard ASCII text
'
' { ??? } = Base-10-Format String = VLFP-Format String
' { ??? } = VLFP-Format String = Base-10-Format String
'
' ...more to follow...
' ---------------------------------------------------------------------------
' FUNCTION Convert$ (Op%, InString$) Makes Strings from Other Strings
' ---------------------------------------------------------------------------
FUNCTION Convert$ (Op AS INTEGER, InString AS STRING)
SELECT CASE Op%
CASE 0
Temp& = Check&(68, InString$)
IF Temp& >= 0 THEN
Temp$ = RIGHT$(STRING$(5, 48) + HEX$(Temp&), 6)
FOR I% = 2 TO 1 STEP -1
Temp% = 16 * Check&(65, LEFT$(Temp$, 1)) + Check&(65, MID$(Temp$, 2, 1))
Temp$ = RIGHT$(Temp$, I% * 2)
RetStr$ = RetStr$ + CHR$(Temp%)
NEXT I%
Temp% = 16 * Check&(65, LEFT$(Temp$, 1)) + Check&(65, RIGHT$(Temp$, 1))
RetStr$ = RetStr$ + CHR$(Temp%)
END IF
CASE 1
IF LEN(InString$) = 3 THEN
Temp& = 65536 * ASC(LEFT$(InString$, 1)) + 256& * ASC(MID$(InString$, 2, 1)) + ASC(RIGHT$(InString$, 1))
RetStr$ = RIGHT$(Build$(5, 0, Temp&), 4)
END IF
CASE 2
IF Check&(64, InString$) = LEN(InString$) AND LEN(InString$) MOD 4 = 0 THEN
FOR I& = 1 TO LEN(InString$) STEP 4
RetStr$ = RetStr$ + Convert$(0, MID$(InString$, I&, 4))
NEXT I&
END IF
CASE 3
IF LEN(InString$) MOD 3 = 0 THEN
FOR I& = 1 TO LEN(InString$) STEP 3
RetStr$ = RetStr$ + Convert$(1, MID$(InString$, I&, 3))
NEXT I&
END IF
CASE ELSE
END SELECT
Convert$ = RetStr$
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION DChar$ (inINT%) Simplified Build$() Operation
' ---------------------------------------------------------------------------
FUNCTION DChar$ (inINT AS INTEGER)
DChar$ = Build$(2, inINT%, 0)
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION FChar$ (inDBL&) Simplified Build$() Operation
' ---------------------------------------------------------------------------
FUNCTION FChar$ (inDBL AS LONG)
FChar$ = Build$(5, 0, inDBL&)
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION Fixed$ (Size%, InTop$, Op$, InBot$) Fixed-Length Arithmetic
' ---------------------------------------------------------------------------
'
' * Operation: "+" (Add)
' * Size% Returns:
' ( 1) ( 2) { 00 - 1_ }
' ( 2) ( 3) { 000 - 1|_ }
' ( 4) ( 5) { 00000 - 1|||_ }
' ( 5) ( 6) { 000000 - 1||||_ }
' (10) (11) { 00000000000 - 1|||||||||_ }
'
' * Operation: "-" (Subtract)
' * Size% Returns:
' ( 1) ( 2) { -| - +| }
' ( 2) ( 3) { -|| - +|| }
' ( 4) ( 5) { -|||| - +|||| }
' ( 5) ( 6) { -||||| - +||||| }
' (10) (11) { -|||||||||| - +|||||||||| }
'
' * Operation: "*" (Multiply)
' * Size% Returns:
' ( 1) ( 2) { 00 - _1 }
' ( 2) ( 4) { 0000 - |_01 }
' ( 4) ( 8) { 00000000 - |||_0001 }
' ( 5) (10) { 0000000000 - ||||_00001 }
' (10) (20) { 00000000000000000000 - |||||||||_0000000001 }
'
' Both input strings must match Size% in length, and may not be signed.
' A sign symbol is only applied to the output string during subtraction.
'
' ---------------------------------------------------------------------------
' FUNCTION Fixed$ (Size%, InTop$, Op$, InBot$) Fixed-Length Arithmetic
' ---------------------------------------------------------------------------
FUNCTION Fixed$ (Size AS INTEGER, InTop AS STRING, Op AS STRING, InBot AS STRING)
' Minimum Stack: Varies by Size% (see below)
RetStr$ = CHR$(66) + CHR$(97) + CHR$(100) + CHR$(32)
IF LEN(InTop$) = Size% AND LEN(InBot$) = Size% AND Check&(64, InTop$ + InBot$) = Size% + Size% THEN
' keep going
ELSE
' return error: "Bad " + [ "TOP" : "BOT" ] + " " + [ "Input" : "Size" ]
IF LEN(InTop$) <> Size% OR Check&(64, InTop$) <> Size% THEN
RetStr$ = RetStr$ + CHR$(84) + CHR$(79) + CHR$(80)
ELSEIF LEN(InBot$) <> Size% OR Check&(64, InBot$) <> Size% THEN
RetStr$ = RetStr$ + CHR$(66) + CHR$(79) + CHR$(84)
END IF
RetStr$ = RetStr$ + CHR$(32)
IF LEN(InTop$) = Size% AND LEN(InBot$) = Size% THEN
RetStr$ = RetStr$ + CHR$(73) + CHR$(110) + CHR$(112) + CHR$(117) + CHR$(116)
ELSE
RetStr$ = RetStr$ + CHR$(83) + CHR$(105) + CHR$(122) + CHR$(101)
END IF
Fixed$ = RetStr$
EXIT FUNCTION
END IF
SELECT CASE Size%
CASE 1
' Minimum Stack: 256
IF Op$ = CHR$(43) THEN
' + (Add)
RetVal% = Check&(65, InTop$) + Check&(65, InBot$)
RetStr$ = Build$(2, RetVal%, 0)
ELSEIF Op$ = CHR$(45) THEN
' - (Subtract)
RetVal% = Check&(65, InTop$) - Check&(65, InBot$)
RetStr$ = Build$(0, RetVal%, 0) + Build$(1, ABS(RetVal%), 0)
ELSEIF Op$ = CHR$(42) THEN
' * (Multiply)
RetVal% = Check&(65, InTop$) * Check&(65, InBot$)
RetStr$ = Build$(2, RetVal%, 0)
END IF
CASE 2
' Minimum Stack: 298
IF Op$ = CHR$(43) THEN
' + (Add)
RetVal% = Check&(66, InTop$) + Check&(66, InBot$)
RetStr$ = Build$(3, RetVal%, 0)
ELSEIF Op$ = CHR$(45) THEN
' - (Subtract)
RetVal% = Check&(66, InTop$) - Check&(66, InBot$)
RetStr$ = Build$(0, RetVal%, 0) + Build$(2, ABS(RetVal%), 0)
ELSEIF Op$ = CHR$(42) THEN
' * (Multiply)
RetVal& = Check&(66, InTop$) * Check&(66, InBot$)
RetStr$ = RIGHT$(Build$(5, 0, RetVal&), 4)
END IF
CASE 4
' Minimum Stack: 306
IF Op$ = CHR$(43) THEN
' + (Add)
RetVal& = Check&(68, InTop$) + Check&(68, InBot$)
RetStr$ = Build$(5, 0, RetVal&)
ELSEIF Op$ = CHR$(45) THEN
' - (Subtract)
RetVal& = Check&(68, InTop$) - Check&(68, InBot$)
RetStr$ = Build$(0, 0, RetVal&) + RIGHT$(Build$(5, 0, ABS(RetVal&)), 4)
ELSEIF Op$ = CHR$(42) THEN
' * (Multiply)
RetVal# = Check&(68, InTop$)
RetVal# = RetVal# * Check&(68, InBot$)
RetStr$ = RIGHT$(ReadD$(RetVal#), 8)
END IF
CASE 5
' Minimum Stack: 378
IF Op$ = CHR$(43) THEN
' + (Add)
RetVal& = Check&(69, InTop$) + Check&(69, InBot$)
RetStr$ = Build$(6, 0, RetVal&)
ELSEIF Op$ = CHR$(45) THEN
' - (Subtract)
RetVal& = Check&(69, InTop$) - Check&(69, InBot$)
RetStr$ = Build$(0, 0, RetVal&) + Build$(5, 0, ABS(RetVal&))
ELSEIF Op$ = CHR$(42) THEN
' * (Multiply)
TL% = Check&(65, LEFT$(InTop$, 1)): TR& = Check&(68, RIGHT$(InTop$, 4))
BL% = Check&(65, LEFT$(InBot$, 1)): BR& = Check&(68, RIGHT$(InBot$, 4))
RetStr$ = Fixed$(4, RIGHT$(InTop$, 4), Op$, RIGHT$(InBot$, 4))
RetVal# = 1# * BR& * TL% + TR& * BL% + Check&(68, LEFT$(RetStr$, 4))
RetVal% = INT(RetVal# / 16777216)
RetVal# = RetVal# - (16777216# * RetVal%): RetVal& = RetVal#
RetVal% = RetVal% + TL% * BL%
RetStr$ = Build$(2, RetVal%, 0) + RIGHT$(Build$(5, 0, RetVal&), 4) + RIGHT$(RetStr$, 4)
END IF
CASE 10
' Minimum Stack: 458
IF Op$ = CHR$(43) THEN
' + (Add)
RetVal& = Check&(69, RIGHT$(InTop$, 5)) + Check&(69, RIGHT$(InBot$, 5))
IF RetVal& >= 64 ^ 5 THEN
RetVal& = RetVal& - 64 ^ 5
RetStr$ = Build$(5, 0, RetVal&)
RetVal& = 1 + Check&(69, LEFT$(InTop$, 5)) + Check&(69, LEFT$(InBot$, 5))
ELSE
RetStr$ = Build$(5, 0, RetVal&)
RetVal& = Check&(69, LEFT$(InTop$, 5)) + Check&(69, LEFT$(InBot$, 5))
END IF
RetStr$ = Build$(6, 0, RetVal&) + RetStr$
ELSEIF Op$ = CHR$(45) THEN
' - (Subtract)
TL& = Check&(69, LEFT$(InTop$, 5)): TR& = Check&(69, RIGHT$(InTop$, 5))
BL& = Check&(69, LEFT$(InBot$, 5)): BR& = Check&(69, RIGHT$(InBot$, 5))
RetVal# = TL& ' # result may be rounded, just get the sign
RetVal# = RetVal# * 64 ^ 5 - BL& * 64 ^ 5 + TR& - BR&
IF RetVal# < 0 THEN
' subtract top from bottom, result is negative
IF TR& > BR& THEN
BL& = BL& - 1
BR& = BR& + 64 ^ 5
END IF
RetStr$ = Op$
ELSE
' subtract bottom from top, result is positive
IF BR& > TR& THEN
TL& = TL& - 1
TR& = TR& + 64 ^ 5
END IF
RetStr$ = CHR$(43)
END IF
IF RetStr$ = Op$ THEN
RetVal& = BL& - TL&
RetStr$ = RetStr$ + Build$(5, 0, RetVal&)
RetVal& = BR& - TR&
ELSE
RetVal& = TL& - BL&
RetStr$ = RetStr$ + Build$(5, 0, RetVal&)
RetVal& = TR& - BR&
END IF
RetStr$ = RetStr$ + Build$(5, 0, RetVal&)
ELSEIF Op$ = CHR$(42) THEN
' * (Multiply) ...has to be done with strings '#(?perhaps not anymore?)#' This section needs clarification! '
RetStr$ = Fixed$(5, LEFT$(InTop$, 5), Op$, RIGHT$(InBot$, 5))
RetStr$ = Fixed$(5, RIGHT$(InTop$, 5), Op$, LEFT$(InBot$, 5)) + RetStr$
RetStr$ = Fixed$(5, LEFT$(InTop$, 5), Op$, LEFT$(InTop$, 5)) + RetStr$
RetStr$ = Fixed$(5, RIGHT$(InTop$, 5), Op$, RIGHT$(InBot$, 5)) + RetStr$
'
' LEN Column
' 40 = 2222211111,4444433333,3333322222,3333322222
' 31 = 43333322222,2222211111,4444433333
' 27 = 433333,322222,11111,4444433333
' 28 = 4,433333,32222211111,44444,added
' 23 = 44,33333,3,22222,11111,44444
' 23 = 44,4,33333,22222,11111,44444
' 23 = 444,33333,22222,11111,44444
' 20 = 44444,33333,22222,11111
'
RetStr$ = Fixed$(10, MID$(RetStr$, 21, 10), CHR$(43), RIGHT$(RetStr$, 10)) + LEFT$(RetStr$, 20)
RetStr$ = LEFT$(RetStr$, 6) + Fixed$(5, MID$(RetStr$, 7, 5), CHR$(43), MID$(RetStr$, 12, 5)) + RIGHT$(RetStr$, 15)
RetStr$ = LEFT$(RetStr$, 1) + Fixed$(5, MID$(RetStr$, 2, 5), CHR$(43), RIGHT$(RetStr$, 5)) + RIGHT$(RetStr$, 21)
RetStr$ = Fixed$(1, LEFT$(RetStr$, 1), CHR$(43), MID$(RetStr$, 2, 1)) + MID$(RetStr$, 3, 21)
RetStr$ = LEFT$(RetStr$, 2) + Fixed$(5, MID$(RetStr$, 3, 5), CHR$(43), STRING$(4, 48) + MID$(RetStr$, 8, 1)) + RIGHT$(RetStr$, 15)
RetStr$ = Fixed$(2, LEFT$(RetStr$, 2), CHR$(43), CHR$(48) + MID$(RetStr$, 3, 1)) + RIGHT$(RetStr$, 20)
RetStr$ = RIGHT$(Fixed$(5, STRING$(2, 48) + LEFT$(RetStr$, 3), CHR$(43), RIGHT$(RetStr$, 5)), 5) + MID$(RetStr$, 4, 15)
END IF
CASE ELSE
' return error: "Bad Size"
RetStr$ = RetStr$ + CHR$(83) + CHR$(105) + CHR$(122) + CHR$(101)
END SELECT
IF RetStr$ = CHR$(66) + CHR$(97) + CHR$(100) + CHR$(32) THEN
' return error: "Bad Op"
RetStr$ = RetStr$ + CHR$(79) + CHR$(112)
END IF
Fixed$ = RetStr$
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION GetUD$ (inDFP#) Get Double-FP as UNSIGNED
' ---------------------------------------------------------------------------
' Returns: {"ñ000000000" - "ñ|||||||||"}
' "<" if inDFP# is below -9007199254740992
' ">" if inDFP# is above +9007199254740991
' "%" if inDFP# is not an integer
' ---------------------------------------------------------------------------
' FUNCTION GetUD$ (inDFP#) Get Double-FP as UNSIGNED
' ---------------------------------------------------------------------------
FUNCTION GetUD$ (inDFP AS DOUBLE)
RetStr$ = ReadD$(inDFP#)
IF LEFT$(RetStr$, 1) = CHR$(45) THEN
RetStr$ = CHR$(48) + RIGHT$(RetStr$, 9)
RetStr$ = Fixed$(10, CHR$(49) + STRING$(9, 48), CHR$(45), RetStr$)
RetStr$ = CHR$(241) + RIGHT$(RetStr$, 9)
ELSEIF LEN(RetStr$) = 9 THEN
RetStr$ = CHR$(241) + RetStr$
END IF
GetUD$ = RetStr$
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION GetUL$ (inDBL&) Simplified Build$() Operation
' ---------------------------------------------------------------------------
FUNCTION GetUL$ (inDBL AS LONG)
GetUL$ = Build$(7, 0, inDBL&)
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION GetUS$ (inINT%) Simplified Build$() Operation
' ---------------------------------------------------------------------------
FUNCTION GetUS$ (inINT AS INTEGER)
GetUS$ = Build$(4, inINT%, 0)
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION Integrate& (InString$) Simplified Check&() Operation
' ---------------------------------------------------------------------------
FUNCTION Integrate& (InString AS STRING)
Integrate& = Check&(198, InString$)
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION ReadD$ (inDFP#) Read Double-FP as Integer
' ---------------------------------------------------------------------------
' Returns: {"-W00000000" - "-000000001"} if inDFP# is negative
' { "000000000" - "V||||||||"} if inDFP# is positive
' "<" if inDFP# is below -9007199254740992
' ">" if inDFP# is above +9007199254740991
' "%" if inDFP# is not an integer
' ---------------------------------------------------------------------------
' FUNCTION ReadD$ (inDFP#) Read Double-FP as Integer
' ---------------------------------------------------------------------------
FUNCTION ReadD$ (inDFP AS DOUBLE)
Z# = INT(inDFP#)
IF Z# <> inDFP# THEN
RetStr$ = CHR$(37)
ELSE
SELECT CASE inDFP#
CASE IS < -9007199254740992#
RetStr$ = CHR$(60)
CASE -9007199254740992#
RetStr$ = CHR$(45) + CHR$(87) + STRING$(7, 48)
CASE -9007199254740991# TO -1
Z# = INT(ABS(inDFP#) / 4398046511104#)
X% = Z#: Z# = ABS(inDFP#) - 4398046511104# * X%: Z# = INT(Z# / 1073741824#)
Y% = Z#: Z# = ABS(inDFP#) - 4398046511104# * X%
Z# = Z# - 1073741824# * Y%: Z& = Z#
RetStr$ = CHR$(45) + Build$(2, X%, 0) + Build$(2, Y%, 0) + Build$(5, 0, Z&)
CASE 0 TO 9007199254740991#
Z# = INT(inDFP# / 4398046511104#)
X% = Z#: Z# = inDFP# - 4398046511104# * X%: Z# = INT(Z# / 1073741824#)
Y% = Z#: Z# = inDFP# - 4398046511104# * X%
Z# = Z# - 1073741824# * Y%: Z& = Z#
RetStr$ = Build$(2, X%, 0) + Build$(2, Y%, 0) + Build$(5, 0, Z&)
CASE IS > 9007199254740991#
RetStr$ = CHR$(62)
END SELECT
END IF
ReadD$ = RetStr$
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION ReadL$ (inDBL&) Simplified Build$() Operation
' ---------------------------------------------------------------------------
FUNCTION ReadL$ (inDBL AS LONG)
ReadL$ = Build$(6, 0, inDBL&)
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION ReadS$ (inINT%) Simplified Build$() Operation
' ---------------------------------------------------------------------------
FUNCTION ReadS$ (inINT AS INTEGER)
ReadS$ = Build$(3, inINT%, 0)
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION SChar$ (inINT%) Simplified Build$() Operation
' ---------------------------------------------------------------------------
FUNCTION SChar$ (inINT AS INTEGER)
SChar$ = Build$(1, inINT%, 0)
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION Squeeze$ (InString$) Simplified Convert$() Operation
' ---------------------------------------------------------------------------
FUNCTION Squeeze$ (InString AS STRING)
Squeeze$ = Convert$(2, InString$)
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION Stretch$ (InString$) Simplified Convert$() Operation
' ---------------------------------------------------------------------------
'
' To Stretch data from a file:
'
'SQU$ = ""
'IN$ = STRING$(1, 32)
'OPEN "Pi.SQU" FOR BINARY ACCESS READ AS 1
' DO WHILE NOT EOF(1)
' GET #1, , IN$
' SQU$ = SQU$ + IN$
' LOOP
'CLOSE 1
'SQU$ = LEFT$(SQU$, LEN(SQU$) - 1) ' trim EOF marker
'Pi$ = Stretch$(SQU$)
'
' ---------------------------------------------------------------------------
' FUNCTION Stretch$ (InString$) Simplified Convert$() Operation
' ---------------------------------------------------------------------------
FUNCTION Stretch$ (InString AS STRING)
Stretch$ = Convert$(3, InString$)
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION Value% (InString$) Simplified Check&() Operation
' ---------------------------------------------------------------------------
FUNCTION Value% (InString AS STRING)
Value% = Check&(195, InString$)
END FUNCTION
' ---------------------------------------------------------------------------
' FUNCTION VLFP$ (InTop$, Op$, InBot$) Base-64 String Arithmetic
' ---------------------------------------------------------------------------
'
' All valid VLFP (Variable-Length Floating-Point) strings begin
' with a 40-character header comprised of the following fields:
'
' [ Prefix, Signs, LeftLEN, LeftZeroes, MidZeroes, MiddleLEN, RightLEN ]
'
' (PR$) Prefix$ = "VLFP_e_"
' (SI$) Signs$ = 2 characters + "_"
' (LL$) LeftLEN$ = 5 characters + "_"
' (LZ$) LeftZeroes$ = 5 characters + "_"
' (MZ$) MidZeroes$ = 5 characters + "_"
' (ML$) MiddleLEN$ = 5 characters + "_"
' (RL$) RightLEN$ = 5 characters + "_"
'
' In addition to the sign of the string, the Signs$ field contains various
' flags related to the format of the string. Under normal circumstances,
' SI$ will be either "00" (Positive) or "01" (Negative). Remaining fields
' are ordinary Base-64 numeric values. In a 'normal' string, ML$ refers to
' the nonrepeating 'digits' to the right of the 'decimal' point, with RL$
' referring to any repeating 'digits' which follow to the right of those.
' LZ$ and MZ$ indicate the number of zeroes inserted to the immediate left
' and right of the 'decimal' point. They are similar to decimal exponential
' notation, but refer instead to powers of 64.
'
' Examples:
' Value PR$+SI$ LL$ LZ$ MZ$ ML$ RL$ Data
'
' ( 0.0 ) = "VLFP_e_00_00000_00000_00000_00000_00000_"
'
' ( 1.0 ) (64^0) = "VLFP_e_00_00002_00000_00000_00001_00001_0100"
' ( 64.0 ) (64^1) = "VLFP_e_00_00002_00000_00000_00001_00001_1000"
' ( 4096.0 ) (64^2) = "VLFP_e_00_00002_00002_00000_00001_00001_0100"
' ( 262144.0 ) (64^3) = "VLFP_e_00_00002_00002_00000_00001_00001_1000"
' ( 1073741824 ) (64^4) = "VLFP_e_00_00002_00004_00000_00001_00001_0100"
' ( 1073741824 ) (64^4) = "VLFP_e_00_00001_00004_00000_00000_00000_1"
'
' ( 0.5 ) ( 1/2 ) = "VLFP_e_00_00001_00000_00000_00002_00001_0W00"
' ( 1.3333333 ) ( 4/3 ) = "VLFP_e_00_00002_00000_00000_00001_00001_01LL"
' ( 2.1 ) (21/10) = "VLFP_e_00_00003_00000_00000_00003_00002_0026PcPc"
' ( 2.1 ) (21/10) = "VLFP_e_00_00001_00000_00000_00001_00002_26Pc"
'
' (~Pi~) = "VLFP_e_00_00001_00000_00000_0000J_00000_393zgY8MZ2DCJ6Oek0t2" ' This is slightly incorrect! The rightmost value is "1", not "2" ' (The result of a FP approximation, left for the benefit of documentation.)
'
' The values of "e" plus LL$ plus ML$ plus RL$ will equal the string length.
' Ideally, this total will be evenly divisible by four, although this is not
' a requirement.
' ---------------------------------------------------------------------------
' By design, this function does not alter the input strings. If possible,
' they should be trimmed to minimal size before calculations are performed.
' ---------------------------------------------------------------------------
' FUNCTION VLFP$ (InTop$, Op$, InBot$) Base-64 String Arithmetic
' ---------------------------------------------------------------------------
FUNCTION VLFP$ (InTop AS STRING, Op AS STRING, InBot AS STRING)
' Test Input Strings
SELECT CASE Op$
CASE CHR$(43) ' + (Add)
CASE CHR$(45) ' - (Subtract)
CASE CHR$(42) ' * (Multiply)
CASE ELSE
EXIT FUNCTION
END SELECT
I% = Check&(4096, InTop$): J% = Check&(4096, InBot$)
IF I% < 0 OR J% < 0 THEN EXIT FUNCTION ' testing returned an error condition
IF I% > 1 OR J% > 1 THEN EXIT FUNCTION ' alternate format (not supported yet)
' ---------------------------------------------------------------------------
' SI$ (Signs$) Details:
' (twelve bits, of which the far right bit signs the string)
'
' Possible alternate formats include...
'
' * Integer fractions (ML$ sizes numerator; RL$ sizes denominator)
' * Square/Cube root and/or Reciprocal of the string's value, etc.
' * Common/Natural logarithm, factorial, etc.
' * Sine/Cosine/Tangent/etc.
'
' ...and so forth...
'
' For now, though, I'd be happy with having the standard format working.
' ---------------------------------------------------------------------------
' Make Stat Data Arrays
' [ Top : Bot ] Short Data ( <0 = pointers / temps )
' 0 = {SI$}; 1 = {LL$}; 2 = L pad; 3 = R offset; 4 = {ML$}; 5 = {RL$}
DIM TSD(-2 TO 5) AS INTEGER
DIM BSD(-2 TO 5) AS INTEGER
' [ Ret : Top : Bot ] Long Data
' 1 = L magnitude; 2 = {LZ$}; 3 = {MZ$}; 4 = M magnitude; 5 = R magnitude
DIM RLD(1 TO 5) AS LONG
DIM TLD(1 TO 5) AS LONG
DIM BLD(1 TO 5) AS LONG
' Process Headers
IF I% = 1 THEN TSD(0) = -1 ELSE TSD(0) = 1
IF J% = 1 THEN BSD(0) = -1 ELSE BSD(0) = 1
TSD(1) = Check&(4101, InTop$): BSD(1) = Check&(4101, InBot$)
TLD(2) = Check&(4102, InTop$): BLD(2) = Check&(4102, InBot$)
TLD(3) = Check&(4103, InTop$): BLD(3) = Check&(4103, InBot$)
TSD(4) = Check&(4104, InTop$): BSD(4) = Check&(4104, InBot$)
TSD(5) = Check&(4105, InTop$): BSD(5) = Check&(4105, InBot$)
' Prepare Magnitudes
' Top
TSD(-1) = 41: TSD(-2) = 41 + TSD(1)
IF LEN(InTop$) = 40 THEN
TSD(0) = 0
ELSE
' Left
IF TSD(1) = 0 THEN
TLD(1) = 0
ELSEIF MID$(InTop$, 41, TSD(1)) = STRING$(TSD(1), 48) THEN
TLD(1) = 0
TSD(-1) = TSD(-2)
TSD(2) = TSD(1)
ELSE
TLD(1) = TSD(1) + TLD(2)
DO WHILE ASC(MID$(InTop$, TSD(-1), 1)) = 48 AND TSD(-1) < TSD(-2)
TSD(-1) = TSD(-1) + 1
TSD(2) = TSD(2) + 1
LOOP
END IF
' Middle
IF LEN(InTop$) < TSD(-2) THEN
TLD(4) = 0
ELSE
TLD(4) = TLD(3) + TSD(4)
IF TLD(3) > 0 AND (TSD(4) = 0 OR MID$(InTop$, TSD(-2), TSD(4)) = STRING$(TSD(4), 48)) THEN
TSD(3) = -1
ELSEIF TSD(4) > 0 THEN
IF MID$(InTop$, TSD(-2), TSD(4)) = STRING$(TSD(4), 48) THEN TSD(3) = -1
END IF
END IF
' Right
IF TSD(5) = 0 OR RIGHT$(InTop$, TSD(5)) = STRING$(TSD(5), 48) THEN
TLD(5) = 0
IF TSD(3) = -1 THEN TLD(4) = 0
ELSE
TLD(5) = TSD(5)
END IF
TSD(3) = 0
' Combined
IF TLD(1) + TLD(4) + TLD(5) = 0 THEN TSD(0) = 0
END IF
' Bottom
BSD(-1) = 41: BSD(-2) = 41 + BSD(1)
IF LEN(InBot$) = 40 THEN
BSD(0) = 0
ELSE
' Left
IF BSD(1) = 0 THEN
BLD(1) = 0
ELSEIF MID$(InBot$, 41, BSD(1)) = STRING$(BSD(1), 48) THEN
BLD(1) = 0
BSD(-1) = BSD(-2)
BSD(2) = BSD(1)
ELSE
BLD(1) = BSD(1) + BLD(2)
DO WHILE ASC(MID$(InBot$, BSD(-1), 1)) = 48 AND BSD(-1) < BSD(-2)
BSD(-1) = BSD(-1) + 1
BSD(2) = BSD(2) + 1
LOOP
END IF
' Middle
IF LEN(InBot$) < BSD(-2) THEN
BLD(4) = 0
ELSE
BLD(4) = BLD(3) + BSD(4)
IF BLD(3) > 0 AND (BSD(4) = 0 OR MID$(InBot$, BSD(-2), BSD(4)) = STRING$(BSD(4), 48)) THEN
BSD(3) = -1
ELSEIF BSD(4) > 0 THEN
IF MID$(InBot$, BSD(-2), BSD(4)) = STRING$(BSD(4), 48) THEN BSD(3) = -1
END IF
END IF
' Right
IF BSD(5) = 0 OR RIGHT$(InBot$, BSD(5)) = STRING$(BSD(5), 48) THEN
BLD(5) = 0
IF BSD(3) = -1 THEN BLD(4) = 0
ELSE
BLD(5) = BSD(5)
END IF
BSD(3) = 0
' Combined
IF BLD(1) + BLD(4) + BLD(5) = 0 THEN BSD(0) = 0
END IF
' Compare Magnitudes
' Left
IF TLD(1) = BLD(1) THEN
RLD(1) = TLD(1)
ELSEIF TLD(1) > BLD(1) THEN
RLD(1) = TLD(1)
BSD(2) = BSD(2) + (TLD(1) - BLD(1))
ELSEIF TLD(1) < BLD(1) THEN
RLD(1) = BLD(1)
TSD(2) = TSD(2) + (BLD(1) - TLD(1))
END IF
' Middle
IF TLD(4) = BLD(4) THEN
RLD(4) = TLD(4)
ELSEIF TLD(4) > BLD(4) THEN
RLD(4) = TLD(4)
BSD(3) = TLD(4) - BLD(4)
ELSEIF TLD(4) < BLD(4) THEN
RLD(4) = BLD(4)
TSD(3) = BLD(4) - TLD(4)
END IF
' Right
RLD(5) = TLD(5) * BLD(5)
' Begin String Arithmetic
IF Op$ = CHR$(42) AND (TSD(0) = 0 OR BSD(0) = 0) THEN
' * (Multiply)
J% = 0
FOR I% = 1 TO 5
RLD(I%) = 0
NEXT I%
'RetStr$ = ""
ELSEIF TSD(0) = 0 AND BSD(0) = 0 THEN
'and (Op$ = CHR$(43) OR Op$ = CHR$(45))
J% = 0
FOR I% = 1 TO 5
RLD(I) = 0
NEXT I%
'RetStr$ = ""
ELSEIF Op$ = CHR$(45) AND TSD(0) = 0 THEN
IF BSD(0) = 1 THEN J% = 1 ELSE J% = 0
RLD(1) = BSD(1)
RLD(2) = BLD(2)
RLD(3) = BLD(3)
RLD(4) = BSD(4)
RLD(5) = BSD(5)
RetStr$ = RIGHT$(InBot$, LEN(InBot$) - 40)
ELSEIF BSD(0) = 0 THEN
'and (Op$ = CHR$(43) OR Op$ = CHR$(45))
IF TSD(0) = 1 THEN J% = 0 ELSE J% = 1
RLD(1) = TSD(1)
RLD(2) = TLD(2)
RLD(3) = TLD(3)
RLD(4) = TSD(4)
RLD(5) = TSD(5)
RetStr$ = RIGHT$(InTop$, LEN(InTop$) - 40)
ELSEIF TSD(0) = 0 THEN
'and (Op$ = CHR$(43)
IF BSD(0) = 1 THEN J% = 0 ELSE J% = 1
RLD(1) = BSD(1)
RLD(2) = BLD(2)
RLD(3) = BLD(3)
RLD(4) = BSD(4)
RLD(5) = BSD(5)
RetStr$ = RIGHT$(InBot$, LEN(InBot$) - 40)
ELSEIF (Op$ = CHR$(43) AND TSD(0) = BSD(0)) OR (Op$ = CHR$(45) AND TSD(0) <> BSD(0)) THEN
' Add Absolute Values
J% = RLD(1) + RLD(4) + RLD(5) + 1
DIM Result(1 TO J%) AS INTEGER
' Left
FOR I% = 1 TO RLD(1)
' Top
IF TSD(2) > 0 THEN
'Result(I%) = 0
TSD(2) = TSD(2) - 1
ELSEIF TSD(2) = 0 THEN
Result(I%) = Check&(65, MID$(InTop$, TSD(-1), 1))
TSD(-1) = TSD(-1) + 1
IF TSD(-1) = TSD(-2) THEN TSD(2) = -1
END IF
' Bottom
IF BSD(2) > 0 THEN
'Result(I%) = Result(I%)
BSD(2) = BSD(2) - 1
ELSEIF BSD(2) = 0 THEN
Result(I%) = Result(I%) + Check&(65, MID$(InBot$, BSD(-1), 1))
BSD(-1) = BSD(-1) + 1
IF BSD(-1) = BSD(-2) THEN BSD(2) = -1
END IF
NEXT I%
TSD(-2) = 40 + TSD(1) + TSD(4)
BSD(-2) = 40 + BSD(1) + BSD(4)
' Right
FOR I% = (RLD(1) + 1) TO J%
' Top
IF TLD(4) = 0 OR TSD(-1) > TSD(-2) THEN
IF TLD(5) = 0 THEN
'Result(I%) = 0
ELSEIF TSD(-1) = LEN(InTop$) THEN
Result(I%) = Check&(65, RIGHT$(InTop$, 1))
TSD(-1) = TSD(-2) + 1
ELSE
Result(I%) = Check&(65, MID$(InTop$, TSD(-1), 1))
TSD(-1) = TSD(-1) + 1
END IF
ELSEIF TLD(3) > 0 THEN
'Result(I%) = 0
TLD(3) = TLD(3) - 1
ELSE
Result(I%) = Check&(65, MID$(InTop$, TSD(-1), 1))
TSD(-1) = TSD(-1) + 1
END IF
' Bottom
IF BLD(4) = 0 OR BSD(-1) > BSD(-2) THEN
IF BLD(5) = 0 THEN
'Result(I%) = Result(I%)
ELSEIF BSD(-1) = LEN(InBot$) THEN
Result(I%) = Result(I%) + Check&(65, RIGHT$(InBot$, 1))
BSD(-1) = BSD(-2) + 1
ELSE
Result(I%) = Result(I%) + Check&(65, MID$(InBot$, BSD(-1), 1))
BSD(-1) = BSD(-1) + 1
END IF
ELSEIF BLD(3) > 0 THEN
'Result(I%) = Result(I%)
BLD(3) = BLD(3) - 1
ELSE
Result(I%) = Result(I%) + Check&(65, MID$(InBot$, BSD(-1), 1))
BSD(-1) = BSD(-1) + 1
END IF
NEXT I%
' Carry
FOR I% = J% TO 2 STEP -1
IF Result(I%) > 63 THEN
Result(I% - 1) = Result(I% - 1) + 1
Result(I%) = Result(I%) - 64
END IF
NEXT I%
' Generate Return String
FOR I% = RLD(1) TO 1 STEP -1
IF Result(I%) = 0 THEN
RLD(1) = RLD(1) - 1
RLD(2) = RLD(2) + 1
ELSE
EXIT FOR
END IF
NEXT I%
IF RLD(1) = 0 THEN RLD(2) = 0
IF Result(1) > 63 THEN
RetStr$ = Build$(2, Result(1), 0)
ELSEIF RLD(1) > 0 THEN
RetStr$ = Build$(1, Result(1), 0)
END IF
FOR I% = 2 TO RLD(1)
RetStr$ = RetStr$ + Build$(1, Result(I%), 0)
NEXT I%
FOR I% = (RLD(1) + 1) TO (J% - 1)
IF Result(I%) = 0 AND LEN(RetStr$) = RLD(1) THEN
RLD(3) = RLD(3) + 1
RLD(4) = RLD(4) - 1
ELSE
RetStr$ = RetStr$ + Build$(1, Result(I%), 0)
END IF
NEXT I%
IF Result(1) > 63 THEN RLD(1) = RLD(1) + 1
ERASE Result
' Return Top Sign
IF TSD(0) = 1 THEN J% = 0 ELSE J% = 1
ELSEIF (Op$ = CHR$(43) AND TSD(0) <> BSD(0)) OR (Op$ = CHR$(45) AND TSD(0) = BSD(0)) THEN
' Subtract Absolute Values
ELSEIF Op$ = CHR$(42) THEN
' * (Multiply)
DIM R(0) AS LONG: R(0) = RLD(1) + RLD(4) + RLD(5)
DIM InData(1 TO R(0)) AS INTEGER
DIM Result(0 TO R(0)) AS INTEGER
' Push String Data into Array
' Multiply from Array to Array
ERASE InData
' Generate Return String
ERASE Result, R
' Return Final Sign
IF (TSD(0) * BSD(0)) = 1 THEN J% = 0 ELSE J% = 1
END IF
ERASE TSD, TLD, BSD, BLD
' Generate Header (from right to left)
RetStr$ = Build$(5, 0, RLD(5)) + CHR$(95) + RetStr$
RetStr$ = Build$(5, 0, RLD(4)) + CHR$(95) + RetStr$
RetStr$ = Build$(5, 0, RLD(3)) + CHR$(95) + RetStr$
RetStr$ = Build$(5, 0, RLD(2)) + CHR$(95) + RetStr$
RetStr$ = Build$(5, 0, RLD(1)) + CHR$(95) + RetStr$
RetStr$ = Build$(2, J%, 0) + CHR$(95) + RetStr$
RetStr$ = CHR$(86) + CHR$(76) + CHR$(70) + CHR$(80) + CHR$(95) + CHR$(101) + CHR$(95) + RetStr$
ERASE RLD
' skip cleanups for now
VLFP$ = RetStr$
END FUNCTION
There really is no main routine right now...
Dell Inspiron laptop:
Intel Core i3-2370M @ 2.4GHz (quad core); 4GB RAM;
200GB HDD (dual-boot) Win 7 64-bit and U E 5.0 64-bit
Tower:
Intel Core i7-4770K @ 3.5 GHz (8 core); 8GB RAM;
118GB SSD, 111GB HDD; 232GB HDD; 465GB USB HDD
Soon to be dual-boot Win 7 64-bit and U E 5.0 64-bit