Author Topic: Samples/Toolbox re-awakening. Call for entries.  (Read 9262 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #15 on: August 11, 2019, 02:51:49 pm »
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. _TITLE "Split 2019-08-11 update" 'b+ 2019-08-11 application for toolbox code
  2. ' 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
  3. ' further modified with Steve McNeill's suggestion to REDIM _PRESERVE in clumps of 1000
  4.  
  5. ' The Split SUB takes a given string and delimiter and breaks the string into a given Dynamic String array base 0.
  6.  
  7. SCREEN _NEWIMAGE(1200, 720, 32)
  8. DIM s$, i, w$
  9.  
  10. ' simple test modify string s$
  11. s$ = "  ,1, 2,     3,   4      ,5   , 6   ,7,   8,   " 'try start and finish 2 blanks
  12. REDIM sa$(0): Split s$, ",", sa$()
  13. FOR i = LBOUND(sa$) TO UBOUND(sa$): PRINT i, "*" + sa$(i) + "*": NEXT
  14. INPUT "Next a test with this code file, press enter "; w$
  15.  
  16. ' test with this bas file saved as  "Split.bas"
  17. IF _FILEEXISTS("Split.bas") THEN
  18.     OPEN "Split.bas" FOR BINARY AS #1
  19.     s$ = SPACE$(LOF(1)): GET #1, , s$: CLOSE #1
  20.     Split s$, CHR$(13) + CHR$(10), sa$() 'test split on the already used array sa$
  21.     FOR i = LBOUND(sa$) TO UBOUND(sa$): PRINT i, sa$(i): NEXT
  22.  
  23. 'notes: the loadMeArray() needs to be dynamic string array with base 0 ie REDIM loadMeArray(0) AS STRING
  24. SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
  25.     DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG
  26.     curpos = 1: arrpos = 0: LD = LEN(delim)
  27.     dpos = INSTR(curpos, SplitMeString, delim)
  28.     DO UNTIL dpos = 0
  29.         loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
  30.         arrpos = arrpos + 1
  31.         IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(UBOUND(loadMeArray) + 1000) AS STRING
  32.         curpos = dpos + LD
  33.         dpos = INSTR(curpos, SplitMeString, delim)
  34.     LOOP
  35.     loadMeArray(arrpos) = MID$(SplitMeString, curpos)
  36.     REDIM _PRESERVE loadMeArray(arrpos) AS STRING 'get the ubound correct
  37.  

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.
split test on spilt bas file.PNG
* split test on spilt bas file.PNG (Filesize: 41.61 KB, Dimensions: 1050x754, Views: 384)
« Last Edit: August 11, 2019, 04:19:40 pm by bplus »

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #16 on: August 12, 2019, 08:27:02 am »
Thanks bplus - I see what you've got goin' on here.
You're not done when it works, you're done when it's right.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #17 on: August 12, 2019, 09:41:26 am »
' 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.     FOR i1 = 0 TO l - 1
  27.         FOR j = 0 TO 7 '8 bytes per length and 8 bits in each byte
  28.             IF _MEMGET(m, m.OFFSET + i1, _BYTE) AND 2 ^ j THEN b$ = "1" + b$ ELSE b$ = "0" + b$
  29.     NEXT j, i1
  30.     bin$ = "&B" + MID$(b$, INSTR(b$, "1"))
  31.  
  32.  



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

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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #18 on: August 12, 2019, 10:42:31 am »
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?

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #19 on: August 12, 2019, 11:14:16 am »
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:
Quote
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:
Quote
'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.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #20 on: August 24, 2019, 04:33:47 pm »
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?
You're not done when it works, you're done when it's right.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #21 on: August 24, 2019, 04:45:49 pm »
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.)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #22 on: August 24, 2019, 05:20:06 pm »
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
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #23 on: August 24, 2019, 05:57:33 pm »
Right. I see a SUB up there, but a demo?
You're not done when it works, you're done when it's right.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #24 on: August 24, 2019, 06:23:25 pm »
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. PRINT "First, I want to showcase the exisinging issue with the _FONT command."
  10. PRINT "Let's start out typing something, and then pause before loading a"
  11. PRINT "new font..."
  12.  
  13. _FONT font(0)
  14. COLOR &HFFF00000, &HFFFFFF00
  15. slowprint "NOW WHERE IS OUR PRINT CURSOR AT??"
  16. CLS , 0
  17. COLOR -1, 0
  18.  
  19. PRINT "Now, let's try this same type of thing, while using SafeLoadFont"
  20. PRINT "We'll start typing something, and then pause before safe loading"
  21. PRINT "a new font..."
  22.  
  23.  
  24. slowprint "Slowly watch what happens to our print cursor "
  25. SafeLoadFont font(1)
  26. slowprint "as we use SafeLoadFont to change "
  27. SafeLoadFont font(2)
  28. slowprint "fonts while happily printing to "
  29. SafeLoadFont 16
  30. slowprint "the screen, without a concern in the world! "
  31. PRINT "Now, isn't that something?!"
  32.  
  33.  
  34. SUB slowprint (text$)
  35.     FOR i = 1 TO LEN(text$)
  36.         PRINT MID$(text$, i, 1);
  37.         _LIMIT 5
  38.     NEXT
  39.  
  40. SUB SafeLoadFont (font#)
  41.     'Safely loads a font without destroying our current print location and making it revert to the top left corner.
  42.  
  43.     down = CSRLIN: right = POS(0)
  44.     down = (down - 1) * _FONTHEIGHT
  45.     IF _FONTWIDTH <> 0 THEN 'we start with a monospace font
  46.         right = (right - 1) * _PRINTWIDTH(" ") 'convert the monospace LOC to a graphic X coordinate
  47.     END IF
  48.     _FONT font#
  49.     IF _FONTWIDTH <> 0 THEN 'we swapped to a monospace font
  50.         right = (right / _PRINTWIDTH(" ")) + 1 'convert the graphic X coordinate back to a monospace LOC column
  51.     END IF
  52.     down = (down / _FONTHEIGHT) + 1
  53.     IF right < 1 THEN right = 1
  54.     LOCATE down, right
  55.  

(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.)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #25 on: August 27, 2019, 09:27:20 pm »
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. _TITLE "Split demo 2" ' started by B+ on 08-27-2019 to compare to Item$ demo
  2. 'new data setup structure to streamline code in setup
  3.  
  4. SCREEN _NEWIMAGE(400, 300, 32)
  5. 'globals seen inside SUBs and FUNCTIONs because SHARED
  6. DIM SHARED topIndex AS INTEGER '<< this is how many keywords we have
  7. 'VVVV REDIM means dynamic arrays, so can change in setup
  8. REDIM SHARED d(1 TO topIndex) AS STRING
  9.  
  10. 'locals just seen in following main code section
  11. REDIM list$(1 TO 1)
  12. setup
  13. FOR i = LBOUND(d) TO UBOUND(d) 'all the keywords are first word$ of d() data array
  14.     Split d(i), ",", list$()
  15.     PRINT "Data index:"; i; " "; "String Item:"; LBOUND(list$); list$(LBOUND(list$))
  16.     FOR j = LBOUND(list$) + 1 TO UBOUND(list$)
  17.         PRINT SPACE$(15); "String Item:"; j; list$(j) 'j-1 counts off the items after the first
  18.     NEXT
  19.     PRINT: INPUT "Ok... press enter "; w$
  20.     CLS
  21.  
  22. SUB setup '3rd method of data structure, this is meant to be edited over and over as add to a refine words and substitutes
  23.     topIndex = 5 ' <<< make modifications to d() and then update this number, that's it!
  24.     REDIM d(1 TO topIndex) AS STRING
  25.     d(1) = "Months,January,February,March,April,May,June,July,August,September,October,November,December"
  26.     d(2) = "Days,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday"
  27.     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"
  28.     d(4) = "Test no further words/phrases in this line. (And the next test will do an empty string.)"
  29.     d(5) = ""
  30.  
  31. '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.
  32. 'notes: the loadMeArray() needs to be dynamic string array and will not change the LBOUND of the array it is given.
  33. SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
  34.     DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
  35.     curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
  36.     dpos = INSTR(curpos, SplitMeString, delim)
  37.     DO UNTIL dpos = 0
  38.         loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
  39.         arrpos = arrpos + 1
  40.         IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS STRING
  41.         curpos = dpos + LD
  42.         dpos = INSTR(curpos, SplitMeString, delim)
  43.     LOOP
  44.     loadMeArray(arrpos) = MID$(SplitMeString, curpos)
  45.     REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS STRING 'get the ubound correct
  46.  
  47.  
Split Demo #2.PNG


Description:
Quote
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.
'
« Last Edit: August 27, 2019, 09:35:08 pm by bplus »

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #26 on: August 27, 2019, 09:44:42 pm »
On it, thanks for letting us know!
You're not done when it works, you're done when it's right.

Offline bplus

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

 
Item$ Demo.PNG


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.
« Last Edit: August 28, 2019, 10:51:57 am by bplus »

Offline Qwerkey

  • Forum Resident
  • Posts: 755
    • View Profile
Re: Samples/Toolbox re-awakening. Call for entries.
« Reply #28 on: August 28, 2019, 06:13:12 am »
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
* QB64 Mahjong User Manual.pdf (Filesize: 120.05 KB, Downloads: 226)
screenshot.jpg
* screenshot.jpg (Filesize: 327.3 KB, Dimensions: 714x738, Views: 356)