Author Topic: Map Making maybe Editor  (Read 7295 times)

0 Members and 1 Guest are viewing this topic.

Offline TerryRitchie

  • Seasoned Forum Regular
  • Posts: 495
  • Semper Fidelis
    • View Profile
Re: Map Making maybe Editor
« Reply #15 on: August 21, 2018, 03:01:12 am »
Here is a random maze generator I wrote many years ago. Perhaps someone can use/modify the code for their purpose.

Code: QB64: [Select]
  1. '**
  2. '** MAZEGEN by Terry Ritchie
  3. '**
  4. '** Creates random 20x16 braided mazes (or perfect mazes with modification)
  5. '**
  6. '** This code was created from pseudo-code obtained at MAZEWORKS.COM
  7. '**
  8. '** This code could be easily modified to create any size maze and cell size
  9. '**
  10. '** If you use this code in your program please credit me and MAZEWORKS.COM
  11. '**
  12. '** Code last modified 02/23/09
  13. '**
  14. '** This maze generating code was created to use in a MEGABUG (Tandy/Radio
  15. '** Shack game from 1982) clone to teach introductory programming. The
  16. '** original game used a 20x16 maze grid. This is why the maze generator has
  17. '** been hard coded to only use a 16x20 grid. A little modification would
  18. '** allow this code to generate any size maze with any size cell.
  19. '**
  20.  
  21. CONST false = 0, true = NOT false
  22. CONST totalcells = 320
  23.  
  24. TYPE cell
  25.   walls AS INTEGER
  26.   x AS INTEGER
  27.   y AS INTEGER
  28.  
  29. TYPE stack
  30.   x AS INTEGER
  31.   y AS INTEGER
  32.  
  33. DECLARE SUB CreateRandomMaze ()
  34. DECLARE SUB DrawMaze ()
  35. DECLARE SUB DrawCell (cellx AS INTEGER, celly AS INTEGER)
  36. DECLARE SUB RemoveWall (cellx AS INTEGER, celly AS INTEGER, dir AS INTEGER)
  37.  
  38. DIM SHARED maze(0 TO 19, 0 TO 15) AS cell
  39.  
  40. SCREEN 7, 0, 1, 0
  41.  
  42.   LINE (81, 37)-(239, 163), 0, BF   'faster than CLS
  43.   CreateRandomMaze
  44.   DrawMaze
  45.   PCOPY 1, 0
  46.   SLEEP 1               '**rem this line out to see how fast it is!
  47.  
  48.  
  49. SUB CreateRandomMaze
  50. '**
  51. '** Creates a random 20x16 braided (looping) maze by first creating a perfect
  52. '** maze (a maze with no loops) then visiting each dead end and randomly
  53. '** opening them to create loops.
  54. '**
  55. '** vcells stores valid next maze cell moves in binary (bit) format
  56. '** if all adjacent cell walls are turned on then that cell is saved in vcells
  57. '** as follows:
  58. '**             bit 1 (2^0) = north cell has all walls on
  59. '**             bit 2 (2^1) = east  cell has all walls on
  60. '**             bit 3 (2^2) = south cell has all walls on
  61. '**             bit 4 (2^3) = west  cell has all walls on
  62. '**
  63.   DIM stack(totalcells) AS stack            '** maze generation LIFO stack
  64.   DIM cellx, celly, counter AS INTEGER      '** general counters
  65.   DIM cell AS stack                         '** current cell being created
  66.   DIM pointer AS INTEGER                    '** pointer for use in LIFO stack
  67.   DIM vcells AS INTEGER                     '** which cells are valid moves?
  68.   DIM randomwall AS INTEGER                 '** random valid mover
  69.   DIM forward AS INTEGER                    '** movement indicator
  70.   RANDOMIZE TIMER                           '** seed random number generator
  71.   FOR cellx = 0 TO 19                       '** initialize maze grid
  72.     FOR celly = 0 TO 15
  73.       maze(cellx, celly).walls = 15         '** turn all walls on
  74.       maze(cellx, celly).x = 80 + cellx * 8 '** x coordinate upper left cell
  75.       maze(cellx, celly).y = 36 + celly * 8 '** y coordinate upper left cell
  76.     NEXT celly
  77.   NEXT cellx
  78.   cell.x = INT(RND(1) * 19)                 '** random x location
  79.   cell.y = INT(RND(1) * 15)                 '** random y location
  80.   visitedcells = 1                          '** initialize counter
  81.   pointer = 0                               '** initialize LIFO stack pointer
  82.   forward = false                           '** initialize movement indicator
  83.   WHILE visitedcells < totalcells           '** continue until all cells made
  84.     vcells = 0                              '** initialize valid move check
  85.     IF cell.y <> 0 THEN IF maze(cell.x, cell.y - 1).walls = 15 THEN vcells = vcells + 1
  86.     IF cell.x <> 19 THEN IF maze(cell.x + 1, cell.y).walls = 15 THEN vcells = vcells + 2
  87.     IF cell.y <> 15 THEN IF maze(cell.x, cell.y + 1).walls = 15 THEN vcells = vcells + 4
  88.     IF cell.x <> 0 THEN IF maze(cell.x - 1, cell.y).walls = 15 THEN vcells = vcells + 8
  89.     IF vcells <> 0 THEN                     '** at least 1 cell has all walls
  90.       DO                                    '** find a random move direction
  91.         randomwall = INT(RND(1) * 4)        '** 0=North 1=East 2=South 3=West
  92.       LOOP UNTIL vcells AND 2 ^ randomwall  '** is random direction valid?
  93.       stack(pointer).x = cell.x             '** save current cell position in
  94.       stack(pointer).y = cell.y             '** the stack
  95.       pointer = pointer + 1                 '** increment stack pointer
  96.       visitedcells = visitedcells + 1       '** increment cell counter
  97.       forward = true                        '** forward movement indicated
  98.       CALL RemoveWall(cell.x, cell.y, randomwall) '** remove random wall
  99.       SELECT CASE randomwall                '** which direction forward?
  100.         CASE 0
  101.           cell.y = cell.y - 1               '** move north
  102.         CASE 1
  103.           cell.x = cell.x + 1               '** move east
  104.         CASE 2
  105.           cell.y = cell.y + 1               '** move south
  106.         CASE 3
  107.           cell.x = cell.x - 1               '** move west
  108.       END SELECT
  109.     ELSE                                    '** no cells have all walls
  110.      
  111. '****** remark the lines below to create perfect mazes (no loops) ***********
  112. '****** the code below creates braided mazes (contains loops)     ***********
  113.  
  114.       IF forward THEN                       '** we hit a dead end!
  115.         forward = false                     '** forward movement stops here
  116.         IF INT(RND(1) * 2) = 1 THEN         '** 50% chance of wall removal
  117.           SELECT CASE randomwall            '** which wall?
  118.             CASE 0                          '** remove north wall
  119.               IF cell.y <> 0 THEN           '** unless it's a border
  120.                 CALL RemoveWall(cell.x, cell.y, randomwall)
  121.               END IF
  122.             CASE 1                          '** remove east wall
  123.               IF cell.x <> 19 THEN          '** unless it's a border
  124.                 CALL RemoveWall(cell.x, cell.y, randomwall)
  125.               END IF
  126.             CASE 2                          '** remove south wall
  127.               IF cell.y <> 15 THEN          '** unless it's a border
  128.                 CALL RemoveWall(cell.x, cell.y, randomwall)
  129.               END IF
  130.             CASE 3                          '** remove west wall
  131.               IF cell.x <> 0 THEN           '** unless it's a border
  132.                 CALL RemoveWall(cell.x, cell.y, randomwall)
  133.               END IF
  134.           END SELECT
  135.         END IF
  136.       END IF
  137.      
  138. '****** remark the lines above to create perfect mazes (no loops) ***********
  139. '****** the code above creates braided mazes (contains loops)     ***********
  140.  
  141.       pointer = pointer - 1                 '** decrement stack pointer
  142.       cell.x = stack(pointer).x             '** go back to previous cell
  143.       cell.y = stack(pointer).y             '** go back to previous cell
  144.     END IF
  145.   WEND                                      '** exit when all cells visited
  146.  
  147.  
  148. SUB DrawCell (cellx AS INTEGER, celly AS INTEGER)
  149.  
  150. '****************************************************************************
  151. '** draw cell to graphics screen                                            *
  152. '****************************************************************************
  153.  
  154.   IF maze(cellx, celly).walls AND 1 THEN LINE (maze(cellx, celly).x, maze(cellx, celly).y)-(maze(cellx, celly).x + 8, maze(cellx, celly).y), 1
  155.   IF maze(cellx, celly).walls AND 2 THEN LINE (maze(cellx, celly).x + 8, maze(cellx, celly).y)-(maze(cellx, celly).x + 8, maze(cellx, celly).y + 8), 1
  156.   IF maze(cellx, celly).walls AND 4 THEN LINE (maze(cellx, celly).x, maze(cellx, celly).y + 8)-(maze(cellx, celly).x + 8, maze(cellx, celly).y + 8), 1
  157.   IF maze(cellx, celly).walls AND 8 THEN LINE (maze(cellx, celly).x, maze(cellx, celly).y)-(maze(cellx, celly).x, maze(cellx, celly).y + 8), 1
  158.  
  159.  
  160. SUB DrawMaze
  161.  
  162. '****************************************************************************
  163. '* Draws the entire maze to the graphics screen                             *
  164. '****************************************************************************
  165.  
  166.   DIM x AS INTEGER                          '** holds x location of maze cell
  167.   DIM y AS INTEGER                          '** holds y location of maze cell
  168.  
  169.   FOR x = 0 TO 19                           '** cycle through all cells
  170.     FOR y = 0 TO 15
  171.       CALL DrawCell(x, y)                   '** draw each cell to the screen
  172.     NEXT y
  173.   NEXT x
  174.   LINE (79, 35)-(241, 165), 1, B            '** draw border around maze
  175.  
  176.  
  177. SUB RemoveWall (cellx AS INTEGER, celly AS INTEGER, dir AS INTEGER)
  178.  
  179. '****************************************************************************
  180. '* Removes the walls between to adjoining cells based on the direction of
  181. '* movement.                                                                *
  182. '****************************************************************************
  183.  
  184.   SELECT CASE dir                           '** which direction?
  185.     CASE 0                                  '** remove north/south walls
  186.       maze(cellx, celly).walls = maze(cellx, celly).walls - 1
  187.       maze(cellx, celly - 1).walls = maze(cellx, celly - 1).walls - 4
  188.     CASE 1                                  '** remove east/west walls
  189.       maze(cellx, celly).walls = maze(cellx, celly).walls - 2
  190.       maze(cellx + 1, celly).walls = maze(cellx + 1, celly).walls - 8
  191.     CASE 2                                  '** remove south/north walls
  192.       maze(cellx, celly).walls = maze(cellx, celly).walls - 4
  193.       maze(cellx, celly + 1).walls = maze(cellx, celly + 1).walls - 1
  194.     CASE 3                                  '** remove west/east walls
  195.       maze(cellx, celly).walls = maze(cellx, celly).walls - 8
  196.       maze(cellx - 1, celly).walls = maze(cellx - 1, celly).walls - 2
  197.  
  198.  
  199.  
