;Konstanten
Const width=800
Const height=width*0.75
Const tile=32
Const gfx$="gfx\"
Const sfx$="sfx\"
;Auflösung
Graphics width,height,0,2
SetBuffer BackBuffer()
Include "data\data.bb"
;Player
Global defMax=100,liveMax=100,Wmax=4
Global player=LoadAnimImage(gfx$+"player.bmp",tile,tile,0,12):MidHandle player
Dim ImaPlayer(4)
For i=0 To 4 : ImaPlayer(i)=CopyImage(player) : RotateImage ImaPlayer(i),i*90 : Next
Type player
Field x,y,typ,def,live,weapon,speed,play,nr
Field aa,dd,move,buf
End Type
;Enemy
Global timer=0:warte=150
Type enemy
Field x,y,typ,live,move,xZ,yZ,fightstep,uPfad,xEnd,yEnd,speed,xS,yS,geh
End Type
Global enemy=LoadAnimImage(gfx$+"enemy.bmp",tile,tile,0,4) : MidHandle enemy
Dim ImaEnemy(4)
For i=0 To 4 : ImaEnemy(i)=CopyImage(Enemy) : RotateImage ImaEnemy(i),i*90 : Next
;Bullet
Type bullet
Field x,y,dir,att,team,typ,speed,reich
End Type
Global bullet=LoadAnimImage(gfx$+"bullet.bmp",tile,tile,0,6) : MidHandle bullet
Global waffe=LoadAnimImage(gfx$+"weapon.bmp",tile,tile,0,6) : MidHandle waffe
Dim ImaWaffe(4)
For i=0 To 4 : ImaWaffe(i)=CopyImage(waffe) : RotateImage ImaWaffe(i),i*90 : Next
Global granate_ex=LoadSound(sfx$+"granate_ex.wav")
Global mp5=LoadSound(sfx$+"mp5.wav")
Global g_bounce=LoadSound(sfx$+"granate.wav")
Global klack=LoadSound(sfx$+"klack.wav")
Global dead=LoadSound(sfx$+"dead.wav")
Dim Swea(99)
   Swea(0)=LoadSound(sfx$+"pistol.wav")
   Swea(1)=LoadSound(sfx$+"p90.wav")
   Swea(2)=LoadSound(sfx$+"shotgun.wav")
   Swea(3)=LoadSound(sfx$+"g_thr.wav")
   Swea(4)=LoadSound(sfx$+"bazooka.wav")
;Map
Global mapX=32*3,mapY=24*3
Dim map(mapX,mapY)
Dim status(mapX,mapY)
Global tileset=LoadAnimImage(gfx$+"desert.bmp",tile,tile,0,70) : MidHandle tileset
;Pathfinding
Global PfadBank=CreateBank(2),Bsize
Global mapwidth=mapX,mapheight=mapY,schalter
Dim MapData$(50),Fighter(72)
Dim sqrmap(mapX,mapY),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
;Explosion
Global Ex=LoadAnimImage(gfx$+"explosion.bmp",48,48,0,10) : MidHandle Ex
Type explosion
Field x,y,st,f
End Type
;pak
Type unit
Field x,y,typ,leb
End Type
Global unit=LoadAnimImage(gfx$+"unit.bmp",tile,tile,0,8) : MidHandle unit
;Blood
Global blood=LoadAnimImage(gfx$+"blood.bmp",tile,tile,0,5) : MidHandle blood
Type blood
Field x,y,st,f
End Type
;Hauptschleife
LoadMap("x")
NewEnemy(2,2,0)
Repeat
Cls
   ;Hintergrund
   
   For x=0 To mapX
   For y=0 To mapY
      DrawImage tileset,x*tile,y*tile,map(x,y)

      ;Text x*tile,y*tile,""+status(x,y)
   ;   If map(x,y)=56 And timer>warte Then NewEnemy(x,y,0) : timer=0
   ;   If map(x,y)=57 And timer>warte Then NewEnemy(x,y,0) : timer=0
   Next
   Next
   timer=timer+1
   
   
   UpdateUnit()
   UpdateEnemy()
   UpdatePlayer()
   UpdateBullet()
   UpdateBlood()
   UpdateExplosions()
   
Flip
Until KeyHit(1)
End    
;Player
Function NewPlayer(x,y,t,pl)
   
   p.player=New player
   p\x=x*tile
   p\y=y*tile
   p\typ=t
   
   p\def=defMax
   p\live=liveMax
   p\speed=2
   p\weapon=0
   
   p\play=pl
   p\nr=typ
   p\move=2
   
