The island - An RTS game

[leopardpm]

So if you had a lot of trees each tree would be at the lowest positions of a height map? The agent rolls down hill until it hits the bottom?

yup, exactly - at position 0... and the heatmap value in every cell is actually also the distance to the nearest tree (or destination)

And if you remove a tree you would have to redo the heat map?

yeah... BUT, there is a way to only redo the map that is effected by that particular tree, I need to think exactly about how the routine would go - but it would be much faster than re-generating the entire heatmap ... especially if it is a BIG worldmap!

By the way with your first example I pushed the code sections into their own subs so the main routine is just a few self commenting statements. I changed a few labels as well just to be annoying :)

not annoying at all! it looks WAY better and easier to read. I apologized for my very sloppy coding...

How do you like my latest example above with the bugs fixed and 45 agents running here and then there? kinda mesmerized I sit and watch the thing...

[leopardpm]

another way to use the heatmap is to make the entire path at once (follow the path downhill and saving each position in an array), so that each agent has its own path to follow which, once made, is separate from the heatmap - kinda like how A* will return an entire path to you. I don't know the advantage of doing so, but it would make it more compatible when using multiple pathfinding routines depending on the destination type, and then just a general routine to 'follow path' for movement....

I don't like the way the agents are currently pathing though, I need to change the heatmap to also have a direction vector pointing back towards the lower heat value tile. Right now, the units check all the tiles around them, and choose the first tile that is also the lowest value... if more than one option to go is available, it just chooses the first one it came across even if to the eye it looks like the unit moves away from destination.

[leopardpm]

And if you remove a tree you would have to redo the heat map?

to visualize... imagine the heatmap as hills and valleys: hills where there are no 'trees', and valleys surrounding each tree radiating outward. To update the heatmap for removing 1 tree, you change the 'valley' that it makes into a 'hill', exactly the opposite 'height'. But, to find the hill height, you need to radiate outward until you hit the crest of another valley, then turn around and fill in the valley with increasing values from the 'crest'... maybe that was too complicated a way to explain it... hills valleys and crests! oh my!

[leopardpm]

ok, the latest, greatest and I think I am done with this episode... pathing pretty much fixed (diagonals now count as 1.5 a regular movement, close enough) and now units don't go apparently wandering...

Code: Select all

const MaxAgents = 45

type agentinfo
    as integer x
    as integer y
    as integer done
end type

dim shared agents(MaxAgents) as agentinfo

type worldinfo
    as integer terrain
    as single heat
    as integer occupied
end type

dim shared worldmap(31,31) as worldinfo

dim shared as single dist(-1 to 1, -1 to 1)
dim shared as single d
                for sx as integer = -1 to 1
                    for sy as integer = -1 to 1
                        d = 3
                        if sx = 0 or sy = 0 then d = 2
                        dist(sx,sy) = d
                    next sy
                next sx


dim shared as integer distance, distance2, frontier

dim shared as integer holder
dim shared chra as string

sub MakeHeatMap
    distance = 0
do
    frontier = distance
    distance += 1
    for i as integer = 1 to 30
        for j as integer = 1 to 30

            if worldmap(i,j).heat = frontier then 'found a frontier tile
                ' now put all the surrounding tiles into the next frontier
                for sx as integer = -1 to 1
                    for sy as integer = -1 to 1
                        if sx = 0 and sy = 0 then
                            ' do nothing if center
                        else
                            distance2 = frontier + dist(sx,sy)
                            select case worldmap(i+sx,j+sy).heat
                            case -1 'empty!
                                worldmap(i+sx,j+sy).heat = distance2
                            case 999
                                'wall, do nothing
                            case else
                                if worldmap(i+sx,j+sy).heat > distance2 then
                                    worldmap(i+sx,j+sy).heat = distance2
                                end if
                            end select
                        end if
                    next sy
                next sx
            end if
        next j
    next i
loop until distance >= 100
end sub


' load WorldMap/heatmap
sub LoadMap

    restore map
    for i as integer = 0 to 31
        for j as integer = 0 to 31
            read worldmap(i,j).heat
        next j
    next i
end sub


' set initial positions of agents
sub PlaceAgents
    erase agents
    randomize
    for a as integer = 1 to MaxAgents
        do
            agents(a).x = int(rnd * 28) + 2
            agents(a).y = int(rnd * 28) + 2
        loop until worldmap(agents(a).x, agents(a).y).heat <> 999 and worldmap(agents(a).x, agents(a).y).heat <> 0
        worldmap(agents(a).x,agents(a).y).occupied = 1
    next a
