Author Topic: Meander testing grounds (Read 6882 times)

bplus · « **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]

_TITLE "Meander ProtoType for Cobolt Problem" ' b+ 2020-09-15
SCREEN _NEWIMAGE(800, 600, 32)
_DELAY .25
_SCREENMOVE _MIDDLE
RANDOMIZE TIMER
DIM SHARED distx, disty, endx, endy, x, y
 
startx = 10: starty = 10: endx = 790: endy = 590
DO
    x = startx: y = starty
    dist
    time = INT(RND * 16 + 4) ' total amoount allowed to move  The More the time the more the meander!!!!
    meanderTime = time '       > 20 is too much!!
    _PRINTSTRING (10, _HEIGHT - 20), " Meander:" + STR$(meanderTime)
    LINE (startx, starty)-STEP(4, 4), &HFFFF000, BF
    LINE (endx, endy)-STEP(4, 4), &HFF0000FF, BF
    IF RND < .5 THEN lastmoveX = 0 ELSE lastmoveX = -1
    lastx = startx
    lasty = starty
    DO
        dist
        IF RND < .5 THEN d = -1 ELSE d = 1
        IF lastmoveX = 0 THEN
            lastx = x
            IF time <= 3 THEN
                x = endx
            ELSE
                dx = d * (.4 * distx + 5)
                IF x + dx > 0 AND x + dx < _WIDTH THEN
                    x = x + dx
                ELSE
                    x = x + -dx
                END IF
            END IF
            LINE (lastx, y)-(x, y)
            lastmoveX = -1
        ELSE
            lasty = y
            IF time <= 3 THEN
                y = endy
            ELSE
                dy = d * (.3 * disty + 5)
                IF y + dy > 0 AND y + dy < _HEIGHT THEN
                    y = y + dy
                ELSE
                    y = y + -dy
                END IF
            END IF
            LINE (x, lasty)-(x, y)
            lastmoveX = 0
        END IF
        time = time - 1
        _LIMIT 10
    LOOP UNTIL time <= 0 OR _KEYDOWN(27)
    CLS
LOOP UNTIL _KEYDOWN(27)
 
SUB dist
    distx = endx - x: disty = endy - y
END SUB
 
 

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

bplus · « **Reply #1 on:** September 15, 2020, 11:15:13 pm »

Code: QB64: [Select]

_TITLE "Meander #2 the SUB" ' b+ 2020-09-15
SCREEN _NEWIMAGE(1200, 720, 32)
_DELAY .25
_SCREENMOVE _MIDDLE
RANDOMIZE TIMER
DIM SHARED distx, disty, endx, endy, x, y
 
nboxes = 20
DO
    COLOR &HFF000000, &HFF882200: CLS
    REDIM xx(nboxes), yy(nboxes)
    x = RND * _WIDTH: y = RND * _HEIGHT: w = RND * .1 * _WIDTH + 36: h = RND * .1 * _HEIGHT + 21
    LINE (x - .5 * w, y - .5 * h)-STEP(w, h), , BF ' _RGB32(RND * 200 + 55, RND * 200 + 55, RND * 200 + 55), BF
    xx(1) = x: yy(1) = y: b = 1
    FOR i = 2 TO nboxes
        tryAgain:
        x2 = RND * _WIDTH: y2 = RND * _HEIGHT: OK = -1
        FOR j = 1 TO i - 1
            IF _HYPOT(xx(j) - x2, yy(j) - y2) < 150 THEN OK = 0: EXIT FOR
        NEXT
        IF OK = 0 THEN GOTO tryAgain
        xx(i) = x2: yy(i) = y2
        w2 = RND * .1 * _WIDTH + 36: h2 = RND * .1 * _HEIGHT + 21
        LINE (x2 - .5 * w2, y2 - .5 * h2)-STEP(w2, h2), , BF '_RGB32(RND * 200 + 55, RND * 200 + 55, RND * 200 + 55), BF
        meander x, y, x2, y2
        x = x2: y = y2: w = w2: h = h2
    NEXT
    _DELAY 2
    CLS
LOOP
 
