Efektit

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
User avatar
Cérebro
Newcomer
Posts: 35
Joined: Wed Jul 16, 2008 8:56 pm

Re: Efektit

Post by Cérebro » Mon Dec 22, 2008 11:37 am

Tein peilausfunktion, joka päihittää sekä DatsuniG:n funktion sekä ResizeImagen (myös isoilla kuvilla).

Code: Select all

SCREEN 600, 400

Img = LoadImage("Media\soldier.bmp") // Pieni kuva
//Img = LoadImage("Media\map.bmp") // Iso kuva

Text 30, 20, "WrapImage_DatsuniG():"
Aika = Timer()
Img1 = WrapImage_DatsuniG(Img, 1)
Väliaika1 = Timer() - Aika : Aika = Timer()

Img2 = WrapImage_DatsuniG(Img, 2)
Väliaika2 = Timer() - Aika
Color cbwhite

DrawImage Img, 20, 50
Text 82, 62, "Alkuperäinen"

DrawImage Img1, 20, 100
Text 82, 112, "Mode 1 - Aikaa kului: " + Väliaika1 + "ms"

DrawImage Img2, 20, 150
Text 82, 162, "Mode 2 - Aikaa kului: " + Väliaika2 + "ms"

Line 305, 0, 305, 200

Text 330, 20, "WrapImage_Cerebro():"
Aika = Timer()
Img1 = WrapImage_Cerebro(Img, 1)
Väliaika1 = Timer() - Aika : Aika = Timer()

Img2 = WrapImage_Cerebro(Img, 2)
Väliaika2 = Timer() - Aika
Color cbwhite

DrawImage Img, 320, 50
Text 382, 62, "Alkuperäinen"

DrawImage Img1, 320, 100
Text 382, 112, "Mode 1 - Aikaa kului: " + Väliaika1 + "ms"

DrawImage Img2, 320, 150
Text 382, 162, "Mode 2 - Aikaa kului: " + Väliaika2 + "ms"

Line 0, 200, ScreenWidth(), 200

Text 250, 220, "ResizeImage:"
Aika = Timer()
Img1 = CloneImage(Img)
ResizeImage Img1, -ImageWidth(Img1), ImageHeight(Img1)
Väliaika1 = Timer() - Aika : Aika = Timer()

Img2 = CloneImage(Img)
ResizeImage Img2, ImageWidth(Img2), -ImageHeight(Img2)
Väliaika2 = Timer() - Aika
Color cbwhite

DrawImage Img, 200, 250
Text 262, 262, "Alkuperäinen"

DrawImage Img1, 200, 300
Text 262, 312, "Mode 1 - Aikaa kului: " + Väliaika1 + "ms"

DrawImage Img2, 200, 350
Text 262, 362, "Mode 2 - Aikaa kului: " + Väliaika2 + "ms"

DrawScreen
WaitKey

Function WrapImage_DatsuniG(img,mode)
    img1 = MakeImage(ImageWidth(img),ImageHeight(img))
    Lock Image(img)
    Lock Image(img1)
    Select mode
        Case 1
            For i=ImageWidth(img) To 0 Step -1
                For a=ImageHeight(img) To 0 Step -1
                    PutPixel2 Abs(i),Abs(a),GetPixel2(ImageWidth(img)-i,ImageHeight(img)-a,Image(img)),Image(img1)
                Next a
            Next i
        Case 2
            For i=0 To ImageWidth(img)
                For a=ImageHeight(img) To 0 Step -1
                    PutPixel2 i,Abs(a),GetPixel2(i,ImageHeight(img)-a,Image(img)),Image(img1)
                Next a
            Next i
        Default
            MakeError "Invalid mode!"
    EndSelect
    Unlock Image(img)
    Unlock Image(img1)
    Return img1
EndFunction

Function WrapImage_Cerebro(Img, Mode)
    IW = ImageWidth(Img)
    IH = ImageHeight(Img)
    Ret = MakeImage(IW, IH)
    Select Mode
        Case 1
            For I = 0 To IW
                CopyBox I, 0, 1, IH, IW - I, 0, Image(Img), Image(Ret)
            Next I
        Case 2
            For I = 0 To IH
                CopyBox 0, I, IW, 1, 0, IH - I, Image(Img), Image(Ret)
            Next I
        Default
            MakeError "Invalid mode!"
    EndSelect
    Return Ret
End Function
cbLib | XMap
In development: EasyBasic - Basic-tyylinen peliohjelmointikieli

User avatar
Tuxu
Member
Posts: 81
Joined: Tue Oct 14, 2008 5:54 pm
Location: Jyväskylä
Contact:

Re: Efektit

Post by Tuxu » Mon Dec 22, 2008 9:13 pm

otto90x wrote:Yritin tehdä jonkinlaisia vauhtiviivoja, mutta en kyllä ole vielä tyytyväinen. Toteutusehdotuksia?

Code: Select all

koodi 
WAUH! Pienellä muokkauksella tuosta saa kätevän piirto-ohjelman.
Jaksoin leikkiä 20min tolla.
Suttuin jpg-kuva
aivot pohtii ja raksuttaa
TuxuGames | Projektiblogi

User avatar
Jani
Devoted Member
Posts: 741
Joined: Fri Oct 31, 2008 5:53 pm

Re: Efektit

Post by Jani » Sun Dec 28, 2008 5:55 pm

Olipa tylsaa niin tein tämmösen "rasitus" efektin

Muistakaa odottaa jonkin aikaa että sen huomaa. (voi mennä muutama minuuttia)

Code: Select all

efont=LoadFont("arial",25)

Type EP
    Field typo //"tyyli"
    Field r //r väri-muuttuja
    Field g //g väri-muuttuja
    Field b //b väri-muuttuja
    Field txt As String //teksti
EndType

Const Dtext="LOL" //Teksti
Const maxEP=5000 //Montako tekstiä enintään kerrallaan
Global kerta

SetFont efont

Repeat

    UpdateEP() : UpdateEP() : UpdateEP() //Päivitä KOLME kerralla
    
    DrawScreen
    
Forever

Function NewE() //Luo uusi
    epi.EP=New(EP)
    
    epi\typo=Rand(0,1) //tyyli, r, g, b ja teksti
    epi\r=Rand(0,255)
    epi\g=Rand(0,255)
    epi\b=Rand(0,255)
    epi\txt=Dtext
EndFunction

