niinpä, itse tyhjentäisin ruudut piirtämällä ne täyteen mustaa.MaGetzUb wrote:Melko hankala saada tuo 3D vaikutelma toimimaan. :/
Miksi muuten ruudut tuhotaan tuossa Draw3d funktiossa?
Efektit
-
- Devoted Member
- Posts: 594
- Joined: Tue Sep 30, 2008 4:30 pm
- Location: Ruudun toisella puolella
Re: Efektit
Re: Efektit
Tai sitten vain komentaa piirtopuskurin kuvaksi ja tyhjentää sen CLS-komennolla.Wingman wrote:niinpä, itse tyhjentäisin ruudut piirtämällä ne täyteen mustaa.MaGetzUb wrote:Melko hankala saada tuo 3D vaikutelma toimimaan. :/
Miksi muuten ruudut tuhotaan tuossa Draw3d funktiossa?
Solar Eclipse
We're in a simulation, and God is trying to debug us.
- Misthema
- Advanced Member
- Posts: 312
- Joined: Mon Aug 27, 2007 8:32 pm
- Location: Turku, Finland
- Contact:
Re: Efektit
Jotain randomia. En jaksanut tehdä mitään FPS-riippumattomuuksia tms. Kunhan kikkailin. =)
Code: Select all
Const SW = 640
Const SH = 480
SCREEN SW,SH
FrameLimit 60
Type BALLS
Field x#
Field y#
Field a#
Field aStart#
Field z#
Field r
Field g
Field b
Field ord
End Type
For i=1 To 18
ball.BALLS=New(BALLS)
ball\aStart=i*20
ball\z=50.0
ball\x=SW/2+Cos(ball\aStart)*ball\z
ball\y=SH/2+Sin(ball\aStart)*ball\z
ball\r=0
ball\g=0
ball\b=0
ball\ord = i Mod 2
Next i
angle#=0.0
angleTimer=Timer()
Repeat
angle=WrapAngle(angle+.5)
For k=0 To 1
For i=0 To 1
For bal.BALLS = Each BALLS
bal\a=((bal\aStart+angle)+(i*90)) Mod 360
bal\z=128+Cos(bal\a*4)*(64+(63*i))
If k=0 Then
bal\x=SW/2-Cos(bal\a+angle)*(bal\z/1.5)
bal\y=SH/2-Sin(bal\a+angle)*(bal\z/1.5)
Else
bal\x=SW/2-Cos(bal\a+angle)*(bal\z/2.5)
bal\y=SH/2+Sin(bal\a+angle)*(bal\z/2.5)
EndIf
bal\r=bal\z*4
Color bal\r,bal\g,bal\b
Circle bal\x-(bal\z/16),bal\y-(bal\z/16),bal\z/8,i
Next bal
Next i
Next k
DrawScreen 1-KeyDown(cbKeySpace)
SetWindow Str(FPS())
Forever
End
Re: Efektit
Tämmööstä metapallo hässäkkää tälläkertaa:
Code: Select all
Const SCRW = 800
Const SCRH = 600
Const GW = 16
Const GH = 16
Dim m(2, 1)
SCREEN SCRW, SCRH
BoxesX = Int(SCRW/GW)
BoxesY = Int(SCRH/GH)
Dim Bright(BoxesX, BoxesY, 2) As Float
rad = 40 / GW
Repeat
a = a + 1
m(0, 0) = SCRW/2 + Cos(a*Sin(a*1.5)*0.75) * SCRW/2.4
m(0, 1) = SCRH/2 - Sin(a*Cos(a*1.5)*3) * SCRH/2.4
m(1, 0) = SCRW/2 + Cos(120+a*Sin(a*1.5)*0.75) * SCRW/2.4
m(1, 1) = SCRH/2 - Sin(120+a*Cos(a*1.5)*3) * SCRH/2.4
m(2, 0) = SCRW/2 + Cos(240+a*Sin(a*1.5)*0.75) * SCRW/2.4
m(2, 1) = SCRH/2 - Sin(240+a*Cos(a*1.5)*3) * SCRH/2.4
For i = 0 To 2
m(i, 0) = m(i, 0) / GW
m(i, 1) = m(i, 1) / GH
Next i
For x = 0 To BoxesX
For y = 0 To BoxesY
If Slowdown Then
For i = 0 To 2
If Bright(x, y, i) Then Bright(x, y, i) = Bright(x, y, i) - Bright(x, y, i)*0.05
Next i
EndIf
For i = 0 To 2
Bright(x, y, i) = Bright(x, y, i) + Float(rad)/((m(i, 0)-x)(m(i, 0)-x) + (m(i, 1)-y)(m(i, 1)-y))
Bright(x, y, i) = Min(1, Bright(x, y, i))
Next i
Color Bright(x, y, 0)*255, Bright(x, y, 1)*255, Bright(x, y, 2)*255
Box x*GW, y*GH, GW, GH
Next y
Next x
If Timer() > slowtime + 2500 Then
slowdown = Not slowdown
slowtime = Timer()
EndIf
DrawScreen
Forever
Solar Eclipse
We're in a simulation, and God is trying to debug us.
Re: Efektit
Tämähän on oikein hieno, joskin vähän hidas.MaGetzUb wrote:Tämmööstä metapallo hässäkkää tälläkertaa:Code: Select all
Const SCRW = 800 Const SCRH = 600 Const GW = 16 Const GH = 16 Dim m(2, 1) SCREEN SCRW, SCRH BoxesX = Int(SCRW/GW) BoxesY = Int(SCRH/GH) Dim Bright(BoxesX, BoxesY, 2) As Float rad = 40 / GW Repeat a = a + 1 m(0, 0) = SCRW/2 + Cos(a*Sin(a*1.5)*0.75) * SCRW/2.4 m(0, 1) = SCRH/2 - Sin(a*Cos(a*1.5)*3) * SCRH/2.4 m(1, 0) = SCRW/2 + Cos(120+a*Sin(a*1.5)*0.75) * SCRW/2.4 m(1, 1) = SCRH/2 - Sin(120+a*Cos(a*1.5)*3) * SCRH/2.4 m(2, 0) = SCRW/2 + Cos(240+a*Sin(a*1.5)*0.75) * SCRW/2.4 m(2, 1) = SCRH/2 - Sin(240+a*Cos(a*1.5)*3) * SCRH/2.4 For i = 0 To 2 m(i, 0) = m(i, 0) / GW m(i, 1) = m(i, 1) / GH Next i For x = 0 To BoxesX For y = 0 To BoxesY If Slowdown Then For i = 0 To 2 If Bright(x, y, i) Then Bright(x, y, i) = Bright(x, y, i) - Bright(x, y, i)*0.05 Next i EndIf For i = 0 To 2 Bright(x, y, i) = Bright(x, y, i) + Float(rad)/((m(i, 0)-x)(m(i, 0)-x) + (m(i, 1)-y)(m(i, 1)-y)) Bright(x, y, i) = Min(1, Bright(x, y, i)) Next i Color Bright(x, y, 0)*255, Bright(x, y, 1)*255, Bright(x, y, 2)*255 Box x*GW, y*GH, GW, GH Next y Next x If Timer() > slowtime + 2500 Then slowdown = Not slowdown slowtime = Timer() EndIf DrawScreen Forever
Aloittelija, koodaaja, jotain...
Re: Efektit
Tosi siisti efekti. FPS ei kylläkään ollut kuin 27 - 31.Misthema wrote:Jotain randomia. En jaksanut tehdä mitään FPS-riippumattomuuksia tms. Kunhan kikkailin. =)
Code: Select all
Const SW = 640 Const SH = 480 SCREEN SW,SH FrameLimit 60 Type BALLS Field x# Field y# Field a# Field aStart# Field z# Field r Field g Field b Field ord End Type For i=1 To 18 ball.BALLS=New(BALLS) ball\aStart=i*20 ball\z=50.0 ball\x=SW/2+Cos(ball\aStart)*ball\z ball\y=SH/2+Sin(ball\aStart)*ball\z ball\r=0 ball\g=0 ball\b=0 ball\ord = i Mod 2 Next i angle#=0.0 angleTimer=Timer() Repeat angle=WrapAngle(angle+.5) For k=0 To 1 For i=0 To 1 For bal.BALLS = Each BALLS bal\a=((bal\aStart+angle)+(i*90)) Mod 360 bal\z=128+Cos(bal\a*4)*(64+(63*i)) If k=0 Then bal\x=SW/2-Cos(bal\a+angle)*(bal\z/1.5) bal\y=SH/2-Sin(bal\a+angle)*(bal\z/1.5) Else bal\x=SW/2-Cos(bal\a+angle)*(bal\z/2.5) bal\y=SH/2+Sin(bal\a+angle)*(bal\z/2.5) EndIf bal\r=bal\z*4 Color bal\r,bal\g,bal\b Circle bal\x-(bal\z/16),bal\y-(bal\z/16),bal\z/8,i Next bal Next i Next k DrawScreen 1-KeyDown(cbKeySpace) SetWindow Str(FPS()) Forever End
EDIT:
Woohoo! Member -> Active Member
Aloittelija, koodaaja, jotain...
Re: Efektit
Joo tuota jos se liikkuisi hitaammin se näyttäisi paremmalta, mutta minkäs teet yyber liikuttelu koodinpätkä by me.TukeKoodi wrote:Tosi siisti efekti. FPS ei kylläkään ollut kuin 27 - 31.Misthema wrote:Jotain randomia. En jaksanut tehdä mitään FPS-riippumattomuuksia tms. Kunhan kikkailin. =)
Code: Select all
koodia
EDIT:Woohoo! Member -> Active Member
Btw, aika kyseenalainen tuo Active Member huudahdus kun teit tuplapostina.
Solar Eclipse
We're in a simulation, and God is trying to debug us.
Re: Efektit
Tein Bézierin käyrän piirtofunktion.
Tein sekä 3:lle pisteelle, että 4 pisteelle.
Viiva piirretään funktioille annetujen pisteiden välille siten, että se kulkee ensimmäisen ja viimeisen pisteen kautta ja taipuu kohti muita pisteitä. DrawBezierCurve3 siis piirtää viivan (x1,y1):stä (x3,y3):een taivuttaen sitä (x2,y2):sta kohti ja DrawBezierCurve4 piirtää viivan (x1,y1):stä (x4,y4):een taivuttaen sitä (x2,y2):sta ja (x3,y3):sta kohti. Katsokaa esimerkki koodia, niin näette sen toimivan käytännössä.
Code: Select all
Global Accuracy
Accuracy = 30.0
Function DrawBezierCurve4(x1#,y1#,x2#,y2#,x3#,y3#,x4#,y4#)
t# = 1/Accuracy
lastX# = x1#
lastY# = y1#
For i# = 1 To Accuracy-1
t# = i / Accuracy
x# = (1.0-t)^3*x1+3.0*(1.0-t)^2*t*x2+3.0*(1.0-t)*t^2*x3+t^3*x4
y# = (1.0-t)^3*y1+3.0*(1.0-t)^2*t*y2+3.0*(1.0-t)*t^2*y3+t^3*y4
Line lastX#,lastY#,x#,y#
lastX# = x
lastY# = y
Next i#
Line lastX#,lastY#,x4#,y4#
EndFunction
Function DrawBezierCurve3(x1#,y1#,x2#,y2#,x3#,y3#)
t# = 1/Accuracy
lastX# = x1#
lastY# = y1#
For i# = 1 To Accuracy-1
t# = i / Accuracy
x# = (1.0-t)^2*x1#+2.0*(1.0-t)*t*x2+t^2*x3
y# = (1.0-t)^2*y1#+2.0*(1.0-t)*t*y2+t^2*y3
Line lastX#,lastY#,x#,y#
lastX# = x
lastY# = y
Next i#
Line lastX#,lastY#,x3#,y3#
EndFunction
SCREEN 800,600
x# = 200
y# = 150
ang# = 0
l# = 10
Repeat
Text 10,10,"FPS:"+FPS()
Text 10,20,"Lines per curve:"+Accuracy
If KeyDown(cbKeyA) Then ang# = ang# + 0.4
If KeyDown(cbKeyD) Then ang# = ang# - 0.4
If KeyDown(cbKeyW) Then l# + 0.4
If KeyDown(cbKeyS) Then l# - 0.4
Accuracy = Max(3,Accuracy+(KeyDown(cbKeyQ)-KeyDown(cbKeyE)))
If UpKey() Then y# - 0.3
If DownKey() Then y# + 0.3
If LeftKey() Then x# - 0.3
If RightKey() Then x# + 0.3
px1# = x#-Cos(ang)*l
py1# = y#-Sin(ang)*l
px2# = x + Cos(ang)*l
py2# = y + Sin(ang)*l
DrawBezierCurve3(0,100,px1#,py1#,x#,y#)
DrawBezierCurve3(x#,y#,px2#,py2#,800,500)
Line px1,py1,px2,py2
DrawScreen
Forever
Viiva piirretään funktioille annetujen pisteiden välille siten, että se kulkee ensimmäisen ja viimeisen pisteen kautta ja taipuu kohti muita pisteitä. DrawBezierCurve3 siis piirtää viivan (x1,y1):stä (x3,y3):een taivuttaen sitä (x2,y2):sta kohti ja DrawBezierCurve4 piirtää viivan (x1,y1):stä (x4,y4):een taivuttaen sitä (x2,y2):sta ja (x3,y3):sta kohti. Katsokaa esimerkki koodia, niin näette sen toimivan käytännössä.
-
- Moderator
- Posts: 1583
- Joined: Mon Aug 27, 2007 11:24 pm
- Location: Otaniemi - Mikkeli -pendelöinti
Re: Efektit
N:lle pisteelle toimiva olisi toki miellyttävämpi ratkaisu, eli esimerkiksi typestä haettaisiin pisteet ja piirrettäisiin niiden perusteella. Muistelen joskus toteuttaneenikin sellaisen CB:llä, eli ei pitäisi mahdotonta olla :)
Re: Efektit
Typeistä hakeminen == ei hyväkoodaaja wrote:N:lle pisteelle toimiva olisi toki miellyttävämpi ratkaisu, eli esimerkiksi typestä haettaisiin pisteet ja piirrettäisiin niiden perusteella. Muistelen joskus toteuttaneenikin sellaisen CB:llä, eli ei pitäisi mahdotonta olla
Mutta voinhan koittaa nopeasti sellaisenkin väsätä...
-
- Moderator
- Posts: 1583
- Joined: Mon Aug 27, 2007 11:24 pm
- Location: Otaniemi - Mikkeli -pendelöinti
Re: Efektit
Kas, olen pastennut sen näköjään tännekin, löytyy sivulta 14. Mutta mitä ehdottaisit typejen sijaan? Taulukot, memblockit ja merkkijonot menevät kaikki turhan säätämisen puolelle.
Re: Efektit
Minä pidin ajatuksesta, että ne tallennettasiin muistipaloihin, joten tein siitäkin koodin pätkän. Käytin muuten vähän koodia sinun versiostasi.koodaaja wrote:Kas, olen pastennut sen näköjään tännekin, löytyy sivulta 14. Mutta mitä ehdottaisit typejen sijaan? Taulukot, memblockit ja merkkijonot menevät kaikki turhan säätämisen puolelle.
Code: Select all
Global Accuracy
Accuracy = 10
Function MakeBezier(x#,y#)
mem = MakeMEMBlock(8)
PokeFloat mem,0,x
PokeFloat mem,4,y
Return mem
EndFunction
Function AddPoint(mem,x#,y#)
s = MEMBlockSize(mem)
ResizeMEMBlock mem,s+8
PokeFloat mem,s,x#
PokeFloat mem,s+4,y#
EndFunction
Function fact(a#)
ret# = 1
For i# = 2 To a
ret = ret * i
Next i#
Return ret
EndFunction
Function nCr(n#, i#)
Return fact(n)/(fact(i)*fact(n-i))
EndFunction
Function DrawBezierCurveN(mem)
lastX# = PeekFloat(mem,0)
lastY# = PeekFloat(mem,4)
points = MEMBlockSize(mem)/8-1
pointC = Accuracy*points-1
For i = 1 To pointC
x# = 0
y# = 0
t# = Float(i)/Float(pointC)
For i2 = 0 To points
B# = nCr(points, i2)*(t#^i2)*((1.0-t#)^(points-i2))
x# = x# + B#*PeekFloat(mem,i2*8)
y# = y# + B#*PeekFloat(mem,i2*8+4)
Next i2
Line lastX#,lastY#,x#,y#
lastX# = x#
lastY# = y#
Next i
Line lastX#,lastY#,PeekFloat(mem,points*8),PeekFloat(mem,points*8+4)
EndFunction
bezier = MakeBezier(200,150)
Repeat
If MouseHit(1) Then AddPoint(bezier,MouseX(),MouseY())
size = MEMBlockSize(bezier)
If MouseHit(2) And size > 8 Then
ResizeMEMBlock bezier,size-8
size - 8
EndIf
For i = 0 To size/8-1
Circle PeekFloat(bezier,i*8)-3,PeekFloat(bezier,i*8+4)-3,6,0
Next i
DrawBezierCurveN(bezier)
DrawScreen
Forever
- Misthema
- Advanced Member
- Posts: 312
- Joined: Mon Aug 27, 2007 8:32 pm
- Location: Turku, Finland
- Contact:
Re: Efektit
Löinpä sitten KilledWhale:n ASCII-metapallot ja Ruuttu:n Fluidize() -funkkarin yhteen. Tuli ihan kivan näkönen ehvekti:
Code: Select all
// Ascii metaballs made with CoolBasic
SCREEN 400, 400
sw = ScreenWidth()
sh = ScreenHeight()
Const Grid = 8
Global Fluidize_img
w = sw / 10
h = sh / 10
Const BALLS = 3
Type ball
Field x
Field y
Field r
Field mod1 As Float
Field mod2 As Float
EndType
For i = 1 To BALLS
b.ball = New(ball)
b\x = Rand(w)
b\y = Rand(h)
b\r = 15 + Rand(15)
b\mod1 = 1.5 - Rnd(1)
b\mod2 = 1.5 - Rnd(1)
Next i
Repeat
angle# = WrapAngle(angle# + 5)
For x = 0 To w
For y = 0 To h
n# = 0.0
For b.ball = Each ball
xx = x - b\x
yy = y - b\y
n# = n# + b\r / (((xx * xx) + (yy * yy)) * 1.1)
b\x = (w Shr 1) + (Sin(b\mod1 * (Timer() / 10)) * ((w - 10) Shr 1))
b\y = (h Shr 1) + (Cos(b\mod2 * (Timer() / 10)) * ((h - 10) Shr 1))
Next b
If n# < 0 Then
n# = 0
ElseIf n# > 1 Then
n# = 1
EndIf
Color n * 255, 0, n * 255
Text x * 10, y * 10, "@"
Next y
Next x
SetWindow "Ascii meatballs w/ Fluidize() | " + FPS()
Fluidize(angle,2,1)
DrawScreen OFF
Forever
Function Fluidize(ang#,amp#,id)
sw = ScreenWidth()
sh = ScreenHeight()
halfsw = sw / 2
halfsh = sh / 2
randscale = amp/3
If Fluidize_img = 0 Then
Fluidize_img = MakeImage(ScreenWidth(),ScreenHeight())
EndIf
For Y = 1 To sh Step Grid
For X = 1 To sw Step Grid
Select id
Case 1
targetx = x + Cos(x+ang)*amp + Rand(-randscale,randscale)
targety = y - Sin(y+ang)*amp + Rand(-randscale,randscale)
Case 2
targetx = x + Cos(x+ang)*amp
targety = y
Default
targetx = x + Cos(y+ang)*amp
targety = y + Cos(x+ang)*amp
End Select
CopyBox x,y,grid,grid,targetx,targety,SCREEN(),Image(Fluidize_img)
Next X
Next Y
DrawImage Fluidize_img,0,0
EndFunction
Re: Efektit
Hieno efekti vaikkakin ihailua hieman häiritsi se, että FPS oli 3...Misthema wrote:Löinpä sitten KilledWhale:n ASCII-metapallot ja Ruuttu:n Fluidize() -funkkarin yhteen. Tuli ihan kivan näkönen ehvekti:Code: Select all
// Ascii metaballs made with CoolBasic SCREEN 400, 400 sw = ScreenWidth() sh = ScreenHeight() Const Grid = 8 Global Fluidize_img w = sw / 10 h = sh / 10 Const BALLS = 3 Type ball Field x Field y Field r Field mod1 As Float Field mod2 As Float EndType For i = 1 To BALLS b.ball = New(ball) b\x = Rand(w) b\y = Rand(h) b\r = 15 + Rand(15) b\mod1 = 1.5 - Rnd(1) b\mod2 = 1.5 - Rnd(1) Next i Repeat angle# = WrapAngle(angle# + 5) For x = 0 To w For y = 0 To h n# = 0.0 For b.ball = Each ball xx = x - b\x yy = y - b\y n# = n# + b\r / (((xx * xx) + (yy * yy)) * 1.1) b\x = (w Shr 1) + (Sin(b\mod1 * (Timer() / 10)) * ((w - 10) Shr 1)) b\y = (h Shr 1) + (Cos(b\mod2 * (Timer() / 10)) * ((h - 10) Shr 1)) Next b If n# < 0 Then n# = 0 ElseIf n# > 1 Then n# = 1 EndIf Color n * 255, 0, n * 255 Text x * 10, y * 10, "@" Next y Next x SetWindow "Ascii meatballs w/ Fluidize() | " + FPS() Fluidize(angle,2,1) DrawScreen OFF Forever Function Fluidize(ang#,amp#,id) sw = ScreenWidth() sh = ScreenHeight() halfsw = sw / 2 halfsh = sh / 2 randscale = amp/3 If Fluidize_img = 0 Then Fluidize_img = MakeImage(ScreenWidth(),ScreenHeight()) EndIf For Y = 1 To sh Step Grid For X = 1 To sw Step Grid Select id Case 1 targetx = x + Cos(x+ang)*amp + Rand(-randscale,randscale) targety = y - Sin(y+ang)*amp + Rand(-randscale,randscale) Case 2 targetx = x + Cos(x+ang)*amp targety = y Default targetx = x + Cos(y+ang)*amp targety = y + Cos(x+ang)*amp End Select CopyBox x,y,grid,grid,targetx,targety,SCREEN(),Image(Fluidize_img) Next X Next Y DrawImage Fluidize_img,0,0 EndFunction
Re: Efektit
Tämä oli kyllä niin mahtava. Hieman pienimmillä pisteillä oli kans jännän näköistä (Text x * 10, y * 10, "@" -> Box x*10, y*10, 3, 3 ja sellasta)Misthema wrote:Löinpä sitten KilledWhale:n ASCII-metapallot ja Ruuttu:n Fluidize() -funkkarin yhteen. Tuli ihan kivan näkönen ehvekti:Code: Select all
// Ascii metaballs made with CoolBasic SCREEN 400, 400 sw = ScreenWidth() sh = ScreenHeight() Const Grid = 8 Global Fluidize_img w = sw / 10 h = sh / 10 Const BALLS = 3 Type ball Field x Field y Field r Field mod1 As Float Field mod2 As Float EndType For i = 1 To BALLS b.ball = New(ball) b\x = Rand(w) b\y = Rand(h) b\r = 15 + Rand(15) b\mod1 = 1.5 - Rnd(1) b\mod2 = 1.5 - Rnd(1) Next i Repeat angle# = WrapAngle(angle# + 5) For x = 0 To w For y = 0 To h n# = 0.0 For b.ball = Each ball xx = x - b\x yy = y - b\y n# = n# + b\r / (((xx * xx) + (yy * yy)) * 1.1) b\x = (w Shr 1) + (Sin(b\mod1 * (Timer() / 10)) * ((w - 10) Shr 1)) b\y = (h Shr 1) + (Cos(b\mod2 * (Timer() / 10)) * ((h - 10) Shr 1)) Next b If n# < 0 Then n# = 0 ElseIf n# > 1 Then n# = 1 EndIf Color n * 255, 0, n * 255 Text x * 10, y * 10, "@" Next y Next x SetWindow "Ascii meatballs w/ Fluidize() | " + FPS() Fluidize(angle,2,1) DrawScreen OFF Forever Function Fluidize(ang#,amp#,id) sw = ScreenWidth() sh = ScreenHeight() halfsw = sw / 2 halfsh = sh / 2 randscale = amp/3 If Fluidize_img = 0 Then Fluidize_img = MakeImage(ScreenWidth(),ScreenHeight()) EndIf For Y = 1 To sh Step Grid For X = 1 To sw Step Grid Select id Case 1 targetx = x + Cos(x+ang)*amp + Rand(-randscale,randscale) targety = y - Sin(y+ang)*amp + Rand(-randscale,randscale) Case 2 targetx = x + Cos(x+ang)*amp targety = y Default targetx = x + Cos(y+ang)*amp targety = y + Cos(x+ang)*amp End Select CopyBox x,y,grid,grid,targetx,targety,SCREEN(),Image(Fluidize_img) Next X Next Y DrawImage Fluidize_img,0,0 EndFunction
FPS oli siinä 20.
Re: Efektit
Waau miten nätti. FPS tasasesti 31.Misthema wrote:Löinpä sitten KilledWhale:n ASCII-metapallot ja Ruuttu:n Fluidize() -funkkarin yhteen. Tuli ihan kivan näkönen ehvekti:Code: Select all
// Ascii metaballs made with CoolBasic SCREEN 400, 400 sw = ScreenWidth() sh = ScreenHeight() Const Grid = 8 Global Fluidize_img w = sw / 10 h = sh / 10 Const BALLS = 3 Type ball Field x Field y Field r Field mod1 As Float Field mod2 As Float EndType For i = 1 To BALLS b.ball = New(ball) b\x = Rand(w) b\y = Rand(h) b\r = 15 + Rand(15) b\mod1 = 1.5 - Rnd(1) b\mod2 = 1.5 - Rnd(1) Next i Repeat angle# = WrapAngle(angle# + 5) For x = 0 To w For y = 0 To h n# = 0.0 For b.ball = Each ball xx = x - b\x yy = y - b\y n# = n# + b\r / (((xx * xx) + (yy * yy)) * 1.1) b\x = (w Shr 1) + (Sin(b\mod1 * (Timer() / 10)) * ((w - 10) Shr 1)) b\y = (h Shr 1) + (Cos(b\mod2 * (Timer() / 10)) * ((h - 10) Shr 1)) Next b If n# < 0 Then n# = 0 ElseIf n# > 1 Then n# = 1 EndIf Color n * 255, 0, n * 255 Text x * 10, y * 10, "@" Next y Next x SetWindow "Ascii meatballs w/ Fluidize() | " + FPS() Fluidize(angle,2,1) DrawScreen OFF Forever Function Fluidize(ang#,amp#,id) sw = ScreenWidth() sh = ScreenHeight() halfsw = sw / 2 halfsh = sh / 2 randscale = amp/3 If Fluidize_img = 0 Then Fluidize_img = MakeImage(ScreenWidth(),ScreenHeight()) EndIf For Y = 1 To sh Step Grid For X = 1 To sw Step Grid Select id Case 1 targetx = x + Cos(x+ang)*amp + Rand(-randscale,randscale) targety = y - Sin(y+ang)*amp + Rand(-randscale,randscale) Case 2 targetx = x + Cos(x+ang)*amp targety = y Default targetx = x + Cos(y+ang)*amp targety = y + Cos(x+ang)*amp End Select CopyBox x,y,grid,grid,targetx,targety,SCREEN(),Image(Fluidize_img) Next X Next Y DrawImage Fluidize_img,0,0 EndFunction
Re: Efektit
Makee on. Mulla ihan sama FPS, 31, ja hassusti tuntuu pyörivän siinä 31:n kohdalla vaikka esimerkiksi pienentäisi resoluutiota tai muuttaisi metapallojen määrän kolmesta yhteen. Mystistä.
Re: Efektit
Hassua muuten, että FPS oli minulla 3. Prosessorin yhdenkään ytimen käyttö ei ollut 70% enempää missään vaiheessa ja näytönohjaimen käyttö oli kokoajan 0%. Enkä oikein usko tuon ohjelman niin paljon kirjoittavan jatkuvasti muistiin, että RAM jarruttaisi. Mikäköhän on tulppana...
Re: Efektit
Minulla oli FPS epätasaisesti 0-2 (jos se vaihtelee ääretön prosenttia, niin silloin ei voida kai puhua kovin tasaisesta, vaikka se onkin vain kahden kokonaisluvun ero?)