Samples/Toolbox re-awakening. Call for entries.

[bplus]

Hi STxAxTIC

The "huge warning" is just reminder that the array to be loaded has to be a Dynamic String array base 0.

Here is bare essentials, save the code as Split.bas to test a bas file split into file lines:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Split 2019-08-11 update" 'b+ 2019-08-11 application for toolbox code
3. ' bplus modifications of Galleon fix of Bulrush Split reply #13 http://xmaxw.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1612.0
4. ' further modified with Steve McNeill's suggestion to REDIM _PRESERVE in clumps of 1000
5.  
6. ' The Split SUB takes a given string and delimiter and breaks the string into a given Dynamic String array base 0.
7.  
8. SCREEN _NEWIMAGE(1200, 720, 32)
9. _SCREENMOVE 100, 0
10. DIM s$, i, w$
11.  
12. ' simple test modify string s$
13. s$ = "  ,1, 2,     3,   4      ,5   , 6   ,7,   8,   " 'try start and finish 2 blanks
14. REDIM sa$(0): Split s$, ",", sa$()
15. FOR i = LBOUND(sa$) TO UBOUND(sa$): PRINT i, "*" + sa$(i) + "*": NEXT
16. INPUT "Next a test with this code file, press enter "; w$
17.  
18. ' test with this bas file saved as  "Split.bas"
19. IF _FILEEXISTS("Split.bas") THEN
20.     OPEN "Split.bas" FOR BINARY AS #1
21.     s$ = SPACE$(LOF(1)): GET #1, , s$: CLOSE #1
22.     Split s$, CHR$(13) + CHR$(10), sa$() 'test split on the already used array sa$
23.     FOR i = LBOUND(sa$) TO UBOUND(sa$): PRINT i, sa$(i): NEXT
24. END IF
25.  
26. 'notes: the loadMeArray() needs to be dynamic string array with base 0 ie REDIM loadMeArray(0) AS STRING
27. SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
28.     DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG
29.     curpos = 1: arrpos = 0: LD = LEN(delim)
30.     dpos = INSTR(curpos, SplitMeString, delim)
31.     DO UNTIL dpos = 0
32.         loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
33.         arrpos = arrpos + 1
34.         IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(UBOUND(loadMeArray) + 1000) AS STRING
35.         curpos = dpos + LD
36.         dpos = INSTR(curpos, SplitMeString, delim)
37.     LOOP
38.     loadMeArray(arrpos) = MID$(SplitMeString, curpos)
39.     REDIM _PRESERVE loadMeArray(arrpos) AS STRING 'get the ubound correct
40. END SUB
41.  

Update: just ran a successful test reversing the order of the two tests loading the file into the array and then loading the smaller string into the array, without REDIM to erase.

[STxAxTIC]

Thanks bplus - I see what you've got goin' on here.

[SMcNeill]

' QB64 can reverse &H numbers with HEX$ and &O numbers with OCT$
' but what about &B numbers?

' Here is BIN$

Negative numbers have a different representation depending on which variable type we're using. 

-1 as a BYTE is &B11111111
-2 as a BYTE is &B11111110
-2 as a integer is &B1111111111111110

Which used to be hard to represent and get proper return values back for, but not anymore!  I present to you an expanded BIN$ which you can use for both positive and negative values:

Code: QB64: [Select]

