Author Topic: Meander testing grounds  (Read 375 times)

Offline bplus

  • Forum Resident
  • Posts: 5004
  • B+ Knot again!
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.     DO
  18.         dist
  19.         IF RND < .5 THEN d = -1 ELSE d = 1
  20.         IF lastmoveX = 0 THEN
  21.             lastx = x
  22.             IF time <= 3 THEN
  23.                 x = endx
  24.             ELSE
  25.                 dx = d * (.4 * distx + 5)
  26.                 IF x + dx > 0 AND x + dx < _WIDTH THEN
  27.                     x = x + dx
  28.                 ELSE
  29.                     x = x + -dx
  30.                 END IF
  31.             END IF
  32.             LINE (lastx, y)-(x, y)
  33.             lastmoveX = -1
  34.         ELSE
  35.             lasty = y
  36.             IF time <= 3 THEN
  37.                 y = endy
  38.             ELSE
  39.                 dy = d * (.3 * disty + 5)
  40.                 IF y + dy > 0 AND y + dy < _HEIGHT THEN
  41.                     y = y + dy
  42.                 ELSE
  43.                     y = y + -dy
  44.                 END IF
  45.             END IF
  46.             LINE (x, lasty)-(x, y)
  47.             lastmoveX = 0
  48.         END IF
  49.         time = time - 1
  50.         _LIMIT 10
  51.     LOOP UNTIL time <= 0 OR _KEYDOWN(27)
  52.     CLS
  53.  
  54. SUB dist
  55.     distx = endx - x: disty = endy - y
  56.  
  57.  

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

Offline bplus

  • Forum Resident
  • Posts: 5004
  • B+ Knot again!
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.         NEXT
  18.         IF OK = 0 THEN GOTO tryAgain
  19.         xx(i) = x2: yy(i) = y2
  20.         w2 = RND * .1 * _WIDTH + 36: h2 = RND * .1 * _HEIGHT + 21
  21.         LINE (x2 - .5 * w2, y2 - .5 * h2)-STEP(w2, h2), , BF '_RGB32(RND * 200 + 55, RND * 200 + 55, RND * 200 + 55), BF
  22.         meander x, y, x2, y2
  23.         x = x2: y = y2: w = w2: h = h2
  24.     NEXT
  25.     _DELAY 2
  26.     CLS
  27.  
  28. SUB meander (x1, y1, x2, y2)
  29.     startx = x1: starty = y1: endx = x2: endy = y2
  30.     x = startx: y = starty
  31.     GOSUB dist
  32.     IF distx + disty > 140 THEN
  33.         time = INT(RND * 6 + 4) ' total amount allowed to move  The More the time the more the meander!!!!
  34.     ELSE
  35.         time = 3
  36.     END IF
  37.     meanderTime = time '       > 20 is too much!!
  38.     IF RND < .5 THEN lastmoveX = 0 ELSE lastmoveX = -1
  39.     lastx = startx: lasty = starty
  40.     DO
  41.         GOSUB dist
  42.         IF RND < .5 THEN d = -1 ELSE d = 1
  43.         IF lastmoveX = 0 THEN
  44.             lastx = x
  45.             IF time <= 3 THEN
  46.                 x = endx
  47.             ELSE
  48.                 dx = d * (.4 * distx + 100)
  49.                 IF x + dx > 0 AND x + dx < _WIDTH THEN
  50.                     x = x + dx
  51.                 ELSE
  52.                     x = x + -dx
  53.                 END IF
  54.             END IF
  55.             'LINE (lastx, y)-(x, y)
  56.             beeline lastx, y, x, y
  57.             lastmoveX = -1
  58.         ELSE
  59.             lasty = y
  60.             IF time <= 3 THEN
  61.                 y = endy
  62.             ELSE
  63.                 dy = d * (.3 * disty + 100)
  64.                 IF y + dy > 0 AND y + dy < _HEIGHT THEN
  65.                     y = y + dy
  66.                 ELSE
  67.                     y = y + -dy
  68.                 END IF
  69.             END IF
  70.             'LINE (x, lasty)-(x, y)
  71.             beeline x, lasty, x, y
  72.             lastmoveX = 0
  73.         END IF
  74.         time = time - 1
  75.         _LIMIT 10
  76.     LOOP UNTIL time <= 0 OR _KEYDOWN(27)
  77.     EXIT SUB
  78.     dist:
  79.     distx = endx - x: disty = endy - y
  80.     RETURN
  81.  
  82. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  83.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  84.     DIM X AS INTEGER, Y AS INTEGER
  85.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
  86.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  87.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  88.     WHILE X > Y
  89.         RadiusError = RadiusError + Y * 2 + 1
  90.         IF RadiusError >= 0 THEN
  91.             IF X <> Y + 1 THEN
  92.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  93.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  94.             END IF
  95.             X = X - 1
  96.             RadiusError = RadiusError - X * 2
  97.         END IF
  98.         Y = Y + 1
  99.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  100.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  101.     WEND
  102.  
  103. SUB beeline (x1, y1, x2, y2)
  104.     IF x1 = x2 THEN
  105.         IF y1 <= y2 THEN FOR y = y1 TO y2: fcirc x1, y, 4, &HFF000000: NEXT
  106.         IF y1 > y2 THEN FOR y = y1 TO y2 STEP -1: fcirc x1, y, 4, &HFF000000: NEXT
  107.     ELSE
  108.         IF x1 <= x2 THEN FOR x = x1 TO x2: fcirc x, y1, 4, &HFF000000: NEXT
  109.         IF x1 > x2 THEN FOR x = x1 TO x2 STEP -1: fcirc x, y1, 4, &HFF000000: NEXT
  110.     END IF