End Function
;Update
Function UpdatePlayer()
   
   For p.player=Each player
      
      ;Anzeigen
      DrawImage ImaPlayer(p\move),p\x,p\y,0
      DrawImage ImaWaffe(p\move),p\x,p\y,p\weapon
      ;Bewegen
      If KeyDown(up(p\play))=1 Then: ; Hoch
         If status(p\x/tile,p\y/tile-1)=0 And p\aa=0 Then p\move=1 : p\aa=1
      EndIf
      If p\move=1 Then:
      If p\aa=1 Then:
      p\y=p\y-p\speed
      p\dd=p\dd+1
      If p\dd=16 Then p\dd=0 : p\aa=0
      EndIf
      EndIf
      If KeyDown(ri(p\play))=1 Then: ; Rechts
         If status(p\x/tile+1,p\y/tile)=0 And p\aa=0 Then p\move=2 : p\aa=1
      EndIf
      If p\move=2 Then:
      If p\aa=1 Then:
      p\x=p\x+p\speed
      p\dd=p\dd+1
      If p\dd=16 Then p\dd=0 : p\aa=0
      EndIf
      EndIf
      If KeyDown(do(p\play))=1 Then: ; Unten
         If status(p\x/tile,p\y/tile+1)=0 And p\aa=0 Then p\move=3 : p\aa=1
      EndIf
      If p\move=3 Then:
      If p\aa=1 Then:
      p\y=p\y+p\speed
      p\dd=p\dd+1
      If p\dd=16 Then p\dd=0 : p\aa=0
      EndIf
      EndIf
      If KeyDown(le(p\play))=1 Then: ; Links
         If status(p\x/tile-1,p\y/tile)=0 And p\aa=0 Then p\move=4 : p\aa=1
      EndIf
      If p\move=4 Then:
      If p\aa=1 Then:
      p\x=p\x-p\speed
      p\dd=p\dd+1
      If p\dd=16 Then p\dd=0 : p\aa=0
      EndIf
      EndIf    
      ;Angriff
      If KeyDown(At(p\play))=1 Then:
         p\buf=p\buf+1
         If p\buf>dauer(p\weapon) And Muni(p\play,p\weapon)>0 Then Muni(p\play,p\weapon)=Muni(p\play,p\weapon)-1: p\buf=0 : NewBullet(p\x,p\y,p\move,p\weapon,p\play) : PlaySound Swea(p\weapon)
      EndIf
      ;Choose
      If KeyHit(Wu(p\play))=1 Then p\weapon=p\weapon+1   
      If KeyHit(Wd(p\play))=1 Then p\weapon=p\weapon-1
      If p\weapon>Wmax Then p\weapon=0
      If p\weapon<0 Then p\weapon=Wmax
      ;ex   
      For e.explosion=Each explosion            
         If ImagesOverlap(ex,e\x,e\y,player,p\x,p\y) And e\f=4 Then p\live=p\live-Angriff(3)
      Next
      Text p\x,p\y,""+p\live+"/"+p\weapon+"/"+Muni(p\play,p\weapon)
      ;ende
      If p\live<1 Then PlaySound klack :bl.blood=New blood:bl\x=p\x:bl\y=p\y:Delete p
   Next
   
End Function
;Bullet
Function NewBullet(x,y,m,w,t)
   
   b.bullet=New bullet
   b\x=x
   b\y=y
   b\dir=m
   b\att=Angriff(w)
   b\typ=w
   b\speed=Speed(w)
   b\team=t
   
