Latest update of Pathfinder 4 has some interesting changes:
#1 the diagonal stepping has been eliminated greatly simplifying code, plus more realistic paths through mazes.
#2 you can make paths to destination points (look like square targets) by moving obstacles around.
#3 the blue door takes you to new map and the maps all start with blue door as destination which can be changed by clicking other places on map.
No fancy tiling or anything just working out mechanics of a game setup.
Moving obstacles around is possible because multiple keys can be read:
_KEYHIT can report when keys are down and released (with negative numbers return) this is handy for taking one step at a time with arrow keys to move hero (what we call the main player).
_KEYDOWN(key_const) can report multiple keys being pressed True/False
So that the combined use of key report functions allows me to program the moving of items around including the blue door exit to another map.
_TITLE "PathFinder 4, No diagonal movements"
'QB64 X 64 version 1.2 20180228/86 from git b301f92
' version 4: Pathfinder or Path Maker!
' ================================ Instructions ==============================================
' ctrl + Arrow will haul a green obstacle
' shift + Arrow will push a green obstacle as long as there is a space on the other side of it.
' With a new map the destination for paths is set the same as the blue door, see target.
' The destination can be reset by clicking the map.
' The blue square is the exit or door to another map, so is pressing n for new.
' A yellow path will appear between the white hero player and the destination if the way is not
' blocked. If it is, you can usually clear a path to the door by moving obstacles around.
' When you clear a path the yellow path will light up. esc to quit.
' Oh yeah, you can haul the door around too.
'
' It is strangely fun to move the green obstacles around, like sculpting with a bull dozer.
' I am thinking maybe some sort of landscaping game.
'=============================================================================================
' History of development:
' started 2018-08-11 when Colbalt asked about A* pathfinder
' He has now 2018-08-12 posted a QB64 version that is nice!
' 2018-08-11 started PathFinder 1
' 2018-08-12 almost working but buggy backtract to point A after point B is found.
' 2018-08-13 PathFinder 1a.bas I think I have a fix for buggy path BackTrack but major surgery so this new version
' 2018-08-14 Pathfinder 2: 2 parts
' Part 1: creates a map, a random Home point and backtracts all the points available to move over.
' Part 2: allows clicking variaous points of map to see if path is found.
' 2018-08-15 PathFinder 3: Make a function that returns a path from A to B given A, B
' The map is shared as well as it's dimensions mapw by maph (constants).
' The function will create a copy of map and work with that so main map remains intact.
' Well I suppose we need aa random map maker for starters.
' And then of course a sub to display the map.
' OK I am now working under the influence of Steve McNeil's programs. ;)
' Thanks Steve some great ideas for simplfying the PathFinder for actual game use.
' 2018-08-17 With Pathfinder 3 I want to start working code towards game using MAP(s)
' I am also under the influence of PMACKAY's game series Mr Bash or Dash or whatever he decides to call the Diamond Miner.
' Thanks PMACKAY, I love the little game you started and have learned from your questions and setup.
'2018-08-18 Pathfinder 3a, I have 3 working with ticks but it changes all after running through the whole tick session.
' 3a tests whether I can do this with Steve's version which changes immediately and not after whole tick session.
' It is allot simpler and will run faster than saving all changes in a container and reprocessing into step array.
' I tried this before but I think I know what I did wrong then, I did not check if value was = current tick.
' Before I think I just checked if the map had a value or not written in, no only current tick values should parent a new cell.
' Finally found the frick'in bug!!! had cy instead of cx, OK let's see if can draw the path from Steps array.
' OK now prepStepMap in called in the Path routine and working.
'2018-08-19 PathFinder 4 add the needed Push Mode to compliment the Haul mode
'2018-08-23 PathFinder 4 DO PATHS USING ONLY VERTCAL AND HORIZONTAL MOVEMENT
' Also use _keydown for push / haul modes, forget having to toggle modes On and Off.
' Use left hand Ctrl+ Arrow to Haul and Shift + Arrow to Push, when both down, neither work.
' Extracted Hero from being emedded in the map.
' Draw the Hero tile on a second layer over the floor = spacer tile.
'
DEFINT A-Z
' Decided to use integer values with Descriptive CONST names, thanks Tempodibasic
' Using ALL CAP's for CONSTants, user defined TYPE, and SHARED variables,
' but short mnuemonic abrev because I hate typing long descriptions,
' so if you forget what the cap'd variable name means, check back to this main section.
CONST TRUE = -1
CONST FALSE = 0
CONST WW = 1060 ' Window Width in pixels
CONST WH = 720 ' Window Height in pixels
CONST SQ = 30 ' Square Size in pixels
CONST MAPW = 30 ' MAP number of squares Wide or Width
CONST MAPH = 20 ' MAP number of squares High or Height
' MAP ITEMS
' CONST HERO = -1 no longer embedded in map
CONST BORDER = -2
CONST OBSTACLE = -3
CONST SPACER = 0
CONST DOOR = -4
'following Steve's example
TYPE COORDINATE
X AS INTEGER
Y AS INTEGER
END TYPE
SCREEN _NEWIMAGE(WW, WH, 32)
_SCREENMOVE _MIDDLE ' ah this is working better now! is it the 64X64 version?
RANDOMIZE TIMER
'The MAP:
'There will be a 1 SQ Border around the Map, the actual squares for game action run 1 to MAPW, 1 to MAPH
DIM SHARED MAP(MAPW + 2, MAPH + 2) AS INTEGER
DIM SHARED HC AS COORDINATE 'Hero Coordinate
DIM SHARED HDC AS COORDINATE 'Hero Destination Coordinate
DIM SHARED MX AS COORDINATE 'Map Exit, AKA Door
'This will be a map used for getting paths from HC = Hero Coordinate to HDC = Hero Destination Coordinate
DIM SHARED STEPMAP(MAPW + 2, MAPH + 2) AS INTEGER
DIM SHARED STEPS(MAPH * MAPW) AS COORDINATE
DIM SHARED STEPSI AS INTEGER 'counts steps
DIM SHARED XOFF, YOFF, HAULMODE AS _BYTE, PUSHMODE AS _BYTE
DIM t AS COORDINATE
XOFF = (WW - SQ * (MAPW + 2)) / 2
YOFF = (WH - SQ * (MAPH + 2)) / 2
HAULMODE = 0: PUSHMODE = 0
DO
'this part sets up a sample map, and here the door is created
RandomMap .7
'set door as first destination for pathing
HDC.X = MX.X: HDC.Y = MX.Y
'find free space to start hero
DO
testx = Rand(1, MAPW): testy = Rand(1, MAPH)
LOOP UNTIL MAP(testx, testy) = SPACER
HC.X = testx: HC.Y = testy
'this part displays the ability to find a path to blue square anywhere in the maze
_TITLE "ctrl+Arrow <haul, shift+Arrow >push, Click to set destination, n or blue door for new map, esc=quit"
DO
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) THEN
xm = _MOUSEX - XOFF - .5 * SQ
ym = _MOUSEY - YOFF - .5 * SQ
t.X = xm / SQ: t.Y = ym / SQ
IF t.X >= 1 AND t.X <= MAPW AND t.Y >= 1 AND t.Y <= MAPH THEN
HDC.X = t.X: HDC.Y = t.Y
END IF
END IF
KH& = _KEYHIT
IF _KEYDOWN(100306) THEN HAULMODE = TRUE ELSE HAULMODE = fales 'ctrl
IF _KEYDOWN(100304) THEN PUSHMODE = TRUE ELSE PUSHMODE = FALSE 'shft
IF PUSHMODE AND HAULMODE THEN PUSHMODE = FALSE: HAULMODE = FALSE
SELECT CASE KH&
CASE 18432 'up
IF MAP(HC.X, HC.Y - 1) = DOOR THEN EXIT DO
IF MAP(HC.X, HC.Y - 1) = SPACER THEN
IF HAULMODE AND MAP(HC.X, HC.Y + 1) < -2 THEN
MAP(HC.X, HC.Y) = MAP(HC.X, HC.Y + 1)
MAP(HC.X, HC.Y + 1) = SPACER
HC.Y = HC.Y - 1
ELSEIF HAULMODE = FALSE AND PUSHMODE = FALSE THEN
HC.Y = HC.Y - 1
END IF
ELSEIF MAP(HC.X, HC.Y - 2) = SPACER AND MAP(HC.X, HC.Y - 1) < -2 AND PUSHMODE THEN
MAP(HC.X, HC.Y - 2) = MAP(HC.X, HC.Y - 1)
MAP(HC.X, HC.Y - 1) = MAP(HC.X, HC.Y)
HC.Y = HC.Y - 1
END IF
CASE 20480 'down
IF MAP(HC.X, HC.Y + 1) = DOOR THEN EXIT DO
IF MAP(HC.X, HC.Y + 1) = SPACER THEN
IF HAULMODE = TRUE AND MAP(HC.X, HC.Y - 1) < -2 THEN
MAP(HC.X, HC.Y) = MAP(HC.X, HC.Y - 1)
MAP(HC.X, HC.Y - 1) = SPACER
HC.Y = HC.Y + 1
ELSEIF HAULMODE = FALSE AND PUSHMODE = FALSE THEN
HC.Y = HC.Y + 1
END IF
ELSEIF MAP(HC.X, HC.Y + 2) = SPACER AND MAP(HC.X, HC.Y + 1) < -2 AND PUSHMODE THEN
MAP(HC.X, HC.Y + 2) = MAP(HC.X, HC.Y + 1)
MAP(HC.X, HC.Y + 1) = MAP(HC.X, HC.Y)
HC.Y = HC.Y + 1
END IF
CASE 19200 'left
IF MAP(HC.X - 1, HC.Y) = DOOR THEN EXIT DO
IF MAP(HC.X - 1, HC.Y) = SPACER THEN
IF HAULMODE AND MAP(HC.X + 1, HC.Y) < -2 THEN
MAP(HC.X, HC.Y) = MAP(HC.X + 1, HC.Y)
MAP(HC.X + 1, HC.Y) = SPACER
HC.X = HC.X - 1
ELSEIF HAULMODE = FALSE AND PUSHMODE = FALSE THEN
HC.X = HC.X - 1
END IF
ELSEIF MAP(HC.X - 2, HC.Y) = SPACER AND MAP(HC.X - 1, HC.Y) < -2 AND PUSHMODE THEN
MAP(HC.X - 2, HC.Y) = MAP(HC.X - 1, HC.Y)
MAP(HC.X - 1, HC.Y) = SPACER
HC.X = HC.X - 1
END IF
CASE 19712 'right
IF MAP(HC.X + 1, HC.Y) = DOOR THEN EXIT DO
IF MAP(HC.X + 1, HC.Y) = SPACER THEN
IF HAULMODE = TRUE AND MAP(HC.X - 1, HC.Y) < -2 THEN
MAP(HC.X, HC.Y) = MAP(HC.X - 1, HC.Y)
MAP(HC.X - 1, HC.Y) = SPACER
HC.X = HC.X + 1
ELSEIF HAULMODE = FALSE AND PUSHMODE = FALSE THEN
HC.X = HC.X + 1
END IF
ELSEIF MAP(HC.X + 2, HC.Y) = SPACER AND MAP(HC.X + 1, HC.Y) < -2 AND PUSHMODE THEN
MAP(HC.X + 2, HC.Y) = MAP(HC.X + 1, HC.Y)
MAP(HC.X + 1, HC.Y) = MAP(HC.X, HC.Y)
HC.X = HC.X + 1
END IF
END SELECT
IF _KEYDOWN(27) THEN END
IF _KEYDOWN(ASC("n")) THEN EXIT DO
displayMap
_LIMIT 100
LOOP
LOOP UNTIL _KEYDOWN(27)
SUB path (ptB AS COORDINATE)
'path is from hero (DIM SHARED HC as COORDINATE) to ptB (DIM SHARED HDC
prepStepMap ptB
dist = STEPMAP(HC.X, HC.Y) 'STEPMAP is DIM SHARED as INTEGER
STEPSI = 0 'DIM SHARED, no path is signaled if still 0 after this sub
IF dist = 0 THEN EXIT SUB
cx = HC.X: cy = HC.Y
'count dist down to destination
WHILE dist >= 2
cf = 0
IF STEPMAP(cx, cy - 1) = dist - 1 THEN
cf = 1: cy = cy - 1
ELSEIF STEPMAP(cx - 1, cy) = dist - 1 THEN
cf = 1: cx = cx - 1
ELSEIF STEPMAP(cx + 1, cy) = dist - 1 THEN
cf = 1: cx = cx + 1
ELSEIF STEPMAP(cx, cy + 1) = dist - 1 THEN
cf = 1: cy = cy + 1
END IF
IF cf = 0 THEN 'lost path, this should not happen until it is done
EXIT SUB
ELSE
'add next step to steps array, set next search target
STEPSI = STEPSI + 1: STEPS(STEPSI).X = cx: STEPS(STEPSI).Y = cy
dist = dist - 1
END IF
WEND
END SUB
'this is Steve McNeil's method optimised to skip over needless or redundant checks
SUB prepStepMap (target AS COORDINATE)
FOR y = 1 TO MAPH
FOR x = 1 TO MAPW
STEPMAP(x, y) = 0
NEXT
NEXT
STEPMAP(target.X, target.Y) = 1: tick = 1: changes = 1
'from an ever broadening area around destination find neighbor to step from
WHILE changes
t = tick: tick = tick + 1: changes = 0
ystart = max(target.Y - tick, 1): ystop = min(target.Y + tick, MAPH)
FOR y = ystart TO ystop
xstart = max(target.X - tick, 1): xstop = min(target.X + tick, MAPW)
FOR x = xstart TO xstop
'check out the neighbors
IF MAP(x, y) = SPACER THEN
IF STEPMAP(x, y) = 0 THEN
IF STEPMAP(x, y - 1) = t OR STEPMAP(x - 1, y) = t OR STEPMAP(x + 1, y) = t OR STEPMAP(x, y + 1) = t THEN
'there is a step close by to step from
STEPMAP(x, y) = tick: changes = 1 'next step
END IF
END IF 'stepmap = 0
END IF 'map = spacer
NEXT
NEXT
WEND
END SUB
SUB displayMap 'all drawing instructions conatined here
'MAP is shared, 1 based with width = mapw, height = maph that are constants
DIM k AS LONG 'kolor tiles
CLS
FOR y = 0 TO MAPH + 1
FOR x = 0 TO MAPW + 1
SELECT CASE MAP(x, y)
'CASE HERO: k = _RGB32(255, 255, 255) 'not embedded in map anymore
CASE BORDER: k = _RGB32(255, 128, 64)
CASE OBSTACLE: k = _RGB32(0, 128, 0)
CASE SPACER: k = _RGB32(0, 0, 0)
CASE DOOR: k = _RGB32(0, 0, 255)
END SELECT
LINE (x * SQ + XOFF, y * SQ + YOFF)-STEP(SQ - 2, SQ - 2), k, BF
NEXT
NEXT
'loads steps array with steps from hero to destination from prepared stepmap array,
'stepsI is number of steps to destination unless = 0
path HDC
IF STEPSI <> 0 THEN
FOR s = 1 TO STEPSI
LINE (STEPS(s).X * SQ + XOFF + 10, STEPS(s).Y * SQ + YOFF + 10)-STEP(SQ - 20, SQ - 20), _RGB32(255, 255, 0), BF
NEXT
END IF
'draw target or destination
FOR i = 6 TO 10 STEP 2
LINE (HDC.X * SQ + XOFF + i - 1, HDC.Y * SQ + YOFF + i - 1)-STEP(SQ - 2 * i, SQ - 2 * i), _RGB32(255, 255, 255), BF
LINE (HDC.X * SQ + XOFF + i, HDC.Y * SQ + YOFF + i)-STEP(SQ - 2 * i - 2, SQ - 2 * i - 2), _RGB32(255, 0, 0), BF
NEXT
'draw hero
LINE (HC.X * SQ + XOFF + 1, HC.Y * SQ + YOFF + 1)-STEP(SQ - 4, SQ - 4), _RGB32(255, 255, 255), BF
'special keys = powers
LOCATE 1, 90: PRINT SPACE$(30)
IF PUSHMODE THEN LOCATE 1, 90: PRINT "Push Mode is ON."
IF HAULMODE THEN LOCATE 1, 90: PRINT "Haul Mode is ON."
_DISPLAY
END SUB
'someone might start with this a build a map or levels editor!
'load a shared MAP(1 to mapw, 1 to maph)
SUB RandomMap (obstacleDensity!) ' obstacleDensity! = fraction of map squares to make obstacles
'MAP is shared, 1 based with width = mapw, height = maph that are constants
'clear last map
FOR y = 1 TO MAPH
FOR x = 1 TO MAPW
MAP(x, y) = SPACER
NEXT
NEXT
'borders
FOR x = 0 TO MAPW + 1
MAP(x, 0) = BORDER
MAP(x, MAPH + 1) = BORDER
NEXT
FOR y = 0 TO MAPH + 1
MAP(0, y) = BORDER
MAP(MAPW + 1, y) = BORDER
NEXT
'convert this part into walls, buildings, jewels, potions...
'with these obstacles there is no guarantee a path will exist
FOR I = 1 TO MAPW * MAPH * obstacleDensity!
ox = Rand(1, MAPW): oy = Rand(1, MAPH)
MAP(ox, oy) = OBSTACLE
NEXT
'door, exit to next map near a border?
wall = Rand(1, 4)
SELECT CASE wall
CASE 1: MX.X = 1: MX.Y = Rand(2, MAPH - 2)
CASE 2: MX.X = MAPW: MX.Y = Rand(2, MAPH - 2)
CASE 3: MX.X = Rand(2, MAPW - 2): MX.Y = 1
CASE 4: MX.X = Rand(2, MAPW - 2): MX.Y = MAPH
END SELECT
MAP(MX.X, MX.Y) = DOOR
END SUB
'handy functions
FUNCTION Rand% (lo%, hi%)
Rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION
FUNCTION min (n1, n2)
IF n1 > n2 THEN min = n2 ELSE min = n1
END FUNCTION
FUNCTION max (n1, n2)
IF n1 < n2 THEN max = n2 ELSE max = n1
END FUNCTION