end sub

Const W = 1200, H = 600
ScreenRes W, H, 32
Width W\8, H\8 '' Use 8*8 font

    distance = 0

    cls
    erase worldmap
    LoadMap
    MakeHeatMap
    PlaceAgents

' ok all set now for agents to path...
' hit space key to step through pathfinding
do
'    cls
' display map
    color rgb(255,255,255),rgb(0,0,0)
    locate 1, 10 : print using "Number of done agents = ## ";holder

    locate 3,1
    for i as integer = 0 to 31
        for j as integer = 0 to 31
            select case worldmap(i,j).heat
                case -1
                    color rgb(0,0,0),rgb(0,0,0)   ' nothing
                case 999
                    color rgb(0,0,255),rgb(0,0,0) ' obstacle/wall
                case 0
                    color rgb(0,255,0),rgb(0,0,0) ' destination
                case else
                    color rgb(0,30,30),rgb(0,0,0) ' heatmap
            end select
            dim as integer agenthere = 0
            for a as integer = 1 to MaxAgents
                if (agents(a).x = i) and  (agents(a).y = j) then agenthere = a
            next a
            if agenthere = 0 then
                print using "###";worldmap(i,j).heat;
            else
                if agents(agenthere).done = 1 then ' agent is done
                    color rgb(255,255,255),rgb(0,0,0) 'if done then make him white
                else    
                    color rgb(255,0,0),rgb(0,0,0)  ' not done? then make hime red
                end if
                
                chra = chr(65+agenthere)
                print "  ";chra;
            end if
        next j
        print : print ' next line
    next i

' move each agent to closest destination
    for a as integer = 1 to MaxAgents
        'find lowest surrounding tile on heatmap
        dim as integer lowX, lowY, lowdist
        dim as integer i = agents(a).x
        dim as integer j = agents(a).y
        
        lowdist = worldmap(i, j).heat
        if lowdist <= 3 then agents(a).done = 1 'if he next to destination then done
        
        if agents(a).done = 1 then 
            ' re-run heatmap, first update with all done agents...
            LoadMap
            for b as integer = 1 to MaxAgents
                if agents(b).done = 1 then worldmap(agents(b).x, agents(b).y).heat = 999
            next b
            MakeHeatMap
        else ' if he is not done...
            for sx as integer = -1 to 1
                for sy as integer = -1 to 1
                    ' is there a closer tile next to him?
                    dim as integer lx = i + sx, lY = j + sy
                    if sx = 0 and sy = 0 then
                        ' his tile, ignore it
                    else
                        if worldmap(lX, lY).heat < lowdist then    'if lower and...
                            if worldmap(lX, lY).occupied = 0 then  ' if not occupied...
                                lowX = lx : lowY = ly
                                lowdist = worldmap(lowX, lowY).heat
                            end if
                        end if
                    end if
                next sy
            next sx

    
            if lowdist < worldmap(i, j).heat then 'found a closer square, so move him
                worldmap(agents(a).x, agents(a).y).occupied = 0  'erase old location
                agents(a).x = lowX : agents(a).y = lowY
                worldmap(agents(a).x, agents(a).y).occupied = 1  'move to new location
            end if
        end if
    next a
    
    sleep 100
    
    chra = inkey
     
    holder = 0
    
    'check to see if all agents are done
    for a as integer = 1 to MaxAgents
        holder = holder + agents(a).done
    next a
    if holder = MaxAgents then chra = "r"
    
    if ucase(chra) = "R" then 'reset to new map
        sleep 1000
        cls
        erase worldmap
        LoadMap
        MakeHeatMap
        PlaceAgents
    end if
    

    
    loop until chra =  chr(27)
end




' world map
' 0 = destination tile, 999 = obstacle
Map:
data 999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999
data 999,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, 0, 0,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, 0, 0,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,999,999,999,999,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, 0, 0, 0,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,999,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, 0, 0,-1,-1,-1,-1,-1,-1,999
data 999,-1, 0,-1,-1,999,-1,999,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,999,-1,999,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,999,-1,999,999,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,999,999,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,999,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,999,999,999,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,999,999,999,999,999,999,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1, 0,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1, 0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1, 0,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,999
data 999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999

