Efektit

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Kumiankka
Member
Posts: 65
Joined: Wed May 18, 2011 5:17 pm
Location: Artjärvi

Re: Efektit

Post by Kumiankka » Wed May 18, 2011 8:05 pm

Koodailin aikanikuluksi maastogeneraattorin :D Jäljestä en tiedä kun ei itsellä kokemusta satunnaisgeneroinnista satu olemaan, mutta omasta mielestäni tuo näyttää ihan hyvältä. aika yksinkertainen, mutta ajaa asiansa:

Code: Select all

SCREEN 800,600
SetWindow "Maastogeneraattori by. Kumiankka"
SW = ScreenWidth()
SH = ScreenHeight()

Const RUOHO = 0
Const KALLIO = 1
Const HIEKKA = 2
Const VESI = 3

Const KORKEUS = 0
Const TYYPPI = 1

MAXKORKEUS = 200
MINKORKEUS = -1

Const ruoho_colR = 1
Const ruoho_colG = 95
Const ruoho_coB = 1
Const kallio_colR = 0
Const kallio_colG = 0
Const kallio_colB = 0
Const hiekka_colR = 150
Const hiekka_colG = 150
Const hiekka_colB = 1
Const vesi_colR = 5
Const vesi_colG = 5
Const vesi_colB = 200

Global vesi_min, vesi_max, hiekka_min, hiekka_max, ruoho_min, ruoho_max, kallio_min, kallio_max

vesi_min = -1
vesi_max = 19
hiekka_min = 20
hiekka_max = 40
ruoho_min = 41
ruoho_max = 120
kallio_min = 121
kallio_max = MAXKORKEUS

korkeus_max_muutos = 50
korkeus_min_muutos = -50

debugHeight = False
Randomize Timer()
_img = MakeImage(SW,SH)

AddText "Generating..."
DrawScreen
Dim maasto(ScreenWidth(),ScreenHeight(),1)
Gosub LuoMaasto
ClearText

Repeat

    Gosub PiirräMaasto

    If KeyHit(28) Then SaveImage _img, CurrentDir()+"mappi.bmp"

    DrawScreen

Until EscapeKey()

LuoMaasto:
For xx = 1 To SW
    For yy = 1 To SH
   
        If xx = 1 Or yy = 1 Then
            maasto(xx, yy,KORKEUS) = Rand(MINKORKEUS,MAXKORKEUS)
            maasto(xx, yy,TYYPPI) = GroundtypeFromHeight(maasto(xx, yy,KORKEUS))
        ElseIf xx > 1 And yy > 1 And xx < SW - 1 And yy < SH - 1 Then
            _korkeus1 = (maasto(xx, yy - 1,KORKEUS) + Rand(korkeus_min_muutos, korkeus_max_muutos))
            _korkeus2 = (maasto(xx - 1, yy,KORKEUS) + Rand(korkeus_min_muutos, korkeus_max_muutos))
            _uusikorkeus = (_korkeus1 + _korkeus2) / 2
            maasto( xx, yy,KORKEUS) = Max(Min(_uusikorkeus,MAXKORKEUS),MINKORKEUS)
            maasto( xx, yy,TYYPPI) = GroundtypeFromHeight(maasto(xx, yy,KORKEUS))
        EndIf
        
    Next yy
Next xx

For xx = 1 To SW
    For yy = 1 To SH
        
        DrawToImage _img
            If maasto(xx,yy,TYYPPI) = RUOHO Then
                Color (Ruoho_colR + maasto(xx,yy,KORKEUS)), (Ruoho_colG + maasto(xx,yy,KORKEUS)), (Ruoho_colB + maasto(xx,yy,KORKEUS))
                Dot xx,yy
            ElseIf maasto(xx,yy,TYYPPI) = KALLIO Then
                Color (Kallio_colR + maasto(xx,yy,KORKEUS)), (Kallio_colG + maasto(xx,yy,KORKEUS)), (Kallio_colB + maasto(xx,yy,KORKEUS))
                Dot xx,yy
            ElseIf maasto(xx,yy,TYYPPI) = HIEKKA Then
                Color (hiekka_colR + maasto(xx,yy,KORKEUS)), (hiekka_colG + maasto(xx,yy,KORKEUS)), (hiekka_colB + maasto(xx,yy,KORKEUS))
                Dot xx,yy
            ElseIf maasto(xx,yy,TYYPPI) = VESI Then
                Color (vesi_colR + maasto(xx,yy,KORKEUS)), (vesi_colG + maasto(xx,yy,KORKEUS)), (vesi_colB + maasto(xx,yy,KORKEUS))
                Dot xx,yy
            EndIf
        DrawToScreen
            
    Next yy
Next xx
Return

PiirräMaasto:
DrawImage _img, 0, 0

If debugHeight = True
    For xx = 1 To SW Step 50
        For yy = 1 To SH Step 50
            Color cbBlack
            Text xx,yy,""+Int(maasto(xx,yy,KORKEUS))
        Next yy
    Next xx
EndIf
Return 

Function GroundtypeFromHeight(_height)
    If _height >= kallio_min Then
        Return KALLIO
    ElseIf _height >= ruoho_min Then
        Return RUOHO
    ElseIf _height >= hiekka_min Then 
        Return HIEKKA
    ElseIf _height >= vesi_min Then
        Return VESI
    EndIf
EndFunction 
Enteriä painamalla kartan voi tallentaa .bmp muodossa...

User avatar
Misthema
Advanced Member
Posts: 312
Joined: Mon Aug 27, 2007 8:32 pm
Location: Turku, Finland
Contact:

Re: Efektit

Post by Misthema » Wed May 18, 2011 8:43 pm

Code: Select all

