The island - An RTS game

[leopardpm]

as far as the obstacle avoidance during pathfinding, this is dealt with usually during 'steering' (http://www.red3d.com/cwr/steer/gdc99/) - a sub-part of pathfinding... Amit has a bunch of resources regarding ALL aspects of pathfinding/steering.... http://www-cs-students.stanford.edu/~am ... html#paths

[ITomi]

So, the possible solving is that the program has to create again the ways of the units when something changed (e.g. creating a new building)?

[leopardpm]

exactly... and the quickest way for multiple units is with heatmap which runs once... and also happens to be VERY easy to implement.... problem with heatmap is the destination tiles... all units will attempt to go to same tile instead of spreading out...

[BasicCoder2]

... problem with heatmap is the destination tiles... all units will attempt to go to same tile instead of spreading out...

Then spreading out needs to be added to the behavior. The target may be the first goal but allow it to be over ridden by other rules governing closeness to other agents and avoiding obstacles. Maybe one leader agent follows the heat map while others follow the leader at some distance.
.

[leopardpm]

was thinking about this... one way to incorporate this behavior into the heatmap is to designate all the tiles surrounding (neighboring) the destination, as destinations... then in the movement part of following the heatmap make an addition: if the next tile to move to is temporarily occupied, pick the neighboring tile with the next lowest distance score (this is part of the heatmap where each tile has a distance to destination). This should have all the units path to the destination and path around any dynamic objects (units, new buildings, etc) in the way, and then surround the destination with units (whether it is a multi-tile structure or even a single tile destination)... pretty nifty and easy addition I should think.

So, the initialization of the heatmap will have not just the single destination tile put into the 'frontier' array, but add all the destination tiles as frontiers - with distances of 0. The algo will then generate a heatmap accordingly. It is really in the movement routine where the difference will be programmed.

[BasicCoder2]

At this stage I haven't felt the need for a heat map relying on the A* routine if the destination is known.

Although these agents are meant to simulate people they are really only simple minded robots and it is that aspect that interests me. Dressing a machine up to look human doesn't make it in the least bit human in terms of behavior although those naive to the inner workings of such machines may imagine something is there that isn't.

Below is a crude code example of what I was suggesting where the mouse position is the destination.
I haven't added any obstacles or obstacle avoidance but the idea would be that if an agent hit an obstacle it would divert to an obstacle avoidance behavior until it could again "follow the leader" in some predetermined spatial arrangement.

It would need modifying to duplicate say a group of marching soldiers who have a "head" that rotates in the direction to be taken. The point is they can act as a group although should an individual hit an obstacle they may be temporarily be separated but having dealt with the obstacle would revert back to the group behavior. If a soldier goes down the group can rearrange itself (fill in the gap). I would see it as agents having a set of rules to follow according to their current spatial relationship with each other as you might see in the boid programs.

https://www.youtube.com/watch?v=rN8DzlgMt3M

Ants are also an interesting example of individuals following rule based behaviors resulting in a colony behavior. In their case memory is in the exchange of pheromones which can have a temporary or permanent change to the rules followed.

Code: Select all

screenres 640,480,32
dim shared as integer mx,my,mb

type AGENT
    as integer x
    as integer y
    as integer dx
    as integer dy
end type

dim shared as integer agentCount
agentCount = 8
dim shared as AGENT agents(0 to agentCount)

sub drawWorld()
    screenlock
    cls
    for i as integer = 0 to agentCount
        circle (agents(i).x,agents(i).y),5,rgb(255,255,255),,,,f
    next i
    screenunlock
end sub

for i as integer = 0 to agentCount
    agents(i).x=int(rnd(1)*640)
    agents(i).y=int(rnd(1)*480)
next i

dim as integer dx,dy,x,y
do
    drawWorld()
    getmouse mx,my,,mb
    'compute dx,dy of agents to move to mx,my as a group
    for i as integer = 0 to agentCount
        y = int(i/3)
        x = i-y*3
        x = x - 1
        y = y - 1
        agents(i).dx = sgn((mx+x*10)-agents(i).x)
        agents(i).dy = sgn((my+y*10)-agents(i).y)
    next i
    for i as integer = 0 to agentCount
        agents(i).x = agents(i).x + agents(i).dx
        agents(i).y = agents(i).y + agents(i).dy
        'test if move hit an obstacle in which case undo move and try something else
    next i

    sleep 20
loop until multikey(&H01)

[leopardpm]

I didn't have alot of time at the moment... but here is an example heatmap generator... ideally, it would also store the vector as well as the distance so movement is simpler, then once the map is made each unit just checks its tile vs the heatmap and goes to the next lowest tile (or just adds the vector info to its position to get next position)

Hate text display, but i had no time...

Code: Select all

dim as integer heatmap(50,50), Worldmap(50,50)

' clear heatmap to -1 values
for i as integer = 0 to 50
    for j as integer = 0 to 50
        heatmap(i,j) = -1
    next j
next i

' insert dest tiles here... the value (0) represents distance to destination
    heatmap(3,2) = 0
    heatmap(4,2) = 0
    heatmap(5,2) = 0
    heatmap(4,3) = 0
    
    heatmap(32,12) = 0
    heatmap(40,30) = 0
    
' inserting obstacle tiles ... value (-9)
    heatmap(5,5) = -9
    heatmap(21,14) = -9
    heatmap(31,11) = -9
    heatmap(30,11) = -9

dim as integer distance
dim as integer frontier
dim as integer Heatmapend

screenres 1600,1200,32

distance = 0

cls

do
    Heatmapend = -1
    frontier = distance
    distance += 1
    for i as integer = 1 to 44
        for j as integer = 1 to 44

            if heatmap(i,j) = 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 not already set...
                        if heatmap(i+sx,j+sy) = -1 then
                            heatmap(i+sx,j+sy) = distance
                            Heatmapend = 0
                        end if
                    next sy
                next sx
            end if
        next j
    next i

    ' print it out to see the map
    locate 1, 50 : print using "distance = ###";distance
    locate 1,1
    for i as integer = 0 to 45
        for j as integer = 0 to 45
            select case heatmap(i,j)
            case -1
                color rgb(0,0,0),rgb(0,0,0)
            case -9
                color rgb(0,0,255),rgb(0,0,0)
            case 0
                color rgb(0,255,0),rgb(0,0,0)
            case else
                dim as integer clr
                if heatmap(i,j) < 10 then
                    clr = 255 - (heatmap(i,j) * 18)
                else
                    clr = 60
                end if
                
                color rgb(0,clr,0),rgb(0,0,0)
                end select
            print using " ## ";heatmap(i,j);
        next j
        print : print ' next line
    next i
    sleep
loop until ((Heatmapend = -1) or (distance = 50))

sleep

end

UPDATED CODE: added some color to help understand the heatmap.... the program requires you to keep hitting a key to step through the generation process...

[BasicCoder2]

Boids simulate flying objects according to three rules – goal direction, alignment, attraction and repulsion.

Here is another example that shows the goal position, attraction, repulsion but not alignment. The mouse position is the target (it can keep moving).

The agents move toward the target (goal) to within a fixed distance but cannot occupy the same position as other agents.

Code: Select all

screenres 640,480,32
dim shared as integer mx,my,mb
type AGENT
    as integer x
    as integer y
    as integer dx
    as integer dy
end type

dim shared as integer agentCount
agentCount = 8
dim shared as AGENT agents(0 to agentCount)

sub drawWorld()
    screenlock
    cls
    for i as integer = 0 to agentCount
        circle (agents(i).x,agents(i).y),5,rgb(255,255,255),,,,f
    next i
    screenunlock
end sub

for i as integer = 0 to agentCount
    agents(i).x=int(rnd(1)*640)
    agents(i).y=int(rnd(1)*480)
next i

dim as integer dx,dy,x,y,hit
dim as double d1
do
    drawWorld()
    getmouse mx,my,,mb
    'compute dx,dy of agents to move to mx,my as a group
    for i as integer = 0 to agentCount
        'if too far away move toward it, if too close move away from it
        d1 = sqr((agents(i).x - mx)^2 + (agents(i).y - my)^2)
        if d1 > 50 then
            agents(i).dx = sgn((mx)-agents(i).x)
            agents(i).dy = sgn((my)-agents(i).y)
        else
            agents(i).dx = sgn(agents(i).x-mx)
            agents(i).dy = sgn(agents(i).y-my) 
        end if
        agents(i).x = agents(i).x + agents(i).dx
        agents(i).y = agents(i).y + agents(i).dy
        'undo move if hits obstacle
        hit = 0
        for j as integer = 0 to agentCount
            if i<>j then
                d1 = sqr((agents(i).x-agents(j).x)^2+(agents(i).y-agents(j).y)^2)
                if d1 < 10 then
                    hit = 1
                end if
            end if
        next j
        if hit = 1 then  'undo move
            agents(i).x = agents(i).x - agents(i).dx
            agents(i).y = agents(i).y - agents(i).dy
        end if
        
    next i

    sleep 20
loop until multikey(&H01)

[leopardpm]

That is fun, BC!

[BasicCoder2]

And no candy eye isometric displays involved!
However are we addressing any of ITomi's issues?
I wonder if this is ITomi utube?
https://www.youtube.com/watch?v=PI4X4wIxFpA
.

[leopardpm]

I wonder if this is ITomi utube?

don't think so.... considering the questions he is asking are shown solved in that game so he would know this stuff already

[leopardpm]

ok, took some time to make better considering BC's excellent 'boid' examples...

problem is, the agents can get stuck, so need a special case scenario I can't figure out atm... but it mostly works... all the agents path to the closest destination, but get stuck if blocked by other agents... could re-run heatmap with the agents that are 'done' considered as obstacles...

note - this code is off the cuff, very yucky and can be extremely more efficient....

Code: Select all

type agentinfo
    as integer x
    as integer y
end type

dim agents(20) as agentinfo

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

dim worldmap(31,31) as worldinfo

' load WorldMap/heatmap
for i as integer = 0 to 31
    for j as integer = 0 to 31
        read worldmap(i,j).heat
    next j
next i

dim as integer distance
dim as integer frontier
dim as integer Heatmapend
dim chra as string

screenres 1200,600,32

distance = 0

cls

do
    Heatmapend = -1
    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 not already set...
                        if worldmap(i+sx,j+sy).heat = -1 then
                            worldmap(i+sx,j+sy).heat = distance
                            Heatmapend = 0
                        end if
                    next sy
                next sx
            end if
        next j
    next i

    ' print it out to see the map
    color rgb(255,255,255),rgb(0,0,0)
    locate 1, 1 : print using "distance = ###";distance
    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)
            case 99
                color rgb(0,0,255),rgb(0,0,0)
            case 0
                color rgb(255,0,0),rgb(0,0,0)
            case else
                dim as integer clr
                if worldmap(i,j).heat < 10 then
                    clr = 255 - (worldmap(i,j).heat * 18)
                else
                    clr = 60
                end if
                
                color rgb(0,clr,0),rgb(0,0,0)
                end select
            print using " ## ";worldmap(i,j).heat;
        next j
        print : print ' next line
    next i

