Read numbers from a STRING

[TJF]

This example is about a function similar to the FB VAL function. It reads a number in a STRING variable and returns its value as a DOUBLE variable.

Of course, there're additional features:

• All characters in front of the number are skipped.
• The end of the number gets marked (a pointer to the character behind the number, or NULL at the STRING end)
• It handles fractional digits in decimal numbers as well as in binary, octal and hexadecimal numbers (separator = ".").
• It reads numbers in FreeBasic style as well as in C style (set second parameter C <> 0 for C style).
• By calling it multiple times all numbers can get red from a STRING (see MACRO 'TEST').

Here's the code including some tests:

Code: Select all

' This is file get_value.bas
' A function to read numbers from a STRING
'
' Licence: GPLv3
' (C) 2012 Thomas[ dot ]Freiherr[ at ]gmx[ dot ]net

#DEFINE C_ALL ".0123456789DEdeABCFabcf"
#DEFINE D_ALL {0, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 13, 14, 13, 14, 10, 11, 12, 15, 10, 11, 12, 15}
#DEFINE C_DECI 10

FUNCTION get_value(BYREF T AS UBYTE PTR, BYVAL C AS INTEGER = 0) AS DOUBLE
  STATIC AS STRING*23 s = C_ALL
  STATIC AS UBYTE z(...) = D_ALL
  STATIC AS INTEGER a, e, b, x, y, d, f, v
  STATIC AS UBYTE PTR n
  STATIC AS DOUBLE r

  r = 0.0 : v = 1
  WHILE v '                                    search for a valid number
    a = 0 : x = 0 : y = 0 : d = 1 : f = 0
    DO
      IF 0 = *T THEN T = 0 : RETURN 0.0 '  stop at the end of the STRING
      IF *T = ASC("-") THEN n = T : T += 1 ELSE n = 0
      IF C THEN '                                    find C style values
        SELECT CASE AS CONST *T
        CASE ASC(".") : T += 1 : b = 10 : e = 14 : d = -1 : a = 1 : EXIT DO
        CASE ASC("0") : T += 1
          IF *T = ASC(".") THEN v = 0 : T += 1 : b = 10 : e = 14 : d = -1 : a = 1 : EXIT DO
          IF *T = ASC("x") THEN T += 1 : b = 16 : e = 22 : EXIT DO
          v = 0 : b = 8 : e = 8 : EXIT DO
        CASE ASC("1") TO ASC("9") : b = 10 : e = 14 : EXIT DO
        END SELECT
      ELSE '                                        find FB style values
        SELECT CASE AS CONST *T
        CASE ASC(".")    : T += 1 : b = 10 : e = 14 : d = -1 : a = 1 : EXIT DO
        CASE ASC("0") TO ASC("9") : b = 10 : e = 14 : EXIT DO
        CASE ASC("&") : T += 1
          SELECT CASE AS CONST *T
          CASE ASC("h"), ASC("H") : T += 1 : b = 16 : e = 22 : EXIT DO
          CASE ASC("o"), ASC("O") : T += 1 : b = 8  : e = 8  : EXIT DO
          CASE ASC("b"), ASC("B") : T += 1 : b = 2  : e = 2  : EXIT DO
          END SELECT
        END SELECT
      END IF
      T += 1
    LOOP

    DO '                                              search valid chars
      VAR i = a
      WHILE *T <> s[i] '                                     check digit
        i += 1 : IF i > e THEN EXIT DO '              not valid -> break
      WEND

      IF i > C_DECI ANDALSO e = 14 THEN '               decimal exponent
        IF 0.0 = r THEN T += 1 : EXIT DO
        d = 0 : T += 1 : e = C_DECI
        IF *T = ASC("+") THEN T += 1 ELSE _
        IF *T = ASC("-") THEN T += 1 : y = 1
        CONTINUE DO
      END IF

      IF i THEN
        f += d : v = 0
        IF d > 0 THEN '                                     normal digit
          r *= b : r += z(i)
        ELSEIF d < 0 THEN '                             fractional digit
          r += z(i) * b ^ f
        ELSE '                                                  exponent
          x *= b : x += z(i)
        END IF
      ELSE '                                 decimal seperator just once
        a = 1 : d = -1 : f = 0
      END IF
      T += 1
    LOOP UNTIL 0 = *T '                   break at the end of the STRING
  WEND : IF x THEN RETURN IIF(n, -r, r) * 10 ^ IIF(y, -x, x)
  RETURN IIF(n, -r, r)
END FUNCTION


' ************ macros for testing *************

