Joillekin 60 ruutua sekunnissa ei riitä.
CB ei ole hidas.
CB:llä on mahdollista piirtää yli 2000 ruutua sekunnissa.
Se perustuu DrawScreenin hylkäämiseen. Tänään pohdin aikaisempaa looppitestiä (pelkkä framelaskuri ilman ruudunpiirtoa): miksi DrawScreen on hidas ja miten sen voisi kiertää? Sitten tuli älynväläys - Print-komento piirtää suoraan näyttöpuskuriin. Pienen testaamisen jälkeen huomasin, että piirtokomennot toimivat samalla tavalla. Koodailin hurjan ohjelman, jolla pääset kaahaamaan suorastaan yliluonnollisilla FPS:illä! Kokeile ja kerro tuloksesi.
Kopioi koodi alempaa tai lataa se täältä.
Code: Select all
SCREEN 50,50
SAFEEXIT OFF
SetWindow "CoolBasic HyperMachine by Harakka",1
menu()
Function menu()
stretchScreen(800,180)
otsikkofontti = LoadFont("arial black",100)
valifontti = LoadFont("tahoma",80,1)
perusfontti = LoadFont("verdana",15)
anykey = LoadFont("arial black",40)
m = 0
ClsColor 20,0,0 : Cls
Repeat
m + 1
Color 80,0,0
SetFont valifontti
fastText(50,5,"Coolbasic")
Color WrapAngle(m),0,0
Box 0,120,800,60
SetFont otsikkofontti
fastText(20 + Sin(m)*40,35 + Cos(m)*5,"HYPERMACHINE")
Color 140,20,20
SetFont perusfontti
fasttext(200,100,"You don't like the 60 FPS limit in CB?")
Color 200,40,40
fasttext(200,120,"This program will BLAST YOUR BRAIN ON THE WALL!!")
Color 220,10,10
SetFont anykey
fastText(50,130,"Press any key to test your REAL fps!")
If m > 1400 Then WaitKey : Exit
Cls
Until EscapeKey()
selectTest()
End Function
Function selectTest()
uusivalinta:
anykey = LoadFont("arial black",30)
SetFont anykey
stretchScreen(200,130)
ClsColor 130,50,0 : Cls
Color cbyellow
perusfontti = LoadFont("tahoma",15) : SetFont perusfontti
Print ""
Print " Select a test"
Print " (Press a key)"
Print ""
Print " 1) Loop Test"
Print " 2) Text Test"
Print " 3) Box Test"
Print " 4) Complicated Test"
Print " 5) Quit"
valinta = WaitKey()
Select valinta
Case 2
looptest()
Case 3
textTest()
Case 4
boxTest()
Case 5
Complicated()
Case 6
stretchScreen(1,1,5)
End
Case 1
stretchScreen(1,1,5)
End
End Select
Cls
Goto uusivalinta
End Function
Function loopTest()
stretchScreen(600,50)
perusfontti = LoadFont("verdana",15) : SetFont perusfontti
ClsColor 0,0,80 : Color cbblue : Cls
Print "Next this program will run as many loops as possible in a second."
WaitKey
Cls : Print "Nothing will be drawn on the screen. Press any key to start."
WaitKey
alku = Timer()
Repeat
n + 1
Until Timer()-alku > 1000
Print "Whoah! You got " + n + " FPS! See, CB isn't slow! Press any key."
WaitKey
End Function
Function textTest()
stretchScreen(400,50)
Locate 0,0
Print "Now let's draw 10 000 frames with text."
WaitKey
aa = Timer() - 1
Repeat
f + 1
Locate 5,13
Print "milliseconds: " + (Timer()-aa) + " | " + "frames: " + f + " | " + "FPS:" + f*1000/(Timer()-aa)
If f > 10000 Then
Print "PRESS ANY KEY TO CONTINUE"
WaitKey
Exit
EndIf
Cls
Until EscapeKey()
End Function
Function boxTest()
stretchScreen(200,200)
Print " And the same with"
Print " ten boxes..."
WaitKey
aa = Timer() -1
f = 0
Repeat
ClsColor Rand(50),Rand(50),Rand(50)
d + 1
For i = 1 To 10
Color Rand(255),Rand(255),Rand(255)
Box Rand(30,100),Rand(30,100),Rand(100),Rand(100),0
Next i
Print d + " | " + "FPS:" + d*1000/(Timer()-aa)
If d > 10000 Then
Print "PRESS ANY KEY TO CONTINUE"
WaitKey
Exit
EndIf
Cls
Until EscapeKey()
End Function
Function complicated()
'SCREEN 800,600
stretchScreen(800,600)
ClsColor 0,80,20 : Cls
Locate 0,20
Print " Something more complicated:"
Print " Here you see a big problem - I think it's about vsync"
Print " Press left mouse button to use DrawScreen with vSync"
Print " The FrameLimit will be set to 50 then, you'll notice the difference"
Print " When you do not press the mouse button, drawScreen will be disabled"
WaitKey
ClsColor 0,0,0
cx = 400 : cy = 300
aa = Timer() -1
maxaplus = 50
FrameLimit 10
Repeat
a + 1
Print "Adjust the amount of boxes with mouse wheel (now " + maxaplus + ")"
Print a + " | " + "RESET FPS: LEFT MOUSE BUTTON (DrawScreen) | AVERAGE (!) FPS: " + a*1000/(Timer()-aa)
If MouseHit(1) Then a = 0 : aa = Timer()-1
maxaplus = maxaplus + MouseMoveZ()*2
For aplus = 0 To maxaplus
For dist = 50 To 400 Step 50
For multi = 1 To 4
Color WrapAngle(a+aplus),dist,multi*70
Box cx + Cos(a+aplus)*dist, cy + Sin(multi*a-aplus)*dist, aplus/5,aplus/5,1
Next multi
Next dist
Next aplus
If MouseDown(1) Then FrameLimit 50 : DrawScreen 0, MouseDown(2) Else FrameLimit 10000
Cls
Until EscapeKey()
End Function
Function fastText(x,y,txt$)
Locate x,y : Print txt
End Function
Function stretchScreen(newx,newy,speed = 15)
w = ScreenWidth()
h = ScreenHeight()
Repeat
If w > newx Then w = Max(w-speed,newx)'w - 1
If w < newx Then w = Min(w+speed,newx)
If h > newy Then h = Max(h-speed,newy)
If h < newy Then h = Min(h+speed,newy)
SCREEN w,h
If w = newx And h = newy Then Return 0
Forever
End Function