SUB meander (x1, y1, x2, y2)
    startx = x1: starty = y1: endx = x2: endy = y2
    x = startx: y = starty
    GOSUB dist
    IF distx + disty > 140 THEN
        time = INT(RND * 6 + 4) ' total amount allowed to move  The More the time the more the meander!!!!
    ELSE
        time = 3
    END IF
    meanderTime = time '       > 20 is too much!!
    IF RND < .5 THEN lastmoveX = 0 ELSE lastmoveX = -1
    lastx = startx: lasty = starty
    DO
        GOSUB dist
        IF RND < .5 THEN d = -1 ELSE d = 1
        IF lastmoveX = 0 THEN
            lastx = x
            IF time <= 3 THEN
                x = endx
            ELSE
                dx = d * (.4 * distx + 100)
                IF x + dx > 0 AND x + dx < _WIDTH THEN
                    x = x + dx
                ELSE
                    x = x + -dx
                END IF
            END IF
            'LINE (lastx, y)-(x, y)
            beeline lastx, y, x, y
            lastmoveX = -1
        ELSE
            lasty = y
            IF time <= 3 THEN
                y = endy
            ELSE
                dy = d * (.3 * disty + 100)
                IF y + dy > 0 AND y + dy < _HEIGHT THEN
                    y = y + dy
                ELSE
                    y = y + -dy
                END IF
            END IF
            'LINE (x, lasty)-(x, y)
            beeline x, lasty, x, y
            lastmoveX = 0
        END IF
        time = time - 1
        _LIMIT 10
    LOOP UNTIL time <= 0 OR _KEYDOWN(27)
    EXIT SUB
    dist:
    distx = endx - x: disty = endy - y
    RETURN
END SUB
 
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 
SUB beeline (x1, y1, x2, y2)
    IF x1 = x2 THEN
        IF y1 <= y2 THEN FOR y = y1 TO y2: fcirc x1, y, 4, &HFF000000: NEXT
        IF y1 > y2 THEN FOR y = y1 TO y2 STEP -1: fcirc x1, y, 4, &HFF000000: NEXT
    ELSE
        IF x1 <= x2 THEN FOR x = x1 TO x2: fcirc x, y1, 4, &HFF000000: NEXT
        IF x1 > x2 THEN FOR x = x1 TO x2 STEP -1: fcirc x, y1, 4, &HFF000000: NEXT
    END IF
END SUB

Cobalt · « **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...

Cobalt · « **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.

bplus · « **Reply #4 on:** September 16, 2020, 07:38:07 am »

Quote from: Cobalt 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...

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 ;-)

bplus · « **Reply #5 on:** September 16, 2020, 07:41:59 am »

Quote from: Cobalt 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.

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).

Cobalt · « **Reply #6 on:** September 16, 2020, 10:24:59 am »

Quote from: bplus on September 16, 2020, 07:38:07 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?

Quote from: bplus on September 16, 2020, 07:41:59 am

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.

bplus · « **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]

dx = d * (.4 * distx + 100)
 

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 · « **Reply #8 on:** September 16, 2020, 10:48:27 am »

Quote from: Cobalt 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...

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 · « **Reply #9 on:** September 16, 2020, 11:03:29 am »

Quote from: FellippeHeitor on September 16, 2020, 10:48:27 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.

FellippeHeitor · « **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 · « **Reply #11 on:** September 16, 2020, 11:34:43 am »

Quote from: FellippeHeitor on September 16, 2020, 10:48:27 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 · « **Reply #12 on:** September 16, 2020, 06:42:37 pm »

Welcome to the Museum of Meandering Art by bplus:

Code: QB64: [Select]

_TITLE "Meander #3 Mod dx dy" ' b+ 2020-09-16   so much better in living color!!
SCREEN _NEWIMAGE(1200, 720, 32)
_DELAY .25
_FULLSCREEN
RANDOMIZE TIMER
DIM SHARED beeLineK AS _UNSIGNED LONG
TYPE box
    x AS SINGLE
    y AS SINGLE
    w AS SINGLE
    h AS SINGLE
    K AS _UNSIGNED LONG
END TYPE
 
