Efektit

[Jonhu]

Kyllästyin logaritmifunktioiden harjoitteluun, niin tuli tehty tälläinen logaritmisumennuksella oleva tekstuuri Koodia saa vapaasti muokkailla, kunhan ei postaile jokaista variaatiota tänne foorumeille..

Muokkailuideoita:
- ota itseisarvo pois toisesta laskusta - Abs(Cos(y*2) * Cos((x+90)*2)) * 250
- vaihda login kertoimia Log((x+100)*(y+100))*2.0 --> eri paksuiset sumennukset
- vaihda "neliöiden" värien kertoimia (Cos(y*2) * Cos(x*2)) * 250 --> tummemmat värit pienemmillä arvoilla

Code: Select all

SCREEN 800,600

img = MakeImage(180,180)
DrawToImage img
    Lock Image(img)
    For x = 0 To ImageWidth(img)
    For y = 0 To ImageHeight(img)   
       
        r = Min( Max( Log((x+100)*(y+100))*2.0 + (Cos(y*2) * Cos(x*2))          * 250 ,0),255)
        b = Min( Max( Log((x+100)*(y+100))*10.0 - Abs(Cos(y*2) * Cos((x+90)*2)) * 250 ,0),255)
        
        pix = 255 Shl 24 + r Shl 16 + b
        PutPixel2 x,y, pix, Image(img)
    Next y
    Next x
    
    Unlock Image(img)
DrawToScreen

background = MakeObjectFloor()
PaintObject background, img

Repeat

    MoveCamera (RightKey()-LeftKey())*5, -1 + (UpKey()-DownKey())*5
    
    DrawGame
    
    Color cbwhite
    Text 10,10,"FPS: " + FPS()+ "       Liikkuu nuolista... "
    
    DrawScreen
Forever

[Knoy]

Hieno effekti Jonhu...

Kokeilin itse hieman tuota Log ia.

Tein sillä pienen hypnon.

Code: Select all

Const ScreenW = 400
Const ScreenH = 300
Const Var = 100

VäriKerroin1# = 255/Log(Var)
VäriKerroin2# = 255/Var

SCREEN ScreenW*2,ScreenH*2