loop until ((Heatmapend = -1) or (distance = 20))

' ok all set now for agents moving...
' set initial positions of agents
randomize
for a as integer = 1 to 20
    agents(a).x = int(rnd * 28) + 2
    agents(a).y = int(rnd * 28) + 2
    while worldmap(agents(a).x, agents(a).y).heat = 99
        agents(a).x = int(rnd * 28) + 2
        agents(a).y = int(rnd * 28) + 2
    wend
    worldmap(agents(a).x,agents(a).y).occupied = 1
next a
    
' hit space key to step through pathfinding...
do
' display map
    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)
                case 99
                    color rgb(0,0,255),rgb(0,0,0)
                case 0
                    color rgb(0,255,0),rgb(0,0,0)
                case else
                    color rgb(0,127,127),rgb(0,0,0)
            end select
            dim as integer agenthere = 0
            for a as integer = 1 to 20
                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
                color rgb(255,0,0),rgb(0,0,0)
                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 20
        'find lowest surrounding tile on heatmap
        dim as integer lowX, lowY, lowdist = 50
        dim as integer i = agents(a).x
        dim as integer j = agents(a).y
        if worldmap(i,j).heat > 1 then ' if he is more than 1 square away...
            for sx as integer = -1 to 1
                for sy as integer = -1 to 1
                    ' is there a closer tile next to him?
                    if worldmap(i+sx,j+sy).heat < lowdist then    'if lower and...
                        if worldmap(i+sx,j+sy).occupied = 0 then  ' if not occupied...
                            lowdist = worldmap(i+sx,j+sy).heat
                            lowX = i+sx
                            lowY = j+sy
                        end if
                    end if
                next sy
            next sx

    
            if lowdist < 99 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
            else
                ' don't move, he is stuck or done...
            end if
        end if
    next a
    
    sleep
    loop until inkey =  chr(27)
