'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
'º ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ      ASCII TERRAIN ENGINE     ÛÛßßÛÛ ÛÛßßÛÛ º
'º ÛÛ     Û     ÛÛ   ® Generator Module v1.0 ¯   ÛÛ ÞÛÛ ÛÛÛÛÛ  º
'º ÛÛ  Û  Û  Û  ÛÛ   (to be integreated in ATE)  ÛÛÜÞÛÛ ÛÛÜÜÛÛ º
'º    Û  Û  Û        Still rough but usable      ßß          º
'º ÛÛ  Û  Û  Û  ÛÛ          ------------         ÛÛßßßß ÛÛ  ÛÛ º
'º ÛÛ  Û     Û  ÛÛ  By Virtusoroca-Brazil, 2020  ÛÛßßÛÛ ÛÛÜÜÛÛ º
'º ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ          Made in QB64         ÛÛÜÜÛÛ     ÛÛ º
'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
'================================================================= 1.    SYSTEM SETTINGS
_CONTROLCHR OFF
RANDOMIZE TIMER
ScreenX = 800: ScreenY = 1200
CharX = 50: CharY = 100
'FontSize = 16
SCREEN _NEWIMAGE(ScreenY, ScreenX, 256)
'================================================================= 2.    SUBPROCEDURES DECLARATIONS
DECLARE SUB PrintMenu
DECLARE SUB Reload (ScreenX, ScreenY, CharX, CharY)
DECLARE SUB ProceduralGeneration (CharX, CharY, MoundAscii$, MoundFColor, MoundBColor, PlainAscii$, PlainFColor, PlainBColor, WaterAscii$, WaterFColor, WaterBColor, MoundChance, MoundBoldness, WaterLevel)
'================================================================= 3.    VARIABLES DECLARATION
DIM SHARED KeyPress AS STRING
TYPE Map
    x AS INTEGER
    y AS INTEGER
    sum AS INTEGER
    num AS INTEGER
    ascii AS STRING
    block AS INTEGER
    fcolor AS INTEGER
    bcolor AS INTEGER
    check AS INTEGER
END TYPE
REDIM SHARED Tile(1, 1) AS Map
'================================================================= 4.    MAIN PROCEDURE
DO
    PrintMenu
    Reload ScreenX, ScreenY, CharX, CharY
    ProceduralGeneration CharX, CharY, MoundAscii$, MoundFColor, MoundBColor, PlainAscii$, PlainFColor, PlainBColor, WaterAscii$, WaterFColor, WaterBColor, MoundChance, MoundBoldness, WaterLevel
    KeyPress = UCASE$(INKEY$)
    SELECT CASE KeyPress
        '========================================================= 4.1.  UserDefined
        CASE CHR$(0) + CHR$(59)
            MoundAscii$ = "²": MoundFColor = 6: MoundBColor = 7
            PlainAscii$ = "Û": PlainFColor = 2: PlainBColor = 0
            WaterAscii$ = "Û": WaterFColor = 3: WaterBColor = 0
            MoundChance = 0: MoundBoldness = 55: WaterLevel = 1
            '===================================================== 4.2.  BayArea
        CASE CHR$(0) + CHR$(60)
            MoundAscii$ = "²": MoundFColor = 2: MoundBColor = 7
            PlainAscii$ = "Û": PlainFColor = 2: PlainBColor = 0
            WaterAscii$ = "Û": WaterFColor = 3: WaterBColor = 0
            MoundChance = 0: MoundBoldness = 55: WaterLevel = 1
            '===================================================== 4.3.  Archipelago
        CASE CHR$(0) + CHR$(61)
            MoundAscii$ = "^": MoundFColor = 6: MoundBColor = 2
            PlainAscii$ = "Û": PlainFColor = 2: PlainBColor = 0
            WaterAscii$ = "Û": WaterFColor = 3: WaterBColor = 0
            MoundChance = 0: MoundBoldness = 35: WaterLevel = 2
            '===================================================== 4.4.  Swamp
        CASE CHR$(0) + CHR$(62)
            MoundAscii$ = "°": MoundFColor = 2: MoundBColor = 0
            PlainAscii$ = "°": PlainFColor = 6: PlainBColor = 0
            WaterAscii$ = "°": WaterFColor = 6: WaterBColor = 3
            MoundChance = 10: MoundBoldness = 25: WaterLevel = 2
            '===================================================== 4.5.  Icelands
        CASE CHR$(0) + CHR$(63)
            MoundAscii$ = "^": MoundFColor = 29: MoundBColor = 27
            PlainAscii$ = "Û": PlainFColor = 27: PlainBColor = 0
            WaterAscii$ = "Û": WaterFColor = 11: WaterBColor = 0
            MoundChance = 30: MoundBoldness = 0: WaterLevel = 1
            '===================================================== 4.6.  Barren
        CASE CHR$(0) + CHR$(64)
            MoundAscii$ = " ": MoundFColor = 14: MoundBColor = 6
            PlainAscii$ = ".": PlainFColor = 14: PlainBColor = 6
            WaterAscii$ = "": WaterFColor = 14: WaterBColor = 6
            MoundChance = 5: MoundBoldness = 45: WaterLevel = 2
            '===================================================== 4.7.  AlienPlanet
        CASE CHR$(0) + CHR$(65)
            MoundAscii$ = " ": MoundFColor = 21: MoundBColor = 18
            PlainAscii$ = "^": PlainFColor = 0: PlainBColor = 18
            WaterAscii$ = "°": WaterFColor = 18: WaterBColor = 5
            MoundChance = 5: MoundBoldness = 45: WaterLevel = 5
            '=====================================================
            'CASE "-": FontSize = FontSize - 1
            'CASE "+": FontSize = FontSize + 1
        CASE "S"
            SaveImageFile CharX, CharY
    END SELECT
    '=============================================================
