UnderwareDESIGN

PlayBASIC => Resources => Source Codes => Topic started by: stef on December 30, 2005, 04:47:37 PM

Title: rocket and ufo 2
Post by: stef on December 30, 2005, 04:47:37 PM
Hi everybody!

Edit: YOU WILL FIND FINAL VERSION DOWNWARDS; THE THIRD CODE IN THREAD

Yes! New technology :)  particle propulsion!

Aim with mouse(no clicking), rocket must hit the center!

Greetings
stef


[pbcode]
; PROJECT : rocket and ufo 2
; AUTHOR  : stef
; CREATED : 12.11.2005
; EDITED  : 01.01.2006
; ---------------------------------------------------------------------
;aim with mouse
;ufo must be hit exactly in center

framerate =0  ;change this when too fast
SetFPS framerate
OpenScreen 800,600,16,2

Global part_numb,sinus#,cosinus#,x#,y#,part_colr,part_colg,part_colb,xstart#,ystart#
Global part_max,part_speed#,rot_angle#,dispers,grav#,ufoposx#,ufoposy#,ufospeed#

Gosub mousedraw
Gosub rocketdraw
SpriteCollision rocketsp,On

ufoposy#=200
ufospeed#=1

part_max=500; possible maximum of particles
part_speed#=2.0
part_emit_numb=5
part_colr=250
part_colg=250
part_colb=0
dispers=15
parameters=8
rotangle#=0   
xstart# = 400
ystart# = 560  


Dim sinus#(360)
Dim cosinus#(360)
For angle= 0 To 360
sinus#(angle) = Sin(angle)
cosinus#(angle) = Cos(angle)
Next   

Dim particles#(part_max,parameters)

Do
Gosub ufodraw
SpriteCollision ufosp,On
RenderToScreen
Cls 0

aimangle#=180+GetAngle2D(MouseX(),MouseY(),xstart#,ystart#)

If rotangle#<=180
   If aimangle#>rotangle# And aimangle#<rotangle#+180
 rotangle#=WrapAngle(rotangle#,1)
   Else
 rotangle#=WrapAngle(rotangle#,-1)
   EndIf
EndIf

If rotangle#>180
   If aimangle#<rotangle# And aimangle#>rotangle#-180
    rotangle#=WrapAngle(rotangle#,-1)
   Else
 rotangle#=WrapAngle(rotangle#,1)
   EndIf
EndIf

xstart# = xstart# + Cosinus#(rotangle#)*2.0
ystart# = ystart# + Sinus#(rotangle#)*2.0  