DIM backColor AS _UNSIGNED LONG, hc AS _UNSIGNED LONG
DO
    'whole new set
    nBoxes = INT(RND * 11) + 10
    REDIM b(1 TO nBoxes) AS box 'new box set
    FOR i = 1 TO nBoxes
        tryAgain:
        b(i).x = RND * (_WIDTH - 70) + 35 'get x, y off the edges of screen!
        b(i).y = RND * (_HEIGHT - 70) + 35
        IF i > 1 THEN
            OK = -1
            FOR j = 1 TO i - 1
                IF _HYPOT(b(j).x - b(i).x, b(j).y - b(i).y) < 150 THEN OK = 0: EXIT FOR
            NEXT
            IF OK = 0 THEN GOTO tryAgain
        END IF
        b(i).w = 50 + RND * 50
        b(i).h = 40 + RND * 45
        b(i).K = _RGB32(RND * 85 + 170, RND * 85 + 170, RND * 85 + 170)
    NEXT
    backColor = _RGB32(RND * 85, RND * 85, RND * 85)
    hc = maxC(backColor)
    IF hc = 1 THEN beeLineK = _RGB32(0, RND * 170, RND * 170)
    IF hc = 2 THEN beeLineK = _RGB32(RND * 170, 0, RND * 170)
    IF hc = 3 THEN beeLineK = _RGB32(RND * 170, RND * 170, 0)
    COLOR , backColor
    CLS
    FOR i = 2 TO nBoxes '                                  draw the meanderings
        meander b(i - 1).x, b(i - 1).y, b(i).x, b(i).y
        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
        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
    NEXT
    FOR i = 1 TO nBoxes
        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
    NEXT
    _DISPLAY
    _DELAY 5
LOOP UNTIL _KEYDOWN(27) OR UCASE$(INKEY$) = "Q"
 
SUB meander (x1, y1, x2, y2)
    startx = x1: starty = y1: endx = x2: endy = y2: minStep = 30
    x = startx: y = starty
    GOSUB dist
    IF dist < 200 THEN
        time = INT(RND * 4 + 4) ' total amount allowed to move  The More the time the more the meander!!!!
    ELSE
        time = 2
    END IF
    startTime = time '       > 20 is too much!!
    IF RND < .5 THEN lastmoveX = 0 ELSE lastmoveX = -1
    lastx = startx: lasty = starty
    DO
        GOSUB dist
        IF RND < .5 THEN d = -1 ELSE d = 1
        IF lastmoveX = 0 THEN
            lastx = x
            IF time <= 2 THEN
                x = endx
            ELSE
                dx = INT(d * (.4 * distx * RND + minStep) * minStep) / minStep
                IF dx = 0 THEN dx = minStep
                IF x + dx > 0 AND x + dx < _WIDTH THEN
                    x = x + dx
                ELSE
                    x = x + -dx
                END IF
            END IF
            x = INT(x * minStep) / minStep
            'LINE (lastx, y)-(x, y)
            beeline lastx, y, x, y
            lastmoveX = -1
        ELSE
            lasty = y
            IF time <= 2 THEN
                y = endy
            ELSE
                dy = INT(d * (.3 * disty * RND + minStep) * minStep) / minStep
                IF dy = 0 THEN dy = minStep
                IF y + dy > 0 AND y + dy < _HEIGHT THEN
                    y = y + dy
                ELSE
                    y = y + -dy
                END IF
            END IF
            y = INT(y * minStep) / minStep
            'LINE (x, lasty)-(x, y)
            beeline x, lasty, x, y
            lastmoveX = 0
        END IF
        time = time - 1
        '_LIMIT 10
    LOOP UNTIL time <= 0 OR _KEYDOWN(27)
    EXIT SUB
    dist:
    distx = endx - x: disty = endy - y
    RETURN
END SUB
 
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 
SUB beeline (x1, y1, x2, y2)
    IF x1 = x2 THEN
        IF y1 <= y2 THEN FOR y = y1 TO y2: fcirc x1, y, 4, beeLineK: NEXT
        IF y1 > y2 THEN FOR y = y1 TO y2 STEP -1: fcirc x1, y, 4, beeLineK: NEXT
    ELSE
        IF x1 <= x2 THEN FOR x = x1 TO x2: fcirc x, y1, 4, beeLineK: NEXT
        IF x1 > x2 THEN FOR x = x1 TO x2 STEP -1: fcirc x, y1, 4, beeLineK: NEXT
    END IF
END SUB
 
FUNCTION maxC (K AS _UNSIGNED LONG)
    IF _RED32(K) >= _GREEN32(K) AND _RED32(K) >= _BLUE32(K) THEN maxC = 1: EXIT FUNCTION
    IF _GREEN32(K) >= _BLUE(K) THEN maxC = 2 ELSE maxC = 3
END FUNCTION
 
 

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

bplus · « **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]

_TITLE "Snapping to a Grid, press any for next grid" ' b+ 2020-09-17   so much better in living color!!
' ah much better response on on escape or Q to quit! too.
 
