Parallax Starfield example.

[Clyde]

Here's a little something for those new & learning Freebasic & the tinyptc library.

Code: [Select]

'
' Paralax Starfield.
' By Clyde Radcliffe & Special thanks to Blitz Amateur for the Random Function.
' Made in Dec '06
'
Option Explicit
Option Static

'-------------------------------------
' Includes.
'-------------------------------------
#Include Once "tinyptc.bi"
#Include Once "crt.bi"

'-------------------------------------
' Constants.
'-------------------------------------
Const XRES=640
Const YRES=480

Const ARES=XRES*YRES

Const MAXSTARS=2000

'-------------------------------------
' Meet the Globals.
'-------------------------------------
Dim Shared ScreenBuffer( ARES )

Dim Shared StarX( MAXSTARS ), StarY( MAXSTARS ), StarC( MAXSTARS ), StarS( MAXSTARS )

'-------------------------------------
' Well I do Declare.
'-------------------------------------
Declare Sub FeedPixels          ( Byval X As Integer, ByVal Y As Integer, ByVal Col As Integer )
Declare Sub InitializeParallax  ()
Declare Sub RunParallax         ()
Declare Sub UpdateStars         ()

'-------------------------------------
' Setup Functions.
'-------------------------------------
Declare Function Randd          (ByVal lower as integer, ByVal upper as integer) As Integer

'-------------------------------------
' Running Order.
'-------------------------------------
InitializeParallax()
RunParallax()
Ptc_Close()


