Efektit

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
User avatar
kaneli2000
Guru
Posts: 1059
Joined: Mon Mar 17, 2008 2:40 pm
Location: Lempäälä

Re: Efektit

Post by kaneli2000 »

Oli taas vaihteeksi tylsää, niin innostuin tekemään myöskin yksinkertaisen palloiluefektin. Eli funktioiden käyttö menee seuraavasti:

Effect_MakeBall(x,y,koko,feidausnopeus,[väriRed],[väriGreen],[väriBlue]) tekee uuden pallon.
  • x - pallon x-piste.
    y - pallon y-piste.
    koko - pallon koko.
    feidausnopeus - kuinka nopeasti pallo feidaa näkymättömiin.
    [väriRed] - kuinka paljon punaista väriä. Valinnainen.
    [väriGreen] - kuinka paljon vihreää väriä. Valinnainen sekin.
    [väriBlue] - kuinka paljon sinistä väriä. Valinnainen.
Jos väreihin ei laita mitään (kuten esimerkkikoodissa), tehdään valkoinen pallo.

Effect_UpdateBalls() piirtää kaikki luodut pallot.

Ja koodissa on mukana simppeli sin-cos-viritelmä.

Code: Select all

//KANELI2000'S SIMPLE BALLEFFECT v2
//Muista, että jos luot liikaa ja liian suuria palloja, se vaikuttaa radikaalisti FPSään.

SCREEN 800,600

Const clsclrR = 100 //taustaväriRed
Const clsclrG = 100 //taustaväriGreen
Const clsclrB = 100 //taustaväriBlue
ClsColor clsclrR,clsclrG,clsclrB

Type BALLEFFECT_BALLS
    Field x
    Field y
    Field size
    Field clrR
    Field clrG
    Field clrB
    Field fadespeed
EndType

Repeat
    
    Color cbWhite
    Text 0,0,"FPS: "+FPS()
    
    x = 0 + Cos(Timer()/20)*225
    y = 0 + Sin(Timer()/20)*225
    
    Effect_MakeBall(x,y,10,4) //tehdään pallo(t)
    Effect_MakeBall(x,0,10,4)
    Effect_MakeBall(0,y,10,4)
    
    DrawToWorld ON,OFF,ON
    Effect_UpdateBalls() //ja piirretään se
    DrawToWorld OFF,OFF,OFF
    
    DrawScreen
Forever

Function Effect_MakeBall(x,y,size,fadespeed,colorR = 255,colorG = 255,colorB = 255) //x,y,koko,feidausnopeus,väriR,väriG,väriB
    newBall.BALLEFFECT_BALLS = New(BALLEFFECT_BALLS)
    newBall\x = x
    newBall\y = y
    newBall\size = size
    newBall\clrR = colorR
    newBall\clrG = colorG
    newBall\clrB = colorB
    newBall\fadespeed = fadespeed
EndFunction

Function Effect_UpdateBalls()
    For iBall.BALLEFFECT_BALLS = Each BALLEFFECT_BALLS
        
        Color iBall\clrR,iBall\clrG,iBall\clrB
        Circle iBall\x-(iBall\size/2),iBall\y-(iBall\size/2),iBall\size
        
        If iBall\clrR > clsclrR Then iBall\clrR - iBall\fadespeed
        If iBall\clrG > clsclrG Then iBall\clrG - iBall\fadespeed
        If iBall\clrB > clsclrB Then iBall\clrB - iBall\fadespeed
        
        If iBall\clrR < clsclrR Then iBall\clrR + iBall\fadespeed
        If iBall\clrG < clsclrG Then iBall\clrG + iBall\fadespeed
        If iBall\clrB < clsclrB Then iBall\clrB + iBall\fadespeed
        
        If iBall\clrR < clsclrR + 5 And iBall\clrR > clsclrR - 5 And iBall\clrG < clsclrG + 5 And iBall\clrG > clsclrG - 5 And iBall\clrB < clsclrB + 5 And iBall\clrB > clsclrB - 5 Then Delete iBall
        
        i=i+1
    Next iBall
EndFunction

EDIT: Väribugi korjattu.
EDIT2: Tein pallot sellaisiksi, että ne feidaavat taustaväriksi eivätkä mustaksi.
Last edited by kaneli2000 on Fri Aug 28, 2009 5:16 pm, edited 3 times in total.
I see the rainbow rising
User avatar
Substance
Active Member
Posts: 234
Joined: Fri Mar 14, 2008 5:48 pm

Re: Efektit

Post by Substance »

kaneli2000 wrote:Oli taas vaihteeksi tylsää, niin innostuin tekemään myöskin yksinkertaisen palloiluefektin. Eli funktioiden käyttö menee seuraavasti:

Effect_MakeBall(x,y,koko,feidausnopeus,[väriRed],[väriGreen],[väriBlue]) tekee uuden pallon.
  • x - pallon x-piste.
    y - pallon y-piste.
    koko - pallon koko.
    feidausnopeus - kuinka nopeasti pallo feidaa näkymättömiin.
    [väriRed] - kuinka paljon punaista väriä. Valinnainen.
    [väriGreen] - kuinka paljon vihreää väriä. Valinnainen sekin.
    [väriBlue] - kuinka paljon sinistä väriä. Valinnainen.
Jos väreihin ei laita mitään (kuten esimerkkikoodissa), tehdään valkoinen pallo.

Effect_UpdateBalls() piirtää kaikki luodut pallot.

Ja koodissa on mukana simppeli sin-cos-viritelmä.