[BasicCoder2]

How do you like my latest example above with the bugs fixed and 45 agents running here and then there?

Yes very good. I now fully understand the heat map algorithm you have used and your demo code.

[leopardpm]

I now fully understand the heat map algorithm you have used and your demo code.

Do you think you will use heatmaps in your code, or stick with djistra's algo? or a combo with both for different occassions? they actually are basically the same thing except with the whole returning a path, exiting early when destination is reached, etc.... djistra's algo is just the heatmap generation, ending when destination is found and then making the path from going downhill. I guess a Heatmap is dijistra's algo, but to every cell in the map, not just to the destination

[BasicCoder2]

The heat map could be used to return a path when requested by a player without the calling programming knowing if the A* or a heat map was used.
Like you say it is a question of which is fast enough. For the small worlds I am using while seeing if I can get some simple simulation up and running the heat map will do fine.
.

[BasicCoder2]

I don't like the way the agents are currently pathing though, I need to change the heatmap to also have a direction vector pointing back towards the lower heat value tile. Right now, the units check all the tiles around them, and choose the first tile that is also the lowest value... if more than one option to go is available, it just chooses the first one it came across even if to the eye it looks like the unit moves away from destination.

Yes this is a major issue as I found out in the demo code below.
I am doing it differently to you in that I am keeping the heat map separate from the world map.
In the example below it will display the generated heat map.
Tap the key and it will show a graphic output with the red square being the agent.
Tap the key again and you will see it take an arc to the nearest destination rather than going straight to it.
.

Code: Select all

type AGENT
    as integer x
    as integer y
end type

dim shared as AGENT agent1
agent1.x = 10
agent1.y = 5

const MAPW = 32
const MAPH = 32

dim shared as integer heatMap(MAPW,MAPH)

sub loadHeatMap()
    for j as integer = 0 to MAPW-1
        for i as integer = 0 to MAPH-1
            read heatMap(i,j)
        next i
    next j
end sub

sub ShowHeatMap()
    cls
    locate 3,1
    for j as integer = 0 to MAPW-1
        for i as integer = 0 to MAPH-1
            if agent1.x = i and agent1.y = j then color rgb(255,0,0) else color rgb(255,255,255)
            print using "###"; heatMap(i,j);
        next i
        print
    next j
end sub

sub showWorld()
    cls
    for j as integer = 0 to MAPW-1
        for i as integer = 0 to MAPH-1
            if heatMap(i,j)=99 then
                line (i*8,j*8)-(i*8+7,j*8+7),rgb(128,128,128),bf
            elseif heatMap(i,j)=0 then
                line (i*8,j*8)-(i*8+7,j*8+7),rgb(0,255,0),bf
            else
                line (i*8,j*8)-(i*8+7,j*8+7),rgb(255,255,255),bf
            end if
        next i
        print
    next j
    line (agent1.x*8,agent1.y*8)-(agent1.x*8+7,agent1.y*8+7),rgb(255,0,0),bf
end sub

sub MakeHeatMap
    dim as integer distance
    dim as integer frontier
    dim as integer Heatmapend
    distance = 0
    do
        Heatmapend = -1
        frontier = distance
        distance += 1
        for j as integer = 1 to MAPW
            for i as integer = 1 to MAPH

                if heatMap(i,j) = frontier then
                    for sx as integer = -1 to 1
                        for sy as integer = -1 to 1
                            if heatMap(i+sx,j+sy) = -1 then
                                heatMap(i+sx,j+sy) = distance
                                Heatmapend = 0
                            end if
                        next sy
                    next
                    
                end if
            next i
        next j
        'showHeatMap
        'sleep
    loop until ((Heatmapend = -1) or (distance = 40))
end sub

sub moveAgent()
    dim as integer lowX, lowY, lowdist
    dim as integer i = agent1.x
    dim as integer j = agent1.y
        
    lowdist = heatMap(i, j)
    if lowdist <> 1 then
            
        for sx as integer = -1 to 1
            for sy as integer = -1 to 1
                
                ' is there a closer tile next to him?
                dim as integer lx = i + sx, lY = j + sy
                if sx = 0 and sy = 0 then
                    ' his tile, ignore it
                else
                    if heatMap(lX, lY) < lowdist then    'if lower and...
                        lowX = lx : lowY = ly
                        lowdist = heatMap(lowX, lowY)
                    end if
                end if
                
            next sy
        next sx
    end if
        
    if lowdist < heatMap(i, j) then 'found a closer square, so move him
        agent1.x = lowX : agent1.y = lowY
    end if