SCREEN 600,600
Repeat
    Cls
    aika=aika+1
    For x=1 To 60
        For y= 1 To 50
            Color Cos(aika+y*2.5+x*2.5)*127+127,Sin(aika+y*5)*127+127,Sin(aika+x*5)*127+127
            Line x*10+Sin(aika+y*5)*20,y*10+Sin(aika+x*5)*20,x*10+Sin(aika+y*5)*20+Sin(aika+x*5)*10,y*10+Sin(aika+x*5)*20+Sin(aika+y*5)*10
        Next y
    Next x
    DrawScreen()
Forever
Lippu? =P

User avatar
Latexi95
Guru
Posts: 1164
Joined: Sat Sep 20, 2008 5:10 pm
Location: Lempäälä

Re: Efektit

Post by Latexi95 » Wed May 18, 2011 8:45 pm

Kumiankka wrote:Koodailin aikanikuluksi maastogeneraattorin :D Jäljestä en tiedä kun ei itsellä kokemusta satunnaisgeneroinnista satu olemaan, mutta omasta mielestäni tuo näyttää ihan hyvältä. aika yksinkertainen, mutta ajaa asiansa:

Code: Select all

SCREEN 800,600
SetWindow "Maastogeneraattori by. Kumiankka"
SW = ScreenWidth()
SH = ScreenHeight()

Const RUOHO = 0
Const KALLIO = 1
Const HIEKKA = 2
Const VESI = 3

Const KORKEUS = 0
Const TYYPPI = 1

MAXKORKEUS = 200
MINKORKEUS = -1

Const ruoho_colR = 1
Const ruoho_colG = 95
Const ruoho_coB = 1
Const kallio_colR = 0
Const kallio_colG = 0
Const kallio_colB = 0
Const hiekka_colR = 150
Const hiekka_colG = 150
Const hiekka_colB = 1
Const vesi_colR = 5
Const vesi_colG = 5
Const vesi_colB = 200

Global vesi_min, vesi_max, hiekka_min, hiekka_max, ruoho_min, ruoho_max, kallio_min, kallio_max

vesi_min = -1
vesi_max = 19
hiekka_min = 20
hiekka_max = 40
ruoho_min = 41
ruoho_max = 120
kallio_min = 121
kallio_max = MAXKORKEUS

korkeus_max_muutos = 50
korkeus_min_muutos = -50

debugHeight = False
Randomize Timer()
_img = MakeImage(SW,SH)

AddText "Generating..."
DrawScreen
Dim maasto(ScreenWidth(),ScreenHeight(),1)
Gosub LuoMaasto
ClearText

Repeat

    Gosub PiirräMaasto

    If KeyHit(28) Then SaveImage _img, CurrentDir()+"mappi.bmp"

    DrawScreen

Until EscapeKey()

LuoMaasto:
For xx = 1 To SW
    For yy = 1 To SH
   
        If xx = 1 Or yy = 1 Then
            maasto(xx, yy,KORKEUS) = Rand(MINKORKEUS,MAXKORKEUS)
            maasto(xx, yy,TYYPPI) = GroundtypeFromHeight(maasto(xx, yy,KORKEUS))
        ElseIf xx > 1 And yy > 1 And xx < SW - 1 And yy < SH - 1 Then
            _korkeus1 = (maasto(xx, yy - 1,KORKEUS) + Rand(korkeus_min_muutos, korkeus_max_muutos))
            _korkeus2 = (maasto(xx - 1, yy,KORKEUS) + Rand(korkeus_min_muutos, korkeus_max_muutos))
            _uusikorkeus = (_korkeus1 + _korkeus2) / 2
            maasto( xx, yy,KORKEUS) = Max(Min(_uusikorkeus,MAXKORKEUS),MINKORKEUS)
            maasto( xx, yy,TYYPPI) = GroundtypeFromHeight(maasto(xx, yy,KORKEUS))
        EndIf
        
    Next yy
Next xx

For xx = 1 To SW
    For yy = 1 To SH
        
        DrawToImage _img
            If maasto(xx,yy,TYYPPI) = RUOHO Then
                Color (Ruoho_colR + maasto(xx,yy,KORKEUS)), (Ruoho_colG + maasto(xx,yy,KORKEUS)), (Ruoho_colB + maasto(xx,yy,KORKEUS))
                Dot xx,yy
            ElseIf maasto(xx,yy,TYYPPI) = KALLIO Then
                Color (Kallio_colR + maasto(xx,yy,KORKEUS)), (Kallio_colG + maasto(xx,yy,KORKEUS)), (Kallio_colB + maasto(xx,yy,KORKEUS))
                Dot xx,yy
            ElseIf maasto(xx,yy,TYYPPI) = HIEKKA Then
                Color (hiekka_colR + maasto(xx,yy,KORKEUS)), (hiekka_colG + maasto(xx,yy,KORKEUS)), (hiekka_colB + maasto(xx,yy,KORKEUS))
                Dot xx,yy
            ElseIf maasto(xx,yy,TYYPPI) = VESI Then
                Color (vesi_colR + maasto(xx,yy,KORKEUS)), (vesi_colG + maasto(xx,yy,KORKEUS)), (vesi_colB + maasto(xx,yy,KORKEUS))
                Dot xx,yy
            EndIf
        DrawToScreen
            
    Next yy
Next xx
Return

PiirräMaasto:
DrawImage _img, 0, 0

If debugHeight = True
    For xx = 1 To SW Step 50
        For yy = 1 To SH Step 50
            Color cbBlack
            Text xx,yy,""+Int(maasto(xx,yy,KORKEUS))
        Next yy
    Next xx
EndIf
Return 

Function GroundtypeFromHeight(_height)
    If _height >= kallio_min Then
        Return KALLIO
    ElseIf _height >= ruoho_min Then
        Return RUOHO
    ElseIf _height >= hiekka_min Then 
        Return HIEKKA
    ElseIf _height >= vesi_min Then
        Return VESI
    EndIf
