Author Topic: Procedural Generation (to be integrated into ASCII Terrain Engine)  (Read 1102 times)

0 Members and 1 Guest are viewing this topic.

Offline Virtusoroca

  • Newbie
  • Posts: 24
    • View Profile
Still rough but usabe
1. Run code
2. Select theme (UserDefined, BayArea, Archipelago, Swamp, Icelands, Barren, AlienPlanet)
3. Loop trough results and Save the selected Terrain (in the CSV file will be included the terrain block properties)
4. Open CSV file with Editor Module (select StructureMode to see block properties): https://www.qb64.org/forum/index.php?topic=2608.0
5. Load CSV (from Generator or Editor) in ATE MainModule and play (current version not compatible yet): https://www.qb64.org/forum/index.php?topic=2547.0
6. Modify variables as you like and run again

Code: QB64: [Select]
  1. 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
  2. 'º ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ      ASCII TERRAIN ENGINE     ÛÛßßÛÛ ÛÛßßÛÛ º
  3. 'º ÛÛ     Û     ÛÛ   ® Generator Module v1.0 ¯   ÛÛ ÞÛÛ ÛÛÛÛÛ  º
  4. 'º ÛÛ  Û  Û  Û  ÛÛ   (to be integreated in ATE)  ÛÛÜÞÛÛ ÛÛÜÜÛÛ º
  5. 'º    Û  Û  Û        Still rough but usable      ßß          º
  6. 'º ÛÛ  Û  Û  Û  ÛÛ          ------------         ÛÛßßßß ÛÛ  ÛÛ º
  7. 'º ÛÛ  Û     Û  ÛÛ  By Virtusoroca-Brazil, 2020  ÛÛßßÛÛ ÛÛÜÜÛÛ º
  8. 'º ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ          Made in QB64         ÛÛÜÜÛÛ     ÛÛ º
  9. 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
  10. '================================================================= 1.    SYSTEM SETTINGS
  11. ScreenX = 800: ScreenY = 1200
  12. CharX = 50: CharY = 100
  13. 'FontSize = 16
  14. SCREEN _NEWIMAGE(ScreenY, ScreenX, 256)
  15. '================================================================= 2.    SUBPROCEDURES DECLARATIONS
  16. DECLARE SUB PrintMenu
  17. DECLARE SUB Reload (ScreenX, ScreenY, CharX, CharY)
  18. DECLARE SUB ProceduralGeneration (CharX, CharY, MoundAscii$, MoundFColor, MoundBColor, PlainAscii$, PlainFColor, PlainBColor, WaterAscii$, WaterFColor, WaterBColor, MoundChance, MoundBoldness, WaterLevel)
  19. '================================================================= 3.    VARIABLES DECLARATION
  20. DIM SHARED KeyPress AS STRING
  21. TYPE Map
  22.     x AS INTEGER
  23.     y AS INTEGER
  24.     sum AS INTEGER
  25.     num AS INTEGER
  26.     ascii AS STRING
  27.     block AS INTEGER
  28.     fcolor AS INTEGER
  29.     bcolor AS INTEGER
  30.     check AS INTEGER
  31. REDIM SHARED Tile(1, 1) AS Map
  32. '================================================================= 4.    MAIN PROCEDURE
  33.     PrintMenu
  34.     Reload ScreenX, ScreenY, CharX, CharY
  35.     ProceduralGeneration CharX, CharY, MoundAscii$, MoundFColor, MoundBColor, PlainAscii$, PlainFColor, PlainBColor, WaterAscii$, WaterFColor, WaterBColor, MoundChance, MoundBoldness, WaterLevel
  36.     KeyPress = UCASE$(INKEY$)
  37.     SELECT CASE KeyPress
  38.         '========================================================= 4.1.  UserDefined
  39.         CASE CHR$(0) + CHR$(59)
  40.             MoundAscii$ = "²": MoundFColor = 6: MoundBColor = 7
  41.             PlainAscii$ = "Û": PlainFColor = 2: PlainBColor = 0
  42.             WaterAscii$ = "Û": WaterFColor = 3: WaterBColor = 0
  43.             MoundChance = 0: MoundBoldness = 55: WaterLevel = 1
  44.             '===================================================== 4.2.  BayArea
  45.         CASE CHR$(0) + CHR$(60)
  46.             MoundAscii$ = "²": MoundFColor = 2: MoundBColor = 7
  47.             PlainAscii$ = "Û": PlainFColor = 2: PlainBColor = 0
  48.             WaterAscii$ = "Û": WaterFColor = 3: WaterBColor = 0
  49.             MoundChance = 0: MoundBoldness = 55: WaterLevel = 1
  50.             '===================================================== 4.3.  Archipelago
  51.         CASE CHR$(0) + CHR$(61)
  52.             MoundAscii$ = "^": MoundFColor = 6: MoundBColor = 2
  53.             PlainAscii$ = "Û": PlainFColor = 2: PlainBColor = 0
  54.             WaterAscii$ = "Û": WaterFColor = 3: WaterBColor = 0
  55.             MoundChance = 0: MoundBoldness = 35: WaterLevel = 2
  56.             '===================================================== 4.4.  Swamp
  57.         CASE CHR$(0) + CHR$(62)
  58.             MoundAscii$ = "°": MoundFColor = 2: MoundBColor = 0
  59.             PlainAscii$ = "°": PlainFColor = 6: PlainBColor = 0
  60.             WaterAscii$ = "°": WaterFColor = 6: WaterBColor = 3
  61.             MoundChance = 10: MoundBoldness = 25: WaterLevel = 2
  62.             '===================================================== 4.5.  Icelands
  63.         CASE CHR$(0) + CHR$(63)
  64.             MoundAscii$ = "^": MoundFColor = 29: MoundBColor = 27
  65.             PlainAscii$ = "Û": PlainFColor = 27: PlainBColor = 0
  66.             WaterAscii$ = "Û": WaterFColor = 11: WaterBColor = 0
  67.             MoundChance = 30: MoundBoldness = 0: WaterLevel = 1
  68.             '===================================================== 4.6.  Barren
  69.         CASE CHR$(0) + CHR$(64)
  70.             MoundAscii$ = " ": MoundFColor = 14: MoundBColor = 6
  71.             PlainAscii$ = ".": PlainFColor = 14: PlainBColor = 6
  72.             WaterAscii$ = "": WaterFColor = 14: WaterBColor = 6
  73.             MoundChance = 5: MoundBoldness = 45: WaterLevel = 2
  74.             '===================================================== 4.7.  AlienPlanet
  75.         CASE CHR$(0) + CHR$(65)
  76.             MoundAscii$ = " ": MoundFColor = 21: MoundBColor = 18
  77.             PlainAscii$ = "^": PlainFColor = 0: PlainBColor = 18
  78.             WaterAscii$ = "°": WaterFColor = 18: WaterBColor = 5
  79.             MoundChance = 5: MoundBoldness = 45: WaterLevel = 5
  80.             '=====================================================
  81.             'CASE "-": FontSize = FontSize - 1
  82.             'CASE "+": FontSize = FontSize + 1
  83.         CASE "S"
  84.             SaveImageFile CharX, CharY
  85.     END SELECT
  86.     '=============================================================
  87. LOOP UNTIL KeyPress = "Q"
  88. '================================================================= 5.   SUBROUTINES
  89. '================================================================= 5.1. PrintMenu
  90. SUB PrintMenu
  91.     FOR MenuColumnX = 1 TO 50
  92.         LOCATE MenuColumnX, 101: COLOR 7, 0: PRINT "º";
  93.     NEXT
  94.     LOCATE 1, 103: PRINT "SELECT OPTION"
  95.     LOCATE 3, 103: PRINT "F1 = UserCustomized"
  96.     LOCATE 4, 103: PRINT "F2 = BayArea"
  97.     LOCATE 5, 103: PRINT "F3 = Archipelago"
  98.     LOCATE 6, 103: PRINT "F4 = Swamp"
  99.     LOCATE 7, 103: PRINT "F5 = Icelands"
  100.     LOCATE 8, 103: PRINT "F6 = Barren"
  101.     LOCATE 9, 103: PRINT "F7 = AlienPlanet"
  102.     LOCATE 11, 103: PRINT "S  = SaveFile"
  103. '================================================================= 5.2. Reload
  104. SUB Reload (ScreenX, ScreenY, CharX, CharY)
  105.     '    font& = _LOADFONT("PerfectDOSVGA437Win.ttf", FontSize, "monospace")
  106.     '    _FONT font&
  107.     '    CharX = INT(ScreenX / _FONTHEIGHT)
  108.     '    CharY = INT(ScreenY / _FONTWIDTH)
  109.     REDIM Tile(CharX, CharY) AS Map
  110.     FOR X = 1 TO CharX
  111.         FOR Y = 1 TO CharY
  112.             Tile(X, Y).block = 0
  113.             Tile(X, Y).check = 0
  114.             Tile(X, Y).num = 0
  115.             Tile(X, Y).sum = 0
  116.             Tile(X, Y).x = X
  117.             Tile(X, Y).y = Y
  118.         NEXT
  119.     NEXT
  120. '================================================================= 5.3. ProceduralGeneration
  121. SUB ProceduralGeneration (CharX, CharY, MoundAscii$, MoundFColor, MoundBColor, PlainAscii$, PlainFColor, PlainBColor, WaterAscii$, WaterFColor, WaterBColor, MoundChance, MoundBoldness, WaterLevel)
  122.     '============================================================= 5.3.1. MoundChance
  123.     FOR X = 1 TO CharX
  124.         FOR Y = 1 TO CharY
  125.             Char = INT(RND * 100)
  126.             IF Char >= 0 AND Char <= MoundChance THEN
  127.                 Tile(X, Y).ascii = MoundAscii$: Tile(X, Y).fcolor = MoundFColor: Tile(X, Y).bcolor = MoundBColor
  128.                 Tile(X, Y).num = 1
  129.                 Tile(X, Y).check = 1
  130.                 LOCATE X, Y: COLOR Tile(X, Y).fcolor, Tile(X, Y).bcolor: PRINT Tile(X, Y).ascii;
  131.             END IF
  132.         NEXT
  133.     NEXT
  134.     '============================================================= 5.3.2. MoundBoldness
  135.     FOR X = 1 TO CharX - 1
  136.         FOR Y = 1 TO CharY - 1
  137.             IF Tile(X, Y).check = 0 THEN
  138.                 Char = INT(RND * 100)
  139.                 IF Char >= 0 AND Char <= MoundBoldness THEN
  140.                     FOR Z = -1 TO 1
  141.                         Tile(X, Y).sum = Tile(X, Y).sum + Tile(X - 1, Y - 1).num
  142.                         Tile(X, Y).sum = Tile(X, Y).sum + Tile(X - 1, Y + 0).num
  143.                         Tile(X, Y).sum = Tile(X, Y).sum + Tile(X - 1, Y + 1).num
  144.                         Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 0, Y - 1).num
  145.                         Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 0, Y + 1).num
  146.                         Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 1, Y - 1).num
  147.                         Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 1, Y + 0).num
  148.                         Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 1, Y + 1).num
  149.                     NEXT
  150.                 END IF
  151.                 IF Tile(X, Y).sum >= 1 THEN '===================== Higher the sum restrictions for MoundBoldness, higher the WaterLevel
  152.                     Tile(X, Y).ascii = MoundAscii$: Tile(X, Y).fcolor = MoundFColor: Tile(X, Y).bcolor = MoundBColor
  153.                     Tile(X, Y).num = 1
  154.                     Tile(X, Y).check = 2
  155.                     LOCATE X, Y: COLOR Tile(X, Y).fcolor, Tile(X, Y).bcolor: PRINT Tile(X, Y).ascii;
  156.                 END IF
  157.             END IF
  158.         NEXT
  159.     NEXT
  160.     '============================================================= 5.3.3. Plains (surrounding Mounds)
  161.     FOR X = 1 TO CharX - 1
  162.         FOR Y = 1 TO CharY - 1
  163.             IF Tile(X, Y).check = 0 THEN
  164.                 Tile(X, Y).sum = Tile(X, Y).sum + Tile(X - 1, Y - 1).num
  165.                 Tile(X, Y).sum = Tile(X, Y).sum + Tile(X - 1, Y + 0).num
  166.                 Tile(X, Y).sum = Tile(X, Y).sum + Tile(X - 1, Y + 1).num
  167.                 Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 0, Y - 1).num
  168.                 Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 0, Y + 1).num
  169.                 Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 1, Y - 1).num
  170.                 Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 1, Y + 0).num
  171.                 Tile(X, Y).sum = Tile(X, Y).sum + Tile(X + 1, Y + 1).num
  172.                 IF Tile(X, Y).sum >= WaterLevel THEN
  173.                     Tile(X, Y).ascii = PlainAscii$: Tile(X, Y).fcolor = PlainFColor: Tile(X, Y).bcolor = PlainBColor
  174.                     Tile(X, Y).check = 3
  175.                     LOCATE X, Y: COLOR Tile(X, Y).fcolor, Tile(X, Y).bcolor: PRINT Tile(X, Y).ascii;
  176.                 END IF
  177.             END IF
  178.         NEXT
  179.     NEXT
  180.     '============================================================= 5.3.4. Water (fill the rest in) [for WaterLevel see MoundBoldness)
  181.     FOR X = 1 TO CharX
  182.         FOR Y = 1 TO CharY
  183.             IF Tile(X, Y).check = 0 THEN
  184.                 Tile(X, Y).ascii = WaterAscii$: Tile(X, Y).fcolor = WaterFColor: Tile(X, Y).bcolor = WaterBColor: Tile(X, Y).block = 1
  185.                 LOCATE X, Y: COLOR Tile(X, Y).fcolor, Tile(X, Y).bcolor: PRINT Tile(X, Y).ascii;
  186.             END IF
  187.         NEXT
  188.     NEXT
  189.     SLEEP
  190. 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ 5.4. SaveImageFile
  191. SUB SaveImageFile (CharX, CharY)
  192.     LOCATE 12, 103: COLOR 7, 0: INPUT "SaveFile: ", FileName$
  193.     OPEN FileName$ FOR OUTPUT AS #1
  194.     FOR A = 1 TO CharX
  195.         FOR B = 1 TO CharY
  196.             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
  197.         NEXT
  198.     NEXT
  199.     CLOSE #1
  200.     SLEEP
  201. '================================================================= 6. END OF PROGRAM
  202.  
