Graphics 800,600,16,2
SetBuffer BackBuffer()
AppTitle ""

Global TileSet = LoadAnimImage("gfx\TileSet.bmp",58,29,0,1)
MaskImage TileSet,255,0,255

Global TileWidth = 58,TileHeight = 29


Type map
Field x,y,frame
End Type

Global m.map

For x = 1 To 10
For y = 1 To 10
m.map = New map
m\x = x
m\y = y
m\frame = 0
Next
Next
Repeat
For m.map = Each map
DrawImage TileSet,(m\x*2-m\y*2)*13.75,(m\y*2+m\x*2)*8,m\frame
Next
Flip
Cls
Until KeyHit(1)
End

Global ISOScreenX=800
Global ISOScreenY=600
Graphics ISOScreenX,ISOScreenY,32,2

Const tilewidth = 64
Const tileheight = 32
Dim Map(100,100)

Global tileA=CreateImage(64,32)
Global tileB=CreateImage(64,32)
Global MausImg=CreateImage(3,3)
Global MausX,MausY


Global StartX=5,StartY=25,ZielX,ZielY

Global mapwidth=99,mapheight=99;"Wichtig für Pfadfinding"

Dim PfadMap(mapwidth,mapheight)
;"----------Pfadfinding Vorbereitung----------------"
Dim sqrmap(100,100),nodemap(0,0),dirx(7),diry(7),dirz(7)
For i=0 To 7:Read dirx(i):Read diry(i):Read dirz(i):Next
Type node
Field parent.node,cost,x,y
End Type

Type open
Field node.node
End Type

Type path
Field node.node
End Type
Data 0,-1,0,  -1,0,0,  1,0,0,  0,1,0
Data -1,-1,1,  1,-1,1,  -1,1,1,  1,1,1
;---------------Vorbereitung beendet----------------



;Tiles Erstellen
SetBuffer ImageBuffer(TileA)
Color 0,200,0:Rect 0,0,100,100:Color 0,0,0
For I=0 To 32:Line 32-I,0,0-I,16:Line 32-I,32,0-I,16
Line 32+I,0,64+I,16:Line 32+I,32,64+I,16:Next

SetBuffer ImageBuffer(TileB)
Color 100,100,100:Rect 0,0,100,100:Color 0,0,0
For I=0 To 32:Line 32-I,0,0-I,16:Line 32-I,32,0-I,16
Line 32+I,0,64+I,16:Line 32+I,32,64+I,16:Next

MidHandle TileA:MidHandle TileB:MidHandle MausImg
MaskImage MausImg,255,0,0




;-----Hindernisse--------
For I=2 To 10:Map(I,11)=1:Map(I,12)=1:Next




SetBuffer BackBuffer()
;-----------MainLoop------------

Repeat
MausX=MouseX():MausY=MouseY()

If MouseHit(1)=1 Then pathfinding():PfadInMap()

funcDrawMap()

Flip
Until KeyDown(1)=1
End







Function PfadInMap()

Dim PfadMap(mapwidth,mapheight)
For path.path=Each path :WegPkt=WegPkt+1:Next


For path.path=Each path
WegPkt=WegPkt-1
      If path=Last path Then Exit
   
        x0=path\node\x
        y0=path\node\y
 
   
     PfadMap(X0,Y0)=WegPkt
Next
End Function


Function funcDrawMap()
   
   tltilex = (0 + mapx) / tilewidth
   tltiley = ((0 + mapy) / tileheight) * 2
   
   brtilex = ((ISOScreenX + mapx) / tilewidth)+1
   brtiley = (((ISOScreenY + mapy) / tileheight) * 2)+1
   

   
   For y = tltiley To brtiley
      For x = tltilex To brtilex
         plotx = (x * tilewidth + (y And 1) * (tilewidth / 2)) - mapx
         ploty = (y * (tileheight/2)) - mapy
         
         If map(x, y) =  0 Then
            DrawImage tileA, plotx, ploty
         Else
            DrawImage tileB, plotx, ploty
         End If
         
         If PfadMap(X,Y)>0 Then Text plotX,PlotY,PfadMap(X,Y),1,1
         If StartX=X And StartY=Y Then STX=plotX:STY=plotY
            
           If ImagesCollide (MausImg,MausX,MausY,0,TileA,plotX,plotY,0) Then
           ZielX=X:ZielY=Y:TX=plotX:TY=plotY
   
   
          
         End If
                  
         
      Next
   Next
   Color 255,255,255:Text TX,TY,"Z",1,1
   Text STX,STY,"S",1,1
End Function



Function pathfinding()
  endX=ZielX:endY=ZielY
  Delete Each node
  Delete Each open
  Delete Each path
  Dim nodemap(mapwidth,mapheight)
  If startx=endx And starty=endy Then Return

  node.node=New node
  node\x=startx
  node\y=starty
  open.open=New open
  open\node=node
  nodemap(startx,starty)=1

  .again2
  node=Null
  cost=2147483647
  For open=Each open
    delta=sqrmap(Abs(open\node\x-endx),Abs(open\node\y-endy))
    If open\node\cost+delta<cost Then
      cost=open\node\cost+delta
      node=open\node
      tempopen.open=open
    EndIf
  Next
  If node=Null Then Return
  Delete tempopen

  For i=0 To 7
    x=node\x+dirx(i)
    y=node\y+diry(i)
    If x=>0 And y=>0 And x<=mapwidth And y<=mapheight Then
      If map(x,y)=0 And nodemap(x,y)=0 Then
        If dirz(i)=1 Then
          If map(x,node\y)=1 And map(node\x,y)=1 Then Goto jump2
        EndIf
        tempnode.node=New node
        tempnode\parent=node
        tempnode\cost=node\cost+1+dirz(i)
        tempnode\x=x
        tempnode\y=y
        open.open=New open
        open\node=tempnode
        nodemap(x,y)=1
        If x=endx And y=endy Then finish=1:Exit
        .jump2
      EndIf
    EndIf
  Next
  If finish=0 Then Goto again2

  While tempnode\parent<>Null
    path.path=New path
    path\node=tempnode
    tempnode=tempnode\parent
  Wend
  path.path=New path
  path\node=tempnode
End Function