;Game created for BCC 17 by The Shark - Edited by DAK

.s
Global fps, FPS_temp, FPS_time
Function GetFPS()
   ctime = MilliSecs()
   FPS_temp = FPS_temp + 1
   If ctime - FPS_time > 500 Then
      fps = FPS_temp * 2
      FPS_temp = 0
      FPS_time = ctime
   EndIf
   Return fps
End Function


SeedRnd MilliSecs()

Type geg
   Field x#,y#,h,mh,w,t
End Type
Type shot
   Field x#,y#,xsp#,ysp#,w,g
End Type
Type blood
   Field x,y,xsp#,ysp#,t
End Type

Local sx,sy,sh.shot
Global shot1=0,shot2=0,pw,mx,my,pat,px#=1024/2,py#=768/2,lv=0,gegner,ge.geg,bl.blood,bg,points,health=20

Graphics 1024,768,32,2
SetBuffer BackBuffer()
HidePointer
t=CreateTimer(80)
Text 20,20,"Lade"
Flip
g=LoadImage("gfx.bmp")
b=LoadImage("boden.bmp")
fk=LoadImage("fk.bmp")
pat=LoadImage("p.bmp")
MidHandle pat
MidHandle fk
MaskImage fk,0,0,0
DrawBlock g,1,0
Dim gr(5,72)
Dim pt(36)
TFormFilter 0
For i=0 To 4
   For j=0 To 71
      gr(i,j)=CreateImage(64,64)
      GrabImage gr(i,j),1*i*64,0
      MidHandle gr(i,j)
      RotateImage gr(i,j),j*5
   Next
Next
For i=0 To 35
   pt(i)=CopyImage(pat)
   MidHandle pt(i)
   RotateImage pt(i),i*10
Next
bg=CreateImage(1024,768)
SetBuffer ImageBuffer(bg)
TileBlock b
level()
SetBuffer BackBuffer()
While Not KeyDown(1)
   WaitTimer(t)
   mx=MouseX()
   my=MouseY()
   pw=(450-ATan2(mx-px,my-py))
   If KeyDown(17) Or KeyDown(200) Then py=py-2
   If KeyDown(31) Or KeyDown(208) Then py=py+2
   If KeyDown(30) Or KeyDown(203) Then px=px-2
   If KeyDown(32) Or KeyDown(205) Then px=px+2
   If px<0 Then px=0
   If py<0 Then py=0
   If px>1023 Then px=1023
   If py>767 Then py=767
   pic=1
   If MouseDown(1) And shot1=0
      pic=pic+1
      shot(1)
      shot1=20
   EndIf
   If MouseDown(2) And shot2=0
      pic=pic+2
      shot(2)
      shot2=20
   EndIf
   up_geg
   up_shot
   up_blood
   DrawBlock bg,0,0   
   dr_shot
   dr_geg
   DrawImage gr(pic,pw/5 Mod 71),px,py
   LockBuffer(BackBuffer())
   dr_blood
   UnlockBuffer(BackBuffer())
   
   DrawImage fk,mx+Cos((pw+90) Mod 360)*23,my+Sin((pw+90) Mod 360)*23
   DrawImage fk,mx+Cos((pw-90) Mod 360)*23,my+Sin((pw-90) Mod 360)*23
   Color 0,0,0
   Rect 5,5,120,55
   Color 255,255,255
   Rect 5,5,120,55,0
   Text 10,10,"Level: "+(lv-1)
   Text 10,20,"Punkte: "+points
   Rect 14,40,102,10,0
   Color 0,200,0
   Rect 15,41,health*100/20,8
   
   Flip 0
   If shot1>0 Then shot1=shot1-1
   If shot2>0 Then shot2=shot2-1
   If gegner=0 Then level()
   If health<1 Then gameover:Goto s
Wend
End

Function shot(side)
   sh.shot=New shot
   Select side
      Case 1   
         sh\x=px+Cos((pw-90) Mod 360)*23+Cos((pw) Mod 360)*26
         sh\y=py+Sin((pw-90) Mod 360)*23+Sin((pw) Mod 360)*26
      Case 2
         sh\x=px+Cos((pw+90) Mod 360)*23+Cos((pw) Mod 360)*26
         sh\y=py+Sin((pw+90) Mod 360)*23+Sin((pw) Mod 360)*26      
   End Select
   sh\xsp=Cos(pw Mod 360)*5
   sh\ysp=Sin(pw Mod 360)*5
   sh\w=pw/10 Mod 35
End Function