Sub FeedPixels( 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
        ScreenBuffer(Y * XRES + X) = col
    End If

End Sub


Sub InitializeParallax()
   
    '
    ' Initialize screen display area.
    '
    If( ptc_open( "Parallax Stars", XRES, YRES ) = 0 ) Then
End -1                                   
End if
   
   
    '
    ' Create start up stars.
    '
    Dim Setup
   
    For Setup=0 To MAXSTARS-1
       
        StarX( Setup )=Randd(-1,XRES-1)
        StarY( Setup )=Randd( 0,YRES-1)
        StarS( Setup )=Randd(1,6)
       
        StarC( Setup )=Randd(&H646464,&HFFFFFF)
     
    Next
   
End Sub


Sub RunParallax()
   
    Dim Key As String
   
    '
    ' Wot, nobodies pressed Escape yet.
    '
    While Key<>Chr(27)
       
        '
        ' chech on the stars.
        '
        UpdateStars()
       
        '
        ' Tell Mr Tiny to use ScreenBuffer as the drawing buffer location (0 - the start ) and display it's contents.
        '
        Ptc_Update @ScreenBuffer(0)
       
        '
        ' Empty Keyboard buffer.
        '
        Key=Inkey()
       
        '
        ' Clear the screen.
        '
        Erase ScreenBuffer
       
    Wend
 
End Sub


Sub UpdateStars()
   
    Dim Update
   
    For Update=0 To MAXSTARS-1
           
        '
        ' Update Scrolling Speed.
        '
        StarX( Update )=StarX( Update )+StarS( Update )
       
        '
        ' If at the X Screen boundary make new stars.
        '
        If StarX( Update )>XRES-1 Then
           
            StarX( Update )=-1
            StarY( Update )=Randd(0,YRES)
            StarC( Update )=Randd(&H646464,&HFFFFFF)
   
        End If
       
        '
        ' Oi, vdu Im hungry feed me some of them dotty type thangs.
        '
        FeedPixels( StarX( Update ), StarY( Update ), StarC( Update ))
           
    Next
   
End Sub


Function Randd(ByVal lower As Integer, ByVal upper As Integer) As Integer
   
    Dim As Integer temp, value, dist
   
    If upper < lower Then
        temp=upper
        upper=lower
        lower=temp
    End If
   
    value=lower
    dist = Abs(lower-upper)
   
    Return ( Rnd(1)*dist) + value

End Function


[rdc]

Neat. Thanks for the example.

[Shockwave]

Nice one Clyde. 

[DrewPee]

That is cool Clyde - Ive written something that does a similar job . . .
Hope you don't mind me posting it in your thread?

Regards Drew

[Clyde]

Cheers all and nice one Drewpee

[ninogenio]

hope you dont mind clyde but heres my one in ogl ive only spent about half an hour on it so it is quite rough it was a stright port but then i got carried away.

Code: [Select]

'
' Paralax Starfield.
' By Clyde Radcliffe & Special thanks to Blitz Amateur for the Random Function.
' Made in Dec '06
'
Option Explicit
Option Static

#Include Once "windows.bi"
#Include Once "GL\gl.bi"
#Include Once "GL\glext.bi"
#Include Once "GL\glu.bi"
#Include Once "crt.bi"



type mat
     
     m0 as double
     m1 as double
     m2 as double
     m3 as double
     m4 as double
     m5 as double
     m6 as double
     m7 as double
     m8 as double
     m9 as double
     m10 as double
     m11 as double
     m12 as double
     m13 as double
     m14 as double
     m15 as double
     
end type



type entity_pos
     
     x_pos as double
     y_pos as double
     z_pos as double
     
end type



type entity_rot
   
    x_rot as double
    y_rot as double
    z_rot as double
   
end type



type entity
     
     position as entity_pos ptr
     rotation as entity_rot ptr
     matrix as mat ptr
     
end type



declare sub loadentityidentity( object as entity ptr )
declare sub positionentity( object as entity ptr , byval xpos as double , byval ypos as double , byval zpos as double )
declare sub moveentity( object as entity ptr , byval xpos as double , byval ypos as double , byval zpos as double )
declare sub moveentityW( object as entity ptr , byval xpos as double , byval ypos as double , byval zpos as double )
declare sub rotateentity( object as entity ptr , xpos as double , ypos as double , zpos as double )
declare sub copymatrix4x4( destination as entity ptr , byval source as entity ptr )
declare sub mulmatrix4x4( byval matrix1 as entity ptr , byval matrix2 as entity ptr , resultmatrix as entity ptr )
declare sub transposematrix( matrix as entity ptr )
declare sub multranslmatrix4x4( byval m1 as entity ptr , byval m2 as entity ptr , destination as entity ptr )
declare sub renderworld( camera as entity ptr )
declare sub clearworld()
declare sub MoveRotateCam( camera as entity ptr )
declare function new_entity() as entity ptr
declare sub convertMarray( dest as double ptr , byval source as entity ptr )
declare sub delete_entity( object as entity ptr )

dim shared as double Psin(0 to 360) , Pcos(0 to 360)

dim x as integer

for x = 1 to 360
      Psin( x ) = sin( x * 3.1415 / 180.0 )
      Pcos( x ) = cos( x * 3.1415 / 180.0 )
next

dim shared as entity ptr object0 , object1 , camera

object0 = new_entity()
object1 = new_entity()

camera = new_entity()

loadentityidentity( object0 )
loadentityidentity( object1 )

positionentity( camera , 0 , 0 , -1 )

dim shared as double XRES = 800
dim shared as double YRES = 600

Const MAXSTARS=2000

Dim shared pglPointParameterfvEXT as PFNGLPOINTPARAMETERFVEXTPROC

Dim Shared StarX( MAXSTARS ) , StarY( MAXSTARS ) , StarZ( MAXSTARS ) , StarC( MAXSTARS ) , StarS( MAXSTARS )

Declare Sub FeedPixels          ( Byval X As double , ByVal Y As double ,  ByVal Z As double , ByVal Col As Integer )
Declare Sub InitializeParallax  ()
Declare Sub UpdateStars         ()


Declare Function Randd          ( ByVal lower as double , ByVal upper as double ) As double

InitializeParallax()
   
Dim Key As String
While Key<>Chr(27)
       
      UpdateStars()

      renderworld( camera )
      clearworld()
       
      camera->rotation->y_rot += 1
     
      Key=Inkey()
       
Wend
delete_entity( camera )




Sub FeedPixels( Byval x As double , Byval y As double , Byval z As double , Byval col As Integer)
   
   dim as integer r = col shr 16 and 255
   dim as integer g = col shr 8 and 255
   dim as integer b = col and 255
   
   glColor3ub( r , g  , b )
   
   glEnable(GL_BLEND)
   
   glPointSize(z/4)
   
   glBegin(GL_POINTS)
           glVertex3f( x / ( XRES / 3 ) , y / ( YRES / 3 ) , Z/5 )
   glEnd()
   
   glDisable(GL_BLEND)

End Sub



Sub InitializeParallax()
   
    screen 19 , 32 ,  , 3

    glViewport 0 , 0 , xres , yres
   
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    gluPerspective( 45 , xres / yres , 1 , 100 )
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    glShadeModel GL_SMOOTH
   
    glClearColor 0.0, 0.0, 0.0, 1.0
    glClearDepth 1.0   
    glEnable GL_DEPTH_TEST
    glDepthFunc GL_LEQUAL
    glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST

    glEnable(GL_POINT_SMOOTH)
    glHint(GL_POINT_SMOOTH, GL_NICEST)
    glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA)
   
    pglPointParameterfvEXT = cast( PFNGLPOINTPARAMETERFVEXTPROC , wglGetProcAddress("glPointParameterfvEXT") )
    dim as single attenuation(3) = { 0.0, 0.5, 0.0 }
    pglPointParameterfvEXT( GL_DISTANCE_ATTENUATION_EXT , @attenuation(0) )

    Dim Setup
   
    For Setup=0 To MAXSTARS-1
       
        StarX( Setup ) = Randd( -XRES , XRES - 1 )
        StarY( Setup ) = Randd( -YRES , YRES - 1 )
        StarZ( Setup ) = Randd( -65 , 65 )
        StarS( Setup ) = Randd( 1 , 6 )
       
        StarC( Setup ) = Randd(&H646464,&HFFFFFF)
     
    Next
   
