### Author Topic: Meander testing grounds  (Read 375 times)

#### bplus ##### Meander testing grounds
« on: September 15, 2020, 08:09:37 PM »
Problem is first discussed here between Cobalt and I:
https://www.qb64.org/forum/index.php?topic=3018.msg122803#msg122803

Here is first rough draft prototype for meandering:
Code: QB64: [Select]
1. _TITLE "Meander ProtoType for Cobolt Problem" ' b+ 2020-09-15
2. SCREEN _NEWIMAGE(800, 600, 32)
3. _DELAY .25
4. DIM SHARED distx, disty, endx, endy, x, y
5.
6. startx = 10: starty = 10: endx = 790: endy = 590
7.     x = startx: y = starty
8.     dist
9.     time = INT(RND * 16 + 4) ' total amoount allowed to move  The More the time the more the meander!!!!
10.     meanderTime = time '       > 20 is too much!!
11.     _PRINTSTRING (10, _HEIGHT - 20), " Meander:" + STR\$(meanderTime)
12.     LINE (startx, starty)-STEP(4, 4), &HFFFF000, BF
13.     LINE (endx, endy)-STEP(4, 4), &HFF0000FF, BF
14.     IF RND < .5 THEN lastmoveX = 0 ELSE lastmoveX = -1
15.     lastx = startx
16.     lasty = starty
17.         dist
18.         IF RND < .5 THEN d = -1 ELSE d = 1
19.         IF lastmoveX = 0 THEN
20.             lastx = x
21.             IF time <= 3 THEN
22.                 x = endx
23.                 dx = d * (.4 * distx + 5)
24.                 IF x + dx > 0 AND x + dx < _WIDTH THEN
25.                     x = x + dx
26.                     x = x + -dx
27.             LINE (lastx, y)-(x, y)
28.             lastmoveX = -1
29.             lasty = y
30.             IF time <= 3 THEN
31.                 y = endy
32.                 dy = d * (.3 * disty + 5)
33.                 IF y + dy > 0 AND y + dy < _HEIGHT THEN
34.                     y = y + dy
35.                     y = y + -dy
36.             LINE (x, lasty)-(x, y)
37.             lastmoveX = 0
38.         time = time - 1
39.         _LIMIT 10
40.     LOOP UNTIL time <= 0 OR _KEYDOWN(27)
41.
42. SUB dist
43.     distx = endx - x: disty = endy - y
44.
45.

We could get fancy and limit the number of path crossovers to 1 or 2? if doesn't block path to target.

