QB64 Phoenix Edition
ASCII Simple Procedural Terrain Generator - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: SMcNeill (https://qb64phoenix.com/forum/forumdisplay.php?fid=29)
+---- Thread: ASCII Simple Procedural Terrain Generator (/showthread.php?tid=300)

ASCII Simple Procedural Terrain Generator - SMcNeill - 05-01-2022

Copied from the old forums, as I continue to try and pull old nuggets from there and keep them here for future reference:

Code: (Select All)
CONST XSize = 200, YSize = 200
DIM SHARED AS LONG Grid(XSize, YSize)

DisplayScreen = MaxScreen
SCREEN MaxScreen
_SCREENMOVE 0, 0

RANDOMIZE TIMER
$COLOR:32

DO
    InitializeMap
    Lakecount = INT(RND * 4)
    Lakes Lakecount, 400 - Lakecount * 100, 1000 - Lakecount * 300
    Rivers INT(RND * 5) + 1, INT(RND * 100) - 100, -3

    GenerateTerrain

    DrawMap
    SLEEP
LOOP UNTIL _KEYDOWN(27)

SUB InitializeMap
    FOR x = 0 TO XSize
        FOR y = 0 TO YSize
            Grid(x, y) = -999 'default blank part of map
        NEXT
    NEXT
END SUB


SUB DrawMap
    DIM kolor AS _UNSIGNED LONG
    xscale = _WIDTH / XSize
    yscale = _HEIGHT / YSize
    FOR x = 0 TO XSize
        FOR y = 0 TO YSize
            SELECT CASE Grid(x, y)
                CASE -3: kolor = DarkBlue 'Deep Water
                CASE -2: kolor = Blue 'Water
                CASE -1: kolor = SkyBlue 'Shallow Water
                CASE 0: kolor = Tann 'beach/sand
                CASE 1: kolor = Green 'grassland
                CASE 2: kolor = DarkGreen 'forest
                CASE 3: kolor = Gold 'hills
                CASE 4: kolor = Purple 'mountains
                CASE 5 TO 99: kolor = Red
                CASE ELSE: kolor = Black
            END SELECT
            LINE (x * xscale, y * yscale)-STEP(xscale, yscale), kolor, BF
    NEXT y, x
END SUB


SUB GenerateTerrain
    Height = -3
    DO UNTIL finished
        finished = -1
        FOR x = 0 TO XSize
            FOR y = 0 TO YSize
                IF Grid(x, y) = Height THEN Fill x, y, Height + 1: finished = 0
            NEXT
        NEXT
        Height = Height + 1
    LOOP

END SUB

SUB Fill (x, y, height)
    SELECT CASE height
        CASE IS = -2: RepeatChance = 50 'water repeat
        CASE IS = -1: RepeatChance = 30 'shallow water repeat
        CASE IS = 0: RepeatChance = 25 'beach repeat
        CASE IS = 1: RepeatChance = 55 'grassland
        CASE IS = 2: RepeatChance = 55 'forest
        CASE IS = 3: RepeatChance = 50 ' hills
        CASE IS = 4: RepeatChance = 50 'mountains
        CASE ELSE
            RepeatChance = 50 - 3 * height
            IF RepeatChance < 10 THEN RepeatChance = 10
    END SELECT
    CurrentX = x
    IF CurrentX > 0 THEN
        IF Grid(CurrentX - 1, y) = -999 THEN
            Grid(CurrentX - 1, y) = height
            IF INT(RND * 100) < RepeatChance THEN Fill CurrentX - 1, y, height
        END IF
    END IF
    CurrentX = x
    IF CurrentX < XSize THEN
        IF Grid(CurrentX + 1, y) = -999 THEN
            Grid(CurrentX + 1, y) = height
            IF INT(RND * 100) < RepeatChance THEN Fill CurrentX + 1, y, height
        END IF
    END IF
    CurrentY = y
    IF CurrentY > 0 THEN
        IF Grid(x, CurrentY - 1) = -999 THEN
            Grid(x, CurrentY - 1) = height
            IF INT(RND * 100) < RepeatChance THEN Fill x, CurrentY - 1, height
        END IF
    END IF
    CurrentY = y
    IF CurrentY < YSize THEN
        IF Grid(x, CurrentY + 1) = -999 THEN
            Grid(x, y + 1) = height
            IF INT(RND * 100) < RepeatChance THEN Fill x, CurrentY + 1, height
        END IF
    END IF
END SUB

SUB Lakes (Number, MinSize, MaxSize)
    FOR i = 1 TO Number
        x = INT(RND * XSize): y = INT(RND * YSize)
        LakeSize = INT(RND * (MaxSize - MinSize)) + MinSize
        LakeBuilt = 0
        DO UNTIL LakeBuilt >= LakeSize
            xchange = 0: ychange = 0
            DO
                DO
                    xchange = INT(RND * 3) - 1
                LOOP UNTIL x + xchange > 0 AND x + xchange < XSize
                DO
                    ychange = INT(RND * 3) - 1
                LOOP UNTIL y + ychange > 0 AND y + ychange < YSize
            LOOP UNTIL xchange <> 0 AND ychange <> 0
            repeat:
            IF x + xchange < 0 OR x + xchange > XSize THEN xchange = -xchange
            IF y + ychange < 0 OR y + ychange > YSize THEN ychange = -ychange
            IF Grid(x + xchange, y + ychange) = -999 THEN
                Grid(x + xchange, y + ychange) = -3
                LakeBuilt = LakeBuilt + 1
                x = x + xchange: y = y + ychange
            ELSE
                flip = INT(RND * 2)
                IF flip THEN xchange = xchange * 2 ELSE ychange = ychange * 2
                GOTO repeat
            END IF
        LOOP
    NEXT
END SUB

SUB Rivers (Number, Meander, Deep)
    FOR i = 1 TO Number
        flip1 = INT(RND * 2): flip2 = INT(RND * 2)
        IF flip1 THEN 'entry point is on top
            x1 = INT(RND * XSize): y1 = 0
        ELSE 'entry point is on left
            x1 = 0: y1 = INT(RND * YSize)
        END IF
        IF flip2 THEN 'exit point is on bottom
            x2 = INT(RND * XSize): y2 = YSize
        ELSE 'exit point is on right
            x2 = XSize: y2 = INT(RND * YSize)
        END IF

        Grid(x1, y1) = Deep: Grid(x2, y2) = Deep
        StartX = x1: StartY = y1: EndX = x2: EndY = y2 'just to preserve our original values, if needed.
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards exit, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0 'Make certain we move inside the bounds of our map dimensions
            IF StartY < 0 THEN StartY = 0
            IF StartX > XSize THEN StartX = XSize
            IF StartY > YSize THEN StartY = YSize
            Grid(StartX, StartY) = Deep 'place a river where we moved to
        LOOP
    NEXT
END SUB





FUNCTION MaxScreen
    MaxScreen = _NEWIMAGE(1024, 720, 32)
END FUNCTION

SUB ScreenMove (x, y)
    DO UNTIL _WIDTH <> 0 AND _SCREENEXISTS = -1: LOOP
    _SCREENMOVE x - BorderWidth, y - BorderWidth - TitleBarHeight
END SUB

SUB ScreenMove_Middle
    DO UNTIL _WIDTH <> 0 AND _SCREENEXISTS = -1: LOOP
    _SCREENMOVE (_DESKTOPWIDTH - _WIDTH - BorderWidth) / 2 + 1, (_DESKTOPHEIGHT - _HEIGHT - BorderWidth) / 2 - TitleBarHeight + 1
END SUB


We start by building some rivers across the screen, which would be the lowest point on the map, and then we rise up to build terrain from that point outwards...    beach, plain, forest, hill, mountain, impassable mountains!

Some things to play around with here:

Rivers Int(Rnd * 10) + 1, Int(Rnd * 100) - 100, -3   -- First value is the number of rivers, second is how much they meander across the map, and the third is their starting depth.  Note that I haven't set any colors for a depth < -3.

In the fill sub, there's a section which you can play around with to increase density of various features:

    Select Case height
        Case Is < 0: RepeatChance = 33 'water repeat
        Case Is = 0: RepeatChance = 25 'beach repeat
        Case Is = 1: RepeatChance = 55 'grassland
        Case Is = 2: RepeatChance = 55 'forest
        Case Is = 3: RepeatChance = 40 ' hills
        Case Is = 4: RepeatChance = 33 'mountains
        Case Else
            RepeatChance = 50 - 3 * height
            If RepeatChance < 10 Then RepeatChance = 10
    End Select

The higher the numbers here, the more of the feature your map is going to have...

There's no Ocean on these maps, nor is there any lakes (I think lakes would be a nice addition, rather than just forcing multiple rivers to define the low points of the map), but I think this goes to show how I'd work on generating a map like this.   I'd start at the lowest point and then just expand outwards and upwards to my mountains.  Wink

Edit: Added Lakes into the mix.

I've got to admit, I think some of these end up looking rather nice.  (Of course, since almost everything is random here, some of these end up looking like complete garbage to me as well.)

Keep in mind, I'm creating massive 200 x 200 world maps with the settings the way I currently have them.  Also note, the actual game would probably be at a much larger scale with only small portions of it viewable by the player at a time.  I also don't know if I'd bother to use so many colors for water... Probably just shallow water (where you can wade in it) and deep water (where a boat travels) would be good enough.  My thinking behind 3 levels of water here was basically ocean ship, canoe/raft/shallow drag boat, and then wading/shallow water.

Anywho...  I'd call this a decent shot at a random terrain generator.  It doesn't follow any basic rules of logic, but it's decent enough I'm not ashamed to share it.  Tongue

If I was serious about this thing, I'd probably start at my mountains and then flow down to my oceans and not backwards like I did in this attempt, as that seems like it'd generate a more natural water flow from high to low.  I'd also try to work in things like temperature zones for the polar regions, and deserts for places which are too far away from any major source of water and would normally be plains instead.

Enough to showcase the basic idea behind things here, but it can definitely be expanded on if someone was wanting to.  ;D