EndFunction 
Enteriä painamalla kartan voi tallentaa .bmp muodossa...
Ihan komeanhan näköinen tuo oli. Koodi kaipaa kyllä reippaasti optimointia. Generointi aika oli todella pitkä. Kaikki järvet tuntuivat olevan luode-kaakko - suuntaisia, ja ehkä hieman suttuinen oli tuo kartta. Ehkä korkeusvaihtelua voisi pienentää?

Misthema wrote:

Code: Select all

SCREEN 600,600
Repeat
    Cls
    aika=aika+1
    For x=1 To 60
        For y= 1 To 50
            Color Cos(aika+y*2.5+x*2.5)*127+127,Sin(aika+y*5)*127+127,Sin(aika+x*5)*127+127
            Line x*10+Sin(aika+y*5)*20,y*10+Sin(aika+x*5)*20,x*10+Sin(aika+y*5)*20+Sin(aika+x*5)*10,y*10+Sin(aika+x*5)*20+Sin(aika+y*5)*10
        Next y
    Next x
    DrawScreen()
Forever
Lippu? =P
Hieno. Lock ja Unlock tuovat heiluntaan reippaasti lisää vauhtia. :P

User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post by MaGetzUb » Wed May 18, 2011 9:03 pm

Misthema wrote:

Code: Select all

SCREEN 600,600
Repeat
    aika=aika+1
    For x=1 To 60
        For y= 1 To 50
            Color Cos(aika+y*2.5+x*2.5)*127+127,Sin(aika+y*5)*127+127,Sin(aika+x*5)*127+127
            Line x*10+Sin(aika+y*5)*20,y*10+Sin(aika+x*5)*20,x*10+Sin(aika+y*5)*20+Sin(aika+x*5)*10,y*10+Sin(aika+x*5)*20+Sin(aika+y*5)*10
        Next y
    Next x
    DrawScreen
Forever
Lippu? =P
Tuommoisenhan aikoinaan taisi Atomimalli vääntää. :)
Btw optimoin koodiasi hiutusen:

Code: Select all

SCREEN 600,600
Repeat
    Cls
    aika=aika+1
    Lock 
    For x=1 To 60
        For y= 1 To 50
            Color Cos(aika+y*2.5+x*2.5)*127+127,Sin(aika+y*5)*127+127,Sin(aika+x*5)*127+127
            Line x*10+Sin(aika+y*5)*20,y*10+Sin(aika+x*5)*20,x*10+Sin(aika+y*5)*20+Sin(aika+x*5)*10,y*10+Sin(aika+x*5)*20+Sin(aika+y*5)*10
        Next y
    Next x
    Unlock 
    DrawScreen()
Forever
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
axu
Devoted Member
Posts: 854
Joined: Tue Sep 18, 2007 6:50 pm

Re: Efektit

Post by axu » Wed May 18, 2011 9:18 pm

Tekeekö tämmösellä melulla mitään? Tämä perustuu edelleen simplexeihin, mutta hieman erilailla (interpoloidaan pisteiden arvoja).
Simplex.png
Simplex.png (22.93 KiB) Viewed 5333 times
Ajattelin käyttää tätä maaston generoinnissa, enkä tuommoisenaan ja tuossa kuvassa on vasta yksi oktaavi, lopulliseen tulee enemmän.
Koodi, joka generoi tämän, bilineaarisella sekä kosinisella interpolaatiolla ja lisäksi Perlinin noisea(noniin, mitähän lienee tuokaan) kummallakin interpoloinnilla. Tekee vain yhden oktaavin, ja muutenkin ihan raaka kehitysversio:

Code: Select all

Const Sin60 = 0.86602540378443864676372317075294
Const W = 15
Const H = 15
SCREEN Int(W + H * .5) * 20 + 40, Int(H * Sin60) * 20 + 40
Dim Point#(W, H)
alku:
For x = 0 To W
    For y = 0 To H
        Point(x, y) = Rnd(-1, 1)
    Next y
Next x

For x = 0 To W
    For y = 0 To H
        g# = 128 + Point(x, y) * 80
        Color g, g, g
'        Circle 7 + x * 20, 7 + y * 20, 6
        transform(x, y, 2.5)
    Next y
Next x
DrawScreen
'WaitKey
x = 0
y = 0
For p = 0 To 3
For x = 0 To W - 1
    For y = 0 To H - 1
        For y2 = 0 To 19
            If p Mod 2 = 0 Then
                dy# = y2 / 20.0
            Else
                dy = .5 - Cos(180 * y2 / 20.0) / 2
            EndIf
            For x2 = 0 To 19
                If p < 2 Then
                    If x2 <= (20 - y2) Then
                        If p = 0 Then
                            dx# = x2 / (20.0 - y2)
                        Else
                            dx = .5 - Cos(180 * x2 / (20.0 - y2))/2
                        EndIf
                        g = Point(x, y) * (1 - dx) + Point(x + 1, y) * dx
                        g = g * (1 - dy) + Point(x, y + 1) * dy
                    Else
                        If p = 0 Then
                            dx = (x2 - (19 - y2)) / 19.0
                        Else
                            dx = .5 - Cos(180 * (x2 - (19 - y2)) / 19.0)/2
                        EndIf
                        g = Point(x, y + 1) * (1 - dx) + Point(x + 1, y + 1) * dx
                        g = g * dy + Point(x + 1, y) * (1 - dy)
                    EndIf
                Else
                    If p = 2 Then
                        dx = x2 / 20.0
                    Else
                        dx = .5 - Cos(180 * x2 / 20.0) / 2
                    EndIf
                    g = Point(x, y) * (1 - dx) + Point(x + 1, y) * dx
                    g2# = Point(x, y + 1) * (1 - dx) + Point(x + 1, y + 1) * dx
                    g = g * (1 - dy) + g2 * dy
                EndIf
                
                g = 128 + g * 80
                Color g, g, g
                If p < 2 Then
                    Transform(x + x2/20.0, y + y2/20.0)
                Else
                    Dot 130 + x * 20 + x2, 10 + y * 20 + y2
                EndIf
            Next x2
        Next y2
    Next y
