Page 1 of 1

A*Star in Hollywood

Posted: Mon May 08, 2023 11:26 am
by dwayne_jarvis
Three files to this one. I will post one at a a time.

astar.hws

Code: Select all

/* MIT License

Copyright (c) 2020 Xiejiangzhi

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE. 

Converted to Hollywood in 2023 by Dwayne Jarvis <dwayne.jarvis@djitalverse.com>

*/

If IsNil (AStar)
	
	Local Function CheckIndex (thisSet, thisNode)
		;DebugPrint ("--> ASTAR:Local Function CheckIndex (thisSet, thisNode)", Debug.Table (thisSet), Debug.Table (thisNode))
		Local CheckIndex = False
		If (HaveItem (thisSet, thisNode)) Then CheckIndex = thisSet [thisNode]
		;DebugPrint ("<-- ASTAR:EndFunction CheckIndex (checkIndex)", CheckIndex)
		Return (CheckIndex)
	EndFunction	

	
	Global AStar = { }
	AStar.__index = AStar
	
	Local private = { }
	Local inf = 255
	
	Function AStar.New (...)
		;DebugPrint ("--> ASTAR:Function AStar.New (...)", arg.n)
		Local newAStar = SetMetaTable ({ }, AStar)
		newAStar:Init (Unpack (arg))
		
		;DebugPrint ("<-- ASTAR:EndFunction AStar.New (newAStar)", Debug.Table (newAStar))
		Return (newAStar)
	EndFunction
	
	Function AStar:Init (thisMap)
		;DebugPrint ("--> ASTAR:Function AStar:Init (thisMap)", Debug.Table(thisMap))
		self.map = thisMap	
		Assert (HaveItem (thisMap, "neighboursget") And HaveItem (thisMap, "costget") And HaveItem (thisMap, "costestimate"))
		;DebugPrint ("<-- ASTAR:EndFunction AStar:Init ()")
	EndFunction
	
	Function AStar:Find (startNode, goalNode, userdata)
		;DebugPrint ("Function AStar:Find (start, goal, userdata)", Debug.Table (startNode), Debug.Table (goalNode), userdata)
		Local thisMap = self.map
		
		Local openSet = {[startNode] = True }
		Local closedSet = { }
		Local cameFrom = { }
		
		Local gScore, hScore, fScore = { }, { }, { }
		gScore [startNode] = 0
		;DebugPrint ("gScore=", Debug.Table (gScore))
		hScore [startNode] = self.map.CostEstimate (startNode, goalNode, userdata)
		;DebugPrint ("hScore=", Debug.Table (hScore))
		fScore [startNode] = hScore [startNode]
		;DebugPrint ("fScore=", Debug.Table (fScore))
		
		Local currentNode
		
		Local Function AddNeighbour (neighbourNode, cost)
			;DebugPrint ("\t--> ASTAR:Local Function AddNeighbour (neighbourNode, cost)", Debug.Table (neighbourNode), cost)
				
			If Not (CheckIndex (closedSet, neighbourNode))
				
				If IsNil (cost) Then cost = self.map.CostGet (currentNode, neighbourNode, userdata)
				
				Local gScoreTemp = gScore [currentNode] + cost
					
				Local openSetIndex = CheckIndex (openSet, neighbourNode)
				
				If Not (openSetIndex) Or (gScoreTemp < gScore [neighbourNode])
					
					cameFrom [neighbourNode] = currentNode
					gScore [neighbourNode] = gScoreTemp
					
					If (CheckIndex (hScore, neighbourNode))
						hScore [neighbourNode] = hScore [neighbourNode] 
					Else 
						hScore [neighbourNode] = self.map.CostEstimate (neighbourNode, goalNode, userdata)
					EndIf
					
					fScore [neighbourNode] = gScoreTemp + hScore [neighbourNode]
					
					openSet [neighbourNode] = True
				EndIf
					
				;DebugPrint ("\t\t<-- ASTAR:EndFunction NeighbourAdd ()")
			EndIf
						
			;DebugPrint ("\t<-- ASTAR:EndFunction AddNeighbour ()")
		EndFunction
		
		While Not (IsTableEmpty (openSet))
			currentNode = private.PopBestNode (openSet, fScore)
			;DebugPrint ("currentNode=", Debug.Table (currentNode))
			openSet [currentNode] = Nil
			
			If (currentNode = goalNode)
				
				Local path = private.UnwindPath ({ }, cameFrom, goalNode)
				InsertItem (path, goalNode)
				
				;DebugPrint ("<-- ASTAR:EndFunction Find (path, gScore, hScore, fScore, cameFrom)", path, Debug.Table (gScore), Debug.Table (hScore), Debug.Table (fScore), cameFrom)
				Return (path, gScore, hScore, fScore, cameFrom)
			EndIf
			
			closedSet [currentNode] = True
			
			Local fromNode = Nil
			If (HaveItem (cameFrom, currentNode)) Then fromNode = cameFrom [currentNode]
			
			self.map.NeighboursGet (currentNode, fromNode, AddNeighbour, userdata)
		Wend
		
		;DebugPrint ("<-- ASTAR:EndFunction Find (Nil, gScore, hScore, fScore, cameFrom)", Nil, Debug.Table (gScore), Debug.Table (hScore), Debug.Table (fScore), cameFrom)
		Return (Nil, gScore, hScore, fScore, cameFrom)
	EndFunction
	
	Function private.PopBestNode (set, score)
		;DebugPrint ("--> ASTAR:Function private.PopBestNode (set, score)", set, score)
		Local best, thisNode = inf, Nil
		
		For k, v In Pairs (set)
			;DebugPrint ("\tk=", k, ", v=", v)
			Local s = score [k]
			;DebugPrint ("\ts=", s, ", best=", best)
			If (s < best) Then best, thisNode = s, k
		Next
		
		If (IsNil (thisNode)) 
			;DebugPrint ("<-- ASTAR:EndFunction private.PopBestNode ()")
			Return ()
		EndIf
		
		set [thisNode] = Nil
		
		;DebugPrint ("<-- ASTAR:EndFunction private.PopBestNode (thisNode)", Debug.Table (thisNode))
		Return (thisNode)
	EndFunction
	
	Function private.UnwindPath (flatPath, thisMap, currentNode)
		;DebugPrint ("--> ASTAR:Function private.UnwindPath (flatPath, thisMap, currentNode)", flatPath, thisMap, currentNode)
		If (HaveItem (thisMap, currentNode))
			InsertItem (flatPath, thisMap [currentNode], 0)
			;DebugPrint ("<-- ASTAR:EndFunction private.UnwindPath (private.PathUnwind, thisMap, thisMap [currentNode]", private.UnwindPath, thisMap, Debug.Table (thisMap [currentNode]))
			Return (private.UnwindPath (flatPath, thisMap, thisMap [currentNode]))
		Else
			;DebugPrint ("<-- ASTAR:EndFunction private.UnwindPath (flatPath)", flatPath)
			Return (flatPath)
		EndIf
		
		;DebugPrint ("<-- ASTAR:EndFunction private.UnwindPath ()")
	EndFunction
	