SCREEN _NEWIMAGE(1024, 620, 32)
_DELAY .25
'_SCREENMOVE _MIDDLE
_FULLSCREEN
RANDOMIZE TIMER
 
TYPE box
    x AS SINGLE
    y AS SINGLE
    w AS SINGLE
    h AS SINGLE
    K AS _UNSIGNED LONG
END TYPE
DIM SHARED beeLineK AS _UNSIGNED LONG, gSize AS INTEGER
 
'test drawGrid
'drawGrid 0, 0, _WIDTH - 1, _HEIGHT - 1, 50, &HFFFFFF00 'crap don't forget screen width and height start at 0
'LINE (0 + 1, 0 + 1)-(_WIDTH - 1, _HEIGHT - 1), &HFF0000FF, B
'SLEEP
'DO
'    CLS
'    x1 = RND * (_WIDTH - 200): y1 = RND * (_HEIGHT - 200)
'    x2 = x1 + (_WIDTH - 1 - x1) * RND: y2 = y1 + RND * (_HEIGHT - 1 - y1)
'    LINE (x1 + 1, y1 + 1)-(x2 - 1, y2 - 1), &HFF0000FF, B
'    PRINT x1, y1, x2, y2
'    drawGrid x1, y1, x2, y2, 50, &HFFFFFF00
'    SLEEP
'LOOP
'END
 
DIM backColor AS _UNSIGNED LONG, hc AS INTEGER
DO
    'whole new set
    gSize = units(INT(40 * RND) + 11, 5)
    nBoxes = INT(SQR(_WIDTH * _HEIGHT) / gSize * RND) + 1
    IF nBoxes < 15 THEN nBoxes = 15
    IF nBoxes > 100 THEN nBoxes = 100
    COLOR &HFFFFFFFF, &HFF000000
    PRINT gSize, nBoxes
    _DISPLAY
    REDIM b(1 TO nBoxes) AS box 'new box set
    FOR i = 1 TO nBoxes
        tryAgain:
        b(i).x = units(RND * (_WIDTH - 2 * (gSize + 1)) + gSize + 1, gSize) 'get x, y off the edges of screen!
        b(i).y = units(RND * (_HEIGHT - 2 * (gSize + 1)) + gSize + 1, gSize)
        IF i > 1 THEN
            OK = -1
            FOR j = 1 TO i - 1
                IF _HYPOT(b(j).x - b(i).x, b(j).y - b(i).y) < 3 * gSize THEN OK = 0: EXIT FOR
            NEXT
            IF OK = 0 THEN GOTO tryAgain
        END IF
        b(i).w = gSize + RND * gSize * .5
        b(i).h = gSize + RND * gSize * .5
        b(i).K = _RGB32(RND * 85 + 170, RND * 85 + 170, RND * 85 + 170)
    NEXT
    backColor = _RGB32(RND * 65, RND * 65, RND * 65)
    hc = maxC(backColor)
    IF hc = 1 THEN beeLineK = _RGB32(0, RND * 85 + 85, RND * 85 + 85)
    IF hc = 2 THEN beeLineK = _RGB32(RND * 85 + 85, 0, RND * 85 + 85)
    IF hc = 3 THEN beeLineK = _RGB32(RND * 85 + 85, RND * 85 + 85, 0)
    COLOR , backColor
    CLS
    drawGrid gSize, gSize, _WIDTH - 1, _HEIGHT - 1, gSize, &HFF404040
    'SLEEP
    FOR i = 2 TO nBoxes '                                  draw the meanderings
        meander2 b(i - 1).x, b(i - 1).y, b(i).x, b(i).y
        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
        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
    NEXT
    FOR i = 1 TO nBoxes
        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
    NEXT
    COLOR &HFFFFFFFF, background
    PRINT "Press any for next screen, escape or q to quit..."
    _DISPLAY
    SLEEP
LOOP UNTIL _KEYDOWN(27) OR UCASE$(INKEY$) = "Q"
 