End Sub



function new_entity() as entity ptr

         dim tmp_entity as entity ptr

         tmp_entity = callocate( len(entity) )
         tmp_entity->position = callocate(len(entity_pos))
         tmp_entity->rotation = callocate(len(entity_rot))
         tmp_entity->matrix = callocate(len(mat))
         
         return(tmp_entity)

end function


sub clearworld()

    glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT

end sub



sub delete_entity( object as entity ptr )

    deallocate(object->rotation)
    deallocate(object->position)
    deallocate(object->matrix)
    deallocate(object)

end sub



sub renderworld( camera as entity ptr )

    dim as double cam(0 to 3,0 to 3)
   
    glloadidentity
   
    loadentityidentity( camera )

    rotateentity( camera , 0 , camera->rotation->y_rot , 0 )
    rotateentity( camera , camera->rotation->x_rot , 0 , 0 )
    rotateentity( camera , 0 , 0 , camera->rotation->z_rot )
   
    moveentity( camera , camera->position->x_pos , camera->position->y_pos , camera->position->z_pos )

    transposematrix( camera )

    convertMarray( @cam(0,0) , camera )
    glloadmatrixd( @cam(0,0) )

    flip

end sub



sub convertMarray( dest as double ptr , byval source as entity ptr )

     dest[0] = source->matrix->m0
     dest[1] = source->matrix->m1
     dest[2] = source->matrix->m2
     dest[3] = source->matrix->m3
     dest[4] = source->matrix->m4
     dest[5] = source->matrix->m5
     dest[6] = source->matrix->m6
     dest[7] = source->matrix->m7
     dest[8] = source->matrix->m8
     dest[9] = source->matrix->m9
     dest[10] = source->matrix->m10
     dest[11] = source->matrix->m11
     dest[12] = source->matrix->m12
     dest[13] = source->matrix->m13
     dest[14] = source->matrix->m14
     dest[15] = source->matrix->m15

end sub



sub loadentityidentity( object as entity ptr )

     object->matrix->m0 = 1
     object->matrix->m1 = 0
     object->matrix->m2 = 0
     object->matrix->m3 = 0
     object->matrix->m4 = 0
     object->matrix->m5 = 1
     object->matrix->m6 = 0
     object->matrix->m7 = 0
     object->matrix->m8 = 0
     object->matrix->m9 = 0
     object->matrix->m10 = 1
     object->matrix->m11 = 0
     object->matrix->m12 = 0
     object->matrix->m13 = 0
     object->matrix->m14 = 0
     object->matrix->m15 = 1

