Author Topic: Parallax Starfield - a different way . . . (Read 11504 times)

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.

Code: [Select]

' 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

Shockwave · « **Reply #1 on:** April 08, 2009 »

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.

DrewPee · « **Reply #2 on:** April 10, 2009 »

@Shockwave, yeah after looking at it again - i tend to agree . . . so a slight change in code . . .

Code: [Select]

' 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?

Shockwave · « **Reply #3 on:** April 11, 2009 »

Good feeling of depth there but a bit flickery

DrewPee · « **Reply #4 on:** April 11, 2009 »

I thought that added to the effect

I will keep working on it . . . thanks Shockwave!

Shockwave · « **Reply #5 on:** April 12, 2009 »

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.

DrewPee · « **Reply #6 on:** April 12, 2009 »

Yeah - I think I will need help mate, I sort of know the theory behind it but . . .

Andy

Shockwave · « **Reply #7 on:** April 13, 2009 »

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.

Shockwave · « **Reply #8 on:** April 13, 2009 »

In fact if you can produce a 3d starfield in <20 lines including screen setup there's +5 karma for you.

DrewPee · « **Reply #9 on:** April 13, 2009 »

Nice one Shockwave, I will have a play and accomplish this now!

Drew

Shockwave · « **Reply #10 on:** April 13, 2009 »

You'll need to do a little bit of obfurscation to free up more lines for your code, for example;

Code: [Select]

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:

Code: [Select]

DIM SHARED  BUFFER ( XRES * YRES ) AS UINTEGER , ZPOS(1000) AS DOUBLE, YPOS(1000) AS DOUBLE, ZPOS(1000) AS DOUBLE

Etc

Clyde · « **Reply #11 on:** April 13, 2009 »

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.

Shockwave · « **Reply #12 on:** April 13, 2009 »

Same goes for you Clyde, if you can get stars into <20 lines, +5 Karma for you

DrewPee · « **Reply #13 on:** April 13, 2009 »

erm - im being really dim here - i have got to this point . . .

Code: [Select]

#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

DrewPee · « **Reply #14 on:** April 13, 2009 »

I am really struggling - can i have any hints on this?

Shockwave · « **Reply #15 on:** April 13, 2009 »

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!

Code: [Select]

#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

DrewPee · « **Reply #16 on:** April 13, 2009 »

Thanks mate!

Now that you have explained it, I see what was wrong now. I will have a look see at the colours now!

Shockwave · « **Reply #17 on:** April 13, 2009 »

I've managed to get it all down to 3 lines (including the colours) so it can be done.

Clyde · « **Reply #18 on:** April 14, 2009 »

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.

Shockwave · « **Reply #19 on:** April 14, 2009 »

Karma is for 3D stars mate not a parallax one