Next x
WaitKey
DrawScreen
Next p

WaitKey
Goto alku

Function Transform(X#, Y#, S# = 1)
    X = X + Y * .5
    Y = Y * Sin60
    Circle 20 + X * 20 - S, 20 + Y * 20 - S, S * 2
End Function
Paina näppäintä vaihtaaksesi kuvaa.
Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua :roll:
Image

User avatar
Timblex
Advanced Member
Posts: 252
Joined: Sun Apr 11, 2010 10:37 am
Location: Kouvola

Re: Efektit

Post by Timblex » Mon May 23, 2011 12:53 pm

Yritin tehdä jotain metapallojen tapaista :oops: ja tuli vahingossa tälläinen revontuliefekti tai mikä lie. On varmaan hienoin efekti jonka olen tehnyt :D

Code: Select all

SCREEN 400,400
Type BALLs
Field x
Field y
EndType 
///////////////luodaan pallot
For i=0 To 2
ball.BALLs=New(BALLs)
ball\x=Rand(0,400)
ball\y=Rand(0,200)
Next i
//////////////////////
Repeat 
For ball.BALLs=Each BALLs
For x=0 To 400 Step 5
For y=0 To 400 Step 5
//////////////pallojen liikutus
ball\x=ball\x+Rand(-1,1)
ball\y=ball\y+Rand(-1,1)
If ball\x>400 Then ball\x=400
    If ball\x<0 Then ball\x=0
    If ball\y>200 Then ball\y=200
If ball\y<0 Then ball\y=0
////////////////////////////////väri
plus=255-Min(255,Distance(x,y,ball\x,ball\y))
Color 0,plus,50
'7*7 laatikko
Box x,y,5,5
Next y
Next x
Next ball
DrawScreen
Forever 
Entinen timpe99...
Demokisa 2013 demo valmis, Check it out!

User avatar
axu
Devoted Member
Posts: 854
Joined: Tue Sep 18, 2007 6:50 pm

Re: Efektit

Post by axu » Mon May 23, 2011 1:21 pm

timpe99 wrote:Yritin tehdä jotain metapallojen tapaista :oops: ja tuli vahingossa tälläinen revontuliefekti tai mikä lie. On varmaan hienoin efekti jonka olen tehnyt :D
Ihan hienoa revontultahan se on :) Koodiasi vähän tarkastelin (jonka olisi voinut sisentää), ja totesin että sinä piirrät jokaisen pikselin kolmeen kertaan. Efekti toimii aivan samalla tavalla (paitsi nopeammin), jos käyttää yhtä palloa kerrallaan.
Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua :roll:
Image

User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post by MaGetzUb » Mon May 23, 2011 7:42 pm

timpe99 wrote:Yritin tehdä jotain metapallojen tapaista :oops: ja tuli vahingossa tälläinen revontuliefekti tai mikä lie. On varmaan hienoin efekti jonka olen tehnyt :D
On kyllä pirun hieno! Oikein yllätyin, luulin sen vain olevan jotain metapallojen tapaista.. :D
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
Timblex
Advanced Member
Posts: 252
Joined: Sun Apr 11, 2010 10:37 am
Location: Kouvola

Re: Efektit

Post by Timblex » Tue May 24, 2011 1:41 pm

Tein sitten kun efkteistä innostuin niin tällaisen tunneliefektin tämän tutoriaalin avulla
tekstuuria en kuitenkaan saanut toimimaan enkä lock unlockia(lock päällä ei piirrä mitään näytölle)

Code: Select all

SCREEN 512,512
screen_width=ScreenWidth()
screen_height=ScreenHeight()
Dim angle_lut(screen_width,screen_height)
Dim depth_lut(screen_width,screen_height)
Repeat 
kulma+1
mp=Cos(kulma+70)*100
mp2=Sin(kulma)*200
For y = 0 to screen_height - 1 Step 8
    For x = 0 to screen_width - 1 Step 8

        // First, we need to calculate the offset to
        // the pixel (the x,y coordinate relative to
        // the centre of the screen.
        // y is calculated "backwards" to x as screen
        // (x,y) are different to normal mathematical
        // (x,y) [on a screen, the y axis points South,
        // whereas we normally treat it as pointing
        // North].
        relative_x = x -  screen_width / 2 + mp
        relative_y = y - screen_height / 2 + mp
    
        // Next, we check to see if y is zero to trap
        // any divide-by-zero errors:
        if relative_y = 0 Then
            if relative_x < 0 Then
                angle = -90
            Else
                angle = 90
            end If
        Else
             // y is not zero, so use atan (tan-1) to
             // calculate the angle.
            angle = ATan(relative_x/relative_y)
        end If

        // Finally, check to see if we're in the
        // bottom half, and if so, fix the angle.
        If relative_y > 0 Then
            angle = angle + 180
        End If

        // Last of all, save the angle to our table.
        angle_lut(x,y) = angle
                depth = 8388608 / (relative_x^2 + relative_y^2+1)+plus

        depth_lut(x,y) = depth
		
        // Set the screen pixel:		
Color mp2,depth,depth-mp
        Box x,y,8,8     
        Next x
Next y 
plus+10
DrawScreen
Forever 
Entinen timpe99...
Demokisa 2013 demo valmis, Check it out!

User avatar
koodaaja
Moderator
Moderator
Posts: 1583
Joined: Mon Aug 27, 2007 11:24 pm
Location: Otaniemi - Mikkeli -pendelöinti

Re: Efektit

Post by koodaaja » Tue May 24, 2011 2:30 pm

Lukittu boxhan ei ole ikinä piirtänyt näytölle mitään, voi johtua siitä ;>

