Dark Bit Factory & Gravity

PROGRAMMING => Freebasic => Topic started by: DrewPee on December 05, 2008

Title: Something strange . . .
Post by: DrewPee on December 05, 2008

I installed FBIDE and FREEBASIC .15 (as a package) and installed on my laptop . . . been using for a while . . . wrote my snow effe(code attached) on it and it was running at the right speed. I updated to the latest version of FREEBASIC (.20) last night and all of my routines are running about 10 times faster - has anybody else had this problem? Is there anything I can do, other than go back to the older version?

Andy (DrewPee)

Code: [Select]


' SNOWING? by Andy of RCM - 28/10/08
' Dedicated to my family and friends

#include once "tinyptc.bi"
#include once "crt.bi"

const xres = 640
const yres = 480

Dim shared as integer sf
sf=512
Dim shared as double x(sf),y(sf)
dim shared as integer r,g,b
Dim Shared as double x1(sf),y1(sf)
dim shared as integer r1,g1,b1
Dim Shared as double x2(sf),y2(sf)
dim shared as integer r2,g2,b2
Dim shared as integer a,bb(xres)
Dim shared as double q,w,m
Dim shared as String key

Declare Sub DrawSnow
Declare Sub MoveSnow
Declare Sub DrawFlakes1
Declare Sub DrawFlakes2
Declare Sub DrawFlakes3

for a=0 to sf-1
    x(a)=2+(int(rnd(1)*xres)-1)
    y(a)=2+(int(rnd(1)*yres)-1)
    x1(a)=2+(int(rnd(1)*xres)-1)
    y1(a)=2+(int(rnd(1)*yres)-1)
    x2(a)=2+(int(rnd(1)*xres)-1)
    y2(a)=2+(int(rnd(1)*yres)-1)
next
   
    r=120:g=120:b=255
    r1=170:g1=170:b1=255
    r2=255:g2=255:b2=255

If( ptc_open( "Snow - Again!", XRES, YRES ) = 0 ) Then
End -1
End If
Dim Shared as Integer sb(xres*yres)
#define pp(x,y,argb) sb(y*XRES+x)=argb

while key<>chr$(27)
    key = inkey$()
    DrawSnow
    MoveSnow
    ptc_update @sb(0)
    erase sb
Wend

Sub DrawSnow
    for a=0 to sf-1
        DrawFlakes1
        DrawFlakes2
        DrawFlakes3
    next a
End Sub

Sub MoveSnow
    for a=0 to sf-1
        y(a)=y(a)+1'int(rnd(1)*2)
        y1(a)=y1(a)+2'int(rnd(1)*2)
        y2(a)=y2(a)+3
        q=int(rnd(1)*6)
        w=int(rnd(1)*6)
        m=int(rnd(1)*6)
        if q>3 then x(a)=x(a)+.2
        if w>3 then x1(a)=x1(a)+.2
        if m>3 then x2(a)=x2(a)+.2
        if q<3 then x(a)=x(a)-.2
        if w<3 then x1(a)=x1(a)-.2
        if m<3 then x2(a)=x2(a)-.2
        if x(a)<=0 then x(a)=xres-1
        if x(a)>=xres then x(a)=1
        if x1(a)<=0 then x1(a)=xres-1
        if x1(a)>=xres then x1(a)=1
        if x2(a)<=0 then x2(a)=xres-1
        if x2(a)>=xres then x2(a)=xres-1
        if y(a)>=yres-1 then y(a)=1
        if y1(a)>=yres-1 then y1(a)=1
        if y2(a)>=yres-1 then y2(a)=1
    next a
End Sub

Sub DrawFlakes1()
    pp(x(a),y(a),rgb(r,g,b))
    pp(x(a)-1,y(a),rgb(r,g,b))
    pp(x(a)+1,y(a),rgb(r,g,b))
    pp(x(a)+xres,y(a),rgb(r,g,b))
    pp(x(a)-xres,y(a),rgb(r,g,b))
End Sub

Sub DrawFlakes2()
    pp(x1(a),y1(a),rgb(r1,g1,b1))
    pp(x1(a)-1,y1(a),rgb(r1,g1,b1))
    pp(x1(a)+1,y1(a),rgb(r1,g1,b1))
    pp(x1(a)+xres,y1(a),rgb(r1,g1,b1))
    pp(x1(a)-xres,y1(a),rgb(r1,g1,b1))
End Sub