SUB meander2 (x1, y1, x2, y2) ' snap to grid!   gSize is shared
    startx = x1: starty = y1: endx = x2: endy = y2
    x = startx: y = starty
    GOSUB dist
    IF dist > 100 THEN
        time = INT(RND * 8 + 4) ' total amount allowed to move  The More the time the more the meander!!!!
    ELSE
        time = 3
    END IF
    startTime = time '       > 20 is too much!!
    IF RND < .5 THEN lastmoveX = 0 ELSE lastmoveX = -1
    lastx = startx: lasty = starty
    DO
        GOSUB dist
        IF RND < .5 THEN d = -1 ELSE d = 1
        IF lastmoveX = 0 THEN
            lastx = x
            IF time <= 2 THEN
                x = endx
            ELSE
                dx = units(d * (.4 * distx * RND + gSize), gSize)
                IF dx = 0 THEN dx = gSize
                IF x + dx > 0 AND x + dx < _WIDTH THEN
                    x = x + dx
                ELSE
                    x = x + -dx
                END IF
            END IF
            'LINE (lastx, y)-(x, y)
            beeline lastx, y, x, y
            lastmoveX = -1
        ELSE
            lasty = y
            IF time <= 2 THEN
                y = endy
            ELSE
                dy = units(d * (.3 * disty * RND + gSize), gSize)
                IF dy = 0 THEN dy = gSize
                IF y + dy > 0 AND y + dy < _HEIGHT THEN
                    y = y + dy
                ELSE
                    y = y + -dy
                END IF
            END IF
            'LINE (x, lasty)-(x, y)
            beeline x, lasty, x, y
            lastmoveX = 0
        END IF
        time = time - 1
        '_LIMIT 10
    LOOP UNTIL time <= 0
    EXIT SUB
    dist:
    distx = endx - x: disty = endy - y
    RETURN
END SUB
 
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 
SUB beeline (x1, y1, x2, y2)
    IF x1 = x2 THEN
        IF y1 <= y2 THEN FOR y = y1 TO y2: fcirc x1, y, 2, beeLineK: NEXT
        IF y1 > y2 THEN FOR y = y1 TO y2 STEP -1: fcirc x1, y, 2, beeLineK: NEXT
    ELSE
        IF x1 <= x2 THEN FOR x = x1 TO x2: fcirc x, y1, 2, beeLineK: NEXT
        IF x1 > x2 THEN FOR x = x1 TO x2 STEP -1: fcirc x, y1, 2, beeLineK: NEXT
    END IF
END SUB
 
FUNCTION maxC (K AS _UNSIGNED LONG)
    IF _RED32(K) >= _GREEN32(K) AND _RED32(K) >= _BLUE32(K) THEN maxC = 1: EXIT FUNCTION
    IF _GREEN32(K) >= _BLUE(K) THEN maxC = 2 ELSE maxC = 3
END FUNCTION
 
' this sub needs FUNCTION units (x, unit)
SUB drawGrid (x1, y1, x2, y2, gsize, gridClr AS _UNSIGNED LONG) ' grid of square gsize X gsize
    ' fit a grid between x1, x2 and  y1, y2
    ' x1, y1 top right corner and x2, y2 expected bottom right corner of boundary line
 
    DIM x AS INTEGER, y AS INTEGER, gx1 AS INTEGER, gy1 AS INTEGER, gx2 AS INTEGER, gy2 AS INTEGER
    gx1 = units(x1, gsize): gy1 = units(y1, gsize) 'convert to grid coordinates
    gx2 = units(x2, gsize): gy2 = units(y2, gsize)
    IF gx1 < x1 THEN gx1 = gx1 + gsize 'stay inside boundarys passed to sub
    IF gy1 < y1 THEN gy1 = gy1 + gsize
    IF gx1 >= gx2 OR gy1 >= gy2 THEN EXIT SUB 'that's not even a single square!
    FOR x = gx1 TO gx2 STEP gsize: LINE (x, gy1)-(x, gy2), gridClr: NEXT
    FOR y = gy1 TO gy2 STEP gsize: LINE (gx1, y)-(gx2, y), gridClr: NEXT
END SUB
 
FUNCTION units (x, unit)
    units = INT(x / unit) * unit
END FUNCTION
 
 
 

Cobalt · « **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.

News:

Author Topic: Meander testing grounds (Read 6882 times)

bplus

Meander testing grounds

bplus

Re: Meander testing grounds

Cobalt

Re: Meander testing grounds

Cobalt

Re: Meander testing grounds

bplus

Re: Meander testing grounds

bplus

Re: Meander testing grounds

Cobalt

Re: Meander testing grounds

bplus

Re: Meander testing grounds

FellippeHeitor

Re: Meander testing grounds

Cobalt

Re: Meander testing grounds

FellippeHeitor

Re: Meander testing grounds

bplus

Re: Meander testing grounds

bplus

Re: Meander testing grounds

bplus

Re: Meander testing grounds

Cobalt

Re: Meander testing grounds