Mutta aika perustunneli, lupsakat värinvaihtelut siinä kyllä on.

User avatar
Misthema
Advanced Member
Posts: 312
Joined: Mon Aug 27, 2007 8:32 pm
Location: Turku, Finland
Contact:

Re: Efektit

Post by Misthema » Mon May 30, 2011 9:25 am

Hehe. Timpen tunnelihan oli ihan hieno. =P
Toisinsanoen, innostuin muokkaamaan siitä nopeamman "virtuaaliresolla" ja ruudun lukituksella.
Tunnelin muotokin muuttui, eli tässä versiossa menette jonkin metrontapaisen vekottimen perässä jossa on hienot takavalot. =D

Code: Select all

SCREEN 512,512
SCREEN 64,64,32,cbsizable
screen_width=64
screen_height=64
Dim angle_lut(screen_width,screen_height)
Dim depth_lut(screen_width,screen_height)
Repeat 
    kulma+1
    mp=Cos(kulma+70)*10
    mp2=Sin(kulma)*20

    Lock SCREEN()
    For y = 0 to screen_height - 1
        For x = 0 to screen_width - 1
    
            // First, we need to calculate the offset to
            // the pixel (the x,y coordinate relative to
            // the centre of the screen.
            // y is calculated "backwards" to x as screen
            // (x,y) are different to normal mathematical
            // (x,y) [on a screen, the y axis points South,
            // whereas we normally treat it as pointing
            // North].
            relative_x = x -  screen_width / 2 + mp
            relative_y = y - screen_height / 2 + mp
        
            // Next, we check to see if y is zero to trap
            // any divide-by-zero errors:
            If relative_y = 0 Then
                If relative_x < 0 Then
                    angle = -90
                Else
                    angle = 90
                End If
            Else
                 // y is not zero, so use atan (tan-1) to
                 // calculate the angle.
                angle = ATan(relative_x/relative_y)
            End If
    
            // Finally, check to see if we're in the
            // bottom half, and if so, fix the angle.
            If relative_y > 0 Then
                angle = angle + 180
            End If
    
            // Last of all, save the angle to our table.
            angle_lut(x,y) = angle
                    depth = 8388608 / (relative_x^4 + relative_y^4+1)+plus
    
            depth_lut(x,y) = depth
          
            // Set the screen pixel:      
    pixcol = mp2 shl 16 + depth Shl 8 + depth-mp
            PutPixel2 x,y,pixcol,SCREEN()
            Next x
    Next y

    Unlock SCREEN()
    plus+10
    DrawScreen
Forever
EDIT:

Tuli huomattua että CB rikkoo tekstuurin, kun sitä yritin tuon oppaan mukaan säätää. Blitzmax:lla toimii normaalisti, vaikka koodi on samanlainen (mikä nyt syntaksissa hieman poikkeaa)... o_O


User avatar
Execute
Active Member
Posts: 110
Joined: Fri Feb 11, 2011 7:41 pm

Re: Efektit

Post by Execute » Fri Jun 03, 2011 8:44 pm

Tässä joku vanha roska

Code: Select all

Screen 1000,1000
bom = LoadFont("Impact",60)
SetFont bom
Repeat 
For i = 1 To 23
Color cbwhite
Box +pl,+pl,+d3,+d3
d3 = d3+1
pl = Rand (-700,700)
Next i
ClsColor Rand(0,360),Rand(0,360),Rand(0,360)
Color Rand(0,360),Rand(0,360),Rand(0,360)
Text Rand(180,220),Rand(180,220), "CoolBasic"
DrawScreen
forever
Koodi on aika sontaa ja tämä esittää varmaan jotain (coolbasic) rähjähdystä.
SpaceCraft on kokopitkä peli! Nyt ladattavissa! Tsekkaa!

User avatar
Misthema
Advanced Member
Posts: 312
Joined: Mon Aug 27, 2007 8:32 pm
Location: Turku, Finland
Contact:

Re: Efektit

Post by Misthema » Sun Jun 05, 2011 1:39 am

Jotain kikkailua ja käytössä porttaamani cbFilt:

Code: Select all

SCREEN 600,600
SCREEN 256,256,32,cbsizable

Const FRAMES = 360
Global gCalc
gCalc = 0

pw = 24:ph = 24
Dim imgs(frames,4)

angle_plus=0

While angle_plus<FRAMES

    For i=0 To 3
        imgs(angle_plus,i)=MakeImage(pw,ph)
        Lock(Image(imgs(angle_plus,i)))
    Next i
    
	For x = 0 To pw - 1
		For y = 0 To ph - 1
			angle = GetAngle3(Cos(x)*x/2, Sin(y)*y/2, pw / 2, ph / 2) + angle_plus*2
			cx = (pw/2) + Cos(angle) * (Cos(angle/2)*20)
			cy = (ph/2) - Sin(angle) * (Sin(angle/2)*20)
	
			a = Int(Cos(Dist(x, y, cx*4, cy*4) )*255 )
			pix = 255-a Shl 16 + (1+Cos(angle/2))*a/2 Shl 8 + 255-a
			PutPixel2 x, y, pix,Image(imgs(angle_plus,0))
            PutPixel2 pw-x-1, y, pix,Image(imgs(angle_plus,1))
            PutPixel2 x, ph-y-1, pix,Image(imgs(angle_plus,2))
            PutPixel2 pw-x-1, ph-y-1, pix,Image(imgs(angle_plus,3))
		Next y
	Next x
    
    For i=0 To 3
        Unlock(Image(imgs(angle_plus,i)))
        ResizeImage imgs(angle_plus,i),128,128
    Next i

    Cls    
    PrInt UpdatePreCalc()
    Print String("|",angle_plus/12)

	angle_plus=angle_plus + 1

Wend

frameTimer=Timer()
a=0


