Here's Thygrions "Stars With Camera" BB routine now converted into TinyPTC mode.
'
' 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