PositionSprite ufosp,ufoposx#,ufoposy#
DrawSprite ufosp
RotateSprite rocketsp,rotangle#+90
PositionSprite rocketsp,xstart#+cosinus#(rotangle#)*14,ystart#+sinus#(rotangle#)*14
DrawSprite rocketsp
DrawImage Mouse1,MouseX()-20,MouseY()-20,1
LockBuffer
For p = 1 To part_emit_numb
emit_particles(xstart#,ystart#,rotangle#)
Next
update_particles()
UnLockBuffer
If PointHitSprite(ufoposx#, ufoposy#, rocketsp)=True
   explosion()
   ufoposx#=0
   ufoposy#= RndRange(100,300)
   xstart#=400
   ystart#=560
   rotangle#=0
EndIf

DeleteImage ufo
DeleteSprite ufosp
ufospeed#=1

ef =ef+1
If ef =10 Then ef =1
ufoposx#= ufoposx# + ufospeed#
If ufoposx#> 800
   ufoposx# =0
EndIf
Print "FPS set to: "+Str$(framerate)
Print "FPS : "+Str$(FPS())
Sync
Loop


Function emit_particles(x1#,y1#,rot#)
   rot1#=WrapAngle(rot#,RndRange(-dispers,dispers))
   rot2#=WrapAngle(rot#,RndRange(-dispers,dispers))
   particles#(part_numb,1)=1
   particles#(part_numb,2)=x1#
   particles#(part_numb,3)=y1#
   particles#(part_numb,4)=-Cosinus#(rot1#)*part_speed#
   particles#(part_numb,5)=-Sinus#(rot2#)*part_speed#
   particles#(part_numb,6)=part_colr
   particles#(part_numb,7)=part_colg
   particles#(part_numb,8)=part_colb
   If part_numb=part_max
 part_numb=0
   Else
 part_numb=part_numb+1
EndIf

EndFunction   
   
   
Function update_particles()
For num = 0 To part_max
   
If particles#(num,1)=1
particles#(num,2)=particles#(num,2)+particles#(num,4)
particles#(num,3)=particles#(num,3)+particles#(num,5);+grav#
;grav#=0

If particles#(num,7)>0  
particles#(num,7)=particles#(num,7)-10
Else
particles#(num,6)=particles#(num,6)-10
EndIf
ran=RndRange(0,250)
If particles#(num,6)<=ran
   particles#(num,8)=ran-100
   particles#(num,7)=ran-100
   particles#(num,6)=ran-100
   r=RndRange(2,3)
;grav#=0.5
   EndIf

CircleC particles#(num,2),particles#(num,3),r,1,RGB(particles#(num,6),particles#(num,7),particles#(num,8))

r=2
EndIf
Next

EndFunction
   

Function explosion()

x1start#=xstart#+cosinus#(WrapAngle(rotangle#,-90))*20

For ex# = 1 To 360
ufoposx1#=ufoposx#
emit_particles(ufoposx1#,ufoposy#,ex#)
Next

EndFunction


rocketdraw:

rocket =GetFreeImage()
CreateImage rocket, 9,36
RenderToImage rocket
BoxC 0,18,9,29,1,RGB(0,0,200)
For rocside= 0 To 4
   LineC 4,0,rocside+2,10,RGB (150, 0,0)
   LineC rocside+2,11,rocside+2,31,RGB (80, 80+rocside*10,80+rocside*20)
   LineC 4,30,rocside+2,36,RGB (100, 50+rocside*20,50+rocside*20)
Next
LineC 4,18,4,29,RGB(0,0,100)

PrepareFXImage rocket
rocketsp=GetFreeSprite()
CreateSprite rocketsp
SpriteImage rocketsp,rocket
SpriteDrawMode rocketsp,2
CenterSpriteHandle rocketsp

Return   
   
mousedraw:
mouse1=GetFreeImage()
CreateImage mouse1, 40,40
RenderToImage mouse1

LineC 20,10,20,30,RGB(250,0,0)
LineC 10,20,30,20,RGB(250,0,0)
CircleC 20,20,4,1,RGB(0,0,0)
CircleC 20,20,8,0,RGB(250,0,0)

mouse2=GetFreeImage()
CreateImage mouse2, 40,40
RenderToImage mouse2

CircleC 20,20,2,1,RGB(200,200,200)

Return   
   
ufodraw:

ufo=GetFreeImage()
CreateImage ufo, 80,40

RenderToImage ufo

For x= 0 To 80
   LineC 40,0,x,20,RGB(10,40,10)
   
Next

For x1= 0 To 70 Step 10
   x=x1 + ef
   
   LineC 40,0,x,20,RGB(200,60,80)
   
Next
EllipseC 40,20,40,5,1,RGB(60,20,80)
EllipseC 40,20,30,3,1,RGB(150*ef/2,30,130)

ufosp=GetFreeSprite()
CreateSprite ufosp
SpriteImage ufosp,ufo
SpriteDrawMode ufosp,0
CenterSpriteHandle ufosp
Return
   
[/pbcode]


Title: rocket and ufo 2
Post by: Digital Awakening on December 30, 2005, 05:06:03 PM
Can't belive I played it for 5 min :) Nice effects!
Title: rocket and ufo 2
Post by: westray on December 31, 2005, 03:21:52 AM
Very good .The only problem is it only runs at 20 fps on my system.Its specs are

AMD 1700XP processor

1GB ddr memory

Nvidia 5900fx video card with 128MB memory.
Title: rocket and ufo 2
Post by: stef on December 31, 2005, 04:38:36 AM
Hi!

Thanks for response

Particles-calc in this demo are very CPU intensivly.
The effects here are of course a bit exaggerated.
It will be necessary or better to make the effects cpu dependetly (like detail reducing in games)

The simplest way to speed up the code above is to reduce the number of particles.
vary lines:

part_max=500
part_emit_numb=5

(but this will also influence the 'lifetime' of particles!!)  

Greetings
stef
Title: rocket and ufo 2
Post by: stef on January 01, 2006, 11:12:37 AM
Hi again!

Changed the code above!!

Supplemented 'lockbuffer' and 'unlockbuffer'
The code is much faster now!!! (unbelievable!)

If you really want to see the particles you must set fps to about 30 !
You can set

part_max=500  to 1000 or 5000!




Greetings
stef
Title: rocket and ufo 2
Post by: tomazmb on January 01, 2006, 01:00:03 PM
Hello,

The game runs at ~ 220 FPS. My specifications - see my signature. Very nice.

Have a nice day,

Tomaz
Title: rocket and ufo 2
Post by: thaaks on January 01, 2006, 04:23:03 PM
Hi,
ran fine with ~ 140 FPS on my Celeron 2.6Ghz with a ATI Radeon 9200 SE on Windows XP SP2.

Nice particle effect for the rocket (especially older particles getting gray) and cool rotation effect on the ufo.
The ufo explosion is a bit too much "square". I think a circular explosion would look better.
But don't bother, it's a good sample code.

Tommy
Title: rocket and ufo 2
Post by: stef on January 01, 2006, 05:22:16 PM
Hi!
QuoteThe ufo explosion is a bit too much "square".

Hm?! Very critical! But that's okay!
(I really hoped that nobody would noticed that! :) )

Here is the code with circular explosion
(Is still not perfect,explosion has no 'volume', would need more work/parameters)

[pbcode]


; PROJECT : rocket and ufo2
; AUTHOR  : stef
; CREATED : 12.11.2005
; EDITED  : 01.01.2006
; ---------------------------------------------------------------------
;aim with mouse
;ufo must be hit exactly in center

framerate =0  ;change this when too fast
SetFPS framerate
OpenScreen 800,600,16,2

Global part_numb,sinus#,cosinus#,x#,y#,part_colr,part_colg,part_colb,xstart#,ystart#
Global part_max,part_speed#,rot_angle#,dispers,grav#,ufoposx#,ufoposy#,ufospeed#

Gosub mousedraw
Gosub rocketdraw
SpriteCollision rocketsp,On

ufoposy#=200
ufospeed#=1

part_max=500; possible maximum of particles
part_speed#=2.0
part_emit_numb=5
part_colr=250
part_colg=250
part_colb=0
dispers=10
parameters=8
rotangle#=0   
xstart# = 400
ystart# = 560  


Dim sinus#(360)
Dim cosinus#(360)
For angle= 0 To 360
sinus#(angle) = Sin(angle)
cosinus#(angle) = Cos(angle)
Next   

Dim particles#(part_max,parameters)

Do
Gosub ufodraw
SpriteCollision ufosp,On
RenderToScreen
Cls 0

aimangle#=180+GetAngle2D(MouseX(),MouseY(),xstart#,ystart#)

If rotangle#<=180
   If aimangle#>rotangle# And aimangle#<rotangle#+180
 rotangle#=WrapAngle(rotangle#,1)
   Else
 rotangle#=WrapAngle(rotangle#,-1)
   EndIf
EndIf

If rotangle#>180
   If aimangle#<rotangle# And aimangle#>rotangle#-180
    rotangle#=WrapAngle(rotangle#,-1)
   Else
 rotangle#=WrapAngle(rotangle#,1)
   EndIf
EndIf

xstart# = xstart# + Cosinus#(rotangle#)*2.0
ystart# = ystart# + Sinus#(rotangle#)*2.0  


PositionSprite ufosp,ufoposx#,ufoposy#
DrawSprite ufosp
RotateSprite rocketsp,rotangle#+90
PositionSprite rocketsp,xstart#+cosinus#(rotangle#)*14,ystart#+sinus#(rotangle#)*14
DrawSprite rocketsp
DrawImage Mouse1,MouseX()-20,MouseY()-20,1

For p = 1 To part_emit_numb
emit_particles(xstart#,ystart#,rotangle#)
Next
LockBuffer
update_particles()
UnLockBuffer
If PointHitSprite(ufoposx#, ufoposy#, rocketsp)=True
   For count = 1 To 20
   explosion()
   Next
   ufoposx#=0
   ufoposy#= RndRange(100,300)
   xstart#=400
   ystart#=560
   rotangle#=0
   
EndIf

DeleteImage ufo
DeleteSprite ufosp
ufospeed#=1

ef =ef+1
If ef =10 Then ef =1
ufoposx#= ufoposx# + ufospeed#
If ufoposx#> 800
   ufoposx# =0
EndIf
Print "FPS set to: "+Str$(framerate)
Print "FPS : "+Str$(FPS())
Sync
Loop


Function emit_particles(x1#,y1#,rot#)
   rot1#=WrapAngle(rot#,RndRange(-dispers,dispers))
   particles#(part_numb,1)=1
   particles#(part_numb,2)=x1#
   particles#(part_numb,3)=y1#
   particles#(part_numb,4)=-Cosinus#(rot1#)*part_speed#
   particles#(part_numb,5)=-Sinus#(rot1#)*part_speed#
   particles#(part_numb,6)=part_colr
   particles#(part_numb,7)=part_colg
   particles#(part_numb,8)=part_colb
   If part_numb=part_max
 part_numb=0
   Else
 part_numb=part_numb+1
EndIf

EndFunction   
   
   
Function update_particles()
For num = 0 To part_max
   
If particles#(num,1)=1
particles#(num,2)=particles#(num,2)+particles#(num,4)
particles#(num,3)=particles#(num,3)+particles#(num,5);+grav#
;grav#=0

If particles#(num,7)>0  
particles#(num,7)=particles#(num,7)-10
Else
particles#(num,6)=particles#(num,6)-10
EndIf
ran=RndRange(0,250)
If particles#(num,6)<=ran
   particles#(num,8)=ran-100
   particles#(num,7)=ran-100
   particles#(num,6)=ran-100
   r=RndRange(2,3)
;grav#=0.5
   EndIf

CircleC particles#(num,2),particles#(num,3),r,1,RGB(particles#(num,6),particles#(num,7),particles#(num,8))

r=2
EndIf
Next

EndFunction
   

Function explosion()

x1start#=xstart#+cosinus#(WrapAngle(rotangle#,-90))*20

For ex# = 1 To 360
ufoposx1#=ufoposx#
dispersold = dispers

emit_particles(ufoposx1#,ufoposy#,ex#)

Next

EndFunction


rocketdraw:

rocket =GetFreeImage()
CreateImage rocket, 9,36
RenderToImage rocket
BoxC 0,18,9,29,1,RGB(0,0,200)
For rocside= 0 To 4
   LineC 4,0,rocside+2,10,RGB (150, 0,0)
   LineC rocside+2,11,rocside+2,31,RGB (80, 80+rocside*10,80+rocside*20)
   LineC 4,30,rocside+2,36,RGB (100, 50+rocside*20,50+rocside*20)
Next
LineC 4,18,4,29,RGB(0,0,100)

PrepareFXImage rocket
rocketsp=GetFreeSprite()
CreateSprite rocketsp
SpriteImage rocketsp,rocket
SpriteDrawMode rocketsp,2
CenterSpriteHandle rocketsp

Return   
   
mousedraw:
mouse1=GetFreeImage()
CreateImage mouse1, 40,40
RenderToImage mouse1

LineC 20,10,20,30,RGB(250,0,0)
LineC 10,20,30,20,RGB(250,0,0)
CircleC 20,20,4,1,RGB(0,0,0)
CircleC 20,20,8,0,RGB(250,0,0)

mouse2=GetFreeImage()
CreateImage mouse2, 40,40
RenderToImage mouse2

CircleC 20,20,2,1,RGB(200,200,200)

Return   
   
ufodraw:

ufo=GetFreeImage()
CreateImage ufo, 80,40

RenderToImage ufo

For x= 0 To 80
   LineC 40,0,x,20,RGB(10,40,10)
   
Next

For x1= 0 To 70 Step 10
   x=x1 + ef
   
   LineC 40,0,x,20,RGB(200,60,80)
   
Next
EllipseC 40,20,40,5,1,RGB(60,20,80)
EllipseC 40,20,30,3,1,RGB(150*ef/2,30,130)

ufosp=GetFreeSprite()
CreateSprite ufosp
SpriteImage ufosp,ufo
SpriteDrawMode ufosp,0
CenterSpriteHandle ufosp
Return
   
   
[/pbcode]


Title: rocket and ufo 2
Post by: kevin on January 01, 2006, 05:38:24 PM
jezz man, another excellent demo !
Title: rocket and ufo 2
Post by: 2dman on January 01, 2006, 10:37:05 PM
Could you PLEASE start also adding compiled versions of your demos? I'm at work alot and I can't install anything but I can run exe's still. ;) Thanks!
Title: rocket and ufo 2
Post by: medwayman on January 02, 2006, 04:57:31 AM
QuoteCan't belive I played it for 5 min
Same here! Thats good fun :D

Nice work

:)
Title: rocket and ufo 2
Post by: stef on January 02, 2006, 10:09:41 AM
Hi everybody!

This is final version of 'rocket and ufo 2'

Added 2  .exe files (in ru.zip), one with 500 the other with 5000 particles.
(It is same as the code below!!!!)

Thanks to all for replies. :)
Special thanks for critics  B)

Greetings
stef


[pbcode]
; PROJECT : rocket and ufo 2 final
; AUTHOR  : stef
; CREATED : 12.11.2005
; EDITED  : 02.01.2006
; ---------------------------------------------------------------------
;aim with mouse
;ufo must be hit exactly in center

framerate =0;change this when too fast
SetFPS framerate
OpenScreen 800,600,16,2

Global part_numb,sinus#,cosinus#,x#,y#,part_colr,part_colg,part_colb,xstart#,ystart#
Global part_max,part_speed#,rot_angle#,dispers,grav#,ufoposx#,ufoposy#,ufospeed#
Global r,ff,f1
Gosub mousedraw
Gosub rocketdraw
SpriteCollision rocketsp,On

ufoposy#=200
ufospeed#=1

part_max=500; possible maximum of particles
part_speed#=2.0
part_emit_numb=5
part_colr=250
part_colg=250
part_colb=0
dispers=6
parameters=8
rotangle#=0   
xstart# = 400
ystart# = 560  
ff=1
r=2

Dim sinus#(360)
Dim cosinus#(360)
For angle= 0 To 360
sinus#(angle) = Sin(angle)
cosinus#(angle) = Cos(angle)
Next   

Dim particles#(part_max,parameters)

Do
Gosub ufodraw
SpriteCollision ufosp,On
RenderToScreen
Cls 0

aimangle#=180+GetAngle2D(MouseX(),MouseY(),xstart#,ystart#)

If rotangle#<=180
   If aimangle#>rotangle# And aimangle#<rotangle#+180
 rotangle#=WrapAngle(rotangle#,1)
   Else
 rotangle#=WrapAngle(rotangle#,-1)
   EndIf
EndIf

If rotangle#>180
   If aimangle#<rotangle# And aimangle#>rotangle#-180
    rotangle#=WrapAngle(rotangle#,-1)
   Else
 rotangle#=WrapAngle(rotangle#,1)
   EndIf
EndIf

xstart# = xstart# + Cosinus#(rotangle#)*2.0
ystart# = ystart# + Sinus#(rotangle#)*2.0  


PositionSprite ufosp,ufoposx#,ufoposy#
DrawSprite ufosp

For p = 1 To part_emit_numb
emit_particles(xstart#,ystart#,rotangle#)
Next
LockBuffer
update_particles()
UnLockBuffer

RotateSprite rocketsp,rotangle#+90
PositionSprite rocketsp,xstart#+cosinus#(rotangle#)*18,ystart#+sinus#(rotangle#)*18
DrawSprite rocketsp
DrawImage Mouse1,MouseX()-20,MouseY()-20,1



If PointHitSprite(ufoposx#, ufoposy#, rocketsp)=True
   For count = 1 To 20
   explosion()
   Next
   ufoposx#=0
   ufoposy#= RndRange(100,300)
   xstart#=400
   ystart#=560
   rotangle#=0
   
EndIf

DeleteImage ufo
DeleteSprite ufosp
ufospeed#=1

ef =ef+1
If ef =10 Then ef =1
ufoposx#= ufoposx# + ufospeed#
If ufoposx#> 800
   ufoposx# =0
EndIf
Print "FPS set to: "+Str$(framerate)
Print "FPS : "+Str$(FPS())
Sync
Loop


Function emit_particles(x1#,y1#,rot#)
   rot1#=WrapAngle(rot#,RndRange(-dispers,dispers))
   
f1=RndRange(-ff,ff)
f2=RndRange(-ff,ff)
   particles#(part_numb,1)=1
   particles#(part_numb,2)=x1#+f1
   particles#(part_numb,3)=y1#+f2
   particles#(part_numb,4)=-Cosinus#(rot1#)*part_speed#;*f1
   particles#(part_numb,5)=-Sinus#(rot1#)*part_speed#;*f2
   particles#(part_numb,6)=part_colr
   particles#(part_numb,7)=part_colg
   particles#(part_numb,8)=part_colb
   If part_numb=part_max
 part_numb=0
   Else
 part_numb=part_numb+1
EndIf

EndFunction   
   
   
Function update_particles()
For num = 0 To part_max
   
If particles#(num,1)=1
particles#(num,2)=particles#(num,2)+particles#(num,4)
particles#(num,3)=particles#(num,3)+particles#(num,5);+grav#
;grav#=0

If particles#(num,7)>0  
particles#(num,7)=particles#(num,7)-10
Else
particles#(num,6)=particles#(num,6)-10
EndIf
ran=RndRange(0,250)
If particles#(num,6)<=ran
   particles#(num,8)=ran-100
   particles#(num,7)=ran-100
   particles#(num,6)=ran-100
   r=RndRange(2,4)
;grav#=0.5
EndIf

CircleC particles#(num,2),particles#(num,3),r,1,RGB(particles#(num,6),particles#(num,7),particles#(num,8))

r=2
EndIf
Next

EndFunction
   

Function explosion()

x1start#=xstart#+cosinus#(WrapAngle(rotangle#,-90))*20
ff=16
For ex# = 1 To 360
   
ufoposx1#=ufoposx#
emit_particles(ufoposx1#,ufoposy#,ex#)

Next
ff=1
f1=1

EndFunction


rocketdraw:

rocket =GetFreeImage()
CreateImage rocket, 9,36
RenderToImage rocket
BoxC 0,18,9,29,1,RGB(0,0,200)
For rocside= 0 To 4
   LineC 4,0,rocside+2,10,RGB (150, 0,0)
   LineC rocside+2,11,rocside+2,31,RGB (80, 80+rocside*10,80+rocside*20)
   LineC 4,30,rocside+2,36,RGB (100, 50+rocside*20,50+rocside*20)
Next
LineC 4,18,4,29,RGB(0,0,100)

PrepareFXImage rocket
rocketsp=GetFreeSprite()
CreateSprite rocketsp
SpriteImage rocketsp,rocket
SpriteDrawMode rocketsp,2
CenterSpriteHandle rocketsp

Return   
   
mousedraw:
mouse1=GetFreeImage()
CreateImage mouse1, 40,40
RenderToImage mouse1

LineC 20,10,20,30,RGB(250,0,0)
LineC 10,20,30,20,RGB(250,0,0)
CircleC 20,20,4,1,RGB(0,0,0)
CircleC 20,20,8,0,RGB(250,0,0)

mouse2=GetFreeImage()
CreateImage mouse2, 40,40
RenderToImage mouse2

CircleC 20,20,2,1,RGB(200,200,200)

Return   
   
ufodraw:

ufo=GetFreeImage()
CreateImage ufo, 80,40

RenderToImage ufo

For x= 0 To 80
   LineC 40,0,x,20,RGB(10,40,10)
   
Next

For x1= 0 To 70 Step 10
   x=x1 + ef
   
   LineC 40,0,x,20,RGB(200,60,80)
   
Next
EllipseC 40,20,40,5,1,RGB(60,20,80)
EllipseC 40,20,30,3,1,RGB(150*ef/2,30,130)

ufosp=GetFreeSprite()
CreateSprite ufosp
SpriteImage ufosp,ufo
SpriteDrawMode ufosp,0
CenterSpriteHandle ufosp
Return
   
[/pbcode]
Title: rocket and ufo 2
Post by: 2dman on January 02, 2006, 10:31:34 PM
Interesting to say the least. Ran very fast, well as it should with very little rendering going on and no apparent alpha, blending, etc happening. The 5000 version slows down to around 30fps on my machine, but that is still VERY good simply because of the number of particles moving around.

I'd like to see a better implementation of this that reflects a real game scenario with time based movement so you don't have to worry about setting the fps, alpha blending,etc so the particles look better, etc.

Very compact and cool, but it left me wanting more! :)