end sub


screenres 1200,600,32

'distance = 0


LoadHeatMap
MakeHeatMap
showHeatMap
sleep

showWorld
sleep
while heatMap(agent1.x,agent1.y)>1
    moveAgent
    showWorld
    sleep 100
wend
print "DONE"


sleep




' world map
' 0 = destination tile, 99 = obstacle

Map:
data 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99
data 99,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, 0, 0,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, 0, 0,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,99,99,99,99,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, 0, 0, 0,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,99,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, 0, 0,-1,-1,-1,-1,-1,-1,99
data 99,-1, 0,-1,-1,99,-1,99,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,99,-1,99,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,99,-1,99,99,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,99,99,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,99,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,99,99,99,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,99,99,99,99,99,99,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1, 0,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1, 0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1, 0,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,99
data 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99

[leopardpm]

yes, that was the issue I was seeing... but is fixed here, takes into account diagonal movement cost being higher so no more wide arcs - one other 'improvement' could be if there are multiple neighboring tiles with same low heatmap value, then have agent randomly pick which one to use... but not a big issue for the effort to do so, i think.

Was also playing with the world size and the heatmap generation get noticeably slower when you double or triple the world size... just needs some optimization is all, i think.

Code: Select all

const MaxAgents = 45
const MaxMapSize = 31

type agentinfo
    as integer x
    as integer y
    as integer done
end type

dim shared agents(MaxAgents) as agentinfo

type worldinfo
    as integer terrain
    as single heat
    as integer occupied
end type

dim shared worldmap(MaxMapSize,MaxMapSize) as worldinfo

dim shared as single dist(-1 to 1, -1 to 1)
dim shared as single d
                for sx as integer = -1 to 1
                    for sy as integer = -1 to 1
                        d = 3
                        if sx = 0 or sy = 0 then d = 2
                        dist(sx,sy) = d
                    next sy
                next sx


dim shared as integer distance, distance2, frontier

dim shared as integer holder
dim shared chra as string

sub MakeHeatMap
    distance = 0
do
    frontier = distance
    distance += 1
    for i as integer = 1 to (MaxMapSize-1)
        for j as integer = 1 to (MaxMapSize-1)

            if worldmap(i,j).heat = frontier then 'found a frontier tile
                ' now put all the surrounding tiles into the next frontier
                for sx as integer = -1 to 1
                    for sy as integer = -1 to 1
                        if sx = 0 and sy = 0 then
                            ' do nothing if center
                        else
                            distance2 = frontier + dist(sx,sy)
                            select case worldmap(i+sx,j+sy).heat
                            case -1 'empty!
                                worldmap(i+sx,j+sy).heat = distance2
                            case 999
                                'wall, do nothing
                            case else
                                if worldmap(i+sx,j+sy).heat > distance2 then
                                    worldmap(i+sx,j+sy).heat = distance2
                                end if
                            end select
                        end if
                    next sy
                next sx
            end if
        next j
    next i
loop until distance >= 120
end sub


' load WorldMap/heatmap
sub LoadMap

    restore map
    for i as integer = 0 to 31
        for j as integer = 0 to 31
            read worldmap(i,j).heat
        next j
    next i
end sub


' set initial positions of agents
sub PlaceAgents
    erase agents
    randomize
    for a as integer = 1 to MaxAgents
        do
            agents(a).x = int(rnd * 28) + 2
            agents(a).y = int(rnd * 28) + 2
        loop until worldmap(agents(a).x, agents(a).y).heat <> 999 and worldmap(agents(a).x, agents(a).y).heat <> 0
        worldmap(agents(a).x,agents(a).y).occupied = 1
    next a
end sub

Const W = 1400, H = 600
ScreenRes W, H, 32
Width W\8, H\8 '' Use 8*8 font

    distance = 0
dim tt as integer
    cls
    erase worldmap
    LoadMap
    MakeHeatMap
    PlaceAgents

