Efektit

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
User avatar
naputtelija
Devoted Member
Posts: 718
Joined: Wed Nov 03, 2010 8:56 pm
Location: Joku piste pohjoisessa.

Re: Efektit

Post by naputtelija » Wed May 11, 2011 10:27 am

Tähän väliin tyhmä kysymys. Mikä on metapallo?
<Ize> Pitäs tehä allekirjotus..
<Ize> Vois keksiä jonkin nasahtavan sanonnan..
<Ize> Siitä tulis upea legenda ja kaikki vaihtaisivat allekirjoituksensa siihen.
<Ize> Ehkä ei kuitenkaa...

Awaclus
Forum Veteran
Posts: 2939
Joined: Tue Aug 28, 2007 2:50 pm

Re: Efektit

Post by Awaclus » Wed May 11, 2011 10:31 am

naputtelija wrote:Tähän väliin tyhmä kysymys. Mikä on metapallo?
Tähän väliin tyhmä vastaus. http://lmgtfy.com/?q=metapallo

User avatar
CCE
Artist
Artist
Posts: 650
Joined: Mon Aug 27, 2007 9:53 pm

Re: Efektit

Post by CCE » Wed May 11, 2011 4:42 pm

naputtelija wrote:Tähän väliin tyhmä kysymys. Mikä on metapallo?
Sähkökentän voimakkuusfunktio piirrettynä kaksiulotteiseen koordinaatistoon.
Tässä naiivi (optimoimaton) esimerkki CoolBasicilla:

Code: Select all

SCREEN 200, 150
Dim ruutu(ScreenWidth(), ScreenHeight()) As Float
Repeat
t# = Timer() / 64.0

// lasketaan jokaisen pikselin kohdalla etäisyys kolmeen palloon, 
// mitä lähempänä pikseli on palloa, sitä kirkkaampi siitä tulee
For i=0 To 2
For y=0 To ScreenHeight()
For x=0 To ScreenWidth()
	säde# = 1500 + i*400	// pallot ovat hieman eri kokoisia
// kirkkaus=säde / pallon_ja_pikselin_välinen_etäisyys (pallon koordinaatit lasketaan trigonometrisillä funktioilla, voisi olla myös tallennettuna esim. taulukkoon)
	plus# = säde / Distance(x, y, 100 + Cos(t+i*45)*80, 70 + Sin(t+i*25)*50)	
	ruutu(x, y) = ruutu(x, y) + plus#
Next x
Next y
Next i

// piirretään äsken lasketut kirkkausarvot pikseli kerrallaan ruudulle
For y=0 To ScreenHeight()
For x=0 To ScreenWidth()
	kirkkaus# = min(255, ruutu(x, y))
	Color kirkkaus, kirkkaus, kirkkaus
	Dot x,y
	ruutu(x, y) = 0
Next x
Next y

DrawScreen

Forever
Tässä vielä Ohjelmointiputkan opas aiheeseen.

Edit: Ja tosiaan korottamalla etäisyysfunktion toiseen (tai suurempaan!) eksponenttiin, voi pallon reunoja säätää pehmeämmäksi tai kovemmaksi. (Lisää ^2 rivin 13 loppuun)
Last edited by CCE on Thu May 12, 2011 7:39 pm, edited 1 time in total.

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

Re: Efektit

Post by axu » Thu May 12, 2011 3:27 pm

Whoops! Tässä oli jonkun viesti missä oli muokattu versio tuosta CCE:n esimerkistä :O En nyt muista kenen se oli mutta hienoa bling blingiä kuiteski (miksiköhän meni poistamaan sen?).
Olen tässä parin päivän ajan yrittänyt päästä kärryille simplex noisesta, mutta epäilen olevani hakoteillä. Tai kyllä minulla on jo idea miten se tehdään, mutta epäilen että ideani on ihan eri kuin Perlinin oma :D Tietääkö kukaan hyvää opasta simplex noise:n maailmaan? Olen tätä lukenut, ja nykyiset tietoni pohjautuvat siihen. Mutta se on sen verran erikoinen opas että en enää tiedä osaanko enää edes perinteistä Perlin noisea tehdä :D Luullakseni periaate on seuraava (sry, viimeisen kuvan valmiiksi tekeminen olisi ollut työlästä minun menetelmälläni ;) ):
Simplex.png
kö?
Simplex.png (12.12 KiB) Viewed 4066 times
EDIT:

Kokeilin yllä olevaa menetelmää. Voin myöntää, että olen hakoteillä :D

Simplex Fail.png
Fail
Simplex Fail.png (22.49 KiB) Viewed 4040 times
[/edit]
Last edited by axu on Thu May 12, 2011 4:58 pm, edited 1 time in total.
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 » Thu May 12, 2011 3:49 pm

Muokkasin vähän metapallo hässäkkääni(puuttuu kommentointia nyt, mutta lopputulos näyttää hienolta Imo :D);

