Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: DrewPee on April 07, 2009
-
Hello guys,
Not posted for a while due to the fact that I lost nearly all of my original code that I have been writing for the last few years . . . serves me right really for not backing it up . . . I have been messing about with my starfield for ages but recently came up with this . . . and thought I would share.
' Starfield v3 by Andy of RCM - 07/04/09
' Dedicated to my family and friends
#include once "tinyptc_ext.bi"
#include once "crt.bi"
#include once "windows.bi"
const xres = 800
const yres = 600
Dim shared as integer sf
sf=512
Dim shared as double x(sf),y(sf),s(sf)
dim shared as double r,g,b
Dim shared as integer a
Dim shared as String key
Dim shared as integer bib
Dim shared as integer q
Declare Sub DLine(ypos,r as double,g as double,b as double,wid)
Declare Sub Stars
for a=0 to sf-1
x(a)=(int(rnd(1)*xres)-1)
y(a)=1+(int(rnd(1)*yres)-1)
s(a)=1+(int(rnd(1)*8))
next
r=255:g=255:b=255
ptc_allowclose(0)
ptc_setdialog(1,"Would you like to go Fullscreen?",0,1)
If( ptc_open( "Starfield - Again!", XRES, YRES ) = 0 ) Then
End -1
End If
Dim Shared as Integer sb(xres*yres)
#define pp(x,y,argb) sb(y*XRES+x)=argb
Dim Shared As LARGE_INTEGER Frequency
Dim Shared As LARGE_INTEGER LiStart
Dim Shared As LARGE_INTEGER LiStop
Dim Shared As LONGLONG LlTimeDiff
Dim Shared As Double MDuration
QueryPerformanceFrequency( @Frequency )
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
QueryPerformanceCounter( @LiStart )
key = inkey$()
Stars
DLine(0,255,128,16,24)
DLine(yres-25,255,128,16,24)
DLine(24,255,255,255,2)
DLine(yres-25,255,255,255,2)
ptc_update @sb(0)
erase sb
do
QueryPerformanceCounter( @LiStop )
LlTimeDiff = LiStop.QuadPart - LiStart.QuadPart
MDuration = Cast( Double, LlTimeDiff ) * 1000.0 / Cast( Double , Frequency.QuadPart )
Loop While ( MDuration <= 1000.0/60.0 )'60fps Clamp change the 60.0 to whatever fps you need
Wend
ptc_close()
end
Sub Stars
for a=0 to sf-1
x(a)=x(a)-s(a)
bib=int(rnd(1)*8)
if bib=3 and y(a)>1 then y(a)=y(a)-1:r=int(rnd(1)*255):g=r:b=g
if bib=6 and y(a)<yres-1 then y(a)=y(a)+1:r=int(rnd(1)*255):g=r:b=g
if y(a)<1 then y(a)=yres-1
if y(a)>yres-1 then y(a)=1
if x(a)<0 then x(a)=(xres-1):y(a)=1+(int(rnd(1)*yres)-1)
if y(a)<0 then x(a)=1
if y(a)>yres then x(a)=yres-1
pp(x(a),y(a),rgb(r,g,b))
next a
End Sub
Sub DLine(ypos,r as double,g as double,b as double,wid)
for a=0 to xres-1
for q=ypos to ypos+wid
pp(a,q,rgb(r,g,b))
next q
if r>32 then r=r-.2
if g>8 then g=g-.2
if b>4 then b=b-.2
next a
End Sub
Basically it allows for a parallax starfield effect in one routine . . . obviously been done before - just thought I would share my version with you guys?
DrewPee
-
It's really nice that you are coding again Andy :)
I like your delta timing routine too.
Good stuff, keep it up.
I think that the random up and down movements would look really effective as snow if the stars were vertical and a little slower moving. As they are now I imagine distant meteorites.
-
@Shockwave, yeah after looking at it again - i tend to agree . . . so a slight change in code . . .
' Starfield v4 by Andy of RCM - 09/04/09
' Dedicated to my family and friends
#include once "tinyptc_ext.bi"
#include once "crt.bi"
#include once "windows.bi"
const xres = 800
const yres = 600
Dim shared as integer sf
sf=1024
Dim shared as double x(sf),y(sf),s(sf)
dim shared as double r,g,b
Dim shared as integer a
Dim shared as String key
Dim shared as integer bib
Dim shared as integer q
Declare Sub Stars
for a=0 to sf-1
x(a)=(int(rnd(1)*xres)-1)
y(a)=1+(int(rnd(1)*yres)-1)
s(a)=1+(int(rnd(1)*8))
next
r=255:g=255:b=255:bib=255
ptc_allowclose(0)
ptc_setdialog(1,"Would you like to go Fullscreen?",0,1)
If( ptc_open( "Starfield - Again!", XRES, YRES ) = 0 ) Then
End -1
End If
Dim Shared as Integer sb(xres*yres)
#define pp(x,y,argb) sb(y*XRES+x)=argb
Dim Shared As LARGE_INTEGER Frequency
Dim Shared As LARGE_INTEGER LiStart
Dim Shared As LARGE_INTEGER LiStop
Dim Shared As LONGLONG LlTimeDiff
Dim Shared As Double MDuration
QueryPerformanceFrequency( @Frequency )
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
QueryPerformanceCounter( @LiStart )
key = inkey$()
Stars
ptc_update @sb(0)
erase sb
do
QueryPerformanceCounter( @LiStop )
LlTimeDiff = LiStop.QuadPart - LiStart.QuadPart
MDuration = Cast( Double, LlTimeDiff ) * 1000.0 / Cast( Double , Frequency.QuadPart )
Loop While ( MDuration <= 1000.0/60.0 )'60fps Clamp change the 60.0 to whatever fps you need
Wend
ptc_close()
end
Sub Stars
for a=0 to sf-1
x(a)=x(a)-s(a)
if x(a)<0 then x(a)=(xres-9):y(a)=1+(int(rnd(1)*yres)-1):s(a)=1+(int(rnd(1)*8))
for q=1 to int(rnd(1)*4)
pp(x(a)+q,y(a),rgb(s(a)*32,s(a)*32,s(a)*32))
next q
next a
End Sub
I think they look more like stars now! Any comments?
-
Good feeling of depth there but a bit flickery :)
-
I thought that added to the effect ;)
I will keep working on it . . . thanks Shockwave!
-
Make them proper 3D mate, then you will be making progress I think you did this kind of thing before.
Post if you need help if you decide to give them some 3d ness.
-
Yeah - I think I will need help mate, I sort of know the theory behind it but . . .
Andy
-
There's not a lot of difference in truth.
You can still use arrays to store the star positions, use floating point for more accuracy, if you are using 640 * 480 screen mode, create your stars in a box roughly 10000 (-5000 to +5000) wide * 10000 tall * 30 deep (3 arrays x,y,z), change the z co-ords of the stars subtracting a small amount (say 0.01 from them each frame), divide x by z and y by z to get the screen position, add 320 to x and 240 to y to center them, convert to integers and just draw them.
See how you get on with that and post your progress and we can go from there, you're easily capable of writing this.
-
In fact if you can produce a 3d starfield in <20 lines including screen setup there's +5 karma for you.
-
Nice one Shockwave, I will have a play and accomplish this now! ;)
Drew
-
You'll need to do a little bit of obfurscation to free up more lines for your code, for example;
DIM SHARED BUFFER ( XRES * YRES ) AS UINTEGER
DIM SHARED ZPOS(1000) AS DOUBLE
DIM SHARED YPOS(1000) AS DOUBLE
DIM SHARED ZPOS(1000) AS DOUBLE
Could become:
DIM SHARED BUFFER ( XRES * YRES ) AS UINTEGER , ZPOS(1000) AS DOUBLE, YPOS(1000) AS DOUBLE, ZPOS(1000) AS DOUBLE
Etc ;)
-
Nice effect Drew Pee and welldone, all I'd add is make your dots into a star shape using the brightest colour as the center, and then as you subtract and add pixels to form your star lower the colour range a bit.
With what Shockie has posted, basically you are transforming the X and Y by the Z, to give the impression of 3D. but you probably allready knew that.
Here's to your stars,
Clyde.
-
Same goes for you Clyde, if you can get stars into <20 lines, +5 Karma for you ;)
-
erm - im being really dim here - i have got to this point . . .
#include once "tinyptc_ext.bi"
const xres = 640 : const yres = 480:Dim shared as integer sf,r,g,b,a:sf=512
Dim shared as double x(10000),y(10000),z(1000),x1(10000),y1(10000):Dim shared as String key:Declare Sub Stars:Dim Shared as Integer sb(xres*yres)
for a=0 to sf-1:x(a)=(int(rnd(1)*5000)-1):y(a)=1+(int(rnd(1)*5000)-1):z(a)=1+(int(rnd(1)*1000)):next
r=255:g=255:b=255:ptc_allowclose(0):ptc_setdialog(1,"Would you like to go Fullscreen?",0,1)
If( ptc_open( "Starfield - Again!", XRES, YRES ) = 0 ) Then
End -1
End If
#define pp(x,y,argb) sb(y*XRES+x)=argb
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
key = inkey$():Stars:ptc_update @sb(0):erase sb
Wend
ptc_close():end
Sub Stars:for a=0 to sf-1: z(a)=z(a)+0.1
x1(a)=(x(a)/z(a)):y1(a)=(y(a)/z(a))
if x(a)<=0 then x(a)=(xres-1):y(a)=1+(int(rnd(1)*yres)-1)
pp(x1(a)+320,y1(a)+240,rgb(r,g,b)):next a:End Sub
I am missing something . . . please bear with me?
Drew
-
I am really struggling - can i have any hints on this?
:)
-
Hi mate, several small problems here.
Here's what I found.
string definition is not needed as you are cheking to see if escape is checked in main loop
Why define 10000 if you have 512 stars?
also z seems to be 1000 not 10000
x1+y1 are not needed as arrays, they only really need to be capable of taking one pair of transformed points.
"Dim shared as double x(10000),y(10000),z(1000),x1(10000),y1(10000)"
The following is a little skewed;
x(a)=(int(rnd(1)*5000)-1):y(a)=1+(int(rnd(1)*5000)-1):z(a)=1+(int(rnd(1)*1000))
To generate between -5000 and + 5000 you should do;
x(a)=(rnd(1)*10000)-5000
No need to convert to integer here either.
Here's the worst error;
z(a)=1+(int(rnd(1)*1000))
remember you divide x and y by z.
so 10000 / 1000 ? !!
10000 / 30 is a better range for z as the screen co-ords are potentially more likely to be within the screen boundary instead of having strange perspective which is why yours looked a bit odd.
This is wrong;
#define pp(x,y,argb) sb(y*XRES+x)=argb
Should be more like;
#define pp(x,y,argb) sb((y*XRES)+x)=argb
But why bother with a define? you can write straight into the buffer and save a line anyway ;)
I debugged it, the code is here, to earn your karma make the colours get brighter as they come towards you :) You have 8 lines to play with. This can be done in <10 ;)
Good effort so far though mate, keep cracking on!
#include once "tinyptc_ext.bi"
const xres = 640 : const yres = 480:Dim shared as integer sf,a,x1,y1:sf=512
Dim shared as double x(sf),y(sf),z(sf):Declare Sub Stars:Dim Shared as Integer sb(xres*yres)
for a=0 to sf-1:x(a)=((rnd(1)*10000)-5000):y(a)=((rnd(1)*10000)-5000):z(a)=((rnd(1)*30)):next
If( ptc_open( "Starfield - Again!", XRES, YRES ) = 0 ) Then End -1 else end if
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
Stars:ptc_update @sb(0):erase sb
Wend
ptc_close():end
Sub Stars:for a=0 to sf-1: z(a)=z(a)-0.1 :x1=320+(x(a)/z(a)):y1=240+(y(a)/z(a))
if x1>0 and x1<640 and y1>0 and y1<yres then sb(x1+(y1*xres))=&hffffff else z(a)=30 end if
next a:End Sub
-
Thanks mate! ;) Now that you have explained it, I see what was wrong now. I will have a look see at the colours now!
-
I've managed to get it all down to 3 lines (including the colours) so it can be done.
-
Thats a nice example of a 3D starfield and very nice compacting dude.
Im up for the challenge of the old grey matter test for a parallax starfield; havent dont one of them in yonks.
-
Karma is for 3D stars mate not a parallax one :)
-
I think I may have done it . . .
#include once "tinyptc_ext.bi"
const xres = 640 : const yres = 480:Dim shared as integer sf,a,x1,y1:sf=255
Dim shared as double x(sf),y(sf),z(sf),col:Declare Sub Stars:Dim Shared as Integer sb(xres*yres)
for a=0 to sf-1:x(a)=((rnd(1)*10000)-5000):y(a)=((rnd(1)*10000)-5000):z(a)=((rnd(1)*30)):next
ptc_allowclose(0):ptc_setdialog(1,"Fullscreen?",0,1)
If( ptc_open( "3D Starfield Test", XRES, YRES ) = 0 ) Then End -1:End If
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
Stars:ptc_update @sb(0):erase sb:Wend:ptc_close():end
Sub Stars:for a=0 to sf-1: z(a)=z(a)-0.1 :x1=320+(x(a)/z(a)):y1=240+(y(a)/z(a)):col=((-z(a))+30)*7
if int(col)>255 then col=255:col=int(col)
if x1>0 and x1<640 and y1>0 and y1<yres then sb(x1+(y1*xres))=rgb(col,col,col) else z(a)=30 end if
next a:End Sub
-
That looks great :)
+5 Karma to you. Definately more interesting than the 2D one.
-
Thanks Shockwave - couldnt really have done it without you! :'(
I now understand exactly how it all works which is cool!
I can now take it further by spinning the stars etc . . .
DrewPee
-
I have now started using a SINE wave to create movement of the stars . . . I can honestly say I am now very proud of this! ;)
-
That is very good indeed dude, welldone.
Sorry DrewPee for seeming to Hijack your topic, didnt mean for that to happen, this is a tad Off Topic:
@Shockwave: Do you remember way back when you used to use Windows / Microsoft Messenger ( now known as Windows Live Messenger) . After saying hello to me on the very first conversation, the second thing you said to me, was do I know anything about 3D Starfields in 2D, and it was one of the very first routines I ever learnt and from you. I remember it like it was only yesterday. But thinking back it's got to be at least 5 years ago, it was when Dark Bit Factory was concieved I cant remember the exact date.
Back To Topic. :)
Havent forgotten about the K*5 challenge offer, will knock something up soon. Mr DrewPee's on a roll with this now.
-
Drewpee, that's really nice that you are adding some more dynamic stuff to the starfield, you're close to getting it similar to the way that the bob starfield worked in the classic amiga demos like mental hangover and hysteresis, one observation though, you seem to have applied the movement to the points after you do the perspective transformation to them which means that they all move around at the same rate, realistically on a 3D starfield, the distant ones would move more slowly.
To achieve this you can do the same as you are doing now but apply the transformation to the points before you transform them and the result will be much more satisfying. It's already nice though so keep on improving it :)
@Shockwave: Do you remember way back when you used to use Windows / Microsoft Messenger ( now known as Windows Live Messenger) . After saying hello to me on the very first conversation, the second thing you said to me, was do I know anything about 3D Starfields in 2D, and it was one of the very first routines I ever learnt and from you. I remember it like it was only yesterday. But thinking back it's got to be at least 5 years ago, it was when Dark Bit Factory was concieved I cant remember the exact date.
It rings a vague bell with me to be honest Clyde but a lot of water has gone under the bridge since then mate. It's great that you remember that though and kind of scary too to think that 5 years have already gone by since then.