In order to understand recursion, one must first understand recursion.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Map Making maybe Editor
« Reply #16 on: August 21, 2018, 08:49:03 am »
Thanks TempodiBasic, Steve and Terrie,

You've made the case clear for using bit values with maps:

Prevalent use with chess programs, I am assuming was Tempodi's point.

Steve
Quote
And the main advantage of this method??  Uni-directional travel.

Map (10,10).Walk = 1 'Only North is allowed
Map (10, 9).Walk = 2 'Only East is allowed.

So if you walk north from (10,10), you can't just turn around and walk back south from (10,9); you have to continue moving east.


Maybe you can combine Steve's idea with the way the Chess pieces are allowed to move?

And amazing maze generation which I think says why you do need x, y with the type, thanks Terrie for code sample. I think this is direction I want to go where the program automatically generates upcoming scenes or mazes. Fellippe had an amazing little game on that line (not a map program but...) here: https://www.qb64.org/forum/index.php?topic=93.0

I have to confess, this was a totally unexpected idea unanticipated by myself when I started this thread. So good! I learn this now before I write something I will have to rewrite later to advance the game.

Last night, I played around with moving my "hero" main character, testing giving him/her/it the power to move through walls or move more than one square at a time like Steve's power of flight for crossing a river. Now I will rewrite that experiment with bitwise walls plus I had idea for improving on allowing max number spaces to walk.

Oh BTW, I rewrote Tempodi's example to walls designated as blocks for comparing to bitwise walls (it is easier to draw but...) and learned about PCOPY using that trick, you only have to draw the map once like drawing a background in a separate _DEST. So you don't have to redraw the whole map on screen each frame, just use it like a background image.
« Last Edit: August 21, 2018, 09:19:06 am by bplus »

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Map Making maybe Editor
« Reply #17 on: August 21, 2018, 09:30:56 am »
Hi Steve
Thanks to confirm that it is a well structured way to code combining CellValue and Bitwise test.

here a code to explain my point of view about using CONST for direct testing in IF THEN
sorry Terry,  I reuse your example of bitwise map to do faster
Code: QB64: [Select]
  1. '*
  2. '* Bitwise math demonstration
  3. '*
  4. '* Draws a simple map and allows player to move circle within map
  5. '*
  6.  
  7. '--------------------------------
  8. '- Variable Declaration Section -
  9. '--------------------------------
  10.  
  11. TYPE MAP '             set up map cell structure
  12.     x AS INTEGER '     upper left x coordinate of cell
  13.     y AS INTEGER '     upper left y coordinate of cell
  14.     walls AS INTEGER ' identifies cell walls
  15. CONST ONN = 1, OFFF = 0
  16. DIM MAP(4, 4) AS MAP ' create the map array
  17. DIM cx% '              current x cell coordinate of player
  18. DIM cy% '              current y cell coordinate of player
  19. DIM KeyPress$ '        player key presses
  20. DIM MagicKey% '        Magic Key to across the walls
  21. DIM KolorStatus& '     it brings status of hero
  22. '----------------------------
  23. '- Main Program Begins Here -
  24. '----------------------------
  25.  
  26. SCREEN _NEWIMAGE(250, 250, 32) '                                  create 250x250 32bit screen
  27. _TITLE "Simple Map" '                                             give window a title
  28. CLS '                                                             clear the screen
  29. DRAWMAP '                                                         draw the map
  30. _TITLE " MagiKey% is " + STR$(MagicKey%)
  31. KolorStatus& = _RGB32(128, 0, 0)
  32. DO '                                                              MAIN LOOP begins here
  33.     PCOPY 1, 0 '                                                  copy page 1 to current screen
  34.     CIRCLE (MAP(cx%, cy%).x + 24, MAP(cx%, cy%).y + 24), 20, _RGB32(255, 0, 0) ' draw player
  35.     PAINT (MAP(cx%, cy%).x + 24, MAP(cx%, cy%).y + 24), KolorStatus&, _RGB32(255, 0, 0)
  36.     _DISPLAY '                                                    update the screen without flicker
  37.     DO '                                                          KEY INPUT LOOP begins here
  38.         KeyPress$ = INKEY$ '                                      get a key (if any) that player pressed
  39.         _LIMIT 120 '                                              limit loop to 120 times per second
  40.     LOOP UNTIL KeyPress$ <> "" '                                  KEY INPUT LOOP back if no key
  41.     SELECT CASE KeyPress$ '                                       which key was pressed?
  42.         CASE CHR$(32) '                                           is magic key activated? Switcher ON/OFF
  43.             IF MagicKey% = OFFF THEN MagicKey% = ONN: KolorStatus& = _RGB32(0, 0, 150) ELSE MagicKey% = OFFF: KolorStatus& = _RGB32(128, 0, 0)
  44.             _TITLE " MagiKey% is " + STR$(MagicKey%)
  45.         CASE CHR$(27) '                                           the ESC key
  46.             SYSTEM '                                              return to Windows
  47.         CASE CHR$(0) + CHR$(72) '                                 the UP ARROW key
  48.             IF (NOT MAP(cx%, cy%).walls AND 1) OR MagicKey% THEN cy% = cy% - 1 ' move player up if no wall present
  49.         CASE CHR$(0) + CHR$(77) '                                 the RIGHT ARROW key
  50.             IF (NOT MAP(cx%, cy%).walls AND 2) OR MagicKey% THEN cx% = cx% + 1 ' move player right if no wall present
  51.         CASE CHR$(0) + CHR$(80) '                                 the DOWN ARROW key
  52.             IF (NOT MAP(cx%, cy%).walls AND 4) OR MagicKey% THEN cy% = cy% + 1 ' move player down if no wall present
  53.         CASE CHR$(0) + CHR$(75) '                                 the LEFT ARROW key
  54.             IF (NOT MAP(cx%, cy%).walls AND 8) OR MagicKey% THEN cx% = cx% - 1 ' move player left if no wall present
  55.  
  56.     END SELECT
  57. LOOP '                                                            MAIN LOOP back
  58.  
  59. '-----------------------------------
  60. '- Function and Subroutine section -
  61. '-----------------------------------
  62.  
  63.  
  64. SUB DRAWMAP ()
  65.  
  66.     '*
  67.     '* draws a map based on the value of each map cell
  68.     '*
  69.  
  70.     SHARED MAP() AS MAP ' need access to map array
  71.  
  72.     DIM x%, y% '          x,y map coordinates
  73.  
  74.     FOR y% = 0 TO 4 '                                                 cycle through map rows
  75.         FOR x% = 0 TO 4 '                                             cycle through map columns
  76.             READ MAP(x%, y%).walls '                                  read wall DATA
  77.             MAP(x%, y%).x = x% * 50 '                                 compute upper left x coordinate of cell
  78.             MAP(x%, y%).y = y% * 50 '                                 compute upper left y coordinate of cell
  79.             IF MAP(x%, y%).walls AND 1 THEN '                         is NORTH wall present?
  80.                 LINE (MAP(x%, y%).x, MAP(x%, y%).y)-(MAP(x%, y%).x + 49, MAP(x%, y%).y), _RGB32(255, 255, 255) ' yes, draw it
  81.             END IF
  82.             IF MAP(x%, y%).walls AND 2 THEN '                         is EAST wall present?
  83.                 LINE (MAP(x%, y%).x + 49, MAP(x%, y%).y)-(MAP(x%, y%).x + 49, MAP(x%, y%).y + 49), _RGB32(255, 255, 255) ' yes, draw it
  84.             END IF
  85.             IF MAP(x%, y%).walls AND 4 THEN '                         is SOUTH wall present?
  86.                 LINE (MAP(x%, y%).x, MAP(x%, y%).y + 49)-(MAP(x%, y%).x + 49, MAP(x%, y%).y + 49), _RGB32(255, 255, 255) ' yes, draw it
  87.             END IF
  88.             IF MAP(x%, y%).walls AND 8 THEN '                         is WEST wall present?
  89.                 LINE (MAP(x%, y%).x, MAP(x%, y%).y)-(MAP(x%, y%).x, MAP(x%, y%).y + 49), _RGB32(255, 255, 255) ' yes, draw it
  90.             END IF
  91.         NEXT x%
  92.     NEXT y%
  93.     PCOPY 0, 1 '                                                      save a copy of the map
  94.  
  95.  
  96. '------------------------
  97. '- Program DATA section -
  98. '------------------------
  99.  
  100. '*
  101. '* Map cell values
  102. '*
  103.  
  104. 'DATA 11,15,15,11,15,12,5,5,4,3,15,15,15,15,10,11,15,9,5,6,12,5,6,15,15
  105.  
  106. ' a different map
  107. DATA 11,15,15,11,15,12,5,5,4,3,15,11,15,15,10,9,0,1,5,6,12,4,5,15,15
  108.  
  109.  