Repeat

    Lisääjä#+0.05
    
    Angle#=WrapAngle(Angle#-Lisääjä#)

    For i = 1 To Var
        
        Color Log(i)*Värikerroin1#,i*VäriKerroin2#,0
        
        If i=Var Then Circle ScreenW-(i+1)*2.05,ScreenH-(i+1)*2.05,(i+1)*4.1,0
        
        For ii = 0 To 7
        
            Line ScreenW+Cos(WrapAngle(Angle#+ii*45+Log(i)*140))*(i*2.05),ScreenH-Sin(WrapAngle(Angle#+ii*45+Log(i)*140))*(i*2.05),ScreenW+Cos(WrapAngle(Angle#+ii*45+Log(i+1)*140))*((i+1)*2.05),ScreenH-Sin(WrapAngle(Angle#+ii*45+Log((i+1))*140))*((i+1)*2.05)
        
        Next ii
    
    Next i
    
    DrawScreen
    
Forever 

[atomimalli]

Vähän kökköä vektorien kästtelyä, mutta säästyypä pari sekuntia

Code: Select all

    
    Const screenw% = 200'käytä samoja jos et halua venynyttä kuvaa, en jaksa nyt fiksata.
    Const screenh% = 200
    fov=35
    maxiters=10
    
    SCREEN screenw, screenh
    
    Type sphere
        Field x#
        Field y#
        Field z#
        Field w#
        Field r#
        Field g#
        Field b#
    EndType

    Type transmitter
        Field r#
        Field g#
        Field b#
    EndType

    Type light
        Field x#
        Field y#
        Field z#
    EndType
    
    s.sphere = New(sphere)
    s\x# = -1: s\y# = -1: s\z# = 7: s\w# = 1.5: s\r# = 255: s\g#= 0: s\b# = 0
    
    s.sphere = New(sphere)
    s\x# = 2: s\y# = 1: s\z# = 6: s\w# = 1: s\r# = 5: s\g# = 0: s\b# = 255
    
    s.sphere = New(sphere)
    s\x# = 0: s\y# = 1.5: s\z# = 7: s\w# = 1: s\r# = 5: s\g# = 255: s\b# = 0 
    
    l.light = New(light)
    l\x = -3: l\y = 0: l\z = 0

Repeat
    Tim=Timer()
    Lock SCREEN()
    xfov#=Tan(fov/2)/Cos(fov/2)'kalansilmän poistoa varten.(sama kulma joka resolla)
    yfov#=xfov'*screenh/screenw'pitänee fiksata vielä :P
    For x#=0 To screenw-1
        For y#=0 To screenh-1
            t=trace(0,0,0,xfov*(x/screenw-0.5)*2.0,yfov*(y/screenw-0.5)*2.0,1,maxiters)
            a.transmitter=ConvertToType(t)
            PutPixel2 x,y, Int(min(255,a\r) Shl 16 + min(255,a\g) Shl 8 + min(255,a\b))
        Next y#
        SetWindow ""+(x/screenw)
    Next x#
    Unlock
    DrawScreen
    SetWindow ""+(Timer()-Tim)
    WaitKey
Forever

Function trace(x#,y#,z#,vx#,vy#,vz#,iters)
    col=0
    For obj.sphere=Each sphere 
            'remstart
            Q# = Sqrt(vx#^2 + vy#^2 + vz#^2)
            dx = dx / Q: dy = dy / Q: dz = dz / Q
           
            a# = vx#^2 + vy#^2 + vz#^2
            b# = 2*vx#*(x#-obj\x#) + 2*vy#*(y#-obj\y) + 2*vz#*(z#-obj\z#)
            c# = obj\x#^2 + obj\y#^2 + obj\z#^2 + x^2 + y^2 + z^2 -2*(obj\x# * x# + obj\y# * y# + obj\z#*z#) - obj\w#^2
            d# = b#^2 - 4*a#*c#
            'remend
            'd#=Sqrt((x-obj\x)^2+(y-obj\y)^2+(y-obj\y)^2)
       
        If d>0 Then
            tt# = (-b#-Sqrt(d#))/(2*a#)',(-b#+Sqrt(d#))/(2*a#))
            'If tt<=0 Then tt# = (-b#-Sqrt(d#))/(2*a#)
            'SetWindow str(tt#)
            If (col=0 Or dist#>tt) And tt>0.0001
                dist#=tt
                nearest=ConvertToInteger(obj)
                col=1
            EndIf
        EndIf
    Next obj
    
    If col Then
        obj.sphere=ConvertToType(nearest)
        //valaistus
        'remstart
        For valo.light=Each light
            pvx#=obj\x-x-vx*dist
            vvx#=valo\x-x-vx*dist
            pvy#=obj\y-y-vy*dist
            vvy#=valo\y-y-vy*dist
            pvz#=obj\z-z-vz*dist
            vvz#=valo\z-z-vz*dist
            pvl#=Sqrt(pvx^2+pvy^2+pvz^2)
            vvl#=Sqrt(vvx^2+vvy^2+vvz^2)
            pvx#=pvx/pvl
            vvx#=-vvx/vvl
            pvy#=pvy/pvl
            vvy#=-vvy/vvl
            pvz#=pvz/pvl
            vvz#=-vvz/vvl
            dp#=pvx*vvx+pvy*vvy+pvz*vvz
            lightness#=lightness+Max(0,dp)
            specular#=specular+Max(0,dp)^5/3
            dp#=pvx*vx+pvy*vy+pvz*vz
            svx#=(2*dp*pvx-vx)
            svy#=(2*dp*pvy-vy)
            svz#=(2*dp*pvz-vz)
            specular#=min(255,Max(0,((vvx*svx+vvy*svy+vvz*svz))))^2/2+specular
        Next valo
        'remend
        //heijastukset
        If iters>0 Then 
            pvx#=obj\x-x-vx*dist
            pvy#=obj\y-y-vy*dist
            pvz#=obj\z-z-vz*dist
            pvl#=Sqrt(pvx^2+pvy^2+pvz^2)
            pvx#=pvx/pvl
            pvy#=pvy/pvl
            pvz#=pvz/pvl
            dp#=pvx*vx+pvy*vy+pvz*vz
            svx#=-(2*dp*pvx-vx)
            svy#=-(2*dp*pvy-vy)
            svz#=-(2*dp*pvz-vz)
            ref.transmitter=ConvertToType(trace(x#+vx*dist,y#+vy*dist,z#+vz*dist,svx,svy,svz,iters-1))
            'SetWindow ""+dotp
        Else
            ref.transmitter=new(transmitter)
        EndIf
        t.transmitter= New(transmitter)
        t\r=(obj\r*lightness+ref\r)/2+specular*255+20'*dotp
        t\g=(obj\g*lightness+ref\g)/2+specular*255+20'*dotp
        t\b=(obj\b*lightness+ref\b)/2+specular*255+20'*dotp
        Delete ref
    Else
        t.transmitter= New(transmitter)    
    EndIf
    Return ConvertToInteger(t)
EndFunction

ps. Ilman koodaajan apua olisin joutunut tekemään alusta sillä hitaammalla mutta selkeämmällä tavalla



Uploaded with ImageShack.us

EDIT:

Hakukoneoptimointia.
tags: raytracing, palloja, heijastus, atomim, hidas, paras

[JATothrim]

atomimalli comeback! Tätä kutsutaan Efektiksi, ottakaas muut mallia!

[phons]

Sanoisin että holy shit, mutta se voisi kuulostaa alentavalta joten pistetään tällainen hymiö-duo:
Todella upea! Mistä oikein repäiset tuollaisia koodeja.. Oma ajattelutasoni ei riittäisi tuollaisen tekemiseen..

[kaneli2000]

O___O

All hail Atomimalli.

[Viltzu]

Todella hienot pallot atomi Tuollasen puristit sitten 120 riviin. Huhhuh. Ei moni pystyis.

[MaGetzUb]

Wau, hienoa renderöintiä.. o_o Ei kyllä täytyy sanoa että: ylistykset Atomille!

[Koodari]

Code: Select all

Repeat
    If x<255 Then x=x+1
    Color 0,x,0
    WA=WrapAngle(WA+1)
    Line 200,150,200+Sin(WA)*40,150-Cos(WA)*40
    Dot 200+Sin(WA)*50,150-Cos(WA)*50
    DrawScreen OFF
Forever

Jännä kuva

[Knoy]

Hieno effecti atomi. +Rep

[SPuntte]

Hienon näköinen raytracer atomimallilta. Kutsuisin sitä pikemminkin algoritmiksi kuin efektiksi. Mitähän shader-algoritmia se käyttää? Sitten vaan lisäämään tohon oversamplingia, että saadaan sahareunat pois. Toki samalla saadaan sitten kaupanpäällisiksi moninkertainen renderöintiaika

Vielä pieni vinkki: en ole varma, mikä CB:n kohdalla on tilanne, mutta luulisin, että muuttujan kertominen itsellään on hiukan nopeampaa kuin potenssiin korottaminen. Siis muuttamalla kaikki a^2 -> a*a voisi tuosta piirtoajasta vielä lohjelta pieni osa pois. Koodia en kauhean tarkasti katsellut, mutta luulisin, että kaikki mahdolliset neliöjuuret on jo optimoitu pois, onhan? Esimerkiksi etäisyyksien vertailussa voi käyttää etäisyyksien neliötä (vektorien pistetuloa) oikean etäisyyden (pistetulon neliöjuuri) sijaan.

[koodaaja]

Luin joskus kuvien jälkikäsittelyyn liittyvää tekstiä, jossa törmäsin hauskaa ditheröintialgoritmiin. Valitettavasti artikkeli on hukkunut, mutta löysin lähdekoodin ja korjasin siitä yhden ongelman, jonka lähdettä en ollut millään löytänyt aiemmin. Muuttujan ds arvo kertoo, kuinka monta sävyä kutakin värikanavaa on - 4 vastaa kahdeksanbittisiä värejä (kaksi bittiä per kanava -tyylisesti).

Code: Select all

kuva$ = "media\map.bmp"

img = LoadImage(kuva)
SCREEN ImageWidth(img), ImageHeight(img)

img = LoadImage(kuva)
DrawImage img, 0, 0

ds# = 4
ds = 256.0/(ds-1)

For x = 0 To ImageWidth (img)-1
    Lock SCREEN()
        For y = 0 To ImageHeight(img)-1
            
            col% = GetPixel2(x, y)
            
            r# = col Shl 8  Shr 24
            g# = col Shl 16 Shr 24
            b# = col Shl 24 Shr 24
            
            re# = r: ge# = g: be# = b
            
            r = Int(r/ds)*ds
            g = Int(g/ds)*ds
            b = Int(b/ds)*ds
            
            re# - r: ge# - g: be# - b
            
            col = GetPixel2(x, Min(ImageHeight(img), y+1))
            PutPixel2 x  , y+1, Int(Min(255, Max(0, ((col Shl 8) Shr 24)+re*7/16.0))) Shl 16 + Int(Min(255, Max(0, ((col Shl 16) Shr 24)+ge*7/16.0))) Shl 8 + Int(Min(255, Max(0, ((col Shl 24) Shr 24)+be*7/16.0)))
            If x<ImageWidth(img)-1 Then
                col = GetPixel2(x+1, Max(y-1, 0))
                PutPixel2 x+1, y-1, Int(Min(255, Max(0, ((col Shl 8) Shr 24)+re*3/16.0))) Shl 16 + Int(Min(255, Max(0, ((col Shl 16) Shr 24)+ge*3/16.0))) Shl 8 + Int(Min(255, Max(0, ((col Shl 24) Shr 24)+be*3/16.0)))
                col = GetPixel2(x+1, y)
                PutPixel2 x+1, y  , Int(Min(255, Max(0, ((col Shl 8) Shr 24)+re*5/16.0))) Shl 16 + Int(Min(255, Max(0, ((col Shl 16) Shr 24)+ge*5/16.0))) Shl 8 + Int(Min(255, Max(0, ((col Shl 24) Shr 24)+be*5/16.0)))
                col = GetPixel2(x+1, Min(ImageHeight(img), y+1))
                PutPixel2 x+1, y+1, Int(Min(255, Max(0, ((col Shl 8) Shr 24)+re  /16.0))) Shl 16 + Int(Min(255, Max(0, ((col Shl 16) Shr 24)+ge  /16.0))) Shl 8 + Int(Min(255, Max(0, ((col Shl 24) Shr 24)+be  /16.0)))
            EndIf
            
            PutPixel2 x, y, Int(Max(0, Min(255, r))) Shl 16 + int(Max(0, Min(255, g))) Shl 8 + Int(Max(0, Min(255, b)))
        Next y
    Unlock
    DrawScreen OFF
Next x
WaitKey

Lisäksi tein wanhaan mandelbrotiini liukuvärit (ihQpinkit, luonnollisesti) ja antialiasoinnin.

Code: Select all

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

Const aaamount# = 10

For i = 0 To screenw-1
    Lock
        For j = 0 To screenh-1
            r# = 0
            g# = 0
            b# = 0
            For p = 1 To aaamount
                x# = 0
                y# = 0
                x0# = (Float(i)-screenw/2.0)*0.005+Rnd(.0,.005)-.6
                y0# = (float(j)-screenh/2.0)*0.005+Rnd(.0,.005)
                k = 0
                While (k<maxiter)And(x*x+y*y<=32)
                    xt# = x*x-y*y+x0
                    y = 2*x*y+y0
                    x = xt
                    k = k + 1
                Wend
                xt = x*x-y*y+x0:y=2*x*y+y0:x=xt:k=k+1
                xt = x*x-y*y+x0:y=2*x*y+y0:x=xt:k=k+1
                
                l# = Sqrt(x*x+y*y)
                mu# = k-Log(Log(l))/Log(2.0)
                If k<maxiter Then
                    c# = (mu*.2+.5)
                    r = r + 255
                    g = g + (215.0+40.0*Sin(c*180.0))/aaamount
                    b = b + (215.0+40.0*Sin(c*180.0))/aaamount
                EndIf
            Next p
            
            PutPixel2 i, j, Int(Max(0, Min(255, r))) Shl 16 + Int(Max(0, Min(255, g))) Shl 8 + Int(Max(0, Min(255, b)))
        Next j
    Unlock
    DrawScreen OFF
Next i
Waitkey

EDIT: Pitääpä seuraavaksi tehdä jotain reaaliaikaista, nämä sivulle scrollaavat offline-renderit alkavat tulla liian kaavamaisiksi :>

[temu92]

Hidas tai jotaki (minä siis), mutta hokasin vasta nyt aaltoilevan tekstin juonen. Tässä testi :P

Code: Select all

SCREEN 600, 200

SetFont LoadFont("Tahoma", 50)

s$	= "This is an epic s"+"tring"
tx	= 300-TextWidth(s$)/2
ty	= 100-TextHeight(s$)/2

Repeat
	t	= WrapAngle(t+1)
	
	x	= 0
	For i=0 To Len(s$)
		c$	= Mid(s$, i+1, 1)
		
		Color Sin(t*3+i*2)*100+155, Cos(t*2+i*20)*100+155, Sin(t*5+i*10)*100+100
		Text tx+x, ty+Sin(t*2+i*20)*10, c$
		
		x	= x + TextWidth(c$)
	Next i
	
	DrawScreen
Forever

[MrMonday]

Tässä erittäin yksinkertainen "lumisade"-efekti, vaikkakin hidas.. (Kiitos huonon toteutuksen)

Code: Select all

SCREEN 150,150

alku:

    For X = 0 To ScreenWidth()
        For Y = 0 To ScreenHeight()
        
        Sävy = Rand(0,255)
        Color Sävy,Sävy,Sävy
        Dot X, Y 
        
        Next Y      
    Next X
    
    DrawScreen

Goto alku
    

Toivottavasti vastaavanlaista ei vielä ole postattu, mutta tätä saa vapaasti halutessaan parannella

[Ilmuri]

Toivottavasti vastaavanlaista ei vielä ole postattu, mutta tätä saa vapaasti halutessaan parannella

Code: Select all

SCREEN 150,150

sw = ScreenWidth()-1
sh = ScreenHeight()-1

Repeat
	
	Lock
		For y = 0 To sh
			For x = 0 To sw
				c = Rand(0,255)
				PutPixel2 x, y, c + c Shl 8 + c Shl 16
			Next x
		Next y
	Unlock
	
	DrawScreen
Forever

[CCE]

Toivottavasti vastaavanlaista ei vielä ole postattu, mutta tätä saa vapaasti halutessaan parannella

Ilmurin hurjien optimointien pohjalta tein efektistä C64 -henkisen version widepixeleineen kaikkineen.

Code: Select all

SCREEN 150,150

sw = ScreenWidth()-1
sh = ScreenHeight()-1

Repeat
   
   Lock
      For y = 10 To sh-10
         For x = 10 To sw-10 Step 2
            c = Rand(0,2)*127
            PutPixel2 x, y, c + c Shl 8 + c Shl 16
		PutPixel2 x+1, y, c + c Shl 8 + c Shl 16
         Next x
      Next y
   Unlock
   
   DrawScreen
Forever

[Wingman]

omanlainen lumisateeni:

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=MouseX()
	mx=MouseY()
	If mx>255 Then mx=255
	If mx<0 Then mx=0
	If mn>255 Then mn=255
	If mn<0 Then mn=0
	Color 255,255,255
	Line 0,MouseY(),sw,MouseY()
	Line MouseX(),0,MouseX(),sh
	
	Text MouseX()+5,MouseY()+5,"1: "+mx+" 2: "+mn
	DrawScreen 
Forever 

kommentoimalla neljä viimeistä riviä ennen drawscreeniä, saa viivat pois

[Ilkka]

omanlainen lumisateeni:

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=MouseX()
	mx=MouseY()
	If mx>255 Then mx=255
	If mx<0 Then mx=0
	If mn>255 Then mn=255
	If mn<0 Then mn=0
	Color 255,255,255
	Line 0,MouseY(),sw,MouseY()
	Line MouseX(),0,MouseX(),sh
	
	Text MouseX()+5,MouseY()+5,"1: "+mx+" 2: "+mn
	DrawScreen 
Forever 

kommentoimalla neljä viimeistä riviä ennen drawscreeniä, saa viivat pois

Meikällä mavaa tää?

[Knoy]

Editoin hieman vanhaa effektiäni ja siitä syntyi jotain omituisehkoa.

Code: Select all

Const ScreenW = 400
Const ScreenH = 300

Angle As Float = 0

ii As Float = 0
iii As Float = 0

SCREEN ScreenW,ScreenH

Repeat
    Angle=WrapAngle(Angle+0.1)
    Angle2=WrapAngle(Angle2+1)
    Angle3#=WrapAngle(Angle3+0.15)
    Angle4#=WrapAngle(Angle4+0.25)
    For i = 1 To 15 As Float
        For ii = 1 To 15 As Float
            Color ii*17,((i+ii)/2)*17,i*17
            Line ScreenW/2+Cos(WrapAngle(Angle2+(1+i+ii)*Angle))*(15+i+ii)+Cos(Angle3+(i+ii+2)*Angle)*45,ScreenH/2-Sin(WrapAngle(Angle2+(1+i+ii)*Angle))*(15+i+ii)-Sin(Angle4+(i+ii+2)*Angle)*45,ScreenW/2+Cos(WrapAngle(Angle2+(i+ii+2)*Angle))*(16+i+ii)+Cos(Angle3+(i+ii+2)*Angle)*45,ScreenH/2-Sin(WrapAngle(Angle2+(i+ii+2)*Angle))*(16+i+ii)-Sin(Angle4+(i+ii+2)*Angle)*45
        Next ii
    Next i
    DrawScreen
Forever

[Wingman]

omanlainen lumisateeni:

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=MouseX()
	mx=MouseY()
	If mx>255 Then mx=255
	If mx<0 Then mx=0
	If mn>255 Then mn=255
	If mn<0 Then mn=0
	Color 255,255,255
	Line 0,MouseY(),sw,MouseY()
	Line MouseX(),0,MouseX(),sh
	
	Text MouseX()+5,MouseY()+5,"1: "+mx+" 2: "+mn
	DrawScreen 
Forever 

kommentoimalla neljä viimeistä riviä ennen drawscreeniä, saa viivat pois

Meikällä mavaa tää?

hmm...koitappa pienentää for-looppien sw- ja sh-muuttujaa em. sw-1 ja ennen sitä oleva 0->1