A-Star 寻路算法演示(PureBasic)

;A-Star panth find
;2003.2.5  from vb6
EnableExplicit
#wd=15  ;width
#Xc=20
#Yc=20
#obstruct = 0
#channel = 1
	
Structure AStarNode
  pos.Point          ;该节点的坐标
  father.Point
  G.i
  H.i
  style.i          ;类型，是否可行走
EndStructure

Declare.i AStar()
Declare AddOpenList(*pos.AStarNode)	
Declare DelOpenList(*pos.AStarNode)
Declare AddCloseList(*pos.AStarNode)
Declare Neighbor_Search(*minFP.AStarNode,offsetX.i, offsetY.i)
Declare.i CheckCloseNode(*node.AStarNode)
Declare.i CheckNode(*node.AStarNode)

Declare CreateAStarMap(Array maps.i(2),*startP.AStarNode, *endP.AStarNode)
Declare OnLeftClick()
Declare OnBtLeftClick()
Declare OnBtCPLeftClick()
Declare OnBtCMLeftClick()
Declare OnChkBLeftClick()
Declare ISstartOrEndPoint(px.i,py.i)
Declare DrawMap()
  
Global OpenNum.i   ;开启列表中的总结点数-1
Global CloseNum.i  ;关闭列表中的总结点数-1
Define ArrLength.l ;数组长度 
Global minX.i,minY.i,maxX.i,maxY.i
;计算出来的地图尺寸
minX=0
minY=0
maxX=#Xc
maxY=#Yc

Global Dim MColor(4),PenColor,Choise.i,starts.i=0,ends.i=0
MColor(1)=$00A000  ;green
MColor(2)=$F00000  ;blue
MColor(3)=$0000F0  ;red
MColor(4)=$00CCFF  ;yellow
PenColor=MColor(1)
Choise=1

ArrLength = (maxX - minX) * (maxY - minY) - 1

Global Dim OpenList.AStarNode(ArrLength)        ;开启表
Global Dim CloseList.AStarNode(ArrLength)       ;关闭表
Global Dim AStarMap.AStarNode(maxX,maxY)        ;地图
Global Dim maps.i(maxX,maxY), HavePath.i=#False        
Global AstartP.AStarNode        ;起点
Global AendP.AStarNode          ;终点
 
 ;参数：要寻路的二维地图,寻路起点,寻路终点
 ;返回值：1找到路径，路径存在AStarPath中 0未找到路径
