NumType FUNCTION by Steve McNeill

[Qwerkey]

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