| Download |
| Lego(TM) fab - a game-like lego fab ... Build with the Lego(TM) robots CPV cells, entaglement RX/TX tools, GW asteroids shifters, AND fight against evil !
|
| Lego(TM) is a registrated trade mark of it's owners ! |
|
Shortest path for any kind of maze (even for "extreme" difficult ones) Maximum [time] for longest shortest paths : width * height ! This algorighm I've implemented by myself haveing in mind an algorithm for my robot ... To understand it you need to understand : Algorithm is Gnupyrighted (G) 1996-2010, AlphaX (R) Co. - Mihai Barboi, Ro, Eu Free for non-criminal purposes ! uses function movsb1(src, dst, length_in_bytes) to copy memory blocks ! Can use your own block mover ! Sub getshortestpath_thread(img1 As Any Ptr,sx As Integer,sy As Integer, ex As Integer,ey As UInteger,diagonala As Integer, thesteps As Any Ptr, thestepstotal As Integer Ptr, map2 As UByte Ptr,slepy As Integer) Dim As Integer i,k,f,j,h,t,l,m,inserted Dim As Integer mx,my,map_size Dim As stepaside Ptr sa, sap, sap2 Dim As Integer steps_total,mused Dim As String A Dim as double tt1,tt2 Dim as ulongint td1,td2 ImageInfo img1,mx,my map_size=mx*my Dim As UByte did(1 To mx, 1 To my) Dim As UInteger steps_count(1 To map_size+1024) Dim As stepaside Ptr steps(1 To map_size+1024) If map2=0 then map2=allocate(map_size+8) mused=1 For k=0 To my-1 For i=0 To mx-1 map2[i +(k)*mx]=iif((Point(i,k,img1) And &hffffff)>0,1,0) Next i Next k End if steps_total=1 steps_count(steps_total)=1 steps(steps_total)=Allocate(Len(stepaside)) sa=steps(steps_total) sa->parent=0 sa->x=sx sa->y=sy sa->brother=0 l=steps_total m=l+1 sa=steps(l) If (sx=ex) And (sy=ey) Then Print "starting position is equal with final one ! No work to do ..." Exit Sub EndIf 'print "starting ..." 'debugx 'tt1=timer() 'rdtsc1 @td1 redo11122: inserted=0 For k=1 To steps_count(L) If sa=0 Then Exit For If sa->x>1 Then 'left 'If (map(sa->x-1,sa->y)= 0) And (did(sa->x-1,sa->y)=0) Then If (map2[sa->x-1 + (sa->y-1)*mx -1]= 0) And (did(sa->x-1,sa->y)=0) Then inserted=1 steps_count(m)+=1 did(sa->x-1,sa->y)=1 If steps_count(m)=1 Then steps(m)=Allocate(Len(stepaside)) sap=steps(m) Else sap->brother=Allocate(Len(stepaside)) sap=sap->brother EndIf sap->parent=sa sap->x=sa->x-1 sap->y=sa->y sap->brother=0 If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122 EndIf EndIf If sa->x < mx Then 'right 'If (map(sa->x+1,sa->y)= 0) And (did(sa->x+1,sa->y)=0) Then If (map2[sa->x+1 + (sa->y-1)*mx -1]= 0) And (did(sa->x+1,sa->y)=0) Then inserted=1 steps_count(m)+=1 did(sa->x+1,sa->y)=1 If steps_count(m)=1 Then steps(m)=Allocate(Len(stepaside)) sap=steps(m) Else sap->brother=Allocate(Len(stepaside)) sap=sap->brother EndIf sap->parent=sa sap->x=sa->x+1 sap->y=sa->y sap->brother=0 If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122 EndIf End If If sa->y > 1 Then 'down (or "up of screen") 'If (map(sa->x,sa->y-1)=0) And (did(sa->x,sa->y-1)=0) Then If (map2[sa->x + (sa->y-1-1)*mx -1]= 0) And (did(sa->x,sa->y-1)=0) Then inserted=1 steps_count(m)+=1 did(sa->x,sa->y-1)=1 If steps_count(m)=1 Then steps(m)=Allocate(Len(stepaside)) sap=steps(m) Else sap->brother=Allocate(Len(stepaside)) sap=sap->brother EndIf sap->parent=sa sap->x=sa->x sap->y=sa->y-1 sap->brother=0 If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122 EndIf End If If sa->y If (map2[sa->x + (sa->y+1-1)*mx -1]= 0) And (did(sa->x,sa->y+1)=0) Then inserted=1 steps_count(m)+=1 did(sa->x,sa->y+1)=1 If steps_count(m)=1 Then steps(m)=Allocate(Len(stepaside)) sap=steps(m) Else sap->brother=Allocate(Len(stepaside)) sap=sap->brother EndIf sap->parent=sa sap->x=sa->x sap->y=sa->y+1 sap->brother=0 If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122 EndIf End If If diagonala=1 Then If (sa->x > 1) And (sa->y > 1) Then ' down and left (or "up" and left) 'If (map(sa->x-1,sa->y-1)=0) And (did(sa->x-1,sa->y-1)=0) Then If (map2[sa->x-1 + (sa->y-1-1)*mx -1]= 0) And (did(sa->x-1,sa->y-1)=0) Then inserted=1 steps_count(m)+=1 did(sa->x-1,sa->y-1)=1 If steps_count(m)=1 Then steps(m)=Allocate(Len(stepaside)) sap=steps(m) Else sap->brother=Allocate(Len(stepaside)) sap=sap->brother EndIf sap->parent=sa sap->x=sa->x-1 sap->y=sa->y-1 sap->brother=0 If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122 EndIf EndIf If (sa->x < mx) And (sa->y > 1) Then 'down and right (or "up" and right) 'If (map(sa->x+1,sa->y-1)=0) And (did(sa->x+1,sa->y-1)=0) Then If (map2[sa->x+1 + (sa->y-1-1)*mx -1]= 0) And (did(sa->x+1,sa->y-1)=0) Then inserted=1 steps_count(m)+=1 did(sa->x+1,sa->y-1)=1 If steps_count(m)=1 Then steps(m)=Allocate(Len(stepaside)) sap=steps(m) Else sap->brother=Allocate(Len(stepaside)) sap=sap->brother EndIf sap->parent=sa sap->x=sa->x+1 sap->y=sa->y-1 sap->brother=0 If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122 EndIf EndIf If (sa->x > 1) And (sa->y < my) Then 'up and left (or "down" and left) 'If (map(sa->x-1,sa->y+1)=0) And (did(sa->x-1,sa->y+1)=0) Then If (map2[sa->x-1 + (sa->y+1-1)*mx -1]= 0) And (did(sa->x-1,sa->y+1)=0) Then inserted=1 steps_count(m)+=1 did(sa->x-1,sa->y+1)=1 If steps_count(m)=1 Then steps(m)=Allocate(Len(stepaside)) sap=steps(m) Else sap->brother=Allocate(Len(stepaside)) sap=sap->brother EndIf sap->parent=sa sap->x=sa->x-1 sap->y=sa->y+1 sap->brother=0 If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122 EndIf EndIf If (sa->x < mx) And (sa->y < my) Then 'up and right (or "down" and right) 'If (map(sa->x+1,sa->y+1)=0) And (did(sa->x+1,sa->y+1)=0) Then If (map2[sa->x+1 + (sa->y+1-1)*mx -1]= 0) And (did(sa->x+1,sa->y+1)=0) Then inserted=1 steps_count(m)+=1 did(sa->x+1,sa->y+1)=1 If steps_count(m)=1 Then steps(m)=Allocate(Len(stepaside)) sap=steps(m) Else sap->brother=Allocate(Len(stepaside)) sap=sap->brother EndIf sap->parent=sa sap->x=sa->x+1 sap->y=sa->y+1 sap->brother=0 If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122 EndIf EndIf EndIf sa=sa->brother Next k If (inserted=0) Or (m=map_size+1000) Then goto finish22 l=m sa=steps(l) steps_total=l m=l+1 If slepy>0 Then Sleep slepy GoTo redo11122 ifound122: steps_total=m 'rdtsc1 @td2 'tt2=timer() *thestepstotal=steps_total If thesteps=0 Then GoTo finish22 Dim As stepaside Ptr ttt *CPtr(UInteger Ptr,thesteps)=Cast(UInteger,Allocate(Len(stepaside)*steps_total+4)) ttt=*CPtr(UInteger Ptr,thesteps) While sap<>0 m-=1 sap->x-=1:sap->y-=1 movsb1 sap,@ttt[m],Len(stepaside) sap=sap->parent Wend finish22: For i=1 to steps_total sa=steps(i) while sa<>0 sap=sa sa=sa->brother deallocate sap wend Next i If mused=1 Then DeAllocate map2 'Print "#!@$ !" End Sub |