Offline 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!

Offline 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!

Offline bplus

  • Forum Resident
  • Posts: 5004
  • B+ Knot again!
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 »

Offline bplus

  • Forum Resident
  • Posts: 5004
  • B+ Knot again!
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 »

Offline 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!

Offline bplus

  • Forum Resident
  • Posts: 5004
  • B+ Knot again!
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.

Offline FellippeHeitor

  • QB64 Developer
  • Forum Resident
  • Posts: 2315
  • LET IT = BE
    • QB64.org
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.

Offline 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!

Offline FellippeHeitor

  • QB64 Developer
  • Forum Resident
  • Posts: 2315
  • LET IT = BE
    • QB64.org
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.

Offline bplus

  • Forum Resident
  • Posts: 5004
  • B+ Knot again!
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! :)

Offline bplus

  • Forum Resident
  • Posts: 5004
  • B+ Knot again!
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.     x AS SINGLE
  6.     y AS SINGLE
  7.     w AS SINGLE
  8.     h AS SINGLE
  9.     K AS _UNSIGNED LONG
  10.  
  11.     'whole new set
  12.     nBoxes = INT(RND * 11) + 10
  13.     REDIM b(1 TO nBoxes) AS box 'new box set
  14.     FOR i = 1 TO nBoxes
  15.         tryAgain:
  16.         b(i).x = RND * (_WIDTH - 70) + 35 'get x, y off the edges of screen!
  17.         b(i).y = RND * (_HEIGHT - 70) + 35
  18.         IF i > 1 THEN
  19.             OK = -1
  20.             FOR j = 1 TO i - 1
  21.                 IF _HYPOT(b(j).x - b(i).x, b(j).y - b(i).y) < 150 THEN OK = 0: EXIT FOR
  22.             NEXT
  23.             IF OK = 0 THEN GOTO tryAgain
  24.         END IF
  25.         b(i).w = 50 + RND * 50
  26.         b(i).h = 40 + RND * 45
  27.         b(i).K = _RGB32(RND * 85 + 170, RND * 85 + 170, RND * 85 + 170)
  28.     NEXT
  29.     backColor = _RGB32(RND * 85, RND * 85, RND * 85)
  30.     hc = maxC(backColor)
  31.     IF hc = 1 THEN beeLineK = _RGB32(0, RND * 170, RND * 170)
  32.     IF hc = 2 THEN beeLineK = _RGB32(RND * 170, 0, RND * 170)
  33.     IF hc = 3 THEN beeLineK = _RGB32(RND * 170, RND * 170, 0)
  34.     COLOR , backColor
  35.     CLS
  36.     FOR i = 2 TO nBoxes '                                  draw the meanderings
  37.         meander b(i - 1).x, b(i - 1).y, b(i).x, b(i).y
  38.         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
  39.         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
  40.     NEXT
  41.     FOR i = 1 TO nBoxes
  42.         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
  43.     NEXT
  44.     _DISPLAY
  45.     _DELAY 5
  46.  
  47. SUB meander (x1, y1, x2, y2)
  48.     startx = x1: starty = y1: endx = x2: endy = y2: minStep = 30
  49.     x = startx: y = starty
  50.     GOSUB dist
  51.     IF dist < 200 THEN
  52.         time = INT(RND * 4 + 4) ' total amount allowed to move  The More the time the more the meander!!!!
  53.     ELSE
  54.         time = 2
  55.     END IF
  56.     startTime = time '       > 20 is too much!!
  57.     IF RND < .5 THEN lastmoveX = 0 ELSE lastmoveX = -1
  58.     lastx = startx: lasty = starty
  59.     DO
  60.         GOSUB dist
  61.         IF RND < .5 THEN d = -1 ELSE d = 1
  62.         IF lastmoveX = 0 THEN
  63.             lastx = x
  64.             IF time <= 2 THEN
  65.                 x = endx
  66.             ELSE
  67.                 dx = INT(d * (.4 * distx * RND + minStep) * minStep) / minStep
  68.                 IF dx = 0 THEN dx = minStep
  69.                 IF x + dx > 0 AND x + dx < _WIDTH THEN
  70.                     x = x + dx
  71.                 ELSE
  72.                     x = x + -dx
  73.                 END IF
  74.             END IF
  75.             x = INT(x * minStep) / minStep
  76.             'LINE (lastx, y)-(x, y)
  77.             beeline lastx, y, x, y
  78.             lastmoveX = -1
  79.         ELSE
  80.             lasty = y
  81.             IF time <= 2 THEN
  82.                 y = endy
  83.             ELSE
  84.                 dy = INT(d * (.3 * disty * RND + minStep) * minStep) / minStep
  85.                 IF dy = 0 THEN dy = minStep
  86.                 IF y + dy > 0 AND y + dy < _HEIGHT THEN
  87.                     y = y + dy
  88.                 ELSE
  89.                     y = y + -dy
  90.                 END IF
  91.             END IF
  92.             y = INT(y * minStep) / minStep
  93.             'LINE (x, lasty)-(x, y)
  94.             beeline x, lasty, x, y
  95.             lastmoveX = 0
  96.         END IF
  97.         time = time - 1
  98.         '_LIMIT 10
  99.     LOOP UNTIL time <= 0 OR _KEYDOWN(27)
  100.     EXIT SUB
  101.     dist:
  102.     distx = endx - x: disty = endy - y
  103.     RETURN
  104.  
  105. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  106.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  107.     DIM X AS INTEGER, Y AS INTEGER
  108.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
  109.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  110.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  111.     WHILE X > Y
  112.         RadiusError = RadiusError + Y * 2 + 1
  113.         IF RadiusError >= 0 THEN
  114.             IF X <> Y + 1 THEN
  115.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  116.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  117.             END IF
  118.             X = X - 1
  119.             RadiusError = RadiusError - X * 2
  120.         END IF
  121.         Y = Y + 1
  122.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  123.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  124.     WEND
  125.  
  126. SUB beeline (x1, y1, x2, y2)
  127.     IF x1 = x2 THEN
  128.         IF y1 <= y2 THEN FOR y = y1 TO y2: fcirc x1, y, 4, beeLineK: NEXT
  129.         IF y1 > y2 THEN FOR y = y1 TO y2 STEP -1: fcirc x1, y, 4, beeLineK: NEXT
  130.     ELSE
  131.         IF x1 <= x2 THEN FOR x = x1 TO x2: fcirc x, y1, 4, beeLineK: NEXT
  132.         IF x1 > x2 THEN FOR x = x1 TO x2 STEP -1: fcirc x, y1, 4, beeLineK: NEXT
  133.     END IF
  134.  
  135.     IF _RED32(K) >= _GREEN32(K) AND _RED32(K) >= _BLUE32(K) THEN maxC = 1: EXIT FUNCTION
  136.     IF _GREEN32(K) >= _BLUE(K) THEN maxC = 2 ELSE maxC = 3
  137.  
  138.  

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 »

