Re: Efektit
Posted: Wed Apr 27, 2011 9:44 pm
Melkoinen viritelmä! Itsekin pohdin juuri eilen samanlaista. Olisi tosiaan mukava jos kartta voisi pyöriä muunkin kuin oman origonsa ympäri.
Page 24 of 34
Re: Efektit
Posted: Wed Apr 27, 2011 10:23 pm
eikö cb.ssä ollut komento, jolla objektin origoa pystyi siirtämään? Vai onko se vain liian raskas
Re: Efektit
Posted: Wed Apr 27, 2011 10:31 pm
Eihän kuvia voida säätää objektikomennoilla. Ja itseasiassa, muuttuva origo olisi helppo tuohon tehdä, en vain ainakaan itse jaksa ruveta säätämään. 
Re: Efektit
Posted: Wed Apr 27, 2011 10:37 pm
aivan, karttahan oli kuvista koostuva.. Eipä siinä sitten, itse en keksi väsyneenä miten sen toteuttaisi
Re: Efektit
Posted: Mon May 02, 2011 1:37 am
Olen jo hetken aikaa halunnut tehdä yhden CPC-demon, Batman Foreverin (videokaappaus) efektin mukaisen semi-3d-siluettikaupungin. Tänään sattui sitten sopivan tylsä ilta ja mukava koodausvire niin sain sen jopa toteutettua. Tuskin tämä esikuvansa veroinen on, mutta hauska sitä oli viritellä :)
Code: Select all
SCREEN 640,480
Randomize 3
Dim h(4,4,6) As Float
For i = 0 To 4
For j = 0 To 4
h(i,j,1)=.15*Rnd(-1,1)+.45*(-2+i)
h(i,j,2)=.15*Rnd(-1,1)+.45*(-2+j)
h(i,j,0)=3.8*Rnd(1,16)/(2+Distance(h(i,j,1),h(i,j,2),0,0))
Next j
Next i
For i = 0 To i+1
ClsColor 180,120,60
sini# = Sin(30+360*Sin(i/10.0)^2)
cosi# = Cos(30+360*Sin(i/10.0)^2)
Color 0,0,0
Box 0,460,640,20
Lock
For j = 0 To 4
For k = 0 To 4
px1# = (h(j,k,1)+.08)*cosi+(h(j,k,2)+.08)*sini
pz1# =10-(h(j,k,1)+.08)*sini+(h(j,k,2)+.08)*cosi
px2# = (h(j,k,1)-.08)*cosi+(h(j,k,2)+.08)*sini
pz2# =10-(h(j,k,1)-.08)*sini+(h(j,k,2)+.08)*cosi
px3# = (h(j,k,1)-.08)*cosi+(h(j,k,2)-.08)*sini
pz3# =10-(h(j,k,1)-.08)*sini+(h(j,k,2)-.08)*cosi
px4# = (h(j,k,1)+.08)*cosi+(h(j,k,2)-.08)*sini
pz4# =10-(h(j,k,1)+.08)*sini+(h(j,k,2)-.08)*cosi
psx1#=px1/pz1
psx2#=px2/pz2
psx3#=px3/pz3
psx4#=px4/pz4
px#=px1:pz#=pz1
If psx2<psx3 And psx2<psx1 And psx2<psx4 Then px#=px2:pz#=pz2
If psx3<psx2 And psx3<psx4 And psx3<psx1 Then px#=px3:pz#=pz3
If psx4<psx2 And psx4<psx3 And psx4<psx1 Then px#=px4:pz#=pz4
pxy#=px1:pzy#=pz1
If psx2>psx3 And psx2>psx1 And psx2>psx4 Then pxy#=px2:pzy#=pz2
If psx3>psx2 And psx3>psx4 And psx3>psx1 Then pxy#=px3:pzy#=pz3
If psx4>psx2 And psx4>psx3 And psx4>psx1 Then pxy#=px4:pzy#=pz4
h2#=1500*h(j,k,0)/(Min(pz,pzy)^2)
h(j,k,3)=320+px/pz*1800
h(j,k,4)=480-h2
h(j,k,5)=1800*(pxy/pzy-px/pz)
h(j,k,6)=h2-20
pxx1#=Min(Max(Min(px1,px2),Min(px3,px4)),Min(Max(px1,px2),Max(px3,px4)))
pzz1#=pz1
If pxx1=px2 Then pzz1=pz2
If pxx1=px3 Then pzz1=pz3
If pxx1=px4 Then pzz1=pz4
pxx2#=Max(Max(Min(px1,px2),Min(px3,px4)),Min(Max(px1,px2),Max(px3,px4)))
pzz2#=pz1
If pxx2=px2 Then pzz2=pz2
If pxx2=px3 Then pzz2=pz3
If pxx2=px4 Then pzz2=pz4
If pzz2<pzz1 Then pzz#=pzz2:pxx#=pxx2 Else pzz=pzz1:pxx=pxx1
ry#=480-1500*h(j,k,0)/pzz^2
If(RoundUp(ry)<RoundDown(h(j,k,4)))
rx1#=320+pxx/pzz*1800
rx2#=rx1
s1# = (rx1-h(j,k,3))/(ry-h(j,k,4))
s2# = (rx2-h(j,k,3)-h(j,k,5)+1)/(ry-h(j,k,4))
For t = ry To h(j,k,4)
rx1 = Max(h(j,k,3),Min(h(j,k,3)+h(j,k,5),rx1+s1))
rx2 = Max(h(j,k,3),Min(h(j,k,3)+h(j,k,5),rx2+s2))
Line rx1,t,rx2,t
Next t
EndIf
Next k
Next j
Color 0,0,0
Unlock
For j = 0 To 4
For k = 0 To 4
Box h(j,k,3),h(j,k,4),h(j,k,5)+1,h(j,k,6)
Next k
Next j
Color 255,255,255
Text 10,10,Str(FPS())
DrawScreen
Next iRe: Efektit
Posted: Mon May 02, 2011 11:35 am
Todella hieno! Coolbasic muka hidas...koodaaja wrote:Olen jo hetken aikaa halunnut tehdä yhden CPC-demon, Batman Foreverin (videokaappaus) efektin mukaisen semi-3d-siluettikaupungin. Tänään sattui sitten sopivan tylsä ilta ja mukava koodausvire niin sain sen jopa toteutettua. Tuskin tämä esikuvansa veroinen on, mutta hauska sitä oli viritellä
Code: Select all
Uskomaton koodin pätkä..
Re: Efektit
Posted: Mon May 02, 2011 3:14 pm
Argumenttisi on invaliidi. CB ei ole ollut moderneilla tietokoneilla vuosiin absoluuttisen hidas.ukkeli wrote:Todella hieno! Coolbasic muka hidas...
Re: Efektit
Posted: Mon May 02, 2011 6:22 pm
On kyllä pirun hieno!koodaaja wrote:Olen jo hetken aikaa halunnut tehdä yhden CPC-demon, Batman Foreverin (videokaappaus) efektin mukaisen semi-3d-siluettikaupungin. Tänään sattui sitten sopivan tylsä ilta ja mukava koodausvire niin sain sen jopa toteutettua. Tuskin tämä esikuvansa veroinen on, mutta hauska sitä oli viritellä
Ei kyllä hidastellut minun vm. 2005 Media Centterillä! 
Otinpa oikeuden omiin käsiini, syntyi tämmöinen, hiukan imo. cooleempi.
Code: Select all
SCREEN 640,480
Randomize 3
Dim h(4,4,6) As Float
For i = 0 To 4
For j = 0 To 4
h(i,j,1)=.15*Rnd(-1,1)+.45*(-2+i)
h(i,j,2)=.15*Rnd(-1,1)+.45*(-2+j)
h(i,j,0)=3.8*Rnd(1,16)/(2+Distance(h(i,j,1),h(i,j,2),0,0))
Next j
Next i
SW = ScreenWidth() : SH = ScreenHeight()
img = MakeImage(SW, SH)
DrawToImage img
For i = 0 To SH
Color 255, 255.0/SH*i, 0
Box 0, i, SW, 1
Next i
DrawToScreen
For i = 0 To i+1
DrawImage img, 0, 0
sini# = Sin(30+360*Sin(i/10.0)^2)
cosi# = Cos(30+360*Sin(i/10.0)^2)
Color 0,0,0
Box 0,460,640,20
Lock
For j = 0 To 4
For k = 0 To 4
px1# = (h(j,k,1)+.08)*cosi+(h(j,k,2)+.08)*sini
pz1# =10-(h(j,k,1)+.08)*sini+(h(j,k,2)+.08)*cosi
px2# = (h(j,k,1)-.08)*cosi+(h(j,k,2)+.08)*sini
pz2# =10-(h(j,k,1)-.08)*sini+(h(j,k,2)+.08)*cosi
px3# = (h(j,k,1)-.08)*cosi+(h(j,k,2)-.08)*sini
pz3# =10-(h(j,k,1)-.08)*sini+(h(j,k,2)-.08)*cosi
px4# = (h(j,k,1)+.08)*cosi+(h(j,k,2)-.08)*sini
pz4# =10-(h(j,k,1)+.08)*sini+(h(j,k,2)-.08)*cosi
psx1#=px1/pz1
psx2#=px2/pz2
psx3#=px3/pz3
psx4#=px4/pz4
px#=px1:pz#=pz1
If psx2<psx3 And psx2<psx1 And psx2<psx4 Then px#=px2:pz#=pz2
If psx3<psx2 And psx3<psx4 And psx3<psx1 Then px#=px3:pz#=pz3
If psx4<psx2 And psx4<psx3 And psx4<psx1 Then px#=px4:pz#=pz4
pxy#=px1:pzy#=pz1
If psx2>psx3 And psx2>psx1 And psx2>psx4 Then pxy#=px2:pzy#=pz2
If psx3>psx2 And psx3>psx4 And psx3>psx1 Then pxy#=px3:pzy#=pz3
If psx4>psx2 And psx4>psx3 And psx4>psx1 Then pxy#=px4:pzy#=pz4
h2#=1500*h(j,k,0)/(Min(pz,pzy)^2)
h(j,k,3)=320+px/pz*1800
h(j,k,4)=480-h2
h(j,k,5)=1800*(pxy/pzy-px/pz)
h(j,k,6)=h2-20
pxx1#=Min(Max(Min(px1,px2),Min(px3,px4)),Min(Max(px1,px2),Max(px3,px4)))
pzz1#=pz1
If pxx1=px2 Then pzz1=pz2
If pxx1=px3 Then pzz1=pz3
If pxx1=px4 Then pzz1=pz4
pxx2#=Max(Max(Min(px1,px2),Min(px3,px4)),Min(Max(px1,px2),Max(px3,px4)))
pzz2#=pz1
If pxx2=px2 Then pzz2=pz2
If pxx2=px3 Then pzz2=pz3
If pxx2=px4 Then pzz2=pz4
If pzz2<pzz1 Then pzz#=pzz2:pxx#=pxx2 Else pzz=pzz1:pxx=pxx1
ry#=480-1500*h(j,k,0)/pzz^2
If(RoundUp(ry)<RoundDown(h(j,k,4)))
rx1#=320+pxx/pzz*1800
rx2#=rx1
s1# = (rx1-h(j,k,3))/(ry-h(j,k,4))
s2# = (rx2-h(j,k,3)-h(j,k,5)+1)/(ry-h(j,k,4))
For t = ry To h(j,k,4)
rx1 = Max(h(j,k,3),Min(h(j,k,3)+h(j,k,5),rx1+s1))
rx2 = Max(h(j,k,3),Min(h(j,k,3)+h(j,k,5),rx2+s2))
Line rx1,t,rx2,t
Next t
EndIf
Next k
Next j
Color 0,0,0
Unlock
For j = 0 To 4
For k = 0 To 4
Box h(j,k,3),h(j,k,4),h(j,k,5)+1,h(j,k,6)
Next k
Next j
Color 255,255,255
Text 10,10,Str(FPS())
DrawScreen
Next iRe: Efektit
Posted: Sun May 08, 2011 6:26 pm
Teinpäs sateen. Saa käyttää vapaasti, mutta minun pitää olla tekijöissä. Ja, tämä on ensiefekti eli ei mikään paras...
Code: Select all
'Epic rain engine by ukkeli\white.. ..in 2011!!!
Type dotrain
Field Elämä
Field Leveli
End Type
Repeat
Color 0,0,255
If Timer()>aika+1 Then
aika=Timer()
do.dotrain=New(dotrain)
do\Elämä=40
do\Leveli=Rand(1,600)
Dot do\Leveli,do\Elämä
pis+1
End If
Text 20,20,"Pisaroita: "+pis
Text 20,40,"Fps: "+FPS()
If pis>100 Then pis=pis-1
For do.dotrain = Each dotrain
Dot do\Leveli,do\Elämä
do\Elämä+4
Next do
DrawScreen
Forever
Re: Efektit
Posted: Sun May 08, 2011 8:59 pm
Teinpä sade-efektin minäkin, ei tarvitse mainita tekijöissänsä ellei välttämättä halua ;)
MaGetzUb; itse ajattelin jotain auringonlaskusta otettua valokuvaa taustalle, mutta ei ole tuokaan huono ratkaisu :)
Code: Select all
For i = 0 To i+1
If i = 0 Then Color 0,0,255 Else Text 10,10,Str(FPS())
If (i Mod 300) = 0 Then DrawScreen Else Dot 400*(1284.19*Sin(1249.1+2479.7*(i Mod 300))-RoundDown(Sin(1284.19*Sin(1249.1+2479.7*(i Mod 300))))) Mod 400, ((i Mod 300)+Timer()/5) Mod 300
Next iRe: Efektit
Posted: Sun May 08, 2011 11:07 pm
Toteuttaisin itse sateen näin:
Code: Select all
imgsade = MakeImage(256, 256)
DrawToImage imgsade
For i = 0 To 100
Color 128, 128, 128
Dot Rand(256), Rand(256)
Next i
DrawToScreen
Repeat
rain_y# = rain_y#+6
catchy=RoundDown(1.0*-rain_y#/ImageHeight(imgsade))
sty=rain_y#+catchy*ImageHeight(imgsade)
y=sty
While y<ScreenHeight()
For x = 0 To ScreenWidth() / ImageWidth(imgsade)
DrawImage imgsade,x*ImageWidth(imgsade),y
Next x
y=y+ImageHeight(imgsade)
Wend
DrawScreen
Forever Re: Efektit
Posted: Sun May 08, 2011 11:20 pm
On kyllä vähän turhan nopea sade mun makuun. Pisarat menee reilusti ylinopeutta.MaGetzUb wrote:Toteuttaisin itse sateen näin:Code: Select all
imgsade = MakeImage(256, 256) DrawToImage imgsade For i = 0 To 100 Color 128, 128, 128 Dot Rand(256), Rand(256) Next i DrawToScreen Repeat rain_y# = rain_y#+6 catchy=RoundDown(1.0*-rain_y#/ImageHeight(imgsade)) sty=rain_y#+catchy*ImageHeight(imgsade) y=sty While y<ScreenHeight() For x = 0 To ScreenWidth() / ImageWidth(imgsade) DrawImage imgsade,x*ImageWidth(imgsade),y Next x y=y+ImageHeight(imgsade) Wend DrawScreen Forever
Re: Efektit
Posted: Mon May 09, 2011 3:18 pm
Tässä teille sade
Code: Select all
a=100
img=MakeImage(400,300)
DrawToImage img
For i=0 To 127
Color 0+i*2,0+i*3/4,0
Line 0,127+i,400,127+i
Next i
Color cbgold
Box 0,255,400,45
Color cbdarkblue
Box 0,240,400,15
///////
Color cbsilver
Circle 0+a,30,30
Circle 15+a,20,40
Circle 35+a,20,40
Circle 60+a,30,30
///////////////
Color cbblue
Ellipse a-10,260,110,25
//////////
DrawToScreen
Type pisarat
Field x
Field y
Field g
Field b
Field nopeus
EndType
Repeat
DrawImage img,0,0
pis.pisarat=New(pisarat)
pis\y=55
pis\x=Rand(a,a+90)
pis\g=Rand(0,200)
pis\b=Rand(150,255)
pis\nopeus=Rand(4,7)
For pis.pisarat = Each pisarat
If pis\y<265 Then
pis\y+pis\nopeus
Color 0,pis\g,pis\b
Box pis\x,pis\y,2,6
//Line pis\x,pis\y,pis\x,pis\y+5
EndIf
Next pis
DrawScreen
Forever
Re: Efektit
Posted: Mon May 09, 2011 10:11 pm
Tässäpä tämän illan värkkäilyn tulos: Voronoi-noisea, 3-ulotteisesti (josta kolmantena aika - ei kuitenkaan kiistellä tästä). Eli siis koodi tuottaa reaaliajassa animoitua voronoi-noisea, jota mahdollisesti zoomataan (venyttämällä ikkunaa), ladotaan vierekkäin (tile) ja tallennetaan GIF-animaatioksi (vaatii laatimani funktion). Pitemmittä puheitta:
Koodin alussa on määritelty pitkälti kaikki tarvittavat vakiot, voit muutella niitä halutessasi. Enteriä painamalla voi muuttaa etäisyyden laskentakaavaa (tosin jotkin moodit vaativat usein muutoksen DistanceFactor-vakioon näyttääkseen hyvältä). Kokeile esim. vaihtaa InitBrightness 255:een ja DistanceFactor negatiiviseksi).
Tässä vielä maistiaiset:
Code: Select all
//Voronoi noise by aXu
Const PointCount = 20 //Kuinka monta solua tehdään (enemmän raskaampi, pienemmät solut)
Const InitBrightness = 0 //Mitä lähempänä solun keskustaa, sitä lähempänä tätä kirkkautta
Const DistanceFactor = 10 //Tällä määritellään kuinka nopeasti tummenee/vaalenee poistuttaessa solun keskustasta (neg. tummenee)
MaxDistance = Abs(255 / DistanceFactor) //Maksimietäisyys, muuttamalla tätä voit määritellä missä kohtaa tummeneminen/vaaleneminen loppuu
Const Tiles = 1.3 //Kuinka monta tileä näkyy (yhdellä akselilla)
Const Zoom = 5 //Kuinka zoomattu ikkuna
Const ScreenW = 50 //Kuvan leveys
Const ScreenH = 50 //Kuvan korkeus
Const ScreenD = 100 //Framejen määrä
SCREEN RoundUp(ScreenW * Tiles * Zoom), RoundUp(ScreenH * Tiles * Zoom)
SCREEN RoundUp(ScreenW * Tiles), RoundUp(ScreenH * Tiles), 0, 2
PositionCamera ScreenWidth() / 2, -ScreenHeight() / 2
'Include "cbGIF.CB" //Animaation tallennusta varten (vaatii GIF-tallennusfunktion)
'Anim = MakeImage(RoundUp(ScreenW * Tiles) * ScreenD, RoundUp(ScreenH * Tiles))
Type Point
Field X#
Field Y#
Field Z#
End Type
For i = 1 To PointCount //Luodaan pisteet
nP.Point = New(Point)
nP\X = Rand(ScreenW - 1)
nP\Y = Rand(ScreenH - 1)
nP\Z = Rand(ScreenD - 1)
Next i
Repeat
SetWindow "Frame: " + Z + " FPS: " + FPS()
Lock
For X = 0 To ScreenW - 1
For Y = 0 To ScreenH - 1
Dist = MaxDistance
For iP.Point = Each Point
//Jos Tiles = 1 niin voit kommentoida X:n ja Y:n kohdalta jälkimmäiset laskut (lisää nopeutta jonkin verran)
XDif = Abs(X - iP\X) : XDif = XDif - (XDif > ScreenW/2) * ScreenW
YDif = Abs(Y - iP\Y) : YDif = YDif - (YDif > ScreenH/2) * ScreenH
ZDif = Abs(Z - iP\Z) : ZDif = ZDif - (ZDif > ScreenD/2) * ScreenD
Select Mode
Case 0
Dist = Min(Dist, Sqrt(XDif*XDif + YDif*YDif + ZDif*ZDif)) //Etäisyydet lasketaan pytaghoraan lauseella
Case 1
Dist = Min(Dist, Abs(XDif) + Abs(YDif) + Abs(ZDif)) //"Taksikuskin etäisyys", kaikista nopein, tuottaa vinoneliöitä
Case 2
Dist = Min(Dist, XDif*XDif + YDif*YDif + ZDif*ZDif) //Vaihtoehtoinen ja nopeampi laskutapa jättää neliöjuuren ottamatta (vaatii huomattavasti pienemmän DistanceFactorin)
Case 3
Dist = Min(Dist, Abs(XDif*XDif*XDif) + Abs(YDif*YDif*YDif) + Abs(ZDif*ZDif*ZDif)) //Neliön sijaan otetaan kuutio, tuottaa "läskistyneitä" neliöitä (vaatii HUOMATTAVASTI pienemmän DistanceFactorin)
End Select
Next iP
Dist = InitBrightness + Dist * DistanceFactor
PutPixel2 X, Y, Dist * 65793 + (255 * 16777216)
Next Y
Next X
Unlock
For i = 1 To RoundUp(Tiles) - 1
CopyBox 0, 0, ScreenW, ScreenH, ScreenW * i, 0, SCREEN(), SCREEN()
Next i
For i = 1 To RoundUp(Tiles) - 1
CopyBox 0, 0, RoundUp(ScreenW * Tiles), ScreenH, 0, ScreenH * i, SCREEN(), SCREEN()
Next i
' CopyBox 0, 0, RoundUp(ScreenW * Tiles), RoundUp(ScreenH * Tiles), RoundUp(ScreenW * Tiles) * Z, 0, SCREEN(), Image(Anim)
' If Z = ScreenD - 1 Then Exit //Animaation tallennusta varten (vaatii GIF-tallennusfunktion)
If KeyHit(28) Then Mode = (Mode + 1) Mod 4
DrawScreen
Z = (Z + 1) Mod ScreenD //Vaihdetaan animaatioframe (eli siirretään läpileikkauksen paikkaa eteenpäin)
Forever
//Animaation tallennusta varten (vaatii GIF-tallennusfunktion)
'SaveGIF(Anim, "Voronoi.GIF", -1, 0, 0, RoundUp(ScreenW * Tiles), RoundUp(ScreenH * Tiles), ScreenD, 5)
Tässä vielä maistiaiset:
- Efekti ei tuota kuvaa tällä FPS:llä :D
- Voronoi.GIF (579.85 KiB) Viewed 10447 times
Re: Efektit
Posted: Tue May 10, 2011 5:39 am
Kappas, varsin komeaa menoa! Hieman hidasta, mutta se nyt on CB:llä väistämätöntä.Systeemiä voi jonkin verran nopeuttaa pistemäärän kasvaessakin käyttämällä gridiä, jossa jokaisessa kuutiossa on vain yksi piste. Näin etäisyyksiä ei tarvitse hakea kuin yhdeksään pisteeseen.
Ensimmäistä kertää tosin kuulen Voronoin joukon visualisaatioita minkään maailman noiseksi kutsuttavan ;) Solutekstuuri on ihan ulkonäön vuoksi varmaankin eniten käytetty termi. Kannattaa kokeilla myös värjäillä soluja kuvien perusteella eli katsot mikä väri kuvassa on pisteen kohdalla, värjäät kyseisen solun kokonaan samalla värillä. Vähän suuremmalla pistemäärällä tulee varsin mainioita kuvia.
Ensimmäistä kertää tosin kuulen Voronoin joukon visualisaatioita minkään maailman noiseksi kutsuttavan ;) Solutekstuuri on ihan ulkonäön vuoksi varmaankin eniten käytetty termi. Kannattaa kokeilla myös värjäillä soluja kuvien perusteella eli katsot mikä väri kuvassa on pisteen kohdalla, värjäät kyseisen solun kokonaan samalla värillä. Vähän suuremmalla pistemäärällä tulee varsin mainioita kuvia.
Re: Efektit
Posted: Tue May 10, 2011 2:02 pm
Tuo nopeutus kävi itsellänikin mielessä, mutta hieman erilaisena: Jos jokaiseen kuutioon tulee yksi piste, se ei näytä niin sattumanvaraiselta. Siksi ajattelin sellaista systeemiä, että ensin luodaan pisteet ja sitten lajitellaan ne kuutioiden sisälle (eli kuutioon voi tulla useampi tai ei yhtään pistettä). Systeemi epäonnistuu vain siinä tapauksessa, että missään näistä yhdeksästä laatikosta ei ole pistettä, mutta silloin voidaan toki laajentaa etsintää pykälän ulospäin. Ja pistettä 3-uloitteisessa avaruudessa ympäröi 27 laatikkoa eikä 9 ja tämän takia en sitä ruvennut tekemään, koska tuo 27 on enemmän kuin tuo oletusarvo 20, joka sekin toimii hitaahkosti.koodaaja wrote:Kappas, varsin komeaa menoa! Hieman hidasta, mutta se nyt on CB:llä väistämätöntä.Systeemiä voi jonkin verran nopeuttaa pistemäärän kasvaessakin käyttämällä gridiä, jossa jokaisessa kuutiossa on vain yksi piste. Näin etäisyyksiä ei tarvitse hakea kuin yhdeksään pisteeseen.
Ensimmäistä kertää tosin kuulen Voronoin joukon visualisaatioita minkään maailman noiseksi kutsuttavanSolutekstuuri on ihan ulkonäön vuoksi varmaankin eniten käytetty termi. Kannattaa kokeilla myös värjäillä soluja kuvien perusteella eli katsot mikä väri kuvassa on pisteen kohdalla, värjäät kyseisen solun kokonaan samalla värillä. Vähän suuremmalla pistemäärällä tulee varsin mainioita kuvia.
Mitä tuohon nimeen tulee, olet osittain oikeassa (tai ehkäpä täysin
). Näyttää siltä, että tätä kutsutaan myös nimellä Worley noise tai cellular noise, mutta ei tosiaankaan Voronoi noise 
Katsotaan josko tästä joskus värillisen, optimoidumman version saisi aikaan, mutta tällä hetkellä koulu painaa pahasti päälle.
EDIT:
Nyt kun tarkemmin ajattelee, ei tarkasteltavia kuutioita olekaan enempää kuin 8, kun eliminoi tarkasteltavaa pistettä kauempana olevat kuutiot. Eli seuraavaan tyyliin (yksinkertaisemmin 2D):
Code: Select all
Alkutilanne:
-------------
| | | |
| | | |
-------------
| | | |
| | | |
-------------
| | | |
| | | |
-------------
Tarkastellaan vain neljää kuutiota, renderöitävä piste +, "turhat" kuutiot rastitettu:
-------------
| | |XXX|
| | |XXX|
-------------
| |+ |XXX|
| | |XXX|
-------------
|XXX|XXX|XXX|
|XXX|XXX|XXX|
-------------
Re: Efektit
Posted: Tue May 10, 2011 7:51 pm
Testailin vähäsen kuvapaletilla toimivia metapalloja, ihan mukaviahan niistä tulee, en jaksanut vain animoida.
Jaksoin kerrankin kommentoida! FTW\o/ or not..
Jaksoin kerrankin kommentoida! FTW\o/ or not..
Code: Select all
//Yhden värillisen laatikon koot GW x GH;
Const GW = 5
Const GH = 5
//Ruudun koko ScrW x ScrH
Const ScrW = 300
Const ScrH = 300
SCREEN ScrW, ScrH
//Määritellään pysty ja vaakariveille laatikoiden määrä muutujat.
Dim BoxesX As Integer, BoxesY As Integer
//Lasketaan montako 5pix laatikkoa mahtuu vaaka ja pystyriveille ruudussa.
BoxesX = Int(ScrW/GW)
BoxesY = Int(ScrH/GW)
//Tehdään meta -taulukko, jotta siihen voitaisiin tallentaa desimaaliarvoja 0 - 1 väliltä.
Dim Meta(BoxesX, BoxesY) As Float
//<paletti>
//Luodaan 512pix leveä ja 1pix korkea kuva
palette = MakeImage(512, 1)
//Asetetaan palette kuva piirtopuskuriksi
DrawToImage palette
//Läpikäydään kuva vain 255 kertaa
For i = 0 To 255
//Piirretään mustan ja punaisen väliset pisteet
Color i, 0, 0
Dot i, 0
//Piirretään punaisen ja valkoisen välillä olevat pisteet
Color 255, i, i
Dot 255+i, 0
//Läpikäynti loppuu
Next i
//Asetetaan näyttö piirtopuskuriksi
DrawToScreen
//</paletti>
bx = 12
by = 15
Repeat
//Lasketaan hiiren koordinaatit
Mx = (MouseX() / GW)
My = (MouseY() / GH)
//Lukitaan paletti värin napsimisen vuoksi
Lock Image(palette)
//Lähdetään silmukoilla lukemaan ja kirjoittamaan Meta -taulukkoon.
For x = 0 To BoxesX
For y = 0 To BoxesY
//Nollataan Meta -taulukon arvo, aina ettei ruutu vain "kirkastuisi"
Meta(x, y) = 0
//Lasketaan nyt meta-arvolle etäisyydenmukaan jokuarvo väliltä: 0 - äärettömyys
//Mitä lähempänä x ja y ovat hiiren koordinaatteja, sitä enemmän numero on.
Meta(x, y) = Meta(x, y) + 30.0/((bx - x)(bx - x)+(by - y)(by - y))
Meta(x, y) = Meta(x, y) + 10.0/((Mx - x)(Mx - x)+(My - y)(My - y))
//Rajoitetaan arvoi kuitenkin yhden paikkeilla;
Meta(x, y) = Min(Meta(x, y), 1)
//Poimitaan väri kuvasta;
Color 0, 0, GetPixel2(Int(Meta(x, y)*510), 0, Image(palette))
//Piirretään
Box x*GW, y*GH, GW, GH
Next y
Next x
Unlock Image(palette)
DrawScreen
ForeverRe: Efektit
Posted: Tue May 10, 2011 10:12 pm
Tuostapa tuli mieleen, että access errorin lopun plasma lähti yksinkertaisesta metapallokokeilusta, jota en täällä tainnut julkaista.
Code: Select all
SCREEN 640, 480
Const detail = 10
Dim msq(63,5)
For i = 0 To 63
j = i
If j>31 Then j = j - 32:msq(i,5)=1
If j>15 Then j = j - 16:msq(i,4)=1
If j>7 Then j = j - 8:msq(i,3)=1
If j>3 Then j = j - 4:msq(i,2)=1
If j>1 Then j = j - 2:msq(i,1)=1
If j>0 Then msq(i,0)=1
Next i
set$ = "0 1 2 16 4 5 32 8 8 32 10 4 16 2 1 0"
Dim seta(15)
For i = 0 To 15
seta(i) = GetWord(set, i+1)
Next i
posxd = RoundDown(ScreenWidth()/detail)
posyd = RoundDown(ScreenHeight()/detail)
Dim pos(posxd, posyd) As Float
balls = 6
Dim ball(balls, 4) As Float
For i = 0 To balls
ball(i,0) = Rnd(60, 600)
ball(i,1) = Rnd(60, 440)
ball(i,2) = Rnd(-4, 4)
ball(i,3) = Rnd(-4, 4)
ball(i,4) = Rnd(1000, 1700)
Next i
Repeat
ang = ang + 2
zloc# = zloc - .8
For i = 0 To balls
ball(i,0) = ball(i,0) + ball(i,2)
ball(i,1) = ball(i,1) + ball(i,3)
If ball(i,0)>600 Then ball(i,2) = ball(i,2)-.4
If ball(i,0)<60 Then ball(i,2) = ball(i,2)+.4
If ball(i,1)>440 Then ball(i,3) = ball(i,3)-.4
If ball(i,1)<60 Then ball(i,3) = ball(i,3)+.4
Next i
For i = 0 To posxd
For j = 0 To posyd
d# = .0
For k = 0 To balls
d = d + ball(k,4)/((ball(k,0)-i*detail)*(ball(k,0)-i*detail)+(ball(k,1)-j*detail)*(ball(k,1)-j*detail))
Next k
pos(i,j) = -Abs(1-d)*15+10
Next j
Next i
Lock
Color 200, 200, 200
For i = 0 To posxd-1
For j = 0 To posyd-1
c1# = pos(i,j)
c2# = pos(i+1,j)
c3# = pos(i+1,j+1)
c4# = pos(i,j+1)
k = seta(Int(c1<0)+2*(c2<0)+4*(c3<0)+8*(c4<0))
sm1# = Abs(c1)/(Abs(c2)+Abs(c1))
sm2# = Abs(c2)/(Abs(c3)+Abs(c2))
sm3# = 1-Abs(c3)/(Abs(c4)+Abs(c3))
sm4# = 1-Abs(c4)/(Abs(c1)+Abs(c4))
If msq(k,0) Then Line (i+sm1)*detail, j*detail, i*detail, (j+sm4)*detail
If msq(k,1) Then Line (i+sm1)*detail, j*detail, (i+1)*detail, (j+sm2)*detail
If msq(k,2) Then Line (i+sm3)*detail, (j+1)*detail, (i+1)*detail, (j+sm2)*detail
If msq(k,3) Then Line (i+sm3)*detail, (j+1)*detail, i*detail, (j+sm4)*detail
If msq(k,4) Then Line i*detail, (j+sm4)*detail, (i+1)*detail, (j+sm2)*detail
If msq(k,5) Then Line (i+sm1)*detail, j*detail, (i+sm3)*detail, (j+1)*detail
Next j
Next i
Unlock
Text 10, 10, Str(FPS())
DrawScreen
ForeverRe: Efektit
Posted: Tue May 10, 2011 11:25 pm
koodaaja wrote:Tuostapa tuli mieleen, että access errorin lopun plasma lähti yksinkertaisesta metapallokokeilusta, jota en täällä tainnut julkaista.
Code: Select all
Jotain solujen/liman näköistä jutskaa.[/quote] En tiedä kyllä, mitä tuo esittää, mutta h******n hieno se ainakin on. :)
Re: Efektit
Posted: Tue May 10, 2011 11:28 pm
Tuota voisi kuvailla metapallojen korkeuskäyräksi.MaGetzUb wrote: En tiedä kyllä, mitä tuo esittää, mutta h******n hieno se ainakin on.