#### bplus ##### Re: Meander testing grounds
« Reply #1 on: September 15, 2020, 11:15:13 PM »
Code: QB64: [Select]
1. _TITLE "Meander #2 the SUB" ' b+ 2020-09-15
2. SCREEN _NEWIMAGE(1200, 720, 32)
3. _DELAY .25
4. DIM SHARED distx, disty, endx, endy, x, y
5.
6. nboxes = 20
7.     COLOR &HFF000000, &HFF882200: CLS
8.     REDIM xx(nboxes), yy(nboxes)
9.     x = RND * _WIDTH: y = RND * _HEIGHT: w = RND * .1 * _WIDTH + 36: h = RND * .1 * _HEIGHT + 21
10.     LINE (x - .5 * w, y - .5 * h)-STEP(w, h), , BF ' _RGB32(RND * 200 + 55, RND * 200 + 55, RND * 200 + 55), BF
11.     xx(1) = x: yy(1) = y: b = 1
12.     FOR i = 2 TO nboxes
13.         tryAgain:
14.         x2 = RND * _WIDTH: y2 = RND * _HEIGHT: OK = -1
15.         FOR j = 1 TO i - 1
16.             IF _HYPOT(xx(j) - x2, yy(j) - y2) < 150 THEN OK = 0: EXIT FOR
17.         IF OK = 0 THEN GOTO tryAgain
18.         xx(i) = x2: yy(i) = y2
19.         w2 = RND * .1 * _WIDTH + 36: h2 = RND * .1 * _HEIGHT + 21
20.         LINE (x2 - .5 * w2, y2 - .5 * h2)-STEP(w2, h2), , BF '_RGB32(RND * 200 + 55, RND * 200 + 55, RND * 200 + 55), BF
21.         meander x, y, x2, y2
22.         x = x2: y = y2: w = w2: h = h2
23.
24. SUB meander (x1, y1, x2, y2)
25.     startx = x1: starty = y1: endx = x2: endy = y2
26.     x = startx: y = starty
27.     GOSUB dist
28.     IF distx + disty > 140 THEN
29.         time = INT(RND * 6 + 4) ' total amount allowed to move  The More the time the more the meander!!!!
30.         time = 3
31.     meanderTime = time '       > 20 is too much!!
32.     IF RND < .5 THEN lastmoveX = 0 ELSE lastmoveX = -1
33.     lastx = startx: lasty = starty
34.         GOSUB dist
35.         IF RND < .5 THEN d = -1 ELSE d = 1
36.         IF lastmoveX = 0 THEN
37.             lastx = x
38.             IF time <= 3 THEN
39.                 x = endx
40.                 dx = d * (.4 * distx + 100)
41.                 IF x + dx > 0 AND x + dx < _WIDTH THEN
42.                     x = x + dx
43.                     x = x + -dx
44.             'LINE (lastx, y)-(x, y)
45.             beeline lastx, y, x, y
46.             lastmoveX = -1
47.             lasty = y
48.             IF time <= 3 THEN
49.                 y = endy
50.                 dy = d * (.3 * disty + 100)
51.                 IF y + dy > 0 AND y + dy < _HEIGHT THEN
52.                     y = y + dy
53.                     y = y + -dy
54.             'LINE (x, lasty)-(x, y)
55.             beeline x, lasty, x, y
56.             lastmoveX = 0
57.         time = time - 1
58.         _LIMIT 10
59.     LOOP UNTIL time <= 0 OR _KEYDOWN(27)
60.     dist:
61.     distx = endx - x: disty = endy - y
62.
63. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
66.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
67.     LINE (CX - X, CY)-(CX + X, CY), C, BF
68.     WHILE X > Y
70.         IF RadiusError >= 0 THEN
71.             IF X <> Y + 1 THEN
72.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
73.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
74.             X = X - 1
76.         Y = Y + 1
77.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
78.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
79.
80. SUB beeline (x1, y1, x2, y2)
81.     IF x1 = x2 THEN
82.         IF y1 <= y2 THEN FOR y = y1 TO y2: fcirc x1, y, 4, &HFF000000: NEXT
83.         IF y1 > y2 THEN FOR y = y1 TO y2 STEP -1: fcirc x1, y, 4, &HFF000000: NEXT
84.         IF x1 <= x2 THEN FOR x = x1 TO x2: fcirc x, y1, 4, &HFF000000: NEXT
85.         IF x1 > x2 THEN FOR x = x1 TO x2 STEP -1: fcirc x, y1, 4, &HFF000000: NEXT

#### Cobalt

• Forum Resident
• Posts: 639
• At 60 I become highly radioactive! ##### Re: Meander testing grounds
« Reply #2 on: September 16, 2020, 01:32:17 AM »
when I try your 1st post code, B+, I get the following:
In file included from qbx.cpp:2208:
..\\temp\\main.txt:208:1: error: 'LABEL_5' does not name a type; did you mean 'HACCEL__'?
LABEL_5:;
^~~~~~~
HACCEL__
compilation terminated due to -Wfatal-errors.

I'll try the second...
Granted after becoming radioactive I only have a half-life!

#### Cobalt

• Forum Resident
• Posts: 639
• At 60 I become highly radioactive! ##### Re: Meander testing grounds
« Reply #3 on: September 16, 2020, 01:40:06 AM »
Okay the second one works.