Code: Select all

Const count = 3
//Yhden värillisen laatikon koot GW x GH;
Const GW = 1
Const GH = 1
//Ruudun koko ScrW x ScrH
Const ScrW = 80
Const ScrH = 60


Dim points(count, 5) As Float

If ScrW < 100 And ScrH < 100 Then 
    SCREEN ScrW*10, ScrH*10
EndIf 
SCREEN ScrW, ScrH, 32, 2

//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 512
        Color Min(255, 6*(255.0/512*i)) , 255-255*Min(1, 350.0/(i^1.5)), 255-255*Min(1, 1000.0/(i^1.5))
        Dot i, 0
    Next i
//Asetetaan näyttö piirtopuskuriksi
DrawToScreen 
//</paletti>
bx = 12
by = 15

For i = 0 To count
    points(i, 0) = Rand(BoxesX)
    points(i, 1) = Rand(BoxesY)
    points(i, 2) = Rand(2, 10)
    sizeplus# = Rnd(-1, 1)
    points(i, 3) = sizeplus# + (sizeplus# = 0.0)*0.1
    points(i, 4) = Rnd(-1, 1)
    points(i, 5) = Rnd(-1, 1)
Next i



Repeat 

    
    For i = 0 To count
        points(i, 0) = points(i, 0) + points(i, 4)
        points(i, 1) = points(i, 1) + points(i, 5)
        'points(i, 2) = points(i, 2) + points(i, 3) 
        'If points(i, 2) > 15 Or points(i, 2) < 5 Then points(i, 3) = - points(i, 3) 
        If points(i, 0) > BoxesX Or points(i, 0) < 0 Then points(i, 4) = - points(i, 4)
        If points(i, 1) > BoxesY Or points(i, 1) < 0 Then points(i, 5) = - points(i, 5) 
    Next i
    
    
    //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.
                For i = 0 To count
                    Meta(x, y) = Meta(x, y) + points(i, 2)/((points(i, 0)  - x)(points(i, 0)  - x)+(points(i, 1) - y)(points(i, 1) - y))
                Next i
                //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 » Thu May 12, 2011 5:25 pm

axu wrote:Whoops! Tässä oli jonkun viesti missä oli muokattu versio tuosta CCE:n esimerkistä :O En nyt muista kenen se oli mutta hienoa bling blingiä kuiteski (miksiköhän meni poistamaan sen?).
Olen tässä parin päivän ajan yrittänyt päästä kärryille simplex noisesta, mutta epäilen olevani hakoteillä. Tai kyllä minulla on jo idea miten se tehdään, mutta epäilen että ideani on ihan eri kuin Perlinin oma :D Tietääkö kukaan hyvää opasta simplex noise:n maailmaan? Olen tätä lukenut, ja nykyiset tietoni pohjautuvat siihen. Mutta se on sen verran erikoinen opas että en enää tiedä osaanko enää edes perinteistä Perlin noisea tehdä :D Luullakseni periaate on seuraava (sry, viimeisen kuvan valmiiksi tekeminen olisi ollut työlästä minun menetelmälläni ;) ):
Simplex.png
EDIT:

Kokeilin yllä olevaa menetelmää. Voin myöntää, että olen hakoteillä :D

Simplex Fail.png
[/edit]
Se ei toimi aivan noin. Kolmioiden kulmissa ei ole kirkkausarvoja vaan kulmia. Tarvitset niinkutsutun wiggle-funktion, joka on toiselta puolelta pehmeästi kirkas ja toiselta tumma, parametriksi annetaan kulma ja etäisyys. Etuna esimerkiksi se, että kun tätä interpoloidaan ajan suhteen, kulmat vain pyörivät jolloin noise näyttää koko ajan suht samalta eikä vain crossfadelta kahdesta yksinkertaisesta noisesta.

User avatar
MetalRain
Active Member
Posts: 188
Joined: Sun Mar 21, 2010 12:17 pm
Location: Espoo

Re: Efektit

Post by MetalRain » Thu May 12, 2011 5:33 pm

MaGetzUb wrote:Muokkasin vähän metapallo hässäkkääni(puuttuu kommentointia nyt, mutta lopputulos näyttää hienolta Imo :D);

Code: Select all

koodia
Tähän saa aikalailla lisää nopeutta kun tallentaa paletin värit taulukkoon kuvan sijasta ja käyttää PutPixel2:ta Boxin sijaan. Kokeilin myös josko pallojen kirkkauden esilaskenta muistipalaan auttaisi, vaan voipi olla että on turhaa.

Code: Select all

Const count = 3
//Yhden värillisen laatikon koot GW x GH;
Const GW = 1
Const GH = 1
//Ruudun koko ScrW x ScrH
Const ScrW = 80
Const ScrH = 60

Dim points(count, 5) As Float
Dim PointMem(count)

