Efektit

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
User avatar
CCE
Artist
Artist
Posts: 650
Joined: Mon Aug 27, 2007 9:53 pm

Re: Efektit

Post by CCE » 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.

User avatar
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Efektit

Post by Wingman » 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
- - - -

User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post by MaGetzUb » 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. :)
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Efektit

Post by Wingman » Wed Apr 27, 2011 10:37 pm

aivan, karttahan oli kuvista koostuva.. Eipä siinä sitten, itse en keksi väsyneenä miten sen toteuttaisi
- - - -

User avatar
koodaaja
Moderator
Moderator
Posts: 1583
Joined: Mon Aug 27, 2007 11:24 pm
Location: Otaniemi - Mikkeli -pendelöinti

Re: Efektit

Post by koodaaja » 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 i

User avatar
ukkeli
Active Member
Posts: 123
Joined: Thu Jan 28, 2010 10:01 pm

Re: Efektit

Post by ukkeli » Mon May 02, 2011 11:35 am

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ä..
Todella hieno! Coolbasic muka hidas...
...

User avatar
esa94
Guru
Posts: 1855
Joined: Tue Sep 04, 2007 5:35 pm

Re: Efektit

Post by esa94 » Mon May 02, 2011 3:14 pm

ukkeli wrote:Todella hieno! Coolbasic muka hidas...
Argumenttisi on invaliidi. CB ei ole ollut moderneilla tietokoneilla vuosiin absoluuttisen hidas.

User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post by MaGetzUb » Mon May 02, 2011 6:22 pm

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ä :)
On kyllä pirun hieno! :) Ei kyllä hidastellut minun vm. 2005 Media Centterillä! :D

Otinpa oikeuden omiin käsiini, syntyi tämmöinen, hiukan imo. cooleempi. 8-)

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 i
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
ukkeli
Active Member
Posts: 123
Joined: Thu Jan 28, 2010 10:01 pm

Re: Efektit

Post by ukkeli » 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 
...

User avatar
koodaaja
Moderator
Moderator
Posts: 1583
Joined: Mon Aug 27, 2007 11:24 pm
Location: Otaniemi - Mikkeli -pendelöinti

Re: Efektit

Post by koodaaja » Sun May 08, 2011 8:59 pm

Teinpä sade-efektin minäkin, ei tarvitse mainita tekijöissänsä ellei välttämättä halua ;)

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 i
MaGetzUb; itse ajattelin jotain auringonlaskusta otettua valokuvaa taustalle, mutta ei ole tuokaan huono ratkaisu :)

User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post by MaGetzUb » 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 
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
TheDuck
Devoted Member
Posts: 632
Joined: Sun Aug 26, 2007 3:51 pm
Location: C:\Program Files\Tuusula\

Re: Efektit

Post by TheDuck » Sun May 08, 2011 11:20 pm

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 
On kyllä vähän turhan nopea sade mun makuun. Pisarat menee reilusti ylinopeutta.
^^

User avatar
Timblex
Advanced Member
Posts: 252
Joined: Sun Apr 11, 2010 10:37 am
Location: Kouvola

Re: Efektit

Post by Timblex » 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 
Entinen timpe99...
Demokisa 2013 demo valmis, Check it out!

User avatar
axu
Devoted Member
Posts: 854
Joined: Tue Sep 18, 2007 6:50 pm

Re: Efektit

Post by axu » 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:

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)
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:
Voronoi.GIF
Efekti ei tuota kuvaa tällä FPS:llä :D
Voronoi.GIF (579.85 KiB) Viewed 3999 times
Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua :roll:
Image

User avatar
koodaaja
Moderator
Moderator
Posts: 1583
Joined: Mon Aug 27, 2007 11:24 pm
Location: Otaniemi - Mikkeli -pendelöinti

Re: Efektit

Post by koodaaja » 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.

User avatar
axu
Devoted Member
Posts: 854
Joined: Tue Sep 18, 2007 6:50 pm

Re: Efektit

Post by axu » Tue May 10, 2011 2:02 pm

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 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.
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.
Mitä tuohon nimeen tulee, olet osittain oikeassa (tai ehkäpä täysin :D ). Näyttää siltä, että tätä kutsutaan myös nimellä Worley noise tai cellular noise, mutta ei tosiaankaan Voronoi noise :P 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|
-------------
[/edit]
Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua :roll:
Image

User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post by MaGetzUb » 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..

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
Forever
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
koodaaja
Moderator
Moderator
Posts: 1583
Joined: Mon Aug 27, 2007 11:24 pm
Location: Otaniemi - Mikkeli -pendelöinti

Re: Efektit

Post by koodaaja » 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
Forever

User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post by MaGetzUb » 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. :)
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
Ilmuri
Developer
Developer
Posts: 277
Joined: Sun Aug 26, 2007 2:46 pm
Location: \o

Re: Efektit

Post by Ilmuri » Tue May 10, 2011 11:28 pm

MaGetzUb wrote: En tiedä kyllä, mitä tuo esittää, mutta h******n hieno se ainakin on. :)
Tuota voisi kuvailla metapallojen korkeuskäyräksi.
CoolBasic henkilökuntaa
Kehittäjä
CoolBasic Classic

Post Reply