Offline bplus

  • Forum Resident
  • Posts: 5004
  • B+ Knot again!
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.     x AS SINGLE
  10.     y AS SINGLE
  11.     w AS SINGLE
  12.     h AS SINGLE
  13.     K AS _UNSIGNED LONG
  14. DIM SHARED beeLineK AS _UNSIGNED LONG, gSize AS INTEGER
  15.  
  16. 'test drawGrid
  17. 'drawGrid 0, 0, _WIDTH - 1, _HEIGHT - 1, 50, &HFFFFFF00 'crap don't forget screen width and height start at 0
  18. 'LINE (0 + 1, 0 + 1)-(_WIDTH - 1, _HEIGHT - 1), &HFF0000FF, B
  19. 'SLEEP
  20. 'DO
  21. '    CLS
  22. '    x1 = RND * (_WIDTH - 200): y1 = RND * (_HEIGHT - 200)
  23. '    x2 = x1 + (_WIDTH - 1 - x1) * RND: y2 = y1 + RND * (_HEIGHT - 1 - y1)
  24. '    LINE (x1 + 1, y1 + 1)-(x2 - 1, y2 - 1), &HFF0000FF, B
  25. '    PRINT x1, y1, x2, y2
  26. '    drawGrid x1, y1, x2, y2, 50, &HFFFFFF00
  27. '    SLEEP
  28. 'LOOP
  29. 'END
  30.  
  31. DIM backColor AS _UNSIGNED LONG, hc AS INTEGER
  32.     'whole new set
  33.     gSize = units(INT(40 * RND) + 11, 5)
  34.     nBoxes = INT(SQR(_WIDTH * _HEIGHT) / gSize * RND) + 1
  35.     IF nBoxes < 15 THEN nBoxes = 15
  36.     IF nBoxes > 100 THEN nBoxes = 100
  37.     COLOR &HFFFFFFFF, &HFF000000
  38.     PRINT gSize, nBoxes
  39.     _DISPLAY
  40.     REDIM b(1 TO nBoxes) AS box 'new box set
  41.     FOR i = 1 TO nBoxes
  42.         tryAgain:
  43.         b(i).x = units(RND * (_WIDTH - 2 * (gSize + 1)) + gSize + 1, gSize) 'get x, y off the edges of screen!
  44.         b(i).y = units(RND * (_HEIGHT - 2 * (gSize + 1)) + gSize + 1, gSize)
  45.         IF i > 1 THEN
  46.             OK = -1
  47.             FOR j = 1 TO i - 1
  48.                 IF _HYPOT(b(j).x - b(i).x, b(j).y - b(i).y) < 3 * gSize THEN OK = 0: EXIT FOR
  49.             NEXT
  50.             IF OK = 0 THEN GOTO tryAgain
  51.         END IF
  52.         b(i).w = gSize + RND * gSize * .5
  53.         b(i).h = gSize + RND * gSize * .5
  54.         b(i).K = _RGB32(RND * 85 + 170, RND * 85 + 170, RND * 85 + 170)
  55.     NEXT
  56.     backColor = _RGB32(RND * 65, RND * 65, RND * 65)
  57.     hc = maxC(backColor)
  58.     IF hc = 1 THEN beeLineK = _RGB32(0, RND * 85 + 85, RND * 85 + 85)
  59.     IF hc = 2 THEN beeLineK = _RGB32(RND * 85 + 85, 0, RND * 85 + 85)
  60.     IF hc = 3 THEN beeLineK = _RGB32(RND * 85 + 85, RND * 85 + 85, 0)
  61.     COLOR , backColor
  62.     CLS
  63.     drawGrid gSize, gSize, _WIDTH - 1, _HEIGHT - 1, gSize, &HFF404040
  64.     'SLEEP
  65.     FOR i = 2 TO nBoxes '                                  draw the meanderings
  66.         meander2 b(i - 1).x, b(i - 1).y, b(i).x, b(i).y
  67.         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
  68.         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
  69.     NEXT
  70.     FOR i = 1 TO nBoxes
  71.         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
  72.     NEXT
  73.     COLOR &HFFFFFFFF, background
  74.     PRINT "Press any for next screen, escape or q to quit..."
  75.     _DISPLAY
  76.     SLEEP
  77.  
  78. SUB meander2 (x1, y1, x2, y2) ' snap to grid!   gSize is shared
  79.     startx = x1: starty = y1: endx = x2: endy = y2
  80.     x = startx: y = starty
  81.     GOSUB dist
  82.     IF dist > 100 THEN
  83.         time = INT(RND * 8 + 4) ' total amount allowed to move  The More the time the more the meander!!!!
  84.     ELSE
  85.         time = 3
  86.     END IF
  87.     startTime = time '       > 20 is too much!!
  88.     IF RND < .5 THEN lastmoveX = 0 ELSE lastmoveX = -1
  89.     lastx = startx: lasty = starty
  90.     DO
  91.         GOSUB dist
  92.         IF RND < .5 THEN d = -1 ELSE d = 1
  93.         IF lastmoveX = 0 THEN
  94.             lastx = x
  95.             IF time <= 2 THEN
  96.                 x = endx
  97.             ELSE
  98.                 dx = units(d * (.4 * distx * RND + gSize), gSize)
  99.                 IF dx = 0 THEN dx = gSize
  100.                 IF x + dx > 0 AND x + dx < _WIDTH THEN
  101.                     x = x + dx
  102.                 ELSE
  103.                     x = x + -dx
  104.                 END IF
  105.             END IF
  106.             'LINE (lastx, y)-(x, y)
  107.             beeline lastx, y, x, y
  108.             lastmoveX = -1
  109.         ELSE
  110.             lasty = y
  111.             IF time <= 2 THEN
  112.                 y = endy
  113.             ELSE
  114.                 dy = units(d * (.3 * disty * RND + gSize), gSize)
  115.                 IF dy = 0 THEN dy = gSize
  116.                 IF y + dy > 0 AND y + dy < _HEIGHT THEN
  117.                     y = y + dy
  118.                 ELSE
  119.                     y = y + -dy
  120.                 END IF
  121.             END IF
  122.             'LINE (x, lasty)-(x, y)
  123.             beeline x, lasty, x, y
  124.             lastmoveX = 0
  125.         END IF
  126.         time = time - 1
  127.         '_LIMIT 10
  128.     LOOP UNTIL time <= 0
  129.     EXIT SUB
  130.     dist:
  131.     distx = endx - x: disty = endy - y
  132.     RETURN
  133.  
  134. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  135.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  136.     DIM X AS INTEGER, Y AS INTEGER
  137.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
  138.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  139.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  140.     WHILE X > Y
  141.         RadiusError = RadiusError + Y * 2 + 1
  142.         IF RadiusError >= 0 THEN
  143.             IF X <> Y + 1 THEN
  144.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  145.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  146.             END IF
  147.             X = X - 1
  148.             RadiusError = RadiusError - X * 2
  149.         END IF
  150.         Y = Y + 1
  151.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  152.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  153.     WEND
  154.  
  155. SUB beeline (x1, y1, x2, y2)
  156.     IF x1 = x2 THEN
  157.         IF y1 <= y2 THEN FOR y = y1 TO y2: fcirc x1, y, 2, beeLineK: NEXT
  158.         IF y1 > y2 THEN FOR y = y1 TO y2 STEP -1: fcirc x1, y, 2, beeLineK: NEXT
  159.     ELSE
  160.         IF x1 <= x2 THEN FOR x = x1 TO x2: fcirc x, y1, 2, beeLineK: NEXT
  161.         IF x1 > x2 THEN FOR x = x1 TO x2 STEP -1: fcirc x, y1, 2, beeLineK: NEXT
  162.     END IF
  163.  
  164.     IF _RED32(K) >= _GREEN32(K) AND _RED32(K) >= _BLUE32(K) THEN maxC = 1: EXIT FUNCTION
  165.     IF _GREEN32(K) >= _BLUE(K) THEN maxC = 2 ELSE maxC = 3
  166.  
  167. ' this sub needs FUNCTION units (x, unit)
  168. SUB drawGrid (x1, y1, x2, y2, gsize, gridClr AS _UNSIGNED LONG) ' grid of square gsize X gsize
  169.     ' fit a grid between x1, x2 and  y1, y2
  170.     ' x1, y1 top right corner and x2, y2 expected bottom right corner of boundary line
  171.  
  172.     DIM x AS INTEGER, y AS INTEGER, gx1 AS INTEGER, gy1 AS INTEGER, gx2 AS INTEGER, gy2 AS INTEGER
  173.     gx1 = units(x1, gsize): gy1 = units(y1, gsize) 'convert to grid coordinates
  174.     gx2 = units(x2, gsize): gy2 = units(y2, gsize)
  175.     IF gx1 < x1 THEN gx1 = gx1 + gsize 'stay inside boundarys passed to sub
  176.     IF gy1 < y1 THEN gy1 = gy1 + gsize
  177.     IF gx1 >= gx2 OR gy1 >= gy2 THEN EXIT SUB 'that's not even a single square!
  178.     FOR x = gx1 TO gx2 STEP gsize: LINE (x, gy1)-(x, gy2), gridClr: NEXT
  179.     FOR y = gy1 TO gy2 STEP gsize: LINE (gx1, y)-(gx2, y), gridClr: NEXT
  180.  
  181. FUNCTION units (x, unit)
  182.     units = INT(x / unit) * unit
  183.  
  184.  
  185.  

 

Offline 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!