If ScrW < 100 And ScrH < 100 Then 
    SCREEN ScrW*10, ScrH*10
EndIf 

SCREEN ScrW, ScrH, 32, 2

//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)

Dim Palette(512) 

For i = 0 To 512

    r=Min(255, 6*(255.0/512*i))
    g=255-255*Min(1, 350.0/(i^1.5))
    b=255-255*Min(1, 1000.0/(i^1.5))
    
    Palette(i) = b + (g Shl 8) + (r Shl 16) + (255 Shl 24)

Next i

For i = 0 To count

    points(i, 2) = Rand(2, 10)
    points(i, 5) = 160
    
    points(i, 0) = Rand(-points(i, 5)/2,BoxesX-points(i, 5)/2)
    points(i, 1) = Rand(-points(i, 5)/2,BoxesY-points(i, 5)/2)
    
    points(i, 3) = Rnd(-1, 1)
    points(i, 4) = Rnd(-1, 1)
    
    PointMem(i) = MetaTable(points(i, 2), points(i, 5))
Next i


Repeat 
    
    For i = 0 To count
        points(i, 0) = points(i, 0) + points(i, 3)
        points(i, 1) = points(i, 1) + points(i, 4)
        
        s# = points(i, 5)/2
        
        If points(i, 0) > BoxesX-s# Or points(i, 0) < -s# Then points(i, 3) = - points(i, 3)
        If points(i, 1) > BoxesY-s# Or points(i, 1) < -s# Then points(i, 4) = - points(i, 4)
    Next i

    Lock 
    //Lähdetään silmukoilla lukemaan ja kirjoittamaan Meta -taulukkoon.
    For x = 0 To BoxesX-1
        For y = 0 To BoxesY-1

            //Nollataan Meta -taulukon arvo, aina ettei ruutu vain "kirkastuisi"
            value# = 0.0
            //Lasketaan nyt meta-arvolle etäisyydenmukaan jokuarvo väliltä: 0 - äärettömyys
            //Mitä lähempänä x ja y ovat koordinaatteja, sitä enemmän numero on.
            For i = 0 To count
            
                dx = x-points(i, 0)
                dy = y-points(i, 1)
            
                If dx=>0 And dx<points(i, 5) And dy=>0 And dy< points(i, 5) Then 
                
                    value# = value# + PeekFloat(PointMem(i),((dy*points(i, 5)+dx) Shl 2))
                
                EndIf 
                
                If value#=>1.0 Then value#=1.0 : Exit
            
            Next i
            //Rajoitetaan arvoi kuitenkin yhden paikkeilla;
            c = value# * 510.0
            
            PutPixel2 x,y,Palette(c)

        Next y
    Next x
    Unlock 
    
    DrawScreen
    
    SetWindow ""+FPS()
    
Forever