does TIME change how much meandering the tunneler does between rooms?

looks pretty good, though it is okay if some rooms are not fully connected, not sure what I would have to change to allow that to happen.
« Last Edit: September 16, 2020, 01:44:13 AM by Cobalt »
Granted after becoming radioactive I only have a half-life!

#### bplus ##### Re: Meander testing grounds
« Reply #4 on: September 16, 2020, 07:38:07 AM »
when I try your 1st post code, B+, I get the following:
In file included from qbx.cpp:2208:
..\\temp\\main.txt:208:1: error: 'LABEL_5' does not name a type; did you mean 'HACCEL__'?
LABEL_5:;
^~~~~~~
HACCEL__
compilation terminated due to -Wfatal-errors.

I'll try the second...

What is line 5?, HACCEL__? and no way is there 208 lines in main text! WTH are feeding QB64?

Are you using vers 1.4 on Windows system? Windows 10? and my bas file?

It's funny, the 2nd is much more complicated with beelines and the room spacing ;-)
« Last Edit: September 16, 2020, 07:57:03 AM by bplus »

#### bplus ##### Re: Meander testing grounds
« Reply #5 on: September 16, 2020, 07:41:59 AM »
Okay the second one works.

does TIME change how much meandering the tunneler does between rooms?

looks pretty good, though it is okay if some rooms are not fully connected, not sure what I would have to change to allow that to happen.

The rooms are fully connected because it is designed to makeup a room at a certain distance from all others, start at that room and "meander" to the next made up room. Some meandering takes place inside other rooms. And yes! most definitely the longer the time the more the meandering, I even said that in a comment.

Meander itself will only go from point A to point B (eventually) regardless of what else is in the way.
You only have to tell meander which 2 points to connect (eventually). You might want to take beeLine out of meander and use your own methods of drawing the path (the LINE statements are still in there commented out).
« Last Edit: September 16, 2020, 07:49:53 AM by bplus »

#### Cobalt

• Forum Resident
• Posts: 639
• At 60 I become highly radioactive! ##### Re: Meander testing grounds
« Reply #6 on: September 16, 2020, 10:24:59 AM »
What is line 5?, HACCEL__? and no way is there 208 lines in main text! WTH are feeding QB64?

Are you using vers 1.4 on Windows system? Windows 10? and my bas file?

It's funny, the 2nd is much more complicated with beelines and the room spacing ;-)

Looking at the translated code it is indeed 208 lines. All that error checking!

But when I tried it this morning all seems good. Something must have been corupted somewhere on my machine last night.

I was working a lot with MEM functions so perhaps I upset something?

The rooms are fully connected because it is designed to makeup a room at a certain distance from all others, start at that room and "meander" to the next made up room. Some meandering takes place inside other rooms. And yes! most definitely the longer the time the more the meandering, I even said that in a comment.

Meander itself will only go from point A to point B (eventually) regardless of what else is in the way.
You only have to tell meander which 2 points to connect (eventually). You might want to take beeLine out of meander and use your own methods of drawing the path (the LINE statements are still in there commented out).

Yeah I have been trying to piece together how to adjust this to work in an array(194,79) but the output looks fairly nice. A lot better than I was getting.

every so often the output is spot on. The only thing might be to give it some 'influence' to meander toward the target room so when it beelines its not so abrupt and straight lined for so long.

But like I said this looks so much better than what I was getting.
Granted after becoming radioactive I only have a half-life!

#### bplus ##### Re: Meander testing grounds
« Reply #7 on: September 16, 2020, 10:33:00 AM »
Quote
every so often the output is spot on. The only thing might be to give it some 'influence' to meander toward the target room so when it beelines its not so abrupt and straight lined for so long.

The dx, (& dy) lines:
Code: QB64: [Select]
1. dx = d * (.4 * distx + 100)
2.

Drop or fiddle with 100 number. If you eliminate completely you could get a number of tiny x the y moves.