EndIf


Re: A*Star in Hollywood

Posted: Mon May 08, 2023 11:29 am
by dwayne_jarvis
second file is an empty gridmap. This can be whatever size you like and doesn't need to be initialised before using.

All MAPs must have the following functions as a minimum (NeighboursGet, CostGet and EstimateGet) for them to work with astar.hws.

This one has additional functions some of which are not fully realised yet, but it works for the purpose of the demonstration. This is a first pass over I will probably convert to a full Class like astar.hws and interchange different map systetm.s

gridmap.hws

Code: Select all

/*
MIT License

Copyright (c) 2020 Xiejiangzhi

Permission is hereby granted, free of charge, To any person obtaining a copy
of this software And associated documentation files (the "Software"), To deal
In the Software without restriction, including without limitation the rights
To use, copy, modify, merge, publish, distribute, sublicense, And/Or sell
copies of the Software, And To permit persons To whom the Software is
furnished To Do so, subject To the following conditions:

The above copyright notice And this permission notice shall be included In all
copies Or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS Or
IMPLIED, INCLUDING BUT Not LIMITED To THE WARRANTIES OF MERCHANTABILITY,
FITNESS For A PARTICULAR PURPOSE And NONINFRINGEMENT. In NO EVENT SHALL THE
AUTHORS Or COPYRIGHT HOLDERS BE LIABLE For ANY CLAIM, DAMAGES Or OTHER
LIABILITY, WHETHER In AN ACTION OF CONTRACT, TORT Or OTHERWISE, ARISING FROM,
OUT OF Or In CONNECTION WITH THE SOFTWARE Or THE USE Or OTHER DEALINGS In THE
SOFTWARE.

Converted to Hollywood in 2023 by Dwayne Jarvis <dwayne.jarvis@djitalverse.com>

*/
If IsNil (GridMap)
	
	Local mapWidth, mapHeight = 42, 28
	Local mapGrid = { }
	
	Local cachedNodes = { }
	Local checkedNodes = { }
	
	Local neighboursOffset = { { -1, 1 }, { 0, -1 }, { 1, -1 }, { -1, 0 }, { 1, 0 }, { -1, 1 }, { 0, 1 }, { 1, 1 } }
	
	Global GridMap = { }
	
	/* 	-- Node must be able to check if they are the same
		-- Cannot directly return different tables for the same coord
		-- The library doesn't change nodes, so you able to reuse your node 
	*/
	Function GridMap.NodeGet (x, y)
		;DebugPrint ("--> GRIDMAP:Function GridMap.NodeGet (x, y)", x, y)
		Local row = { }
		
		If (HaveItem (cachedNodes, y)) 
			;DebugPrint ("HaveItem (cachedNodes, y)")
			row = cachedNodes [y] 
		Else 
			;DebugPrint ("NOT HaveItem (cachedNodes, y)")
			cachedNodes [y] = row
		EndIf
	
		Local thisNode = { x = x, y = y , cost = 0 }
		
		If (HaveItem (row, x)) 
			;DebugPrint ("HaveItem (row, x)")
			thisNode = row [x] 
		Else 
			;DebugPrint ("NOT HaveItem (row, x)")			
			row [x] = thisNode
		EndIf
		
		;DebugPrint (Debug.Table (cachedNodes [y][x]))
		
		;DebugPrint ("<-- GRIDMAP:EndFunction GridMap.NodeGet (thisNode)", Debug.Table (thisNode))
		Return (thisNode)
	EndFunction
	
	Function GridMap.WidthGet () Return (mapWidth) EndFunction
	Function GridMap.WidthSet (thisWidth) mapWidth = thisWidth EndFunction
	
	Function GridMap.HeightGet () Return (mapHeight) EndFunction
	Function GridMap.HeightSet (thisHeight) mapHeight = thisHeight EndFunction
		
	Function GridMap.GridGet () Return (mapGrid) EndFunction
	Function GridMap.GridSet (thisGrid) mapGrid = thisGrid EndFunction
		
	Function GridMap.CheckedNodesGet () Return (checkedNodes) EndFunction
	Function GridMap.CheckedNodesClear () checkedNodes = { } EndFunction
	
	/* 	-- Return all neighbor nodes. Means a target that can be moved from the current node */
	Function GridMap.NeighboursGet (thisNode, fromNode, fnNeighbourAdd, userdata)
		;DebugPrint ("--> GRIDMAP:Function GridMap.NeighboursGet (thisNode, fromNode, fnNeighbourAdd, userdata)", thisNode, fromNode, fnNeighbourAdd, userdata)
		
		Local x, y = thisNode.x, thisNode.y
		
		For i, offset In IPairs (neighboursOffset)
			Local tempNode = GridMap.NodeGet (x + offset [0], y + offset [1])

			If (tempNode.cost >= 0) And (tempNode.x >= 0) And (tempNode.x < mapWidth) And (tempNode.y >= 0) And (tempNode.y < mapHeight) Then fnNeighbourAdd (tempNode)
		Next
		
		;DebugPrint ("<-- GRIDMAP:EndFunction GridMap.NeighboursGet ()")
	EndFunction
	
	/*	-- Cost of two adjacent nodes.
		-- Distance, distance + cost or other comparison value you want
	*/
	Function GridMap.CostGet (fromNode, toNode)
		;DebugPrint ("--> GRIDMAP:Function GridMap.CostGet (fromNode, toNode)", fromNode, toNode)
		Local dx, dy = fromNode.x - toNode.x, fromNode.y - toNode.y
		Local cost = Sqrt (dx * dx + dy * dy) + (fromNode.cost + toNode.cost) * 0.5
		;DebugPrint ("<-- GRIDMAP:EndFunction GridMap.CostGet (cost)", cost)
		Return (cost)
	EndFunction
	
	/*	-- For heuristic. Estimate cost of current node To goal node
		-- As close To the real cost as possible
	*/
	Function GridMap.CostEstimate (thisNode, goalNode, userdata)
		;DebugPrint ("--> GRIDMAP:Function GridMap.CostEstimate (thisNode, goalNode, userdata)", thisNode, goalNode, userdata)
		
		checkedNodes [TableItems (checkedNodes)] = thisNode
		
		Local cost = GridMap.CostGet (thisNode, goalNode) * 1.5 + (thisNode.cost + goalNode.cost) * 0.5
		
		;DebugPrint ("<-- GRIDMAP:EndFunction GridMap.CostEstimate (cost)", cost)
		Return (cost)
	EndFunction
	