Sub DrawFlakes3()
    pp(x2(a),y2(a),rgb(r2,g2,b2))
    pp(x2(a)-1,y2(a),rgb(r2,g2,b2))
    pp(x2(a)+1,y2(a),rgb(r2,g2,b2))
    pp(x2(a)+xres,y2(a),rgb(r2,g2,b2))
    pp(x2(a)-xres,y2(a),rgb(r2,g2,b2))
End Sub


Title: Re: Something strange . . .
Post by: Hezad on December 05, 2008

Well, first it's a pretty nice effect :D But it runs really fast indeed.

Did you try to put a sleep statement in your loop ? (try sleep 1,1) [But I never used Tiny PTC so I don't know if it "likes" sleep statements :P]

The cause of this gain in speed is pretty mysterious to me so wait for someone with a better knowledge to explain that ;D (And I'll read that explanation with a great interest, it tickles me :)

Title: Re: Something strange . . .
Post by: bikerboy on December 05, 2008

i just tried Sleep 1,1 but nope not working :-\

i've noticed that the snow comes in 3 colors

dark blue (slowest)
royal blue (bit fast)
white (fastest)

just an idea, see what's the code for the blue one (the slowest) , and adjust the other 2 colors.

dunno if what i've just said is dumb or not but i hope i helped :D

Title: Re: Something strange . . .
Post by: ninogenio on December 06, 2008

the most likely cause for a speed up would be better optimization through the newer compiler but thats a guess as i havent looked into it, i seem to remeber .15 being slow as the compiler was being changed to suport oop features.

there is no point using sleep on its own to slow it down as that will be unpredictable from system to system. much better would be to use a frame clamp through system timers like so.

Code: [Select]

' SNOWING? by Andy of RCM - 28/10/08
' Dedicated to my family and friends

#include "windows.bi"
#include "tinyptc.bi"
#include "crt.bi"

const xres = 640
const yres = 480

Dim shared as integer sf
sf=512
Dim shared as double x(sf),y(sf)
dim shared as integer r,g,b
Dim Shared as double x1(sf),y1(sf)
dim shared as integer r1,g1,b1
Dim Shared as double x2(sf),y2(sf)
dim shared as integer r2,g2,b2
Dim shared as integer a,bb(xres)
Dim shared as double q,w,m
Dim shared as String key

Declare Sub DrawSnow
Declare Sub MoveSnow
Declare Sub DrawFlakes1
Declare Sub DrawFlakes2
Declare Sub DrawFlakes3

for a=0 to sf-1
    x(a)=2+(int(rnd(1)*xres)-1)
    y(a)=2+(int(rnd(1)*yres)-1)
    x1(a)=2+(int(rnd(1)*xres)-1)
    y1(a)=2+(int(rnd(1)*yres)-1)
    x2(a)=2+(int(rnd(1)*xres)-1)
    y2(a)=2+(int(rnd(1)*yres)-1)
next
    
    r=120:g=120:b=255
    r1=170:g1=170:b1=255
    r2=255:g2=255:b2=255

If( ptc_open( "Snow - Again!", XRES, YRES ) = 0 ) Then
End -1
End If
Dim Shared as Integer sb(xres*yres)
#define pp(x,y,argb) sb(y*XRES+x)=argb
''''''''''''''''''''''''''''''''''''''''
'            Timer Stuff
''''''''''''''''''''''''''''''''''''''''
Dim Shared As LARGE_INTEGER Frequency
Dim Shared As LARGE_INTEGER LiStart
Dim Shared As LARGE_INTEGER LiStop
Dim Shared As LONGLONG LlTimeDiff
Dim Shared As Double MDuration

QueryPerformanceFrequency( @Frequency )
'''''''''''''''''''''''''''''''''''''''''
while key<>chr$(27)
    ' start timer
    QueryPerformanceCounter( @LiStart )

    key = inkey$()
    DrawSnow
    MoveSnow
    ptc_update @sb(0)
    erase sb
    
    do
        'stop timer and calculate
        QueryPerformanceCounter( @LiStop )
        LlTimeDiff = LiStop.QuadPart - LiStart.QuadPart
        MDuration = Cast( Double, LlTimeDiff ) * 1000.0 / Cast( Double , Frequency.QuadPart )
    Loop While (  MDuration <= 1000.0/60.0 )'60fps Clamp change the 60.0 to whatever fps you need  

Wend

Sub DrawSnow
    for a=0 to sf-1
        DrawFlakes1
        DrawFlakes2
        DrawFlakes3
    next a
End Sub

Sub MoveSnow
    for a=0 to sf-1
        y(a)=y(a)+1'int(rnd(1)*2)
        y1(a)=y1(a)+2'int(rnd(1)*2)
        y2(a)=y2(a)+3
        q=int(rnd(1)*6)
        w=int(rnd(1)*6)
        m=int(rnd(1)*6)
        if q>3 then x(a)=x(a)+.2
        if w>3 then x1(a)=x1(a)+.2
        if m>3 then x2(a)=x2(a)+.2
        if q<3 then x(a)=x(a)-.2
        if w<3 then x1(a)=x1(a)-.2
        if m<3 then x2(a)=x2(a)-.2
        if x(a)<=0 then x(a)=xres-1
        if x(a)>=xres then x(a)=1
        if x1(a)<=0 then x1(a)=xres-1
        if x1(a)>=xres then x1(a)=1
        if x2(a)<=0 then x2(a)=xres-1
        if x2(a)>=xres then x2(a)=xres-1
        if y(a)>=yres-1 then y(a)=1
        if y1(a)>=yres-1 then y1(a)=1
        if y2(a)>=yres-1 then y2(a)=1
    next a
End Sub

Sub DrawFlakes1()
    pp(x(a),y(a),rgb(r,g,b))
    pp(x(a)-1,y(a),rgb(r,g,b))
    pp(x(a)+1,y(a),rgb(r,g,b))
    pp(x(a)+xres,y(a),rgb(r,g,b))
    pp(x(a)-xres,y(a),rgb(r,g,b))
End Sub

Sub DrawFlakes2()
    pp(x1(a),y1(a),rgb(r1,g1,b1))
    pp(x1(a)-1,y1(a),rgb(r1,g1,b1))
    pp(x1(a)+1,y1(a),rgb(r1,g1,b1))
    pp(x1(a)+xres,y1(a),rgb(r1,g1,b1))
    pp(x1(a)-xres,y1(a),rgb(r1,g1,b1))
End Sub

Sub DrawFlakes3()
    pp(x2(a),y2(a),rgb(r2,g2,b2))
    pp(x2(a)-1,y2(a),rgb(r2,g2,b2))
    pp(x2(a)+1,y2(a),rgb(r2,g2,b2))
    pp(x2(a)+xres,y2(a),rgb(r2,g2,b2))
    pp(x2(a)-xres,y2(a),rgb(r2,g2,b2))
End Sub

this way if .20 runs quicker you can run your app at whatever speed you want and have extra power on tap.

Title: Re: Something strange . . .
Post by: Jim on December 06, 2008

Check your libptc versions.  I suspect that has changed a lot too.

Jim

Title: Re: Something strange . . .
Post by: DrewPee on December 06, 2008

Superb! Nice input and advice there! Thank you!

@Ninogenio - that is a nice bit of code - a special thank you to you!

@Bikerboy - i didnt want to change the speed to all match the same - I wanted to create a parallax effect. I think by having three speeds you can sort of tell that the white ones more very quickly and then the darker blue go a little slower because they are further away!?

:)

DrewPee

Title: Re: Something strange . . .
Post by: Shockwave on December 06, 2008

Another painless thing that you could do is use rbz's ptc_ext

There's no need to use tinyptc now.
Delta timing would help too.

Title: Re: Something strange . . .
Post by: Hotshot on December 06, 2008

Nice snow  ;)

Title: Re: Something strange . . .
Post by: DrewPee on December 17, 2008

@Jim - you were right mate - definately a problem with my libraries! doh!

I have now sorted it but also used ninogenio's delta timer too!

It runs superbly now!

Code: [Select]


' SNOWING? by Andy of RCM - 28/10/08
' Dedicated to my family and friends
' amended 17/12/08 to sort out dodgy code!

#include once "tinyptc_ext.bi"
#include once "crt.bi"
#include once "windows.bi"

const xres = 800
const yres = 600

Dim shared as integer sf
sf=512
Dim shared as double x(sf),y(sf)
dim shared as integer r,g,b
Dim Shared as double x1(sf),y1(sf)
dim shared as integer r1,g1,b1
Dim Shared as double x2(sf),y2(sf)
dim shared as integer r2,g2,b2
Dim shared as integer a,bb(xres)
Dim shared as double q,w,m
Dim shared as String key

Declare Sub DrawSnow
Declare Sub MoveSnow
Declare Sub DrawFlakes1
Declare Sub DrawFlakes2
Declare Sub DrawFlakes3

for a=0 to sf-1
    x(a)=2+(int(rnd(1)*xres)-1)
    y(a)=2+(int(rnd(1)*yres)-1)
    x1(a)=2+(int(rnd(1)*xres)-1)
    y1(a)=2+(int(rnd(1)*yres)-1)
    x2(a)=2+(int(rnd(1)*xres)-1)
    y2(a)=2+(int(rnd(1)*yres)-1)
next
   
    r=120:g=120:b=255
    r1=170:g1=170:b1=255
    r2=255:g2=255:b2=255
   
    ptc_allowclose(0)
    ptc_setdialog(1,"Would you like to go Fullscreen?",0,1)
   
If( ptc_open( "Parallax Snowfield - Again!", XRES, YRES ) = 0 ) Then
End -1
End If

Dim Shared as Integer sb(xres*yres)

#define pp(x,y,argb) sb(y*XRES+x)=argb

Dim Shared As LARGE_INTEGER Frequency
Dim Shared As LARGE_INTEGER LiStart
Dim Shared As LARGE_INTEGER LiStop
Dim Shared As LONGLONG LlTimeDiff
Dim Shared As Double MDuration

QueryPerformanceFrequency( @Frequency )

WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
   
    QueryPerformanceCounter( @LiStart )
   
    key = inkey$()
    DrawSnow
    MoveSnow
    ptc_update @sb(0)
    erase sb
   
        do
        QueryPerformanceCounter( @LiStop )
        LlTimeDiff = LiStop.QuadPart - LiStart.QuadPart
        MDuration = Cast( Double, LlTimeDiff ) * 1000.0 / Cast( Double , Frequency.QuadPart )
        Loop While (  MDuration <= 1000.0/60.0 )'60fps Clamp change the 60.0 to whatever fps you need
   
Wend

ptc_close()
end

Sub DrawSnow
    for a=0 to sf-1
        DrawFlakes1
        DrawFlakes2
        DrawFlakes3
    next a
End Sub

Sub MoveSnow
    for a=0 to sf-1
        y(a)=y(a)+2
        y1(a)=y1(a)+3
        y2(a)=y2(a)+4
        q=int(rnd(1)*6)
        w=int(rnd(1)*6)
        m=int(rnd(1)*6)
        if q>3 then x(a)=x(a)+.4
        if w>3 then x1(a)=x1(a)+.6
        if m>3 then x2(a)=x2(a)+.8
        if q<3 then x(a)=x(a)-.4
        if w<3 then x1(a)=x1(a)-.6
        if m<3 then x2(a)=x2(a)-.8
        if x(a)<=0 then x(a)=xres-1
        if x(a)>=xres then x(a)=1
        if x1(a)<=0 then x1(a)=xres-1
        if x1(a)>=xres then x1(a)=1
        if x2(a)<=0 then x2(a)=xres-1
        if x2(a)>=xres then x2(a)=xres-1
        if y(a)>=yres-1 then y(a)=1
        if y1(a)>=yres-1 then y1(a)=1
        if y2(a)>=yres-1 then y2(a)=1
    next a
End Sub

Sub DrawFlakes1()
    pp(x(a),y(a),rgb(r,g,b))
    pp(x(a)-1,y(a),rgb(r,g,b))
    pp(x(a)+1,y(a),rgb(r,g,b))
    pp(x(a)+xres,y(a),rgb(r,g,b))
    pp(x(a)-xres,y(a),rgb(r,g,b))
End Sub

Sub DrawFlakes2()
    pp(x1(a),y1(a),rgb(r1,g1,b1))
    pp(x1(a)-1,y1(a),rgb(r1,g1,b1))
    pp(x1(a)+1,y1(a),rgb(r1,g1,b1))
    pp(x1(a)+xres,y1(a),rgb(r1,g1,b1))
    pp(x1(a)-xres,y1(a),rgb(r1,g1,b1))
End Sub

Sub DrawFlakes3()
    pp(x2(a),y2(a),rgb(r2,g2,b2))
    pp(x2(a)-1,y2(a),rgb(r2,g2,b2))
    pp(x2(a)+1,y2(a),rgb(r2,g2,b2))
    pp(x2(a)+xres,y2(a),rgb(r2,g2,b2))
    pp(x2(a)-xres,y2(a),rgb(r2,g2,b2))
End Sub

Thank you to everybody who posted . . . without you guys I would still be in the dark ages . . . lol!

Title: Re: Something strange . . .
Post by: bikerboy on December 18, 2008

nice snow man :D better than the previous one ;)