Efektit

[mkn]

Täämmönen o tullu väsättyy:

Code: Select all

SCREEN 640,480,0
uusio:
aika=1
ellix=250
elliy=250
ellipsihal=250
ellipsihaly=250
ellipx=390
ellipy=230
Linja=0
linjay=280
Repeat
aika=aika+1 
väri1=Rand (1, 360)
väri2=Rand (1, 360)
väri3=Rand (1, 360)
ClsColor väri1*2,väri2*2,väri3*2
Color cbRed
ellix=ellix-1
elliy=elliy-1
ellipy=ellipy-1
ellipx=ellipx-1
Ellipse ellipx, ellipy,ellix ,elliy,0
ellix=ellix-1
elliy=elliy-1
ellipy=ellipy-1
ellipx=ellipx-1
Color cbdark
Ellipse ellipx, ellipy,ellix ,elliy,0
Color väri1,väri2,väri3 
Ellipse ellipx, ellipy,ellix ,elliy,0
Color väri1,väri2,väri3 
Line linja,linjay,ellix-5 , elliy-5
If aika=300 Then Cls Then Goto uusio  
DrawScreen OFF 
Forever 

[Wingman]

oho, ompas jännä itekki jotain tommosta vääntäny...

[mkn]

Väsäsin tämmösen "3D-jutun" kommentoikaa:D

Code: Select all

SCREEN 640,480,cb
x=320
y=240
kx=320
ky=240
pos=0
posy=0
Repeat
pos=pos+1
posy=posy+1
Color cbwhite
x=x-1
y=y-1
kx=kx-1
ky=ky-1 
Box x, y, kx, ky,0
Color cbblack
Line 320,240,kx,ky
Line 320,480,kx,ky
Line 640,240,kx,ky
Color cbblue
DrawScreen OFF
Box x+2, y+2, kx+2, ky+2,0
Forever 

[mkn]

Modasin edellistä efektiäni...

Code: Select all

SCREEN 640,480,cb
x=320
y=240
kx=320
ky=240
pos=0
posy=0
Repeat
pos=pos+1
posy=posy+1
Color cbwhite
x=x-1
y=y-1
kx=kx-1
ky=ky-1 
Box x, y, kx, ky,0
Color cbblack
Line 320,480,kx,ky
Line 640,240,kx,ky
Color cbblue
DrawScreen OFF
Forever 

[phons]

Aika outo, mutta silti ihan siisti, vaikka ei tuo kovin 3D:ltä näyttänyt.. :S Ja käytä sitä Edittiä..

[Wingman]

Yhdyn edelliseen, aika outo, mutta siisti...

[Jonhu]

Yksinkertainen 3d pallo ( tai tarkemmin 3d:tä muistuttava pallo ):
- zoomaus hiirellä

Code: Select all

Type vertex
    Field x As Float
    Field y As Float
    Field z As Float
EndType

sw = ScreenWidth()/2
sh = ScreenHeight()/2

InitDots()

pallo_r = 120

Repeat

    pallo_r = pallo_r + MouseMoveZ()*5

    Color 50,50,50
    Circle sw-pallo_r,sh-pallo_r,pallo_r*2

    RotateZ( 0.5 )
    RotateY( 0.5 )
  //RotateX( 0.5 )
    
    Color cbwhite
    For aa.vertex = Each vertex
        If aa\z < 0 Then
            Dot aa\x * pallo_r + sw, aa\y * pallo_r + sh
        EndIf
    Next aa
    
    Text 10,10,"FPS: " + FPS()

    DrawScreen

Forever

Function InitDots( maara=1000 )
    
    For a=1 To maara
        aa.vertex = New( vertex )
        
        // paikkavektori v = xi + yj + zk  tai toinen merkintätapa: v = ( x, y, z )
        aa\x = Rnd(-1000,1000)
        aa\y = Rnd(-1000,1000)
        aa\z = Rnd(-1000,1000)
        
        length# = Sqrt( aa\x * aa\x + aa\y * aa\y + aa\z * aa\z )
        
        // vektoreiden normalisointi...
        If length# <> 0 Then
            aa\x = aa\x / length#
            aa\y = aa\y / length#
            aa\z = aa\z / length#
        EndIf
    Next a
    
EndFunction

