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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

;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