Ultimate Edition Forum

Posted: **Fri Jan 03, 2014 12:37 am**

Code: Select all: ' --------------------------------------------------------------------------- ' CalcuL8R - A Base-64 string calculator. ' Revision: 00.00.00.0I (2014-01-02) ' Author: S3KshuN8 ' --------------------------------------------------------------------------- ' ' Base-64 Character Set: ' ' { 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_| } ' = ' ( 0000000000111111111122222222223333333333444444444455555555556666 ) tens ' ( 0123456789012345678901234567890123456789012345678901234567890123 ) ones ' ' ( 0=0; A=10; K=20; U=30; W=32; a=36; e=40; o=50; y=60; z=61; _=62; |=63 ) ' ' --------------------------------------------------------------------------- ' _________________________________________________________________________________________________________________________________________ ' ' Textish uses the "_" character as a space and "|" as a special character indicator. One | in regular text indicates one of 63 alternate ' Chars and a more complex structure is supported with two or more pipes. No standard protocol there yet; just use your best judgement... ' _________________________________________________________________________________________________________________________________________ ' ' ...Textish (Alternate Character Set)... ' ' |0 = . ' |1 = ! ' |2 = ? ' |3 = , ' |4 = ; ' |5 = : ' |6 = ( ' |7 = ) ' |8 = [ ' |9 = ] ' |A = { ' |B = } ' |C = < ' |D = > ' |E = = ' |F = + ' |G = - ' |H = * ' |I = / ' |J = "^" (removed toggle superscript, use this instead) ' |K = % ' |L = # ' |M = $ ' |N = Euro symbol ' |O = Infinity symbol ' |P = Pi symbol ' |Q = SQUARE_ROOT_ symbol ' |R = ROOT symbol (can be square, cube, etc.; ie. "|R3" = cube root) ' |S = " " (SPACE character, used internally to swap with underscore) ' |T = TAB (double indent) ' |U = " ' |V = ' ' |W = ` ' |X = ~ ' |Y = \ ' |Z = & ' |a = @ ' |b = toggle bold ' |c = center text ' |d = natural antilog symbol ' |e = natural logarithm symbol ' |f = move to next field ' |g = go to previous field ' |h = toggle hidden ' |i = toggle italic ' |j = justify text left and right ' |k = "ñ" (denotes an explicitly unsigned number) ' |l = left-align text ' |m = toggle markover (AKA strikethrough) ' |n = new line ' |o = new file (TOF Top of File marker, should see "|o|q" at least...) ' |p = "|" (display a pipe character) ' |q = ASCII {[EOF]} (EOF End of File marker) ' |r = right-align text ' |s = toggle subscript ' |t = tab (indent) ' |u = toggle underlined ' |v = toggle version (Characters or ...['newer']...) ' |w = move to top left corner (TOF Top of File, used to prefix a file) ' |x = move to top right corner (end of current paragraph) ' |y = move to bottom left corner (top of next paragraph) ' |z = move to bottom right corner (EOF End of File) ' |_ = "_" (display an underscore instead of space) ' || RESERVED for forward compatibility ' ' _________________________________________________________________________________________________________________________________________ '

The rest of the code is forthcoming, but this should give you an idea of the direction I'm headed...

Posted: **Fri Jan 03, 2014 1:05 am**

I tried to install the SDL version of QB64 since it is more complete, but all I got was this:

s3kshun8@LinuxLaptop:~$ cd qb64sdl
s3kshun8@LinuxLaptop:~/qb64sdl$ ./setup.sh
QB64 Setup

Make sure the following packages are installed before continuing:
(SDL packages should be version 1.2 or 1.2.???)
libsdl-dev
libsdl-image-dev
libsdl-mixer-dev
libsdl-net-dev
libsdl-ttf-dev (may report as version 2.0)
timidity (only required if playing MIDI files)

Press any key to continue...

Checking for existance of 'g++'
****************************************
g++: fatal error: no input files
compilation terminated.
****************************************
The above line should read 'g++: no input files'. If it doesn't you need to install the g++ compiler before continuing.

Press any key to continue...

Creating 'qb64'...
(Notes: Warnings can be ignored. This process could take a minute or so.)
./setup.sh: 1: ./setup.sh: sdl-config: not found
In file included from libqbx.cpp:1:0:
common.cpp:30:17: fatal error: SDL.h: No such file or directory
compilation terminated.
./setup.sh: 1: ./setup.sh: sdl-config: not found
g++: error: libqbx_lnx.o: No such file or directory

Setup complete!

Launching 'qb64'...
./setup.sh: 43: ./setup.sh: ./qb64: not found

Note: 'qb64' is located in same folder as this setup program.
Press any key to exit...
s3kshun8@LinuxLaptop:~/qb64sdl$ ls
audio.txt internal LICENSE.TXT samples setup.sh
cyberbit.ttf LGPL-2.1.TXT readme.txt samples.txt source
s3kshun8@LinuxLaptop:~/qb64sdl$

I was hoping the SDL version would be more stable and possibly have a faster IDE...

Posted: **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...

Posted: **Wed Jan 15, 2014 7:39 pm**

How do I go about getting SDL 1.2 installed so the more developed version will run? I'm guessing it starts with "sudo apt-get install" or similar but my linux skills are virtually nonexistent (if you couldn't already tell).

Posted: **Fri Jul 11, 2014 7:56 pm**

The horrible lag in QB64-GL for Linux has been fixed in the most recent Dirty Build. (It was the result of some C code causing delays to last much longer than they should have.) Anyone who tried it out and didn't like it before because of the lag should give it another try.

Ultimate Edition Forum

QB64

Re: QB64

Re: QB64

Re: QB64

Re: QB64

Re: QB64