Code archives/Miscellaneous/Sideview shooter example
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
Here a video of it in action : http://youtu.be/8OTIwclTL6s I was looking at video footage of a old Amiga game called Project X. There was a part were asteroids were moving into the screen and the player was shooting them. I remade that part here. The asteroids are created randomly and flash if hit. They have a hitcount. The player moves towards the mouse and mouse 1 is fire. If you hit an asteroid then the position of the player is reset and the score is set back to 0. | |||||
; Sideview shooter example by Pakz Graphics 640,480,32,2 SetBuffer BackBuffer() SeedRnd MilliSecs() Type ast Field x,y End Type Type bullet Field t,x#,y#,mx#,my# End Type Type player Field x,y,w,h,e ;e=energy Field s ; s = score End Type Type asteroid Field x#,y#,mx#,my#,f,ftime,p ; f = flash , flash time,p = power Field im,fim ; image and flash image End Type Global p.player = New player p\x = 32 p\y = GraphicsHeight()/2 p\w = 32 p\h = 32 ; make 10 asteroids For i=0 To 10 newasteroid Next timer = CreateTimer(60) While KeyDown(1) = False WaitTimer(timer) Cls updateplayer() updatebullets() updateasteroids() drawbullets() drawasteroids() Color 255,0,0 Oval p\x-p\w/2,p\y-p\h/2,p\w,p\h,True Color 255,255,255 Text 0,0,"score:"+p\s Flip Wend End Function newasteroid() ; create a new asteroid this.asteroid = New asteroid n = MilliSecs() ; create the images this\im = CreateImage(64,64) this\fim = CreateImage(64,64) ; draw the asteroids into the containers this\im = makeasteroid(0,n) this\fim = makeasteroid(1,n) ; choose top right or bottom position for asteroid to begin a = Rand(1,3) Select a Case 1 ; top this\x = Rand(100,GraphicsWidth()) this\y = -48 this\mx = Rand(-1,-2) this\my = Rand(1,2) Case 2 ; bottom this\x = Rand(100,GraphicsWidth()) this\y = GraphicsHeight()+48 this\mx = Rand(-1,-2) this\my = Rand(-1,-2) Case 3 ; right this\x = GraphicsWidth()+48 this\y = Rand(-48,GraphicsHeight()+92) this\mx = Rand(-1,-2) this\my = Rand(-1,2) End Select this\p = Rand(2,3) End Function Function updateasteroids() For this.asteroid = Each asteroid ; move the asteroids this\x = this\x + this\mx this\y = this\y + this\my ; stop the flashing If this\ftime < MilliSecs() Then this\f = False ; if the asteroid is to far away out of the screen then delete it and remake it elsewhere If RectsOverlap(this\x-24,this\y-24,48,48,-64,-64,GraphicsWidth()+128,GraphicsHeight()+128) = False FreeImage this\im FreeImage this\fim Delete this newasteroid() End If Next End Function Function drawasteroids() For this.asteroid = Each asteroid Select this\f Case False : DrawImage this\im,this\x-32,this\y-32 Case True : DrawImage this\fim,this\x-32,this\y-32 End Select Next End Function Function updatebullets() For this.bullet = Each bullet rembullet = False this\x = this\x + this\mx this\y = this\y + this\my For that.asteroid = Each asteroid Select this\t Case 1 If RectsOverlap(this\x-3,this\y-16,3,32,that\x-32,that\y-32,64,64) that\p = that\p - 1 that\f = True that\ftime = MilliSecs()+120 If that\p < 0 p\s = p\s + 10 FreeImage that\im FreeImage that\fim Delete that newasteroid End If rembullet = True End If Case 2 If RectsOverlap(this\x-16,this\y-3,32,3,that\x-32,that\y-32,64,64) that\p = that\p - 1 that\f = True that\ftime = MilliSecs()+120 If that\p < 0 p\s = p\s + 10 FreeImage that\im FreeImage that\fim Delete that newasteroid End If rembullet = True End If End Select Next If RectsOverlap(this\x,this\y,3,32,-32,-32,GraphicsWidth()+64,GraphicsHeight()+64) = False Delete this End If If rembullet = True Then Delete this Next End Function ; ; Move the player towards the mouse position ; Fire if pressed ; If collision with player then reset to start position Function updateplayer() a = getangle(p\x,p\y,MouseX(),MouseY()) p\x = p\x + Cos(a) * 5 p\y = p\y + Sin(a) * 5 If MouseHit(1) initshot() End If For this.asteroid = Each asteroid If RectsOverlap(p\x-16,p\y-16,32,32,this\x-32,this\y-32,64,64) p\x = 64 p\y = GraphicsHeight()/2-16 p\s = 0 End If Next End Function Function initshot() this.bullet = New bullet this\x = p\x this\y = p\y this\mx = 12 ; bullet shooting speed this\my = 0 this\t = 1 this.bullet = New bullet this\x = p\x this\y = p\y this\mx = 0 this\my = -12 this\t = 2 this.bullet = New bullet this\x = p\x this\y = p\y this\mx = 0 this\my = 12 this\t = 2 End Function Function drawbullets() For this.bullet = Each bullet If this\t = 1 Color 0,0,255 Oval this\x,this\y-16,4,32,True End If If this\t = 2 Color 0,0,255 Oval this\x-16,this\y,32,4,True End If Next End Function Function getangle(x1,y1,x2,y2) Local dx = x2 - x1 Local dy = y2 - y1 Return ATan2(dy,dx)+360 Mod 360 End Function ; ; This function makes a random asteroid ; ; It goes in a circle and uses a random distance to place points ; then it draws lines from the last point to the last point ; Function makeasteroid(c=0,seed) Delete Each ast SeedRnd seed Local im = CreateImage(64,64) SetBuffer ImageBuffer(im) Select c Case 0:Color 150,150,150 Case 1:Color 255,255,255 End Select a=-180 For i=0 To 20 a = a + 360/20 this.ast = New ast this\x = Cos(a)*Rand(20,32) this\y = Sin(a)*Rand(20,32) Next this.ast = Last ast x1 = this\x y1 = this\y For this.ast = Each ast Line x1+32,y1+32,this\x+32,this\y+32 x1 = this\x y1 = this\y Next SetBuffer BackBuffer() Return im End Function |
Comments
None.
Code Archives Forum