// kääntää pisteitä z-akselin ympäri
Function RotateZ( ang# )
    // hieman nopeampaa laskea etukäteen hitaammat laskutoimitukset?
    cosa# = Cos( ang# )
    sina# = Sin( ang# )
    For aa.vertex = Each vertex
        px# = aa\x * cosa# - aa\y * sina#
        py# = aa\x * sina# + aa\y * cosa#
        aa\x = px
        aa\y = py
    Next aa
EndFunction

Function RotateY( ang# )
    cosa# = Cos( ang# )
    sina# = Sin( ang# )
    For aa.vertex = Each vertex
        pz# = aa\z * cosa# - aa\x * sina#
        px# = aa\z * sina# + aa\x * cosa#
        aa\z = pz
        aa\x = px
    Next aa
EndFunction

REMSTART
Function RotateX( ang# )

    cosa# = Cos( ang# )
    sina# = Sin( ang# )
    
    For aa.vertex = Each vertex
        py# = aa\y * cosa# - aa\z * sina#
        pz# = aa\y * sina# + aa\z * cosa#
        aa\y = py
        aa\z = pz
    Next aa
    
EndFunction
REMEND

Läpinäkyvä versio:

Code: Select all

Type vertex
    Field x As Float
    Field y As Float
    Field z As Float
EndType

sw = ScreenWidth()/2
sh = ScreenHeight()/2

InitDots()
pallo_r = 120
lapinakyvyys = 1

Repeat
    Color 50,50,50
    pallo_r = pallo_r + MouseMoveZ()*5
    Circle sw-pallo_r,sh-pallo_r,pallo_r*2
    
    If KeyHit(cbkeyspace) Then lapinakyvyys = Not lapinakyvyys
    
    RotateZ( -0.5 )
    RotateY( 0.5 )

    For aa.vertex = Each vertex
        If aa\z < 0 Then
            Color cbsilver
            Dot aa\x * pallo_r + sw, aa\y * pallo_r + sh
        ElseIf lapinakyvyys = ON
            Color cbwhite
            Dot aa\x * pallo_r + sw, aa\y * pallo_r + sh
        EndIf
    Next aa
   
    Text 10,10,"FPS: " + FPS()
    DrawScreen
Forever

Function InitDots( maara=1000 )
    For a=1 To maara
   
        aa.vertex = New( vertex )
        aa\x =  Rnd(-1000,1000)
        aa\y =  Rnd(-1000,1000)
        aa\z = Rnd(-1000,1000)
       
        length# = Sqrt( aa\x * aa\x + aa\y * aa\y + aa\z * aa\z )
        If length# <> 0 Then
            aa\x = aa\x / length#
            aa\y = aa\y / length#
            aa\z = aa\z / length#
        EndIf
    Next a
EndFunction

Function RotateZ( ang# )
    cosa# = Cos( ang# )
    sina# = Sin( ang# )
    For aa.vertex = Each vertex
        px# = aa\x * cosa# - aa\y * sina#
        py# = aa\x * sina# + aa\y * cosa#
        aa\x = px
        aa\y = py
    Next aa
EndFunction

Function RotateY( ang# )
    cosa# = Cos( ang# )
    sina# = Sin( ang# )
    For aa.vertex = Each vertex
        pz# = aa\z * cosa# - aa\x * sina#
        px# = aa\z * sina# + aa\x * cosa#
        aa\z = pz
        aa\x = px
    Next aa
EndFunction

[koodaaja]

Hienoja palloja Jonhu, laita vielä vähän perspektiiviä niin muoto tulee selvemmin esille :>

Näin pouet.netin random gif -langassa näin hienon kuvan ja päätin, että tuollainenhan pitää väsäillä CB:llä.

Code: Select all

Const screenw = 1000
Const screenh = 800
i# = 256
p=1

SCREEN screenw, screenh

Lock
    For x = 0 To 2*i-1
        For y = 0 To 2*i-1
            PutPixel2 Int(x+screenw/2.0-i), Int(y+screenh/2.0-i), RoundDown(127+x/4.0) Shl 16 + RoundDown(128-y/4.0) Shl 8
        Next y
    Next x
Unlock

DrawScreen OFF
WaitKey

Repeat
    
    If p Mod 2 Then
        
        j = (screenh/2.0)-i*RoundDown((screenh/2.0)/i)
        k = 1-RoundDown((screenh/2.0)/i) Mod 2
        
        Repeat
            CopyBox 0, j, screenw, int(i), RoundDown((Float(k Mod 2)-.5)*i-screenw/2.0), RoundDown(j-screenh/2.0)
            k = k + 1
            j = j + i
        Until j > screenh
        
    Else
        
        j = (screenw/2.0)-i*RoundDown((screenw/2.0)/i)
        k = RoundDown((screenw/2.0)/i) Mod 2
        
        Repeat
            CopyBox j, 0, int(i), screenh, RoundDown(j-screenw/2.0), RoundDown((Float(k Mod 2)-.5)*i-screenh/2.0)
            k = k + 1
            j = j + i
        Until j > screenw
        
    EndIf
    
    p = p + 1
    i = i/2.0
    
    DrawScreen OFF
    WaitKey
    
Until i < 1

Editoidaas vielä animoitu versio tähän:

Code: Select all

Const screenw = 1000
Const screenh = 800
i# = 256
p=1

SCREEN screenw, screenh

Lock
    For x = 0 To 2*i-1
        For y = 0 To 2*i-1
            PutPixel2 Int(x+screenw/2.0-i), Int(y+screenh/2.0-i), RoundDown(127+x/4.0) Shl 16 + RoundDown(128-y/4.0) Shl 8
        Next y
    Next x
Unlock

DrawScreen OFF
WaitKey

Repeat
    If p Mod 2 Then
        d# = (screenh/2.0)-i*RoundDown((screenh/2.0)/i)
        g# = 1-RoundDown((screenh/2.0)/i) Mod 2
        For w = 1 To RoundUp(i/2.0)
            j = d
            k = g
            Repeat
                CopyBox 0, j, screenw, int(i), RoundDown((k Mod 2)*(1+(i>1.0))-1-screenw/2.0), RoundDown(j-screenh/2.0)
                k = k + 1
                j = j + i
            Until j > screenh
            DrawScreen OFF
        Next w
    Else
        d# = (screenw/2.0)-i*RoundDown((screenw/2.0)/i)
        g# = RoundDown((screenw/2.0)/i) Mod 2
        For w = 1 To RoundUp(i/2.0)
            j = d
            k = g
            Repeat
                CopyBox j, 0, int(i), screenh, RoundDown(j-screenw/2.0), RoundDown((k Mod 2)*(1+(i>1.0))-1-screenh/2.0)
                k = k + 1
                j = j + i
            Until j > screenw
            DrawScreen OFF
        Next w
    EndIf
    
    p = p + 1
    i = i/2.0
    
    DrawScreen OFF
    WaitKey
    
Until i < 1

[Jonhu]

Joo olisihan tuo tyylikkäämpi, jos siihen lisäisi persfektiivin ja värisävyt, mutta tarkoitin tuon yksinkertaiseksi esimerkiksi. Pallon luontiakin voi editoida, että tekee jonkun säännönminkä mukaan pisteitä luodaan, niin saa aikaiseksi ihan mielenkiintoisia kuvioita

Tässä tälläinen randomilla toimiva fraktaali...

Code: Select all

Repeat
    Fraktaali( 0,0, ScreenWidth(), ScreenHeight() )
    DrawScreen 
    WaitKey
Forever

Function Fraktaali( x1,y1, width, height, iter=70000)

    Dim alue(width, height, 3)
    px# = width/2 : py# = height/2.0 
   
    For a=0 To iter
        px = px + Rand(-1,1) //Sin(Rnd(90))*a/1000
        py = py + Rand(-1,1) //Sin(Rnd(90))*a/1000
        If px>=0 And py>= 0 And px<width And py<height Then
            alue( Int(px), Int(py), 0 ) = Min(alue( Int(px), Int(py), 0 ) + Rand(1,15),255)
            alue( Int(px), Int(py), 1 ) = Min(alue( Int(px), Int(py), 1 ) + Rand(1,15),255)
            alue( Int(px), Int(py), 2 ) = Min(alue( Int(px), Int(py), 2 ) + Rand(10,15),255)
        Else
            px = width  / 2.0
            py = height / 2.0 
        EndIf
    Next a
    
    // piirto.. voisi aijemmassakin piirtää, mutta selkeämpi kai näin (ja nopeampi, kun on pieni alue ja suuri iterin arvo)
    Lock SCREEN()
        For y=0 To height
            For x=0 To width
                PutPixel2 x1+x, y1+y, ( 255 Shl 24 ) + (alue( x, y, 0 ) Shl 16) + (alue( x, y, 1 ) Shl 8) + alue( x, y, 2 )
            Next x
        Next y
    Unlock SCREEN()
    
EndFunction

Joku diagrammia muistuttava härveli.. Tarkoitus oli tehdä fps:ää mittaava käyrä,mutta fps päivittyy ilmeisesti hieman turhan hitaasti, että saisi tyylikästä kaarevaa käyrää aikaiseksi. Taidan päivittää myöhemmin hieman tuon piirtotapaa,kun tuo ei ole mitenkään huippu kaunis pelkällä punaisella viivalla

Code: Select all

mem_sin = CreateDiagram( 100,50,160,50 )
mem_cos = CreateDiagram( 100,110,160,50 )
mem_FPS = CreateDiagram( 330,10,60,20 )
mem_rnd = CreateDiagram( 100,200,160,50 )


Repeat

    v = v + 1
    mem_FPS = UpdateDiagram( mem_FPS, FPS(),20 )
    mem_sin = UpdateDiagram( mem_sin, Abs(Sin(v)) )
    mem_cos = UpdateDiagram( mem_cos, Abs(Cos(v)) )
    mem_rnd = UpdateDiagram( mem_rnd, Rand(100),10 )
    
    mem_FPS = DrawDiagram( mem_FPS )
    mem_sin = DrawDiagram( mem_sin )
    mem_cos = DrawDiagram( mem_cos )
    mem_rnd = DrawDiagram( mem_rnd )
    
    Color cbwhite
    Text 300,18,"FPS:"
    Text 10,75,"|Sin(v)|"
    Text 10,125,"|Cos(v)|"
    Text 10,220,"Rand(100)"
    
    DrawScreen
Forever


Function CreateDiagram( x, y, width, height )
    mem = MakeMEMBlock( ( 6+width ) * 4 )
    PokeFloat mem, 0, x 
    PokeFloat mem, 4, y 
    PokeFloat mem, 8, width
    PokeFloat mem, 12,height 
    PokeFloat mem, 16, 0 // paikka max_arvolle, jolloin ei tarvitse käydä kaikkia läpi skaalauksen saamiseksi 
    PokeFloat mem, 20, Timer() // paikka ajalle
    For a=0 To width
        PokeFloat mem, a*4+24, 0
    Next a
    Return mem
EndFunction


Function DrawDiagram( mem )

    Color cbwhite
    starty = PeekFloat(mem,4) + PeekFloat(mem,12)
    Box PeekFloat(mem,0)-2,PeekFloat(mem,4)-2, PeekFloat(mem,8)+4, PeekFloat(mem,12)+4,0
    CenterText PeekFloat(mem,0)-TextWidth(""+Int(PeekFloat(mem,16)))/2-2,PeekFloat(mem,4)-TextHeight(""+Int(PeekFloat(mem,16)))/2,Int(PeekFloat(mem,16))
    
    Color cbred  // endy = starty - ( arvo / max_arvo ) * max_korkeus
    For a = 0 To PeekFloat(mem,8)
        endy    = starty-(PeekFloat(mem,24+a*4) / PeekFloat( mem, 16 ))*PeekFloat( mem, 12 ) // skaalaus suurimman arvon mukaan
        Line PeekFloat(mem,0)+a, starty, PeekFloat(mem,0)+a, endy
    Next a
    
    Return mem
EndFunction


Function UpdateDiagram( mem, uusi_arvo#, updatespeed = 50 ) // updatespeed = 50ms oletus
    If mem=0 Then MakeError "UpdateDiagram fail"
    If Timer() < PeekFloat( mem, 20 ) + updatespeed Then Return mem

    mem2 = MakeMEMBlock( MEMBlockSize(mem) )
    MemCopy mem, 0, mem2, 0, 24
    MemCopy mem, 28, mem2, 24, MEMBlockSize(mem)-24
    
    // skaalaus suuremmaksi
    If uusi_arvo# > PeekFloat( mem2, 16 ) Then 
        PokeFloat mem2, 16, uusi_arvo#
    
    // skaalaus pienemmäksi
    ElseIf PeekFloat( mem, 16 ) = PeekFloat( mem2, 24 )  Then
    
        // voisi olettaa myös jonkun pienen arvon tähän for-loopin tilalle, jolloin virhe korjautuisi seruraavilla kierroksilla...
        max_arvo# = 0
        For n=0 To PeekFloat(mem2,8)
            If PeekFloat( mem2, 24+n*4 ) > max_arvo# Then max_arvo# = PeekFloat( mem2, 24+n*4 )
        Next n
        
        // uusi max arvo paikalleen, jos muutosta tarpeeksi
        If uusi_arvo# - max_arvo# >= 5 Then PokeFloat mem2, 16, max_arvo#

    EndIf
    
    // uusi arvo paikalleen
    PokeFloat mem2, MEMBlockSize(mem), uusi_arvo#
    PokeFloat mem2, 20, Timer() 
    
    DeleteMEMBlock mem
    
    Return mem2
EndFunction

[koodaaja]

Jonhu, FPS:n suht hyvän likiarvon voi laskea joka frame edellisestä framesta kuluneesta ajasta.

Löysin tällaisen solutekstuuria luovan koodinpätkän kovalevyn syövereistä ja lisäsin siihen kuvan väriarvojen käytön.

Code: Select all

path$ = "media\map.bmp"

img = LoadImage(path$)

texw = ImageWidth(img)
texh = ImageHeight(img)

pointw = RoundDown(texw/4)
pointh = RoundDown(texh/4)

SCREEN texw, texh

img = LoadImage(path$)
ResizeImage img, texw, texh

Dim points(pointw-1, pointh-1, 1) As Float

For x = 0 To pointw-1
    For y = 0 To pointh-1
        points(x, y, 0) = max(0, Min(texw, x*(Float(texw)/Float(pointw))+Rnd(Float(texw)/Float(pointw))))
        points(x, y, 1) = max(0, Min(texh, y*(Float(texh)/Float(pointh))+Rnd(Float(texh)/Float(pointh))))
    Next y
Next x

For x = 0 To texw-1
    Lock
        For y = 0 To texh-1
            
            u = RoundDown(Float(x)/(Float(texw)/Float(pointw)))
            v = RoundDown(Float(y)/(Float(texh)/Float(pointh)))
            
            curdist# = 100.0
            ii = u
            jj = v
            For i = Max(0, u-1) To Min(pointw-2, u+1)
                For j = Max(0, v-1) To Min(pointh-2, v+1)
                    e# = Distance(x, y, points(i, j, 0), points(i, j, 1))
                    If curdist>e Then ii = i: jj = j
                    curdist = Min(curdist, e)
                Next j
            Next i
            
            c# = Max(0, Min(.8+curdist*.02, 1.0))
            
            p% = GetPixel2(points(ii,jj,0),points(ii,jj,1),Image(img))
            
            b = p Shl 24 Shr 24
            g = p Shl 16 Shr 24
            r = p Shl 8 Shr 24
            
            PutPixel2 x, y, int(255 Shl 25 + (r*c) Shl 16 + (g*c) Shl 8 + b*c)
            
        Next y
    Unlock
    DrawScreen OFF
Next x

a = 0

While a=0
    a = GetKey()
    DrawScreen OFF
Wend

[KillBurn]

@koodaaja.Getpixel2 aiheuttaa edelleen MAV:in joillakin tietokoneilla, mutta tosi hieno efekti.

[koodaaja]

@koodaaja.Getpixel2 aiheuttaa edelleen MAV:in joillakin tietokoneilla, mutta tosi hieno efekti.

Kas, tällaisesta en muista kuulleenikaan. No, mikäli se satunnaismavaa niin tässä pickimagecolorilla vastaava :>

Code: Select all

path$ = "media\map.bmp"

img = LoadImage(path$)

texw = ImageWidth(img)
texh = ImageHeight(img)

pointw = RoundDown(texw/4)
pointh = RoundDown(texh/4)

SCREEN texw, texh

img = LoadImage(path$)
ResizeImage img, texw, texh

Dim points(pointw-1, pointh-1, 1) As Float

For x = 0 To pointw-1
    For y = 0 To pointh-1
        points(x, y, 0) = max(0, Min(texw, x*(Float(texw)/Float(pointw))+Rnd(Float(texw)/Float(pointw))))
        points(x, y, 1) = max(0, Min(texh, y*(Float(texh)/Float(pointh))+Rnd(Float(texh)/Float(pointh))))
    Next y
Next x

For x = 0 To texw-1
    Lock
        For y = 0 To texh-1
            
            u = RoundDown(Float(x)/(Float(texw)/Float(pointw)))
            v = RoundDown(Float(y)/(Float(texh)/Float(pointh)))
            
            curdist# = 100.0
            ii = u
            jj = v
            For i = Max(0, u-1) To Min(pointw-2, u+1)
                For j = Max(0, v-1) To Min(pointh-2, v+1)
                    e# = Distance(x, y, points(i, j, 0), points(i, j, 1))
                    If curdist>e Then ii = i: jj = j
                    curdist = Min(curdist, e)
                Next j
            Next i
            
            c# = Max(0, Min(.8+curdist*.02, 1.0))
            
            PickImageColor img, points(ii,jj,0),points(ii,jj,1)
            
            b = getRGB(BLUE)
            g = getRGB(GREEN)
            r = getRGB(RED)
            
            PutPixel2 x, y, int(255 Shl 25 + (r*c) Shl 16 + (g*c) Shl 8 + b*c)
            
        Next y
    Unlock
    DrawScreen OFF
Next x

a = 0

While a=0
    a = GetKey()
    DrawScreen OFF
Wend

[Wingman]

tässä vähän kohinaa, nuolinäppäimistä vaihtaa valoisuuden ääripäitä:

Code: Select all

sw=400
sh=300
SCREEN sw,sh,0,2
Smooth2D ON 
mn=50
mx=250
Repeat 
	For x=0 To sw Step 4
		For y=0 To sh Step 3
			c=Rand(mn,mx)
			Color c,c,c
			Box x,y,4,3
		Next y
	Next x
	mn=mn+UpKey()-DownKey()
	mx=mx-LeftKey()+RightKey()
	If mx>255 Then mx=255
	If mx<0 Then mx=0
	If mn>255 Then mn=255
	If mn<0 Then mn=0
	SetWindow "1: "+mx+" 2: "+mn
	DrawScreen 
Forever 

[DatsuniG]

Fysiikan kolmos kurssin kunniaksi tein iki ihanan puhallinsoitin simulaation. Koodi on rumaa, mutta pitäisi toimia.

Ja jos ohjelma laskee taajuuden väärin niin asiasta voi ilmoittaa minulle

Code: Select all

FrameLimit 10 // Rajoitellaan hitusen
Const SCALE = 100 // Mittakaava 100 pixeliä = 1m
speed As Float = 340 // Äänennopeus ilmassa
length As Float = 20 // Aloituspituus
ends As Integer = 0 // Suljettujen päiden lukumäärä
tune = 0 // Ylävärähtely
Repeat
    Text 2, 2, "Pituus: " + length / SCALE + "m"
    Text 396 - TextWidth("Taajuus: " + Frequency(length / SCALE, 340 , tune, ends) + "Hz"), 2, "Taajuus: " + Frequency(length / SCALE, 340, tune, ends) + "Hz"
    Box 394 - TextWidth("Taajuus: " + Frequency(length / SCALE, 340 , tune, ends) + "Hz"), 1, 300, 16, 0
    Text 2, 284, "Suljetut päät: " + ends
    Text 400 - TextWidth("Ylävärähtely: " + tune), 284, "Ylävärähtely: " + tune
    length = max(1, length + button(2, 20, 2) - button(2, 45, 3))
    ends = Max(0, Min(1, ends - button(2, 262, 1) + button(24, 262, 0)))
    tune = Max(0, tune - button(356, 262, 1) + button(378, 262, 0))
    Line 200 - length / 2, 140, 200 + length / 2, 140
    Line 200 - length / 2, 160, 200 + length / 2, 160 
    If ends = 1 Then Line 200 + length / 2, 140, 200 + length / 2, 160 
    If play = 0 Then 
        If txtbutton(200 - TextWidth("Soita") / 2, 180, "Soita") Then 
            play = 1
            sound = SinWave(Frequency(length / SCALE, 340, tune, ends), 2)
            playtimer = Timer()
            PlaySound sound
        EndIf 
    EndIf 
    If Timer() - playtimer > 2000 Then play = 0 Else txtbutton(200 - TextWidth("Soitetaan") / 2, 180, "Soitetaan")
    DrawScreen 
Forever 

Function txtbutton(x,y,txt$)
    w = TextWidth(txt) + 4
    h = TextHeight(txt) + 4
    Box x, y, w, h, 0
    Text x + 2, y + 2, txt
    If MouseHit(1) And MouseX() > x And MouseX() < x + w And MouseY() > y And MouseY() < y + h Then Return 1
EndFunction 

Function Button(x,y,dir)
    Box x, y, 20, 20, 0
    Select dir
        Case 0
            Line x + 6, y + 6, x + 6, y + 14
            Line x + 6, y + 6, x + 14, y + 10
            Line x + 14, y + 10, x + 6, y + 14
        Case 1
            Line x + 14, y + 6, x + 14, y + 14
            Line x + 6, y + 10, x + 14, y + 6
            Line x + 14, y + 14, x + 6, y + 10
        Case 2
            Line x + 6, y + 14, x + 14, y + 14
            Line x + 6, y + 14, x + 10, y + 6
            Line x + 14, y + 14, x + 10, y + 6
        Case 3
            Line x + 6, y + 6, x + 14, y + 6
            Line x + 6, y + 6, x + 10, y + 14
            Line x + 10, y + 14, x + 14, y + 6
    EndSelect
    If MouseDown(1) And MouseX() > x And MouseX() < x + 20 And MouseY() > y And MouseY() < y + 20 Then Return 1
EndFunction 

Function Frequency(length As Float, speed As Float, tune As Integer, ends As Integer)
    lambda As Float = (length * (2 + 2 * ends)) / (tune + 1)
    Return speed / lambda
EndFunction 
    
Function SinWave(taajuus#, pituus#, voimakkuus#=100)
    fq=44100
    length=pituus*fq
    f=OpenToWrite("tmpwav.tmp")
    WriteInt f,$52494646
    WriteInt f,0
    WriteInt f,$57415645
    WriteInt f,$666d7420
    WriteInt f,16
    WriteShort f,1
    WriteShort f,1
    WriteInt f,fq
    WriteInt f,fq*2
    WriteShort f,2
    WriteShort f,16
    WriteInt f,$64617461
    WriteInt f,length*2
    vokke = voimakkuus/100*32767
    For i = 0 To length-1
        WriteShort f,Sin(360.0*taajuus/fq*(i Mod fq))*vokke
    Next i
    fs=FileOffset(f)-8
    SeekFile f,4
    WriteInt f,fs
    CloseFile f
    tmpsnd=LoadSound("tmpwav.tmp")
    DeleteFile "tmpwav.tmp"
    Return tmpsnd
EndFunction

[koodaaja]

Kirjoittelin pienenä lämmittelynä vanhan kunnon plasman. Jokseenkin pyörivä pienillä resoluutioilla, putpixel2:n nopeus tulee toki vastaan.

Code: Select all

Const screenw = 320
Const screenh = 240
SCREEN screenw, screenh

Dim map(screenw, screenh)
For i = 0 To screenw
    x# = i*1.2
    For j = 0 To screenh
        y# = j*1.2
        map(i, j) = 255*(Sin(x)*Cos(y-x)-Sin(y)*Cos(x+y)+2)*.25
    Next j
Next i

Dim col(255)
For i = 0 To 255
    col(i) = Int(128+127.0*Sin(i*(720/255.0))) Shl 16 + int(32 +32.0 *Cos(i*(360/255.0))) Shl 8 + Int(16 +16.0 *Sin(i*(360/255.0)))
Next i

Repeat
    z = (z+2) Mod 256
    Lock
        For i = 0 To screenw-1
            For j = 0 To screenh-1
                PutPixel2 i, j, col((map(i, j)+z) Mod 256)
            Next j
        Next i
    Unlock
    Color 255, 255, 255
    Text 10, 10, str(FPS())
    DrawScreen
Forever

Vastaava boxilla, tarpeeksi isoilla laatikoilla se pyörii jo paremmin:

Code: Select all

Const screenw = 640
Const screenh = 480
SCREEN screenw, screenh
Const size = 10
 
Dim map(screenw, screenh) As Float
For i = 0 To screenw
    x# = i*1.2
    For j = 0 To screenh
        y# = j*1.2
        map(i, j) = (Sin(x)*Cos(y-x)-Sin(y)*Cos(x+y)+2)*.25
    Next j
Next i
 
Dim col(255, 2)
For i = 0 To 255
    col(i, 0) = 127+127.0*Sin(i*(720/255.0))
    col(i, 1) = 32 +32.0 *Cos(i*(360/255.0))
    col(i, 2) = 16 +16.0 *Sin(i*(360/255.0))
Next i
 
Repeat
    z = (z+2) Mod 256
    For i = 0 To screenw Step size
        For j = 0 To screenh Step size
            c = ((map(i, j)+z)*254) Mod 255
            Color col(c, 0), col(c, 1), col(c, 2)
            Box i, j, size, size
        next j
    Next i
    DrawScreen
Forever

EDIT: Lisätääs vielä pieni mandelbrotin fraktaali :>

Code: Select all

Const screenw = 640
Const screenh = 480
SCREEN screenw, screenh

For i = 0 To screenw-1
    Lock
        For j = 0 To screenh-1
            x0# = (float(i)-screenw/2.0)*0.005-.6
            y0# = (float(j)-screenh/2.0)*0.005
            x# = 0
            y# = 0
            k = 0
            While (k<500)And(x*x+y*y<=4)
                xt# = x*x-y*y+x0
                y = 2*x*y+y0
                x = xt
                k = k + 1
            Wend
            If k=500 Then col = 0 Else col = k*4
            PutPixel2 i, j, col Shl 16
        Next j
    Unlock
    DrawScreen OFF
Next i

Color 255, 255, 255
Text 10, 10, "dun"
DrawScreen OFF

WaitKey

[CCE]

Kirjoittelin pienenä lämmittelynä vanhan kunnon plasman. Jokseenkin pyörivä pienillä resoluutioilla, putpixel2:n nopeus tulee toki vastaan...

Komea fraktaali! Varsin kompaktiin muotoon puristettukin vielä. Plasma oli taas huijaus, kuvio ei liikkunut vaan tyydyit pelkkään palettipyörittelyyn >:(
Edit:Kyllä realiaikainenkin mössö onnistuu kunhan resoluutiolta ei vaadi ihmeitä, kuten tässä omassa wanhassa efektissäni: viewtopic.php?f=12&t=697&start=160#p31611

[koodaaja]

On sitä joskus tullut reaaliaikaista plasmaa kokeiltua, mutta se menee CB:llä melkoiseksi diaesitykseksi ;> Esimerkiksi GLSL:llä toteutettuna se taas pyörii varsin nätisti isoillakin resoilla.

[MaGetzUb]

On sitä joskus tullut reaaliaikaista plasmaa kokeiltua, mutta se menee CB:llä melkoiseksi diaesitykseksi ;> Esimerkiksi GLSL:llä toteutettuna se taas pyörii varsin nätisti isoillakin resoilla.

Laitas vain cb koodia, haluan kääntää sen FreeBasicille.

[koodaaja]

Efektitopikki tippuu uhkaavasti D: Katselin second realityä tuossa ja arvelin, että moire-ympyrät (vai mikähän noiden oikea nimi on) olisi kiva toteuttaa CB:llä. Kyllä olivat, kaunista ja yksinkertaista. Havaitsin myös, että lukitut viivat tuntuvat olevan boxia nopeammat näin pienissä laatikoissa. w:tä voi kasvattaa jos ei tahdo pyöriä.

Code: Select all

Const w = 5

Repeat
    ang# = WrapAngle(ang+0.4)
    
    b1x# = 200 + Cos(ang*2.0)*200
    b1y# = 150 + Sin(ang*4.0)*150
    
    b2x# = 200 + Cos(180+ang*3.0)*200
    b2y# = 150 + Sin(180+ang*5.0)*150
    
    Lock
        For x = 0 To 400 Step w
            For y = 0 To 300 Step w
                If (Distance(x, y, b1x, b1y) Mod 41 > 20) <> (Distance(x, y, b2x, b2y) Mod 41 > 20) Then
                    For i = x To x+w
                        Line i, y, i, y+w
                    Next i
                EndIf
            Next y
        Next x
    Unlock
    
    DrawScreen
Forever

[Requiem for Anthrax]

tälläisen hirvityksen väkertelin näytönsäästäjäksi.

Code: Select all

SCREEN 1280,1024,32,0
DrawToWorld ON
Randomize timer()
c=Rand(2,8)
d=Rand(1,7)
t=Rand(1,4)
Repeat
For x=0 To 360
    If d=1 Then Color x*c,0,0
    If d=2 Then Color 0,x*c,0
    If d=3 Then Color 0,0,x*c
    
    If d=4 Then Color x*c,x*c,0
    If d=5 Then Color 0,x*c,x*c
    If d=6 Then Color x*c,0,x*c
    If d=7 Then Color x*c,x*c,x*c
    
    If t=1 Then Line Cos(x)*481,Sin(x)*481,Cos(x*p)*381,Sin(x*p)*381
    If t=2 Then Line Cos(x)*481,Sin(x)*481,Cos(x*Sqrt(p))*381,Sin(x*Sqrt(p))*381
    If t=3 Then Line Cos(x)*481,Sin(x)*481,Cos(x*Log(p))*381,Sin(x*Log(p))*381
    If t=4 Then Line Cos(x)*481,Sin(x)*481,Cos(x*Log10(p))*381,Sin(x*Log10(p))*381
Next x
p+1
If p=720 Then
    c=Rand(2,8)
    d=Rand(1,7)
    t=Rand(1,4)
    p=0
EndIf
DrawScreen
Forever

edit: fix'd randomize ja resuluutio