I used 100 to get dramatic minimum distance  to move = dx, dy to avoid a RND walk in a 10 pixel radial area.

#### FellippeHeitor ##### Re: Meander testing grounds
« Reply #8 on: September 16, 2020, 10:48:27 AM »
when I try your 1st post code, B+, I get the following:
In file included from qbx.cpp:2208:
..\\temp\\main.txt:208:1: error: 'LABEL_5' does not name a type; did you mean 'HACCEL__'?
LABEL_5:;
^~~~~~~
HACCEL__
compilation terminated due to -Wfatal-errors.

I'll try the second...

All this looks like is Cobalt's finger went to F5 but instead hit a stray '5' after a SUB and generated this error. No labels can occur after SUB/FUNCTION blocks.

So here's how I imagine it:
- Cobalt copies the code from the codebox in the forum.
- He pastes it in the IDE - cursor is now at the end of pasted code, which means it's after the last END SUB
- Cobalt tries to run with F5 - which happens to be just above key 5. Finger slips and hits 5 just before F5.
- A stray 5 label - which gets converted in the C++ code to LABEL_5:; gets added.
- Labels after SUB/FUNCTION blocks are not allowed.
- The c++ compiler tries to find something in the C++ language that kinda resembles LABEL_5:; - compiler's auto-correct at play.
- Then you get the odd error above.

Elementary, Watson.

#### Cobalt

• Forum Resident
• Posts: 639
• At 60 I become highly radioactive! ##### Re: Meander testing grounds
« Reply #9 on: September 16, 2020, 11:03:29 AM »
All this looks like is Cobalt's finger went to F5 but instead hit a stray '5' after a SUB and generated this error. No labels can occur after SUB/FUNCTION blocks.

So here's how I imagine it:
- Cobalt copies the code from the codebox in the forum.
- He pastes it in the IDE - cursor is now at the end of pasted code, which means it's after the last END SUB
- Cobalt tries to run with F5 - which happens to be just above key 5. Finger slips and hits 5 just before F5.
- A stray 5 label - which gets converted in the C++ code to LABEL_5:; gets added.
- Labels after SUB/FUNCTION blocks are not allowed.
- The c++ compiler tries to find something in the C++ language that kinda resembles LABEL_5:; - compiler's auto-correct at play.
- Then you get the odd error above.

Elementary, Watson.

That is possible. the layout on this laptop has the F5 directly above the 5 key. So I could have actually hit both keys at once and it took the 5 before the F5. although I am getting odd errors consistently lately. usually after working with MEM functions. Just posted the latest to Discord. Something Tells me I am misusing MEM or have found a hole somewhere.
Granted after becoming radioactive I only have a half-life!

#### FellippeHeitor ##### Re: Meander testing grounds
« Reply #10 on: September 16, 2020, 11:28:30 AM »
People more knowledgeable of how memory is handled by modern OSes may shed brighter light, but I believe your program will be terminated before it can access memory areas outside of what is allowed for it. I won't advocate for Windows though.

#### bplus ##### Re: Meander testing grounds
« Reply #11 on: September 16, 2020, 11:34:43 AM »
All this looks like is Cobalt's finger went to F5 but instead hit a stray '5' after a SUB and generated this error. No labels can occur after SUB/FUNCTION blocks.

So here's how I imagine it:
- Cobalt copies the code from the codebox in the forum.
- He pastes it in the IDE - cursor is now at the end of pasted code, which means it's after the last END SUB
- Cobalt tries to run with F5 - which happens to be just above key 5. Finger slips and hits 5 just before F5.
- A stray 5 label - which gets converted in the C++ code to LABEL_5:; gets added.
- Labels after SUB/FUNCTION blocks are not allowed.
- The c++ compiler tries to find something in the C++ language that kinda resembles LABEL_5:; - compiler's auto-correct at play.
- Then you get the odd error above.

Elementary, Watson.

Nice work Sherlock! :)