' ok all set now for agents to path...
' hit space key to step through pathfinding
do
'    cls
' display map
    color rgb(255,255,255),rgb(0,0,0)
    locate 1, 10 : print using "Number of done agents = ## ";holder

    locate 3,1
    for i as integer = 0 to MaxMapSize
        for j as integer = 0 to MaxMapSize
            select case worldmap(i,j).heat
                case -1
                    color rgb(0,0,0),rgb(0,0,0)   ' nothing
                case 999
                    color rgb(0,0,255),rgb(0,0,0) ' obstacle/wall
                case 0
                    color rgb(0,255,0),rgb(0,0,0) ' destination
                case else
                    color rgb(0,30,30),rgb(0,0,0) ' heatmap
            end select
            dim as integer agenthere = 0
            for a as integer = 1 to MaxAgents
                if (agents(a).x = i) and  (agents(a).y = j) then agenthere = a
            next a
            if agenthere = 0 then
                print using "###";worldmap(i,j).heat;
            else
                if agents(agenthere).done = 1 then ' agent is done
                    color rgb(255,255,255),rgb(0,0,0) 'if done then make him white
                else    
                    color rgb(255,0,0),rgb(0,0,0)  ' not done? then make hime red
                end if
                
                chra = chr(65+agenthere)
                print "  ";chra;
            end if
            'pset (800+j,100+i)
            'line (800+j*3,100+i*3) - step (2,2),,BF
        next j
        print : print ' next line
    next i
'    sleep
'   if tt = 0 then tt = 1 : sleep 'only pause on the first time through to debug map

' move each agent to closest destination
    for a as integer = 1 to MaxAgents
        'find lowest surrounding tile on heatmap
        dim as integer lowX, lowY, lowdist
        dim as integer i = agents(a).x
        dim as integer j = agents(a).y
        
        lowdist = worldmap(i, j).heat
        if lowdist <= 3 then agents(a).done = 1 'if he next to destination then done
        
        if agents(a).done = 1 then 
            ' re-run heatmap, first update with all done agents...
            LoadMap
            for b as integer = 1 to MaxAgents
                if agents(b).done = 1 then worldmap(agents(b).x, agents(b).y).heat = 999
            next b
            MakeHeatMap
        else ' if he is not done...
            for sx as integer = -1 to 1
                for sy as integer = -1 to 1
                    ' is there a closer tile next to him?
                    dim as integer lx = i + sx, lY = j + sy
                    if sx = 0 and sy = 0 then
                        ' his tile, ignore it
                    else
                        if worldmap(lX, lY).heat < lowdist then    'if lower and...
                            if worldmap(lX, lY).occupied = 0 then  ' if not occupied...
                                lowX = lx : lowY = ly
                                lowdist = worldmap(lowX, lowY).heat
                            end if
                        end if
                    end if
                next sy
            next sx

    
            if lowdist < worldmap(i, j).heat then 'found a closer square, so move him
                worldmap(agents(a).x, agents(a).y).occupied = 0  'erase old location
                agents(a).x = lowX : agents(a).y = lowY
                worldmap(agents(a).x, agents(a).y).occupied = 1  'move to new location
            end if
        end if
    next a
    
    sleep 1
    
    chra = inkey
     
    holder = 0
    
    'check to see if all agents are done, by totalling up all the 'done' agents
    for a as integer = 1 to MaxAgents
        holder = holder + agents(a).done
    next a
    if holder = MaxAgents then chra = "r" '   if all done then reset the map as if user pressed 'R' key...
    
    if ucase(chra) = "R" then 'reset to new map
        sleep 1000
        cls
        erase worldmap
        LoadMap
        MakeHeatMap
        PlaceAgents
    end if

    loop until chra =  chr(27)
end

' world map
' 0 = destination tile, 999 = obstacle
Map:
data 999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999
data 999,  0, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1,999, -1, -1,999,999,999,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1,999, -1, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,  0,  0, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1,999, -1, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,  0,  0, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1,999,999,999,999,999, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,  0,  0,  0, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1,999, -1, -1, -1,999, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,  0,  0, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1,999, -1,999, -1,999, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1,999, -1,999,  0,999, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1,999, -1,999,999,999, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1,999, -1, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1,999, -1, -1, -1, -1, -1,999, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1,999,999,999,999,999,999,999,999,999, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1,999,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1,999, -1, -1, -1, -1, -1, -1,999,999,999, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1,999,999,999,999,999,999, -1, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1,  0, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1,  0, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1,  0, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,999
data 999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999

[leopardpm]

hey..

ITomi, are you still here? do these routines help you with your pathfinding, got any sample game code to show off? I really like your use of Warcraft I /II sprites... my favorite game back in the day...