* ATE_generator_v1.bas (Filesize: 10.67 KB, Downloads: 142)
UserDefined.jpg
* UserDefined.jpg (Filesize: 456.53 KB, Dimensions: 1212x834, Views: 235)
Archipelago.jpg
* Archipelago.jpg (Filesize: 118.86 KB, Dimensions: 1218x840, Views: 217)
BayArrea.jpg
* BayArrea.jpg (Filesize: 303.08 KB, Dimensions: 1218x836, Views: 233)
Barren.jpg
* Barren.jpg (Filesize: 267.31 KB, Dimensions: 1210x837, Views: 218)

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Procedural Generation (to be integrated into ASCII Terrain Engine)
« Reply #1 on: May 31, 2020, 09:59:36 pm »
Looks really cool! Reminds me of the 1980's when there were games like this where you control your little ASCII character around the map and get gold and stuff. There was a funny one once, I think from a TRS-80 magazine which was about getting your cattle and it would say, "The cow broke loose!" :)

Offline Virtusoroca

  • Newbie
  • Posts: 24
    • View Profile
Re: Procedural Generation (to be integrated into ASCII Terrain Engine)
« Reply #2 on: May 31, 2020, 10:08:48 pm »
Glad you liked it @SierraKen! Exactly what im going for here. Those retro RPGs. Rogue, Nethack, Dwarf Fortress, but not so complex. My procedural generation experiment is much simplier than those too. I belive we have one of those retro RPGs here in the forum. "Crashlanded" if im not mistaken. Didnt played it yet but looks nice.