Global Dim AStarPath.Point(ArrLength)            ;路径
Global PathLength.i             ;路径长度
Global Slant.i                  ;斜向 0 false ,1 true
Define k.i,Event
Define X.i,Y.i,XN.i,YN.i,oldSX,oldSY,oldEX,oldEY
If OpenWindow(0, 100, 100, 460, 400, "PureBasic - A-Star Path", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  
  FrameGadget(11, 335, 15,95, 150, "选项")
  OptionGadget(12, 350, 40, 40, 20, "平地")
  OptionGadget(13, 350, 65, 40, 20, "障碍")
  OptionGadget(14, 350, 90, 40, 20, "开始")
  OptionGadget(15, 350, 115,40, 20, "结束")
  CheckBoxGadget(16,350,140,40,20,"斜线")
  SetGadgetState(12, 1)   ; set second option as active one
  BindGadgetEvent(12, @OnLeftClick(),#PB_EventType_LeftClick) ; Bind  left click
  BindGadgetEvent(13, @OnLeftClick(),#PB_EventType_LeftClick) ; Bind  left click
  BindGadgetEvent(14, @OnLeftClick(),#PB_EventType_LeftClick) ; Bind  left click
  BindGadgetEvent(15, @OnLeftClick(),#PB_EventType_LeftClick) ; Bind  left click
  
  ButtonGadget(17,340,185,80,30,"Find Path")
  ButtonGadget(18,340,235,80,30,"Clear Path")
  ButtonGadget(19,340,285,80,30,"Clear Map")
  BindGadgetEvent(17, @OnBtLeftClick(),#PB_EventType_LeftClick) ; Bind  left click
  BindGadgetEvent(18, @OnBtCPLeftClick(),#PB_EventType_LeftClick)
  BindGadgetEvent(19, @OnBtCMLeftClick(),#PB_EventType_LeftClick)
  
  CanvasGadget(1,400,40,15,115)
  If StartDrawing(CanvasOutput(1))
    Box(0,0,75,115,$EEEEEE);RGB(196,196,196))
    Box(0, 0,15,15,MColor(1))
    Box(0,25,15,15,MColor(2))
    Box(0,50,15,15,MColor(3))
    Box(0,75,15,15,MColor(4))
    LineXY(0,105,15,115,$000000)
    StopDrawing()
  EndIf
  CanvasGadget(0, 10, 10, 301, 301)
  OnBtCMLeftClick()
  
  Repeat
    Event = WaitWindowEvent()
    If Event = #PB_Event_Gadget And EventGadget() = 0 
      If EventType() = #PB_EventType_LeftButtonDown Or (EventType() = #PB_EventType_MouseMove And GetGadgetAttribute(0, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton)        
          x = GetGadgetAttribute(0, #PB_Canvas_MouseX)
          y = GetGadgetAttribute(0, #PB_Canvas_MouseY)
          If (x<300 And x>0) And (y<300  And y>0)
          If StartDrawing(CanvasOutput(0))
            XN=Int(x/#wd)
            YN=Int(y/#wd)
            Select Choise
              Case 1  ;#Tongdao
                ISstartOrEndPoint(XN,YN)
                maps(XN,YN)=#channel
              Case 2  ;#zhangai
                ISstartOrEndPoint(XN,YN)
                maps(XN,YN)=#obstruct
              Case 3
                ISstartOrEndPoint(XN,YN)
                maps(XN,YN)=2
                Box(oldSX*#wd+1,oldSY*#wd+1,13,13,MColor(1))
                maps(oldSX,oldSY)=#channel                
                oldSX=XN
                oldSY=YN
                starts=1
                AstartP\pos\x=XN
                AstartP\pos\y=YN
              Case 4
                ISstartOrEndPoint(XN,YN)
                maps(XN,YN)=3
                Box(oldEX*#wd+1,oldEY*#wd+1,13,13,MColor(1))
                maps(oldEX,oldEY)=#channel
                oldEX=XN
                oldEY=YN
                ends=1
                AendP\pos\x=XN
                AendP\pos\y=YN
            EndSelect
            Box(Int(x/#wd)*#wd+1,Int(y/#wd)*#wd+1,13,13,PenColor) 
            StopDrawing()
          EndIf
        EndIf
      EndIf
    EndIf    
    
  Until Event = #PB_Event_CloseWindow  ; If the user has pressed on the close button
EndIf


End
Procedure.i AStar()  
  Protected p.Point                  ;指针
  Protected minFP.AStarNode          ;最小F值的节点
  Protected i.i                      ;找最小F值For循环的循环变量
  Protected Result=0
  ;初始化
  OpenNum = -1: CloseNum = -1
  PathLength = 0
  Protected t.i=1      

  CreateAStarMap(maps(),@AstartP,@AendP)              ;根据游戏地图创建本次寻路的A星地图
  AddOpenList(@AstartP)  ;将起点加入开启表
  
  Repeat
    If OpenNum = -1 
      Result = 0
      Break   ;当开启列表为空时，退出循环（没有找到路径）
    EndIf
    
    ;把开启列表中G H值最小的点找出来（有多个相同最小值的话，找出靠前的那个）
    minFP = OpenList(0)
    For i = 0 To OpenNum
      If minFP\G + minFP\H > OpenList(i)\G + OpenList(i)\H    ;找数组中最小数
        minFP = OpenList(i)
      EndIf
    Next i
    
    ;把这个点从开启列表中删除，加入到关闭列表
    DelOpenList(@minFP)
    AddCloseList(@minFP)
    
    ;搜索该点的邻居

    Neighbor_Search(@minFP,0,-1)       ;上
    Neighbor_Search(@minFP, 0, 1)       ;下
    Neighbor_Search(@minFP,-1, 0)       ;左
    Neighbor_Search(@minFP, 1, 0)       ;右
    
    ;这里是八方寻路，用不上可以直接注释掉
    If Slant = 1 
      Neighbor_Search(@minFP, -1, -1)      ;上左
      Neighbor_Search(@minFP,  1, -1)       ;上右
      Neighbor_Search(@minFP, -1, 1)       ;下左
      Neighbor_Search(@minFP,  1, 1)        ;下右
    EndIf

    If CheckCloseNode(@AendP) = #True ;如果终点在关闭列表中，就说明找到了通路，用回溯的方法记录路径
      Result = 1
      ;寻找回路
      p = AendP\pos
      Repeat
        AStarPath(PathLength) = p
        PathLength = PathLength + 1
        p = AStarMap(p\x,p\y)\father           ;指针移动
        If p\X = AstartP\pos\x And p\Y = AstartP\pos\y 
          Break
        EndIf
      Until t=0
      Break 
    EndIf
  Until OpenNum=-1
  
  ProcedureReturn Result
  ;Debug.Print AStarMap(0, 0).H: Debug.Print AStarMap(1, 1).H
EndProcedure
;根据游戏地图创建AStar的寻路地图
Procedure CreateAStarMap(Array maps.i(2),*startP.AStarNode, *endP.AStarNode)
  Protected  x.i, y.i
  
  ;ReDim AStarMap(maxX - minX, maxY - minY) '根据游戏地图确定寻路地图尺寸  
  ;生成寻路地图
  For X = minX To maxX
    For Y = minY To maxY
      If Maps(X, Y) = 0 
        AStarMap(X, Y)\style = #obstruct
        AStarMap(X, Y)\G = 0            ;初始化成0，到需要的时候再重新计算
        AStarMap(X, Y)\H = (Abs(X - *endP\pos\X) + Abs(Y - *endP\pos\Y)) * 10   ;对于相同的起点和终点，H为定值，我们需要在这里一次性计算好(曼哈顿距离)
        AStarMap(X, Y)\pos\X = X
        AStarMap(X, Y)\pos\Y = Y
      ElseIf Maps(X, Y) >= 1 
        AStarMap(X, Y)\style = #channel
        AStarMap(X, Y)\G = 0
        AStarMap(X, Y)\H = (Abs(X - *endP\pos\X) + Abs(Y - *endP\pos\Y)) * 10
        AStarMap(X, Y)\pos\X = X
        AStarMap(X, Y)\pos\Y = Y
      EndIf
    Next Y
  Next X
  
EndProcedure

;参数：需要添加进来的节点（添加在线性表的尾部）
Procedure AddOpenList(*pos.AStarNode)
  ;Debug OpenNum
  OpenNum = OpenNum + 1 ;总节点数 1
  ;OpenList(OpenNum)=*pos;添加节点
  OpenList(OpenNum)\father=*pos\father
  OpenList(OpenNum)\G=*pos\G
  OpenList(OpenNum)\H=*pos\H
  OpenList(OpenNum)\pos=*pos\pos
  OpenList(OpenNum)\style=*pos\style  
EndProcedure
    
;参数：需要删除的节点（删除后，将线性表尾部节点补充到删除后的空缺位置，为了减小时间复杂度）
Procedure DelOpenList(*pos.AStarNode)  
  Protected t.AStarNode ;临时节点，用于做变量交换
  Protected c.AStarNode ;临时节点，用于清空对象
  Protected i.i
  For i = 0 To OpenNum
    If OpenList(i)\pos\X =*pos\pos\X And OpenList(i)\pos\Y =*pos\pos\Y ;找到要删除的节点（目标节点）
      t = OpenList(OpenNum)                                            ;t指向开启表中最后一个节点
      OpenList(OpenNum) = c                                            ;删除最后一个节点
      OpenList(i) = t                                                  ;把最后一个节点覆盖到目标节点
      OpenNum = OpenNum - 1                                            ;开启表长度-1
      Break                                                            ;结束不必要的循环
    EndIf
  Next i
  
EndProcedure
 
;参数：需要添加进来的节点（添加在线性表的尾部）
Procedure.i AddCloseList(*pos.AStarNode)
  CloseNum = CloseNum + 1 ;总节点数 1
  ;CloseList(CloseNum) =*pos  ;添加节点 
  CloseList(CloseNum)\father=*pos\father
  CloseList(CloseNum)\G=*pos\G
  CloseList(CloseNum)\H=*pos\H
  CloseList(CloseNum)\pos=*pos\pos
  CloseList(CloseNum)\style=*pos\style
EndProcedure

;确认传入节点是否存在于开启表中
Procedure.i CheckNode(*node.AStarNode)
  Protected i.i
  Protected Result=#False
  For i = 0 To OpenNum
    If OpenList(i)\pos\X =*node\pos\X And OpenList(i)\pos\Y =*node\pos\Y       ;找到了
      Result = #True
      Break
    EndIf
  Next i
  If i>OpenNum 
    Result = #False
  EndIf
  ProcedureReturn Result
EndProcedure
 
;确认是否在关闭表里
Procedure CheckCloseNode(*node.AStarNode)
  Protected i.i
  Protected Result=#False
  For i = 0 To CloseNum
    If CloseList(i)\pos\X =*node\pos\X And CloseList(i)\pos\Y =*node\pos\Y      ;找到了
      Result =#True
      Break
    EndIf
  Next i
  If i>CloseNum
    Result = #False
  EndIf
  ProcedureReturn Result   
EndProcedure
      
;功能：
;更新开启表中的G值
Procedure  UpdataG()
  Protected i.i
  For i = 0 To OpenNum
    If OpenList(i)\G <> AStarMap(OpenList(i)\pos\X, OpenList(i)\pos\Y)\G 
      OpenList(i)\G = AStarMap(OpenList(i)\pos\X, OpenList(i)\pos\Y)\G
    EndIf
  Next i
EndProcedure

Procedure Neighbor_Search(*minFP.AStarNode,offsetX.i, offsetY.i)
  Protected AStep.i
  ;越界检测
  If *minFP\pos\X + offsetX >=maxX Or *minFP\pos\X + offsetX < 0 Or *minFP\pos\Y + offsetY >=maxY Or *minFP\pos\Y + offsetY < 0 
    Goto exit1
  EndIf
  If offsetX = 0 Or offsetY = 0 ;设置单位花费
    AStep = 10
  Else
    AStep = 14
  EndIf
  ;如果该邻居不是障碍并且不在关闭表中
  If AStarMap(*minFP\pos\X + offsetX, *minFP\pos\Y + offsetY)\style <>#obstruct And CheckCloseNode(AStarMap(*minFP\pos\X + offsetX,*minFP\pos\Y + offsetY)) =#False 
    ;AStarMap(minFP.pos.x offsetX, minFP.pos.y offsetY).G = minFP.G AStep      '给G赋值
    If CheckNode(AStarMap(*minFP\pos\X + offsetX,*minFP\pos\Y + offsetY)) = #True ;存在于开启表中
      If *minFP\G + AStep < AStarMap(*minFP\pos\X + offsetX,*minFP\pos\Y + offsetY)\G ;如果走新路径更短就更换父节点
        AStarMap(*minFP\pos\X + offsetX,*minFP\pos\Y + offsetY)\G =*minFP\G + AStep
        AStarMap(*minFP\pos\X + offsetX,*minFP\pos\Y + offsetY)\father =*minFP\pos
        UpdataG()    ;更新Openlist中的G值
      EndIf
    Else    ;不存在于开启表中
      AStarMap(*minFP\pos\X + offsetX,*minFP\pos\Y + offsetY)\father =*minFP\pos ;设置该邻居的父节点为我们上面找到的最小节点（minFP）
      AStarMap(*minFP\pos\X + offsetX,*minFP\pos\Y + offsetY)\G =*minFP\G + AStep  ;计算该点（邻居）的G值
      AddOpenList(@AStarMap(*minFP\pos\X + offsetX,*minFP\pos\Y + offsetY))  ;把该点加入开启表中
    EndIf
  EndIf
  exit1:
EndProcedure
Procedure OnLeftClick()  
  If GetGadgetState(12) 
    Choise=1
    PenColor=MColor(1)
  EndIf
  If GetGadgetState(13)
    Choise=2
    PenColor=MColor(2)
  EndIf
  If GetGadgetState(14)
    Choise=3
    PenColor=MColor(3)
  EndIf
  If GetGadgetState(15)
    Choise=4
    PenColor=MColor(4)
  EndIf
EndProcedure
Procedure ISstartOrEndPoint(px.i,py.i)
  If maps(px,py)=2
    starts=0
  EndIf
  If maps(px,py)=3
    ends=0
  EndIf
EndProcedure
Procedure OnBtLeftClick()
  Define i.i
  If starts=0 Or ends=0
    MessageRequester("Warnning","No Start or Ending point!",#PB_MessageRequester_Ok|#PB_MessageRequester_Warning)
  Else
    If GetGadgetState(16)=#PB_Checkbox_Checked
      Slant=1
    Else
      Slant=0
    EndIf
    If AStar()=0
      MessageRequester("Info","No Path find !",#PB_MessageRequester_Ok|#PB_MessageRequester_Info)
    Else      
      If StartDrawing(CanvasOutput(0))
        For i = 1 To PathLength - 1
            Circle(AStarPath(i)\x*#wd+7, AStarPath(i)\y*#wd+7,5, $F000F0)
        Next i
      EndIf
      StopDrawing()
      HavePath=#True
    EndIf    
  EndIf
EndProcedure
Procedure OnBtCPLeftClick()
  Define i.i
  If HavePath
    If StartDrawing(CanvasOutput(0))
      For i = 1 To PathLength - 1
        Circle(AStarPath(i)\x*#wd+7, AStarPath(i)\y*#wd+7,5, MColor(1))
      Next i
    EndIf
    StopDrawing()
    HavePath=#False
  EndIf      
EndProcedure
Procedure OnBtCMLeftClick()
  Define i.i,j.i
  For i=0 To maxX
    For j=0 To maxY
      maps(i,j)=#channel
    Next j
  Next i
  HavePath=#False
  starts=0
  ends=0
  DrawMap()    
EndProcedure
Procedure DrawMap()
  Define k.i,Font1.i
  LoadFont(0, "Arial" , 28, #PB_Font_Bold)
  If StartDrawing(CanvasOutput(0))
    Box(0,0,300,300,MColor(1))
    For k=0 To 300 Step #wd
      Line(0, k, 300, 1,RGB(0,0,0))
      Line(k,0,1,300,RGB(0,0,0))
    Next k    
    DrawingMode(#PB_2DDrawing_Transparent)
    FrontColor(RGB(200,200,255)) ; print the text to white !
    
    DrawingFont(FontID(0))
    DrawText(70, 80, "A graphic")
    DrawText(15,160,"of A-Star path !",RGB(220,120,160))
    StopDrawing() ; This is absolutely needed when the drawing operations are finished !!! Never forget it !
  EndIf
EndProcedure

　　正月十五闲来无事，改编自VB6版本的。