end sub



sub positionentity( object as entity ptr , byval xpos as double , byval ypos as double , byval zpos as double )
   
    object->position->x_pos = xpos
    object->position->y_pos = ypos
    object->position->z_pos = zpos
   
end sub



sub moveentity( object as entity ptr , byval xpos as double , byval ypos as double , byval zpos as double )
       
      dim as entity ptr Tmp1 , Tmp2

      Tmp1 = new_entity()
      Tmp2 = new_entity()

      loadentityidentity( Tmp1 )

      Tmp1->matrix->m12 = xpos
      Tmp1->matrix->m13 = ypos
      Tmp1->matrix->m14 = zpos

      mulmatrix4x4( Tmp1 , object , Tmp2 )

      copymatrix4x4( object , Tmp2 )

      delete_entity(Tmp1)
      delete_entity(Tmp2)

end sub



sub moveentityW( object as entity ptr , byval xpos as double , byval ypos as double , byval zpos as double )
       
      object->matrix->m12 += xpos
      object->matrix->m13 += ypos
      object->matrix->m14 += zpos

end sub



sub rotateentity( object as entity ptr , xpos as double , ypos as double , zpos as double )

    dim as entity ptr Tmp1 , Tmp2

    Tmp1 = new_entity()
    Tmp2 = new_entity()

    if xpos > 360 then xpos = 0
    if xpos < 0 then xpos = 360
    if ypos > 360 then ypos = 0
    if ypos < 0 then ypos = 360
    if zpos > 360 then zpos = 0
    if zpos < 0 then zpos = 360
   
    'rotate on xaxis
    if xpos then

        loadentityidentity( Tmp1 )
        Tmp1->matrix->m5 = Pcos( xpos )
        Tmp1->matrix->m6 = -Psin( xpos )
        Tmp1->matrix->m9 = Psin( xpos )
        Tmp1->matrix->m10 = Pcos( xpos )
        mulmatrix4x4( Tmp1 , object , Tmp2 )
        copymatrix4x4( object , Tmp2 )

    endif
   
    'rotate on yaxis
    if ypos then

        loadentityidentity( Tmp1 )
        Tmp1->matrix->m0 = Pcos( ypos )
        Tmp1->matrix->m2 = Psin( ypos )
        Tmp1->matrix->m8 = -Psin( ypos )
        Tmp1->matrix->m10 = Pcos( ypos )
        mulmatrix4x4( Tmp1 , object , Tmp2 )
        copymatrix4x4( object , Tmp2 )

    endif
   
    'rotate on zaxis
    if zpos then

        loadentityidentity( Tmp1 )
        Tmp1->matrix->m0 = Pcos( zpos )
        Tmp1->matrix->m1 = -Psin( zpos )
        Tmp1->matrix->m4 = Psin( zpos )
        Tmp1->matrix->m5 = Pcos( zpos )
        mulmatrix4x4( Tmp1 , object , Tmp2 )
        copymatrix4x4( object , Tmp2 )

    endif

    delete_entity(Tmp1)
    delete_entity(Tmp2)

end sub



sub copymatrix4x4( destination as entity ptr , byval source as entity ptr )

    destination->matrix->m0 = source->matrix->m0
    destination->matrix->m1 = source->matrix->m1
    destination->matrix->m2 = source->matrix->m2
    destination->matrix->m3 = source->matrix->m3
    destination->matrix->m4 = source->matrix->m4
    destination->matrix->m5 = source->matrix->m5
    destination->matrix->m6 = source->matrix->m6
    destination->matrix->m7 = source->matrix->m7
    destination->matrix->m8 = source->matrix->m8
    destination->matrix->m9 = source->matrix->m9
    destination->matrix->m10 = source->matrix->m10
    destination->matrix->m11 = source->matrix->m11
    destination->matrix->m12 = source->matrix->m12
    destination->matrix->m13 = source->matrix->m13
    destination->matrix->m14 = source->matrix->m14
    destination->matrix->m15 = source->matrix->m15

end sub