As you can see if you run it, Title gives feedback for status of hero, (also its color does this!), to activate/deactivate MagicKey% you press  spacebar.  At the end of map there are 2 special cells that have a special behaviour.
I hope it is clear and useful
Thanks to read
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Map Making maybe Editor
« Reply #18 on: August 21, 2018, 12:22:19 pm »
Hey TempodiBasic, your "trap" inspired this!
Code: QB64: [Select]
  1. _TITLE "B+ Flying Hero Mod of TempodiBasic Trap Mod of Terri Ritchie Simple Map Demo, 2018-08-21"
  2.  
  3. '*
  4. '* Bitwise math demonstration
  5. '*
  6. '* Draws a simple map and allows player to move circle within map
  7. '*
  8.  
  9. '--------------------------------
  10. '- Variable Declaration Section -
  11. '--------------------------------
  12. DEFSNG A-Z
  13. 'Window
  14. CONST WW = 800 'Width
  15. CONST WH = 600 'Height
  16.  
  17. 'Map active arena
  18. CONST MAPW = 5 'Width
  19. CONST MAPH = 5 'Height
  20. CONST SQ = 50 'Tile size
  21.  
  22. 'special powers
  23. CONST ONN = 1, OFFF = 0
  24.  
  25. TYPE MAP '             set up map cell structure
  26.     x AS INTEGER '     upper left x coordinate of cell
  27.     y AS INTEGER '     upper left y coordinate of cell
  28.     walls AS INTEGER ' identifies cell walls
  29.  
  30. TYPE HeroType
  31.     X AS INTEGER
  32.     Y AS INTEGER
  33.     DX AS INTEGER
  34.     DY AS INTEGER
  35.  
  36. DIM SHARED MAP(-100 TO MAPW + 100, -100 TO MAPH + 100) AS MAP
  37. DIM SHARED XOFF, YOFF, FLAP, H AS HeroType
  38.  
  39. 'get ready
  40. XOFF = (WW - MAPW * SQ) / 2 - SQ
  41. YOFF = (WH - MAPH * SQ) / 2 - SQ
  42. H.X = 1: H.Y = 1
  43.  
  44. DIM SHARED RAT AS HeroType
  45. RAT.X = 1: RAT.Y = 1
  46. RAT.DX = 0: RAT.DY = 1 'moving right need these for heading calulations for drawing
  47.  
  48. DIM KH& '        player key presses
  49. DIM MagicKey '        Magic Key to across the walls
  50.  
  51.  
  52. '----------------------------
  53. '- Main Program Begins Here -
  54. '----------------------------
  55.  
  56. SCREEN _NEWIMAGE(WW, WH, 32) '                                  create 250x250 32bit screen
  57. CLS '                                                             clear the screen
  58. DRAWMAP '
  59.  
  60. DO '                                                              MAIN LOOP begins here
  61.     PCOPY 1, 0 '                                                  copy page 1 to current screen
  62.     DrawHero MagicKey
  63.     _DISPLAY '                                                    update the screen without flicker
  64.     KH& = _KEYHIT
  65.     SELECT CASE KH& '                                       which key was pressed?
  66.         CASE 27 '                                           the ESC key
  67.             SYSTEM '
  68.         CASE 32
  69.             IF MagicKey = OFFF THEN MagicKey = ONN ELSE MagicKey = OFFF
  70.         CASE 18432 'the UP ARROW key
  71.             IF (NOT MAP(RAT.X, RAT.Y).walls AND 1) OR MagicKey THEN RAT.Y = RAT.Y - 1: RAT.DX = 0: RAT.DY = -1
  72.         CASE 19712 'the RIGHT ARROW key
  73.             IF (NOT MAP(RAT.X, RAT.Y).walls AND 2) OR MagicKey THEN RAT.X = RAT.X + 1: RAT.DX = 1: RAT.DY = 0
  74.         CASE 20480 'the DOWN ARROW key
  75.             IF (NOT MAP(RAT.X, RAT.Y).walls AND 4) OR MagicKey THEN RAT.Y = RAT.Y + 1: RAT.DX = 0: RAT.DY = 1
  76.         CASE 19200 'the LEFT ARROW key
  77.             IF (NOT MAP(RAT.X, RAT.Y).walls AND 8) OR MagicKey THEN RAT.X = RAT.X - 1: RAT.DX = -1: RAT.DY = 0
  78.     END SELECT
  79.     FLAP = FLAP + 1 MOD 60
  80.     _LIMIT 60 'save the fan!
  81. LOOP '                                                            MAIN LOOP back
  82.  
  83. '-----------------------------------
  84. '- Function and Subroutine section -
  85. '-----------------------------------
  86. SUB DrawHero (Status)
  87.     DIM heading AS SINGLE
  88.     rx = RAT.X * SQ + .5 * SQ + XOFF
  89.     ry = RAT.Y * SQ + .5 * SQ + YOFF
  90.     rr = .2 * SQ
  91.     IF Status THEN rc& = _RGB32(50, 100, 200) ELSE rc& = _RGB32(200, 100, 50)
  92.     heading = _ATAN2(RAT.DY, RAT.DX)
  93.     noseX = rx + 2 * rr * COS(heading)
  94.     noseY = ry + 2 * rr * SIN(heading)
  95.     neckX = rx + .75 * rr * COS(heading)
  96.     neckY = ry + .75 * rr * SIN(heading)
  97.     tailX = rx + 2 * rr * COS(heading + _PI)
  98.     tailY = ry + 2 * rr * SIN(heading + _PI)
  99.     earLX = rx + rr * COS(heading - _PI(1 / 12))
  100.     earLY = ry + rr * SIN(heading - _PI(1 / 12))
  101.     earRX = rx + rr * COS(heading + _PI(1 / 12))
  102.     earRY = ry + rr * SIN(heading + _PI(1 / 12))
  103.     fcirc rx, ry, .65 * rr, rc&
  104.     fcirc neckX, neckY, rr * .3, rc&
  105.     ftri noseX, noseY, earLX, earLY, earRX, earRY, rc&
  106.     fcirc earLX, earLY, rr * .3, rc&
  107.     fcirc earRX, earRY, rr * .3, rc&
  108.     wX = .5 * rr * COS(heading - _PI(11 / 18))
  109.     wY = .5 * rr * SIN(heading - _PI(11 / 18))
  110.     LINE (noseX + wX, noseY + wY)-(noseX - wX, noseY - wY), rc&
  111.     wX = .5 * rr * COS(heading - _PI(7 / 18))
  112.     wY = .5 * rr * SIN(heading - _PI(7 / 18))
  113.     LINE (noseX + wX, noseY + wY)-(noseX - wX, noseY - wY), rc&
  114.     LINE (rx, ry)-(tailX, tailY), rc&
  115.     IF Status AND (FLAP MOD 60 > 10) THEN 'how about some wings?
  116.         wingx = rx + .25 * rr * COS(heading)
  117.         wingy = ry + .25 * rr * SIN(heading)
  118.         pieSlice wingx, wingy, 4 * rr, heading + _PI(.5) - _PI(1 / 24), heading + _PI(.5) + _PI(1 / 6), _RGB32(0, 255, 255)
  119.         pieSlice wingx, wingy, 4 * rr, heading - _PI(.5) - _PI(1 / 6), heading - _PI(.5) + _PI(1 / 24), _RGB32(0, 255, 255)
  120.         PAINT (wingx + 2 * rr * COS(heading + _PI(.5)), wingy + 2 * rr * SIN(heading + _PI(.5))), _RGBA32(10, 255, 255, 255), _RGB32(0, 255, 255)
  121.         PAINT (wingx + 2 * rr * COS(heading - _PI(.5)), wingy + 2 * rr * SIN(heading - _PI(.5))), _RGBA32(10, 255, 255, 255), _RGB32(0, 255, 255)
  122.     END IF
  123.  
  124. SUB DRAWMAP ()
  125.  
  126.     '*
  127.     '* draws a map based on the value of each map cell
  128.     '*
  129.  
  130.     DIM x, y '          x,y map coordinates
  131.  
  132.     FOR y = 1 TO MAPH '                                                 cycle through map rows
  133.         FOR x = 1 TO MAPW '                                             cycle through map columns
  134.             READ MAP(x, y).walls '                                  read wall DATA
  135.             MAP(x, y).x = x * SQ + XOFF '                                 compute upper left x coordinate of cell
  136.             MAP(x, y).y = y * SQ + YOFF '                                 compute upper left y coordinate of cell
  137.             IF MAP(x, y).walls AND 1 THEN '                         is NORTH wall present?
  138.                 LINE (MAP(x, y).x, MAP(x, y).y)-STEP(SQ - 1, 0), _RGB32(255, 255, 255) ' yes, draw it
  139.             END IF
  140.             IF MAP(x, y).walls AND 2 THEN '                         is EAST wall present?
  141.                 LINE (MAP(x, y).x + SQ - 1, MAP(x, y).y)-STEP(0, SQ - 1), _RGB32(255, 255, 255) ' yes, draw it
  142.             END IF
  143.             IF MAP(x, y).walls AND 4 THEN '                         is SOUTH wall present?
  144.                 LINE (MAP(x, y).x, MAP(x, y).y + SQ - 1)-STEP(SQ - 1, 0), _RGB32(255, 255, 255) ' yes, draw it
  145.             END IF
  146.             IF MAP(x, y).walls AND 8 THEN '                         is WEST wall present?
  147.                 LINE (MAP(x, y).x, MAP(x, y).y)-STEP(0, SQ - 1), _RGB32(255, 255, 255) ' yes, draw it
  148.             END IF
  149.         NEXT x
  150.     NEXT y
  151.     COLOR _RGB32(0, 255, 255)
  152.     _PRINTSTRING (40, 40), "The Magic Key is the spacebar."
  153.  
  154.     PCOPY 0, 1 '                                                      save a copy of the map
  155.  
  156.  
  157. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG, K AS LONG)
  158.     DIM subRadius AS LONG, RadiusError AS LONG
  159.     DIM X AS LONG, Y AS LONG
  160.  
  161.     subRadius = ABS(R)
  162.     RadiusError = -subRadius
  163.     X = subRadius
  164.     Y = 0
  165.  
  166.     IF subRadius = 0 THEN PSET (CX, CY), K: EXIT SUB
  167.  
  168.     ' Draw the middle span here so we don't draw it twice in the main loop,
  169.     ' which would be a problem with blending turned on.
  170.     LINE (CX - X, CY)-(CX + X, CY), K, BF
  171.  
  172.     WHILE X > Y
  173.         RadiusError = RadiusError + Y * 2 + 1
  174.         IF RadiusError >= 0 THEN
  175.             IF X <> Y + 1 THEN
  176.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), K, BF
  177.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), K, BF
  178.             END IF
  179.             X = X - 1
  180.             RadiusError = RadiusError - X * 2
  181.         END IF
  182.         Y = Y + 1
  183.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), K, BF
  184.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), K, BF
  185.     WEND
  186.  
  187. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  188.     a& = _NEWIMAGE(1, 1, 32)
  189.     _DEST a&
  190.     PSET (0, 0), K
  191.     _DEST 0
  192.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  193.     _FREEIMAGE a& '<<< this is important!
  194.  
  195. 'use radians
  196. SUB arc (x, y, r, raStart, raStop, c AS _UNSIGNED LONG)
  197.     'x, y origin, r = radius, c = color
  198.  
  199.     'raStart is first angle clockwise from due East = 0 degrees
  200.     ' arc will start drawing there and clockwise until raStop angle reached
  201.  
  202.     IF raStop < raStart THEN
  203.         arc x, y, r, raStart, _PI(2), c
  204.         arc x, y, r, 0, raStop, c
  205.     ELSE
  206.         ' modified to easier way suggested by Steve
  207.         'Why was the line method not good? I forgot.
  208.         al = _PI * r * r * (raStop - raStart) / _PI(2)
  209.         FOR a = raStart TO raStop STEP 1 / al
  210.             PSET (x + r * COS(a), y + r * SIN(a)), c
  211.         NEXT
  212.     END IF
  213.  
  214. 'draw lines from origin to arc on sides
  215. SUB pieSlice (x, y, r, raStart, raStop, c AS _UNSIGNED LONG)
  216.     arc x, y, r, raStart, raStop, c
  217.     px = x + r * COS(raStart): py = y + r * SIN(raStart)
  218.     LINE (x, y)-(px, py), c
  219.     px = x + r * COS(raStop): py = y + r * SIN(raStop)
  220.     LINE (x, y)-(px, py), c
  221.  
  222. '------------------------
  223. '- Program DATA section -
  224. '------------------------
  225.  
  226. '*
  227. '* Map cell values
  228. '*
  229.  
  230. 'DATA 11,15,15,11,15,12,5,5,4,3,15,15,15,15,10,11,15,9,5,6,12,5,6,15,15
  231.  
  232. ' a different map
  233. DATA 11,15,15,11,15,12,5,5,4,3,15,11,15,15,10,9,0,1,5,6,12,4,5,15,15
  234.  
  235.  
