Re: Efektit
Posted: Wed May 11, 2011 10:27 am
Tähän väliin tyhmä kysymys. Mikä on metapallo?
Tähän väliin tyhmä vastaus. http://lmgtfy.com/?q=metapallonaputtelija wrote:Tähän väliin tyhmä kysymys. Mikä on metapallo?
Sähkökentän voimakkuusfunktio piirrettynä kaksiulotteiseen koordinaatistoon.naputtelija wrote:Tähän väliin tyhmä kysymys. Mikä on metapallo?
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
Kokeilin yllä olevaa menetelmää. Voin myöntää, että olen hakoteillä
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
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.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 ;) ):EDIT:[/edit]Kokeilin yllä olevaa menetelmää. Voin myöntää, että olen hakoteillä :D
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.MaGetzUb wrote:Muokkasin vähän metapallo hässäkkääni(puuttuu kommentointia nyt, mutta lopputulos näyttää hienolta Imo );Code: Select all
koodia
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
Laitetaas nyt uudestaan, tuntui ettei ollut tarpeeksi erilainen niin poistin sen.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?).
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
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
Aivan upea! Todella komeita puita piirtelee, eikä minulla kestänyt yhden puun piirrossa kuin parisen sekuntia eli odotuskaan ei ollut päätä huimaava. Loistavaa!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:Known bugs/features:Code: Select all
...awesomeness...
- 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 :OWingman 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ä.
mikäs tämä on?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ä.
Puu, jonka kaksi haaraa ovat päällekkäin?timpe99 wrote:mikäs tämä on?
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
Ei, kyllä 'yksihaaraiset' puut ovat mahdollisia, kaksi haaraa menevät aivan lopussa päällekkäin. Eli ei sitä tarvitse muokataChaosworm wrote:Villi veikkaus: puu, joka on renderöity hieman muokatulla versiolla Wingmanin efektistä.
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ää =DDkoodaaja 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
Hieno on! Värit mukaankoodaaja wrote:Eipä ollut CB:n nopeudesta oikein plane deformeihin. 320x240 venytettynä 640x480 -ikkunaankin vain 15fps :/
En muokannut koodia yhtään ja tämä tuli jo toisella kokeilullaChaosworm wrote:Villi veikkaus: puu, joka on renderöity hieman muokatulla versiolla Wingmanin efektistä.
Mahdollista ja suhteellisen todennäköistä.timpe99 wrote:En muokannut koodia yhtään ja tämä tuli jo toisella kokeilullaChaosworm wrote:Villi veikkaus: puu, joka on renderöity hieman muokatulla versiolla Wingmanin efektistä.
Kaksi haaraa päällekkäin? mahdollista mutta epätodennäköistä