LOOP UNTIL KeyPress = "Q"
'================================================================= 5.   SUBROUTINES
'================================================================= 5.1. PrintMenu
SUB PrintMenu
    FOR MenuColumnX = 1 TO 50
        LOCATE MenuColumnX, 101: COLOR 7, 0: PRINT "º";
    NEXT
    LOCATE 1, 103: PRINT "SELECT OPTION"
    LOCATE 3, 103: PRINT "F1 = UserCustomized"
    LOCATE 4, 103: PRINT "F2 = BayArea"
    LOCATE 5, 103: PRINT "F3 = Archipelago"
    LOCATE 6, 103: PRINT "F4 = Swamp"
    LOCATE 7, 103: PRINT "F5 = Icelands"
    LOCATE 8, 103: PRINT "F6 = Barren"
    LOCATE 9, 103: PRINT "F7 = AlienPlanet"
    LOCATE 11, 103: PRINT "S  = SaveFile"
END SUB
'================================================================= 5.2. Reload
SUB Reload (ScreenX, ScreenY, CharX, CharY)
    '    font& = _LOADFONT("PerfectDOSVGA437Win.ttf", FontSize, "monospace")
    '    _FONT font&
    '    CharX = INT(ScreenX / _FONTHEIGHT)
    '    CharY = INT(ScreenY / _FONTWIDTH)
    REDIM Tile(CharX, CharY) AS Map
    FOR X = 1 TO CharX
        FOR Y = 1 TO CharY
            Tile(X, Y).block = 0
            Tile(X, Y).check = 0
            Tile(X, Y).num = 0
            Tile(X, Y).sum = 0
            Tile(X, Y).x = X
            Tile(X, Y).y = Y
        NEXT
    NEXT