1.  
2. n$ = bin$(12, 1)
3. PRINT n$, VAL(n$)
4.  
5. n$ = bin$(-2, 1) 'byte
6. PRINT n$, VAL(n$)
7.  
8. n$ = bin$(-2, 2) 'integer
9. PRINT n$, VAL(n$)
10.  
11. FUNCTION bin$ (n AS _INTEGER64, Rbytes AS _BYTE)
12.     STATIC m AS _MEM
13.     DIM b AS _BYTE, i AS INTEGER, l AS LONG, i64 AS _INTEGER64
14.     IF n < 1 THEN 'the user needs to tell us how many return bytes they expect
15.         SELECT CASE Rbytes 'assign the value to the proper mem type
16.             CASE 1: m = _MEM(b): l = 1: b = n '1 for a byte
17.             CASE 2: m = _MEM(i): l = 2: i = n '2 for an integer
18.             CASE 4:: m = _MEM(l): l = 4: l = n '4 for a long
19.             CASE 8: m = _MEM(i64): l = 8: i64 = n '8 for an integer64
20.             CASE ELSE: bin$ = "WRONG RETURN TYPE!": EXIT FUNCTION
21.         END SELECT
22.     ELSE
23.         m = _MEM(n): l = 8 'just use the number as we passed it
24.     END IF
25.  
26.     $CHECKING:OFF
27.     FOR i1 = 0 TO l - 1
28.         FOR j = 0 TO 7 '8 bytes per length and 8 bits in each byte
29.             IF _MEMGET(m, m.OFFSET + i1, _BYTE) AND 2 ^ j THEN b$ = "1" + b$ ELSE b$ = "0" + b$
30.     NEXT j, i1
31.     $CHECKING:ON
32.     bin$ = "&B" + MID$(b$, INSTR(b$, "1"))
33. END FUNCTION
34.  
35.  

Or, for those who like to keep BIN$ simple, the function could be easily broken down into 2 parts -- bin$ and nbin$ (negative bin$), as so:

Code: QB64: [Select]

1. n$ = bin$(12)
2. PRINT n$, VAL(n$)
3.  
4. n$ = nbin$(-2, 1) 'byte
5. PRINT n$, VAL(n$)
6.  
7. n$ = nbin$(-2, 2) 'integer
8. PRINT n$, VAL(n$)
9.  
10. FUNCTION bin$ (n AS _INTEGER64)
11.     STATIC m AS _MEM
12.     IF n < 1 THEN bin$ = "WRONG RETURN TYPE!": EXIT FUNCTION
13.     m = _MEM(n)
14.     $CHECKING:OFF
15.     FOR i1 = 0 TO 7: FOR j = 0 TO 7 '8 bytes per byte and 8 bits in each byte
16.             IF _MEMGET(m, m.OFFSET + i1, _BYTE) AND 2 ^ j THEN b$ = "1" + b$ ELSE b$ = "0" + b$
17.     NEXT j, i1
18.     $CHECKING:ON
19.     bin$ = "&B" + MID$(b$, INSTR(b$, "1"))
20. END FUNCTION
21.  
22. FUNCTION nbin$ (n AS _INTEGER64, Rbytes AS _BYTE) 'the user needs to tell us how many return bytes they expect
23.     STATIC m AS _MEM
24.     DIM b AS _BYTE, i AS INTEGER, l AS LONG, i64 AS _INTEGER64
25.     SELECT CASE Rbytes 'assign the value to the proper mem type
26.         CASE 1: m = _MEM(b): l = 1: b = n '1 for a byte
27.         CASE 2: m = _MEM(i): l = 2: i = n '2 for an integer
28.         CASE 4:: m = _MEM(l): l = 4: l = n '4 for a long
29.         CASE 8: m = _MEM(i64): l = 8: i64 = n '8 for an integer64
30.         CASE ELSE: nbin$ = "WRONG RETURN TYPE!": EXIT FUNCTION
31.     END SELECT
32.     $CHECKING:OFF
33.     FOR i1 = 0 TO l - 1: FOR j = 0 TO 7 '8 bytes per length and 8 bits in each byte
34.             IF _MEMGET(m, m.OFFSET + i1, _BYTE) AND 2 ^ j THEN b$ = "1" + b$ ELSE b$ = "0" + b$
35.     NEXT j, i1
36.     $CHECKING:ON
37.     nbin$ = "&B" + MID$(b$, INSTR(b$, "1"))
38. END FUNCTION
39.  

I don't know if you guys would prefer either of these over the version Bplus posted, but I thought I'd offer them for you to look at.

[bplus]

On converting negative integers in different bases:

Ideally, if BIN$ could handle both positive and negative integers I'd prefer that but if I have to say how many bytes then definitely prefer just doing positive, so nBin$ with 2nd argument of bytes is great additional tool for those who might need that.

BTW I doubt HEX$ and OCT$ handle negatives either, so a tool for all 3 handling negatives?

[bplus]

Hi STxAxTIC,

A couple of comments on the Split1000 entry to tool box, I hope you don't think this picky.

I did rename the sub simply Split, so the title for the tool might be just Split, though Split1000 has a catchy ring. :)

Your 2nd line in description:

Description:
Split receives a string (or entire text file) along with a delimiter argument (such as space, semicolon, tab, etc.) and prepares an array to store the string in fragments. The Nth member of the resulting array is the sub-string between the N-1 and Nth delimiter in the original string.

Did not ring quite right but got me thinking the number of delimiters and the number of strings loaded to the array.
It is true, if there are N delimiters then there are N+1 strings loaded into the zero based array including potentially empty strings to serve as place holders ie if the whole string is just N delimiters, the array will be loaded with N+1 empty strings.

What's not ringing right is that N usually denotes a count and counts usually start at 1. It is very important to stress Split uses a zero based array (and does not exactly prepare one).
It is also true that the last item in the array comes after the last delimiter in the string, counting wise that is N+1.

Thanks for reading carefully and considering this as alternate description:

'The Split SUB takes a given string and delimiter and loads a given Dynamic String array base 0 with parsed or empty strings s.t. if there are N delimiters there will be N+1 strings and the upper bound of the array will be N.

[STxAxTIC]

Hey fellas,

The Librarian has been slowly chipping away (well, the opposite really) at this archive... Next question is for Steve regarding saving images.

Would you say the save image stuff is ready to crystalize? Namely this post:
https://www.qb64.org/forum/index.php?topic=1605.0

... but save GIF is not:
https://www.qb64.org/forum/index.php?topic=1618.0

- OR -

Should we hold off until the zlib/inflate/deflate stuff is more thoroughly vetted?

[SMcNeill]

Hey fellas,

The Librarian has been slowly chipping away (well, the opposite really) at this archive... Next question is for Steve regarding saving images.

Would you say the save image stuff is ready to crystalize? Namely this post:
https://www.qb64.org/forum/index.php?topic=1605.0

... but save GIF is not:
https://www.qb64.org/forum/index.php?topic=1618.0

- OR -

Should we hold off until the zlib/inflate/deflate stuff is more thoroughly vetted?

SaveGIF works just fine and can be added anytime.  Sooner or later, I’ll update it to allow animations, but probably not for quite some time.  There’s also a SaveBMP and SavePNG library available as well, if someone just wants to save in one of those particular formats.

The SaveImage v2.1 Library works just fine and pulls all those libraries together into one place for us, as well as the JPG format.  For Windows, it allows image saving in BMP, JPG, PNG, and GIF format.  Linux doesn’t play nice with DECLARE LIBRARY with the zlib library, so PNG is excluded from it, but it still works with GIF, BMP, and GIF formats.  (Which is part of the reason why I was working so hard to add the zlib library to my repo.)

[SMcNeill]

And here's a suggestion for something else to go into the toolbox -- SafeLoadFont.  I think the demo will explain its functionality for itself.

Code: QB64: [Select]