sub transposematrix( object as entity ptr )
   
    dim as entity ptr Tmp1 , Tmp2

    Tmp1 = new_entity()
    Tmp2 = new_entity()

    copymatrix4x4( Tmp1 , object )

    Tmp1->matrix->m0 = object->matrix->m0
    Tmp1->matrix->m1 = object->matrix->m4
    Tmp1->matrix->m2 = object->matrix->m8

    Tmp1->matrix->m4 = object->matrix->m1
    Tmp1->matrix->m5 = object->matrix->m5
    Tmp1->matrix->m6 = object->matrix->m9

    Tmp1->matrix->m8 = object->matrix->m2
    Tmp1->matrix->m9 = object->matrix->m6
    Tmp1->matrix->m10 = object->matrix->m10

    multranslmatrix4x4(  object , Tmp1 , Tmp2 )
    copymatrix4x4( object , Tmp2 )

    delete_entity(Tmp1)
    delete_entity(Tmp2)

end sub



sub multranslmatrix4x4( byval m1 as entity ptr , byval m2 as entity ptr , destination as entity ptr )
   
    dim as double Tx , Ty , Tz

    Tx = m1->matrix->m0 * m2->matrix->m12 + m1->matrix->m1 * m2->matrix->m13 + m1->matrix->m2 * m2->matrix->m14
    Ty = m1->matrix->m4 * m2->matrix->m12 + m1->matrix->m5 * m2->matrix->m13 + m1->matrix->m6 * m2->matrix->m14
    Tz = m1->matrix->m8 * m2->matrix->m12 + m1->matrix->m9 * m2->matrix->m13 + m1->matrix->m10 * m2->matrix->m14

    copymatrix4x4( destination , m2 )
   
    Tx += m2->matrix->m8
    Ty += m2->matrix->m9
    Tz += m2->matrix->m10


    destination->matrix->m12 = Tx
    destination->matrix->m13 = Ty
    destination->matrix->m14 = Tz

end sub