end




' world map
' 0 = destination tile, 99 = obstacle
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]

ok, here is the actual, working, doesn't get stuck version. All agents will path towards nearest destination, and surround it, while avoiding each other. This program does NOT take into consideration if the destination is completely surrounded already... it should then path to another destination that has open tiles around it.

To use routine to send workers to a building, then set all the building tiles on heatmap to '0" - if the building has every adjacent tile occupied, then this is a problem...

To use routine to have workers pick a nearest tree to go n chop, set all the tree tiles in the heatmap to '0' - they we go to the tree that is closest to them, if tree is already surrounded, then they will go to another tree.

There are MANY optimizations to be done, and the heatmap generation is just brute force and relatively slow.... but it only needs to be called once, and then once each time a unit reaches their destination. One thing that would make the pathing much better is to also save the vector info in the heatmap which will point to the right direction to path.... right now their paths can look a bit weird...

NOTE: this routine is currently setup using diagonals and treats diagonal movement the same 'cost' as a straight movement - I assume that there will be a terrain cost at some point and this diagonal movement should be fixed at that point (heatmap value = 1.41 * Terrain cost if diagonal, else heatmap value = terrain cost)


Press 'R' to reset the map and show again, press ESC to end program, press SPACE to step through their pathing

there is a bug where an agent gets into a destination tile, i don't know why yet... but the program will not then auto-reset the map and you need to press the 'R' key to manually do it... stupid bugs!

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 integer heat
    as integer occupied
