Variable Length String Array-like Strings - Tools

[bplus]

Something I had to figure out again to add to Interpreter along lines of Luke's Get and Set for Longs and Doubles, fixed lengths is easy! ;-))

Code: QB64: [Select]

1. OPTION _EXPLICIT '  b+ 2021-02-19
2. _TITLE "Tools for Variable Length Array-Like Strings"
3. '2021-02-19 all tests work with comma space delimiter, try comma alone next, OK! how about abc OK
4. '2021-02-20 renaming done all tests look OK, go over tomorrow before add to SB1.
5.  
6. ' Todo change names of these functions
7. REDIM test$(1 TO 20), deli$, i&, ins$, result$, insertplace AS LONG, testN AS LONG, getUser
8.  
9. deli$ = ", ":
10. test$(1) = "1, 2, 3, 4"
11. test$(2) = "1, 2, 3"
12. test$(3) = "1, 2"
13. test$(4) = "1"
14. test$(5) = ""
15.  
16. 'deli$ = ",":
17. 'test$(1) = "1,2,3,4"
18. 'test$(2) = "1,2,3"
19. 'test$(3) = "1,2"
20. 'test$(4) = "1"
21. 'test$(5) = ""
22.  
23. 'deli$ = "abc":
24. 'test$(1) = "1abc2abc3abc4"
25. 'test$(2) = "1abc2abc3"
26. 'test$(3) = "1abc2"
27. 'test$(4) = "1"
28. 'test$(5) = ""
29.  
30.  
31. ins$ = "insert"
32.  
33. DO
34.     INPUT "Test GetVS$ function, give us an index to look up, 0 quits "; getUser
35.     PRINT "*"; GetVS$(deli$, getUser, test$(1)); "*"
36.     PRINT
37. LOOP UNTIL getUser = 0
38. '----------------------------------------- Test Delimiter/Word counter
39. PRINT "test StrCount&, counting *" + deli$ + "*"
40. FOR i& = 1 TO 5
41.     PRINT test$(i&), "# of "; deli$; StrCount&(deli$, test$(i&))
42. NEXT
43. ' ---------------------------------------- Test Delimiter/Word locator
44. PRINT: PRINT "test StrPlace&"
45. PRINT "testing: "; test$(1)
46. FOR i& = 1 TO 5
47.     PRINT "Find: " + TS$(i&) + "th delimiter is at "; StrPlace&(deli$, i&, test$(1))
48. NEXT
49. ' ---------------------------------------- Test Insert between Multi Char Delimiters
50. PRINT: PRINT: INPUT "Press enter for some Insert tests... enter "; insertplace
51. CLS
52. FOR testN = 2 TO 5
53.     PRINT "Insert from right to left in this string: "; test$(testN)
54.     FOR insertplace = 6 TO 1 STEP -1
55.         PRINT: PRINT "Test Insert, test string is *" + test$(testN) + "* insert at place #" + TS$(insertplace)
56.         result$ = AStringInsert$(deli$, ins$, insertplace, test$(testN))
57.         PRINT result$
58.     NEXT
59.     PRINT: INPUT "Press enter to continue... "; insertplace 'reuse variable instead of dim another
60.     CLS
61. NEXT
62. ' ------------------------------------------ Test Replace String between Multi-Char Delimiters
63. PRINT: PRINT: INPUT "Press enter for some Replace tests... enter "; insertplace
64. CLS
65. FOR testN = 2 TO 5
66.     PRINT "Replace from right to left in this string: " + test$(testN)
67.     FOR insertplace = 6 TO 1 STEP -1
68.         PRINT: PRINT "Test Replace, test string is *" + test$(testN) + "* Replace item #" + TS$(insertplace)
69.         result$ = SetVS$(deli$, ins$, insertplace, test$(testN))
70.         PRINT result$
71.     NEXT
72.     PRINT: INPUT "Press enter to continue... "; insertplace 'reuse variable instead of dim another
73.     CLS
74. NEXT
75. PRINT "end of tests, goodbye! "
76.  
77.  
78.  
79.  
80. FUNCTION AStringInsert$ (Delimiter$, Insert$, NthPlace&, AStringCopy$)
81.     'use: Function StrCount& (Char$, AString$)
82.     'use: Function StrPlace& (Char$, Nth&, Astring$)
83.     'use: FUNCTION StrCopies$ (NumberOfCopies&, S$)
84.  
85.     REDIM Astring$, wCnt&, nthPlaceAt&, head$, tail$
86.     Astring$ = AStringCopy$ 'AstringCopy$ gets changed so return result through function name$
87.     wCnt& = StrCount&(Delimiter$, Astring$) + 1
88.     'make sure we have enough delimiters
89.     IF wCnt& <= NthPlace& THEN Astring$ = Astring$ + StrCopies$(NthPlace& - wCnt&, Delimiter$) ' string$ is the problem!!!!!
90.     IF NthPlace& <= 1 THEN 'If something there then it comes before but if nothing probably just starting out.
91.         IF Astring$ <> "" THEN Astring$ = Insert$ + Delimiter$ + Astring$ ELSE Astring$ = Insert$
92.     ELSEIF NthPlace& > wCnt& THEN ' AString$ will be modified such that only insert has to be tacked to end after delimiter
93.         Astring$ = Astring$ + Insert$
94.     ELSEIF NthPlace& <= wCnt& THEN
95.         nthPlaceAt& = StrPlace&(Delimiter$, NthPlace& - 1, Astring$)
96.         head$ = MID$(Astring$, 1, nthPlaceAt& + LEN(Delimiter$) - 1) 'include delim
97.         tail$ = MID$(Astring$, nthPlaceAt& + LEN(Delimiter$)) 'no delim
98.         IF tail$ <> "" THEN
99.             Astring$ = head$ + Insert$ + Delimiter$ + tail$
100.         END IF
101.     END IF
102.     AStringInsert$ = Astring$
103. END FUNCTION
104.  
105. FUNCTION SetVS$ (Delimiter$, Insert$, NthPlace&, AStringCopy$) ' VS = Variable Siring Lengths
106.     'use: FUNCTION StrCount& (S$, AString$)
107.     'use: FUNCTION StrPlace& (S$, Index AS LONG, Astring$)
108.     'use: FUNCTION StrCopies$ (NumberOfCopies&, S$)
109.  
110.     REDIM Astring$, wCnt&, nthPlaceAt&, nextAt&
111.     Astring$ = AStringCopy$ 'AstringCopy$ gets changed so return result through function name$
112.     wCnt& = StrCount&(Delimiter$, Astring$) + 1
113.     'make sure we have enough delimiters
114.     IF wCnt& <= NthPlace& THEN Astring$ = Astring$ + StrCopies$(NthPlace& - wCnt&, Delimiter$) ' string$ is the problem!!!!!
115.     IF NthPlace& > wCnt& THEN ' AString$ will be modified such that only insert has to be tacked to end after delimiter
116.         Astring$ = Astring$ + Insert$
117.     ELSEIF wCnt& = 1 THEN 'If something there then it comes before but if nothing probably just starting out.
118.         Astring$ = Insert$
119.     ELSE ' NthPlace& is between 2 delimiters
120.         nthPlaceAt& = StrPlace&(Delimiter$, NthPlace& - 1, Astring$)
121.         nextAt& = StrPlace&(Delimiter$, NthPlace&, Astring$)
122.         IF NthPlace& = wCnt& THEN 'no delim  on right end
123.             Astring$ = MID$(Astring$, 1, nthPlaceAt& + LEN(Delimiter$) - 1) + Insert$
124.         ELSEIF NthPlace& <= 1 THEN 'no delim of left end
125.             IF nextAt& THEN Astring$ = Insert$ + MID$(Astring$, nextAt&) ELSE Astring$ = Insert$
126.         ELSE 'between 2 delimiters
127.             Astring$ = MID$(Astring$, 1, nthPlaceAt& + LEN(Delimiter$) - 1) + Insert$ + MID$(Astring$, nextAt&)
128.         END IF
129.     END IF
130.     SetVS$ = Astring$
131. END FUNCTION
132.  
133. FUNCTION GetVS$ (Delimiter$, Index AS LONG, AString$) ' VS for Variable length string,
134.     'use: FUNCTION StrCount& (S$, AString$)
135.     'use: FUNCTION StrPlace& (S$, Index AS LONG, Astring$)
136.     REDIM cnt AS LONG, p1 AS LONG, p2 AS LONG
137.     cnt = StrCount&(Delimiter$, AString$) + 1
138.     p1 = StrPlace&(Delimiter$, Index - 1, AString$)
139.     p2 = StrPlace&(Delimiter$, Index, AString$)
140.     IF Index > cnt OR Index < 1 THEN
141.         EXIT FUNCTION ' beyond the limit of string
142.     ELSEIF Index = 1 THEN
143.         GetVS$ = MID$(AString$, 1, p2 - 1)
144.     ELSEIF Index = cnt THEN
145.         GetVS$ = MID$(AString$, p1 + LEN(Delimiter$))
146.     ELSE 'between
147.         GetVS$ = MID$(AString$, p1 + LEN(Delimiter$), p2 - p1 - LEN(Delimiter$))
148.     END IF
149. END FUNCTION
150.  
151. FUNCTION StrCopies$ (NumberOfCopies&, S$) ' Concatenate repeated copies of S$
152.     DIM i&
153.     FOR i& = 1 TO NumberOfCopies&
154.         StrCopies$ = StrCopies$ + S$
155.     NEXT
156. END FUNCTION
157.  
158. FUNCTION StrCount& (S$, AString$) ' Count S$ in Astring$
159.     REDIM place AS LONG, cnt AS LONG, lenS AS LONG
160.     place = INSTR(AString$, S$): lenS = LEN(S$)
161.     WHILE place
162.         cnt = cnt + 1
163.         place = INSTR(place + lenS, AString$, S$)
164.     WEND
165.     StrCount& = cnt
166. END FUNCTION
167.  
168. FUNCTION StrPlace& (S$, Index AS LONG, Astring$) ' Locate the Index number S$ in Astrin$
169.     REDIM place AS LONG, cnt AS LONG, lenS AS LONG
170.     place = INSTR(Astring$, S$): lenS = LEN(S$)
171.     WHILE place
172.         cnt = cnt + 1
173.         IF cnt = Index THEN StrPlace& = place: EXIT FUNCTION
174.         place = INSTR(place + lenS, Astring$, S$)
175.     WEND
176. END FUNCTION
177.  
178.  
179.  
180. FUNCTION TS$ (n AS LONG)
181.     TS$ = _TRIM$(STR$(n))
182. END FUNCTION
183.  
184.  
185.  
186.  

I wonder if you gamers would ever need this ;-))

EDIT: forgot name changes in the functions using other functions notes.

[bplus]

BTW these type tools are THE workaround for TYPE not having arrays!

Now you can Type a Variable as string and var$ = GetVS$(MyDelim$, MyIndex&, MyType(i).MyArrInAString) after setting up with:

NewMyArrInAString$ = SetVS$(MyDelim$, MyNewOrModStr$, MyIndex&, MyType(i).MyArrInAString)

Yeah, clunky is better than nothing :)

Such tools give your code Unlimited Parameter strings to use, so you are not forced comma delimited arguments and maybe even don't have to order your arguments or list a complete set.

SUB MySub(parameters$)
      parse parameters for Arguments with GetVS$
end sub