sub mulmatrix4x4( byval matrix1 as entity ptr , byval matrix2 as entity ptr , resultmatrix as entity ptr )

    resultmatrix->matrix->m0 = matrix1->matrix->m0 * matrix2->matrix->m0 + matrix1->matrix->m1 * matrix2->matrix->m4 + matrix1->matrix->m2 * matrix2->matrix->m8 + matrix1->matrix->m3 * matrix2->matrix->m12
    resultmatrix->matrix->m1 = matrix1->matrix->m0 * matrix2->matrix->m1 + matrix1->matrix->m1 * matrix2->matrix->m5 + matrix1->matrix->m2 * matrix2->matrix->m9 + matrix1->matrix->m3 * matrix2->matrix->m13
    resultmatrix->matrix->m2 = matrix1->matrix->m0 * matrix2->matrix->m2 + matrix1->matrix->m1 * matrix2->matrix->m6 + matrix1->matrix->m2 * matrix2->matrix->m10 + matrix1->matrix->m3 * matrix2->matrix->m14
    resultmatrix->matrix->m3 = matrix1->matrix->m0 * matrix2->matrix->m3 + matrix1->matrix->m1 * matrix2->matrix->m7 + matrix1->matrix->m2 * matrix2->matrix->m11 + matrix1->matrix->m3 * matrix2->matrix->m15

    resultmatrix->matrix->m4 = matrix1->matrix->m4 * matrix2->matrix->m0 + matrix1->matrix->m5 * matrix2->matrix->m4 + matrix1->matrix->m6 * matrix2->matrix->m8 + matrix1->matrix->m7 * matrix2->matrix->m12
    resultmatrix->matrix->m5 = matrix1->matrix->m4 * matrix2->matrix->m1 + matrix1->matrix->m5 * matrix2->matrix->m5 + matrix1->matrix->m6 * matrix2->matrix->m9 + matrix1->matrix->m7 * matrix2->matrix->m13
    resultmatrix->matrix->m6 = matrix1->matrix->m4 * matrix2->matrix->m2 + matrix1->matrix->m5 * matrix2->matrix->m6 + matrix1->matrix->m6 * matrix2->matrix->m10 + matrix1->matrix->m7 * matrix2->matrix->m14
    resultmatrix->matrix->m7 = matrix1->matrix->m4 * matrix2->matrix->m3 + matrix1->matrix->m5 * matrix2->matrix->m7 + matrix1->matrix->m6 * matrix2->matrix->m11 + matrix1->matrix->m7 * matrix2->matrix->m15

    resultmatrix->matrix->m8 = matrix1->matrix->m8 * matrix2->matrix->m0 + matrix1->matrix->m9 * matrix2->matrix->m4 + matrix1->matrix->m10 * matrix2->matrix->m8 + matrix1->matrix->m11 * matrix2->matrix->m12
    resultmatrix->matrix->m9 = matrix1->matrix->m8 * matrix2->matrix->m1 + matrix1->matrix->m9 * matrix2->matrix->m5 + matrix1->matrix->m10 * matrix2->matrix->m9 + matrix1->matrix->m11 * matrix2->matrix->m13
    resultmatrix->matrix->m10 = matrix1->matrix->m8 * matrix2->matrix->m2 + matrix1->matrix->m9 * matrix2->matrix->m6 + matrix1->matrix->m10 * matrix2->matrix->m10 + matrix1->matrix->m11 * matrix2->matrix->m14
    resultmatrix->matrix->m11 = matrix1->matrix->m8 * matrix2->matrix->m3 + matrix1->matrix->m9 * matrix2->matrix->m7 + matrix1->matrix->m10 * matrix2->matrix->m11 + matrix1->matrix->m11 * matrix2->matrix->m15

    resultmatrix->matrix->m12 = matrix1->matrix->m12 * matrix2->matrix->m0 + matrix1->matrix->m13 * matrix2->matrix->m4 + matrix1->matrix->m14 * matrix2->matrix->m8 + matrix1->matrix->m15 * matrix2->matrix->m12
    resultmatrix->matrix->m13 = matrix1->matrix->m12 * matrix2->matrix->m1 + matrix1->matrix->m13 * matrix2->matrix->m5 + matrix1->matrix->m14 * matrix2->matrix->m9 + matrix1->matrix->m15 * matrix2->matrix->m13
    resultmatrix->matrix->m14 = matrix1->matrix->m12 * matrix2->matrix->m2 + matrix1->matrix->m13 * matrix2->matrix->m6 + matrix1->matrix->m14 * matrix2->matrix->m10 + matrix1->matrix->m15 * matrix2->matrix->m14
    resultmatrix->matrix->m15 = matrix1->matrix->m12 * matrix2->matrix->m3 + matrix1->matrix->m13 * matrix2->matrix->m7 + matrix1->matrix->m14 * matrix2->matrix->m11 + matrix1->matrix->m15 * matrix2->matrix->m15

end sub



Sub UpdateStars()
   
    Dim Update
   
    For Update=0 To MAXSTARS-1
           
        StarX( Update )=StarX( Update )+StarS( Update )

        If StarX( Update )>XRES-1 Then
           
            StarX( Update ) = - xres
            StarY( Update ) = Randd( -YRES , YRES )
            StarZ( Update ) = Randd( -65 , 65 )
            StarC( Update ) = Randd( &H646464 , &HFFFFFF )
   
        End If

        FeedPixels( StarX( Update ) , StarY( Update ) , StarZ( Update ) , StarC( Update ) )
           
    Next
   
End Sub


Function Randd(ByVal lower As double, ByVal upper As double) As double
   
    Dim As double temp, value, dist
   
    If upper < lower Then
        temp=upper
        upper=lower
        lower=temp
    End If
   
    value=lower
    dist = abs(lower-upper)
   
    Return ( value + ( Rnd(1)*dist ) )

End Function


[Clyde]

Thats great Nino, cool

Tell you what folks, it would be much better if you created your own posts - otherwize it will get confusing also it would mean you get the praise etc your routines desire. I will see about seperating them into new topics after dinner.

[.:] Druid [:.]

thanks to both..karma for sharing code of course!

[ninogenio]

cheers dudes

ive created a thread now clyde sorry for that.

[Dr_D]

 Hey, I guess I should be asking about this in a lib thread at fb.net, but does anyone know why I can't compile any tinyptc progs with the testing versions of fbc? I haven't used tinyptc in a while, but it seems to be a problem with the header.