« Last Edit: August 21, 2018, 12:36:59 pm by bplus »

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Map Making maybe Editor
« Reply #19 on: August 22, 2018, 04:20:08 am »
Hi Bplus

I tryed it
cool the flying effect!
Thanks for feedback
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Map Making maybe Editor
« Reply #20 on: August 22, 2018, 08:44:58 pm »
I have just realized a problem with bitwise walls, it is incompatible to diagonal movements and thusly the Pathfinder problem that was part of what got me going with maps.

Maybe walls:
north = 1
northeast = 2
east = 4
southeast = 8
south = 16
southwest = 32
west = 64
north west = 128
 
Is a maze generator possible for octagonal cells with or without inter-spaced squares?

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Map Making maybe Editor
« Reply #21 on: August 22, 2018, 11:24:56 pm »
The main issue with Octagonal Mazes is that the map grid just doesn't make for "pretty" game design/maps, such as illustrated via the image here:   https://i.stack.imgur.com/UvO5x.jpg

It's either the odd-style map above, or else lots of "black space" in the map to designate unmoverable areas.

Hexagonal Maps are easily doable, though.  (My eternal game-in-progress, "Destiny's Child", uses hexagonal maps -- which is why I have issues with development as there's no easy to find tile sets to download and use with it.)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Map Making maybe Editor
« Reply #22 on: August 23, 2018, 09:40:12 am »
Hey Steve, With Hexagonal Maps, do you still use bitwise walls? "They" don't make equilateral triangle tiles either?

I have to say, octagonal and hexagonal are "pretty" to look at and look "pretty" in a challenging sort of way.

How are walls tiled when square bitwise maps are used? just lines?

Also with more thought, I have to say that moving diagonally as in the Pathfinder example didn't look right either, realistically not possible for a player. Which has me wondering if there are PAINT algorithms that stop if only diagonal spread is possible.

It would be easy (famous last words?) to modify Pathfinder for horizontal and vertical movement only.


Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Map Making maybe Editor
« Reply #23 on: August 23, 2018, 10:27:22 am »
Hey Steve, With Hexagonal Maps, do you still use bitwise walls? "They" don't make equilateral triangle tiles either?

I have to say, octagonal and hexagonal are "pretty" to look at and look "pretty" in a challenging sort of way.

How are walls tiled when square bitwise maps are used? just lines?

Also with more thought, I have to say that moving diagonally as in the Pathfinder example didn't look right either, realistically not possible for a player. Which has me wondering if there are PAINT algorithms that stop if only diagonal spread is possible.

It would be easy (famous last words?) to modify Pathfinder for horizontal and vertical movement only.

Quite easy to modify the pathfinder demo I posted for hortizontal and vertical movement only; just remark out the lines which check the diagional for possible passage.  ;)