EndIf

Re: A*Star in Hollywood

Posted: Mon May 08, 2023 11:37 am
by dwayne_jarvis
Third file is a test demonstrating astar.hws with the empty gridmap.hws

When it starts it setups a 1440x900 screen (you can change the size to whatever you like. It then sets the GridMap to one quarter of the ScreenWidth and ScreenHeight.

Sets the StartX, StartY position to 0,0 and the GoalX and the GoalY to the opposite corner (in this example 359, 224)

You can use the light mouse on any grip position to change the start and rightmouse to change the goal. Use the keys 1 to 3 to change the cost of the corresponding gridmap or 4 to block.

The astar path will be re-calculated on this basis. NOTE: that you must fill in diagonals to block. Stats in the corner show mouse coordinates (based upon the grid map), Node cost under the mouse pointer, number of nodes checked and the time in ms to calculate the map.

astartest.hws

Code: Select all

/*
MIT License

Copyright (c) 2020 Xiejiangzhi

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

Converted to Hollywood in 2023 by Dwayne Jarvis <dwayne.jarvis@djitalverse.com>

*/

@INCLUDE "../system/astar.hws"
@INCLUDE "../system/gridmap.hws"

@DISPLAY 1, { Title = "AStar", X = #CENTER, Y = #CENTER, Width = 1440, Height = 900, FillStyle = #FILLCOLOR, Color = #GRAY }

Function DimensionsGet () Return (GetAttribute (#DISPLAY, 1, #ATTRWIDTH), GetAttribute (#DISPLAY, 1, #ATTRHEIGHT)) EndFunction
Function ColorSet (r, g, b, a) Return (ARGB ((a Or 1 * 255), RGB (r * 255, g * 255, b * 255))) EndFunction

Local screenWidth, screenHeight = DimensionsGet ()

GridMap.WidthSet (Int (screenWidth / 25))
GridMap.HeightSet (Int (screenHeight / 25))

Local finder = AStar.New (GridMap)

Local path, gScore, hScore

Local startX, startY = 0, 0
Local mapW, mapH = GridMap.WidthGet (), GridMap.HeightGet ()
Local goalX, goalY = mapW-1, MapH-1

Local findTime = 0

Local Function UpdatePath ()
	;DebugPrint ("--> ASTARTEST:Local Function UpdatePath ()")
	
	GridMap.CheckedNodesClear ()
	
	Local timer = StartTimer (Nil)
	
	path, gScore, hScore = finder:Find (GridMap.NodeGet (startX, startY), GridMap.NodeGet (goalX, goalY))
	findTime = GetTimer (timer)
	StopTimer (timer)

	If Not (IsNil (path)) 
		For i, thisNode In IPairs (path)
			path [thisNode] = True
		Next
	EndIf

	;DebugPrint ("<-- ASTARTEST:EndFunction UpdatePath ()")
EndFunction

Local mcx, mcy = 0, 0

Function Update ()
	;DebugPrint ("--> ASTARTEST:Function Update")
	Local mx, my = MouseX (), MouseY ()
	
	Local cellw, cellh = Int (screenWidth / mapW), Int (screenHeight / mapH)

	mcx, mcy = Floor (mx / cellw), Floor (my / cellh)
	
	Local changed = False
	
	If (IsLeftMouse ()) And (startX <> mcx) And (startY <> mcy)
		startX, startY = mcx, mcy
		changed = True
	EndIf
	
	If (IsRightMouse ()) And (goalX <> mcx) And (goalY <> mcy)
		goalX, goalY = mcx, mcy
		changed = True
	EndIf
	
	Local newCost = Nil
	If (IsKeyDown ("1"))
		newCost = 0
	ElseIf (IsKeyDown ("2"))
		newCost = 1
	ElseIf (IsKeyDown ("3"))
		newCost = 2
	ElseIf (IsKeyDown ("4"))
		newCost = -1
	EndIf
	
	If Not (IsNil (newCost))
		
		Local thisNode = GridMap.NodeGet (mcx, mcy)
		
		If (thisNode.cost <> newCost)
			
			thisNode.cost = newCost
			changed = True
			
		EndIf
		
	EndIf
	
	If (changed) Then UpdatePath ()
	;DebugPrint ("<-- ASTARTEST:EndFunction Update ()")
EndFunction

Function Draw ()
	;DebugPrint ("--> ASTARTEST:Function Draw ()")
	Local thisColor = ColorSet (0.5, 0.5, 0.5, 1)

	Cls (thisColor)
	
	Local w, h = DimensionsGet ()
	Local cellw, cellh = Int (w / mapW), Int (h / mapH)
	
	For i = 0 To mapW-1
		
		For j = 0 To mapH-1
			
			Local x, y = j * cellw, i * cellh
			Local thisNode = GridMap.NodeGet (j, i)
			Local cost = thisNode.cost
			thisColor = RGB (0, 0, 0)
			
			If (cost <> 0)
				If (cost = -1)
					thisColor = ColorSet (0.1, 0.1, 0.1, 1)
				ElseIf (cost = 1)
					thisColor = ColorSet (1, 1, 0.5, 1)
				ElseIf (cost = 2)
					thisColor = ColorSet (0.5, 0.5, 0.1, 1)
				EndIf
				
				SetFillStyle (#FILLCOLOR)
				Box (x, y, cellw, cellh, thisColor)
				
			EndIf
			
		Next
		
	Next
	
	Local checkedNodes = GridMap.CheckedNodesGet ()
	
	If Not (IsTableEmpty (checkedNodes))
		For _, thisNode In IPairs (checkedNodes)
			
			Local x, y = thisNode.x * cellw, thisNode.y * cellh
			
			thisColor = ColorSet (1, 0, 0, 0.2)
			SetFillStyle (#FILLCOLOR)
			Box (x, y, cellw, cellh, thisColor)
			
			thisColor = ColorSet (0.7, 0.7, 0.9, 1)
			TextOut (x + 3, y + 3, PadNum (gScore [thisNode], 2) .. "\n" .. PadNum (hScore [thisNode], 2), {color = thisColor})
			
		Next
	EndIf
	
	If Not (IsNil (path))

		thisColor = ColorSet (0, 1, 0, 0.4)
		For _, thisNode In IPairs (path)
			
			SetFillStyle (#FILLCOLOR)
			Box (thisNode.x * cellw, thisNode.y * cellh, cellw, cellh, thisColor)
			
		Next
	EndIf
	
	thisColor = ColorSet (1, 1, 1, 1)
	SetFillStyle (#FILLCOLOR)
	Circle (startX * cellw + (cellw / 3), startY * cellh + (cellh / 3), cellh / 3, thisColor)
	
	thisColor = ColorSet (0, 0, 1, 1)
	SetFillStyle (#FILLCOLOR)
	Circle (goalX * cellw + (cellw / 3), goalY * cellh + (cellh / 3), cellh / 3, thisColor)
	
	Local mNode = GridMap.NodeGet (mcx, mcy)
	Local str$ = ""
	str$ = str$ .. "\n mouse coord: " .. ToString (mcx) .. ", " .. ToString (mcy)
	str$ = str$ .. "\n mouse node cost: " .. ToString (mNode.cost)
	str$ = str$ .. "\n\n checked nodes: " .. ToString (TableItems (checkedNodes))
	str$ = str$ .. "\n time: " .. ToString (findTime) .. "ms"
	str$ = str$ .. "\n left/right click: move start/goal"
	str$ = str$ .. "\n keyboard: 1: cost 0; 2: cost 1; 3: cost 2; 4: blocked"

	thisColor = ColorSet (1, 1, 1, 1)
	TextOut (10, 10, str$, {color = thisColor})
	Flip ()
	
	;DebugPrint ("<-- ASTARTEST:Function Draw ()")
EndFunction

UpdatePath ()

BeginDoubleBuffer ()

Repeat
	Update ()
	DisableLineHook ()
	Draw ()
	EnableLineHook ()
Forever

Re: A*Star in Hollywood

Posted: Mon May 08, 2023 11:39 am
by dwayne_jarvis
Any questions or comments, please let me know.

I will use these algorithms for the sdlRogue demo that I am converting in place of the astarpath find algorithm that Parallel Realities wrote as it appears to be much quicker and can provide the fullpath from the start to end goal in a table.

Hope you find this useful.

Dwayne

Re: A*Star in Hollywood

Posted: Mon May 08, 2023 6:03 pm
by jalih
There is an excellent old article about realtime pathfinding by Swen Vincke inside the Game Developer Magazine, June 1997.

Re: A*Star in Hollywood

Posted: Mon May 15, 2023 10:15 am
by dwayne_jarvis
There is an error in the the two for loops in the Draw Function from the astartest.hws file which meant it was not displaying the nodes correctly. mapH and mapW were used in the wrong loop. J correlates to the X coordinates and should have used the mapW variable in the counter and obviously i correlates to the Y coordinates and should have used mapH variable.

Change the following lines:

Code: Select all

	For i = 0 To mapW-1
		
		For j = 0 To mapH-1
to this.

Code: Select all

	For i = 0 To mapH-1
		
		For j = 0 To mapW-1
Apologies.