Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: neriakX on October 24, 2011
-
Hi guys,
as I'm trying to learn FreeBasic I thought I'd port some examples of http://lodev.org to FreeBasic.
I already made some progress (having fun with plasmas) but this one is hurting my braincells. -> http://lodev.org/cgtutor/sierpinski.html
The first code example on the website does not work in FreeBasic, it looks completely different, so I went for the 2nd method. The result looks a lot better but it's still not the same. I'm not getting rectangles but some kind of triangles. Can you help me find the culprit please? I suspect Modulo being different to '%' in C.
I guess I have used some code snippets from Shockwave, Clyde and other guys to code this thing. So don't be surprised if you find some code similar to your own. (Everyone has to start somewhere =) ). Thanks for your great selection of source codes on the forums!
Ok, here's my code:
' Sierpinski Fractals (http://lodev.org/cgtutor/sierpinski.html)
'
' ported to FreeBasic
' by dizphunkt in 2011
'-------------------------------------------------------------------------------
Option Static
Option Explicit
'-------------------------------------------------------------------------------
Const XRES = 729
Const YRES = 729
Const FPS = 60 'PPS
'-------------------------------------------------------------------------------
'#DEFINE Ptc_win
#Include "tinyptc_ext.bi"
'-------------------------------------------------------------------------------
' OPEN THE SCREEN;
'-------------------------------------------------------------------------------
PTC_ALLOWCLOSE(0)
PTC_SETDIALOG(1,"Sierpinski Fractals"+CHR$(13)+"FULL SCREEN?",0,1)
if (ptc_open("Sierpinski Fractals", XRES, YRES) = 0) then end -1
Sleep 10
'--------------------------------------------------------------------------
' Hide Mouse Pointer;
'--------------------------------------------------------------------------
'SETMOUSE 1,1,0
'-------------------------------------------------------------------------------
' VARIABLES DEFINITION
'-------------------------------------------------------------------------------
dim shared as integer ScreenBuffer(XRES*YRES)
Dim Shared as integer x, y
Dim Shared As Integer r, g, b
'Timei is TIMER var
Dim Shared As Double Timei ', SecondsPerFrame
'-------------------------------------------------------------------------------
' SUBS DEFINITION
'-------------------------------------------------------------------------------
Declare Sub FeedPixels( Buffer() as integer, ByVal x As Integer,_
ByVal y As Integer, ByVal col As Integer)
Declare Sub drawCarpet()
Declare Sub RunIntro()
Declare Sub SyncScr()
Declare Sub ClearScr()
'-------------------------------------------------------------------------------
' MAIN LOOP
'-------------------------------------------------------------------------------
While(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
Timei = Timer()
RunIntro()
Ptc_Update @ScreenBuffer(0)
Erase ScreenBuffer
SyncScr()
Wend
'------------------------------------------------------------------------------
'The End
'------------------------------------------------------------------------------
ptc_close
end 0
Sub FeedPixels( Buffer() as integer, 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(X + (Y * XRES)) = col
End If
End Sub
Sub drawCarpet()
For x = 0 To XRES -1
For y = 0 To YRES -1
If Not ((x/1) Mod 3 = 1 And (y/1) Mod 3 = 1) And _
Not ((x/3) Mod 3 = 1 And (y/3) Mod 3 = 1) And _
Not ((x/9) Mod 3 = 1 And (y/9) Mod 3 = 1) And _
Not ((x/27) Mod 3 = 1 And (y/27) Mod 3 = 1) And _
Not ((x/81) Mod 3 = 1 And (y/81) Mod 3 = 1) And _
Not ((x/243) Mod 3 = 1 And (y/243) Mod 3 = 1) Then
FeedPixels(ScreenBuffer(), x, y, RGB(255, 255, 255))
End If
Next
Next
End Sub
Sub RunIntro()
drawCarpet()
End Sub
Sub SyncScr()
Dim As Double SecondsPerFrame
'How long each frame should take to be rendered
SecondsPerFrame = 1 / FPS
Do: Sleep 1: Loop While Timer - Timei <= SecondsPerFrame
End Sub
Sub ClearScr()
For bx As Integer = 0 To XRES -1
For by As Integer = 0 To YRES -1
FeedPixels(ScreenBuffer(),bx,by,RGB(255,255,255))
Next
Next
End Sub
-
Should work the same.
Try setting xres=800, yres =600.
Jim
-
Try setting xres=800, yres =600.
Hi and thanks for your reply, Jim. Unfortunately changing the resoultion does not help :-/
-
I see, in FreeBasic
5 / 2 equals 2.5
in C
5 / 2 equals 2
You need to use \ in FreeBasic for integer division
5 \ 2 equals 2
Jim
-
Woot Jim! Your mojo is very powerful! hehe. It works like a charm now! Thank you so much .. now I can solve some other (same) riddles in my codes. awesome! karma+
Here is the updated and finally working Sierpinski Carpet in FB!
' Sierpinski Carpet (http://lodev.org/cgtutor/sierpinski.html)
'
' ported to FreeBasic
' by dizphunkt in 2011
'-------------------------------------------------------------------------------
Option Static
Option Explicit
'-------------------------------------------------------------------------------
Const XRES = 729
Const YRES = 729
Const SCR_SIZE = XRES*YRES
Const FPS = 60 'PPS
'-------------------------------------------------------------------------------
'#DEFINE Ptc_win
#Include "tinyptc_ext.bi"
'-------------------------------------------------------------------------------
' OPEN THE SCREEN;
'-------------------------------------------------------------------------------
PTC_ALLOWCLOSE(0)
PTC_SETDIALOG(1,"Sierpinski Fractals"+CHR$(13)+"FULL SCREEN?",0,1)
if (ptc_open("Sierpinski Fractals", XRES, YRES) = 0) then end -1
Sleep 10
'-------------------------------------------------------------------------------
' VARIABLES DEFINITION
'-------------------------------------------------------------------------------
Dim Shared ScreenBuffer(0 To SCR_SIZE-1) As Integer
Dim Shared x, y as Integer
Dim Shared r, g, b As Integer
'Timei is TIMER var
Dim Shared As Double Timei ', SecondsPerFrame
'-------------------------------------------------------------------------------
' SUB DEFINITION
'-------------------------------------------------------------------------------
Declare Sub put_pixel(Buffer() as integer, ByVal x As Integer,_
ByVal y As Integer, ByVal col As Integer)
Declare Sub drawCarpet()
Declare Sub RunIntro()
Declare Sub SyncScr()
Declare Sub ClearScr()
'-------------------------------------------------------------------------------
' MAIN LOOP
'-------------------------------------------------------------------------------
While(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
Timei = Timer()
RunIntro()
ScreenLock()
Ptc_Update @ScreenBuffer(0)
ScreenUnlock()
Erase ScreenBuffer
SyncScr()
Wend
'------------------------------------------------------------------------------
'The End
'------------------------------------------------------------------------------
ptc_close
end 0
Private Sub put_pixel(Buffer() as integer, 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(x + (y * XRES)) = col
End If
End Sub
Private Sub drawCarpet()
For x = 0 To XRES -1
For y = 0 To YRES -1
If Not ((x\1) Mod 3 = 1 And (y\1) Mod 3 = 1) And _
Not ((x\3) Mod 3 = 1 And (y\3) Mod 3 = 1) And _
Not ((x\9) Mod 3 = 1 And (y\9) Mod 3 = 1) And _
Not ((x\27) Mod 3 = 1 And (y\27) Mod 3 = 1) And _
Not ((x\81) Mod 3 = 1 And (y\81) Mod 3 = 1) And _
Not ((x\243) Mod 3 = 1 And (y\243) Mod 3 = 1) Then
put_pixel(ScreenBuffer(), x, y, RGB(255, 255, 255))
End If
Next
Next
End Sub
Private Sub RunIntro()
drawCarpet()
End Sub
Private Sub SyncScr()
Dim As Double SecondsPerFrame
'How long each frame should take to be rendered
SecondsPerFrame = 1 / FPS
Do: Sleep 1: Loop While Timer - Timei <= SecondsPerFrame
End Sub