Function UpdateEP(nollaus=1) //päivitä
    If nollaus=1 Then kerta=0
    For epi.EP=Each EP
        Color epi\r,epi\g,epi\b
        Select epi\typo
            Case 0
                Text ScreenWidth()/2-TextWidth(epi\txt)/2,ScreenHeight()/2,epi\txt
                Text Rand(0,ScreenWidth()),Rand(0,ScreenHeight()),epi\txt
            Case 1
                Text ScreenWidth()/2-TextWidth(epi\txt)/2,ScreenWidth()/2-TextHeight("L"),epi\txt
        EndSelect
        kerta+1
    Next epi
    NewE()
    If kerta>=maxEP Then DelE() : kerta=0
EndFunction

Function DelE() //tuhoa
    For epi.EP=Each EP
        Delete epi
    Next epi
EndFunction
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition

User avatar
Jani
Devoted Member
Posts: 741
Joined: Fri Oct 31, 2008 5:53 pm

Re: Efektit

Post by Jani » Mon Jan 05, 2009 9:55 am

Yritin jonkinlaisia "sirpale pamauksia" tehdä.
Tässä on lopputulos:

Code: Select all

Type PALLO
    Field x#
    Field y#
    Field xx
    Field yy
    Field sx
    Field sy
    Field ax
    Field ay
    Field lenght
    Field width
    Field r
    Field g
    Field b
EndType

For i=1 To 150
    Make(ScreenWidth()/2,ScreenHeight()/2,Rand(1,5),Rand(1,5),Rand(3),Rand(3),Rand(100,200),Rand(1,2),Rand(255),Rand(255),Rand(255))
Next i

Repeat

    Update()
    
    DrawScreen
    
Forever

Function Update()
    For b.PALLO=Each PALLO
        Color b\r,b\g,b\b
        Circle b\x,b\y,b\width
        
        Select b\sx
            Case 0
                b\x+b\xx
            Case 1
                b\x-b\xx
            Case 2
                l=b\xx*2
                b\x+l
            Case 3
                l=b\xx*2
                b\x-l
        EndSelect
        
        Select b\sy
            Case 0
                b\y+b\yy
            Case 1
                b\y-b\yy
            Case 2
                l=b\yy*2
                b\y+l
            Case 3
                l=b\yy*2
                b\y-l
        EndSelect
        
        If Distance(b\ax,b\ay,b\x,b\y)>b\lenght Then Delete b
    Next b
EndFunction