end type

dim shared worldmap(31,31) as worldinfo

dim shared as integer distance
dim shared as integer frontier
dim shared as integer Heatmapend
dim shared as integer holder
dim shared chra as string

sub MakeHeatMap
    distance = 0
do
    Heatmapend = -1
    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 not already set...
                        if worldmap(i+sx,j+sy).heat = -1 then
                            worldmap(i+sx,j+sy).heat = distance
                            Heatmapend = 0
                        end if
                    next sy
                next sx
            end if
        next j
    next i
loop until ((Heatmapend = -1) or (distance = 40))
end sub

sub ShowMap
    ' print it out to see the map
    color rgb(255,255,255),rgb(0,0,0)
    locate 1, 1 : print using "distance = ###";distance
    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)
            case 99
                color rgb(0,0,255),rgb(0,0,0)
            case 0
                color rgb(255,0,0),rgb(0,0,0)
            case else
                dim as integer clr
                if worldmap(i,j).heat < 10 then
                    clr = 255 - (worldmap(i,j).heat * 18)
                else
                    clr = 60
                end if
                
                color rgb(0,clr,0),rgb(0,0,0)
                end select
            print using " ## ";worldmap(i,j).heat;
        next j
        print : print ' next line
    next i
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 <> 99 and worldmap(agents(a).x, agents(a).y).heat <> 0
        worldmap(agents(a).x,agents(a).y).occupied = 1
    next a
end sub

screenres 1200,600,32

distance = 0

cls
    erase worldmap
LoadMap
MakeHeatMap
'ShowMap
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 99
                    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 = 1 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 = 99
            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
        ShowMap
        PlaceAgents
    end if
    

    
    loop until chra =  chr(27)
end




' 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]

so... heatmaps are both easy to program AND pretty powerful. Imagine... if you had a heatmap for Trees, one for water, one for Ore, one for the Lumberyard, one for the Ore Refinery,etc.... all you would need to do is have a variable for each agent which tells them which heatmap to path on (lumberjack, miner, etc) and they could very easily be made to: go find nearest tree, chop wood for x time, take wood to lumberyard, go and find another tree, if they get thirsty at any time then go to nearest water, then resume being a lumberjack, or miner, or whatever... and all this WITHOUT any real 'AI', just heatmap pathfinding. I would make the WorldMap array have all the heatmaps and terrain... kinda like this:

Code: Select all

type worldinfo
	as byte terraintype
	as byte terrainhealth   '<---- this variable keeps track of how much wood is left in tree, or Ore at mining node, etc
	as byte heatTree
	as byte heatOre
	as byte heatWater
	as byte heatLumberyard
	as byte heatOreRefinery
end type

and code the terrain in data statements like this, grouped by 'passibility' so is an easy test of terrain to see if unit can go there:
0 = null
1 = grass, flat
2 = path
3 = ore, impassable
4 = tree, impassable
5 = water, impassable
6 = hill, impassable
7 = lumberyard (make it multi-tile)
8 = ore refinery (make it multi-tile)

when reading in the data statements, also put '0' in the corresponding heatmap. Then after all data is read in, make all the heatmaps. As trees are cut down or an Ore node is mined out, modify the WorldMap array and re-run that heatmap. Same if you want new trees to sprout up, or random Ore deposits to spring up. This can provide you with some very decent basic AI without getting all into FSMs and Behavior trees, etc. You can even make units 'run away' from enemies (or Attack!) by having an EnemyHeatmap... but since that needs alot of updating, need to have the heatmap routine optimal and not brute force as I currently have it.

