Stars With Camera Tiny PTC version.

[Clyde]

Here's Thygrions "Stars With Camera" BB routine now converted into TinyPTC mode.

Code: [Select]

'
' Stars with Camera
' Original BB Source by Thygrion.
' FB TinyPtc adaption by Clyde Radcliffe May 06.
'

#Include Once "tinyptc.bi"

Chdir Exepath
Option Static
Option Explicit

Const XRES=640
Const YRES=480

Const ARES=XRES*YRES

Randomize Timer

Const PI = 3.141593

Const MAXSTARS=10000

Dim Shared ScreenBuffer( ARES )

Dim Shared As Double StarX( MAXSTARS ), StarY( MAXSTARS ), StarZ( MAXSTARS ), StarZV( MAXSTARS )

Dim Shared move     As Double = .05
Dim Shared damping  As Double = .99
Dim Shared zoom     As Double = 5

Dim Shared As Double camx, camy, camz, camxv, camyv

Declare Sub ClearBuffer( Buffer(), ByVal Col As Integer=&H00000000 )

Declare Sub FeedPixels( buffer(), Byval x As Integer, Byval y As Integer, Byval col As Integer)

Declare Sub InitializeStars()
Declare Sub RunStars()
Declare Sub StarPositions( ByVal StarNo )
Declare Sub UpdateStars()

InitializeStars()
RunStars()
End


Sub ClearBuffer( Buffer(), ByVal Col As Integer=&H00000000 )
   
    Dim x,y

    For y=0 to YRES-1
        For x=0 to XRES-1
           
            FeedPixels( Buffer(), x, y, col )
       
        Next
    Next
   
End Sub


Sub FeedPixels( buffer(), 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 InitializeStars()
   
    If( ptc_open( "Camera Stars TinyPTC", XRES, YRES ) = 0 ) Then
End -1                                   
End if
 
    Dim i

    For i = 1 To MAXSTARS
       
        StarPositions(i)
       
    Next
   
End Sub


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

        Ptc_Update @ScreenBuffer(0)
       
        ClearBuffer( ScreenBuffer() )
       
        Key=Inkey()

    Wend
   
    Ptc_Close
   
End Sub


Sub StarPositions( ByVal StarNo )
   
    StarX( StarNo ) = (Rnd(1)*2000)-1000
    StarY( StarNo ) = (Rnd(1)*2000)-1000
    StarZ( StarNo ) = (Rnd(1)*2000)-1000
       
    StarZV( StarNo ) = Rnd(1)*5.0

End Sub


Sub UpdateStars()
   
    Dim i
   
    Dim As Double cx,sx,cy,sy,cz,sz
    Dim As Double sxsx, sxsy
   
    Dim As Double m00,m01,m02
    Dim As Double m10,m11,m12
    Dim As Double m20,m21,m22
   
    Dim As Double cxsx, cxsy
   
    Dim As Double tx, ty, tz
    Dim As Double rx,ry,rz
    Dim As Double nx,ny
   
    Dim As Double c1,c2,c3
    Dim As Double ARGB1, ARGB2, ARGB3
   
    cx = Cos(camx * PI/180.00 )
    sx = Sin(camx * PI/180.00 )
    cy = Cos(camy * PI/180.00 )
    sy = Sin(camy * PI/180.00 )

    cz = Cos(camz * PI/180.00 )
    sz = Sin(camz * PI/180.00 )
       
    sxsy = Cdbl(sx * sy)
    cxsy = Cdbl(cx * sy)

    m00 = Cdbl( cy * cz)
    m01 = Cdbl(-cy * sz)
    m02 = sy

    m10 = cdbl(cx * sz) + cdbl(sxsy * cz)
    m11 = cdbl(cx * cz) - cdbl(sxsy * sz)
    m12 = cdbl(-sx * cy)

    m20 = cdbl(sx * sz) - cdbl(cxsy * cz)
    m21 = cdbl(sx * cz) + cdbl(cxsy * sz)
    m22 = cdbl(cx * cy)

    For i = 1 To MAXSTARS
   
        starz(i) = starz(i) - starzv(i)
   
        tx = starx(i)
        ty = stary(i)
        tz = starz(i)
       
        rx = cdbl(tx * m00) + cdbl(ty * m10) + cdbl(tz * m20)
        ry = cdbl(tx * m01) + cdbl(ty * m11) + cdbl(tz * m21)
        rz = cdbl(tx * m02) + cdbl(ty * m12) + cdbl(tz * m22)
       
        nx = (( cdbl(rx / rz) * 100) * zoom) + (XRES Shr 1)
        ny = ((-cdbl(ry / rz) * 100) * zoom) + (YRES Shr 1)
       
        If starz( i ) <= -1000 then
            starpositions( i )
            starz        ( i ) = 1000
       
        ElseIf nx>1 And nx <XRES-2 And ny>1 And ny<YRES-2 And rz>0 And rz <=1000 then
               
            c1 = 255 * csng(1.0 - csng(rz / 1000.0))
            c2 = c1 * .66
            c3 = c1 * .33
               
            argb1 = (c1 Shl 16 ) Or ( c1 Shl 8 ) Or c1
            argb2 = (c2 Shl 16 ) Or ( c2 Shl 8 ) Or c2
            argb3 = (c3 Shl 16 ) Or ( c3 Shl 8 ) Or c3
               
            FeedPixels( ScreenBuffer(), nx+0, ny+0, ARGB1 )
           
            FeedPixels( ScreenBuffer(), nx-1, ny+0, ARGB2 )
            FeedPixels( ScreenBuffer(), nx+1, ny+0, ARGB2 )
            FeedPixels( ScreenBuffer(), nx+0, ny-1, ARGB2 )
            FeedPixels( ScreenBuffer(), nx+0, ny+1, ARGB2 )
 
            FeedPixels( ScreenBuffer(), nx-2, ny+0, ARGB3 )
            FeedPixels( ScreenBuffer(), nx+2, ny+0, ARGB3 )
            FeedPixels( ScreenBuffer(), nx+0, ny-2, ARGB3 )
            FeedPixels( ScreenBuffer(), nx+0, ny+2, ARGB3 )

        EndIf
    Next
   
    camx = camx + .25
    camy = camy + .5
    camz = camz + .25

End Sub


[Ferris]

Nice conversion, once again k++

[benny!]

Any chance of an exe, please ?

[Shockwave]

Here