While Not KeyDown(key_escape)

    mx=MouseX()
    my=MouseY()

    a=Timer()*.05
    a=a Mod FRAMES
	
	DrawImage imgs(a,0),0,0        
    DrawImage imgs(a,1),128,0
    DrawImage imgs(a,2),0,128
    DrawImage imgs(a,3),128,128

    For k=0 To 9
    
        If FRAMES>180 Then
            x=128+Cos(a+(k*36))*40
            y=128-Sin(a+(k*36))*40
        Else
            x=128+Cos(a*2+(k*36))*40
            y=128-Sin(a*2+(k*36))*40
        EndIf
        
        PickColor x,y
        r = getRGB(RED)
        g = getRGB(GREEN)
        b = getRGB(BLUE)

        ef=k Mod 2
        
        For i=0 To 9
            Select ef
                Case 0
                    colR = Difference(r,24*i)
                    colG = Difference(g,0)
                    colB = Difference(b,24*i)
                Case 1
                    colR = ColorDodge(r,24*i)
                    colG = ColorDodge(g,0)
                    colB = ColorDodge(b,24*i)
            EndSelect
            
            Color colR,colG,colB
            Circle x-(15-i),y-(15-i),30-(i*2)
        Next i
    Next k
    
	DrawScreen()
    SetWindow ""+FPS()
Wend
End


Function GetAngle3#(x1#, y1#, x2#, y2#) 
	Return ATan2(y1*y2,x1*x2)
End Function

Function ATan2#(opp#, adj#)

	Dim angle#

    ' Get the basic angle.
    If Abs(adj) < 0.0001 Then
        angle = 90 
    Else
        angle = Abs(ATan(opp / adj))
    End If

    ' See if we are in quadrant 2 or 3.
    If adj < 0 Then
        angle = 180-angle 
    End If

    ' See if we are in quadrant 3 or 4.
    If opp < 0 Then
        angle = -angle
    End If

    ' Return the result.
    Return angle

End Function


Function Dist# (x0#, y0#, x1#, y1#)
         Return Sqrt (((x1 - x0) * (x1 - x0)) + ((y1 - y0) * (y1 - y0)))
End Function

Function Difference(a%,b%)
	Return Abs(a-b)
End Function

Function ColorDodge(a%,b%)
	If b=255 Then
		Return 255
	Else
		c%=RoundDown((a Shl 8)/(255-b))
		If c>255 Then Return 255 Else Return c
	EndIf
End Function

Function UpdatePreCalc$()
    If gCalc>6 Then gCalc=0 Else gCalc+1
    dots$="......"
    If gCalc=0 Then Return "Precalc"
    Return "Precalc"+Mid(dots,1,gCalc)
EndFunction

User avatar
valscion
Moderator
Moderator
Posts: 1587
Joined: Thu Dec 06, 2007 8:46 pm
Location: Espoo
Contact:

Re: Efektit

Post by valscion » Mon Jun 06, 2011 11:57 am

Execute wrote:Tässä joku vanha roska

Code: Select all

...koodia...
Koodi on aika sontaa ja tämä esittää varmaan jotain (coolbasic) rähjähdystä.
Aika perusefekti. Pisti silmään se, että olit määritellyt väriarvot Rand:lla 0-360 välillä - oikeasti väriarvojen maksimi on 255 ja minimi 0, eli kannattaisi käyttää sitä Rand:ia mielummin näin:

Code: Select all

ClsColor Rand(255), Rand(255), Rand(255)
cbEnchanted, uudelleenkirjoitettu runtime. Uusin versio: 0.4.1 — Nyt myös sorsat GitHubissa!
NetMatch - se kunnon nettimättö-deathmatch! Avoimella lähdekoodilla varustettu
vesalaakso.com

User avatar
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Efektit

Post by Wingman » Wed Jun 08, 2011 11:17 am

Leikin isometrisillä laatikoilla ja tajusin, että niillä voisi toteuttaa plasman ;) Tässä on nyt siis minun ensimmäinen kunnon plasma (Ascii-introssa ollut ei ollut plasma vaan joku läheinen juttu).

Code: Select all

sw=800
sh=500
SCREEN sw,sh,0,1
b1=MakeImage(21,21)
b3=MakeImage(21,21)
b2=MakeImage(21,21)
g#=255
r#=127.5
b#=127.5
Const XX=40
Const YY=40
DrawToImage b1
	Color 12,12,12
	For i=0 To 20
		Line 10,0+i,20,Min(15,5+i)
		Line 10,0+i,0,Min(15,5+i)
	Next i
	Color r/4,g/4,b/4
	Line 10,20,20,15
	Line 10,20,0,15
	Line 10,0,20,5
	Line 10,0,0,5
	Line 0,15,0,5
	Line 20,15,20,5
	Color r/3,g/3,b/3
	Line 20,5,10,10
	Line 10,10,0,5
	Line 10,10,10,20
DrawToImage b2
	Color r/5,g/5,b/5
	For i=0 To 20
		Line 10,0+i,20,Min(15,5+i)
		Line 10,0+i,0,Min(15,5+i)
	Next i
	Color r/10,g/10,b/10
	Line 10,20,20,15
	Line 10,20,0,15
	Line 10,0,20,5
	Line 10,0,0,5
	Line 0,15,0,5
	Line 20,15,20,5
	Color r/2,g/2,b/2
	Line 20,5,10,10
	Line 10,10,0,5
	Line 10,10,10,20
DrawToImage b3
	Color r/2,g/2,b/2
	For i=0 To 20
		Line 10,0+i,20,Min(15,5+i)
		Line 10,0+i,0,Min(15,5+i)
	Next i
	Color r/10,g/10,b/10
	Line 10,20,20,15
	Line 10,20,0,15
	Line 10,0,20,5
	Line 10,0,0,5
	Line 0,15,0,5
	Line 20,15,20,5
	Color r,g,b
	Line 20,5,10,10
	Line 10,10,0,5
	Line 10,10,10,20