#### bplus ##### Re: Meander testing grounds
« Reply #12 on: September 16, 2020, 06:42:37 PM »
Welcome to the Museum of Meandering Art by bplus:
Code: QB64: [Select]
1. _TITLE "Meander #3 Mod dx dy" ' b+ 2020-09-16   so much better in living color!!
2. SCREEN _NEWIMAGE(1200, 720, 32)
3. _DELAY .25
4. TYPE box
5.
6.     'whole new set
7.     nBoxes = INT(RND * 11) + 10
8.     REDIM b(1 TO nBoxes) AS box 'new box set
9.     FOR i = 1 TO nBoxes
10.         tryAgain:
11.         b(i).x = RND * (_WIDTH - 70) + 35 'get x, y off the edges of screen!
12.         b(i).y = RND * (_HEIGHT - 70) + 35
13.         IF i > 1 THEN
14.             OK = -1
15.             FOR j = 1 TO i - 1
16.                 IF _HYPOT(b(j).x - b(i).x, b(j).y - b(i).y) < 150 THEN OK = 0: EXIT FOR
17.             IF OK = 0 THEN GOTO tryAgain
18.         b(i).w = 50 + RND * 50
19.         b(i).h = 40 + RND * 45
20.         b(i).K = _RGB32(RND * 85 + 170, RND * 85 + 170, RND * 85 + 170)
21.     backColor = _RGB32(RND * 85, RND * 85, RND * 85)
22.     hc = maxC(backColor)
23.     IF hc = 1 THEN beeLineK = _RGB32(0, RND * 170, RND * 170)
24.     IF hc = 2 THEN beeLineK = _RGB32(RND * 170, 0, RND * 170)
25.     IF hc = 3 THEN beeLineK = _RGB32(RND * 170, RND * 170, 0)
26.     COLOR , backColor
27.     FOR i = 2 TO nBoxes '                                  draw the meanderings
28.         meander b(i - 1).x, b(i - 1).y, b(i).x, b(i).y
29.         LINE (b(i).x - b(i).w * .5, b(i).y - b(i).h * .5)-STEP(b(i).w, b(i).h), b(i).K, BF 'draw the boxes
30.         LINE (b(i - 1).x - b(i - 1).w * .5, b(i - 1).y - b(i - 1).h * .5)-STEP(b(i - 1).w, b(i - 1).h), b(i - 1).K, BF 'draw the boxes
31.     FOR i = 1 TO nBoxes
32.         LINE (b(i).x - b(i).w * .5, b(i).y - b(i).h * .5)-STEP(b(i).w, b(i).h), b(i).K, BF 'draw the boxes
33.
34. SUB meander (x1, y1, x2, y2)
35.     startx = x1: starty = y1: endx = x2: endy = y2: minStep = 30
36.     x = startx: y = starty
37.     GOSUB dist
38.     IF dist < 200 THEN
39.         time = INT(RND * 4 + 4) ' total amount allowed to move  The More the time the more the meander!!!!
40.         time = 2
41.     startTime = time '       > 20 is too much!!
42.     IF RND < .5 THEN lastmoveX = 0 ELSE lastmoveX = -1
43.     lastx = startx: lasty = starty
44.         GOSUB dist
45.         IF RND < .5 THEN d = -1 ELSE d = 1
46.         IF lastmoveX = 0 THEN
47.             lastx = x
48.             IF time <= 2 THEN
49.                 x = endx
50.                 dx = INT(d * (.4 * distx * RND + minStep) * minStep) / minStep
51.                 IF dx = 0 THEN dx = minStep
52.                 IF x + dx > 0 AND x + dx < _WIDTH THEN
53.                     x = x + dx
54.                     x = x + -dx
55.             x = INT(x * minStep) / minStep
56.             'LINE (lastx, y)-(x, y)
57.             beeline lastx, y, x, y
58.             lastmoveX = -1
59.             lasty = y
60.             IF time <= 2 THEN
61.                 y = endy
62.                 dy = INT(d * (.3 * disty * RND + minStep) * minStep) / minStep
63.                 IF dy = 0 THEN dy = minStep
64.                 IF y + dy > 0 AND y + dy < _HEIGHT THEN
65.                     y = y + dy
66.                     y = y + -dy
67.             y = INT(y * minStep) / minStep
68.             'LINE (x, lasty)-(x, y)
69.             beeline x, lasty, x, y
70.             lastmoveX = 0
71.         time = time - 1
72.         '_LIMIT 10
73.     LOOP UNTIL time <= 0 OR _KEYDOWN(27)
74.     dist:
75.     distx = endx - x: disty = endy - y
76.
77. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
80.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
81.     LINE (CX - X, CY)-(CX + X, CY), C, BF
82.     WHILE X > Y
84.         IF RadiusError >= 0 THEN
85.             IF X <> Y + 1 THEN
86.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
87.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
88.             X = X - 1
90.         Y = Y + 1
91.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
92.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
93.
94. SUB beeline (x1, y1, x2, y2)
95.     IF x1 = x2 THEN
96.         IF y1 <= y2 THEN FOR y = y1 TO y2: fcirc x1, y, 4, beeLineK: NEXT
97.         IF y1 > y2 THEN FOR y = y1 TO y2 STEP -1: fcirc x1, y, 4, beeLineK: NEXT
98.         IF x1 <= x2 THEN FOR x = x1 TO x2: fcirc x, y1, 4, beeLineK: NEXT
99.         IF x1 > x2 THEN FOR x = x1 TO x2 STEP -1: fcirc x, y1, 4, beeLineK: NEXT
100.
101.     IF _RED32(K) >= _GREEN32(K) AND _RED32(K) >= _BLUE32(K) THEN maxC = 1: EXIT FUNCTION
102.     IF _GREEN32(K) >= _BLUE(K) THEN maxC = 2 ELSE maxC = 3
103.
104.