Code: Select all

Function Effect_UpdateBalls()
    For iBall.BALLEFFECT_BALLS = Each BALLEFFECT_BALLS
        
        Color iBall\clrR,iBall\clrG,iBall\clrB
        Circle iBall\x-iBall\size/2,iBall\y-iBall\size/2,iBall\size
        If iBall\clrR > 5 Then iBall\clrR - iBall\fadespeed
        If iBall\clrG > 5 Then iBall\clrG - iBall\fadespeed
        If iBall\clrB > 5 Then iBall\clrB - iBall\fadespeed
        
        If iBall\clrR < 10 And iBall\clrG < 5 And iBall\clrB < 5 Then Delete iBall
        
        i=i+1
    Next iBall
EndFunction
Hieno on, mutta harmillisesti olet estänyt pallojen poistumisen.
Substance aka LittleGreen
Red Encounter - shoot'em uppia - lataus
User avatar
kaneli2000
Guru
Posts: 1059
Joined: Mon Mar 17, 2008 2:40 pm
Location: Lempäälä

Re: Efektit

Post by kaneli2000 »

LittleGreen wrote: Hieno on, mutta harmillisesti olet estänyt pallojen poistumisen.
Niinpä olenkin. Jess.

Korajsin.
I see the rainbow rising
koodaaja
Moderator
Moderator
Posts: 1583
Joined: Mon Aug 27, 2007 11:24 pm
Location: Otaniemi - Mikkeli -pendelöinti

Re: Efektit

Post by koodaaja »

Mjaa, eipä anneta tämän tippua liian alas, on sen verran jalo topiikki.

Kaveri aikanaan havaitsi, että lockin ollessa päällä voi piirtää viivoja huomattavan nopeasti. Pientä demonstraatiota seuraa. Tämä tuntuu joillakin koneilla olevan toimimaton, ilmoittakaa jos ei pelaa. Laitan myös .exen, useimmilla koneilla jotka eivät itse osaa tuota CB:stä ajaa, toimii .exe kuitenkin oikein. Toimiessaan ohjelma piirtää erivärisiä kartioita näytölle, muutoin pelkän FPS-mittarin vasempaan ylälaitaan. d on muuten kartion alamylpyrän kulmien lukumäärä ja amount kartioiden määrä. Omalla koneella tämä 12 ja 12 pyörii 64fps.

.exe

Code: Select all

Const w = 400
Const h = 300

Const cop = 800 // w*2

SCREEN w*2, h*2