#MACRO TEST(_S_,_F_) '                         search all numbers in _S_
SCOPE
  ?_S_;!"\nPosition","Value"
  VAR n = _S_ & CHR(0), t = SADD(n), a = t - 1, p = t, z = get_value(t, _F_)
  WHILE t
    ?RIGHT("    " & t - a, 4);": ";
    ?RIGHT("             " & z, 13);
    ?" from substring >";LEFT(*p, t - p);"<"
    p = t
    z = get_value(t, _F_)
  WEND
END SCOPE
#ENDMACRO

#DEFINE TEST_C(_S_) TEST(_S_,1) '                 search C style numbers
#DEFINE TEST_FB(_S_) TEST(_S_,0) '               search FB style numbers

' ************ main *************

?"Read FB stuff:"
TEST_FB("In1text broken exponent.e+1, a date (two decimal values) 12.3.29 negative: -127 exponent: +15.1D-93 hexa: &hff bin:-&B11.11 octal: +++&o10+-&h&b&o4a")
?:?"Read C stuff:"
TEST_C("This is a 0. (NULL) and more values: 01234, 0xff.12, 0.41e-13 decimal: 0.77 octal: 00.77")

And the output

Read FB stuff:
In1text broken exponent.e+1, a date (two decimal values) 12.3.29 negative: -127 exponent: +15.1D-93 hexa: &hff bin:-&B11.11 octal: +++&o10+-&h&b&o4a
Position Value
4: 1 from substring >In1<
28: 1 from substring >text broken exponent.e+1<
62: 12.3 from substring >, a date (two decimal values) 12.3<
65: 0.29 from substring >.29<
80: -127 from substring > negative: -127<
100: 1.51e-92 from substring > exponent: +15.1D-93<
111: 255 from substring > hexa: &hff<
124: -3.75 from substring > bin:-&B11.11<
139: 8 from substring > octal: +++&o10<
148: 4 from substring >+-&h&b&o4<

Read C stuff:
This is a 0. (NULL) and more values: 01234, 0xff.12, 0.41e-13 decimal: 0.77 octal: 00.77
Position Value
13: 0 from substring >This is a 0.<
43: 668 from substring > (NULL) and more values: 01234<
52: 255.0703125 from substring >, 0xff.12<
62: 4.1e-14 from substring >, 0.41e-13<
76: 0.77 from substring > decimal: 0.77<
89: 0.984375 from substring > octal: 00.77<

Check for updates:

• Zahl(en) aus STRING-Variable lesen

[Roland Chastain]

Hello, TJF !

I find your code is very interesting. I wanted to study it but it's a little too strong for me : there are too many things I don't understand. If you allow me to make a request, I would like you to write a simpler version, without C stuff, and with a simpler output example, because I don't understand the current example.

Roland

[TJF]

... and with a simpler output example, because I don't understand the current example.

Thanks for your interest in the code. To get a more simple example just replace the STRINGs in the last lines

Code: Select all

' ...
?"Read FB stuff:"
TEST_FB("Decimal: 1, 2, 3, 4 ~ Binary: &b11.1, &b101.001 ~ Octal: &o765.4321 ~ Hexadecimal: &hf.ba ")

?:?"Read C stuff:"
TEST_C("Octal: 01234 ~ Hex 0xff.12 ~ decimal 0.41e-13, 0.77 octal: 00.77 ~ no binary in C syntax")

I wanted to study it but it's a little too strong for me : there are too many things I don't understand. If you allow me to make a request, I would like you to write a simpler version, without C stuff, ...

This example is optimized for high execution speed and low number of code lines. In the TEST macro it uses the pointer 't' to scan the characters. When the end of the STRING is reached, the pointer is set to zero. Of course it's not good for learning the basics (but it's FB code without any C stuff).

Anyway, don't hazitate to post requests here. I'll do my best to answer.

[Roland Chastain]

To get a more simple example just replace the STRINGs in the last lines

Code: Select all

' ...
?"Read FB stuff:"
TEST_FB("Decimal: 1, 2, 3, 4 ~ Binary: &b11.1, &b101.001 ~ Octal: &o765.4321 ~ Hexadecimal: &hf.ba ")

?:?"Read C stuff:"
TEST_C("Octal: 01234 ~ Hex 0xff.12 ~ decimal 0.41e-13, 0.77 octal: 00.77 ~ no binary in C syntax")

Thank you. I should have thought to it. :-)

This example is optimized for high execution speed and low number of code lines. In the TEST macro it uses the pointer 't' to scan the characters. When the end of the STRING is reached, the pointer is set to zero. Of course it's not good for learning the basics (but it's FB code without any C stuff).

Thanks for the explanation.

Roland