Function MetaTable(metasize,memsize,intensity#=1.0)
    mem =  MakeMEMBlock((memsize*memsize) Shl 2)
    
    cx#=memsize/2.0
    cy#=memsize/2.0
    
    For y=0 To memsize-1
        dy# = y-cy#  
    
        For x=0 To memsize-1
            
            dx# = x-cx#  

            value# = Max(Min(Float(metasize)/(dx#*dx#+dy#*dy#)^intensity#, 1.0),0.0)

            PokeFloat mem,((y*memsize+x) Shl 2),value# 
        Next x
    Next y
    
    Return mem
End Function 
axu wrote:Whoops! Tässä oli jonkun viesti missä oli muokattu versio tuosta CCE:n esimerkistä :O En nyt muista kenen se oli mutta hienoa bling blingiä kuiteski (miksiköhän meni poistamaan sen?).
Laitetaas nyt uudestaan, tuntui ettei ollut tarpeeksi erilainen niin poistin sen.

Code: Select all

Const sw = 320
Const sh = 240

SCREEN sw, sh
Dim ruutu(sw, sh,2) As Float

Const pX = 0
Const pY = 1
Const pRad = 2
Const pR = 3
Const pG = 4
Const pB = 5
Const pDiff = 6

Const Size = 8
Const Balls = 8

Dim Ball(Balls,6) As Float

For i=0 To Balls
   Ball(i,pRad) = 5000.0 + i*400.0 // pallot ovat hieman eri kokoisia

   Ball(i,pR) = (i Mod 3 =0) * Rnd(0.25,0.45) + Rnd(0.15,0.65)
   Ball(i,pG) = (i Mod 3 =1) * Rnd(0.25,0.45) + Rnd(0.15,0.65)
   Ball(i,pB) = (i Mod 3 =2) * Rnd(0.25,0.45) + Rnd(0.15,0.65)
Next i

Repeat

    t# = Timer() / 32.0
    t2# = t# / 5.0
    
    // lasketaan jokaisen pikselin kohdalla etäisyys kolmeen palloon, 
    // mitä lähempänä pikseli on palloa, sitä kirkkaampi siitä tulee

    diffw#=-Cos(t2#)*90.0+90.0-Sin(t2#)*45.0
    diffh#=-Cos(t2#)*50.0+50.0-Sin(t2#)*25.0
    
    For i=0 To Balls
        //  tallennetaan pallojen koordinaatit taulukkoon
        Ball(i,pX) = sw/2.0 + Cos(t+i*diffw#)*sw/2.5
        Ball(i,pY) = sh/2.0 + Sin(t+i*diffh#)*sh/2.5
        Ball(i,pDiff) = Max(Min(0.5+Cos(t#*(5+i))*0.5,1.0),0.5)
       
    Next i

    For y=0 To ScreenHeight() Step Size
        For x=0 To ScreenWidth() Step Size
            For i=0 To Balls
                
               plus# = Ball(i,pRad) / Distance(x, y, Ball(i,pX), Ball(i,pY))^1.1  
               
               ruutu(x, y,0) = ruutu(x, y, 0) + plus#*Ball(i,pR)* Ball(i,pDiff)
               ruutu(x, y,1) = ruutu(x, y, 1) + plus#*Ball(i,pG)* Ball(i,pDiff)
               ruutu(x, y,2) = ruutu(x, y, 2) + plus#*Ball(i,pB)* Ball(i,pDiff)
            Next i
            
            r = Min(255, ruutu(x, y,0))
            g = Min(255, ruutu(x, y,1))
            b = Min(255, ruutu(x, y,2))
            
            Color r,g,b
            
            Box x,y,Size,Size,1

            ruutu(x, y,0) = 0
            ruutu(x, y,1) = 0
            ruutu(x, y,2) = 0
        
        Next x
    Next y
    
    SetWindow ""+FPS()
    
    DrawScreen
Forever

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

Re: Efektit

Post by Wingman » Mon May 16, 2011 10:16 pm

Tein tässä päivän aikana puumoottorin, joka siis nimensä mukaan tekee puita. Kommentoin koodia jotta sotkuistani saa selvän, ja tiedän, että tämän olisi voinut toteuttaa paljon nopeammin/vähemmällä koodilla.

Idea lähti siitä kun piirtelin puita (ihan paperille) ja mietin miten puu saa muotonsa siinä. Aloin sitten kotiin päästyäni koodaamaan, ja viiden minuutin jälkeen minulla oli rungon generointi kasassa. Lisäilin värit ja lehdet ja siinä se. Tietenkin myös optimoin hieman. En tässä enempää löpise, annetaan koodin puhua:

Code: Select all

Type POINT
	Field x					// pisteen sijainti
	Field y
	Field an				// pisteestä lähtevän oksanpätkän kulma
	Field mxa				// näitä kahta ei vielä käytetä
	Field mia
	Field nx				// oksanpätkän pään koordinaatit
	Field ny
	Field tehty				// onko oksa tehnyt uuden oksan
	Field leveys As Float 	// nimensä mukaan leveys
	Field id				// oksan järjestysnumero, tällä tarkistetaan että vain joka neljännellä piirretään
	Field i					// randomi, joka määrittää haarauman
	Field uusi				// i.stä karsittu vain 1, 2 tai 3, suuremmat kuin 3 ovat 1
EndType 
Type LEHTI
	Field x
	Field y
	Field id
EndType 
lehtialku=50 		// rungon pituus ennen lehtiä
lehtiä=4			// lehtiä/rungon kulma
smooth=2			// rungon kulmien välimatka
määrä=0
lmäärä=0
//alkupiste
p.POINT=New(POINT)
p\x=200
p\y=280
p\an=90
p\mxa=p\an+10
p\mia=p\an-10
p\leveys=10
p\nx=p\x+Cos(p\an)*smooth
p\ny=p\y-Sin(p\an)*smooth
p\id=määrä+1
määrä+1
r=200				// puun väri
g=100
b=50
AddText "Rendering the tree.."
Repeat
	For p.POINT=Each POINT
		p\i=Rand(1,40)			// tässä valitaan puun haarauma, jos p\i=2 tai 3, puu haarautuu, 
		Select p\i				// muuten se jatkaa kasvua
			Case 1
				p\uusi=1
			Case 2
				p\uusi=2
			Case 3
				p\uusi=3
			'Case 4
			'	p\uusi=4
			Default 
				p\uusi=1
		EndSelect 
		If määrä=lehtialku Then p\uusi=2		// puu haarautuu vähintään kun ON päästy lehtirajaan
		If p\tehty<>1 And p\leveys>0 Then 		// tarkistetaan ettei kulma ole tehnyt jo uutta kulmaa
			For ii=1 To p\uusi
				p2.POINT=New(POINT)
				p2\x=p\nx
				p2\y=p\ny
				p2\an=p\an+Rand(-20,20)
				p2\mxa=p2\an+10
				p2\mia=p2\an-10
				If Distance(p2\an,0,p\an,0)>10 Or Distance(p2\an,0,p\an,0)<-10 Then 
					p2\nx=p2\x+Cos(p2\an)*smooth*5					// jos puu haarautuu, tehdään kulmien 
					p2\ny=p2\y-Sin(p2\an)*smooth*5					// välimatkasta hieman suurempi
				Else  
					p2\nx=p2\x+Cos(p2\an)*smooth
					p2\ny=p2\y-Sin(p2\an)*smooth
				EndIf 
				p2\id=määrä+1
				määrä+1
				p2\leveys=p\leveys-0.2	// vähennetään oksan leveyttä
			Next ii
			If määrä>lehtialku Then		// jos ollaan lehtirajan yläpuolella 
				For l=1 To lehtiä
					le.LEHTI=New(LEHTI)
					le\x=p\nx+Rand(-10,10)
					le\y=p\ny+Rand(-10,10)
					le\id=lmäärä+1
					lmäärä+1
				Next l
			EndIf 
			If p\leveys<0.2 Then Goto lehdet 		// kun leveys ON liian pieni, mennään lehtien rendaukseen
			p\tehty=1 		// kerrotaan että puun kulma ON tehnyt uuden pisteen
		EndIf
		Color 1,1,1									 	// puun piirto
		Line p\x+p\leveys/2,p\y,p\nx+p\leveys/2,p\ny
		Color r/2,g/2,b/2
		For pp=-p\leveys/2+1 To p\leveys/2-1
			Line p\x+pp,p\y,p\nx+pp,p\ny
		Next pp
		Color r,g,b
		Line p\x-p\leveys/2,p\y,p\nx-p\leveys/2,p\ny
		If p\id Mod 4=1 Then							// nopeutetaan renderöintiä, vain joka neljännellä oksalla rendataan
			DrawScreen OFF
		EndIf  
	Next p  
Forever 

lehdet:
Color 255,255,255
AddText "Leaves"
For le.LEHTI=Each LEHTI
	Color 0,255,0				// lehtien piirto, erottelin vain hienouden vuoksi ;)
	Circle le\x-4,le\y-4,6,1
	Color 0,50,0
	Circle le\x-2,le\y-2,6,1
	Color 0,180,0
	Circle le\x-3,le\y-3,6,1
	If le\id Mod 4=1 Then 
		DrawScreen OFF
	EndIf 
Next le  
Goto loppu 
 
loppu:
Color 255,255,255
AddText "Done"
Repeat
	DrawScreen OFF
Forever 
Known bugs/features:
- joskus puusta voi tulla vain kaksihaarainen, sillä koodi pakottaa sen haarautumaan vain kerran.
- rungon suuntaa ei ole rajoitettu, eli periaatteessa puu voi kasvaa alaskin päin, mutta aloituskulma on 90 astetta, joten se on aika epätodennäköistä.
- - - -

User avatar
valscion
Moderator
Moderator
Posts: 1587
Joined: Thu Dec 06, 2007 8:46 pm
Location: Espoo
Contact:

Re: Efektit

Post by valscion » Mon May 16, 2011 11:03 pm

Wingman wrote:Tein tässä päivän aikana puumoottorin, joka siis nimensä mukaan tekee puita. Kommentoin koodia jotta sotkuistani saa selvän, ja tiedän, että tämän olisi voinut toteuttaa paljon nopeammin/vähemmällä koodilla.

Idea lähti siitä kun piirtelin puita (ihan paperille) ja mietin miten puu saa muotonsa siinä. Aloin sitten kotiin päästyäni koodaamaan, ja viiden minuutin jälkeen minulla oli rungon generointi kasassa. Lisäilin värit ja lehdet ja siinä se. Tietenkin myös optimoin hieman. En tässä enempää löpise, annetaan koodin puhua:

Code: Select all

...awesomeness...
Known bugs/features:
- joskus puusta voi tulla vain kaksihaarainen, sillä koodi pakottaa sen haarautumaan vain kerran.
- rungon suuntaa ei ole rajoitettu, eli periaatteessa puu voi kasvaa alaskin päin, mutta aloituskulma on 90 astetta, joten se on aika epätodennäköistä.
Aivan upea! Todella komeita puita piirtelee, eikä minulla kestänyt yhden puun piirrossa kuin parisen sekuntia eli odotuskaan ei ollut päätä huimaava. Loistavaa!
cbEnchanted, uudelleenkirjoitettu runtime. Uusin versio: 0.4.1 — Nyt myös sorsat GitHubissa!
NetMatch - se kunnon nettimättö-deathmatch! Avoimella lähdekoodilla varustettu
vesalaakso.com

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

Re: Efektit

Post by axu » Tue May 17, 2011 12:29 pm

Wingman wrote:Tein tässä päivän aikana puumoottorin, joka siis nimensä mukaan tekee puita. Kommentoin koodia jotta sotkuistani saa selvän, ja tiedän, että tämän olisi voinut toteuttaa paljon nopeammin/vähemmällä koodilla.

Known bugs/features:
- joskus puusta voi tulla vain kaksihaarainen, sillä koodi pakottaa sen haarautumaan vain kerran.
- rungon suuntaa ei ole rajoitettu, eli periaatteessa puu voi kasvaa alaskin päin, mutta aloituskulma on 90 astetta, joten se on aika epätodennäköistä.
Komeita puita tuo kyllä renderöi :O
Mielestäni paremman näköisiä kun jätti lehdet pois, mutta se on mielipidekysymys. Puu tosiaan joskus lähti kasvamaan maan sisään, mutta harvoin. Ruudun kooksi kannattaa laittaa ainakin 500x500, kun tahtoo tuo puu mennä ruudun ulkopuolelle...
Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua :roll:
Image

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

Re: Efektit

Post by Timblex » Tue May 17, 2011 1:59 pm

Wingman wrote: Known bugs/features:
- joskus puusta voi tulla vain kaksihaarainen, sillä koodi pakottaa sen haarautumaan vain kerran.
- rungon suuntaa ei ole rajoitettu, eli periaatteessa puu voi kasvaa alaskin päin, mutta aloituskulma on 90 astetta, joten se on aika epätodennäköistä.
mikäs tämä on?
puu.png
Vain kaksihaarainen???
puu.png (9.71 KiB) Viewed 3905 times
Entinen timpe99...
Demokisa 2013 demo valmis, Check it out!

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

Re: Efektit

Post by ukkeli » Tue May 17, 2011 3:27 pm

Puu?

Edit:Poistin quoten(Vai mikä on :D )
...

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

Re: Efektit

Post by axu » Tue May 17, 2011 5:34 pm

timpe99 wrote:mikäs tämä on?
Puu, jonka kaksi haaraa ovat päällekkäin?
Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua :roll:
Image

Awaclus
Forum Veteran
Posts: 2939
Joined: Tue Aug 28, 2007 2:50 pm

Re: Efektit

Post by Awaclus » Tue May 17, 2011 9:39 pm

Villi veikkaus: puu, joka on renderöity hieman muokatulla versiolla Wingmanin efektistä.

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

Re: Efektit

Post by Wingman » Tue May 17, 2011 9:44 pm

Lisäilin muutaman jutun, nyt välilyönti renderöi uuden puun. sävyttelin grafiikkaa hieman ja vähensin lehtiä:
Samat bugit säilyvät, enkä niitä ala korjailemaan (ihan hyviä rendaa jo nyt, ei kaikkien tarvitse olla täydellisiä ;) )

Code: Select all

SCREEN 800,600,0,1
SCREEN 800,600,0,2
Type POINT
	Field x					// pisteen sijainti
	Field y
	Field an				// pisteestä lähtevän oksanpätkän kulma
	Field mxa				// näitä kahta ei vielä käytetä
	Field mia
	Field nx				// oksanpätkän pään koordinaatit
	Field ny
	Field tehty				// onko oksa tehnyt uuden oksan
	Field leveys As Float 	// nimensä mukaan leveys
	Field id				// oksan järjestysnumero, tällä tarkistetaan että vain joka neljännellä piirretään
	Field i					// randomi, joka määrittää haarauman
	Field uusi				// i.stä karsittu vain 1, 2 tai 3, suuremmat kuin 3 ovat 1
EndType 
Type LEHTI
	Field x
	Field y
	Field id
	Field c
EndType 
alku:
start=Timer()
lehtialku=50 		// rungon pituus ennen lehtiä
lehtiä=1			// lehtiä/rungon kulma
smooth=2			// rungon kulmien välimatka
nopeus=64           // kuinka monta kulmaa/lehteä piirretään kerralla, suurempi arvo, nopeampi piirto
suoruus=10			// puun suoruus, suurempi arvo, mutkikkaampi puu
määrä=0
lmäärä=0
//alkupiste
p.POINT=New(POINT)
p\x=ScreenWidth()/2
p\y=ScreenHeight()
p\an=90
p\mxa=p\an+10
p\mia=p\an-10
p\leveys=12			// rungon leveys alusssa
p\nx=p\x+Cos(p\an)*smooth
p\ny=p\y-Sin(p\an)*smooth
p\id=määrä+1
määrä+1
r=200				// puun väri
g=100
b=50
AddText "Rendering the tree.."
Repeat
	Lock 
	'For yy=0 To ScreenHeight() 	//tausta
	'	If yy<ScreenHeight()-50 Then 
	'		Color Min(255,10+yy/5),Min(255,30+yy/4),Min(255,50+yy/3)
	'	Else
	'		Color Min(255,10+yy/5)/2,Min(255,30+yy/3)/2,Min(255,50+yy/5)/2
	'	EndIf  
	'	Line 0,yy,ScreenWidth(),yy
	'Next yy
	Unlock 
	For p.POINT=Each POINT
		aika=Timer()-start
		p\i=Rand(1,40)			// tässä valitaan puun haarauma, jos p\i=2 tai 3, puu haarautuu, 
		Select p\i				// muuten se jatkaa kasvua
			Case 1
				p\uusi=1
			Case 2
				p\uusi=2
			Case 3
				p\uusi=3
			'Case 4
			'	p\uusi=4
			Default 
				p\uusi=1
		EndSelect 
		If määrä=lehtialku Then p\uusi=2		// puu haarautuu vähintään kun ON päästy lehtirajaan
		If p\tehty<>1 And p\leveys>0 Then 		// tarkistetaan ettei kulma ole tehnyt jo uutta kulmaa
			For ii=1 To p\uusi
				p2.POINT=New(POINT)
				p2\x=p\nx
				p2\y=p\ny
				p2\an=p\an+Rand(-suoruus*2,suoruus*2)
				p2\mxa=p2\an+suoruus
				p2\mia=p2\an-suoruus
				If Distance(p2\an,0,p\an,0)>suoruus Or Distance(p2\an,0,p\an,0)<-suoruus Then 
					p2\nx=p2\x+Cos(p2\an)*smooth*5					// jos puu haarautuu, tehdään kulmien 
					p2\ny=p2\y-Sin(p2\an)*smooth*5					// välimatkasta hieman suurempi
				Else  
					p2\nx=p2\x+Cos(p2\an)*smooth
					p2\ny=p2\y-Sin(p2\an)*smooth
				EndIf 
				p2\id=määrä+1
				määrä+1
				p2\leveys=p\leveys-0.2	// vähennetään oksan leveyttä
			Next ii
			If määrä>lehtialku Then		// jos ollaan lehtirajan yläpuolella 
				For l=1 To lehtiä
					le.LEHTI=New(LEHTI)
					le\x=p\nx+Rand(-10,10)
					le\y=p\ny+Rand(-10,10)
					le\id=lmäärä+1
					le\c=Rand(-50,50)
					lmäärä+1
					If määrä>lehtialku*2 Then 
						p3.POINT=New(POINT)
						p3\tehty=1
						p3\x=p\nx
						p3\y=p\ny
						p3\nx=le\x
						p3\ny=le\y
						p3\leveys=2
						p3\id=määrä+1
						määrä+1
					EndIf 
				Next l
			EndIf 
			If p\leveys<0.2 Then Goto lehdet		// kun leveys ON liian pieni, mennään lehtien rendaukseen
			p\tehty=1 		// kerrotaan että puun kulma ON tehnyt uuden pisteen
		EndIf
		Lock 
		Color r/10,g/10,b/10						 	// puun piirto
		Line p\x+p\leveys/2,p\y,p\nx+p\leveys/2,p\ny
		For pp=-p\leveys/2+1 To p\leveys/2
			rrr=Rand(-15,15)-(pp*3)
			Color Min(255,Max(0,r/2+rrr)),Min(255,Max(0,g/2+rrr)),Min(255,Max(0,b/2+rrr))
			Line p\x+pp,p\y,p\nx+pp,p\ny
		Next pp
		Color r,g,b
		Line p\x-p\leveys/2,p\y,p\nx-p\leveys/2,p\ny
		Unlock 
		If p\id Mod nopeus=1 Then							// nopeutetaan renderöintiä
			DrawScreen OFF
		EndIf  
	Next p  
Forever 

lehdet:
Color 255,255,255
AddText "time: "+aika+"ms, branches: "+määrä
AddText "Rendering the leaves.."
start=Timer()
For le.LEHTI=Each LEHTI
		aika2=Timer()-start
	Color Max(0,le\c),200+le\c,Max(0,le\c)				// lehtien piirto, erottelin vain hienouden vuoksi ;)
	Ellipse le\x-3,le\y-2,6,4,1
	Color Max(0,le\c),50+le\c,Max(0,le\c)
	Ellipse le\x-2,le\y-1,6,4,1
	Color Max(0,le\c),180+le\c,Max(0,le\c)
	Ellipse le\x-3,le\y-2,6,4,1
	If le\id Mod nopeus=1 Then 
		DrawScreen OFF
	EndIf 
Next le  
Goto loppu 
 
loppu:
Color 255,255,255
AddText "time: "+aika2+"ms, leaves: "+lmäärä
AddText "Done"
ajat=aika+aika2
määrät=määrä+lmäärä
AddText "overall time: "+ajat+"ms, overall shapes: "+määrät
Repeat
	DrawScreen OFF
	If KeyHit(57) Then
		For p.POINT=Each POINT	
			Delete p
		Next p
		For le.LEHTI=Each LEHTI
			Delete le
		Next le
		ClearText 
		DrawScreen 
		Goto alku
	EndIf 
Forever 
Chaosworm wrote:Villi veikkaus: puu, joka on renderöity hieman muokatulla versiolla Wingmanin efektistä.
Ei, kyllä 'yksihaaraiset' puut ovat mahdollisia, kaksi haaraa menevät aivan lopussa päällekkäin. Eli ei sitä tarvitse muokata
- - - -

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 » Wed May 18, 2011 1:28 am

Eipä ollut CB:n nopeudesta oikein plane deformeihin. 320x240 venytettynä 640x480 -ikkunaankin vain 15fps :/

Code: Select all

SCREEN 640,480
Dim map(319,239,1), pic(99,99) As Float
For i = 0 To 319
    For j = 0 To 239
        If i<100 And j<100 Then pic(i,j)=Abs(Distance(49.5,49.5,i,j)-40)-5
        c#=.05*Distance(i,j,160,120)*cos(GetAngle(i,j,160,120)+.8*Distance(i,j,160,120))
        map(i,j,0)=Min(99,RoundDown((c-RoundDown(c))*100))
        c=.05*Distance(i,j,160,120)*sin(GetAngle(i,j,160,120)+.8*Distance(i,j,160,120))
        map(i,j,1)=Min(99,RoundDown((c-RoundDown(c))*100))
    Next j
Next i
PositionCamera 320,-240
Repeat
    x# = x + 7
    ix = Int(x)
    Lock
        For i = 0 To 319
            For j = 0 To 239
                If pic(Int((map(i,j,0)+x) Mod 100),map(i,j,1))<0 Then PutPixel2 i,j,16777215
            Next j
        Next i
    Unlock
    For i = 240 To 0 Step -1
        CopyBox 0, i, 320, 2, 0, i*2
    Next i
    For i = 320 To 0 Step -1
        CopyBox i,0,2,480,i*2,0
    Next i
    DrawScreen
Forever

User avatar
legend
Advanced Member
Posts: 371
Joined: Wed Nov 18, 2009 9:06 pm

Re: Efektit

Post by legend » Wed May 18, 2011 7:26 am

koodaaja wrote:Eipä ollut CB:n nopeudesta oikein plane deformeihin. 320x240 venytettynä 640x480 -ikkunaankin vain 15fps :/

Code: Select all

SCREEN 640,480
Dim map(319,239,1), pic(99,99) As Float
For i = 0 To 319
    For j = 0 To 239
        If i<100 And j<100 Then pic(i,j)=Abs(Distance(49.5,49.5,i,j)-40)-5
        c#=.05*Distance(i,j,160,120)*cos(GetAngle(i,j,160,120)+.8*Distance(i,j,160,120))
        map(i,j,0)=Min(99,RoundDown((c-RoundDown(c))*100))
        c=.05*Distance(i,j,160,120)*sin(GetAngle(i,j,160,120)+.8*Distance(i,j,160,120))
        map(i,j,1)=Min(99,RoundDown((c-RoundDown(c))*100))
    Next j
Next i
PositionCamera 320,-240
Repeat
    x# = x + 7
    ix = Int(x)
    Lock
        For i = 0 To 319
            For j = 0 To 239
                If pic(Int((map(i,j,0)+x) Mod 100),map(i,j,1))<0 Then PutPixel2 i,j,16777215
            Next j
        Next i
    Unlock
    For i = 240 To 0 Step -1
        CopyBox 0, i, 320, 2, 0, i*2
    Next i
    For i = 320 To 0 Step -1
        CopyBox i,0,2,480,i*2,0
    Next i
    DrawScreen
Forever
Itselläni pyöri ihan 29 fps. Ihan hieno toi oli värit olisivat tehnyt vain terää =DD

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

Re: Efektit

Post by ukkeli » Wed May 18, 2011 8:27 am

koodaaja wrote:Eipä ollut CB:n nopeudesta oikein plane deformeihin. 320x240 venytettynä 640x480 -ikkunaankin vain 15fps :/
Hieno on! Värit mukaan :D
...

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

Re: Efektit

Post by Timblex » Wed May 18, 2011 8:35 am

Chaosworm wrote:Villi veikkaus: puu, joka on renderöity hieman muokatulla versiolla Wingmanin efektistä.
En muokannut koodia yhtään ja tämä tuli jo toisella kokeilulla
Kaksi haaraa päällekkäin? mahdollista mutta epätodennäköistä
Entinen timpe99...
Demokisa 2013 demo valmis, Check it out!

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 May 18, 2011 9:05 am

timpe99 wrote:
Chaosworm wrote:Villi veikkaus: puu, joka on renderöity hieman muokatulla versiolla Wingmanin efektistä.
En muokannut koodia yhtään ja tämä tuli jo toisella kokeilulla
Kaksi haaraa päällekkäin? mahdollista mutta epätodennäköistä
Mahdollista ja suhteellisen todennäköistä.
- - - -

Post Reply