DrawToScreen 
Dim palikka(XX,YY) As Float 
For x=1 To XX
	For y=1 To YY
		palikka(x,y)=0
	Next y
Next x
Repeat
	If switch<>1 Then a#+1
	If KeyHit(28) Or KeyHit(57) Then switch=Not switch
	For x=1 To XX
		For y=1 To YY 
			If palikka(x,y)=<-5 Then 
				DrawImage b1,sw/2-10+x*12-y*11,80+y*5+x*5-palikka(x,y)
			EndIf 
			If palikka(x,y)=>5 Then 
				DrawImage b3,sw/2-10+x*12-y*11,80+y*5+x*5-palikka(x,y)
			EndIf
			If palikka(x,y)<=5 And palikka(x,y)=>-5 Then 
				DrawImage b2,sw/2-10+x*12-y*11,80+y*5+x*5-palikka(x,y)
			EndIf
			palikka(x,y)=(((Sin(x*17))*(Cos(y*13)))+((Sin(a+y*23))*(Cos(a+x*25))))*15
		Next y
	Next x
	Color 255,255,255
	Text 0,0,FPS()
	DrawScreen 
Forever 
Sain sen näköjään alle sataan riviin, rivejä vie eniten tuo laatikoiden piirto
- - - -

DJ-Filbe
Devoted Member
Posts: 854
Joined: Sat Feb 20, 2010 3:18 pm

Re: Efektit

Post by DJ-Filbe » Wed Jun 08, 2011 5:21 pm

Wingman wrote:Leikin isometrisillä laatikoilla ja tajusin, että niillä voisi toteuttaa plasman ;) Tässä on nyt siis minun ensimmäinen kunnon plasma (Ascii-introssa ollut ei ollut plasma vaan joku läheinen juttu).

Code: Select all

sw=800
sh=500
SCREEN sw,sh,0,1
b1=MakeImage(21,21)
b3=MakeImage(21,21)
b2=MakeImage(21,21)
g#=255
r#=127.5
b#=127.5
Const XX=40
Const YY=40
DrawToImage b1
	Color 12,12,12
	For i=0 To 20
		Line 10,0+i,20,Min(15,5+i)
		Line 10,0+i,0,Min(15,5+i)
	Next i
	Color r/4,g/4,b/4
	Line 10,20,20,15
	Line 10,20,0,15
	Line 10,0,20,5
	Line 10,0,0,5
	Line 0,15,0,5
	Line 20,15,20,5
	Color r/3,g/3,b/3
	Line 20,5,10,10
	Line 10,10,0,5
	Line 10,10,10,20
DrawToImage b2
	Color r/5,g/5,b/5
	For i=0 To 20
		Line 10,0+i,20,Min(15,5+i)
		Line 10,0+i,0,Min(15,5+i)
	Next i
	Color r/10,g/10,b/10
	Line 10,20,20,15
	Line 10,20,0,15
	Line 10,0,20,5
	Line 10,0,0,5
	Line 0,15,0,5
	Line 20,15,20,5
	Color r/2,g/2,b/2
	Line 20,5,10,10
	Line 10,10,0,5
	Line 10,10,10,20
DrawToImage b3
	Color r/2,g/2,b/2
	For i=0 To 20
		Line 10,0+i,20,Min(15,5+i)
		Line 10,0+i,0,Min(15,5+i)
	Next i
	Color r/10,g/10,b/10
	Line 10,20,20,15
	Line 10,20,0,15
	Line 10,0,20,5
	Line 10,0,0,5
	Line 0,15,0,5
	Line 20,15,20,5
	Color r,g,b
	Line 20,5,10,10
	Line 10,10,0,5
	Line 10,10,10,20
DrawToScreen 
Dim palikka(XX,YY) As Float 
For x=1 To XX
	For y=1 To YY
		palikka(x,y)=0
	Next y
Next x
Repeat
	If switch<>1 Then a#+1
	If KeyHit(28) Or KeyHit(57) Then switch=Not switch
	For x=1 To XX
		For y=1 To YY 
			If palikka(x,y)=<-5 Then 
				DrawImage b1,sw/2-10+x*12-y*11,80+y*5+x*5-palikka(x,y)
			EndIf 
			If palikka(x,y)=>5 Then 
				DrawImage b3,sw/2-10+x*12-y*11,80+y*5+x*5-palikka(x,y)
			EndIf
			If palikka(x,y)<=5 And palikka(x,y)=>-5 Then 
				DrawImage b2,sw/2-10+x*12-y*11,80+y*5+x*5-palikka(x,y)
			EndIf
			palikka(x,y)=(((Sin(x*17))*(Cos(y*13)))+((Sin(a+y*23))*(Cos(a+x*25))))*15
		Next y
	Next x
	Color 255,255,255
	Text 0,0,FPS()
	DrawScreen 
Forever 
Sain sen näköjään alle sataan riviin, rivejä vie eniten tuo laatikoiden piirto
Eihän tuo mikään plasma ole...
Tässä koodisi rajusti pelkistettynä:

Code: Select all

sw=800
sh=500
SCREEN sw,sh,0,1
b1=MakeImage(15,15)
b3=MakeImage(15,15)
b2=MakeImage(15,15)
g#=255
r#=127.5
b#=127.5
Const XX=40
Const YY=40
DrawToImage b1
   Color 12,12,12
   For i=0 To b
      Line r,0+i,b,Min(g,5+i)*5
      Line r,0+i,0,Min(g,5+i)*5
   Next i
   Color r/4,g/4,b/4
   Line r,b,b,g*5
   Line r,b,0,g*5
   Line r,0,b,5*5
   Line r,0,0,5*5
   Line 0,g,0,5*5
   Line b,g,b,5*5
   Color r/3,g/3,b/3
   Line b,5,r,r*5
   Line r,r,0,5*5
   Line r,r,r,b*5