End Function
;Bullet
Function UpdateBullet()
   
   For b.bullet=Each bullet
      
      ;Anzeigen
      DrawImage bullet,b\x,b\y,b\typ
      ;Bewegen
      If b\dir=1 And b\typ<3 Then b\y=b\y-b\speed
      If b\dir=2 And b\typ<3 Then b\x=b\x+b\speed
      If b\dir=3 And b\typ<3 Then b\y=b\y+b\speed 
      If b\dir=4 And b\typ<3 Then b\x=b\x-b\speed
      ;Granate
      If b\dir=1 And b\typ=3 And b\reich<=3*tile Then b\y=b\y-b\speed : b\reich=b\reich+b\speed
      If b\dir=2 And b\typ=3 And b\reich<=3*tile Then b\x=b\x+b\speed : b\reich=b\reich+b\speed
      If b\dir=3 And b\typ=3 And b\reich<=3*tile Then b\y=b\y+b\speed : b\reich=b\reich+b\speed   
      If b\dir=4 And b\typ=3 And b\reich<=3*tile Then b\x=b\x-b\speed : b\reich=b\reich+b\speed
      If b\typ=3 And b\reich>3*tile Then b\reich=b\reich+1
      If b\typ=3 And b\reich>3*tile+5 And b\reich<3*tile+10  Then b\reich=3*tile+11   PlaySound g_bounce
      If b\typ=3 And b\reich>4*tile Then:
      PlaySound granate_ex
         b\reich=b\reich+1
         e.Explosion=New Explosion
         e\x=b\x
         e\y=b\y
         e.Explosion=New Explosion
         e\x=b\x+tile
         e\y=b\y
         e.Explosion=New Explosion
         e\x=b\x-tile
         e\y=b\y
         e.Explosion=New Explosion
         e\x=b\x
         e\y=b\y+tile   
         e.Explosion=New Explosion
         e\x=b\x
         e\y=b\y-tile                           
         b\x=0 : b\y=0         
      EndIf
      ;Bazooka
      If b\dir=1 And b\typ=4 And b\reich=0 Then b\y=b\y-b\speed
      If b\dir=2 And b\typ=4 And b\reich=0 Then b\x=b\x+b\speed
      If b\dir=3 And b\typ=4 And b\reich=0 Then b\y=b\y+b\speed 
      If b\dir=4 And b\typ=4 And b\reich=0 Then b\x=b\x-b\speed
      If b\reich=1 And b\typ=4 Then:
         PlaySound granate_ex
         b\reich=b\reich+1
         e.Explosion=New Explosion
         e\x=b\x
         e\y=b\y
         e.Explosion=New Explosion
         e\x=b\x+tile
         e\y=b\y
         e.Explosion=New Explosion
         e\x=b\x-tile
         e\y=b\y
         e.Explosion=New Explosion
         e\x=b\x
         e\y=b\y+tile   
         e.Explosion=New Explosion
         e\x=b\x
         e\y=b\y-tile                           
         b\x=0 : b\y=0         
      EndIf   
      ;Kollision
      If status(b\x/tile,b\y/tile)=1 And b\typ<>3 And b\typ<>4 Then b\x=5 : b\y=5
      If status(b\x/tile,b\y/tile)=1 And b\typ=3 Then b\reich=5*tile
      If status(b\x/tile,b\y/tile)=1 And b\typ=4 Then b\reich=1
      For p.player=Each player
         If p\play<>b\team And b\typ<>3 Then:
            If b\typ<>4 And ImagesCollide(player,p\x,p\y,p\nr,bullet,b\x,b\y,b\typ) Then b\x=-123455 : b\y=-123344 : p\live=p\live-b\att : bl.blood=New blood : bl\x=p\x+Rnd(-5,5) : bl\y=p\y+Rnd(-5,5)
            If b\typ=4 And ImagesCollide(player,p\x,p\y,p\nr,bullet,b\x,b\y,b\typ) Then b\reich=1:p\live=p\live-b\att :  bl.blood=New blood : bl\x=p\x+Rnd(-5,5) : bl\y=p\y+Rnd(-5,5)
         EndIf
      Next
      For en.enemy=Each enemy
         If ImagesCollide(enemy,en\x,en\y,0,bullet,b\x,b\y,b\typ) Then b\x=-123455 : b\y=-123344 : en\live=en\live-b\att : bl.blood=New blood : bl\x=en\x+Rnd(-5,5) : bl\y=en\y+Rnd(-5,5)
      Next    
      ;Ende
      If b\x<16 Or b\y<16 Or b\x>width-tile Or b\y>height-tile Then Delete b
      
   Next
   
End Function
;Explosiuon
Function UpdateExplosions()
   For e.explosion=Each explosion
      e\f=e\st/3
      If e\f=9
         Delete e
      Else
         DrawImage ex,e\x,e\y,e\f
         e\st=e\st+1
      EndIf
   Next
End Function
;blood
Function UpdateBlood()
   For bl.blood=Each blood
      bl\f=bl\st/4
      If bl\f=3
         Delete bl
      Else
         DrawImage blood,bl\x,bl\y,bl\f
         bl\st=bl\st+1
      EndIf
   Next
End Function
;unit
Function NewUnit(x,y,t)
   
   u.unit=New unit
   u\x=x*tile
   u\y=y*tile
   u\typ=t
   u\leb=1
   