[BasicCoder2]

... but is fixed here,...

Well done!!

You have an advantage in that you have played these games. I have been watching some video game play and tutorials trying to get the gist of what they actually do in order to try and make a little cut down demo game utilizing the mechanics of such simulations.

.

[leopardpm]

Was also playing with the world size and the heatmap generation get noticeably slower when you double or triple the world size... just needs some optimization is all, i think.

actually, I forgot that i just was very lazy and did brute force method... didn't use an array to keep track of the 'frontier' tiles so the routine iterates through entire map with each growth tick of the heatmap... probably about the slowest method I could use! lol! I thin I will fix that and then it will basically be a pure djistra's alog... will make a version of it for early exit when finds first destination, so then we will have both heatmap, and a point-to-point pathfinding

You have an advantage in that you have played these games.

I don't know if playing them helps, but I have been researching and coding gaming routines for long long time now... that is probably it.

I have been watching some video game play and tutorials trying to get the gist of what they actually do in order to try and make a little cut down demo game utilizing the mechanics of such simulations.

like what 'parts' of 'what they do''? Download the Towns Demo, and/or the game on steam called 'Retro-Pixel Castles' (for $5) - those two pretty much have everything we have been talking about with little dudes going about and doing things when general commands have been issued. The Towns demo is good in that is has multiple levels (you can dig down and find dungeons to explore), but sometimes it is hard to keep your townsfolk alive for very long (feeding them is a pain at first until they get farms up and running)

Have you sketched out any more 'goals' to your game/test that you want to try?

[BasicCoder2]

Have you sketched out any more 'goals' to your game/test that you want to try?

Had a few thoughts and will share later.

With regards to path finding I guess my emphasis is more on how we might do it. When Sydney Australia was colonized the Blue Mountains were a barrier to the plains beyond. No gps, no maps. We had explorers. One algorithm they used was "follow the ridges". Once a path was found it could be followed. An explorer can lay out a path and label the start with its destination. Where paths split a node with destination information could be stored. The Settler's game seemed to use user defined paths? And little flags to place things for other agents to pick up.

Anyway all this is not directly related to FreeBASIC. Maybe I can give you an email address to exchange ideas. I will pop one in a post in a form readable by a human but not readable to a bot when I think you are online and delete it later.
.

[leopardpm]

my email is leopardPM and is at gmail dot com

these subjects are not exactly Freebasic related, but figuring out Freebasic solutions to game routines in general is... I don't think folks mind and it is informative and perhaps entertaining to see the various things we attempt and the (unexpected) issues that pop up and how we (hopefully) overcome them... if conversation strays into unrelated territory, I am sure a moderator will step in and let us know...

When Sydney Australia was colonized the Blue Mountains were a barrier to the plains beyond. No gps, no maps. We had explorers. One algorithm they used was "follow the ridges"

kinda like how we do mazes with either the 'follow the left or right wall' algo until find the end

An explorer can lay out a path and label the start with its destination. Where paths split a node with destination information could be stored.

seems like alot of paths would be created and each one would not probably be the 'straightest' or best. But it does dovetail into the ability to 'track' things... have an 'explorer' just leave a trail in the worldmap that others could follow if they were looking for trails... but not a good general pathfinding method... I suppose that even in Australia after the first explorer found a path over the mountains, the next few paths improved upon it as shortcuts were found or easier ways to reach different parts. Probably the first path the explorer took was not exactly the final, made into a trail, that everyone used afterwards, right? I didn't know this bit of geography regarding australia.. interesting! thanks!

In thinking about 'explorers' or scouts, I would imagine a routine that kind of randomly explores unknown/unseen tiles, then once an interesting destination is discovered, an attempt to find a 'straighter' path back to the start would be made, perhaps uncovering even more interesting destinations in the process.

[BasicCoder2]

Have the email address if you now want to delete it.

In thinking about 'explorers' or scouts, I would imagine a routine that kind of randomly explores unknown/unseen tiles, then once an interesting destination is discovered, an attempt to find a 'straighter' path back to the start would be made, perhaps uncovering even more interesting destinations in the process.

Yes I think an "explorer" would be a worthwhile agent. The bouncing off obstacles example I gave isn't really of any use as that is not how we explore.
If explorer_1 gets to a target in less time than explorer_2 then we know who has the shortest path.
.