The major limitation of heatmaps is for dynamic destinations.... unless ALOT of units are pathing to the same dynamic destination (like a moving enemy unit), then heatmap method will be too slow... though it IS possible to vastly increase the efficiency of the generation AND a pretty quick way to also update a map(for instance, as each thing changes, no need to rerun the whole map - just work backwards from the thing that changed until you get to about halfway to the next 'same thing' (tree, etc) - MUCH quicker than re-generating whole darned map!

[BasicCoder2]

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?
And if you remove a tree you would have to redo the heat map?

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 :)

Code: Select all

type AGENT
    as integer x
    as integer y
end type

dim shared agents(20) as AGENT

type CELL
    as integer terrain
    as integer heat
    as integer occupied
end type

dim shared world(31,31) as CELL


sub loadWorld()
    for i as integer = 0 to 31
        for j as integer = 0 to 31
            read world(i,j).heat
        next j
    next i
end sub


dim shared as integer distance
dim shared as integer frontier
dim shared as integer Heatmapend
dim shared as string  chra

screenres 1200,600,32

distance = 0

sub drawWorld()
    locate 3,1
    for i as integer = 0 to 31
        for j as integer = 0 to 31
            select case world(i,j).heat
                case -1
                    color rgb(0,0,0),rgb(0,0,0)
                case 99
                    color rgb(0,0,255),rgb(0,0,0)
                case 0
                    color rgb(0,255,0),rgb(0,0,0)
                case else
                    color rgb(0,127,127),rgb(0,0,0)
            end select
            dim as integer agenthere = 0
            for a as integer = 1 to 20
                if (agents(a).x = i) and  (agents(a).y = j) then agenthere = a
            next a
            if agenthere = 0 then
                print using " ## ";world(i,j).heat;
            else
                color rgb(255,0,0),rgb(0,0,0)
                chra = chr(65+agenthere)
                print "  ";chra;" ";
            end if
        next j
        print : print ' next line
    next i
end sub

sub createHeatMap()
    do
        Heatmapend = -1
        frontier = distance
        distance += 1
        for i as integer = 1 to 30
            for j as integer = 1 to 30

                if world(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 not already set...
                            if world(i+sx,j+sy).heat = -1 then
                                world(i+sx,j+sy).heat = distance
                                Heatmapend = 0
                            end if
                        next sy
                    next sx
                
                end if
            next j
        next i
    loop until ((Heatmapend = -1) or (distance = 20))
end sub

sub setAgentPositions()
    randomize
    for a as integer = 1 to 20
        agents(a).x = int(rnd * 28) + 2
        agents(a).y = int(rnd * 28) + 2
        while world(agents(a).x, agents(a).y).heat = 99
            agents(a).x = int(rnd * 28) + 2
            agents(a).y = int(rnd * 28) + 2
        wend
        world(agents(a).x,agents(a).y).occupied = 1
    next a
end sub

sub moveAgents()
    for a as integer = 1 to 20
        'find lowest surrounding tile on heatmap
        dim as integer lowX, lowY, lowdist = 50
        dim as integer i = agents(a).x
        dim as integer j = agents(a).y
        if world(i,j).heat > 1 then ' if he is more than 1 square away...
            for sx as integer = -1 to 1
                for sy as integer = -1 to 1
                    ' is there a closer tile next to him?
                    if world(i+sx,j+sy).heat < lowdist then    'if lower and...
                        if world(i+sx,j+sy).occupied = 0 then  ' if not occupied...
                            lowdist = world(i+sx,j+sy).heat
                            lowX = i+sx
                            lowY = j+sy
                        end if
                    end if
                next sy
            next sx

            if lowdist < 99 then 'found a closer square, so move him
                world(agents(a).x,agents(a).y).occupied = 0  'erase old location
                agents(a).x = lowX
                agents(a).y = lowY
                world(agents(a).x,agents(a).y).occupied = 1  'move to new location
            else
                ' don't move, he is stuck or done...
            end if
        end if
    next a
end sub

'==================================================
'                   MAIN PROGRAM
'==================================================
loadWorld()
createHeatMap()
setAgentPositions()

do
    drawWorld()
    moveAgents()
    sleep
loop until inkey =  chr(27)



' world map
' 0 = destination tile, 99 = obstacle
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

.