As for bit wise hex maps, I tend to make them:
1)North
2)NorthEast
4)SouthEast
8)South
16)SouthWest
32)NorthWest
64)Up
128)Down

Code: QB64: [Select]
  1. / \_/
  2. \_/ \
  3. / \_/ \
  4. \_/ \_/

The only thing to keep in mind with hex maps is the interlacing coordinate system, which is a little odd until you adjust to it....

Take a look at any hex graph you want, (with the little ASCII-hex in the box above, start at the bottom left tile),  and try the following:
Travel NE, your coordinates increase 1 NORTH, 1 EAST
Travel NW, your coordinates increase 1 NORTH, 1 WEST

Now, if you look, you're now directly NORTH of the original spot where you started from...

IF travel.direction = NE THEN X = X +1: Y = Y - 1
IF travel.direction = NW THEN X = X - 1: Y = Y - 1
IF travel.direction = N THEN Y = Y - 2

Movement isn't quite as simple as add 1 step in the proper direction; it's always of change of 2 coordinates per step...

Describing it is a little difficult to do.  If I get a chance, I'll post you a demo ASAP to illustrate what I'm trying to say.
« Last Edit: August 23, 2018, 10:35:25 am by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Map Making maybe Editor
« Reply #24 on: August 23, 2018, 12:51:36 pm »
Now, here's a demo of the movement style which I was speaking of:

Code: QB64: [Select]
  1. CONST min = 1, max = 20
  2. CONST TopLeftX = 50, TopLeftY = 50 'just where I want to put my top left corner of my map on the screen
  3. CONST HexSize = 16 'Size of Hex
  4.  
  5. CONST NE = 1, East = 2, SE = 4, SW = 8, West = 16, NW = 32
  6.  
  7. DIM SHARED HeroPointer, HeroHeading
  8.  
  9. SCREEN _NEWIMAGE(800, 600, 32)
  10.  
  11. HeroX = 1: HeroY = 1: HeroHeading = SE: direction = 2
  12.  
  13. HeroPointer = TextToImage("", 16, &HFFFFFF00, &HFFFF00FF, 0)
  14.  
  15.     _LIMIT 30
  16.     CLS , 0
  17.     DrawMap
  18.     DrawHero HeroX, HeroY
  19.  
  20.     k = _KEYHIT
  21.     SELECT CASE k
  22.         CASE 19200 'left arrow
  23.             direction = direction - 1: IF direction < 0 THEN direction = 5
  24.             HeroHeading = 2 ^ direction
  25.         CASE 20480 'down arrow
  26.             SELECT CASE HeroHeading
  27.                 CASE NE: HeroX = HeroX - .5: HeroY = HeroY + 1
  28.                 CASE East: HeroX = HeroX - 1
  29.                 CASE SE: HeroX = HeroX - .5: HeroY = HeroY - 1
  30.                 CASE SW: HeroX = HeroX + .5: HeroY = HeroY - 1
  31.                 CASE West: HeroX = HeroX + 1
  32.                 CASE NW: HeroX = HeroX + .5: HeroY = HeroY + 1
  33.             END SELECT
  34.  
  35.         CASE 19712 'right arrow
  36.             direction = direction + 1: IF direction > 5 THEN direction = 0
  37.             HeroHeading = 2 ^ direction
  38.         CASE 18432 'up arrow
  39.             SELECT CASE HeroHeading
  40.                 CASE NE: HeroX = HeroX + .5: HeroY = HeroY - 1
  41.                 CASE East: HeroX = HeroX + 1
  42.                 CASE SE: HeroX = HeroX + .5: HeroY = HeroY + 1
  43.                 CASE SW: HeroX = HeroX - .5: HeroY = HeroY + 1
  44.                 CASE West: HeroX = HeroX - 1
  45.                 CASE NW: HeroX = HeroX - .5: HeroY = HeroY - 1
  46.             END SELECT
  47.     END SELECT
  48.     _PRINTSTRING (680, 100), "AV: " + STR$(HeroX) + "," + STR$(HeroY)
  49.     _PRINTSTRING (680, 130), "TV: " + STR$(_CEIL(HeroX)) + "," + STR$(HeroY)
  50.     _DISPLAY
  51. LOOP UNTIL k = 27
  52.  
  53. SUB DrawHero (TempX, Y)
  54.     X = _CEIL(TempX)
  55.     HexWidth = SQR(3) * HexSize: HexHeight = 2 * HexSize 'Height and Width of each individual hex
  56.     CenterX = TopLeftX + X * HexWidth
  57.     CenterY = TopLeftY + Y * HexHeight * 0.75
  58.     IF Y MOD 2 THEN CenterX = CenterX + HexWidth / 2 'offset for odd/even rows
  59.     SELECT CASE HeroHeading
  60.         CASE NE: Angle = -45
  61.         CASE East: Angle = -90
  62.         CASE SE: Angle = -135
  63.         CASE SW: Angle = 135
  64.         CASE West: Angle = 90
  65.         CASE NW: Angle = 45
  66.     END SELECT
  67.     DisplayImage HeroPointer, CenterX, CenterY, Angle, 0
  68.  
  69.  
  70. SUB DrawHex (X, Y, C AS _UNSIGNED LONG)
  71.     HexWidth = SQR(3) * HexSize: HexHeight = 2 * HexSize 'Height and Width of each individual hex
  72.     CenterX = TopLeftX + X * HexWidth
  73.     CenterY = TopLeftY + Y * HexHeight * 0.75
  74.     IF Y MOD 2 THEN CenterX = CenterX + HexWidth / 2 'offset for odd/even rows
  75.     COLOR C
  76.     Point1X = CenterX - HexWidth / 2
  77.     Point2X = CenterX
  78.     Point3x = CenterX + HexWidth / 2
  79.     Point1y = CenterY - HexHeight / 2
  80.     Point2y = CenterY - HexHeight / 4
  81.     Point3y = CenterY + HexHeight / 4
  82.     Point4y = CenterY + HexHeight / 2
  83.     LINE (Point1X, Point2y)-(Point2X, Point1y) 'NorthWest
  84.     LINE (Point2X, Point1y)-(Point3x, Point2y) 'NorthEast
  85.     LINE (Point3x, Point2y)-(Point3x, Point3y) 'East
  86.     LINE (Point3x, Point3y)-(Point2X, Point4y) 'SouthEast
  87.     LINE (Point2X, Point4y)-(Point1X, Point3y) 'SouthWest
  88.     LINE (Point1X, Point3y)-(Point1X, Point2y) 'West
  89.     PAINT (CenterX, CenterY), C
  90.     COLOR -1
  91.  
  92.  
  93.  
  94. SUB DrawMap
  95.     HexWidth = SQR(3) * HexSize: HexHeight = 2 * HexSize 'Height and Width of each individual hex
  96.     COLOR &H99FFFFFF
  97.     FOR X = min - 1 TO max + 1
  98.         FOR Y = min - 1 TO max + 1
  99.             CenterX = TopLeftX + X * HexWidth
  100.             CenterY = TopLeftY + Y * HexHeight * 0.75
  101.             IF Y MOD 2 THEN CenterX = CenterX + HexWidth / 2 'offset for odd/even rows
  102.             Point1X = CenterX - HexWidth / 2
  103.             Point2X = CenterX
  104.             Point3x = CenterX + HexWidth / 2
  105.             Point1y = CenterY - HexHeight / 2
  106.             Point2y = CenterY - HexHeight / 4
  107.             Point3y = CenterY + HexHeight / 4
  108.             Point4y = CenterY + HexHeight / 2
  109.             LINE (Point1X, Point2y)-(Point2X, Point1y) 'NorthWest
  110.             LINE (Point2X, Point1y)-(Point3x, Point2y) 'NorthEast
  111.             LINE (Point3x, Point2y)-(Point3x, Point3y) 'East
  112.             LINE (Point3x, Point3y)-(Point2X, Point4y) 'SouthEast
  113.             LINE (Point2X, Point4y)-(Point1X, Point3y) 'SouthWest
  114.             LINE (Point1X, Point3y)-(Point1X, Point2y) 'West
  115.             IF X = min - 1 OR X = max + 1 THEN PAINT (CenterX, CenterY)
  116.             IF Y = min - 1 OR Y = max + 1 THEN PAINT (CenterX, CenterY)
  117.         NEXT
  118.     NEXT
  119.     COLOR -1
  120.  
  121. SUB DisplayImage (Image AS LONG, x AS INTEGER, y AS INTEGER, angle AS SINGLE, mode AS _BYTE)
  122.     'Image is the image handle which we use to reference our image.
  123.     'x,y is the X/Y coordinates where we want the image to be at on the screen.
  124.     'angle is the angle which we wish to rotate the image.
  125.     'mode determines HOW we place the image at point X,Y.
  126.     'Mode 0 we center the image at point X,Y
  127.     'Mode 1 we place the Top Left corner of oour image at point X,Y
  128.     'Mode 2 is Bottom Left
  129.     'Mode 3 is Top Right
  130.     'Mode 4 is Bottom Right
  131.  
  132.  
  133.     DIM px(3) AS INTEGER, py(3) AS INTEGER, w AS INTEGER, h AS INTEGER
  134.     DIM sinr AS SINGLE, cosr AS SINGLE, i AS _BYTE
  135.     w = _WIDTH(Image): h = _HEIGHT(Image)
  136.     SELECT CASE mode
  137.         CASE 0 'center
  138.             px(0) = -w \ 2: py(0) = -h \ 2: px(3) = w \ 2: py(3) = -h \ 2
  139.             px(1) = -w \ 2: py(1) = h \ 2: px(2) = w \ 2: py(2) = h \ 2
  140.         CASE 1 'top left
  141.             px(0) = 0: py(0) = 0: px(3) = w: py(3) = 0
  142.             px(1) = 0: py(1) = h: px(2) = w: py(2) = h
  143.         CASE 2 'bottom left
  144.             px(0) = 0: py(0) = -h: px(3) = w: py(3) = -h
  145.             px(1) = 0: py(1) = 0: px(2) = w: py(2) = 0
  146.         CASE 3 'top right
  147.             px(0) = -w: py(0) = 0: px(3) = 0: py(3) = 0
  148.             px(1) = -w: py(1) = h: px(2) = 0: py(2) = h
  149.         CASE 4 'bottom right
  150.             px(0) = -w: py(0) = -h: px(3) = 0: py(3) = -h
  151.             px(1) = -w: py(1) = 0: px(2) = 0: py(2) = 0
  152.     END SELECT
  153.     sinr = SIN(angle / 57.2957795131): cosr = COS(angle / 57.2957795131)
  154.     FOR i = 0 TO 3
  155.         x2 = (px(i) * cosr + sinr * py(i)) + x: y2 = (py(i) * cosr - px(i) * sinr) + y
  156.         px(i) = x2: py(i) = y2
  157.     NEXT
  158.     _MAPTRIANGLE (0, 0)-(0, h - 1)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  159.     _MAPTRIANGLE (0, 0)-(w - 1, 0)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  160.  
  161. FUNCTION TextToImage& (text$, font&, fc&, bfc&, mode AS _BYTE)
  162.     'text$ is the text that we wish to transform into an image.
  163.     'font& is the handle of the font we want to use.
  164.     'fc& is the color of the font we want to use.
  165.     'bfc& is the background color of the font.
  166.  
  167.     'Mode 1 is print forwards
  168.     'Mode 2 is print backwards
  169.     'Mode 3 is print from top to bottom
  170.     'Mode 4 is print from bottom up
  171.     'Mode 0 got lost somewhere, but it's OK.  We check to see if our mode is < 1 or > 4 and compensate automatically if it is to make it one (default).
  172.  
  173.     IF mode < 1 OR mode > 4 THEN mode = 1
  174.     dc& = _DEFAULTCOLOR: bgc& = _BACKGROUNDCOLOR
  175.     IF font& <> 0 THEN _FONT font&
  176.     IF mode < 3 THEN
  177.         'print the text lengthwise
  178.         w& = _PRINTWIDTH(text$): h& = _FONTHEIGHT
  179.     ELSE
  180.         'print the text vertically
  181.         FOR i = 1 TO LEN(text$)
  182.             IF w& < _PRINTWIDTH(MID$(text$, i, 1)) THEN w& = _PRINTWIDTH(MID$(text$, i, 1))
  183.         NEXT
  184.         h& = _FONTHEIGHT * (LEN(text$))
  185.     END IF
  186.     TextToImage& = _NEWIMAGE(w&, h&, 32)
  187.     _DEST TextToImage&
  188.     IF font& <> 0 THEN _FONT font&
  189.     COLOR fc&, bfc&
  190.  
  191.     SELECT CASE mode
  192.         CASE 1
  193.             'Print text forward
  194.             _PRINTSTRING (0, 0), text$
  195.         CASE 2
  196.             'Print text backwards
  197.             temp$ = ""
  198.             FOR i = 0 TO LEN(text$) - 1
  199.                 temp$ = temp$ + MID$(text$, LEN(text$) - i, 1)
  200.             NEXT
  201.             _PRINTSTRING (0, 0), temp$
  202.         CASE 3
  203.             'Print text upwards
  204.             'first lets reverse the text, so it's easy to place
  205.             temp$ = ""
  206.             FOR i = 0 TO LEN(text$) - 1
  207.                 temp$ = temp$ + MID$(text$, LEN(text$) - i, 1)
  208.             NEXT
  209.             'then put it where it belongs
  210.             FOR i = 1 TO LEN(text$)
  211.                 fx = (w& - _PRINTWIDTH(MID$(temp$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
  212.                 _PRINTSTRING (fx, _FONTHEIGHT * (i - 1)), MID$(temp$, i, 1)
  213.             NEXT
  214.         CASE 4
  215.             'Print text downwards
  216.             FOR i = 1 TO LEN(text$)
  217.                 fx = (w& - _PRINTWIDTH(MID$(text$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
  218.                 _PRINTSTRING (fx, _FONTHEIGHT * (i - 1)), MID$(text$, i, 1)
  219.             NEXT
  220.     END SELECT
  221.     _DEST 0
  222.     COLOR dc&, bgc&
  223.  
  224.  

Only thing here, is I was distracted and made the math much more complicated than it needed to be -- I used single-width steps for the default, instead of double-width steps, which means when we move we only move a HALF step at once when we go NE, SE, SE, or NW.

Searching the web, I found a nice site which describes (and illustrates with graphics) what I was trying to show here, as well as going into quite a bit of nice detail about various ways you could label your map/grid, and work with it.  If you're interested in hex maps, I'd suggest taking a bit to look at what they show/teach there; it really does seem to be a fairly comprehensive on the subject.   

Edit:  Another point different from the demo and I spoke about in the previous post:  I've rotated the demo map 90 degrees.  My flat-side here is on the East and West sides and not the North and South, but that's basically just a graphical rotation issue from how I calculated my math...
« Last Edit: August 23, 2018, 01:08:45 pm by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Map Making maybe Editor
« Reply #25 on: August 23, 2018, 01:26:22 pm »
Nice demo Steve. I was wondering how you would handle arrow moves. Looks like the turtle drawing way, use left/right to turn, up/down for forward and backwards, very intuitive. I like the different style grid. Have you tried maze generating?

Steve
Quote
If you're interested in hex maps, I'd suggest taking a bit to look at what they show/teach there; it really does seem to be a fairly comprehensive on the subject.

I am locked in ideas to make octagonal work at moment, but if that doesn't pan out did you have a particular link to site in mind for learning more? "There" is where? (Apologies if you posted it and I am just not seeing it.)

Oh, also, confirmed, Pathfinding for just vertical/horizontal moves was easy to setup. I am un-embedding the hero from the map and removing excess code to Pathfinder v4. The paths look much more realistic for maze maneuvering. Eh, more errands today...

« Last Edit: August 23, 2018, 01:34:35 pm by bplus »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Map Making maybe Editor
« Reply #26 on: August 23, 2018, 01:36:17 pm »
https://www.redblobgames.com/grids/hexagons/

Sorry!  Somehow, I forgot to post the link I was talking about for you.

/Blush!

https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Map Making maybe Editor
« Reply #27 on: August 23, 2018, 01:38:44 pm »
:)) That was quick! Oh hey, cube walking, cool!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Map Making maybe Editor
« Reply #28 on: August 23, 2018, 08:26:37 pm »
An initial attempt to setup a basic hexagonal maze maker:

Code: QB64: [Select]
  1. TYPE MapInfo
  2.     Wall AS _UNSIGNED _BYTE
  3.     Distance AS _BYTE
  4.  
  5.  
  6. CONST min = 1, max = 20
  7. CONST TopLeftX = 50, TopLeftY = 50 'just where I want to put my top left corner of my map on the screen
  8. CONST HexSize = 16 'Size of Hex
  9.  
  10. CONST NE = 1, East = 2, SE = 4, SW = 8, West = 16, NW = 32
  11.  
  12.  
  13.  
  14. DIM SHARED HeroPointer, HeroHeading, Difficulty
  15. DIM SHARED map(min - 1 TO max + 1, min - 1 TO max + 1) AS MapInfo
  16.  
  17. Difficulty = 140
  18.  
  19. SCREEN _NEWIMAGE(800, 600, 32)
  20.  
  21.  
  22. HeroX = 1: HeroY = 1: HeroHeading = SE: direction = 2
  23.  
  24. HeroPointer = TextToImage("", 16, &HFFFF0000, 0, 0)
  25.  
  26. CreateMap
  27. TargetX = INT(RND * max) + min: TargetY = INT(RND * max) + min
  28.  
  29.     _LIMIT 30
  30.     CLS , 0
  31.     _DONTBLEND: DrawMap
  32.     _BLEND: DrawHero HeroX, HeroY
  33.  
  34.     k = _KEYHIT
  35.     SELECT CASE k
  36.         CASE 19200 'left arrow
  37.             direction = direction - 1: IF direction < 0 THEN direction = 5
  38.             HeroHeading = 2 ^ direction
  39.         CASE 20480 'down arrow
  40.             SELECT CASE HeroHeading
  41.                 CASE NE: HeroX = HeroX - .5: HeroY = HeroY + 1
  42.                 CASE East: HeroX = HeroX - 1
  43.                 CASE SE: HeroX = HeroX - .5: HeroY = HeroY - 1
  44.                 CASE SW: HeroX = HeroX + .5: HeroY = HeroY - 1
  45.                 CASE West: HeroX = HeroX + 1
  46.                 CASE NW: HeroX = HeroX + .5: HeroY = HeroY + 1
  47.             END SELECT
  48.  
  49.         CASE 19712 'right arrow
  50.             direction = direction + 1: IF direction > 5 THEN direction = 0
  51.             HeroHeading = 2 ^ direction
  52.         CASE 18432 'up arrow
  53.             SELECT CASE HeroHeading
  54.                 CASE NE: IF (map(_CEIL(HeroX), HeroY).Wall AND 1) = 0 THEN HeroX = HeroX + .5: HeroY = HeroY - 1
  55.                 CASE East: IF (map(_CEIL(HeroX), HeroY).Wall AND 2) = 0 THEN HeroX = HeroX + 1
  56.                 CASE SE: IF (map(_CEIL(HeroX), HeroY).Wall AND 4) = 0 THEN HeroX = HeroX + .5: HeroY = HeroY + 1
  57.                 CASE SW: IF (map(_CEIL(HeroX), HeroY).Wall AND 8) = 0 THEN HeroX = HeroX - .5: HeroY = HeroY + 1
  58.                 CASE West: IF (map(_CEIL(HeroX), HeroY).Wall AND 16) = 0 THEN HeroX = HeroX - 1
  59.                 CASE NW: IF (map(_CEIL(HeroX), HeroY).Wall AND 32) = 0 THEN HeroX = HeroX - .5: HeroY = HeroY - 1
  60.             END SELECT
  61.         CASE ASC("r"), ASC("R")
  62.             TargetX = INT(RND * max) + min: TargetY = INT(RND * max) + min
  63.     END SELECT
  64.     _PRINTSTRING (680, 100), "AV: " + STR$(HeroX) + "," + STR$(HeroY)
  65.     _PRINTSTRING (680, 130), "TV: " + STR$(_CEIL(HeroX)) + "," + STR$(HeroY)
  66.     _PRINTSTRING (680, 160), "WL: " + STR$(map(_CEIL(HeroX), HeroY).Wall)
  67.     DrawHex TargetX, TargetY, &HFFFF00FF
  68.  
  69.     IF _CEIL(HeroX) = TargetX AND HeroY = TargetY THEN
  70.         CreateMap
  71.         Difficulty = Difficulty + 5
  72.         TargetX = INT(RND * max) + min: TargetY = INT(RND * max) + min
  73.     END IF
  74.     _DISPLAY
  75. LOOP UNTIL k = 27
  76.  
  77. SUB CreateMap
  78.     FOR x = min - 1 TO max + 1 'Reset the map to just borders
  79.         FOR y = min - 1 TO max + 1
  80.             map(x, y).Distance = -1: map(x, y).Wall = 0
  81.     NEXT y, x
  82.     FOR x = min - 1 TO max + 1 'borders are non-moveable
  83.         map(x, min - 1).Wall = -1
  84.         map(x, max + 1).Wall = -1
  85.         map(min - 1, x).Wall = -1
  86.         map(max + 1, x).Wall = -1
  87.     NEXT
  88.  
  89.     D = 256 - Difficulty: IF D < 63 THEN D = 63
  90.     FOR x = min TO max
  91.         FOR y = min TO max
  92.             r = INT(RND * D)
  93.             IF r > 63 THEN r = 0
  94.             IF r > 0 THEN map(x, y).Wall = map(x, y).Wall OR r
  95.         NEXT
  96.     NEXT
  97.     FOR x = min - 1 TO max + 1
  98.         FOR y = min - 1 TO max + 1
  99.             IF y MOD 2 = 0 THEN xmod = 0 ELSE xmod = 1
  100.  
  101.             IF map(x, y).Wall AND NE AND x <= max AND y >= min THEN map(x + xmod, y - 1).Wall = map(x + xmod, y - 1).Wall OR SW
  102.             IF map(x, y).Wall AND East AND x <= max THEN map(x + 1, y).Wall = map(x + 1, y).Wall OR West
  103.             IF map(x, y).Wall AND SE AND y <= max AND x <= max THEN map(x + xmod, y + 1).Wall = map(x + xmod, y + 1).Wall OR NW
  104.             IF xmod = 0 THEN xmod = 1 ELSE xmod = 0
  105.             IF map(x, y).Wall AND SW AND x >= min AND y <= max THEN map(x - xmod, y + 1).Wall = map(x - xmod, y + 1).Wall OR NE
  106.             IF map(x, y).Wall AND West AND x >= min THEN map(x - 1, y).Wall = map(x - 1, y).Wall OR East
  107.             IF map(x, y).Wall AND NW AND x >= min AND y >= min THEN map(x - xmod, y - 1).Wall = map(x - xmod, y - 1).Wall OR SE
  108.         NEXT
  109.     NEXT
  110.  
  111.  
  112.  
  113. SUB DrawHero (TempX, Y)
  114.     X = _CEIL(TempX)
  115.     HexWidth = SQR(3) * HexSize: HexHeight = 2 * HexSize 'Height and Width of each individual hex
  116.     CenterX = TopLeftX + X * HexWidth
  117.     CenterY = TopLeftY + Y * HexHeight * 0.75
  118.     IF Y MOD 2 THEN CenterX = CenterX + HexWidth / 2 'offset for odd/even rows
  119.     SELECT CASE HeroHeading
  120.         CASE NE: Angle = -30
  121.         CASE East: Angle = -90
  122.         CASE SE: Angle = -150
  123.         CASE SW: Angle = 150
  124.         CASE West: Angle = 90
  125.         CASE NW: Angle = 30
  126.     END SELECT
  127.     DisplayImage HeroPointer, CenterX, CenterY, Angle, 0
  128.  
  129.  
  130. SUB DrawHex (X, Y, C AS _UNSIGNED LONG)
  131.     HexWidth = SQR(3) * HexSize: HexHeight = 2 * HexSize 'Height and Width of each individual hex
  132.     CenterX = TopLeftX + X * HexWidth
  133.     CenterY = TopLeftY + Y * HexHeight * 0.75
  134.     IF Y MOD 2 THEN CenterX = CenterX + HexWidth / 2 'offset for odd/even rows
  135.     COLOR C
  136.     Point1X = CenterX - HexWidth / 2
  137.     Point2X = CenterX
  138.     Point3x = CenterX + HexWidth / 2
  139.     Point1y = CenterY - HexHeight / 2
  140.     Point2y = CenterY - HexHeight / 4
  141.     Point3y = CenterY + HexHeight / 4
  142.     Point4y = CenterY + HexHeight / 2
  143.     LINE (Point1X, Point2y)-(Point2X, Point1y) 'NorthWest
  144.     LINE (Point2X, Point1y)-(Point3x, Point2y) 'NorthEast
  145.     LINE (Point3x, Point2y)-(Point3x, Point3y) 'East
  146.     LINE (Point3x, Point3y)-(Point2X, Point4y) 'SouthEast
  147.     LINE (Point2X, Point4y)-(Point1X, Point3y) 'SouthWest
  148.     LINE (Point1X, Point3y)-(Point1X, Point2y) 'West
  149.     PAINT (CenterX, CenterY), C
  150.     COLOR -1
  151.  
  152.  
  153.  
  154. SUB DrawMap
  155.     HexWidth = SQR(3) * HexSize: HexHeight = 2 * HexSize 'Height and Width of each individual hex
  156.     FOR X = min - 1 TO max + 1
  157.         FOR Y = min - 1 TO max + 1
  158.             CenterX = TopLeftX + X * HexWidth
  159.             CenterY = TopLeftY + Y * HexHeight * 0.75
  160.             IF Y MOD 2 THEN CenterX = CenterX + HexWidth / 2 'offset for odd/even rows
  161.             Point1X = CenterX - HexWidth / 2
  162.             Point2X = CenterX
  163.             Point3x = CenterX + HexWidth / 2
  164.             Point1y = CenterY - HexHeight / 2
  165.             Point2y = CenterY - HexHeight / 4
  166.             Point3y = CenterY + HexHeight / 4
  167.             Point4y = CenterY + HexHeight / 2
  168.             IF map(X, Y).Wall AND NW THEN LINE (Point1X, Point2y)-(Point2X, Point1y) 'NorthWest
  169.             IF map(X, Y).Wall AND NE THEN LINE (Point2X, Point1y)-(Point3x, Point2y) 'NorthEast
  170.             IF map(X, Y).Wall AND East THEN LINE (Point3x, Point2y)-(Point3x, Point3y) 'East
  171.             IF map(X, Y).Wall AND SE THEN LINE (Point3x, Point3y)-(Point2X, Point4y) 'SouthEast
  172.             IF map(X, Y).Wall AND SW THEN LINE (Point2X, Point4y)-(Point1X, Point3y) 'SouthWest
  173.             IF map(X, Y).Wall AND West THEN LINE (Point1X, Point3y)-(Point1X, Point2y) 'West
  174.             IF (map(X, Y).Wall AND 63) = 63 THEN PAINT (CenterX, CenterY)
  175.         NEXT
  176.     NEXT
  177.  
  178. SUB DisplayImage (Image AS LONG, x AS INTEGER, y AS INTEGER, angle AS SINGLE, mode AS _BYTE)
  179.     'Image is the image handle which we use to reference our image.
  180.     'x,y is the X/Y coordinates where we want the image to be at on the screen.
  181.     'angle is the angle which we wish to rotate the image.
  182.     'mode determines HOW we place the image at point X,Y.
  183.     'Mode 0 we center the image at point X,Y
  184.     'Mode 1 we place the Top Left corner of oour image at point X,Y
  185.     'Mode 2 is Bottom Left
  186.     'Mode 3 is Top Right
  187.     'Mode 4 is Bottom Right
  188.  
  189.  
  190.     DIM px(3) AS INTEGER, py(3) AS INTEGER, w AS INTEGER, h AS INTEGER
  191.     DIM sinr AS SINGLE, cosr AS SINGLE, i AS _BYTE
  192.     w = _WIDTH(Image): h = _HEIGHT(Image)
  193.     SELECT CASE mode
  194.         CASE 0 'center
  195.             px(0) = -w \ 2: py(0) = -h \ 2: px(3) = w \ 2: py(3) = -h \ 2
  196.             px(1) = -w \ 2: py(1) = h \ 2: px(2) = w \ 2: py(2) = h \ 2
  197.         CASE 1 'top left
  198.             px(0) = 0: py(0) = 0: px(3) = w: py(3) = 0
  199.             px(1) = 0: py(1) = h: px(2) = w: py(2) = h
  200.         CASE 2 'bottom left
  201.             px(0) = 0: py(0) = -h: px(3) = w: py(3) = -h
  202.             px(1) = 0: py(1) = 0: px(2) = w: py(2) = 0
  203.         CASE 3 'top right
  204.             px(0) = -w: py(0) = 0: px(3) = 0: py(3) = 0
  205.             px(1) = -w: py(1) = h: px(2) = 0: py(2) = h
  206.         CASE 4 'bottom right
  207.             px(0) = -w: py(0) = -h: px(3) = 0: py(3) = -h
  208.             px(1) = -w: py(1) = 0: px(2) = 0: py(2) = 0
  209.     END SELECT
  210.     sinr = SIN(angle / 57.2957795131): cosr = COS(angle / 57.2957795131)
  211.     FOR i = 0 TO 3
  212.         x2 = (px(i) * cosr + sinr * py(i)) + x: y2 = (py(i) * cosr - px(i) * sinr) + y
  213.         px(i) = x2: py(i) = y2
  214.     NEXT
  215.     _MAPTRIANGLE (0, 0)-(0, h - 1)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  216.     _MAPTRIANGLE (0, 0)-(w - 1, 0)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  217.  
  218. FUNCTION TextToImage& (text$, font&, fc&, bfc&, mode AS _BYTE)
  219.     'text$ is the text that we wish to transform into an image.
  220.     'font& is the handle of the font we want to use.
  221.     'fc& is the color of the font we want to use.
  222.     'bfc& is the background color of the font.
  223.  
  224.     'Mode 1 is print forwards
  225.     'Mode 2 is print backwards
  226.     'Mode 3 is print from top to bottom
  227.     'Mode 4 is print from bottom up
  228.     'Mode 0 got lost somewhere, but it's OK.  We check to see if our mode is < 1 or > 4 and compensate automatically if it is to make it one (default).
  229.  
  230.     IF mode < 1 OR mode > 4 THEN mode = 1
  231.     dc& = _DEFAULTCOLOR: bgc& = _BACKGROUNDCOLOR
  232.     IF font& <> 0 THEN _FONT font&
  233.     IF mode < 3 THEN
  234.         'print the text lengthwise
  235.         w& = _PRINTWIDTH(text$): h& = _FONTHEIGHT
  236.     ELSE
  237.         'print the text vertically
  238.         FOR i = 1 TO LEN(text$)
  239.             IF w& < _PRINTWIDTH(MID$(text$, i, 1)) THEN w& = _PRINTWIDTH(MID$(text$, i, 1))
  240.         NEXT
  241.         h& = _FONTHEIGHT * (LEN(text$))
  242.     END IF
  243.     TextToImage& = _NEWIMAGE(w&, h&, 32)
  244.     _DEST TextToImage&
  245.     IF font& <> 0 THEN _FONT font&
  246.     COLOR fc&, bfc&
  247.  
  248.     SELECT CASE mode
  249.         CASE 1
  250.             'Print text forward
  251.             _PRINTSTRING (0, 0), text$
  252.         CASE 2
  253.             'Print text backwards
  254.             temp$ = ""
  255.             FOR i = 0 TO LEN(text$) - 1
  256.                 temp$ = temp$ + MID$(text$, LEN(text$) - i, 1)
  257.             NEXT
  258.             _PRINTSTRING (0, 0), temp$
  259.         CASE 3
  260.             'Print text upwards
  261.             'first lets reverse the text, so it's easy to place
  262.             temp$ = ""
  263.             FOR i = 0 TO LEN(text$) - 1
  264.                 temp$ = temp$ + MID$(text$, LEN(text$) - i, 1)
  265.             NEXT
  266.             'then put it where it belongs
  267.             FOR i = 1 TO LEN(text$)
  268.                 fx = (w& - _PRINTWIDTH(MID$(temp$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
  269.                 _PRINTSTRING (fx, _FONTHEIGHT * (i - 1)), MID$(temp$, i, 1)
  270.             NEXT
  271.         CASE 4
  272.             'Print text downwards
  273.             FOR i = 1 TO LEN(text$)
  274.                 fx = (w& - _PRINTWIDTH(MID$(text$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
  275.                 _PRINTSTRING (fx, _FONTHEIGHT * (i - 1)), MID$(text$, i, 1)
  276.             NEXT
  277.     END SELECT
  278.     _DEST 0
  279.     COLOR dc&, bgc&

Notice that the game gets consistently harder as you progress, with more walls blocking your path, and I must admit:  I didn't bother to have the program check to make certain that you can actually reach the target location.  In fact, I freely confess, if you keep playing, you'll eventually get to a stage where you WON'T be able to reach the target -- the non-intelligent randomness of this little demo WILL make it an impossible task eventually. 

ESC stops the program.
R will Relocate the target location.
Left/Right allows us to change heading.
Up moves us in the direction we're facing.
Down is a terrible cheat (intentionally left at this point, to allow full map movement), which moves us away from the direction we're facing. 

Try it out and see what you think; it's definitely different than most other quad-directional maze-generators which I've seen and played around with in the past.  :)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Map Making maybe Editor
« Reply #29 on: August 23, 2018, 09:56:57 pm »
Hey Steve, very nice!

I find it hard to turn in the direction I want when the arrow is pointed down, so backwards is the best way to travel!
I see why you say it's a terrible cheat! but it does allow the game to continue when you get trapped.

Fun stuff!