Page 1 of 1

Puiden generointi

Posted: Wed Feb 20, 2008 2:46 pm
by otto90x
Olen kyhännyt hieman eräänlaista puugeneraattoria, mutta se on kaipaisi hieman piristystä. Toivoisin että joku neuvoisi minua kuinka teen siitä paremman (aidomman ja hienomman näköiset puut ja lehdet) ja nopeamman. Kiitos.

Code: Select all

SCREEN 800,600

SetWindow "Keskeneräinen puugeneraattori."

lehdet=OFF

img=drawtree(200,200,lehdet)

Repeat


If KeyHit(cbkeyreturn) Then lehdet=Not lehdet

If KeyDown(cbkeyspace) Then 
    DeleteImage img
    img=drawtree(200,200,lehdet)
EndIf

DrawImage img,MouseX(),MouseY()

Color cbwhite
If lehdet Then Text 20,20,"Lehdet päällä - vaihda Enteristä" else Text 20,20,"Lehdet pois - vaihda Enteristä"
Text 20,40,"Paina välilyöntiä generoidaksesi uuden puun. Varoitus: Lehdet hidastavat rajusti"


DrawScreen

Forever

Function DrawTree(_width,_height,_lehdet)

img=MakeImage(_width,_height)
    
    DrawToImage img
        'ClsColor cbblack
        'Cls
        Color 96,64,0
        Box 0,0,_width,_height,0
        
        oksat$=Str(_width/2)+","+Str(_height-10)+","+Str(105)+","+Str(10)
        
        puuvaihtelu=5
        
        lehtietä=5
        
        While oksat$<>"" 
        
            word$=GetWord(oksat$,1,"|")
            
            x#=Float(GetWord(word$,1,","))
            y#=Float(GetWord(word$,2,","))
            angle#=Float(GetWord(word$,3,",")) 
            paksuus#=Float(GetWord(word$,4,","))
            

            
            Color 80+Rand(-puuvaihtelu*2,puuvaihtelu),50+Rand(-puuvaihtelu*2,puuvaihtelu/2),0+Rand(puuvaihtelu/2)
            
            For i=paksuus*4.5 To 0 Step -1
            
                viimehaara=viimehaara+1
            
                
                
                x#=x#+Cos(angle#)*3.0'(paksuus#/1.5)
                y#=y#-Sin(angle#)*3.0'(paksuus#/1.5)
                
                angle#=angle#-Sin(i*20)*7
                
                paksuus#=(Float(i)/5.0)
                
                Circle x#,Y#,(1+paksuus#),1
                
                If _lehdet Then 
                    If Rand(1)=0 And paksuus<5 Then 
                        
                        'For o=1 To 3
                            a=Rand(360)
                            lehdet$=lehdet$+Float(x#+Cos(a)*lehtietä)+","+Float(y#-Sin(a)*lehtietä)+"|"
                        'Next o
                    EndIf
                
                EndIf

                If viimehaara>9  Then 
                    r#=0.0
                    While Abs(r#)<0.7
                        r#=Rnd(-5,5)
                    Wend
                    oksat$=oksat$+"|"+x#+","+y#+","+str(float(angle#+(10.0*r#)))+","+paksuus#
                    viimehaara=0
                EndIf
                
                        
            Next i 
            
            oksia=int(CountWords(oksat$,"|"))
            
            If oksia>1 Then 
                oksat$=Mid(oksat$,Int(Len(word$)+2))
                
            Else
                oksat$=""
            EndIf
        
        Wend
        
        If _lehdet Then
            lehtivaihtelu=50
            
            lehdet$=Left(lehdet$,Int(Len(lehdet$)-1))
            
            i=0
            For i=1 To Int(CountWords(lehdet$,"|"))
            
                word$=GetWord(lehdet$,i,"|")
        
                x#=Float(GetWord(word$,1,","))
                y#=Float(GetWord(word$,2,","))
                'paksuus=Int(GetWord(word$,3,","))
    
                Color Rand(lehtivaihtelu),100+Rand(-lehtivaihtelu,lehtivaihtelu),Rand(lehtivaihtelu/2)
                koko=rand(3,6)'Abs((paksuus+Rand(2,4)))
                Box x#,y#,koko,koko,1
            
            Next i
        
        EndIf

    DrawToScreen 
    
    Return img

End Function 
Ja jos joku kysyy miksi ihmeessä haluan tehdä puugeneraattorin, niin vastaan siihen että koska en ole mikään kummoinen piirtäjä niin tahdon koneen piirtävän puolestani ja näin säästyy myös aikaa kun ei tarvitse joka puuta erikseen alkaa piirtelemään.

Re: Puiden generointi

Posted: Wed Feb 20, 2008 4:52 pm
by Harakka
Vau! Todella hieno systeemi jo nyt. Nopeutta saataisin varmaan paljonkin lisää jos boxin sijasta käytettäisiin PutPixel2():sta.

Re: Puiden generointi

Posted: Wed Feb 20, 2008 6:30 pm
by mikeful

Code: Select all

Randomize TIMER()
SCREEN 800,600,16
Repeat
Cls
aika=TIMER()
tarkista(ScreenWidth()/2,ScreenHeight(),Rand(260,280),ScreenHeight()/3)
Text 0,0,"Buildtime="+Str(TIMER()-aika)+" milliseconds. Press any key for new tree"
DrawScreen
WaitKey
Forever

Function tarkista(x1,y1,kulma,pituus)
		If pituus>15
			Color 128,128,0
			kul=Rand(kulma-90,kulma+90)
			If kul<0 Then kul=kul+360
			If kul>360 Then kul=kul-360
			pit=Rand(pituus-2)
			Line x1,y1,getlineox(x1,y1,kulma,pituus),getlineoy(x1,y1,kulma,pituus)
			tarkista(getlineox(x1,y1,kulma,pituus),getlineoy(x1,y1,kulma,pituus),Rand(kulma-20,kulma+20),Rand(pituus-(pituus/Rand(3,6))))
			tarkista(getlineox(x1,y1,kulma,pituus),getlineoy(x1,y1,kulma,pituus),Rand(kulma-20,kulma+20),Rand(pituus-(pituus/Rand(3,6))))
			tarkista(getlineox(x1,y1,kulma,pituus),getlineoy(x1,y1,kulma,pituus),Rand(kulma-20,kulma+20),Rand(pituus-(pituus/Rand(3,6))))
			tarkista(getlineox(x1,y1,kulma,pituus),getlineoy(x1,y1,kulma,pituus),Rand(kulma-20,kulma+20),Rand(pituus-(pituus/Rand(3,6))))
			tarkista(getlineox(x1,y1,kulma,pituus),getlineoy(x1,y1,kulma,pituus),kulma,Rand(pituus-(pituus/4)))
		Else
			Color 0,Rand(100,200),0
			'Color Rand(255),Rand(255),Rand(255)
			
            ran=Rand(5,20)
			Circle x1-(ran/2),y1-(ran/2),ran,ON            
            'Line x1,y1,x1,y1+ran
		EndIf
End Function

Function Lineo(x,y,kulma,pituus)
	Line x, y, Float(x) + Cos (kulma) * pituus, Float(y) - Sin (kulma) * pituus
End Function

Function GetLineoX(x,y,kulma,pituus)
	Return Int(x + Cos (kulma) * pituus)
End Function

Function GetLineoY(x,y,kulma,pituus)
	Return Int(y + Sin (kulma) * pituus)
End Function
Tällaisen kaivelin esiin vanhojen testiohjelmien joukosta.
EDIT:

Uusi verio koodista. Pastesin vahingossa väärän aluksi.


Re: Puiden generointi

Posted: Wed Feb 20, 2008 7:24 pm
by Harakka
mikeful wrote:Tällaisen kaivelin esiin vanhojen testiohjelmien joukosta.
Tosta koodista puuttuu GetLineOx() ja GetLineOy()-funktiot.

Re: Puiden generointi

Posted: Wed Feb 20, 2008 7:27 pm
by Koodiapina
mikeful wrote:

Code: Select all

Koodia
Tällaisen kaivelin esiin vanhojen testiohjelmien joukosta.
Tuosta koodista taitaa puuttua jotain.
EDIT:

Harakka ehti ruhtinaalliset 3 minuuttia edelleni