Author Topic: NumType FUNCTION by Steve McNeill  (Read 299 times)

Offline Qwerkey

  • Moderator
  • Forum Resident
  • Posts: 722
NumType FUNCTION by Steve McNeill
« on: June 07, 2020, 11:10:42 AM »
NumType (The Overengineered 'Is it a number?') FUNCTION.

Author: @SMcNeill
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=949.msg101479#msg101479
Version: January 06, 2019
Tags: [Function]

Description:
I bring you the glorious FUNCTION NumType!

Pass it a string and watch as it not only decides IF it's a number for you, but what TYPE of number you gave it!  It detects bits, bytes, integers, singles, floats, offsets...  Signed and unsigned!

It works with &H, &B, &O values.

You can set your string a suffix like 123&& and see if it's a valid _INTEGER64...

It generates error messages, so you can see WHY it's not a number!


Code: QB64: [Select]
  1. CONST limit = 16
  2.  
  3. DIM test(limit) AS STRING
  4.  
  5. DATA "123a.3","-123.456","--234","1.23E15","123","dogfood","678.965","54678","-987134","1E15"
  6. DATA "&HFF","&B1001111","&O17","&HFF&&","&B12000222","1.E-12"
  7.  
  8. FOR i = 1 TO limit
  9.     READ test(i)
  10.  
  11.  
  12. FOR i = 1 TO limit
  13.     PRINT "TEST #"; i; ": "; test(i) + " "
  14.     result = NumType(test(i))
  15.     IF result = 0 THEN PRINT "INVALID: "; NumErr$
  16.     IF result AND 1 THEN PRINT "Valid Unsigned Bit.  ";
  17.     IF result AND 2 THEN PRINT "Valid Unsigned Byte.  ";
  18.     IF result AND 4 THEN PRINT "Valid Unsigned Integer.  ";
  19.     IF result AND 8 THEN PRINT "Valid Unsigned Long.  ";
  20.     IF result AND 16 THEN PRINT "Valid Unsigned Integer64.  ";
  21.     IF result AND 32 THEN PRINT "Valid Unsigned Bit.  ";
  22.     IF result AND 64 THEN PRINT "Valid Signed Byte.  ";
  23.     IF result AND 128 THEN PRINT "Valid Signed Integer.  ";
  24.     IF result AND 256 THEN PRINT "Valid Signed Long.  ";
  25.     IF result AND 512 THEN PRINT "Valid Signed Integer64.  ";
  26.     IF result AND 1024 THEN PRINT "Valid Single.  ";
  27.     IF result AND 2048 THEN PRINT "Valid Double.  ";
  28.     IF result AND 4096 THEN PRINT "Valid Float.  ";
  29.     IF result AND 8192 THEN PRINT "Valid Unsigned Offset.  ";
  30.     IF result AND 16384 THEN PRINT "Valid Signed Offset.  ";
  31.     PRINT
  32.     PRINT
  33.     SLEEP
  34.  
  35. FUNCTION NumType~% (text$)
  36.     SHARED NumErr$
  37.     temp$ = UCASE$(_TRIM$(text$))
  38.     NumErr$ = "": NumType = 0
  39.  
  40.     'First look for manually assigned types
  41.     r1$ = RIGHT$(temp$, 1): r = 1
  42.     r2$ = LEFT$(RIGHT$(temp$, 2), 1)
  43.     SELECT CASE r1$
  44.         CASE "`"
  45.             TestFor = 1 'bit
  46.         CASE "%"
  47.             IF r2$ = "%" THEN
  48.                 r = 2
  49.                 TestFor = 2 'byte
  50.             ELSE
  51.                 TestFor = 3 'integer
  52.             END IF
  53.         CASE "&" 'long, int64, offset
  54.             IF r2$ = "&" THEN
  55.                 r = 2
  56.                 TestFor = 5 'int64
  57.             ELSEIF r2$ = "%" THEN
  58.                 r = 2
  59.                 TestFor = 9 'offset
  60.             ELSE
  61.                 TestFor = 4 'long
  62.             END IF
  63.         CASE "!" 'single
  64.             TestFor = 6
  65.         CASE "#" 'double, float
  66.             IF r2$ = "#" THEN
  67.                 r = 2
  68.                 TestFor = 8 'float
  69.             ELSE
  70.                 TestFor = 7 'double
  71.             END IF
  72.         CASE ELSE 'there's no set type
  73.             TestFor = 0
  74.             r = 0
  75.     END SELECT
  76.  
  77.  
  78.     temp$ = LEFT$(temp$, LEN(temp$) - r) 'strip off the type symbol
  79.     SELECT CASE TestFor
  80.         CASE 1 TO 5, 9
  81.             r$ = RIGHT$(temp$, 1)
  82.             IF r$ = "~" THEN Unsigned = -1: temp$ = LEFT$(temp$, LEN(temp$) - 1)
  83.     END SELECT
  84.  
  85.     'check for valid prefixes
  86.  
  87.     l$ = LEFT$(temp$, 2)
  88.     SELECT CASE l$
  89.         CASE "&H"
  90.             temp$ = MID$(temp$, 3)
  91.             FOR i = 1 TO LEN(temp$)
  92.                 t$ = MID$(temp$, i, 1)
  93.                 SELECT CASE t$
  94.                     CASE "0" TO "9", "A" TO "F" 'valid
  95.                     CASE ELSE
  96.                         NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered.  "
  97.                 END SELECT
  98.             NEXT
  99.             IF NumErr$ <> "" THEN EXIT FUNCTION
  100.             GOTO evaluateintegers
  101.         CASE "&B"
  102.             temp$ = MID$(temp$, 3)
  103.             FOR i = 1 TO LEN(temp$)
  104.                 t$ = MID$(temp$, i, 1)
  105.                 SELECT CASE t$
  106.                     CASE "0", "1" 'only valid bit characters
  107.                     CASE ELSE
  108.                         NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered.  "
  109.                 END SELECT
  110.             NEXT
  111.             IF NumErr$ <> "" THEN EXIT FUNCTION
  112.             GOTO evaluateintegers
  113.         CASE "&O"
  114.             temp$ = MID$(temp$, 3)
  115.             FOR i = 1 TO LEN(temp$)
  116.                 t$ = MID$(temp$, i, 1)
  117.                 SELECT CASE t$
  118.                     CASE "0" TO "7" 'only valid oct characters
  119.                     CASE ELSE
  120.                         NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered.  "
  121.                 END SELECT
  122.             NEXT
  123.             IF NumErr$ <> "" THEN EXIT FUNCTION
  124.             GOTO evaluateintegers
  125.     END SELECT
  126.  
  127.  
  128.     'Test for easy integers
  129.     'First check for positive/negative values; flag for invalid cases of multiple negation.
  130.     IF MID$(temp$, 1, 1) = "-" THEN
  131.         negative = -1: temp$ = MID$(temp$, 2) 'strip off the initial negative
  132.     ELSEIF MID$(temp$, 1, 1) = "+" THEN
  133.         temp$ = MID$(temp$, 2) 'strip off the initial positive
  134.     END IF
  135.  
  136.     FOR i = 1 TO LEN(temp$)
  137.         IF MID$(temp$, i, 1) = "-" THEN minus = minus + 1
  138.         IF MID$(temp$, i, 1) = "+" THEN plus = plus + 1
  139.         IF MID$(temp$, i, 1) = "." THEN period = period + 1 'Go ahead and check for multiple periods while we're at it.
  140.         IF MID$(temp$, i, 1) = "E" OR MID$(temp$, i, 1) = "D" THEN
  141.             Exponent = Exponent + 1
  142.             IF MID$(temp$, i + 1, 1) = "-" OR MID$(temp$, i + 1, 1) = "+1" THEN ExponentSign = -1
  143.         END IF
  144.     NEXT
  145.  
  146.     IF period = 0 AND Exponent = 0 THEN 'we should only have integers to process
  147.         FOR i = 1 TO LEN(temp$)
  148.             t$ = MID$(temp$, i, 1)
  149.             IF t$ < "0" OR t$ > "9" THEN NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered.  ": EXIT FUNCTION
  150.         NEXT
  151.         GOTO evaluateintegers
  152.     END IF
  153.  
  154.     'At this point forward, we should only have REAL numbers to process
  155.  
  156.     IF Exponent > 1 THEN NumErr$ = NumErr$ + "Multiple E/D exponent characters in string.  ": EXIT FUNCTION
  157.  
  158.     IF ExponentSign = 0 THEN
  159.         IF minus THEN NumErr$ = NumErr$ + "Multiple negative signs (-) encountered.  ": EXIT FUNCTION
  160.         IF plus THEN NumErr$ = NumErr$ + "Multiple negative signs (-) encountered.  ": EXIT FUNCTION
  161.     ELSE
  162.         IF minus > 1 THEN NumErr$ = NumErr$ + "Multiple negative signs (-) encountered.  ": EXIT FUNCTION
  163.         IF plus > 1 THEN NumErr$ = NumErr$ + "Multiple negative signs (-) encountered.  ": EXIT FUNCTION
  164.     END IF
  165.  
  166.     IF period > 1 THEN NumErr$ = NumErr$ + "Multiple decimal points (.) encountered.  ": EXIT FUNCTION
  167.  
  168.     IF Exponent AND period THEN
  169.         e = INSTR(temp$, "E")
  170.         IF e = 0 THEN e = INSTR(temp$, "D")
  171.         p = INSTR(temp$, ".")
  172.         IF p > e THEN NumErr$ = NumErr$ + "Decimal points (.) AFTER E/D exponent encountered.  ": EXIT FUNCTION
  173.     END IF
  174.  
  175.  
  176.     FOR i = 1 TO LEN(temp$)
  177.         t$ = MID$(temp$, i, 1)
  178.         SELECT CASE t$
  179.             CASE "0" TO "9", "-", "+", ".", "D", "E" 'we should have validated all these characters earlier
  180.             CASE ELSE 'so anything else is invalid
  181.                 NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered.  ": EXIT FUNCTION
  182.         END SELECT
  183.     NEXT
  184.  
  185.     IF NumErr$ <> "" THEN EXIT FUNCTION
  186.  
  187.  
  188.     'We should've passed all the error checking by this point -- I think...
  189.  
  190.  
  191.     evaluateintegers:
  192.     t## = VAL(text$)
  193.  
  194.     'first compare for all types
  195.     IF INT(t##) = t## THEN
  196.         IF t## = -1 OR t## = 0 THEN NumType = NumType OR 32 'signed bit
  197.         IF t## >= -128 AND t## <= 127 THEN NumType = NumType OR 64 'signed byte
  198.         IF t## >= -32768 AND t## <= 32767 THEN NumType = NumType OR 128 'signed integer
  199.         IF t## >= -2147483648 AND t## <= 2147483647 THEN NumType = NumType OR 256 'signed long
  200.         IF t## >= -9223372036854775808 AND t## <= 9223372036854775807 THEN
  201.             NumType = NumType OR 512 'signed integer64
  202.             NumType = NumType OR 16384 'signed offset
  203.         END IF
  204.         IF t## = 1 OR t## = 0 THEN NumType = NumType OR 1 'unsigned bit
  205.         IF t## >= 0 AND t## <= 255 THEN NumType = NumType OR 2 'unsigned byte
  206.         IF t## >= 0 AND t## <= 65535 THEN NumType = NumType OR 4 'unsigned integer
  207.         IF t## >= 0 AND t## <= 4294967295 THEN NumType = NumType OR 8 'unsigned long
  208.         IF t## >= 0 AND t## <= 18446744073709551615 THEN
  209.             NumType = NumType OR 16 'unsigned integer64
  210.             NumType = NumType OR 8192 'unsigned offset
  211.         END IF
  212.     END IF
  213.  
  214.     IF t## >= -2.802597D45 AND t## <= 3.402823D+38 THEN
  215.         NumType = NumType OR 1024 'single
  216.     END IF
  217.     IF t## >= -4.490656458412465E324 AND t## <= 1.797693134862310E+308 THEN NumType = NumType OR 2048 'double
  218.     IF t## >= -1.18E4932 AND t## <= 1.18E+4932 THEN NumType = NumType OR 4096 'float
  219.  
  220.     IF r THEN 'we have specific suffix; only decide if the value is valid for it
  221.         NumType = 0
  222.         IF NOT Unsigned THEN 'unsigned
  223.             SELECT CASE TestFor
  224.                 CASE 1
  225.                     IF t## = -1 OR t## = 0 THEN NumType = 32 'signed bit
  226.                 CASE 2
  227.                     IF t## >= -128 AND t## <= 127 THEN NumType = 64 'signed byte
  228.                 CASE 3
  229.                     IF t## >= -32768 AND t## <= 32767 THEN NumType = 128 'signed integer
  230.                 CASE 4
  231.                     IF t## >= -2147483648 AND t## <= 2147483647 THEN NumType = 256 'signed long
  232.                 CASE 5, 9
  233.                     IF t## >= -9223372036854775808 AND t## <= 9223372036854775807 THEN
  234.                         IF TestFor = 5 THEN
  235.                             NumType = 512 'signed integer64
  236.                         ELSE
  237.                             NumType = 16384 'signed offset
  238.                         END IF
  239.                     END IF
  240.                 CASE 6
  241.                     IF t## >= -2.802597E-45 AND t## <= 3.402823E+38 THEN NumType = 1024 'single
  242.                 CASE 7
  243.                     IF t## >= -4.490656458412465E-324 AND t## <= 1.797693134862310E+308 THEN NumType = 2048 'double
  244.                 CASE 9
  245.                     IF t## >= -1.18E-4932 AND t## <= 1.18E+4932 THEN NumType = 4096 'float
  246.             END SELECT
  247.         ELSE
  248.             SELECT CASE TestFor
  249.                 CASE 1
  250.                     IF t## = 0 OR t## = 1 THEN NumType = 1 'unsigned bit
  251.                 CASE 2
  252.                     IF t## >= 0 AND t## <= 255 THEN NumType = 2 'unsigned byte
  253.                 CASE 3
  254.                     IF t## >= 0 AND t## <= 65535 THEN NumType = 4 'unsigned integer
  255.                 CASE 4
  256.                     IF t## >= 0 AND t## <= 4294967295 THEN NumType = 8 'unsigned long
  257.                 CASE 5, 9
  258.                     IF t## >= 0 AND t## <= 18446744073709551615 THEN
  259.                         IF TestFor = 5 THEN
  260.                             NumType = 16 'unsigned integer64
  261.                         ELSE
  262.                             NumType = 8192 'unsigned offset
  263.                         END IF
  264.                     END IF
  265.             END SELECT
  266.         END IF
  267.         IF NumType = 0 THEN NumErr$ = "Invalid Suffix.  "
  268.     END IF
  269.  
  270.