Function up_shot()
   For sh.shot=Each shot
      sh\x=sh\x+sh\xsp
      sh\y=sh\y+sh\ysp
      del = 0
      For ge.geg=Each geg         
         If ImagesOverlap(pt(sh\w),sh\x,sh\y,gr(0,ge\w/5 Mod 71),ge\x,ge\y)
            If ImagesCollide(pt(sh\w),sh\x,sh\y,0,gr(0,ge\w/5 Mod 71),ge\x,ge\y,0)
               If sh\g<>Handle(ge.geg)
                  ge\h=ge\h-1
                  sh\g=Handle(ge.geg)
                  del=1
               EndIf
               For i=0 To 20
                  blood(sh\x,sh\y)
               Next
            EndIf
         EndIf   
      Next
      If sh\x>1025 Or sh\x<-1 Or sh\y>769 Or sh\y<-1
         Delete sh
      EndIf
      If del=1 Then Delete sh
   Next
End Function

Function dr_shot()
   For sh.shot=Each shot
      DrawImage pt(sh\w),sh\x,sh\y
   Next
End Function

Function up_geg()
   For ge.geg=Each geg
      ge\w=450-ATan2(ge\x-px,ge\y-py)+180 Mod 360
      ge\x=ge\x+Cos(ge\w)*1.5
      ge\y=ge\y+Sin(ge\w)*1.5
      If MilliSecs()>ge\t
         If (Float(Abs((px-ge\x#)*(px-ge\x#)+(py-ge\y#)*(py-ge\y#))))^.5<60
            health=health-1
            ge\t=MilliSecs()+500
         EndIf
      EndIf
      If ge\h<1
         points=points+ge\mh
         Delete ge
         gegner=gegner-1
      EndIf
   Next
End Function

Function dr_geg()
   For ge.geg=Each geg
      DrawImage gr(0,ge\w/5 Mod 71),ge\x,ge\y
      Color 0,0,0
      Rect ge\x-31,ge\y+30,62,7
      Color 255,0,0
      Rect ge\x-30,ge\y+31,ge\h*60/ge\mh,5
   Next
End Function
Function level()
   gegner=0
   For i=0 To lv
      ge.geg=New geg
      ge\x=(512*Rand(0,2))
      If ge\x=512
         ge\y=(768*Rand(0,1))
      Else
         ge\y=(384*Rand(0,2))
      EndIf
      ge\h=lv*2
      ge\mh=ge\h
      gegner=gegner+1
   Next
   lv=lv+1
End Function

Function blood(x,y)
   bl.blood=New blood
   bl\x=x
   bl\y=y
   bl\xsp=Rnd(-2,2)
   bl\ysp=Rnd(-2,2)
   bl\t=MilliSecs()+Rand(300,800)
End Function
Function up_blood()
   For bl=Each blood
      bl\x=bl\x+bl\xsp
      bl\y=bl\y+bl\ysp
      If MilliSecs()>bl\t
         SetBuffer ImageBuffer(bg)
         LockBuffer()
         bloodmap(bl\x+1,bl\y)
         bloodmap(bl\x,bl\y+1)
         bloodmap(bl\x,bl\y-1)
         bloodmap(bl\x-1,bl\y)
         bloodmap(bl\x,bl\y)
         UnlockBuffer()
         SetBuffer BackBuffer()
         Delete bl
      EndIf
   Next   
End Function
Function dr_blood()
   Color 255,0,0
   For bl=Each blood
      Line bl\x,bl\y,bl\x+bl\xsp,bl\y+bl\ysp
   Next
End Function
Function bloodmap(x,y)
   If x>1023 Or x<0 Or y>767 Or y<0 Then Goto ext
   al=50
   farbe=ReadPixelFast(x,y)
   red_old = (farbe And $FF0000)/$10000
   green_old = (farbe And $FF00)/$100
   blue_old = farbe And $FF
   red = (al * red_old + (1 - al) * 255)
   green = (al * green_old + (1 - al) * 0)
   blue = (al * blue_old + (1 - al) * 0)
   rgb = 255 * $1000000 + red * $10000 + green * $100 + blue
   WritePixelFast X,Y,rgb   
   .ext
End Function
Function gameover()
   Color 0,0,0
   Rect 200,200,400,200
   Color 255,255,255
   Rect 200,200,400,200,0
   Text 1024/2,220,"GAME OVER",1
   Text 280,280,"Level"
   Text 280,300,"Punkte"
   Text 380,280,lv
   Text 380,300,points
   Text 280,350,"Press any key to end the game"
   Text 280,370,"Press R for rematch"
   Flip
   Delay 1000
   FlushKeys
   WaitKey
   If KeyHit(19) Then del:Return 1
   End
End Function
Function del()
   For g.geg=Each geg
      Delete g
   Next
   For s.shot=Each shot
      Delete s
   Next
   For b.blood=Each blood
      Delete b
   Next
End Function