Taken from the BDF forums at the old board, original post by Shockwave;
Here's my first ever Freebasic program;
' First Attempt At A Demo In FB!
' Some Stars Will Hopefully Result From This.
' By Shockwave / DBF 2006.
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
' Open 640 X 480 True Colour Full Screen With Refresh Rate Of 70hz.
'--------------------------------------------------------------------------
SCREEN 18,32,2,1,70
IF NOT SCREENPTR THEN
PRINT "Cannot Set Video Mode!"
END
END IF
SCREENSET 1,0
'--------------------------------------------------------------------------
' Hide Mouse Pointer;
'--------------------------------------------------------------------------
SETMOUSE 1,1,0
'--------------------------------------------------------------------------
' Define Storage;
'--------------------------------------------------------------------------
DIM BUFF AS LONG PTR
BUFF=SCREENPTR
DIM SHARED A AS INTEGER :' USED FOR KEYPRESS .
DIM SHARED LP AS INTEGER :' USED AS LOOP COUNTER.
DIM SHARED STARS AS INTEGER: ' USED TO HOLD MAX NUMBER OF STARS.
DIM SHARED TX AS INTEGER
DIM SHARED TY AS INTEGER
'--------------------------------------------------------------------------
' Change The Amount Of Stars By Altering This Number;
'--------------------------------------------------------------------------
STARS = 50000
DIM SHARED STX (1 TO STARS) AS DOUBLE
DIM SHARED STY (1 TO STARS) AS DOUBLE
DIM SHARED STZ (1 TO STARS) AS DOUBLE
'--------------------------------------------------------------------------
' Generate Some Star Positions;
'--------------------------------------------------------------------------
FOR LP = 1 TO STARS STEP 1
' Generate Random Numbers And Pull Halfway Into Negative Values To Distribute
' Stars Around Origin In Centre; ( X + Y )
STX (LP) = ((RND(1) * 20000)-10000 )
STY (LP) = ((RND(1) * 20000)-10000 )
' Z Position;
STZ (LP) = ((RND(1) * 31))+1
NEXT
'--------------------------------------------------------------------------
' Main Loop;
'--------------------------------------------------------------------------
DO
'--------------------------------------------------------------------------
' Do Starfield;
'--------------------------------------------------------------------------
SCREENLOCK
FOR LP = 1 TO STARS STEP 1
TX = (STX(LP) / STZ(LP)) + 320
TY = (STY(LP) / STZ(LP)) + 240
IF (TX>0) AND (TX<640) AND (TY>0) AND (TY<480) THEN
POKE INTEGER, BUFF+(TY*640)+TX,&hFFFFFF
ELSE
STX (LP) = INT((RND(1) * 20000)-10000 )
STY (LP) = INT((RND(1) * 20000)-10000 )
STZ (LP) = 32
END IF
STZ (LP) = STZ(LP) -0.3
NEXT LP
SCREENUNLOCK
'--------------------------------------------------------------------------
' Wait For Vertical Retrace ;
'--------------------------------------------------------------------------
WAIT &H3DA,8
SCREENCOPY
CLS
LOOP UNTIL INKEY$<>""
'--------------------------------------------------------------------------
' Main Loop Ends.
'--------------------------------------------------------------------------
END
I'm happy with the speed of the program, it seems easily within the refresh rate, no difference to execution speed even if I reduce the amount of stars to say 100.
The program judders, I thought it was because I was using PSET so I have changed the listing to use direct memory access to draw the dots as you'll see above, it still glitches.
Is this typical of FB programs or can something be done to smooth things out?
Thygrion? Rbraz? Help appreciated!
Thanks,
Nick.
¤´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´ (¸.·`¤... SHOCKWAVE / DBF...¤
VISIT DARK BIT FACTORY INTERACTIVE! (please!)
Clyde Radcliffe
Fuzzy Wuzzy
Posts: 18236
(15/4/06 14:17)
Reply
Re: Glitchy Freebasic Program
For some reason theres a problem with clearing and buffering the screen from what I can make out mate. The Cls I narrowed down as the culprit.
Ive ever so slightly adapted the code for you it looks more like a Blitz approach, and I hope it helps you dude.
'
' Stars For Shockwave
' By Clyde April '06
'
Option Static
Option Explicit
Randomize Timer
Const XRES=640
Const YRES=480
Const XRES2=XRES/2
Const YRES2=YRES/2
Const STARS=100
Dim Shared ScreenBuffer As UByte Ptr
Dim Shared RGBScreen( XRES, YRES )
Dim Shared As Double STX( STARS ), STY( STARS ), STZ( STARS )
Dim Shared As Integer LP, TX, TY, Col
Dim Shared x,y
Declare Sub SetupStars()
Declare Sub RunStars()
Declare Sub UpdateStars( Buffer As Ubyte Ptr )
SetupStars()
RunStars()
End
Sub SetupStars()
'
' Initialize Screen 640x480x32 with Double buffering and fullscreen
'
Screenres XRES,YRES,32,1,1
ScreenSet 0,1
Setmouse ,,0
ScreenBuffer = Screenptr()
For LP = 1 To STARS
' Generate Random Numbers And Pull Halfway Into Negative Values To Distribute
' Stars Around Origin In Centre; ( X + Y )
STX (LP) = ((RND(1) * 20000)-10000 )
STY (LP) = ((RND(1) * 20000)-10000 )
' Z Position;
STZ (LP) = ((RND(1) * 31))+1
Next
End Sub
Sub RunStars()
Dim Key As String
While Key<>Chr(27)
ScreenLock()
UpdateStars( ScreenBuffer )
ScreenUnlock()
ScreenCopy()
Key=Inkey()
Wend
End Sub
Sub UpdateStars( Buffer As Ubyte Ptr )
For LP = 1 TO Stars
TX = (STX(LP) / STZ(LP)) + XRES2
TY = (STY(LP) / STZ(LP)) + YRES2
If (TX>0) And (TX<640) And (TY>0) And (TY<480) Then
RGBScreen( TX, TY )=&HFFFFFF
Else
STX (LP) = Int((RND(1) * 20000)-10000 )
STY (LP) = Int((RND(1) * 20000)-10000 )
STZ (LP) = 32
End If
STZ (LP) = STZ(LP) -0.3
Next
For y=0 to YRES-1
For x=0 to XRES-1
Col = RGBScreen( x,y )
'If Col>0 Then
Poke Integer, Buffer+(( y )*XRES+( x )) shl 2, Col
RGBScreen( x, y )=0
'End If
Next
Next
End Sub
rbraz
CBM 128
Posts: 165
(15/4/06 14:57)
Reply
Re: Glitchy Freebasic Program
I think that FB with vga mode isn't that good, try to use tinyptc instead. Below, check your code converted to use tinyptc, at first time you will see some glitches (probably read/write disk access), after that it will run fine.
' First Attempt At A Demo In FB!
' Some Stars Will Hopefully Result From This.
' By Shockwave / DBF 2006.
' TinyPTC version by Rbraz
'--------------------------------------------------------------------------
'-------------------------------------
' Includes.
'-------------------------------------
#Include Once "tinyptc.bi"
'--------------------------------------------------------------------------
' Open 640 X 480
'--------------------------------------------------------------------------
If( ptc_open( "Stars", 640, 480 ) = 0 ) Then
End -1
End If
'--------------------------------------------------------------------------
' Hide Mouse Pointer;
'--------------------------------------------------------------------------
SETMOUSE 1,1,0
'--------------------------------------------------------------------------
' Declare sub-routines
'--------------------------------------------------------------------------
Declare Sub ClearScreen ()
'--------------------------------------------------------------------------
' Define Storage;
'--------------------------------------------------------------------------
Dim Shared As Integer Buffer( 640 * 480 )
DIM SHARED A AS INTEGER :' USED FOR KEYPRESS .
DIM SHARED LP AS INTEGER :' USED AS LOOP COUNTER.
DIM SHARED STARS AS INTEGER: ' USED TO HOLD MAX NUMBER OF STARS.
DIM SHARED TX AS INTEGER
DIM SHARED TY AS INTEGER
'--------------------------------------------------------------------------
' Change The Amount Of Stars By Altering This Number;
'--------------------------------------------------------------------------
STARS = 50000
DIM SHARED STX (1 TO STARS) AS DOUBLE
DIM SHARED STY (1 TO STARS) AS DOUBLE
DIM SHARED STZ (1 TO STARS) AS DOUBLE
'--------------------------------------------------------------------------
' Generate Some Star Positions;
'--------------------------------------------------------------------------
FOR LP = 1 TO STARS STEP 1
' Generate Random Numbers And Pull Halfway Into Negative Values To Distribute
' Stars Around Origin In Centre; ( X + Y )
STX (LP) = ((RND(1) * 20000)-10000 )
STY (LP) = ((RND(1) * 20000)-10000 )
' Z Position;
STZ (LP) = ((RND(1) * 31))+1
NEXT
'--------------------------------------------------------------------------
' Main Loop;
'--------------------------------------------------------------------------
DO
ClearScreen()
'--------------------------------------------------------------------------
' Do Starfield;
'--------------------------------------------------------------------------
FOR LP = 1 TO STARS STEP 1
TX = (STX(LP) / STZ(LP)) + 320
TY = (STY(LP) / STZ(LP)) + 240
IF (TX>0) AND (TX<640) AND (TY>0) AND (TY<480) THEN
'Update our temp buffer
Buffer(TX + (TY * 640)) = &hFFFFFF
ELSE
STX (LP) = INT((RND(1) * 20000)-10000 )
STY (LP) = INT((RND(1) * 20000)-10000 )
STZ (LP) = 32
END IF
STZ (LP) = STZ(LP) -0.3
NEXT LP
ScreenLock()
'Update PTC screen with temp buffer
Ptc_Update @Buffer(0)
ScreenUnlock()
LOOP UNTIL INKEY$<>""
'--------------------------------------------------------------------------
' Main Loop Ends.
'--------------------------------------------------------------------------
END
Sub ClearScreen()
Dim i as integer
for i = 0 to 640*480
Buffer(i) = 0
next
End Sub
Edited by: rbraz at: 15/4/06 14:59
5H0CKW4VE
*Administrator*
Posts: 7981
(15/4/06 16:08)
Reply
ezSupporter
Re: Glitchy Freebasic Program
Thanks fellas
The exe comes out at only 25kb with the tinyptc lib version too.
¤´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´ (¸.·`¤... SHOCKWAVE / DBF...¤
VISIT DARK BIT FACTORY INTERACTIVE! (please!)
5H0CKW4VE
*Administrator*
Posts: 7983
(15/4/06 18:35)
Reply
ezSupporter
Re: Glitchy Freebasic Program
Just Prettied it up ever so slightly..
' First Attempt At A Demo In FB!
' Some Stars Will Hopefully Result From This.
' By Shockwave / DBF 2006.
' TinyPTC version by Rbraz
'--------------------------------------------------------------------------
'-------------------------------------
' Includes.
'-------------------------------------
#Include Once "tinyptc.bi"
'--------------------------------------------------------------------------
' Open 640 X 480
'--------------------------------------------------------------------------
If( ptc_open( "Stars", 640, 480 ) = 0 ) Then
End -1
End If
'--------------------------------------------------------------------------
' Hide Mouse Pointer;
'--------------------------------------------------------------------------
SETMOUSE 1,1,0
'--------------------------------------------------------------------------
' Declare sub-routines
'--------------------------------------------------------------------------
Declare Sub ClearScreen ()
'--------------------------------------------------------------------------
' Define Storage;
'--------------------------------------------------------------------------
Dim Shared As Integer Buffer( 640 * 480 )
DIM SHARED CR , CR2 AS INTEGER : ' USED TO STORE COLOUR
DIM SHARED A , B AS INTEGER :' USED FOR KEYPRESS .
DIM SHARED LP AS INTEGER :' USED AS LOOP COUNTER.
DIM SHARED STARS AS INTEGER: ' USED TO HOLD MAX NUMBER OF STARS.
DIM SHARED TX AS INTEGER
DIM SHARED TY AS INTEGER
'--------------------------------------------------------------------------
' Change The Amount Of Stars By Altering This Number;
'--------------------------------------------------------------------------
STARS = 5000
DIM SHARED STX (1 TO STARS) AS DOUBLE
DIM SHARED STY (1 TO STARS) AS DOUBLE
DIM SHARED STZ (1 TO STARS) AS DOUBLE
'--------------------------------------------------------------------------
' Generate Some Star Positions;
'--------------------------------------------------------------------------
FOR LP = 1 TO STARS STEP 1
' Generate Random Numbers And Pull Halfway Into Negative Values To Distribute
' Stars Around Origin In Centre; ( X + Y )
STX (LP) = ((RND(1) * 20000)-10000 )
STY (LP) = ((RND(1) * 20000)-10000 )
' Z Position;
STZ (LP) = ((RND(1) * 31))+1
NEXT
'--------------------------------------------------------------------------
' Main Loop;
'--------------------------------------------------------------------------
DO
ClearScreen()
'--------------------------------------------------------------------------
' Do Starfield;
'--------------------------------------------------------------------------
FOR LP = 1 TO STARS STEP 1
TX = (STX(LP) / STZ(LP)) + 320
TY = (STY(LP) / STZ(LP)) + 240
IF (TX>1) AND (TX<639) AND (TY>1) AND (TY<479) AND (STZ(LP) > 0) THEN
A=INT(-STZ(LP) + 32) SHL 3
B=INT(-STZ(LP) + 32) SHL 1
CR=RGB ( A , A , A )
CR2=RGB ( B , B , B )
'Update our temp buffer
Buffer(TX + (TY * 640)) = CR
Buffer((TX-1) + (TY * 640)) = CR2
Buffer((TX+1) + (TY * 640)) = CR2
Buffer(TX + ((TY-1) * 640)) = CR2
Buffer(TX + ((TY+1) * 640)) = CR2
ELSE
STX (LP) = INT((RND(1) * 20000)-10000 )
STY (LP) = INT((RND(1) * 20000)-10000 )
STZ (LP) = 32
END IF
STZ (LP) = STZ(LP) -0.1
NEXT LP
ScreenLock()
'Update PTC screen with temp buffer
Ptc_Update @Buffer(0)
ScreenUnlock()
LOOP UNTIL INKEY$<>""
'--------------------------------------------------------------------------
' Main Loop Ends.
'--------------------------------------------------------------------------
END
Sub ClearScreen()
Dim i as integer
for i = 0 to 640*480
Buffer(i) = 0
next
End Sub
A few things I noticed when you changed the listing Rbraz, first there seems to be no wait for vertical retrace, second, what happened to the double buffering?
Is this now handled automatically by tinyptc?
Showing / Hiding the mouse seems to have no effect now, the mouse pointer is always hidden (not that it makes any difference!).
It runs totally smooth now with tinyptc, it's a very quick language, I like it already.
Does anyone know of any really small dlls to play tracker music? like smaller than fmod?
Thanks.
¤´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´ (¸.·`¤... SHOCKWAVE / DBF...¤
VISIT DARK BIT FACTORY INTERACTIVE! (please!)
Thygrion
DBF: Coder
Posts: 362
(16/4/06 5:04)
Reply
Re: Glitchy Freebasic Program
Try researching minifmod or email the Kolor or Exceed bunch.
Finally 14!!
5H0CKW4VE
*Administrator*
Posts: 7990
(16/4/06 16:04)
Reply
ezSupporter
Re: Glitchy Freebasic Program Thanks dude.
¤´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´ (¸.·`¤... SHOCKWAVE / DBF...¤
VISIT DARK BIT FACTORY INTERACTIVE! (please!)
rbraz
CBM 128
Posts: 168
(16/4/06 20:56)
Reply
Re: Glitchy Freebasic Program
Tinyptc uses DirectDraw, and it doesn't need "ScreenLock() ScreenUnlock()" stuff (remove it), Tinyptc lock and unlock your directdraw surface automatically. About vertical retrace, I'm not sure, perhaps there be a way to do that, and lock the fps for a example to only 60 fps.
Oh, I was forgotten, use #define PTC_WIN above your tinyptc include to run into windowed mode.
#define PTC_WIN
'-------------------------------------
' Includes.
'-------------------------------------
#Include Once "tinyptc.bi"
Edited by: rbraz at: 16/4/06 21:05
5H0CKW4VE
*Administrator*
Posts: 7999
(16/4/06 23:13)
Reply
ezSupporter
Re: Glitchy Freebasic Program
Thanks for the tip
¤´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´ (¸.·`¤... SHOCKWAVE / DBF...¤
VISIT DARK BIT FACTORY INTERACTIVE! (please!)