DrawToImage b2
   Color r/5,g/5,b/5
   For i=0 To b
      Line r,0+i,b,Min(g,5+i)*5
      Line r,0+i,0,Min(g,5+i)*5
   Next i
   Color r/r,g/r,b/r
   Line r,b,b,g*5
   Line r,b,0,g*5
   Line r,0,b,5*5
   Line r,0,0,5*5
   Line 0,g,0,5*5
   Line b,g,b,5*5
   Color r/2,g/2,b/2
   Line b,5,r,r*5
   Line r,r,0,5*5
   Line r,r,r,b*5
DrawToImage b3
   Color r/2,g/2,b/2
   For i=0 To b
      Line r,0+i,b,Min(g,5+i)
      Line r,0+i,0,Min(g,5+i)
   Next i
   Color r/r,g/r,b/r
   Line r,b,b,g*5
   Line r,b,0,g*5
   Line r,0,b,25
   Line r,0,0,25
   Line 0,g,0,25
   Line b,g,b,25
   Color r,g,b*5
   Line b,5,r,r*5
   Line r,r,0,5*5
   Line r,r,r,b*5
DrawToScreen
Dim palikka(XX,YY) As Float
For x=1 To XX
   For y=1 To YY
      palikka(x,y)=0
   Next y
Next x
Repeat
   If switch<>1 Then a#+1
   If KeyHit(28) Or KeyHit(57) Then switch=Not switch
   For x=1 To XX
      For y=1 To YY
         If palikka(x,y)=<-5 Then
            DrawImage b1,sw/2-r+x*12-y*11,80+y*5+x*5-palikka(x,y)
         EndIf
         If palikka(x,y)=>5 Then
            DrawImage b3,sw/2-r+x*12-y*11,80+y*5+x*5-palikka(x,y)
         EndIf
         If palikka(x,y)<=5 And palikka(x,y)=>-5 Then
            DrawImage b2,sw/2-r+x*12-y*11,80+y*5+x*5-palikka(x,y)
         EndIf
         palikka(x,y)=(((Sin(x*17))*(Cos(y*13)))+((Sin(a+y*23))*(Cos(a+x*25))))*g
      Next y
   Next x

	
   Color 255,255,255
   Text 0,0,FPS()
   DrawScreen
Forever 
Tästä "huijaus" käy ilmi :D
neliöt näyttävät pyörivän kolmiulotteisesti vaakatasossa olevan akselin ympäri

User avatar
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Efektit

Post by Wingman » Wed Jun 08, 2011 7:20 pm

pelkistitpä harvinaisen väärin. tässä koodi on kunnolla pelkistettynä:

Code: Select all

sw=800
sh=500
SCREEN sw,sh,0,1
	Repeat
	Lock 
	a+1
	For x=1 To sw Step 20
		For y=1 To sh Step 20
			c=(((Sin(x*1.7))*(Cos(y*1.3)))+((Sin(a+y*2.3))*(Cos(a+x*2.5))))*255
			c=Min(255,Max(0,c))
			Color c,c,c
			For yy=y to y+20
				Line x,yy,x+20,yy
			Next yy 
		Next y
	Next x
	Unlock 
	Color 255,255,255
	Text 0,0,FPS()
	DrawScreen
Forever 
en piirrä koodissani siis plasmaa näytölle, vaan taulukkoon, jonka mukaan laatikoiden z-sijainti muuttuu. Isometrisesti katseltuna isometrinen palikkamatriisi muodostaa näin plasman, ja kun sitä katsellaan ylhäältä päin se näyttää 2-ulotteiselta ja suunnilleen tältä miltä pelkistetty koodi näyttää.
- - - -

User avatar
atomimalli
Moderator
Moderator
Posts: 227
Joined: Wed Aug 29, 2007 3:55 pm

Re: Efektit

Post by atomimalli » Wed Jun 08, 2011 7:58 pm

Kyllä tuo vain on ihan perinteinen plasmaefekti. http://en.wikipedia.org/wiki/Plasma_effect
Sivusta katsotun plasman pyöriminen taas lienee optinen illuusio. Siinä pitäisi nousta palikoita ylös suunnilleen yhtä paljon kuin niitä menee alaskin.

User avatar
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Efektit

Post by Wingman » Wed Jun 08, 2011 10:45 pm

atomimalli wrote:.. Siinä pitäisi nousta palikoita ylös suunnilleen yhtä paljon kuin niitä menee alaskin.
eikös silloin palikoiden keskiarvo ole lähes sama koko ajan?
- - - -

DJ-Filbe
Devoted Member
Posts: 854
Joined: Sat Feb 20, 2010 3:18 pm

Re: Efektit

Post by DJ-Filbe » Thu Jun 09, 2011 9:29 am

Wingman wrote:
atomimalli wrote:.. Siinä pitäisi nousta palikoita ylös suunnilleen yhtä paljon kuin niitä menee alaskin.
eikös silloin palikoiden keskiarvo ole lähes sama koko ajan?
Tämä on ihan normaalia myös pyörimisessä, jos se on jatkuvaa (kuten koodissani).
Jos efektisi on plasmaa, miksi se ei kimpoa seinistä? Miksi se menee vain yhteen suuntaan? Näihin kahteen kysymykseen perustin väitteeni ja koodini pelkistyksen, koska pelkistyksestäni näkee paremmin sen, että liikkeen suunta muuttuu aina samalla tavalla (pyöriminen). Läsäksi joissain nurkissa "plasma" voi olla vain tietyllä korkeudella (laittakaa DrawScreen 0 ja katsokaa vaikka vasenta ylänurkkaa). Miksi?

Okei, huono minun on kai sanoa mitään koska en jaksa itse koodata parempaa efektiä :D

Post Reply