Function filltriangle(x1#, y1#, x2#, y2#, x3#, y3#, r%, g%, b%) //ensimmäistä kertaa jaksoin oman kirjoittaa :o
    
    Dim tmpy As Float, tmpx As Float, slp1 As Float, slp2 As Float, slp3 As Float, i As integer
    
    If((x2#-x1#)*(y3#-y1#)-(x3#-x1#)*(y2#-y1#))<=0.0 Then Return 0
    
    Color r, g, b
    
    If (y1>y2) Then
        tmpy = y1
        tmpx = x1
        
        y1 = y2
        x1 = x2
        
        y2 = tmpy
        x2 = tmpx
    EndIf
    
    If (y1>y3) Then
        tmpy = y1
        tmpx = x1
        
        y1 = y3
        x1 = x3
        
        y3 = tmpy
        x3 = tmpx
    EndIf
    
    If (y2>y3) Then
        tmpy = y2
        tmpx = x2
        
        y2 = y3
        x2 = x3
        
        y3 = tmpy
        x3 = tmpx
    EndIf
    
    If(y2=y1) Then y1-0.001
    If(y3=y2) Then y3+0.01
    
    slp1# = (x3-x1)/(y3-y1)
    slp2# = (x2-x1)/(y2-y1)
    slp3# = (x3-x2)/(y3-y2)
    
    If(Int(y1)<Int(y2)) Then
        For i = y1 To y2
            Line x1+slp1*(i-y1), i, x2+slp2*(i-y2), i
        Next i
    EndIf
    If(Int(y2)<Int(y3)) Then
        For i = y2 To y3
            Line x1+slp1*(i-y1), i, x3+slp3*(i-y3), i
        Next i
    EndIf
EndFunction



Function tri3D(x1#, y1#, z1#, x2#, y2#, z2#, x3#, y3#, z3#, r%, g%, b%)
    
    Dim s1 As Float, s2 As Float, s3 As Float, cx As Float, cy As Float, cz As Float, cL As Float, lcd As Float, lx As Float, lc As Float, ly As Float, lz As Float, aL As Float
    
    If(z1<=0)Or(z2<=0)Or(z3<=0)Then Return 0
    
    s1# = (1.0/z1#)*cop
    s2# = (1.0/z2#)*cop
    s3# = (1.0/z3#)*cop
    
    cx# = ((y2#-y1#)*(z3#-z1#))-((y3#-y1#)*(z2#-z1#))
    cy# = ((z2#-z1#)*(x3#-x1#))-((z3#-z1#)*(x2#-x1#))
    cz# = ((x2#-x1#)*(y3#-y1#))-((x3#-x1#)*(y2#-y1#))
    
    lx# = -2
    ly# = -1.0
    lz# = 3
    
    cL# = Sqrt(cx#*cx#+cy#*cy#+cz#*cz#)
    aL# = Sqrt(lx#*lx#+ly#*ly#+lz#*lz#)
    
    cx# = cx# / cL#
    cy# = cy# / cL#
    cz# = cz# / cL#
    
    lx# = lx# / aL#
    ly# = ly# / aL#
    lz# = lz# / aL#
    
    lcd# = (cx#*lx#) + (cy#*ly#) + (cz#*lz#)
    lc# = .1 + Max(0.0,min(lcd#, 1.0))*.9
    
    filltriangle(Int(s1*x1+w), Int(s1*y1+h), Int(s2*x2+w), Int(s2*y2+h), Int(s3*x3+w), Int(s3*y3+h), Int(Float(r)*lc#), Int(Float(g)*lc#), Int(Float(b)*lc#))
    
EndFunction

Dim x# As Float, i As integer, col As integer, a As Float, j As integer, d As integer, ang As integer, amount As integer, r As Float, g As Float, b As Float

d = 12
ang = 360.0/Float(d)
amount = 12

Repeat
    a# = WrapAngle(a#+.5)
    
    Lock
        For i = 5+2*(amount-1) To 5 Step -2
            x = (.5*i)-3.25
            col = 255-((amount^-1)*(i-5))*255
            
            r = ((((i-5.0)/2.0) Mod 3) = 0)
            g = (((((i-5.0)/2.0) + 1) Mod 3) = 0)
            b = (((((i-5.0)/2.0) + 2) Mod 3) = 0)
            
            For j = 0 To d-1
                tri3D(x+Cos(a+j*ang), 1, i+Sin(a+j*ang), x, -1, i, x+Cos(a+(j+1)*ang), 1, i+Sin(a+(j+1)*ang), col*r, col*g, col*b)
            Next j
        Next i
    Unlock
    Color 255, 255, 255
    Text 10, 10, Str(FPS())
    DrawScreen
Forever
User avatar
Ruuttu
Devoted Member
Posts: 688
Joined: Thu Aug 30, 2007 5:11 pm
Location: Finland, Sipoo

Re: Efektit

Post by Ruuttu »

No on hieno! Älyttömän nopeasti tosiaan toimii, on kai tämän joku huomannut aiemminkin? Lockit tosiaan nopeuttaa suorituskykyä parhaimmillaan moninkertaisesti.

Code: Select all

Repeat

    Text 10,10,FPS()

DrawScreen
Forever
Johtuuko se vain Windows 7:stä, vai miksi tämä ohjelma pyörii 400FPS nopeudella?
Guest_Feuer

Re: Efektit

Post by Guest_Feuer »

Äidin vista-työkonella tuon ylemmän FPS pomppi väliä 150-200. Miksi Text ja Drawscreen aiheuttavat noin suurta pomppimista? :shock:
User avatar
Ruuttu
Devoted Member
Posts: 688
Joined: Thu Aug 30, 2007 5:11 pm
Location: Finland, Sipoo

Re: Efektit

Post by Ruuttu »

Olisi kiva jos Zero kerkeäisi tekemään perustavanlaatuisen selostuksen CoolBasic:n tekniikasta - mitä siellä konepellin alla oikeasti tapahtuu olisi hyödyllinen tieto optimointia yms. ajatellen.
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post by MaGetzUb »

Uskon että se johtuu vain prosessoreista ja prosessien päälläolemisesta. Itselläni FPS oli 10, ja turhan monta prosessia päällä. :)
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.
KilledWhale
Tech Developer
Tech Developer
Posts: 545
Joined: Sun Aug 26, 2007 2:43 pm
Location: Liminka

Re: Efektit

Post by KilledWhale »

Ruuttu wrote:Olisi kiva jos Zero kerkeäisi tekemään perustavanlaatuisen selostuksen CoolBasic:n tekniikasta - mitä siellä konepellin alla oikeasti tapahtuu olisi hyödyllinen tieto optimointia yms. ajatellen.
Minulla tuli joskus decompileria koodaillessa mieleen että voisin ehkä kirjoittaa _omiin_tietoihini_ perustuvan artikkelin coolpalstaan cbn toiminnasta mutta en sitten jaksanut :D
CoolBasic henkilökuntaa
Kehittäjä

cbFUN Kello
cbSDL
Whale.dy.fi

<@cce> miltäs tuntuu olla suomen paras
User avatar
Ruuttu
Devoted Member
Posts: 688
Joined: Thu Aug 30, 2007 5:11 pm
Location: Finland, Sipoo

Re: Efektit

Post by Ruuttu »

KilledWhale wrote:
Ruuttu wrote:Olisi kiva jos Zero kerkeäisi tekemään perustavanlaatuisen selostuksen CoolBasic:n tekniikasta - mitä siellä konepellin alla oikeasti tapahtuu olisi hyödyllinen tieto optimointia yms. ajatellen.
Minulla tuli joskus decompileria koodaillessa mieleen että voisin ehkä kirjoittaa _omiin_tietoihini_ perustuvan artikkelin coolpalstaan cbn toiminnasta mutta en sitten jaksanut :D
Ruikutus ei taida auttaa tässä kohtaa? :D Ja sinä ja sun decompileris...
User avatar
CCE
Artist
Artist
Posts: 650
Joined: Mon Aug 27, 2007 9:53 pm

Re: Efektit

Post by CCE »

Tein tämmöisen pikkuisen intron näin perjantai-illan ratoksi:

Code: Select all

    // piskuinen roxor intro
    // koodannut cce, Valtzulle kiitos SinWave funktiosta

    Gosub InitAudio
    font=LoadFont("fixedsys",12)
    SetFont font

    Dim img(17) as String
    Gosub CreateKuva
    Dim kuva(24,16)
    For y=0 To 16
    For x=0 To 24
       kuva(x,17-y) = max(0, Asc( Mid( img(y), x+1, 1 ) )-35)
    Next x
    Next y

    Randomize 5

    bg=MakeImage(420,320)
    DrawToImage bg
       Color 32,32,32
       Box 0,0,420,320
       Color 1,1,1
       For i=0 To 2000
          kulma=Rnd(360)
          matka=Rand(0,240)
          koko= matka*0.1
          Box 200+Cos(kulma)*matka, 150+Sin(kulma)*matka, koko, koko, 1
       Next i
    DrawToScreen
    Color 255,255,255

    start=Timer()
    skrol$ = "                                                  Hieno musa eikö totta? Biisi on generoitu lennossa ilman ulkopuolisia tiedostoja. CB:en rajoittuneisuudesta johtuen musiikin rytmi saattaa heitellä vähän miten sattuu. Valtzulle kiitos alkuperäisestä siniaaltofunktiostaan. -cce     "
    Repeat
       aika = Timer()-start
       Gosub UpdateAudio
       shake# = shake# * 0.92
       DrawImage bg, -10+shake*7, -10+shake*7
       For y=0 To 16
       For x=0 To 24
          If kuva(x,y) Then
             xx#=  Cos( (aika Shr 3)) * x - Cos(aika Shr 4)*16 + Rnd(-shake,shake)
             yy#=y-5.1 + Sin( aika Shr 6 )*6 + Rnd(-shake,shake)
             zz#=Sin( (aika Shr 3)) * x - 50 + Rnd(-shake,shake)
             'Box x*8+100,y*8+110,4,4,1
             Box 200+(xx# * 300) / zz#, 150+(yy# * 300) / zz#, 4,4 , 1
          EndIf
       Next x
       Next y
       
       x=( aika Shr 5 ) Mod (Len(skrol$)*8)
       Text 10-x ,260+Sin(aika / 12  )*10+rnd(-shake*3.5,shake*3.5) , skrol$
       DrawScreen
    '   Wait 2
    Forever

    InitAudio:
    // pohjana käytetty valtzun funktioita
    lead = SinWave(262, 0.08,50, 1.0,  3.0)
    laulu= SinWave(523, 0.16,50, 1.0,  2.1)
    bass= SinWave(131, 0.31,50, 1.0, 2.8)
    runpu= SinWave(262, 0.21,50, 1.0, 3.0, 0.9998)
    snare=SinWave(262, 0.21,50, 1.0, 3.0, 0.8521,1)
    bpm = 180
    HitInterval = 60000 / (bpm*4)
    LeadLine$ = "E2 a2 h2 E2 a2 h2 E2 a2 h2 E2 a2 h2 E2 a2 h2 D3 E2 a2 h2 E2 a2 h2 E2 a2 h2 D2 G2 A2 D2 G2 A2 F#2"
    BassLine$ = "E1 E1 E1 D1"
    LauluLine$ = "z z E2 D2 D2 z z E2 D2 D2 z E2 D2 D2 H1 D2 z z E2 D2 D2 z z E2 D2 D2 z E2 D2 D2 H1 D2 z z E2 D2 D2 z z E2 D2 D2 z E2 D2 D2 H1 D2 z z H2 D2 D2 z z E2 D2 H1 H1 A1 G1 A1 E1 E1 "
    LeadPItuus=CountWords(LeadLine$)
    BassPituus=CountWords(BassLine$)
    LauluPituus=CountWords(LauluLine$)
    Dim LeadNotes(LeadPituus) As String
    Dim BassNotes(LeadPituus) As String
    Dim LauluNotes(LauluPituus) As String
    For i=0 To LeadPituus
       LeadNotes(i) = GetWord(LeadLine$, i+1)
    Next i
    For i=0 To BassPituus
       BassNotes(i) = GetWord(BassLine$, i+1)
    Next i
    For i=0 To LauluPituus
       LauluNotes(i) = GetWord(LauluLine$, i+1)
    Next i
    Return

    UpdateAudio:
       Gosub UpdatePos
       
       If OldPos <> Pos Then
          If Pos Mod 2 = 0 Then
             PlaySound lead, 70,35, nuotti( LeadNotes(LeadMatka Mod LeadPituus) )
             LeadMatka = LeadMatka + 1
             PlaySound lead, 40,-35, nuotti( LeadNotes(3 Mod LeadPituus) )
             If lower(LauluNotes(LauluMatka Mod LauluPituus)) <> "z" And matka > 128 Then
             PlaySound laulu, 60, 10, nuotti( LauluNotes(LauluMatka Mod LauluPituus))
             PlaySound lead, 30, 10, nuotti( LauluNotes(LauluMatka Mod LauluPituus))
             EndIf
             LauluMatka = LauluMatka + 1
          EndIf
       
          If pos = 2 Then
             PlaySound snare,70,0
          EndIf
          If pos16 =8 Then
             PlaySound runpu, 70,0, 44100
          '   PlaySound bass, 40,0, nuotti( BassNotes( BassMatka Mod BassPituus ) )
             PlaySound bass, 70,0, nuotti( "E1" )
             shake#=0.6
          EndIf
          If pos32 =30 And pos64 < 60 Then
          PlaySound runpu, 70,0, 44100
          '   PlaySound bass, 40,0, nuotti( BassNotes( BassMatka Mod BassPituus ) )
             PlaySound bass, 70,0, nuotti( "D1" )
             shake#=0.6
          EndIf
          If pos64 = 62 Then
          PlaySound runpu, 70,0, 44100
             PlaySound bass, 70,0, nuotti( "G1" )
             shake#=0.6
          EndIf
          If matka > 512 Then
             MatkaMinus = 512
          EndIf
       
       EndIf
    Return

    UpdatePos:
       OldPos = pos
       

       Matka = aika / HitInterval -MatkaMinus
       pos = matka Mod 8
       pos16 = matka Mod 16
       pos32 = matka Mod 32
       pos64 = matka Mod 64
    Return


    Function SinWave(taajuus#, pituus#, voimakkuus#=100, kerroin#=1.0, gain#=1.0, slide#=1.0, noise=0)
        fq=44100
        length=pituus*fq
        f=OpenToWrite("tmpwav.tmp")

        WriteInt f,$52494646   // RIFF
        WriteInt f,0         // koko, tähän palataan myöhemmin
        WriteInt f,$57415645   // "WAVE" (ASCII Characters)
        WriteInt f,$666d7420    // "fmt_" (ASCII Characters)
        WriteInt f,16   // always 0x10 = 16
        WriteShort f,1   // always 0x01
        WriteShort f,1  // Channel Numbers(0x01=mono, 0x02=stereo )
        WriteInt f,fq   // Samplerate (Binary, in Hz)
        WriteInt f,fq*2 // Bytes Per Second
        WriteShort f,2  // Bytes per sample, 2=8bit stereo, or 16bit mono
        WriteShort f,16 // bits per sample
        WriteInt f,$64617461 // "data" (ASCII Characters)
        WriteInt f,length*2   // length of Data To follow
        vokke# = voimakkuus/100*32767
        For i = 0 To length-1
          taajuus = taajuus * slide#
          vokke# = vokke# * kerroin#
          kohta#=Sin(360.0*taajuus/fq*(i Mod fq))*vokke
          Select noise
             Case 0
                WriteShort f, Min(32600, kohta#*gain)
             Case 1
                WriteShort f,Rand(255)*vokke
             Default
                WriteShort f, Min(32600, kohta#*gain)
          EndSelect
           
          'WriteShort f,Rand(255)*vokke
        Next i
        fs=FileOffset(f)-8   // palataan kokoon
        SeekFile f,4   
        WriteInt f,fs   // ja sinne siististi tiedoston koko

        CloseFile f
        tmpsnd=LoadSound("tmpwav.tmp")
       DeleteFile "tmpwav.tmp"
        Return tmpsnd
    End Function

    Function nuotti(in$)
       oct = Int(Right(in$,1))

       Select Lower(Left( in$ ,Len(in$)-1))
          Case "c"
             note=0
          Case "c#"
             note=1
          Case "d"
             note = 2
          Case "d#"
             note=3
          Case "e"
             note=4
          Case "e#"
             note=5
          Case "f"
             note=5
          Case "f#"
             note=6
          Case "g"
             note=7
          Case "g#"
             note=8
          Case "a"
             note=9
          Case "a#"
             note=10
          Case "b"
             note = 10
          Case "bb"
             note = 10
          Case "h"
             note=11
          Case "h#"
             note=12
       EndSelect
       freq=44100*(1.05946)^(note+12*(oct-2))
       Return freq
    EndFunction

    CreateKuva:


    img(0)="#########################"
    img(1)="#########################"
    img(2)="#########################"
    img(3)="#$$$$$$$$$$$$$$$$$$$$$$$#"
    img(4)="#########################"
    img(5)="#$$$$#$$$$#$#$#$$$$#$$$$#"
    img(6)="#$##$#$##$#$#$#$##$#$##$#"
    img(7)="#$##$#$##$#$#$#$##$#$##$#"
    img(8)="#$$$##$##$##$##$##$#$$$##"
    img(9)="#$##$#$##$#$#$#$##$#$##$#"
    img(10)="#$##$#$$$$#$#$#$$$$#$##$#"
    img(11)="#########################"
    img(12)="#$$$$$$$$$$$$$$$$$$$$$$$#"
    img(13)="#########################"
    img(14)="#########################"
    img(15)="#########################"
    img(16)="#########################"

    Return
Last edited by CCE on Sun Dec 06, 2009 2:46 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 »

CCE wrote:Tein tämmöisen pikkuisen intron näin perjantai-illan ratoksi:

Code: Select all

koodia...
Aikas komea, musasta tykkäsin kovasti :D
Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua :roll:
Image
phons
Guru
Posts: 1056
Joined: Wed May 14, 2008 10:11 am

Re: Efektit

Post by phons »

Wow... Siinä varmaan onkin mennyt hetki funtsia tuollaisen äänen lennosta tekemiseen, ja tuo 3D-tekstikin oli tosi hieno kun se värisi...
Image
User avatar
kaneli2000
Guru
Posts: 1059
Joined: Mon Mar 17, 2008 2:40 pm
Location: Lempäälä

Re: Efektit

Post by kaneli2000 »

CCE:n intro == :o.
I see the rainbow rising
koodaaja
Moderator
Moderator
Posts: 1583
Joined: Mon Aug 27, 2007 11:24 pm
Location: Otaniemi - Mikkeli -pendelöinti

Re: Efektit

Post by koodaaja »

No jos nyt taas jotain perustylsää ettei topikin taso nouse liian korkeaksi.

IFS:ää kaasopelin keinoin:

Code: Select all

SCREEN 400, 800

x# = .0
y# = .0

Lock
For i = 0 To 1000000
    a# = Rnd(1)
    tmpx# = x
    tmpy# = y
    If a<0.01
        x = 0.0
        y = 0.16*tmpy
    ElseIf a<0.08
        x = 0.20*tmpx - 0.26*tmpy
        y = 0.23*tmpx + 0.22*tmpy + 1.6
    ElseIf a<0.15
        x = -.15*tmpx + 0.28*tmpy
        y = 0.26*tmpx + 0.24*tmpy + 0.44
    Else
        x = 0.85*tmpx + 0.04*tmpy
        y =-0.04*tmpx + 0.85*tmpy + 1.6
    EndIf
    lul = GetPixel2(220-(x*60), 670-(y*60))
    PutPixel2 220-(x*60), 670-(y*60), lul + 10
Next i
Unlock
DrawScreen
WaitKey
Jos näyttääpi liian rumalta niin oman koneensa tehojen puitteissa voi iteraatioiden määrää lisätä ja kirkkauksen lisäämisen määrää vähentää.
Tuxi
Active Member
Posts: 190
Joined: Wed Jan 21, 2009 10:25 pm
Contact:

Re: Efektit

Post by Tuxi »

Hieno on. Tarkaittaako muuten tuo iteraatioiden määrä sitä, että monta kertaa tuo for-silmukka läpikäydään?
Projektit:
Jotain pientä (Ehkä vähän suurempaakin)

-Tuxi- (myös Tuxi4321)
koodaaja
Moderator
Moderator
Posts: 1583
Joined: Mon Aug 27, 2007 11:24 pm
Location: Otaniemi - Mikkeli -pendelöinti

Re: Efektit

Post by koodaaja »

Kyllä vaan, i -kirjaimen käyttö taitaa jopa alunperin tulla sanasta 'iterator' eli muuttuja joka käy läpi arvoja. Pitäisi joskus viritellä jotain hauskempaa IFS:ää randomikaavoilla mutta siinä alkaa CB:n nopeus tulla vastaan kun ei oikein jaksaisi useampaa tuntia renderöidä yhtä kuvaa, etenkään kun ei voi olla varma tuleeko lopputuloksena kuvaa ollenkaan.
User avatar
CCE
Artist
Artist
Posts: 650
Joined: Mon Aug 27, 2007 9:53 pm

Re: Efektit

Post by CCE »

Joops eli tälläisen varsin raskaan rotozoomerin hommailin. Itselläni fps on noin kymmenen :P

Code: Select all

SCREEN 160,120,0,2
Dim tex(64,64) // generoidaan tekstuuri
Gosub imageData
start=Timer()
Repeat
aika = Timer()-start
kulma2# = WrapAngle( aika / 11 )
scale# = (2.1-Sin( WrapAngle( aika / 14 ) ) ) * 0.5
posx#= Cos(WrapAngle( aika / 7 )) * 64
posy#= Sin(WrapAngle( aika / 6 )) * 64
Lock SCREEN()
	For y=0 To 119
	For x=0 To 159
		PystyX# = Cos(kulma2)*x
		PystyY# = Sin(kulma2)*x	
		vaakaX# = Cos(kulma2+90)*y
		VaakaY# = Sin(kulma2+90)*y
		screenx = Abs( ( x + PystyX + VaakaX + posx )*scale Mod 64 ) 
		screeny = Abs( ( y + PystyY + VaakaY + posy )*scale Mod 64 ) 
		PutPixel2 x, y, (tex(screenx, screeny))
	Next x
	Next y
Unlock SCREEN()
SetWindow Str(FPS())
	DrawScreen
Forever
Function rgb(_r,_g,_b)
Return _b + (_g Shl 8) + (_r Shl 16) + (255 Shl 24)
End Function 
imageData:
Dim pal(47)
pal(0)=-7827859
pal(1)=-5459064
pal(2)=-6117512
pal(3)=-10130860
pal(4)=-4274537
pal(5)=-5723241
pal(6)=-7102622
pal(7)=-7629982
pal(8)=-3158079
pal(9)=-10261689
pal(10)=-12104648
pal(11)=-14276322
pal(12)=-16117235
pal(13)=-16049121
pal(14)=-13355223
pal(15)=-7829129
pal(16)=-16776448
pal(17)=-15001072
pal(18)=-11842233
pal(19)=-16769246
pal(20)=-16698821
pal(21)=-12964094
pal(22)=-16755611
pal(23)=-16750464
pal(24)=-16748144
pal(25)=-16419429
pal(26)=-16742217
pal(27)=-1644580
pal(28)=-196869
pal(29)=-16770304
pal(30)=-16756992
pal(31)=-16697343
pal(32)=-16636672
pal(33)=-4859730
pal(34)=-16744704
pal(35)=-16750848
pal(36)=-9519237
pal(37)=-131615
pal(38)=-7679364
pal(39)=-16737022
pal(40)=-12278976
pal(41)=-394294
pal(42)=-9085696
pal(43)=-1855232
pal(44)=-211200
pal(45)=-268032
pal(46)=-4616192
pal(47)=-6259456

imgLogo=MakeImage(65,65)
Dim img(65) as String
img(0)="#$%%%$%%#####&#%#%%%$%%%$%%%%%%%#$$%$%$$$$$%$##########&######&&&"
img(1)="%$$$$$$$$'$$$$$$$$$$$$$($$$($$$$$$$$$$$$$$$$$$$$$$$$$$$'$$'$$$$'&"
img(2)="#$$$$$($$%%$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$%$%$%$%$%$$$$$$$$'&"
img(3)="$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$%$%$$%$$$$$$$$$'&"
img(4)="$$($$$$$$$%$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$%$%%%$$$$$$$$$$$$'&"
img(5)="$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$($$$$$$$%%%)%)%%%$$$'$$$$$$'&"
img(6)="$$$$$$$$$$$$$$$$$$$$$($$$$$$$$$$$$$$$$($$$%$%**)*)#*$$$$$('$+$''&"
img(7)="$$$$$$$$$$$$$$$$$$$$$'($$$$($($$$$$$$$%%$$$%%*),-./01-2('+$$$$$'&"
img(8)="$$$$$$$$$$$$$$$$$$($$$$$($$$$$$$($$$$$$$%$%%)*-/33333331#$$+$+$'2"
img(9)="$$$$$$$$$$$($$$$$$$$$$$'$$$$$$$$$$$%%%%%%%%%,133/1--14331$$$$$$'&"
img(10)="$$$$($%$$$$$$$$$$$$$$$$$$$$$%%%%%%%%%%%%%%%*133.&*%%%#5/1('$'$+'&"
img(11)="$$$$$$$$$$$$$$$$$$$$%$$$$$$$$%%%%%%%%%%%%*)-33.#)**)%$$#$$$$$$$'&"
img(12)="$$$$$$$$$$$$$$$$$%$$$$$$%$%%%%%%%%%%%%**))*.3.,))**)%%$$$$$+$$$'&"
img(13)="$$$$$$$$$%$%$$$$$$%%%%%%%*%*%%%**#,&--1--,-3/,)**)**)%%$$$$$'$$$#"
img(14)="$$$$$$$%$$$$%(%$$$%%%%%%*)*)*,-14333333333333-*)*%)%%%%%%$$$('$$#"
img(15)="$$$$$$$%%$$$$$$%%%%%%%%))*,-.33333066766//3333/-,***)%%$%%$$$$$'#"
img(16)="$$$$$$($$$%$$$$$%%%%%%%*,843330799:;;;<;:997633331,#)%%%$$$$$$('#"
img(17)="$$$$$$$%$$$%%%%%%%%%%%*-333/69:;=====<<;<;::997/3331,*)%%$$$$$$$#"
img(18)="$$$$$$$$$$%%%%%%%%%%*133309<<==<===<<<<;<;;;:::97033/-#%%%$$$$$'&"
img(19)="($($$$$$$$$%%%%%%)#-33369=====<=<<=<<<<<;<::;;:::97333.*%%$$$$$'&"
img(20)="%$$$$$$$%$%%%%%)*,.3309<=========<<<<<<<;;<;:::9:::9633.,%$$$$$$&"
img(21)="$$$$$$%%%%%%%%**-4337;======;=;=<<<<<<<<;<;:;;;:::996/3341-&#%%'1"
img(22)="$$$$$$%$%%%)%)#133369;=========<;<<<<<;<<;<;;:::996/33333333.&*'."
img(23)="$$$$$%%%%***-.3333333/7:====;=<<<;<<<<<<;<;;:;:90333.15&&-5433.#."
img(24)="%$$$$%*%*,-4333.1--1143309;===;=<<<<<<<<<;;;;:7/34-2+>????>+-/34/"
img(25)="2$$%$%%%,.334-2++++>+(21337:==<;<<<<<<<<<;;;:733-(>?????????>(.33"
img(26)="#$$%%$%-33/&+>?????????+&436:=<<<<<<<<<<<<;;9/35+?????????????+13"
img(27)="#$%$$%-331+??????????????(.36:<<<<<<<<;<;<;933->?>+2222(+??????>4"
img(28)="#$%$$#33&>?????>(22&22+>??+.37;<<<<<<<;<<;;731+>(133333345(>????5"
img(29)="&$$%%-3->????>(54333334-(>?(437<<;<<<<<<<;9/3(+&333.@//3333-(???5"
img(30)="&$$$#/3(????(-4333/4/33342?>&36;<<<<<<<<<;731+533&(+%AABC/3342??5"
img(31)="&'$#&3&????24331,BBAABC4332?+439<<<<<<<<<:0322332>???DEFAAC/332?5"
img(32)="&'$#.3(???&331(?>DFFFFAA@3/(?-37;<<<<<;<;934243&??????GFFFFB434+5"
img(33)="&$$&31>??(33&>???HIEEEEFB/31>230;<<<<<<<;73-&33#??????GEJKEFC3325"
img(34)="-'%03&??+135>?????IJJIDIAB332(43:<<<;<<<;63143@)??????DKL?DKAC314"
img(35)=".'#33(??(33(??????IJI??HEA@312439<<<<<<<:0343/BFD?????GG???KAB343"
img(36)=".'234(??&3@*??????)A$??>KFB342.39<<<<<<<:/333@AEI>??>(A)???KFB/33"
img(37)="1'&3.+??13CFD????(./1+HIJEA/3-439<<<<<<<90333CAFJKKG&.3/%DIJFA@33"
img(38)=".'&31>?+13CFEKII$1333BJJEFF@31439<<<<<<<9033/BAEEJJA3333AJJEFAC33"
img(39)=".%43.+?>.3CAEEEKA333/BJJEEA@34339<<<<<<<9/33/BFEJJJB3333AJJEEA@33"
img(40)=".&334+?>.3CFFEJKFC334FJJEEA@3330<<<<<<<<:033/BAEJJJE@33/EJJEFB/33"
img(41)="/.333&?>13CAFEJJJEABFJJEEFA/3336;<<<<<<;9633/BAEJJKJEABAJJJEFB/33"
img(42)="33/634+?-3@AEEEJJJJJJJJJEFB33337<<<<<<;;;7333CAFEEJJJJJKJJEFAB3.4"
img(43)="337;03.+(33BFEEJJJJKJJJEFFC3330:<<;<;<;;:9333/BFFEEEJJJJEEEFA/351"
img(44)="33:=<03.213/AFEEJJJEEEEFAB/3336777977979996333/BAFEFEJEJEFAB@33+5"
img(45)="37===:63..33@AFFFFEEFFFAB@3333333333333336/33333CAAFFEFFFAAC33&?5"
img(46)="39====:033333/BBAAAAABBC/333338888888844333333333/CBAAABCC433->?5"
img(47)="/;===<=:633333333//4//333338MNOPOOONNNNQQM8333333333///33333&>+23"
img(48)="0====<==<70333333333333334RPPPPPPOOOOOOONOQM43333333333334-2(2433"
img(49)="7===<=<==<970333333333338RPPPPOOOOOOOOONNNNNM3333333333334513330/"
img(50)="7=====<=<<<;977666033333MOPPPOOOOOOOOONOONQNM33333333333333336796"
img(51)="7==;==<=<<<<<;;<996333334ROOOOOOOOOOONONNQNNM34&543333/779799::;6"
img(52)="7===<=;<<<<<<<;9633/122-338QNNOOOOONONNNQQRM33&??>2-43309:;;;;;<6"
img(53)="7==;==<<<<<<<:7334-(>??+&4338MMRRQQQRRRMM83331(?????(&.3369:;;;;6"
img(54)="7===;<<<<<<<:6335(>?????>(-3333334444333333.&+???????>',3307:;;;7"
img(55)="7=<==<<<<<;9/34(>?????????>(25.44333344.1&(+??????????LL%13/7:;;6"
img(56)="7===;<;<<:7331(???????????????>+++((++>>??????????????LLL'*3369<6"
img(57)="7==<<<<<9633&+?????????????????????????????????????????HLLL%4/6:6"
img(58)="7==;<<<:6342?????????????????????????????????????????????HLL%4376"
img(59)="7=<<<<:634(??????????????????????????????????????????????HLLL,330"
img(60)="7==;<;734(???????????????????????????????????????????????HLLLL,33"
img(61)="7=<<;9332???????????????????????????????????????????????HLLLLL'43"
img(62)="7=<<:63->???????????????????????????????????????????????>LLLLLL,3"
img(63)="7=<<73.>?????????????????????????????????????????????????HHHHHHL4"
img(64)="0777334555555555555555555555555555555555555555555555555551-11-113"

For y=0 To 64
For x=0 to 64
tex(x,y) = pal(Asc((Mid(img(y), x+1, 1)))-35)
Next x
Next y

Return
User avatar
Ruuttu
Devoted Member
Posts: 688
Joined: Thu Aug 30, 2007 5:11 pm
Location: Finland, Sipoo

Re: Efektit

Post by Ruuttu »

CCE wrote:Joops eli tälläisen varsin raskaan rotozoomerin hommailin. Itselläni fps on noin kymmenen :P
FPS oli tasaiset 31 kuvaa sekunnissa. Hyvä saavutus ja hieno on.
DatsuniG
Advanced Member
Posts: 367
Joined: Fri Aug 15, 2008 9:57 pm

Re: Efektit

Post by DatsuniG »

Jotakin säätöä vaihteeksi:

Code: Select all

X = ScreenWidth() / 2
Y = ScreenHeight() / 2
Angles = 5
rad As Float = 28
RadMax = 66
Size = 10
Pulse As String ="--#-###--#--#-##"
PulseLength = 250
Repeat
    If Timer() - PulseTimer > PulseLength Then 
        PulseTimer = Timer()
        If PulsePointer < Len(Pulse) Then PulsePointer + 1 Else PulsePointer = 1
    Else 
        If Mid(Pulse, PulsePointer, 1) = "#" Then 
            dir = 1
            Rad = CurveValue(RadMax / 4,rad,10.0)
        Else 
            dir = -1
            Rad = CurveValue(RadMax,rad,10.0)
        EndIf 
    EndIf 
    angle = WrapAngle(angle + dir)
    For a = 0 To Angles - 1
        Line2(x + Cos(Angle + 360 / Angles * a) * rad, y - Sin(Angle + 360 / Angles * a) * rad, x + Cos(Angle + 360 / Angles * a + 360 / Angles / 2) * (rad * 0.6), y - Sin(Angle + 360 / Angles * a + 360 / Angles / 2) * (rad * 0.6), Size)
        Line2(x + Cos(Angle + 360 / Angles * a) * rad, y - Sin(Angle + 360 / Angles * a) * rad, x + Cos(Angle + 360 / Angles * (a - 1) + 360 / Angles / 2) * (rad * 0.6), y - Sin(Angle + 360 / Angles * (a - 1) + 360 / Angles / 2) * (rad * 0.6), size)
    Next a
    DrawScreen
Forever 

Function Line2(x,y,x2,y2,size)
    For a = 0 To Distance(x,y,x2,y2)
        Circle (x + Cos(GetAngle(x,y,x2,y2)) * a) - Size / 2, (y - Sin(GetAngle(x,y,x2,y2)) * a) - Size / 2, Size
    Next a
EndFunction 
Hengität nyt manuaalisesti.
Post Reply