End Function
;unit
Function UpdateUnit()
   
   For u.unit=Each unit
      
      ;Anzeigen
      DrawImage unit,u\x,u\y,u\typ
      ;Wirkung
      For p.player=Each player
      If ImagesCollide(unit,u\x,u\y,0,player,p\x,p\y,0) Then:
         
         If u\typ=0 Then:;Medipack
            u\leb=0
            p\live=liveMax
         ElseIf u\typ=1 Then:;pistol
            u\leb=0
            Muni(p\play,0)=Muni(p\play,0)+12
         ElseIf u\typ=2 Then:;mp90
            u\leb=0
            Muni(p\play,1)=Muni(p\play,1)+25
         ElseIf u\typ=3 Then:;shotgun
            u\leb=0
            Muni(p\play,2)=Muni(p\play,2)+6                        
         ElseIf u\typ=4 Then:;granate
            u\leb=0
            Muni(p\play,3)=Muni(p\play,3)+3   
         ElseIf u\typ=5 Then:;bazooka
            u\leb=0
            Muni(p\play,4)=Muni(p\play,4)+1                                 
         EndIf      
      EndIf
      Next
      For b.bullet=Each bullet
      If ImagesOverlap(bullet,b\x,b\y,unit,u\x,u\y) Then:
         
         If u\typ=6 Then:;fass
            u\leb=0
            PlaySound granate_ex
            e.Explosion=New Explosion
            e\x=b\x
            e\y=b\y
            e.Explosion=New Explosion
            e\x=b\x+tile
            e\y=b\y
            e.Explosion=New Explosion
            e\x=b\x-tile
            e\y=b\y
            e.Explosion=New Explosion
            e\x=b\x
            e\y=b\y+tile   
            e.Explosion=New Explosion
            e\x=b\x
            e\y=b\y-tile
            ;b\x=0
         EndIf
      EndIf    
      Next
      For e.explosion=Each explosion
      If ImagesOverlap(ex,e\x,e\y,unit,u\x,u\y) Then:
         
         If u\typ=6 Then:;fass
            u\leb=0
            PlaySound granate_ex
            e.Explosion=New Explosion
            e\x=u\x
            e\y=u\y
            e.Explosion=New Explosion
            e\x=u\x+tile
            e\y=u\y
            e.Explosion=New Explosion
            e\x=u\x-tile
            e\y=u\y
            e.Explosion=New Explosion
            e\x=u\x
            e\y=u\y+tile   
            e.Explosion=New Explosion
            e\x=u\x
            e\y=u\y-tile
         EndIf
      EndIf    
      Next       
      ;Ende
      If u\leb=0 Then PlaySound klack :bl.blood=New blood:bl\x=u\x:bl\y=u\y:Delete u
      
   Next
   
