Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: neriakX on November 02, 2011
-
This keeps frustrating me since yesterday evening. Regardless what I'm changing .. I can't get it to work like those effect in the video.
I'm so lost, thought it'd be easy .. but I failed. Well, then again I'm a noob ... :(
I think what's missing is some kind of pixel lifetime (TimeToLive). I've seen OOP examples of it, but again, it's a bit hard to understand and port it to FreeBasic using tinyptc.
Here is the video of the effect I wanna try: http://www.youtube.com/watch?v=qdpxanCY04M at 5:15 minutes
' Particle FX test
'
'
'-------------------------------------------------------------------------------
option Static
option Explicit
'-------------------------------------------------------------------------------
Const XRES = 800
Const YRES = 600
Const HALFXRES = XRES / 2
Const HALFYRES = YRES / 2
Const MYFPS = 60 'PPS
'-------------------------------------------------------------------------------
#Define Ptc_win
#Include "tinyptc_ext.bi"
'-------------------------------------------------------------------------------
' OPEN THE SCREEN;
'-------------------------------------------------------------------------------
'PTC_ALLOWCLOSE(0)
'PTC_SETDIALOG(1,"Particles"+CHR$(13)+"FULL SCREEN?",0,1)
if (ptc_open("Particles", XRES, YRES) = 0) then end -1
'-------------------------------------------------------------------------------
' VARIABLES DEFINITION
'-------------------------------------------------------------------------------
dim shared ScreenBuffer(XRES*YRES) As UInteger
dim Shared as integer x, y
Dim Shared As Integer LP,w
Dim Shared As Integer Particles
Particles = 5000
DIM SHARED speedx (1 TO Particles) AS DOUBLE
DIM SHARED speedy (1 TO Particles) AS Double
Dim SHARED ptx (1 TO Particles) AS DOUBLE
DIM SHARED pty (1 TO Particles) AS Double
'Timei is TIMER var
Dim Shared Timei As Double
'-------------------------------------------------------------------------------
' SUBS DEFINITION
'-------------------------------------------------------------------------------
Declare Sub PutPixels( Buffer() as integer, ByVal x As Integer,_
ByVal y As Integer, ByVal col As Integer)
Declare Sub InitParticles()
Declare Sub Explode()
Declare Sub SyncScr()
Declare Sub MILLISECS()
'-------------------------------------------------------------------------------
' MAIN LOOP
'-------------------------------------------------------------------------------
DIM SHARED AS DOUBLE M ,oldtime,newtime
dim shared tst as string
dim shared ticks,t as integer
ticks=0
oldtime=Timer
While(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
Timei = Timer()
InitParticles()
Erase ScreenBuffer
Explode()
MILLISECS()
ScreenLock()
Ptc_Update @ScreenBuffer(0)
ScreenUnLock()
ticks=ticks+1
'SyncScr()
Wend
ptc_close
end 0
Sub InitParticles()
For LP = 1 To Particles
w = Rnd(0)*359
speedx(LP) = (cos(w) * Rnd((1)*2))
speedy(LP) = (-Sin(w) * Rnd((1)*2))
ptx(LP) = HALFXRES + speedx(LP)
pty(LP) = HALFYRES + speedy(LP)
Next
End Sub
Sub PutPixel( Buffer() as integer, ByVal x As Integer, ByVal y As Integer, ByVal col As Integer)
If X>0 And X<XRES-1 And Y>0 And Y<YRES-1 Then
Buffer(Y * XRES + X) = col
End If
End Sub
Sub Explode()
For LP = 1 To Particles
PutPixel(ScreenBuffer(), (ptx(LP) + HALFXRES) * speedx(LP), (pty(LP) + HALFYRES ) * speedy(LP), RGB(255,255,255))
Next
End Sub
' ---------------------------------------------------------
' FPS counter taken from Shockwave's code
' --------------------------------------------------------
SUB Millisecs()
t=timer
if t-oldtime >=1 then
newtime = ticks
ticks=0
oldtime=timer
TST = str( (newtime) )
TST = "FPS "+TST
print tst
end if
end Sub
Sub SyncScr()
Dim As Double SecondsPerFrame
'How long each frame should take to be rendered
SecondsPerFrame = 1 / MYFPS
Print "FPS"
Do: Sleep 1: Loop While Timer - Timei <= SecondsPerFrame
End Sub
Edit: typos and small code change
-
There's some good stuff in here neriakX, don't be so hard on yourself.
You want to have an expanding doughnut shape like the video? That should be straight forward.. I'm just going to have some food and then I'll knock something up for you to see which will be simpler (especially the screen refresh stuff).
If you check back in a couple of hours it will be done.
-
Here you go.
There's a lot in here, anything you don't understand just ask :)
' ZOOMING DOUGHNUT EXAMPLE BY SHOCKWAVE FOR NERIAKX
' WWW.DBFINTERACTIVE.COM
'-------------------------------------------------------------------------------
#INCLUDE "TINYPTC_EXT.BI"
#INCLUDE "WINDOWS.BI"
OPTION STATIC
OPTION EXPLICIT
CONST XRES = 800 ' SCREEN WIDTH
CONST YRES = 600 ' SCREEN HEIGHT
CONST PIXELS = 1000 ' HOW MANY DOTS TO HAVE
DIM SHARED RAD2DEG AS DOUBLE ' CALCS ARE IN RADIANS BY DEFAULT, THIS IS TO CONVERT TO DEGREES.
RAD2DEG=(4*ATN(1))/180 ' TRANSLATED, THIS = 3.14 / 180.
' MULTIPLY A RADIAN BY THAT AMOUNT TO CONVERT IT TO A DEGREE.
DIM SHARED AS INTEGER XOFF,YOFF ' TO HOLD X + Y SCREEN OFFSET
DIM SHARED AS DOUBLE ZOOM ' MASTER ZOOM
DIM SHARED AS DOUBLE SP(PIXELS) ' ROTATION SPEED
DIM SHARED AS DOUBLE AN(PIXELS) ' ANGLE OF PIXEL
DIM SHARED AS DOUBLE RD(PIXELS) ' RADIUS OF PIXEL
DIM SHARED AS UINTEGER BUFFER(800*600) ' SCREEN BUFFER
DECLARE SUB PLOTPIXEL( BYVAL X AS INTEGER, BYVAL Y AS INTEGER, BYVAL COLOUR AS UINTEGER )
DECLARE SUB DOUGHNUT()
DECLARE SUB SETSPEEDS()
'-------------------------------------------------------------------------------
' OPEN SCREEN AND ALLOW 50 MS FOR THE SCREEN TO OPEN.
'-------------------------------------------------------------------------------
PTC_ALLOWCLOSE(0)
PTC_SETDIALOG(1,"Expanding Doughnut"+CHR$(13)+"FULL SCREEN?",0,1)
IF (PTC_OPEN("www.dbfinteractive.com",XRES,YRES)=0) THEN
END-1
END IF
SLEEP 50
'-------------------------------------------------------------------------------
' THESE THREE VARIABLES ARE DOUBLES, HIGH PRECISION NUMBERS FOR DELTA TIMING
'-------------------------------------------------------------------------------
DIM SHARED AS DOUBLE OLD,DV,GADD
' Instantiate variables (good programming practice)
OLD = TIMER
DV = 0
GADD = 0
ZOOM = 150
XOFF= 400
YOFF = 300
SETSPEEDS()' SET THE INITIAL SPEED, RADIUS AND ANGLE OF EACH DOT
'-------------------------------------------------------------------------------
' MAIN LOOP (UNTIL ESC OR MOUSE)
'-------------------------------------------------------------------------------
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE and PTC_GETRIGHTBUTTON=FALSE)
OLD=TIMER ' Store Time.
ZOOM=200+140*SIN(GADD*RAD2DEG)' Zoom the doughnut
DOUGHNUT() ' Draw the doughnut
PTC_UPDATE@BUFFER(0)' Update screen.
ERASE BUFFER' Clear the logical screen.
SLEEP 1' Pause for 1 Millisecond.
DV=TIMER-OLD' Get time elapsed since start of loop DV is the delta time.
DV=DV*100' Turn it into something useful
GADD=GADD+DV' Used in Zoom as this needs adding to all the time.
WEND
'-------------------------------------------------------------------------------
' END THE PROGRAM
'-------------------------------------------------------------------------------
PTC_CLOSE()
EXITPROCESS(0)
SUB SETSPEEDS()
'-------------------------------------------------------------------------------
' SET UP THE DOTS
'-------------------------------------------------------------------------------
DIM LP AS INTEGER
FOR LP=0 TO PIXELS-1
SP(LP)=-1+(RND(1)*2)' Random Speed -5 to +5
AN(LP)=(RND(1)*359) ' Angle 0 - 359 Degrees
RD(LP)=(RND(1)*50) ' Radius 0 - 10
NEXT
END SUB
SUB DOUGHNUT()
'-------------------------------------------------------------------------------
' DRAW THE DOTS
'-------------------------------------------------------------------------------
DIM AS INTEGER LP,TX,TY
FOR LP=0 TO PIXELS-1
AN(LP)=AN(LP)+(SP(LP)*DV) ' ROTATE THE DOT BY IT'S SPEED IN DEGREES
TX = ((ZOOM+RD(LP))*COS(AN(LP)*RAD2DEG))+XOFF ' TURN THE DOT INTO A SCREEN CO-ORDINATE
TY = ((ZOOM+RD(LP))*SIN(AN(LP)*RAD2DEG))+YOFF '
PLOTPIXEL(TX,TY,RGB(255,255,255)) ' PLOT IT
NEXT
END SUB
SUB PLOTPIXEL( BYVAL X AS INTEGER, BYVAL Y AS INTEGER, BYVAL COLOUR AS UINTEGER )
'*******************************************************************************
'* Plot a dot at X,Y *
'*******************************************************************************
IF Y>0 AND Y< YRES THEN
IF X>0 AND X<XRES THEN
BUFFER(X+(Y*XRES))=COLOUR
END IF
END IF
END SUB
-
Awesome mate. That was extremely fast. Guess that should be of some help for neriakX.
Runs smooth here and it is actually a quite nice fx.
-
Here you go.
There's a lot in here, anything you don't understand just ask :)
OMG! This looks great! Thank you so much for your help and efforts. Amazing. Also the source is very, very well commented! That would be worth karma + some cold beer! :cheers:
It seems I can understand each part. I never had come up with that stuff on my own, that's for sure :)
Thank you again, I really appreciated it.
-
Awesome mate. That was extremely fast. Guess that should be of some help for neriakX.
Runs smooth here and it is actually a quite nice fx.
You're right benny. That was mega-fast and very helpful for me. I'm still astonished by it, hehe.
-
Glad to help!
In all fairness to you, you've used a lot of concepts there that are hard for new programmers to grasp, especially arrays and plotting pixels into a linear (1 dimensional) screen buffer! My first efforts were nowhere near as good as yours.
-
In all fairness to you, you've used a lot of concepts there that are hard for new programmers to grasp, especially arrays and plotting pixels into a linear (1 dimensional) screen buffer! My first efforts were nowhere near as good as yours.
I think I've learned alot of your example codes in the forums. But it's not enough to come up with something bigger yet. I'd feel like a thief If I had taken some code here and there to make a complete demo out of it. Thanks for your kind words. Highly appreciated :)
-
Nice one Shockie! :clap:
-
Hi! Neriakx - I've looked at your code and found some mistakes. I assume that you've figured it out by now, as this thread is a little old. But maybe others will have some benefit from this debug.
1. Initialise the particles _before_ the main loop, not INSIDE!
2. This is quite wrong:
PutPixel(ScreenBuffer(), (ptx(LP) + HALFXRES) * speedx(LP), (pty(LP) + HALFYRES ) * speedy(LP), RGB(255,255,255)),
so I've changed that too.
' Particle FX test
'
'
'-------------------------------------------------------------------------------
option Static
option Explicit
'-------------------------------------------------------------------------------
Const XRES = 800
Const YRES = 600
Const HALFXRES = XRES / 2
Const HALFYRES = YRES / 2
Const MYFPS = 60 'PPS
'-------------------------------------------------------------------------------
#Define Ptc_win
#Include "tinyptc_ext.bi"
'-------------------------------------------------------------------------------
' OPEN THE SCREEN;
'-------------------------------------------------------------------------------
'PTC_ALLOWCLOSE(0)
PTC_SETDIALOG(1,"Particles"+CHR$(13)+"FULL SCREEN?",0,1)
if (ptc_open("Particles", XRES, YRES) = 0) then end -1
'-------------------------------------------------------------------------------
' VARIABLES DEFINITION
'-------------------------------------------------------------------------------
dim shared ScreenBuffer(XRES*YRES) As UInteger
dim Shared as integer x, y
Dim Shared As Integer LP
Dim Shared As Integer Particles
Particles = 5000
DIM SHARED speedx (1 TO Particles) AS DOUBLE
DIM SHARED speedy (1 TO Particles) AS Double
Dim SHARED ptx (1 TO Particles) AS DOUBLE
DIM SHARED pty (1 TO Particles) AS Double
'Timei is TIMER var
Dim Shared Timei As Double
'-------------------------------------------------------------------------------
' SUBS DEFINITION
'-------------------------------------------------------------------------------
Declare Sub PutPixels( Buffer() as integer, ByVal x As Integer,_
ByVal y As Integer, ByVal col As Integer)
Declare Sub InitParticles()
Declare Sub Explode()
Declare Sub SyncScr()
Declare Sub MILLISECS()
'-------------------------------------------------------------------------------
' MAIN LOOP
'-------------------------------------------------------------------------------
DIM SHARED AS DOUBLE M ,oldtime,newtime
dim shared tst as string
dim shared as Integer ticks,t
ticks=0
oldtime=Timer
InitParticles() ' Init sys BEFORE mainloop !
While(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
Timei = Timer()
Explode()
MILLISECS()
ScreenLock()
Ptc_Update @ScreenBuffer(0)
ScreenUnLock()
Erase ScreenBuffer
ticks=ticks+1
'SyncScr()
Wend
ptc_close
end 0
Sub InitParticles()
Dim As Double spd, w
For LP = 1 To Particles
w = Rnd(1)*359
spd = 1 + Rnd(1)
speedx(LP) = (cos(w) * spd)
speedy(LP) = (-Sin(w) * spd)
ptx(LP) = HALFXRES
pty(LP) = HALFYRES
Next
End Sub
Sub PutPixel( Buffer() as integer, ByVal x As Integer, ByVal y As Integer, ByVal col As UInteger)
If X>0 And X<XRES-1 And Y>0 And Y<YRES-1 Then
Buffer(Y * XRES + X) = col
End If
End Sub
Sub Explode()
For LP = 1 To Particles
ptx(LP) += speedx(LP) 'remember to update particle states!
pty(LP) += speedy(LP)
PutPixel(ScreenBuffer(), ptx(LP), pty(LP), RGB(255,255,255))
Next
End Sub
' ---------------------------------------------------------
' FPS counter taken from Shockwave's code
' --------------------------------------------------------
SUB Millisecs()
t=timer
if t-oldtime >=1 then
newtime = ticks
ticks=0
oldtime=timer
TST = str( (newtime) )
TST = "FPS "+TST
print tst
end if
end Sub
Sub SyncScr()
Dim As Double SecondsPerFrame
'How long each frame should take to be rendered
SecondsPerFrame = 1 / MYFPS
Print "FPS"
Do: Sleep 1: Loop While Timer - Timei <= SecondsPerFrame
End Sub
I haven't cleaned anything up (unused vars etc.) in your code.
Kris.
-
O yes Shockwave sure makes it look easy and cool at the same time.
Nice one. :clap:
-
Nice example Kris, K+