Demo: Getting arrays into an array of a UDT

[bplus]

Line 68 needs to say INTEGER.

I generally just accept the extra space usage of longs in order to get their extra range and prevent overflow, but to reach their own.

Yeah I just caught that looking over post. :)

Fixed, now I can sleep tonight! ha, ha

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Getting an Array into UDT Mod 1 Luke Method" ' started b+ 2020-01-29
3. ' 2021-01-30   Mod 1 employ Lukes method, dump ALL previous subroutines this is much less complex
4. '  I am getting too many screwups trying x, y, x, y, x, y pairs! So do 2 string arrays 1 for X 1 for Y.
5. '  Still getting some screwy problem from 1st and last elements???  but works fine if I ignore.
6. ' 2021-01-30 fixed! missed changing LONG to INTEGER in one place.
7.  
8. CONST Xmax = 1200, Ymax = 700
9. TYPE ArrayType
10.     Aname AS STRING ' here is the name of the array
11.     X AS STRING '    here is the array joined into a long string so it may be stored in a UDT
12.     Y AS STRING '
13. END TYPE
14.  
15. REDIM words(100) AS ArrayType ' record the script positions of handwritten words and save the word and positions into a UDT
16.  
17. SCREEN _NEWIMAGE(Xmax, Ymax, 32)
18. _DELAY .25 'need time for screen to load before attempting to move it.
19. _SCREENMOVE _MIDDLE
20. DIM mx AS INTEGER, my AS INTEGER, mb AS INTEGER, w$, wi AS INTEGER, i AS INTEGER, j AS INTEGER, ai AS INTEGER
21.  
22. _TITLE "To gather data:  Hand write words with mouse and then enter the word, up to 100 words or escape."
23. wi = 0 ' word index for words
24. DO
25.     CLS
26.     WHILE _MOUSEINPUT: WEND
27.     mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
28.     IF mb THEN
29.         words(wi).X = "": words(wi).Y = "": ai = 0 ' ai = array index for the elements in X, Y arrays
30.         set words(wi).X, ai, mx: set words(wi).Y, ai, my: ai = ai + 1
31.         PSET (mx, my)
32.         WHILE mb
33.             WHILE _MOUSEINPUT: WEND
34.             mx = _MOUSEX: my = _MOUSEY: mb = _MOUSEBUTTON(1)
35.             set words(wi).X, ai, mx: set words(wi).Y, ai, my: ai = ai + 1
36.             LINE -(mx, my)
37.             _LIMIT 20
38.         WEND
39.         CLS
40.         INPUT "Enter word > "; w$
41.         words(wi).Aname = w$
42.         wi = wi + 1
43.         IF wi > 100 THEN EXIT DO ' wi will always be 1 more than last word
44.     END IF
45. LOOP UNTIL _KEYDOWN(27)
46. wi = wi - 1
47.  
48. ' simple playback
49. FOR j = 0 TO wi
50.     CLS
51.     IF words(j).Aname <> "" THEN
52.         PRINT "This is word "; words(j).Aname
53.         FOR i = 0 TO LEN(words(j).X) / 2 - 1 'fixed
54.             IF i = 0 THEN PSET (get%(words(j).X, i), get%(words(j).Y, i)) ELSE LINE -(get%(words(j).X, i), get%(words(j).Y, i))
55.             _LIMIT 30
56.         NEXT
57.         _DELAY 1
58.     END IF
59. NEXT
60.  
61. '              ======================= Luke's Method ========================
62.  
63. SUB set (array$, index AS INTEGER, value AS INTEGER) ' <<<< having big debate with myself between Integer and Long, Integers are shorter
64.     REDIM element_size AS INTEGER
65.     element_size = LEN(value)
66.     IF LEN(array$) < element_size * (index + 1) THEN
67.         array$ = array$ + STRING$(element_size * (index + 1) - LEN(array$), CHR$(0))
68.     END IF
69.     MID$(array$, index * element_size + 1) = _MK$(INTEGER, value) '< fixed
70. END SUB
71.  
72. FUNCTION get% (array$, index AS INTEGER)
73.     get% = _CV(INTEGER, MID$(array$, index * 2 + 1, 2))
74. END FUNCTION
75.  
76.  
77.  

[Dimster]

That is so cool aplus . mega beyond what I had in mind but oh so cool.

[bplus]

That is so cool aplus . mega beyond what I had in mind but oh so cool.

Well I am glad I tried this because I got a nice lesson myself!

[Pete]

This looks interesting, but I'm too bogged down at the moment to get sidetracked. I hope to revisit it soon.

I also love the shameless advertising of marking your own posts as the Best Answer. Keep in mind, as per our previous conversation,I'm more than happy to do that for you, but my fee is my fee! :D

Pete

[bplus]

This looks interesting, but I'm too bogged down at the moment to get sidetracked. I hope to revisit it soon.

I also love the shameless advertising of marking your own posts as the Best Answer. Keep in mind, as per our previous conversation,I'm more than happy to do that for you, but my fee is my fee! :D

Pete

I just came back to change that, Luke's is better description!

I do have a question about Len(get) in this:

Code: QB64: [Select]

1. FUNCTION get& (array$, index)
2.     get = _CV(LONG, MID$(array$, index * LEN(get) + 1, LEN(get)))
3. END FUNCTION
4.  

That really work? using the function name most curious!
Why yes, yes it does work in demo. ;-)) Before now I just read the code never tried the Run.

[luke]

I do have a question about Len(get) in this:

Code: QB64: [Select]

1. FUNCTION get& (array$, index)
2.     get = _CV(LONG, MID$(array$, index * LEN(get) + 1, LEN(get)))
3. END FUNCTION
4.  

That really work? using the function name most curious!

I'm shamelessly exploiting a QB64 bug where the name of a function inside that function is treated as a regular variable, not a recursive call. I'm pretty sure you can't do that in QBasic, but of course it's not integral to the program - just a convenient way to reduce the number of things to change if you change the data type.

[bplus]

I have worked up 3 pairs of SUBs and FUNCTIONs for using Integers (Long), Floats (Double) and Strings (length Limit 32 characters) Array like strings with little demos of each:

https://www.qb64.org/forum/index.php?topic=1511.msg129084#msg129084

Find a great idea and you've got to run with it a bit! These should be useful for UDT "arrays" at least.

BTW I have SetLong down to this 2 liner:

Code: QB64: [Select]

1. SUB SetLong (array$, index AS LONG, value&) ' Luke's Method except option explicit requires mod, no variables needed for one type
2.     IF LEN(array$) < 4 * (index + 1) THEN array$ = array$ + STRING$(4 * (index + 1) - LEN(array$), CHR$(0))
3.     MID$(array$, index * 4 + 1) = _MK$(LONG, value&)
4. END SUB