Heads Attack

[peter]

Hello,

A small game demo.

Arrow keys right / left moves a space ship.
Space bar fires a laser-energy-ball.



Uses "ui"
#INCLUDE "abc.inc"
#INCLUDE "bass.inc"

openwindow 800,600
SetHandleDC hdc, hwnd
SetFont 22,32,%FW_BOLD,"times"
initBass

Function CircleCollide(x1,y1,r1, x2,y2,r2 As Long) As Long
If Sqr((x1-x2) * (x1-x2) + (y1-y2) * (y1-y2)) < r1+r2 Then
Return 1
End If
End Function

Long xRak,yRak,rRak,zRak,iBx,iDx,iCx,iAx,zFrame,z1,z2,z3,z4
Long bmap,fo,fa,w1,w2,w3,s,y,sc,uz,jx,drop,Ok,count,px
Single jv,zv,dv,za

Dim xMeg(40) As Long
Dim yMeg(40) As Long
Dim zMeg(40) As Long
Dim xUfo(40) As Long
Dim yUfo(40) As Long
Dim zUfo(40) As Long
Dim rUfo(40) As Long
Dim iUfo(40) As Long
Dim nUfo(40) As Long
Dim xRok(40) As Long
Dim yRok(40) As Long
Dim rRok(40) As Long
Dim xBum(40) As Long
Dim yBum(40) As Long
Dim iBum(40) As Long
Dim zBum(40) As Long
Dim vBum(40) As Single

bmap= LoadTile "shoot/bitmap.bmp",8,5
w1 = LoadSound "shoot/shoot.wav"
w2 = LoadSound "shoot/explo.wav"
w3 = LoadSound "shoot/xship.wav"

Sub Timer1()
dv = dv + 0.1
If dv >=1 Then
dv=0
zFrame = zFrame +1
If zFrame =8 Then zFrame =0
End If
End Sub

Sub Timer2()
jv = jv +1
If jv =50 Then
jv=0
jx = jx +1
If jx =21 Then jx=0
End If
End Sub

Sub Timer3()
Drop = Rnd(1,40)
End Sub

Sub Timer4()
If Ok=1 Then Exit Sub
za +=.2
If za >=5 Then
za=0
count = count -1
If count <=0 Then count=0
End If
End Sub

Function SetExplos(xx, yy, ii As Long) As Long
For iDx=1 To 40
If yBum(iDx) = 0 Then
xBum(iDx) = xx
yBum(iDx) = yy
iBum(iDx) = ii
Return 0
End If
Next
End Function

Sub ShowExplos()
For iDx=1 To 40
If iBum(iDx) =1 Then
DrawTile(bmap,xBum(iDx),yBum(iDx),64,64,zBum(iDx),1)
vBum(iDx) = vBum(iDx) + 0.1
If vBum(iDx) >=1 Then
vBum(iDx)=0
zBum(iDx) = zBum(iDx) +1
End If
If zBum(iDx) =8 Then
zBum(iDx) =0
yBum(iDx) =0
iBum(iDx) =0
vBum(iDx) =0
End If
End If
Next
End Sub

Function SetRocket(xx, yy As Long) As Long
For iAx=1 To 40
If yRok(iAx) =0 Then
xRok(iAx) = xx
yRok(iAx) = yy
rRok(iAx) = 1
Return 0
End If
Next
End Function

Sub ScanRocket()
For iAx=1 To 40
If rRok(iAx) =1 And yRok(iAx) <=-32 Then
rRok(iAx) =0
yRok(iAx) =0
End If
Next
End Sub

Sub ShowRocket()
For iAx=1 To 40
If rRok(iAx) =1 Then
DrawTile(bmap,xRok(iAx),yRok(iAx),64,64,zFrame,0)
yRok(iAx) = yRok(iAx) -4
If yRok(iAx) =400 Then zRak=0
End If
Next
End Sub

Sub ScanRakete()
If rRak=5 Then Exit Sub
If Key(32) And Key(%VK_RIGHT) And zRak =0 Then
SetRocket(xRak,yRak)
rRak =1
zRak =1
PlaySound(w1)
ElseIf Key(32) And Key(%VK_LEFT) And zRak =0 Then
SetRocket(xRak,yRak)
rRak =2
zRak =1
PlaySound(w1)
ElseIf Key(32) And zRak =0 Then
SetRocket(xRak,yRak)
zRak =1
PlaySound(w1)
ElseIf Key(%VK_RIGHT) And xRak <736 Then
rRak =1
ElseIf Key(%VK_LEFT) And xRak >0 Then
rRak =2
Else
rRak =0
End If
End Sub

Sub ShowRakete()
If rRak =0 Then
DrawTile(bmap,xRak,yRak,64,64,zFrame,4)
ElseIf rRak =1 Then
DrawTile(bmap,xRak,yRak,64,64,zFrame,4)
xRak = xRak +2
ElseIf rRak =2 Then
DrawTile(bmap,xRak,yRak,64,64,zFrame,4)
xRak = xRak -2
End If
End Sub