Function Make(xxx#,yyy#,bxx,byy,sxx,syy,l,f,r,g,bb)
    b.PALLO=New(PALLO)

    b\x=xxx
    b\y=yyy
    b\xx=bxx
    b\yy=byy
    b\sx=sxx
    b\sy=syy
    b\ax=b\x
    b\ay=b\y
    b\lenght=l
    b\width=f
    b\r=r
    b\g=g
    b\b=bb
EndFunction
EDIT: lisäsin pienen hienouden...

Code: Select all

Type PALLO
    Field x#
    Field y#
    Field xx
    Field yy
    Field sx
    Field sy
    Field ax
    Field ay
    Field lenght
    Field width
    Field r
    Field g
    Field b
EndType

For i=1 To 1000
    Make(Rand(30,ScreenWidth()-30),Rand(30,ScreenHeight()/2),Rand(1,5),Rand(1,5),Rand(3),Rand(3),Rand(100,200),Rand(1,2),Rand(255),Rand(255),Rand(255))
Next i

aika=Timer()
aika2=Timer()

Repeat

    Update()
    
    If Timer()>aika+1000
        For i=1 To 150
            Make(ScreenWidth()/2,ScreenHeight()/2,Rand(1,5),Rand(1,5),Rand(3),Rand(3),Rand(100,200),Rand(1,2),Rand(255),Rand(255),Rand(255))
        Next i
        aika=Timer()
    EndIf
    
    If Timer()>aika2+5000
        For i=1 To 500
            Make(Rand(30,ScreenWidth()-30),Rand(30,ScreenHeight()/2),Rand(1,5),Rand(1,5),Rand(3),Rand(3),Rand(100,200),Rand(1,2),Rand(255),Rand(255),Rand(255))
        Next i
        aika2=Timer()
    EndIf
    
    DrawScreen
    
Forever

//Päivittää Make() funktiolla tehdyt pallot
Function Update()
    For b.PALLO=Each PALLO
        Color b\r,b\g,b\b
        Circle b\x,b\y,b\width
        
        Select b\sx
            Case 0
                b\x+b\xx
            Case 1
                b\x-b\xx
            Case 2
                l=b\xx*2
                b\x+l
            Case 3
                l=b\xx*2
                b\x-l
        EndSelect
        
        Select b\sy
            Case 0
                b\y+b\yy
            Case 1
                b\y-b\yy
            Case 2
                l=b\yy*2
                b\y+l
            Case 3
                l=b\yy*2
                b\y-l
        EndSelect
        
        If Distance(b\ax,b\ay,b\x,b\y)>b\lenght Then Delete b
    Next b
EndFunction

//Tekee uuden pallon.
//xxx#:  Ympyrän x-koordinaatti
//yyy#:  Ympyrän y-koordinaatti
//bxx:  liikutus sivuttain
//byy:  liikutus pystysuunnassa
//sxx:  suunta sivuttain
//syy:  y suunta
//l:  Kuinka pitkälle pallo voi mennä
//f:  Pallon koko
//r, g ja bb: värit
Function Make(xxx#,yyy#,bxx,byy,sxx,syy,l,f,r,g,bb)
    b.PALLO=New(PALLO)

    b\x=xxx
    b\y=yyy
    b\xx=bxx
    b\yy=byy
    b\sx=sxx
    b\sy=syy
    b\ax=b\x
    b\ay=b\y
    b\lenght=l
    b\width=f
    b\r=r
    b\g=g
    b\b=bb
EndFunction
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition

User avatar
Niko40
Newcomer
Posts: 8
Joined: Wed Jan 23, 2008 8:28 pm

Re: Efektit

Post by Niko40 » Fri Jan 16, 2009 1:38 am

Huh... Pitkästä aikaa taas CB:llä. On täs töitä ollu ja ne muuten oikeasti vie aika pitkälti sitä vapaata aikaa. :(
Ohjelmoinnissa cb on alkanut jäädä taakse, kun lukuisten ongelmien takia en pystyny enää jatkaa isommissa cb projekteissa. C++ on vallannut tilaa koneelta aika ruhtinaallisesti. Joka tapaukses kun c++ ongelmat ei oo niitä helpoimpia, niin aina silloin tällöin teköö mieli palata tähän vanhaan tuttuun CoolBasiciin.

Koodaan tällä hetkellä CB:llä omaa kuvaformaattia, josta sitten lisää myöhemmin... Tähän liittyen tuli tehtyä pari matemaattista laskelmaa, joiden avulla on mahdollista laskea gradient väritykset, neljän eri kulman värien perusteella... En vaan oo varma, onko tälläistä vielä tehty CB:llä... Äh. Selostukset sikseen. Tässä koodi. Hyödyntää saa vapaasti. Ajattelin, että tämä saattais olla mielenkiintoinen esitys muille.

Muutama Const alussa, joita voi vapaasti säädellä mieleisekseen. Sanokaapa muuten FPS (näkyy vasemmassa yläkulmassa) perusasetuksilla ja jos on minkäänlaisia optimointiehdotuksia, niin tänne vaan.

Code: Select all


// Näytön kokoa voi säätää tästä
Const ScreenSizeX = 800
Const ScreenSizeY = 600

// Piirron tarkkuus
Const QualityX = 8
Const QualityY = 7

// Väriarvojen vainhtumisnopeutta voi säätää tästä
Const ColorSpeedInSec_Min = 30.0
Const ColorSpeedInSec_Max = 120.0

// Säädä eri värien esiintymivoimakkuutta tästä 0-255
Const MultipColor_R = 255
Const MultipColor_G = 255
Const MultipColor_B = 255



SizeX = ScreenSizeX / (QualityX+1)
SizeY = ScreenSizeY / (QualityY+1)

GradSizeBufX# = 1.0 / SizeX
GradSizeBufY# = 1.0 / SizeY

Rotator1Speed# = Rnd(ColorSpeedInSec_Min, ColorSpeedInSec_Max)
Rotator2Speed# = Rnd(ColorSpeedInSec_Min, ColorSpeedInSec_Max)
Rotator3Speed# = Rnd(ColorSpeedInSec_Min, ColorSpeedInSec_Max)
Rotator4Speed# = Rnd(ColorSpeedInSec_Min, ColorSpeedInSec_Max)

MC_R# = MultipColor_R / 255.0
MC_G# = MultipColor_G / 255.0
MC_B# = MultipColor_B / 255.0



SCREEN ScreenSizeX, ScreenSizeY



t = Timer()
t_old = Timer()
t_dif# = 0.0

Repeat
    
    // Tämä koodi pitää animaation aina samassa ajassa riippumatta nykyisestä FPS:stä.
    t_old = t
    t = Timer()
    t_dif = (t - t_old) / 1000.0
    
    // Palasten piirtoa
    For Y = 0 To SizeY
        For X = 0 To SizeX
            
            // Läjä matemaattista puuroa jolla saadaan jokaisen palasen väritys...
            GradSlideX# = GradSizeBufX * X
            GradSlideY# = GradSizeBufY * Y
            
            ColG1# = ((r3 - r1)*GradSlideX) + r1
            ColG2# = ((r4 - r2)*GradSlideX) + r2
            r = ((ColG2 - ColG1)*GradSlideY) + ColG1
            
            ColG1# = ((g3 - g1)*GradSlideX) + g1
            ColG2# = ((g4 - g2)*GradSlideX) + g2
            g = ((ColG2 - ColG1)*GradSlideY) + ColG1
            
            ColG1# = ((b3 - b1)*GradSlideX) + b1
            ColG2# = ((b4 - b2)*GradSlideX) + b2
            b = ((ColG2 - ColG1)*GradSlideY) + ColG1
            
            // toteutetaan piirto
            Color r, g, b
            Box X+(QualityX*X), Y+(QualityY*Y), QualityX+1, QualityY+1
            
        Next X
    Next Y
    
    // Väriarvot määrää kulma. Tällä saadaan värin vahtumiseen pehmeyttä.
    Rotator1# = Rotator1 + (Rotator1Speed * t_dif)  ' (Rotator1Speed * t_dif) <- pitää huolen, että FPS ei vaikuta animaation nopeuteen
    If Rotator1 > 360 Then Rotator1 = Rotator1 - 360    ' Rotator1 = Rotator1 - 360 <- Pitää huolen, että animaatioon ei tule hyppyjä, 
    Rotator2# = Rotator2 + (Rotator2Speed * t_dif)      ' silloin kun animaatio (kulma) alkaa alusta.
    If Rotator2 > 360 Then Rotator2 = Rotator2 - 360
    Rotator3# = Rotator3 + (Rotator3Speed * t_dif)
    If Rotator3 > 360 Then Rotator3 = Rotator3 - 360
    Rotator4# = Rotator4 + (Rotator4Speed * t_dif)
    If Rotator4 > 360 Then Rotator4 = Rotator4 - 360
    
    r1 = ((Sin(Rotator1)+1.0)*127)*MC_R
    r3 = ((Cos(Rotator2)+1.0)*127)*MC_R
    r4 = ((Sin(Rotator3)+1.0)*127)*MC_R
    r2 = ((Cos(Rotator4)+1.0)*127)*MC_R
    g4 = ((Sin(Rotator1)+1.0)*127)*MC_G
    g3 = ((Cos(Rotator2)+1.0)*127)*MC_G
    g1 = ((Sin(Rotator3)+1.0)*127)*MC_G
    g2 = ((Cos(Rotator4)+1.0)*127)*MC_G
    b3 = ((Sin(Rotator1)+1.0)*127)*MC_B
    b2 = ((Cos(Rotator2)+1.0)*127)*MC_B
    b1 = ((Sin(Rotator3)+1.0)*127)*MC_B
    b4 = ((Cos(Rotator4)+1.0)*127)*MC_B
    
    // Piirretään FPS
    Color 255, 255, 255
    Text 0, 0, FPS()
    
    DrawScreen
Forever 

Last edited by Niko40 on Fri Jan 16, 2009 3:41 am, edited 1 time in total.

User avatar
temu92
Web Developer
Web Developer
Posts: 1226
Joined: Mon Aug 27, 2007 9:56 pm
Location: Gamindustri
Contact:

Re: Efektit

Post by temu92 » Fri Jan 16, 2009 1:46 am

Tasasesti pyörähteli 20 fps ympärillä. Ei asetuksia muutettuna.

User avatar
Valtzu
Active Member
Posts: 115
Joined: Sun Aug 26, 2007 2:40 pm
Location: Sauvo
Contact:

Re: Efektit

Post by Valtzu » Fri Jan 16, 2009 7:39 pm

Niko40 wrote:Sanokaapa muuten FPS (näkyy vasemmassa yläkulmassa) perusasetuksilla ja jos on minkäänlaisia optimointiehdotuksia, niin tänne vaan.
Tasasesti pyöri 10FPS. Kone on tältä vuosituhannelta.

User avatar
otto90x
Advanced Member
Posts: 349
Joined: Mon Aug 27, 2007 9:00 pm
Location: Lapinjärvi, Finland
Contact:

Re: Efektit

Post by otto90x » Fri Jan 16, 2009 11:03 pm

Niko40, onhan se nätti, mutta kivempi olisi esimerkiksi funktio jolle voisi antaa jokaisen kulman värin parametrinä. Mutta onhan se vähän raskas, ainakin näin reaaliaikaisena, 30 FPS puolisen vuotta vanhalla läppärillä.
Otto Martikainen a.k.a. MetalRain, otto90x, kAATOSade.
Runoblogi, vuodatusta ja sekoiluja.

Character
Active Member
Posts: 113
Joined: Thu Nov 27, 2008 3:16 pm

Re: Efektit

Post by Character » Wed Jan 21, 2009 9:26 pm

Kerrankin sain tehtyä efektin joka on ainakin itseni mielestä jo aika hyvä:
(ainakin kun en vielä mikään mestari ole..)

Code: Select all

i=MakeImage(ScreenWidth(),ScreenHeight())

DrawToImage i
For x = 0 To ScreenWidth()
    For y = 0 To ScreenHeight()
        Color 10 * x - y / 3, 5 * y - x / 3, Rand(157)
        Dot x, y
    Next y
Next x
DrawToScreen

Repeat

    DrawImage i, 0, 0

    DrawScreen

Forever
Edit: Tässä toinen:

Code: Select all

i = MakeImage(ScreenWidth(),ScreenHeight())
r = Max(ScreenWidth(),ScreenHeight())

DrawToImage i
        For x = 0 To ScreenWidth()
            For y = 0 To ScreenHeight()
                Color x * y / r + r / 3, y * r / 3, Rand(172)
                Dot x,y
            Next y
        Next x
DrawToScreen

Repeat

    DrawImage i, 0, 0

    DrawScreen
    
Forever

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 » Thu Jan 22, 2009 7:55 pm

Tjoo, tuli tässä joku ilta/yö tällainen väsättyä ja.. no, laitanpa tänne ihan kummajaiseksi. Eli pallo-raytracer coolbasicilla. Itselläni oletus 2:n pallon kuva @ 640x480 vie noin 20 sekuntia. Optimointia ei ole edes yritetty tehdä, sillä kyseessä ei ole mikään oikeaan käyttöön tarkoitettu koodinpätkä. 150 riviä purkkaa, olkaa hyvät.

Code: Select all

Const screenw% = 640
Const screenh% = 480

SCREEN screenw, screenh

Type sphere
    
    Field x#
    Field y#
    Field z#
    Field w#
    
    Field r%
    Field g%
    Field b%
    
EndType

Type ray
    
    Field x0#
    Field y0#
    Field z0#
    
    Field x1#
    Field y1#
    Field z1#
    
EndType

Type light
    
    Field x#
    Field y#
    Field z#
    
EndType

s.sphere = New(sphere)
s\x# = screenw*.6666666: s\y# = screenh/2.0: s\z# = -80: s\w# = 60: s\r% = 255: s\g% = 0: s\b% = 0
s.sphere = New(sphere)
s\x# = screenw/3.0: s\y# = screenh/2.0: s\z# = -80: s\w# = 60: s\r% = 0: s\g% = 0: s\b% = 255

l.light = New(light)
l\x = 10.0: l\y = 10.0: l\z = -200

//l.light = New(light)
//l\x = 700.0: l\y = screenh/2: l\z = -100

r.ray = New(ray)
r\x0# = screenw/2.0
r\y0# = screenh/2.0
r\z0# = -500
r\z1# = 0

f.ray = New(ray)

Function rsi( rid%, sid%, fid )
    
    r.ray = ConvertToType(rid%)
    s.sphere = ConvertToType(sid%)
    f.ray = ConvertToType(fid%)
    
    dx# = r\x1# - r\x0#
    dy# = r\y1# - r\y0#
    dz# = r\z1# - r\z0#
    
    Q# = Sqrt(dx#^2 + dy#^2 + dz#^2)
    dx = dx / Q: dy = dy / Q: dz = dz / Q
    
    a# = dx#^2 + dy#^2 + dz#^2
    b# = 2*dx#*(r\x0#-s\x#) + 2*dy#*(r\y0#-s\y) + 2*dz#*(r\z0#-s\z#)
    c# = s\x#^2 + s\y#^2 + s\z#^2 + r\x0^2 + r\y0^2 + r\z0^2 -2*(s\x# * r\x0# + s\y# * r\y0# + s\z#*r\z0#) - s\w#^2
    d# = b#^2 - 4*a#*c#
    
    If d<0 Then Return 0
    
    t# = (-b#+Sqrt(d#))/2*a#
    
    f\x1# = r\x0# + t#*dx#
    f\y1# = r\y0# + t#*dy#
    f\z1# = r\z0# + t#*dz#
    
    Return 1
    
End Function

aika = Timer()

Lock
    For x% = 0 To screenw
        r\x1# = x%
        For y% = 0 To screenh
            r\y1# = y%
            
            f\z0# = 0
            
            fc# = 0.0
            
            col = 255 Shl 24 + 255 Shl 16 + 255 Shl 8 + 255
            For s.sphere = Each sphere
                
                If rsi( ConvertToInteger(r), ConvertToInteger(s), ConvertToInteger(f) ) Then
                
                    f\z0# = f\z1#
                    
                    n.ray = New(ray)
                    
                    n\x0 = (f\x1#-s\x#)/s\w#
                    n\y0 = (f\y1#-s\y#)/s\w#
                    n\z0 = (f\z1#-s\z#)/s\w#
                    
                    For l.light = Each light
                        
                        n\x1 = l\x - f\x1
                        n\y1 = l\y - f\y1
                        n\z1 = -l\z - f\z1
                        
                        nlen# = Sqrt(n\x1^2+n\y1^2+n\z1^2)
                        n\x1 = n\x1 / nlen: n\y1 = n\y1 / nlen: n\z1 = n\z1 / nlen
                        
                        fadd# =  (n\x0*n\x1 + n\y0*n\y1 + n\z0*n\z1)*.6
                        
                        If fadd#<0 Then fadd# = 0
                        
                        fc = fc + fadd
                        
                    Next l
                    
                    If fc#>1.0 Then fc# = 1.0
                    If fc#<0.0 Then fc# = 0.0
                    
                    col = (255 Shl 24) +  ( Int(0.9*fc*Float(s\r) + 0.1*Float(s\r)) Shl 16) + (Int(0.9*fc*Float(s\g) + 0.1*Float(s\g)) Shl 8) + Int( 0.9*fc*Float(s\b) + 0.1*Float(s\b))
                    
                    Delete n
                    
                EndIf
                    
            Next s
                
            PutPixel2 x, y, col
            
        Next y%
    Next x%
Unlock

Color 0, 0, 0
Text 10, 10, Str(Timer() - aika)
DrawScreen
WaitKey
EDIT: joo, vaihdoin järkevämpään piirtokomentoon, renderöintiaika tippui puoleen.

User avatar
phons
Guru
Posts: 1056
Joined: Wed May 14, 2008 10:11 am

Re: Efektit

Post by phons » Thu Jan 22, 2009 8:39 pm

Tulee Memory Acces Violation ja koska en kovin hyvin ymmärrä tuota en löydä mitään paikkaa mikä sen aiheuttaisi.
Image

User avatar
KilledWhale
Tech Developer
Tech Developer
Posts: 543
Joined: Sun Aug 26, 2007 2:43 pm
Location: Liminka

Re: Efektit

Post by KilledWhale » Thu Jan 22, 2009 8:51 pm

phons wrote:Tulee Memory Acces Violation ja koska en kovin hyvin ymmärrä tuota en löydä mitään paikkaa mikä sen aiheuttaisi.
Johtuu siitä että tuo koodi tunkee pikseleitä ruudun ulkopuolelle. Tämä on taas näitä ceebeen satunnaisia erroreita jotka joillain koneilla ilmenevät. Tässä korjattu versio:

Code: Select all

    Const screenw% = 640
    Const screenh% = 480

    SCREEN screenw, screenh

    Type sphere
       
        Field x#
        Field y#
        Field z#
        Field w#
       
        Field r%
        Field g%
        Field b%
       
    EndType

    Type ray
       
        Field x0#
        Field y0#
        Field z0#
       
        Field x1#
        Field y1#
        Field z1#
       
    EndType

    Type light
       
        Field x#
        Field y#
        Field z#
       
    EndType

    s.sphere = New(sphere)
    s\x# = screenw*.6666666: s\y# = screenh/2.0: s\z# = -80: s\w# = 60: s\r% = 255: s\g% = 0: s\b% = 0
    s.sphere = New(sphere)
    s\x# = screenw/3.0: s\y# = screenh/2.0: s\z# = -80: s\w# = 60: s\r% = 0: s\g% = 0: s\b% = 255

    l.light = New(light)
    l\x = 10.0: l\y = 10.0: l\z = -200

    //l.light = New(light)
    //l\x = 700.0: l\y = screenh/2: l\z = -100

    r.ray = New(ray)
    r\x0# = screenw/2.0
    r\y0# = screenh/2.0
    r\z0# = -500
    r\z1# = 0

    f.ray = New(ray)

    Function rsi( rid%, sid%, fid )
       
        r.ray = ConvertToType(rid%)
        s.sphere = ConvertToType(sid%)
        f.ray = ConvertToType(fid%)
       
        dx# = r\x1# - r\x0#
        dy# = r\y1# - r\y0#
        dz# = r\z1# - r\z0#
       
        Q# = Sqrt(dx#^2 + dy#^2 + dz#^2)
        dx = dx / Q: dy = dy / Q: dz = dz / Q
       
        a# = dx#^2 + dy#^2 + dz#^2
        b# = 2*dx#*(r\x0#-s\x#) + 2*dy#*(r\y0#-s\y) + 2*dz#*(r\z0#-s\z#)
        c# = s\x#^2 + s\y#^2 + s\z#^2 + r\x0^2 + r\y0^2 + r\z0^2 -2*(s\x# * r\x0# + s\y# * r\y0# + s\z#*r\z0#) - s\w#^2
        d# = b#^2 - 4*a#*c#
       
        If d<0 Then Return 0
       
        t# = (-b#+Sqrt(d#))/2*a#
       
        f\x1# = r\x0# + t#*dx#
        f\y1# = r\y0# + t#*dy#
        f\z1# = r\z0# + t#*dz#
       
        Return 1
       
    End Function

    aika = Timer()

    Lock
        For x% = 0 To screenw - 1
            r\x1# = x%
            For y% = 0 To screenh - 1
                r\y1# = y%
               
                f\z0# = 0
               
                fc# = 0.0
               
                col = 255 Shl 24 + 255 Shl 16 + 255 Shl 8 + 255
                For s.sphere = Each sphere
                   
                    If rsi( ConvertToInteger(r), ConvertToInteger(s), ConvertToInteger(f) ) Then
                   
                        f\z0# = f\z1#
                       
                        n.ray = New(ray)
                       
                        n\x0 = (f\x1#-s\x#)/s\w#
                        n\y0 = (f\y1#-s\y#)/s\w#
                        n\z0 = (f\z1#-s\z#)/s\w#
                       
                        For l.light = Each light
                           
                            n\x1 = l\x - f\x1
                            n\y1 = l\y - f\y1
                            n\z1 = -l\z - f\z1
                           
                            nlen# = Sqrt(n\x1^2+n\y1^2+n\z1^2)
                            n\x1 = n\x1 / nlen: n\y1 = n\y1 / nlen: n\z1 = n\z1 / nlen
                           
                            fadd# =  (n\x0*n\x1 + n\y0*n\y1 + n\z0*n\z1)*.6
                           
                            If fadd#<0 Then fadd# = 0
                           
                            fc = fc + fadd
                           
                        Next l
                       
                        If fc#>1.0 Then fc# = 1.0
                        If fc#<0.0 Then fc# = 0.0
                       
                        col = (255 Shl 24) +  ( Int(0.9*fc*Float(s\r) + 0.1*Float(s\r)) Shl 16) + (Int(0.9*fc*Float(s\g) + 0.1*Float(s\g)) Shl 8) + Int( 0.9*fc*Float(s\b) + 0.1*Float(s\b))
                       
                        Delete n
                       
                    EndIf
                       
                Next s
                   
                PutPixel2 x, y, col
               
            Next y%
        Next x%
    Unlock

    Color 0, 0, 0
    Text 10, 10, Str(Timer() - aika)
    DrawScreen
    WaitKey
CoolBasic henkilökuntaa
Kehittäjä

cbFUN Kello
cbSDL
Whale.dy.fi

<@cce> miltäs tuntuu olla suomen paras

User avatar
KilledWhale
Tech Developer
Tech Developer
Posts: 543
Joined: Sun Aug 26, 2007 2:43 pm
Location: Liminka

Re: Efektit

Post by KilledWhale » Mon Jan 26, 2009 12:06 am

Anteeksi nyt tuplapostia mutta tulisi pieni efekti ja laitan uuden viestin että ihmeiset huomaavat aiheen päivittyneen :D
Eli pienet ascii metapallerot jotka käänsin mureakuhasta alunperin javascriptille tehdyistä. Tehoja vaatii jonkun verran joten pallojen määrää ja ruudun kokoa kannattaa säädellä.

Code: Select all

SCREEN 400, 400
	
	sw = ScreenWidth()
	sh = ScreenHeight()
	
	w = sw / 10
	h = sh / 10
	
	Const BALLS = 3
	
	Type ball
		Field x
		Field y
		Field r
		Field mod1 As Float
		Field mod2 As Float
	EndType
	
	For i = 1 To BALLS
		b.ball = New(ball)
		b\x = Rand(w)
		b\y = Rand(h)
		b\r = 15 + Rand(15)
		b\mod1 = 1.5 - Rnd(1)
		b\mod2 = 1.5 - Rnd(1)
	Next i

Repeat
	For x = 0 To w
		For y = 0 To h
			n# = 0.0
			For b.ball = Each ball
				xx = x - b\x
				yy = y - b\y
				n# = n# + b\r / (((xx * xx) + (yy * yy)) * 1.1)
				
				b\x = (w Shr 1) + (Sin(b\mod1 * (Timer() / 10)) * ((w - 10) Shr 1))
				b\y = (h Shr 1) + (Cos(b\mod2 * (Timer() / 10)) * ((h - 10) Shr 1))
			Next b
			
			If n# < 0 Then 
				n# = 0
			ElseIf n# > 1 Then
				n# = 1
			EndIf

			Color 0, n * 255, 0
			Text x*10, y*10, "@"
		Next y
	Next x
	
	SetWindow "Ascii meatballs - " + FPS()
	DrawScreen OFF
Forever
CoolBasic henkilökuntaa
Kehittäjä

cbFUN Kello
cbSDL
Whale.dy.fi

<@cce> miltäs tuntuu olla suomen paras

Jonhu
Active Member
Posts: 186
Joined: Mon Aug 04, 2008 5:45 pm

Re: Efektit

Post by Jonhu » Tue Feb 03, 2009 1:15 pm

Tein tälläisen pikku aaltoefectin.
Lataus vähäsen kestää, mutta efecti on odottamisen arvoinen :)

Kaavat tuohon väritaulukon tekemiseen otin tuolta: http://www.ohjelmointiputka.net/opas.php?tunnus=plasma

EDIT: Vihdoinkin korjattu toimivaksi kaikille :)

Code: Select all

SCREEN 400,300
FrameLimit 40

Const Kerroin = 100 'testaa eri luvuilla
Const Kuvia   = 12  'ladattavien kuvien määrä-1
Const viive   = 60 ' asetetaan viive kuvien vaihto välille

Dim pixeli(255,3) ' väreille taulukko
Dim kuva(Kuvia)   ' kuville taulukko

sw = ScreenWidth()
sh = ScreenHeight()

// Pistetään värejä taulukkoon...
For i = 0 To 255
    luku + 100
    Pixeli(i,0) = Func( Int( 72 + 71 * Cos( i * PI / 128 + luku / 74)) ) // punaisen värin määrä
    Pixeli(i,1) = Func( Int( 72 + 71 * Sin( i * PI / 128 + luku / 63)) ) // vihreän värin määrä
    pixeli(i,2) = Func( Int( 72 - 71 * Cos( i * PI / 128 + luku / 81)) ) // sinisen värin määrä   
Next i

Print "Kuvia tehdään "+(Kuvia+1)+". Teko kestää noin minutin"

For i=0 To Kuvia
    kuva(i) = MakeImage(sw,sh) // tehdään kuva
    Lock Image(kuva(i))        // lukitaan kuva
        For x = 0 To sw        // käydään jokainen pikseli läpi
            For y = 0 To sh
                luk#+1 ' mitä suurempi sitä mutkaisempi
                xx = sw + x + Kerroin * Cos(luk# * PI / 360) //lasketaan vähän
                yy = sh + y + Kerroin * Sin(luk# * PI / 360)
                vari = Func( (xx + yy) / 2 )                 // lasketaan keskiarvo
                Color pixeli(vari,0),pixeli(vari,1),pixeli(vari,2) // värin asetus
                PutPixel2 x, y, vari,Image(kuva(i))                // pikseli kuvaan
            Next y
        Next x
    Unlock Image(kuva(i))
    Color cbwhite
    Print "Kuvia tehty: "+(i+1)
Next i
   
a=0   
// pyöritetään kuvia järjestyksessä...
Repeat
    SetWindow "FPS: "+ FPS()

    If Timer()>aika+Viive Then
        a=a+1
        If a>kuvia then a=0
        aika=Timer()
    EndIf

    DrawImage kuva(a),0,0

    DrawScreen
Forever

Function Func(nro,max1=255,min1=0)
    If nro>max1
        Return (nro-max1)
    ElseIf nro<min1
        Return (nro+min1)
    EndIf
    Return nro
   
EndFunction
EDIT: Huomenna kulunut 6kk siitä, kun kuulin, mikä on Coolbasic :P
Last edited by Jonhu on Thu Feb 05, 2009 5:15 pm, edited 5 times in total.
Tekeillä pikkupelejä ja ohjelmia :)

Character
Active Member
Posts: 113
Joined: Thu Nov 27, 2008 3:16 pm

Re: Efektit

Post by Character » Tue Feb 03, 2009 2:35 pm

Jonhu wrote:Tein tälläisen pikku aaltoefectin.
Lataus vähäsen kestää, mutta efecti on odottamisen arvoinen :)
MAV! :o

Edit: Siinä kun se on jo ladannut ja sen aaltoefektin pitäisi tulla niin MAV.

Edit2: Kumma.. Ei tuokaan toiminut minulla. :cry:
Last edited by Character on Tue Feb 03, 2009 4:59 pm, edited 3 times in total.

Jonhu
Active Member
Posts: 186
Joined: Mon Aug 04, 2008 5:45 pm

Re: Efektit

Post by Jonhu » Tue Feb 03, 2009 2:56 pm

Character wrote:
Jonhu wrote:Tein tälläisen pikku aaltoefectin.
Lataus vähäsen kestää, mutta efecti on odottamisen arvoinen :)
MAV! :o
Itellä ei tule :| Missä lataamisen vaiheessa sinulla tulee MAV?
Edittaa vastaus postiisi ;)

Testasin nyt toisella koneella ja sain korjattua virheen. Jostain syystä tuo functio ei toiminut toisella koneella...
Last edited by Jonhu on Tue Feb 03, 2009 10:47 pm, edited 2 times in total.
Tekeillä pikkupelejä ja ohjelmia :)

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

Re: Efektit

Post by MaGetzUb » Tue Feb 03, 2009 4:50 pm

KilledWhale wrote:Lähetetty: Ma Tammi 26, 2009 12:06 am Vastaa lainaamalla

Anteeksi nyt tuplapostia mutta tulisi pieni efekti ja laitan uuden viestin että ihmeiset huomaavat aiheen päivittyneen
Eli pienet ascii metapallerot jotka käänsin mureakuhasta alunperin javascriptille tehdyistä. Tehoja vaatii jonkun verran joten pallojen määrää ja ruudun kokoa kannattaa säädellä.

Code: Select all

...Koodia..

Tuosta tulee hyvän näköinen, kun Text x*10,y*10,"@" vaihtaa Box x*10,y*10,10,10
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
elmo123
Active Member
Posts: 153
Joined: Sun Sep 09, 2007 4:19 pm

Re: Efektit

Post by elmo123 » Sun Feb 15, 2009 7:42 pm

Black & white-efekti. 8-)
Tekstiä voi raahata.

Code: Select all


Const TXT = "Black & White"

SetFont LoadFont("impact", 50)

img1 = MakeImage(400, 300)

MaskImage img1, -9999, -9999, -9999


DrawToImage img1

    k = 1

    For x = 0 To 6
        For y = 0 To 4

            k = Not k
            Color 255 * k, 255 * k, 255 * k
            Box x * 64, y * 64, 64, 64

        Next y
    Next x

DrawToScreen


img2 = MakeImage(400, 300)

MaskImage img2, -9999, -9999, -9999


DrawToImage img2


    k = 0

    For x = 0 To 6
        For y = 0 To 4

            k = Not k
            Color 255 * k, 255 * k, 255 * k
            Box x * 64, y * 64, 64, 64

        Next y
    Next x


DrawToScreen


coverimg = MakeImage(400, 300)

MaskImage coverimg, cbWhite



mask = MakeImage(400, 300)

MaskImage mask, cbMagenta


ClsColor 128, 128, 128

textx = 200
texty = 150
textw = TextWidth(TXT)
texth = TextHeight(TXT)

Repeat

    mx = MouseX()
    my = MouseY()

    If MouseHit(1) And BoxOverlap(mx, my, 1, 1, textx - textw / 2, texty - texth / 2, textw, texth) Then hold = 1 : contactx = textx - mx : contacty = texty - my
    If MouseUp(1) Then hold = 0


    If hold Then textx = mx + contactx : texty = my + contacty


    If KeyDown(cbKeySpace) = 0 Then DrawImage img1, 0, 0



    DrawToImage coverimg


        Color cbMagenta
        Box 0, 0, 400, 300

        Color cbWhite
        CenterText textx, -texty, TXT, 2


    DrawToScreen



    DrawToImage mask


        DrawImage img2, 0, 0
        DrawImage coverimg, 0, 0


    DrawToScreen


    DrawImage mask, 0, 0


    DrawScreen


Forever


Kiinnostuin pelien tekemisestä ennen 1. luokkaa.
Sitten 3. luokalla tuli CB. Ja siitä se alkoi.

Blender! TF2! CB! Game Maker! Nokia-mollaus! Kitaransoitto! Breakdance! MadTracker! Minecraft!

Jonhu
Active Member
Posts: 186
Joined: Mon Aug 04, 2008 5:45 pm

Re: Efektit

Post by Jonhu » Sun Feb 15, 2009 8:48 pm

Tässä tälläinen functio :)

Tein tämän pääasiassa vain laskuharjoituksena, mutta sopii tuo vähäsen eilisen ystävänpäivänkin teemaan ;)

Code: Select all

FrameLimit 30

Const MinSize=10
Const MaxSize=150

ShowMouse OFF

koko = MinSize

Repeat

    If suunta=0 Then 
        koko+1
        If koko > MaxSize Then suunta=1
    Else
        koko-1
        If koko < MinSize Then suunta=0
    EndIf
    
    sydan( MouseX(), MouseY(), koko , 75 )
    
    DrawScreen
    
Forever

// Function Sydan()
//
// Tapa määrää, onko (x,y)-piste kuvion vasen ylänurkka vai keskipiste
//      tapa = 0 ==> (x,y) on kuvion keskipiste
//      tapa = 1 ==> (x,y) on kuvion vasen ylänurkka 
//
// h    = sydämmen "kärkipisteestä" puoliympyröiden puoliväliin oleva matka
// alfa = sydämmen "kärkipisteestä" lähtevien viivojen kulma
// ang  = koko kuvion kulma
Function sydan( x, y, h = 100, alfa# = 75, ang# = 0, tapa = 0 )

    // lasketaan ympyrän säde
    r_# = ( Tan(alfa/2.0) * h ) / 2.0
    
    // Lasketaan sydämmen keskipiste
    If tapa = 1 Then
        kx# = x + 2.0 * r_
        ky# = y + ( h + r_ ) / 2.0
    Else
        kx# = x
        ky# = y
    EndIf
    
    // lasketaan sydämmen kärkipisteen sijainti
    ax# = kx + Cos( ang - 90.0 ) * ( ( h + r_ ) / 2.0 )
    ay# = ky - Sin( ang - 90.0 ) * ( ( h + r_ ) / 2.0 )
    
    // Lasketaan kyljen pituus
    l1_# = h / Cos( alfa / 2.0 )
    
    // piirretään viivat
    line2( ax, ay, l1_# , (alfa/2.0)  + 90.0 + ang)
    line2( ax, ay, l1_# , -(alfa/2.0) + 90.0 + ang)
    
    // lasketaan etäisyys sydämmen keskipisteestä ympyöiden keskipisteeseen
    l2_# = Sqrt( ((r_ - h) ^ 2.0) / 4.0 + r_^2.0 )
    
    // lasketaan kulma sydämmen keskipisteestä ympyöiden keskipisteeseen
    b_# = ATan( (2.0 * r_) / ( r_ - h ) )
    
    // ympyröiden sijainnit..
    cx1# = kx + Cos( ang + ( 90 - b_) ) * l2_#
    cy1# = ky - Sin( ang + ( 90 - b_) ) * l2_#
    
    cx2# = kx + Cos( ang + ( 90 + b_) ) * l2_#
    cy2# = ky - Sin( ang + ( 90 + b_) ) * l2_#
    
    // piirretään kaaret
    kaari( cx1, cy1, r_, ang)
    kaari( cx2, cy2, r_, ang)
    
EndFunction

Function kaari(x_#, y_#, r_#, ang2 = 0, ang1 = 180)
    For a=0 To ang1
        Dot x_# + Cos( a + ang2 ) * r_, y_# - Sin( a + ang2 ) * r_
    Next a
EndFunction


Function line2(x_#, y_#, l_#, ang#)
    Line x_, y_, x_ + Cos( ang ) * l_, y_ - Sin( ang ) * l_
EndFunction
EDIT:
Tässä nyt vielä täytteellä oleva functio ja esimerkki..
Tuon sydämmen täytön teko tuli tehtyä hieman matemaattisesti, mutta näin kuvion saa hienommin väritettyä :)

lm_# ja z_# muuttujat ovat turhia (kuitenkin selventävät koodia), niin halutessasi voit kirjoittaa l3_#n yhtälön näin..

Code: Select all

l3_# = ( Sin( (180.0-alfa) / 2.0 ) * (Tan( b ) * l1_ ) ) / Sin( b ) + ( Sin( 180.0 - y_ - ASin( ( Abs( ( Sin( b ) * l1_) / Sin( y_ ) - r_) * Sin( y_ )) / r_ ) ) * r_) / Sin( y_ )

Code: Select all

SCREEN 640,480

Const FrameWidth = 80
Const FrameHeight= 100
Const Frames = 10


Type ANIM
    Field x
    Field y
    Field img
    Field tim
    Field Frame
EndType

AddText "Loading... "
DrawScreen

sydan_img = MakeImage( RoundUp( (Frames+1) * FrameWidth) , FrameHeight)
DrawToImage sydan_img
    For a=1 To Frames
        sydan2( FrameWidth*a, 50, 4 * a ) 
    Next a
DrawToScreen

ShowMouse OFF
ClearText 

Color cbwhite
AddText "Move mouse :)"


Repeat

    'If MouseHit(1) Then 
    If Timer() > aika+100 And MouseX()<> mousex_old Then 
        aa.ANIM = New (ANIM)
        aa\x    = MouseX() - FrameWidth/2
        aa\y    = MouseY() - FrameHeight/2
        aa\img  = CloneImage(sydan_img)
        aa\Tim  = Timer()
        aa\Frame= 0
        
        mousex_old = MouseX()
        aika=Timer()
    EndIf
    
    For aa.ANIM = Each ANIM
        DrawImageBox aa\img, aa\x, aa\y, aa\Frame * FrameWidth + FrameWidth/2, 0, Framewidth, FrameHeight
        
        If Timer() > aa\tim + 80 Then 
            aa\Frame  + 1
            aa\tim = Timer()
            If aa\Frame > Frames Then 
                DeleteImage aa\img
                Delete aa
            EndIf
        EndIf
    Next aa
    
    Text 300,10,"FPS: "+FPS()
    
    DrawScreen
    
Forever

// Function sydan2
// 
// kuvion keskikohta on sijainnissa (x,y)
// h = sydämmen kärjestä ympyröiden leikkauspisteeseen oleva etäisyys
// alfa = kärjestä lähtevien viivojen välinen kulma
// ang = koko kuvion kallistuma
// tarkkuus = kuinka tiheästi viivoja piirretään (pienempi = tiheämpi)

Function sydan2( x, y, h = 100, alfa# = 75, ang# = 0, tarkkuus#=0.01 )

    // lasketaan ympyrän säde, koska halutaan tietää kuvion leveys, joka on 4r
    r_# = ( Tan(alfa/2.0) * h ) / 2.0
    
    // Lasketaan sydämmen keskipiste
    kx# = x '+ 2.0 * r_         
    ky# = y '+ ( h + r_ ) / 2.0 
    
    // lasketaan sydämmen "kärkipiste"
    ax# = kx + Cos( ang - 90.0 ) * ( ( h + r_ ) / 2.0 )
    ay# = ky - Sin( ang - 90.0 ) * ( ( h + r_ ) / 2.0 )
    
    // Lasketaan kyljen pituus
    l1_# = h / Cos( alfa / 2.0 )
    
    //asetetaan alkuvariarvoksi 255
    r_col# = 255.0
    
    b# = tarkkuus 
    While b < alfa/2.0
    
        // Lasketaan l1_ sivua vastainen kulma
        y_# = - b - ( 540.0 - alfa ) / 2.0    ' y_# = 180.0 - b - (180.0 - alfa)/2  
        
        // lasketaan b - kulmaa vastaavan kateetin pituus
        z_# = ( Sin( b ) * l1_) / Sin( y_ )  ' Tan( b ) * l1_ 
        
        //Lasketaan piirrettävän viivan osan 2. pituus 
        lm_# = ( Sin( 180.0 - y_ - ASin( ( Abs(z_ - r_) * Sin( y_ )) / r_ ) ) * r_) / Sin( y_ )

        //Lasketaan piirrettävän viivan osan 1. pituus ja lisätään siihen 2. pituus ( sinilause )
        l3_# = ( Sin( (180.0-alfa) / 2.0 ) * (Tan( b ) * l1_ ) ) / Sin( b ) + lm_
        
        // valitaan väri
        Color RoundUp(r_col),0,0
        
        // asetetaan uusi arvo punaiselle
        r_col = Max(r_col-0.02,40)
        
        // Piirretään viivat
        line2( ax, ay, l3_,  b + 90.0 + ang)
        line2( ax, ay, l3_, -b + 90.0 + ang)
        
        b = b + tarkkuus
    Wend

EndFunction


Function line2(x_#, y_#, l_#, ang#)
    Line x_, y_, x_ + Cos( ang ) * l_, y_ - Sin( ang ) * l_
EndFunction
Tekeillä pikkupelejä ja ohjelmia :)

DatsuniG
Advanced Member
Posts: 367
Joined: Fri Aug 15, 2008 9:57 pm

Re: Efektit

Post by DatsuniG » Sat Feb 21, 2009 6:01 pm

Kokeilinpas tehä jonkinlaisia fysiikoita pienellä rivimäärällä ja tässä tulos :

Code: Select all

FrameLimit 50
Const Gravity = 0.08
Const Bounce = -0.82
angle = 0
X# = 200
Y# = 0
GravityMultiPlier = 0
Repeat
    If y < ScreenHeight() - 20 Then GravityMultiPlier + 1 Else GravityMultiPlier = GravityMultiplier * Bounce : Y = ScreenHeight() - 20
    If x<0 Or x>ScreenWidth() - 20 Or y<0 Or y > ScreenHeight() - 20 Then 
        angle = 180 - angle
    EndIf 
    Y = (Y + Gravity * GravityMultiplier) - Sin(angle) * 0.8
    X = x + Cos(angle) * 0.8
    Box x,y,20,20
    Text 2,2,FPS()
    DrawScreen
Forever 
Hengität nyt manuaalisesti.

Post Reply