End Function
;Load
Function LoadMap(nam$)
   
   file=OpenFile("Map\"+nam$+".HoB")
      
      For x=0 To mapX
      For y=0 To mapY
      
      map(x,y)=ReadInt(file)   
      
      If map(x,y)=0 Then map(x,y)=8
      If map(x,y)=56 Then NewPlayer(x,y,1,0)
      ;If map(x,y)=57 Then NewPlayer(x,y,1,1)      
      If map(x,y)>0 And map(x,y)<8 Then status(x,y)=1
      If map(x,y)>19 And map(x,y)<24 Then status(x,y)=1
      If map(x,y)>27 And map(x,y)<35 Then status(x,y)=1
      If map(x,y)=55 Then status(x,y)=1
      If map(x,y)>57 And map(x,y)<60 Then status(x,y)=1
      
      For i=64 To 70
      If map(x,y)=i Then NewUnit(x,y,i-64) : map(x,y)=8
      Next
      Next
      Next
      
            
         
            
   CloseFile file
   
End Function
;Enemy
Function NewEnemy(x,y,t)
   
   en.enemy=New enemy
   en\x=x*tile
   en\y=y*tile
   en\typ=t
   
   en\xZ=4*tile
   en\yz=18*tile   
   
   en\live=50
   en\speed=1
   en\uPfad=CreateBank(2)
   
End Function
;Update
Function UpdateEnemy()
   
   For en.enemy=Each enemy

   ;Anzeigen
      DrawImage ImaEnemy(en\move),en\x,en\y,en\typ
            
      ;Bewegen
      If en\xZ<>en\x And en\yZ<>en\y Then:
         If status(en\xZ/tile,en\yZ/tile)=0 Then:
         en\geh=1
            en\xEnd=en\xZ
            en\yEnd=en\yZ
            Pathfinding(en\x/tile,en\y/tile,en\xEnd/tile,en\yEnd/tile):en\FightStep=PfadSpliner()
            Bsize=BankSize(PfadBank)
            ResizeBank(en\uPfad,Bsize)
            CopyBank PfadBank, 0, en\uPfad, 0, Bsize   
         EndIf          
      EndIf
      
      ;Pathfinding
      If en\fightstep<0 Then en\fightstep=0
      If en\fightstep<1 Then: en\xZ=en\xEnd:en\yZ=en\yEnd   
      ElseIf en\fightstep>0 Then:
         en\xZ=(PeekShort(en\uPfad,en\FightStep))
         en\yZ=(PeekShort(en\uPfad,en\FightStep+2))
         en\x=en\xZ
         en\y=en\yZ
      EndIf
      If en\x=en\xZ And en\y=en\yZ And en\fightstep>0 Then en\fightstep=en\fightstep-44   
      
      ;Oben laufen                         
         If en\yZ < en\y And status(en\x/tile,en\y/tile-1)=0 Then: en\y=en\y-en\speed : en\move=1   
      ;Unten  laufen
         ElseIf en\yZ > en\y And status(en\x/tile,en\y/tile+1)=0 Then: en\y=en\y+en\speed : en\move=3       
      ;Rechts laufen
         ElseIf en\xZ > en\x And status(en\x/tile+1,en\y/tile)=0 Then: en\x=en\x+en\speed : en\move=2         
      ;Links  laufen
         ElseIf en\xZ < en\x And status(en\x/tile-1,en\y/tile)=0 Then: en\x=en\x-en\speed : en\move=4      
         EndIf
         
      ;Ende
      If en\live<1 Then Delete en   : PlaySound dead
   
   Next
   

End Function
;pathfinding
Function pathfinding(startx,starty,endx,endy)
  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

  .again0
  node=Null
  cost=2147483647
  For open=Each open
    delta=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 3
    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
        tempnode.node=New node
        tempnode\parent=node
        tempnode\cost=node\cost+1
        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
      EndIf
    EndIf
  Next
  If finish=0 Then Goto again0

  While tempnode\parent<>Null
    path.path=New path
    path\node=tempnode
    tempnode=tempnode\parent
  Wend
  path.path=New path
  path\node=tempnode
End Function
;PfadSpliner()
Function PfadSpliner()
FreeBank(PfadBank):PfadBank=CreateBank(4)

    Color 200,0,0
    For path.path=Each path
      If path=Last path Then Exit
      tmp.path=Before path
      If tmp=Null Then
        x0=path\node\x
        y0=path\node\y
      Else
        x0=tmp\node\x
        y0=tmp\node\y
      EndIf
      x1=path\node\x
      y1=path\node\y
      tmp.path=After path
      x2=tmp\node\x
      y2=tmp\node\y
      tmp.path=After tmp
      If tmp=Null Then
        x3=x2
        y3=y2
      Else
        x3=tmp\node\x
        y3=tmp\node\y
      EndIf
      spline(X0,Y0,X1,Y1,X2,Y2,X3,Y3)
   Next
Return BankSize(PfadBank)-4
End Function
;spline(x1,y1,x2,y2,x3,y3,x4,y4)
Function spline(x1,y1,x2,y2,x3,y3,x4,y4)
Ras=32:Rh=Ras/2
x1=x1*Ras+rh:y1=y1*Ras+rh
x2=x2*Ras+rh:y2=y2*Ras+rh
x3=x3*Ras+rh:y3=y3*Ras+rh
x4=x4*Ras+rh:y4=y4*Ras+rh
  For u#=0 To 1.1 Step .1
    u2#=u#*u#
    u3#=u#*u#*u#
    f1#=-0.5*u3#+1.0*u2#-0.5*u#
    f2#= 1.5*u3#-2.5*u2#+1.0
    f3#=-1.5*u3#+2.0*u2#+0.5*u#
    f4#= 0.5*u3#-0.5*u2#
    x=x1*f1#+x2*f2#+x3*f3#+x4*f4#
    y=y1*f1#+y2*f2#+y3*f3#+y4*f4#

If ax<>x Or ay<>y Then
Pos=BankSize(PfadBank):ResizeBank(PfadBank,Pos+4)
PokeShort(PfadBank,Pos,x)
PokeShort(PfadBank,Pos+2,y)

End If
ax=X:ay=Y
      Next
End Function

http://www.file-upload.net/download-918022/Shooter.exe.html