EDIT: trying to get more contrast between background and "wiring" to rectangular lights.

hmm... if Q key or escape fail there is always alt+ F4
« Last Edit: September 16, 2020, 07:59:55 PM by bplus »

#### bplus ##### Re: Meander testing grounds
« Reply #13 on: September 17, 2020, 12:34:30 PM »
Here is what I was wanting to get yesterday, Snap to Grid! and the escape and Q key presses are responding better now:
Code: QB64: [Select]
1. _TITLE "Snapping to a Grid, press any for next grid" ' b+ 2020-09-17   so much better in living color!!
2. ' ah much better response on on escape or Q to quit! too.
3.
4. SCREEN _NEWIMAGE(1024, 620, 32)
5. _DELAY .25
6. '_SCREENMOVE _MIDDLE
7.
8. TYPE box
9. DIM SHARED beeLineK AS _UNSIGNED LONG, gSize AS INTEGER
10.
11. 'test drawGrid
12. 'drawGrid 0, 0, _WIDTH - 1, _HEIGHT - 1, 50, &HFFFFFF00 'crap don't forget screen width and height start at 0
13. 'LINE (0 + 1, 0 + 1)-(_WIDTH - 1, _HEIGHT - 1), &HFF0000FF, B
14. 'SLEEP
15. 'DO
16. '    CLS
17. '    x1 = RND * (_WIDTH - 200): y1 = RND * (_HEIGHT - 200)
18. '    x2 = x1 + (_WIDTH - 1 - x1) * RND: y2 = y1 + RND * (_HEIGHT - 1 - y1)
19. '    LINE (x1 + 1, y1 + 1)-(x2 - 1, y2 - 1), &HFF0000FF, B
20. '    PRINT x1, y1, x2, y2
21. '    drawGrid x1, y1, x2, y2, 50, &HFFFFFF00
22. '    SLEEP
23. 'LOOP
24. 'END
25.
26. DIM backColor AS _UNSIGNED LONG, hc AS INTEGER
27.     'whole new set
28.     gSize = units(INT(40 * RND) + 11, 5)
29.     nBoxes = INT(SQR(_WIDTH * _HEIGHT) / gSize * RND) + 1
30.     IF nBoxes < 15 THEN nBoxes = 15
31.     IF nBoxes > 100 THEN nBoxes = 100
32.     COLOR &HFFFFFFFF, &HFF000000
33.     PRINT gSize, nBoxes
34.     REDIM b(1 TO nBoxes) AS box 'new box set
35.     FOR i = 1 TO nBoxes
36.         tryAgain:
37.         b(i).x = units(RND * (_WIDTH - 2 * (gSize + 1)) + gSize + 1, gSize) 'get x, y off the edges of screen!
38.         b(i).y = units(RND * (_HEIGHT - 2 * (gSize + 1)) + gSize + 1, gSize)
39.         IF i > 1 THEN
40.             OK = -1
41.             FOR j = 1 TO i - 1
42.                 IF _HYPOT(b(j).x - b(i).x, b(j).y - b(i).y) < 3 * gSize THEN OK = 0: EXIT FOR
43.             IF OK = 0 THEN GOTO tryAgain
44.         b(i).w = gSize + RND * gSize * .5
45.         b(i).h = gSize + RND * gSize * .5
46.         b(i).K = _RGB32(RND * 85 + 170, RND * 85 + 170, RND * 85 + 170)
47.     backColor = _RGB32(RND * 65, RND * 65, RND * 65)
48.     hc = maxC(backColor)
49.     IF hc = 1 THEN beeLineK = _RGB32(0, RND * 85 + 85, RND * 85 + 85)
50.     IF hc = 2 THEN beeLineK = _RGB32(RND * 85 + 85, 0, RND * 85 + 85)
51.     IF hc = 3 THEN beeLineK = _RGB32(RND * 85 + 85, RND * 85 + 85, 0)
52.     COLOR , backColor
53.     drawGrid gSize, gSize, _WIDTH - 1, _HEIGHT - 1, gSize, &HFF404040
54.     'SLEEP
55.     FOR i = 2 TO nBoxes '                                  draw the meanderings
56.         meander2 b(i - 1).x, b(i - 1).y, b(i).x, b(i).y
57.         LINE (b(i).x - b(i).w * .5, b(i).y - b(i).h * .5)-STEP(b(i).w, b(i).h), b(i).K, BF 'draw the boxes
58.         LINE (b(i - 1).x - b(i - 1).w * .5, b(i - 1).y - b(i - 1).h * .5)-STEP(b(i - 1).w, b(i - 1).h), b(i - 1).K, BF 'draw the boxes
59.     FOR i = 1 TO nBoxes
60.         LINE (b(i).x - b(i).w * .5, b(i).y - b(i).h * .5)-STEP(b(i).w, b(i).h), b(i).K, BF 'draw the boxes
61.     COLOR &HFFFFFFFF, background
62.     PRINT "Press any for next screen, escape or q to quit..."
63.
64. SUB meander2 (x1, y1, x2, y2) ' snap to grid!   gSize is shared
65.     startx = x1: starty = y1: endx = x2: endy = y2
66.     x = startx: y = starty
67.     GOSUB dist
68.     IF dist > 100 THEN
69.         time = INT(RND * 8 + 4) ' total amount allowed to move  The More the time the more the meander!!!!
70.         time = 3
71.     startTime = time '       > 20 is too much!!
72.     IF RND < .5 THEN lastmoveX = 0 ELSE lastmoveX = -1
73.     lastx = startx: lasty = starty
74.         GOSUB dist
75.         IF RND < .5 THEN d = -1 ELSE d = 1
76.         IF lastmoveX = 0 THEN
77.             lastx = x
78.             IF time <= 2 THEN
79.                 x = endx
80.                 dx = units(d * (.4 * distx * RND + gSize), gSize)
81.                 IF dx = 0 THEN dx = gSize
82.                 IF x + dx > 0 AND x + dx < _WIDTH THEN
83.                     x = x + dx
84.                     x = x + -dx
85.             'LINE (lastx, y)-(x, y)
86.             beeline lastx, y, x, y
87.             lastmoveX = -1
88.             lasty = y
89.             IF time <= 2 THEN
90.                 y = endy
91.                 dy = units(d * (.3 * disty * RND + gSize), gSize)
92.                 IF dy = 0 THEN dy = gSize
93.                 IF y + dy > 0 AND y + dy < _HEIGHT THEN
94.                     y = y + dy
95.                     y = y + -dy
96.             'LINE (x, lasty)-(x, y)
97.             beeline x, lasty, x, y
98.             lastmoveX = 0
99.         time = time - 1
100.         '_LIMIT 10
101.     LOOP UNTIL time <= 0
102.     dist:
103.     distx = endx - x: disty = endy - y
104.
105. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
108.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
109.     LINE (CX - X, CY)-(CX + X, CY), C, BF
110.     WHILE X > Y
112.         IF RadiusError >= 0 THEN
113.             IF X <> Y + 1 THEN
114.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
115.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
116.             X = X - 1
118.         Y = Y + 1
119.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
120.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
121.
122. SUB beeline (x1, y1, x2, y2)
123.     IF x1 = x2 THEN
124.         IF y1 <= y2 THEN FOR y = y1 TO y2: fcirc x1, y, 2, beeLineK: NEXT
125.         IF y1 > y2 THEN FOR y = y1 TO y2 STEP -1: fcirc x1, y, 2, beeLineK: NEXT
126.         IF x1 <= x2 THEN FOR x = x1 TO x2: fcirc x, y1, 2, beeLineK: NEXT
127.         IF x1 > x2 THEN FOR x = x1 TO x2 STEP -1: fcirc x, y1, 2, beeLineK: NEXT
128.
129.     IF _RED32(K) >= _GREEN32(K) AND _RED32(K) >= _BLUE32(K) THEN maxC = 1: EXIT FUNCTION
130.     IF _GREEN32(K) >= _BLUE(K) THEN maxC = 2 ELSE maxC = 3
131.
132. ' this sub needs FUNCTION units (x, unit)
133. SUB drawGrid (x1, y1, x2, y2, gsize, gridClr AS _UNSIGNED LONG) ' grid of square gsize X gsize
134.     ' fit a grid between x1, x2 and  y1, y2
135.     ' x1, y1 top right corner and x2, y2 expected bottom right corner of boundary line
136.
137.     DIM x AS INTEGER, y AS INTEGER, gx1 AS INTEGER, gy1 AS INTEGER, gx2 AS INTEGER, gy2 AS INTEGER
138.     gx1 = units(x1, gsize): gy1 = units(y1, gsize) 'convert to grid coordinates
139.     gx2 = units(x2, gsize): gy2 = units(y2, gsize)
140.     IF gx1 < x1 THEN gx1 = gx1 + gsize 'stay inside boundarys passed to sub
141.     IF gy1 < y1 THEN gy1 = gy1 + gsize
142.     IF gx1 >= gx2 OR gy1 >= gy2 THEN EXIT SUB 'that's not even a single square!
143.     FOR x = gx1 TO gx2 STEP gsize: LINE (x, gy1)-(x, gy2), gridClr: NEXT
144.     FOR y = gy1 TO gy2 STEP gsize: LINE (gx1, y)-(gx2, y), gridClr: NEXT
145.
146. FUNCTION units (x, unit)
147.     units = INT(x / unit) * unit
148.
149.
150.

#### Cobalt

• Forum Resident
• Posts: 639
• At 60 I become highly radioactive! ##### Re: Meander testing grounds
« Reply #14 on: September 17, 2020, 02:22:01 PM »
I have created a monster....

Seriously though, Thanks for the help. gets me a lot closer to the look and feel I wanted.
Granted after becoming radioactive I only have a half-life!