Sub RocketCollision()
For iBx=1 To uz
For iCx=1 To 40
If rRok(iCx) >0 And rUfo(iBx) >0 Then
If CircleCollide(xRok(iCx)+32,yRok(iCx)+32,16,xUfo(iBx)+32,yUfo(iBx)+32,16)=1 Then
SetExplos(xRok(iCx),yRok(iCx),1)
SetExplos(xUfo(iBx),yUfo(iBx),1)
rRok(iCx) =0: yRok(iCx) =0
rUfo(iBx) =0: yUfo(iBx) =0
PlaySound(w2)
sc = sc +25
Exit Sub
End If
End If
Next
Next
End Sub

Sub RaketeCollision()
If Ok=1 Then Exit Sub
For iAx=1 To 40
If yMeg(iAx) >0 Then
If CircleCollide(xRak,yRak,16,xMeg(iAx),yMeg(iAx),16)=1 Then
SetExplos(xRak,yRak,1)
rRak=5: Ok=1
PlaySound(w3)
Return 0
End If
End If
Next
End Function

Sub SetUfos()
For iAx=1 To uz
xUfo(iAx) = Rnd(16,736)
yUfo(iAx) = Rnd(16,300)
rUfo(iAx) = Rnd(1,4)
zUfo(iAx) = 0
nUfo(iAX) = 0
Next
End Sub

Sub ScanUfos()
For iBx=1 To uz
If rUfo(iBx) =1 And xUfo(iBx) >=736 Then
rUfo(iBx) =2
ElseIf rUfo(iBx) =2 And xUfo(iBx) <=0 Then
rUfo(iBx) =1
ElseIf rUfo(iBx) =3 And yUfo(iBx) <=0 Then
rUfo(iBx) =4
ElseIf rUfo(iBx) =4 And yUfo(iBx) >=350 Then
rUfo(iBx) =3
ElseIf jx = 5 And rUfo(iBx) =4 Then
rUfo(iBx) = Rnd(1,4)
ElseIf jx =10 And rUfo(iBx) =3 Then
rUfo(iBx) = Rnd(1,4)
ElseIf jx =15 And rUfo(iBx) =2 Then
rUfo(iBx) = Rnd(1,4)
ElseIf jx =20 And rUfo(iBx) =1 Then
rUfo(iBx) = Rnd(1,4)
End If
Next
End Sub

Sub ShowUfos()
For iBx=1 To uz
If rUfo(iBx) =1 Then
DrawTile(bmap,xUfo(iBx),yUfo(iBx),64,64,zFrame,2)
xUfo(iBx) = xUfo(iBx) +2
ElseIf rUfo(iBx) =2 Then
DrawTile(bmap,xUfo(iBx),yUfo(iBx),64,64,zFrame,2)
xUfo(iBx) = xUfo(iBx) -2
ElseIf rUfo(iBx) =3 Then
DrawTile(bmap,xUfo(iBx),yUfo(iBx),64,64,zFrame,2)
yUfo(iBx) = yUfo(iBx) -2
ElseIf rUfo(iBx) =4 Then
DrawTile(bmap,xUfo(iBx),yUfo(iBx),64,64,zFrame,2)
yUfo(iBx) = yUfo(iBx) +2
End If
Next
End Sub

Sub SetData()
xRak=384:yRak=536:rRak=0:za=0
uz=40:sc=0:Ok=0:count=300
SetUfos()
For iBx=1 To 40
yMeg(iBx) =0
xMeg(iBx) =0
Next
End Sub

Sub TestUfos()
For iAx=1 To 40
If yUfo(iAx) >0 Or Ok=1 Then Exit Sub
Next
Ok=1
sc= sc+count
End Sub

Sub ScanUfoBombs()
For iAx=1 To drop Step 2
If rUfo(iAx) >0 Then
If yMeg(iAx) =0 Then
xMeg(iAx) =xUfo(iAx)
yMeg(iAx) =yUfo(iAx)+32
End If
End If
Next
End Sub

Sub UfoBombs()
For iDx=1 To 40
If yMeg(iDx) >0 Then
If iDx <20 Then
DrawTile(bmap,xMeg(iDx),yMeg(iDx),64,64,zFrame,3)
ElseIf iDx >=20 Then
DrawTile(bmap,xMeg(iDx),yMeg(iDx),64,64,zFrame,3)
End If
yMeg(iDx) = yMeg(iDx) +2
If yMeg(iDx) >=600 Then yMeg(iDx)=0
End If
Next
End Sub

SetData()
While IsWindow(hwnd) And Key(27)=0
Canvas_Clear 0
If Ok=1 Then
DrawText(460,32,"SCORE:" & sc,&H45D4FE)
ElseIf Ok=0 Then
DrawText(460,32,"SCORE:" & sc,&HFFFFFF)
End If
ScanUfos()
ShowUfos()
ScanRocket()
ShowRocket()
ScanRakete()
ShowRakete()
ScanUfoBombs()
UfoBombs()
ShowExplos()
RocketCollision()
RaketeCollision()
TestUfos()
Timer1()
Timer2()
Timer3()
Timer4()
If Ok=1 Then
DrawText(240,300,"ONCE AGAIN?",&HFFFFFF)
DrawText(240,334,"HIT (c) KEY",&HFFFFFF)
If Key(%VK_C) Then
SetData
End If
End If
DrawText(16,32,"BONUS:" & count,&H8080FF)
Canvas_Redraw
SetFps 200
Wend
FreeGraphic
FreeBass
Canvas_Window End

[ErosOlmi]

Thanks a lot for this nice game.
All is working fine!