END SUB
'================================================================= 5.3. ProceduralGeneration
SUB ProceduralGeneration (CharX, CharY, MoundAscii$, MoundFColor, MoundBColor, PlainAscii$, PlainFColor, PlainBColor, WaterAscii$, WaterFColor, WaterBColor, MoundChance, MoundBoldness, WaterLevel)
    '============================================================= 5.3.1. MoundChance
    FOR X = 1 TO CharX
        FOR Y = 1 TO CharY
            Char = INT(RND * 100)
            IF Char >= 0 AND Char <= MoundChance THEN
                Tile(X, Y).ascii = MoundAscii$: Tile(X, Y).fcolor = MoundFColor: Tile(X, Y).bcolor = MoundBColor
                Tile(X, Y).num = 1
                Tile(X, Y).check = 1
                LOCATE X, Y: COLOR Tile(X, Y).fcolor, Tile(X, Y).bcolor: PRINT Tile(X, Y).ascii;
            END IF
        NEXT
    NEXT
    '============================================================= 5.3.2. MoundBoldness
    FOR X = 1 TO CharX - 1
        FOR Y = 1 TO CharY - 1
            IF Tile(X, Y).check = 0 THEN
                Char = INT(RND * 100)
                IF Char >= 0 AND Char <= MoundBoldness THEN
                    FOR Z = -1 TO 1
                        Tile(X, Y).sum = Tile(X, Y).sum + Tile(X - 1, Y - 1).num
                        Tile(X, Y).sum = Tile(X, Y).sum + Tile(X - 1, Y + 0).num
                        Tile(X, Y).sum = Tile(X, Y).sum + Tile(X - 1, Y + 1).num
                        Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 0, Y - 1).num
                        Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 0, Y + 1).num
                        Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 1, Y - 1).num
                        Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 1, Y + 0).num
                        Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 1, Y + 1).num
                    NEXT
                END IF
                IF Tile(X, Y).sum >= 1 THEN '===================== Higher the sum restrictions for MoundBoldness, higher the WaterLevel
                    Tile(X, Y).ascii = MoundAscii$: Tile(X, Y).fcolor = MoundFColor: Tile(X, Y).bcolor = MoundBColor
                    Tile(X, Y).num = 1
                    Tile(X, Y).check = 2
                    LOCATE X, Y: COLOR Tile(X, Y).fcolor, Tile(X, Y).bcolor: PRINT Tile(X, Y).ascii;
                END IF
            END IF
        NEXT
    NEXT
    '============================================================= 5.3.3. Plains (surrounding Mounds)
    FOR X = 1 TO CharX - 1
        FOR Y = 1 TO CharY - 1
            IF Tile(X, Y).check = 0 THEN
                Tile(X, Y).sum = Tile(X, Y).sum + Tile(X - 1, Y - 1).num
                Tile(X, Y).sum = Tile(X, Y).sum + Tile(X - 1, Y + 0).num
                Tile(X, Y).sum = Tile(X, Y).sum + Tile(X - 1, Y + 1).num
                Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 0, Y - 1).num
                Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 0, Y + 1).num
                Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 1, Y - 1).num
                Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 1, Y + 0).num
                Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 1, Y + 1).num
                IF Tile(X, Y).sum >= WaterLevel THEN
                    Tile(X, Y).ascii = PlainAscii$: Tile(X, Y).fcolor = PlainFColor: Tile(X, Y).bcolor = PlainBColor
                    Tile(X, Y).check = 3
                    LOCATE X, Y: COLOR Tile(X, Y).fcolor, Tile(X, Y).bcolor: PRINT Tile(X, Y).ascii;
                END IF
            END IF
        NEXT
    NEXT
    '============================================================= 5.3.4. Water (fill the rest in) [for WaterLevel see MoundBoldness)
    FOR X = 1 TO CharX
        FOR Y = 1 TO CharY
            IF Tile(X, Y).check = 0 THEN
                Tile(X, Y).ascii = WaterAscii$: Tile(X, Y).fcolor = WaterFColor: Tile(X, Y).bcolor = WaterBColor: Tile(X, Y).block = 1
                LOCATE X, Y: COLOR Tile(X, Y).fcolor, Tile(X, Y).bcolor: PRINT Tile(X, Y).ascii;
            END IF
        NEXT
    NEXT
    SLEEP
END FUNCTION
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ 5.4. SaveImageFile
SUB SaveImageFile (CharX, CharY)
    LOCATE 12, 103: COLOR 7, 0: INPUT "SaveFile: ", FileName$
    OPEN FileName$ FOR OUTPUT AS #1
    FOR A = 1 TO CharX
        FOR B = 1 TO CharY
            WRITE #1, Tile(A, B).x, Tile(A, B).y, Tile(A, B).fcolor, Tile(A, B).bcolor, ASC(Tile(A, B).ascii), Tile(A, B).block
        NEXT
    NEXT
    CLOSE #1
    SLEEP
END SUB
'================================================================= 6. END OF PROGRAM