1. SUB SafeLoadFont (font#)
2.     'Safely loads a font without destroying our current print location and making it revert to the top left corner.
3.  
4.     down = CSRLIN: right = POS(0)
5.     down = (down - 1) * _FONTHEIGHT
6.     IF _FONTWIDTH <> 0 THEN 'weed start with a monospace font
7.         right = (right - 1) * _PRINTWIDTH(" ") 'convert the monospace LOC to a graphic X coordinate
8.     END IF
9.     _FONT font#
10.     IF _FONTWIDTH <> 0 THEN 'we swapped to a monospace font
11.         right = (right / _PRINTWIDTH(" ")) + 1 'convert the graphic X coordinate back to a monospace LOC column
12.     END IF
13.     down = (down / _FONTHEIGHT) + 1
14.     IF right < 1 THEN right = 1
15.     LOCATE down, right
16. END SUB

[STxAxTIC]

Right. I see a SUB up there, but a demo?

[SMcNeill]

Right. I see a SUB up there, but a demo?

&!#@%!! 

Sometimes, I think my clipboard is broken.   I copied the routine from my personal set of "toolbox tools", and wrote a demo for it... Somehow, windows didn't bother to copy the whole demo, and I was left with just the copied sub to paste.   Let's try this one more time:

Code: QB64: [Select]

1. DIM fonts(3) AS LONG
2. SCREEN _NEWIMAGE(640, 480, 32)
3.  
4. font(0) = _LOADFONT("cour.ttf", 16, "monospace")
5. font(1) = _LOADFONT("courbd.ttf", 16, "monospace")
6. font(2) = _LOADFONT("courbi.ttf", 16, "monospace")
7. font(3) = _LOADFONT("couri.ttf", 16, "monospace")
8.  
9. CLS
10. COLOR -1
11. PRINT "First, I want to showcase the exisinging issue with the _FONT command."
12. PRINT "Let's start out typing something, and then pause before loading a"
13. PRINT "new font..."
14.  
15. SLEEP
16. _FONT font(0)
17. COLOR &HFFF00000, &HFFFFFF00
18. slowprint "NOW WHERE IS OUR PRINT CURSOR AT??"
19. SLEEP
20. CLS , 0
21. COLOR -1, 0
22.  
23. PRINT "Now, let's try this same type of thing, while using SafeLoadFont"
24. PRINT "We'll start typing something, and then pause before safe loading"
25. PRINT "a new font..."
26.  
27. SLEEP
28.  
29. slowprint "Slowly watch what happens to our print cursor "
30. SafeLoadFont font(1)
31. slowprint "as we use SafeLoadFont to change "
32. SafeLoadFont font(2)
33. slowprint "fonts while happily printing to "
34. SafeLoadFont 16
35. slowprint "the screen, without a concern in the world! "
36. PRINT
37. PRINT
38. PRINT "Now, isn't that something?!"
39.  
40.  
41. SUB slowprint (text$)
42.     FOR i = 1 TO LEN(text$)
43.         PRINT MID$(text$, i, 1);
44.         _LIMIT 5
45.     NEXT
46. END SUB
47.  
48. SUB SafeLoadFont (font#)
49.     'Safely loads a font without destroying our current print location and making it revert to the top left corner.
50.  
51.     down = CSRLIN: right = POS(0)
52.     down = (down - 1) * _FONTHEIGHT
53.     IF _FONTWIDTH <> 0 THEN 'we start with a monospace font
54.         right = (right - 1) * _PRINTWIDTH(" ") 'convert the monospace LOC to a graphic X coordinate
55.     END IF
56.     _FONT font#
57.     IF _FONTWIDTH <> 0 THEN 'we swapped to a monospace font
58.         right = (right / _PRINTWIDTH(" ")) + 1 'convert the graphic X coordinate back to a monospace LOC column
59.     END IF
60.     down = (down / _FONTHEIGHT) + 1
61.     IF right < 1 THEN right = 1
62.     LOCATE down, right
63. END SUB
64.  

(Do I need to load a copy of the fonts as well?  They're fairly standard ones, which seem to ship with most every OS out there.)

[bplus]

Hi STxAxTIC,

I have been working with Ron on streamlining DATA and from the experience have improved our very useful Split SUB into an even more convenient tool to use by lifting the 0 base restriction from it's usage.

Here is an updated Demo that shows we are using base 1 instead of 0 and a new description for the Split SUB. I hope the Librarian will be pleased that we constantly try to improve our tools and sometimes succeed.

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Split demo 2" ' started by B+ on 08-27-2019 to compare to Item$ demo
3. 'new data setup structure to streamline code in setup
4.  
5. SCREEN _NEWIMAGE(400, 300, 32)
6. 'globals seen inside SUBs and FUNCTIONs because SHARED
7. DIM SHARED topIndex AS INTEGER '<< this is how many keywords we have
8. 'VVVV REDIM means dynamic arrays, so can change in setup
9. REDIM SHARED d(1 TO topIndex) AS STRING
10.  
11. 'locals just seen in following main code section
12. DIM i AS INTEGER, j AS INTEGER, w$
13. REDIM list$(1 TO 1)
14. setup
15. FOR i = LBOUND(d) TO UBOUND(d) 'all the keywords are first word$ of d() data array
16.     Split d(i), ",", list$()
17.     PRINT "Data index:"; i; " "; "String Item:"; LBOUND(list$); list$(LBOUND(list$))
18.     FOR j = LBOUND(list$) + 1 TO UBOUND(list$)
19.         PRINT SPACE$(15); "String Item:"; j; list$(j) 'j-1 counts off the items after the first
20.     NEXT
21.     PRINT: INPUT "Ok... press enter "; w$
22.     CLS
23. NEXT
24.  
25. SUB setup '3rd method of data structure, this is meant to be edited over and over as add to a refine words and substitutes
26.     topIndex = 5 ' <<< make modifications to d() and then update this number, that's it!
27.     REDIM d(1 TO topIndex) AS STRING
28.     d(1) = "Months,January,February,March,April,May,June,July,August,September,October,November,December"
29.     d(2) = "Days,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday"
30.     d(3) = "Holidays,NewYears Day,MLK Day,Valentine's Day,Easter,Mother's Day,Memorial Day,Father's Day,Independence Day,Bplus Day,Labor Day,Halloween,Thanksgiving,Christmas"
31.     d(4) = "Test no further words/phrases in this line. (And the next test will do an empty string.)"
32.     d(5) = ""
33. END SUB
34.  
35. 'This SUB will take a given N delimited string, and delimiter$ and creates an array of N+1 strings using the LBOUND of the given dynamic array to load.
36. 'notes: the loadMeArray() needs to be dynamic string array and will not change the LBOUND of the array it is given.
37. SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
38.     DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
39.     curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
40.     dpos = INSTR(curpos, SplitMeString, delim)
41.     DO UNTIL dpos = 0
42.         loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
43.         arrpos = arrpos + 1
44.         IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS STRING
45.         curpos = dpos + LD
46.         dpos = INSTR(curpos, SplitMeString, delim)
47.     LOOP
48.     loadMeArray(arrpos) = MID$(SplitMeString, curpos)
49.     REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS STRING 'get the ubound correct
50. END SUB
51.  
52.  

Description:

This SUB will take a given N delimited string, and delimiter$ and creates an array of N+1 strings using the LBOUND of the given dynamic array to load.
'

[STxAxTIC]

On it, thanks for letting us know!

[bplus]

Hi STxAxTIC,

Another great tool I have used in the past (for evaluator for interpreter) is now new and improved and newly named! For instance it use to use a slow FOR structure and step through string 1 character at a time, now uses While loop and Instr to fly through, it is now also not restricted to just space delimited strings.

Here is the description:

'Description: Use Item$() Function to treat strings like arrays without having to use an array structure.
' This function does not throw a fit if you ask for an item number (index) it does not have, it just returns an empty string.
' In QB64, Functions can't return arrays through the function name, but they can return strings that the Item$() function can translate like an an array index.  nItem numbers are the same as Counting numbers positive integers starting at 1. eg Item7$ = Item$(CommaDelimitedString$, 7, ",") 'get 7th Item in string

And here is the Demo, you might notice it is allot like the one for improved Split. That is because I was comparing the two because I couldn't decide which is better. Both are designed to be vast improvement over the old RESTORE, READ, DATA system.

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Item$ Demo" ' B+ start 2019-08-27
3.  
4. 'globals seen inside SUBs and FUNCTIONs because SHARED
5. DIM SHARED topIndex AS INTEGER '<< this is how many data lines we have, set in setup Sub
6. 'VVVV REDIM means dynamic arrays, so can change in setup
7. REDIM SHARED d(1 TO topIndex) AS STRING 'here is our data array see setup SUB
8.  
9. 'locals just seen in following main code section
10. DIM i AS INTEGER, j AS INTEGER, keyword$, w$
11.  
12. SCREEN _NEWIMAGE(400, 300, 32)
13. setup
14. FOR i = 1 TO topIndex 'all the keywords are first Item$ of d() data array
15.     keyword$ = Item$(d(i), 1, ","): PRINT i; " "; keyword$
16.     j = 2
17.     WHILE Item$(d(i), j, ",") <> "" 'all words > 1 are sub or subst items of keyword
18.         PRINT SPACE$(5); j - 1; Item$(d(i), j, ",") 'j-1 counts off the sub item
19.         j = j + 1
20.     WEND
21.     PRINT: INPUT "Ok... press enter "; w$
22.     CLS
23. NEXT
24.  
25. SUB setup '3rd method of data structure, this is meant to be edited over and over as add to a refine words and substitutes
26.     topIndex = 6 ' <<< make modifications to d() and then update this number, that's it!
27.     REDIM d(1 TO topIndex) AS STRING
28.     d(1) = "Months,January,February,March,April,May,June,July,August,September,October,November,December"
29.     d(2) = "Days,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday"
30.     d(3) = "Holidays,NewYears Day,MLK Day,Valentine's Day,Easter,Mother's Day,Memorial Day,Father's Day,Independence Day,Bplus Day,Labor Day,Halloween,Thanksgiving,Christmas"
31.     d(4) = "Leap Years,2000,2004,2008,2012,2016,2020,2024,2028,2032,2036,2040,...,2096,2104,..."
32.     d(5) = "Test no further words/phrases in this line. (And the next test will do an empty string.)"
33.     d(6) = ""
34. END SUB
35.  
36. 'Description: Use Item$() Function to treat strings like arrays without having to use an array structure.
37. ' This function does not throw a fit if you ask for an item number (index) it does not have, it just returns an empty string.
38. ' In QB64, Functions can't return arrays through the function name, but they can return strings that the Item$() function can
39. ' translate like an an array index.  nItem numbers are the same as Counting numbers positive integers starting at 1.
40. '  eg Item7$ = Item$(CommaDelimitedString$, 7, ",") 'get 7th Item in string
41. FUNCTION Item$ (s$, nItem AS INTEGER, delimiter$)
42.     DIM c AS INTEGER, d AS INTEGER, lastd AS INTEGER
43.     IF LEN(s$) = 0 THEN Item$ = "": EXIT FUNCTION
44.     lastd = 1: d = INSTR(lastd, s$, delimiter$)
45.     WHILE d > 0
46.         c = c + 1
47.         IF c = nItem THEN
48.             Item$ = MID$(s$, lastd, d - lastd): EXIT FUNCTION
49.         ELSE
50.             lastd = d + 1: d = INSTR(lastd, s$, delimiter$)
51.         END IF
52.     WEND
53.     c = c + 1
54.     IF c <> nItem THEN Item$ = "" ELSE Item$ = MID$(s$, lastd, LEN(s$))
55. END FUNCTION
56.  

 

Update / Append:
So you may wonder when to use Split and when to use Item$, well it is more efficient to Split to an array if the string is huge, like a file, and it is vital reference for your application. On the other hand, Rons task: https://www.qb64.org/forum/index.php?topic=1655.0 is solved by getting info fast from potentially hundreds of smaller strings a sort of Just In Time processing that gives array like access to a string without actually having to create an array :)
Ha! we have 50 replies in that thread and I have yet to demo the perfect fit Item$ is for his task, stay tuned...
I also have the problem solved with a Split version too but... learning is step by step.

[Qwerkey]

QB64 Mahjong

Librarian, please find attached.  I believe that this would be suitable as a Sample Program.  As well as showing off the good graphics which QB64 produces, this is an InForm-based game and advertises Fellippe's production.

Post:
https://www.qb64.org/forum/index.php?topic=632.msg5033#new