Efektit

[koodaaja]

Kyllä periaatteessa, piirtojärjestys vaatisi kyllä jonkin verran kikkailua.

[temu92]

Ja Coolbasicilla tuota ei sais toimimaan reaaliajassa millään ilveellä.

[MaGetzUb]

Holy sh*t it's amazing! On kyllä taas proo koodarit asiallansa! Hienoa työtä.

Komea efekti koodaajalta tosiaan. Muokkasinpa sitä hieman luomaan suurempaakin kuvaa: FullHD-versio (Varoitus: kyseessä on kahden megan png-tiedosto)

Itseasiassa jos tarkkoja ollaan FullHD on 1920*1080, kuvasi oli vain 1900*1080.

[DatsuniG]

Jaa'a, tylsää oli ja yrittelin vääntää jonkinmoisia efektejä 5 riviin:

Code: Select all

For i = 0 To 1000
    Color 255 * Abs(Sin(i Mod 360)), 255 * Abs(Sin((i + 20) Mod 360)), 255 * Abs(Sin((i + 70) Mod 360))
    Line 200 + Cos((i Mod 360) + (360 / (3 + (1000 - i) / 300)) * (i Mod (360 / (360 / (3 + (1000 - i) / 300))))) * 100, 150 - Sin((i Mod 360) + (360 / (3 + (1000 - i) / 300)) * (i Mod (360 / (360 / (3 + (1000 - i) / 300))))) * 100, 200 + Cos((i Mod 360) + (360 / (3 + (1000 - i) / 300)) * ((i Mod (360 / (360 / (3 + (1000 - i) / 300))))+1)) * 100, 150 - Sin((i Mod 360) + (360 / (3 + (1000 - i) / 300)) * ((i Mod (360 / (360 / (3 + (1000 - i) / 300))))+1)) * 100
    If Not(i Mod (360 / (360 / (3 + (1000 - i) / 300)))) Then DrawScreen 
Next i

Code: Select all

For i = 0 To 1000
    Color 255 * Abs(Sin((i + 30) Mod 360)), 255 * Abs(Sin(i Mod 360)), 255 * Abs(Sin((i + 120) Mod 360))
    Text 200 + Cos(-(i Mod 360) + (8 - (i Mod 8)) * 45) * 125, 150 - Sin(-(i Mod 360) + ( 8 - (i Mod 8)) * 45) * 125,Chr(((i Mod 8) = 0) * 68 + ((i Mod 8) = 1) * 65 + ((i Mod 8) = 2) * 84 + ((i Mod 8) = 3) * 83 + ((i Mod 8) = 4) * 85 + ((i Mod 8) = 5) * 78 + ((i Mod 8) = 6) * 73 + ((i Mod 8) = 7) * 71)
    If Not(i Mod 8) Then DrawScreen Else Wait 5
Next i

[Dande]

Komea efekti koodaajalta tosiaan. Muokkasinpa sitä hieman luomaan suurempaakin kuvaa: FullHD-versio (Varoitus: kyseessä on kahden megan png-tiedosto)

Itseasiassa jos tarkkoja ollaan FullHD on 1920*1080, kuvasi oli vain 1900*1080.

Hupsista
No korjataan asia tällä hieman enemmän generoitua kuviota sisältävällä kuvalla (warning! lähes 4MB ), jossa on korjattu wh#=950 -> wh#=960 kirjoitusvirhe

[Knoy]

Väänsin tälläisen sydeemin:

Code: Select all

SCREEN 800,600,0,0

Dim Angle(3250)
Dim X(3250)
Dim Y(3250)
Dim r2(3250)
Dim g2(3250)
Dim b2(3250)
Dim re2(3250)
Dim gr2(3250)
Dim bl2(3250)

r=54
g=54
b=254

For i = 1 To 3250
    x(i)=X2
    y(i)=Y2
    x2+16
    If x2>798 Then Y2+16
    If X2>798 Then X2=0
    r2(i)=r
    b2(i)=b
    g2(i)=g
    re2(i)=re
    bl2(i)=bl
    gr2(i)=gr
    If re=0 Then r+2 Else r-1
    If r=256 Then re=1
    If r=0 Then re=0
    If bl=0 Then b+2 Else b-1
    If b=256 Then bl=1
    If b=0 Then bl=0
    If gr=0 Then g+2 Else g-1
    If g=256 Then gr=1
    If g=0 Then gr=0
Next i

Speed=2

Repeat
    aika+1
    If (aika Mod 500)=0 Then
        If speed=4 Then Speed =2 Else Speed=4
        Aika=0
    EndIf
    For i = 1 To 3250
        Color r2(i)/1.05,g2(i)/1.05,b2(i)/1.05
        If re2(i)=0 Then r2(i)=r2(i)+Speed Else r2(i)=r2(i)-1
        If r2(i)=255 Then re2(i)=1
        If r2(i)=0 Then re2(i)=0
        If bl2(i)=0 Then b2(i)=b2(i)+Speed Else b2(i)=b2(i)-1
        If b2(i)=255 Then bl2(i)=1
        If b2(i)=0 Then bl2(i)=0
        If gr2(i)=0 Then g2(i)=g2(i)+Speed Else g2(i)=g2(i)-1
        If g2(i)=255 Then gr2(i)=1
        If g2(i)=0 Then gr2(i)=0
            Box x(i),y(i),8,8
    Next i    
    x(3250)=X(1)
    y(3250)=y(1)
    For i = 1 To 3249
        x(i)=x(i+1)
        y(i)=y(i+1)
    Next i
DrawScreen
Forever

Alussa olevia R,G ja B kannattaa kokeilla vaihtaa tulee mukavan näköisiä yhdistelmiä välillä.

[temu92]

Wanhan efektin parantelua:

Code: Select all

sw	= 1000
sh	= 650

SCREEN sw, sh

// Nollaus :P
p	= 0

// Laatikoiden väli
s	= 20

Repeat
	For i=0 To Int(sw/s)*2
		c	= Min(255, i*s/4)
		Color c, c, c
		drawbox((sw/2-(p/2+(s/2)*i))*2, (sh/2-(p/2+(s/2)*i))*2, p+s*i, p+s*i, WrapAngle(a-i))
	Next i
	
	a=WrapAngle(a+1)
	
	p+1
	If p>=s Then
		p = 0
	EndIf
	
	DrawScreen
Forever

Function drawbox(x#, y#, w, h, ang#)
	cw = Cos(ang#)*w/2.0: ch = Cos(ang#)*h/2.0: sw = Sin(ang#)*w/2.0: sh = Sin(ang#)*h/2.0
   
	Line x + cw - sh, y + sw + ch, x - cw - sh, y - sw + ch
	Line x - cw - sh, y - sw + ch, x - cw + sh, y - sw - ch
	Line x - cw + sh, y - sw - ch, x + cw + sh, y + sw - ch
	Line x + cw + sh, y + sw - ch, x + cw - sh, y + sw + ch
EndFunction

[phons]

Ihan jäätävän hieno! Tuon kun vielä saisi ympyröillä

[Jonhu]

Ihan jäätävän hieno! Tuon kun vielä saisi ympyröillä

Tällästäkö tarkotit?
Laatikko versio on kyllä mielestäni hienompi

Code: Select all

sw   = 1000
sh   = 650

SCREEN sw, sh

// Nollaus :P
p   = 0

// Laatikoiden väli
s   = 20

Repeat
   For i=0 To Int(sw/s)*2
      c   = Min(255, i*s/4)
      Color c, c, c
       DrawFastEllipse((sw/2-(p/2+(s/2)*i))*2, (sh/2-(p/2+(s/2)*i))*2, p+s*i, p+s*i, WrapAngle(a-i))
   Next i
   
   a=WrapAngle(a+1)
   
   p+1
   If p>=s Then
      p = 0
   EndIf
   
   DrawScreen
Forever


Function DrawFastEllipse( x#, y#, w, h, ang#, stp=10 )
    cw = w/2
    sh = Sin(ang#)*h/2.0

    For i = 0 To 360/stp 
        a = i*stp 
        Line x+Cos( a )*cw, y+Sin( a )*sh, x + Cos( a + stp )*cw, y+Sin( a + stp )*sh
    Next i
EndFunction

Muutama ellipsikomento tuli väsätty sivussa:
Näitäkin voi kokeilla tuossa temun kehittämässä neliöpohjassa Ensimmäinen ja kolmas ellipsifunktio ovat ihan tyylikkäitä siinä.

Code: Select all

Repeat
    a+1
    
    DrawFastEllipse1( 100,100,200,150, a )
    DrawFastEllipse2( 300,100,80,50,   a )
    DrawFastEllipse3( 100,250,200,100, a )
    DrawFastEllipse4( 300,250,100,50, a )
    
    SetWindow "FPS: "+FPS()
    DrawScreen
Forever

Function DrawFastEllipse4( x#, y#, w, h, ang#, stp=10 )
    cw = w/2
    sh = Sin(ang#)*h/2.0
  //  sh = ATan( ang ) * w 
    For i = 0 To 360/stp 
        a = i*stp 
        Line x+Cos( a )*cw, y+Sin( a )*sh, x + Cos( a + stp )*cw, y+Sin( a + stp )*sh
    Next i
EndFunction


Function DrawFastEllipse3( x#, y#, w, h, ang#, stp=10 )

    cw = Cos(ang#)*w/2.0
    sh = Sin(ang#)*h/2.0

    For i = 0 To 360/stp 
        a = i*stp 
        Line x+Cos( a )*cw, y+Sin( a )*sh, x + Cos( a + stp )*cw, y+Sin( a + stp )*sh
    Next i

EndFunction


Function DrawFastEllipse1( x#, y#, w, h, ang#, stp=10 )

    cw = Cos(ang#)*w/2.0
    ch = Cos(ang#)*h/2.0
    sw = Sin(ang#)*w/2.0
    sh = Sin(ang#)*h/2.0

    For i = 0 To 360/stp 
        a = i*stp 
        Line x+Cos( a )*cw, y+Sin( a )*ch, x + Cos( a + stp )*sw, y+Sin( a + stp )*sh
    Next i

EndFunction

Function DrawFastEllipse2( x#, y#, w, h, ang#, stp=10 )
    For i = 0 To 360/stp 
        a = i*stp 
        Line x+Cos( a+ang )*w, y+Sin( a+ang )*h, x + Cos( a + stp+ang )*w, y+Sin( a + stp+ang )*h
    Next i
EndFunction

[Knoy]

Foorumi tai nettini... lagitti tätä viestiä tehdessäni niin tuli tupla postitus... Toinen viesti ny poistettu on... Hieno sanajärjestys...

Muutama ellipsikomento tuli väsätty sivussa:
Näitäkin voi kokeilla tuossa temun kehittämässä neliöpohjassa Ensimmäinen ja kolmas ellipsifunktio ovat ihan tyylikkäitä siinä.

Code: Select all

Koodia...

Just tuo eka oli aivan saman lainen kun juuri tein... Ei aivan yhtä värikäs tosin... Onneksi katsoin ennen kuin laitoin omani, Olisi aika typerää laittaa kaksi samanlaista effektiä peräkkäin...

No tässä on minun vääntämäni outo effekti:

Code: Select all

//Alku säätöä...
SCREEN 300,300

Dim Piste(360,2)
Dim Angle(360)

// Näitä voi vaihdella...
Kulma=90
InOut=75 //0-150 välillä
Speed = 2//1-8 välillä (Voi laittaa muutakin [ei negatiivisiä], mutta ei tule vaihtumaan enää takaisin näillä asetuksilla.
         // Jos kuitenkin haluat laittaa isomman vaihda myös If lausekkeita rivilta 33-39

//Sijoittaa pisteet alkuun...
For i = 1 To 360
    Angle(i)=Kulma
    Piste(i,1)=150+Cos(Angle(i))*InOut
    Piste(i,2)=150-Sin(Angle(i))*InOut
    Kulma+1
Next i

Repeat//Silmukan alku
    For u = 1 To Speed //Tähän voisi laittaa kertoimen tai jakajan...
        For i = 1 To 360 // Käydään pisteet läpi
            If OutIn=0 Then Color i/2+75, 0, 0 Else Color 255-i/2, 255-i/2, 255-i/2 //Värejä kannattaa koekilla vaihtaa... Voi tulla hienoja yhdistelmiä...
            Angle(i)=WrapAngle(Angle(i)+OutIn+1)
            Dot Piste(i,1),Piste(i,2) //Tähän voisi laittaa myös jotain muuta... Vaikka Text Piste(i,1),Piste(i,2),"#"
            Piste(i,1)=150+Cos(Angle(i))*InOut
            Piste(i,2)=150-Sin(Angle(i))*InOut
        Next i
    Next u
    
    // Tässä saattaa olla kaikkea turhaa kiinnitin enempi huomiota kolaani tässä vaiheessa...
    If InOut = 0 Then OutIn=1
    If InOut = 150 Then OutIn=0
    If InOut = 150 And Speeder = 0 Then Speed+1
    If Speed = 8 Then Speeder=1
    If InOut = 150 And Speeder = 1 Then Speed-1
    If Speed = 1 And InOut = 150 Then Speeder = 0
    If OutIn = 0 Then InOut-1 Else InOut+1
    // En jaksanut kääntää suomeksi... If lausekkeet on helppo ymmärtää...

    DrawScreen OFF // Näyttää ihan kivalta myös ilma OFF:ia
        
Forever //Silmukan Loppu

[koodaaja]

Kääntelin wanhan kleinin pulloni CB-koodiksi. Kovin montaa pistettä tässä ei toki piirrellä mutta ihan hauska se on.

Code: Select all

SCREEN 800, 600

Const VEC_COUNT = 999
Dim vec(VEC_COUNT*3) As Float

Function drawpoint(px#, y#, pz#, ang#)
    Dim z#, s#, co#, si#
    co# = Cos(ang#):si# = Sin(ang#)
    z# =-si#*px#+co#*pz#+10.0
    s# = (1.0/z#)*600
    PutPixel2 (co#*px#+si#*pz#)*s#+400, y#*s#+300, 255 Shl 16 + 255 Shl 8 + 255
EndFunction

Dim i%, ang#

For i = 0 To VEC_COUNT*3 Step 3
    Dim a#, r#, u#, v#
    u# = Rnd(360.0):v# = Rnd(360.0)
    a# = Sqrt((Cos(u#)-Cos(2.0*u#))*(Cos(u#)-Cos(2.0*u#)) + (3.0*Sin(u#))*(3.0*Sin(u#)))
    r# = (1.0 + .2*Sin(u#))
    vec(i+0) = (Sin(u#) - 0.5 * Sin(2.0*u#)+3.0*r#*Sin(u#)*Cos(v#)/a#)
    vec(i+1) = (-3.0*Cos(u#) + r#*(Cos(2.0*u#)-Cos(u#))*Cos(v#)/a#)
    vec(i+2) = (r#*Sin(v#))
Next i

Repeat
    
    ang# = WrapAngle(ang# - 2.0)
    
    Lock
        For i = 0 To VEC_COUNT*3 Step 3
            drawpoint(vec(i+0), vec(i+1), vec(i+2), ang#)
        Next i
    Unlock
    
    DrawScreen
Forever

Pikaeditoidaas samaan viestiin vielä Bezier-systeemi, joka tuli kirjoiteltua harjoituksena ennen bezier patchien lataamista utah teapotin alkuperäistiedostosta. Hiiren vasen lisää ja liikuttaa pisteitä, oikea poistaa. Alkaa kusta mystisesti tietyssä pisteessä, liekö tarkkuusongelma vai olenko vaan failannut jotain.

Code: Select all

SCREEN 800, 600

Type point
    Field x#
    Field y#
End Type

Function fact(a)
    ret = 1
    For i = 2 To a
        ret = ret * i
    Next i
    Return ret
EndFunction

Function nCr(n, i)
    Return fact(n)/(fact(i)*fact(n-i))
EndFunction

held = -1

Repeat
    If MouseHit(1) Then
        held = -1
        For p.point = Each point
            If Distance(p\x, p\y, MouseX(), MouseY())<10
                held = ConvertToInteger(p.point)
            EndIf
        Next p
        If held = -1 Then
            p.point = New(point)
            p\x# = MouseX()
            p\y# = MouseY()
        EndIf
    EndIf
    
    If MouseHit(2) And held = -1 Then
        For p.point = Each point
            If Distance(p\x, p\y, MouseX(), MouseY())<10
                Delete p
            EndIf
        Next p
    EndIf
    
    If MouseUp(1) Then held = -1
    
    If held<>-1 Then
        p.point = ConvertToType(held)
        p\x# = MouseX()
        p\y# = MouseY()
    EndIf
    
    pointcount = -1
    
    For p.point = Each point
        Circle p\x-2, p\y-2, 4, OFF
        pointcount = pointcount + 1
        If pointcount=13 Then
            Delete p:pointcount = pointcount - 1
        EndIf
    Next p
    
    Lock
        p.point = First(point)
        If p<>NULL Then
            lpx# = p\x#
            lpy# = p\y#
            For i = 1 To 20
                t# = i/20.0
                pointcount2 = 0
                px# = 0
                py# = 0
                For p.point = Each point
                    B# = nCr(pointcount, pointcount2)*(t^pointcount2)*((1.0-t#)^(pointcount-pointcount2))
                    pointcount2 = pointcount2 + 1
                    px# = px# + B#*p\x#
                    py# = py# + B#*p\y#
                Next p
                Color 255, 255, 255
                Line px#, py#, lpx#, lpy#
                lpx# = px#
                lpy# = py#
            Next i
        EndIf
    Unlock
    
    DrawScreen
Forever

Temun efekti on muuten erittäin komea, tuo mieleen ysäri-introt.

EDIT: Jonhu heitti privassa vinkeän idean eli viimeisen pisteen sijaan poistetaankin ensimmäinen, jolloin käyrää voi luoda ikuisesti eteenpäin, vaikka loppupää sieltä poistuukin.

Code: Select all

SCREEN 800, 600

Type point
    Field x#
    Field y#
End Type

Function fact(a)
    ret = 1
    For i = 2 To a
        ret = ret * i
    Next i
    Return ret
EndFunction

Function nCr(n, i)
    Return fact(n)/(fact(i)*fact(n-i))
EndFunction

held = -1

Repeat
    If MouseHit(1) Then
        held = -1
        For p.point = Each point
            If Distance(p\x, p\y, MouseX(), MouseY())<10
                held = ConvertToInteger(p.point)
            EndIf
        Next p
        If held = -1 Then
            p.point = New(point)
            p\x# = MouseX()
            p\y# = MouseY()
        EndIf
    EndIf
    
    If MouseHit(2) And held = -1 Then
        For p.point = Each point
            If Distance(p\x, p\y, MouseX(), MouseY())<10
                Delete p
            EndIf
        Next p
    EndIf
    
    If MouseUp(1) Then held = -1
    
    If held<>-1 Then
        p.point = ConvertToType(held)
        p\x# = MouseX()
        p\y# = MouseY()
    EndIf
    
    pointcount = -1
    
    For p.point = Each point
        Circle p\x-2, p\y-2, 4, OFF
        pointcount = pointcount + 1
        If pointcount=13 Then
            f.point = First(point)
            Delete f:pointcount = pointcount - 1
        EndIf
    Next p
    
    Lock
        p.point = First(point)
        If p<>NULL Then
            lpx# = p\x#
            lpy# = p\y#
            For i = 1 To 20
                t# = i/20.0
                pointcount2 = 0
                px# = 0
                py# = 0
                For p.point = Each point
                    B# = nCr(pointcount, pointcount2)*(t^pointcount2)*((1.0-t#)^(pointcount-pointcount2))
                    pointcount2 = pointcount2 + 1
                    px# = px# + B#*p\x#
                    py# = py# + B#*p\y#
                Next p
                Color 255, 255, 255
                Line px#, py#, lpx#, lpy#
                lpx# = px#
                lpy# = py#
            Next i
        EndIf
    Unlock
    
    DrawScreen
Forever

[Wingman]

Just tuo eka oli aivan saman lainen kun juuri tein... Ei aivan yhtä värikäs tosin... Onneksi katsoin ennen kuin laitoin omani, Olisi aika typerää laittaa kaksi samanlaista effektiä peräkkäin...

No tässä on minun vääntämäni outo effekti:

Code: Select all

koodia....

hieno on!

tässä oma vääntämisen tulos...

Code: Select all

sw=800
sh=600
SCREEN sw,sh,0,1
Type PALLO
	Field x
	Field y
    Field c As Float 
	Field siz
EndType
minus=0
balls=0
Repeat 
	Color 60,100,255
	Box 0,0,FPS()+20,12,1
	Box 0,14,minus*4+20,12,1
	Box 0,28,balls/2+20,12,1
	Line 18,0,18,38
	Color 1,1,1
	Line 19,0,19,38
	Text 0,0,FPS()
	Text 0,1,FPS()
	Text 1,0,FPS()
	Text 1,1,FPS()
	Text 0,14,minus
	Text 0,15,minus
	Text 1,14,minus
	Text 1,15,minus
	Text 0,28,balls
	Text 0,29,balls
	Text 1,28,balls
	Text 1,29,balls
	If MouseDown(1) Or MouseDown(2) Or MouseDown(3) Then    
		pal.PALLO=New(PALLO)
		pal\siz=15-Abs(MouseMoveX()/4)-Abs(MouseMoveY()/4)
		pal\x=MouseX()-pal\siz/2
		pal\y=MouseY()-pal\siz/2
		pal\c=255
		balls+1
	EndIf 
	minus=minus+MouseMoveZ()
	If minus>15 Then minus=15
	If minus<0 Then minus=0
	For pal.PALLO=Each PALLO
		pal\c-minus
		Color pal\c/2,pal\c/1.5,pal\c
		Circle pal\x,pal\y,pal\siz,1
		If pal\c<minus Then 
			balls-1
			Delete pal
		EndIf
	Next pal
	DrawScreen 
Forever 

[Knoy]

tässä oma vääntämisen tulos...

Code: Select all

Koodia...

Cool... Alkuun olin et... Aikas hyödytön tää ku rupee lagii vaan... Sit selasin koodin läpi: Olin et oho... Scrollil saa häivytettyy näit nice...
Tein pienen kuvankin tuolla hauska...

Luulin tuossa päivä sitten etten ikinä opi käyttämään cossia ja siniä...

Yhdistin tuon Hypnon ja uuden kello effektini ja syntyi
Second Hand of Time

Code: Select all

SetWindow "Second hand of time" //Ohjelman nimi

//Alku sähellystä
Dim Viisarit (2,2) //Viisarien Dim
Dim Angle(2,2) As Float //Kulmia ja pituuksia
Dim Piste(360,2) //Effektin X,Y
Dim Angle2(360) //Effektien Paikka Cos ja Sin Avulla Anglekakkosesta

Kulma=90//Alkusäätöä... Voi vaihtaa jos haluaa

//Viisareitten sijainti ja pituus yms.
For i = 1 To 2
    Viisarit(i,1)=200
    Viisarit(i,2)=150
    Angle(i,1)=Kulma
    Angle(i,2)=I*25.5
Next i

//Alku suunta/nopeus voi vaihtaa jos haluaa... Toimii tosin nuolillakin...
Speed=0

//Effektin säätöä
Kulma2=90 //Alku kulmaa
InOut=100 //50-150 välillä

//Sijoittaa effektin Yyt ja X:t
For i = 1 To 360
    Angle2(i)=Kulma2
    Piste(i,1)=200+Cos(Angle2(i))*InOut
    Piste(i,2)=150-Sin(Angle2(i))*InOut
    Kulma2+1
Next i


Repeat //Silmukan alku
    // Säätää nopeutta
    If KeyHit(CbKeyRight) And Speed<8 Then Speed +1
    If KeyHit(CbKeyLeft) And Speed>-8 Then Speed-1
    //Kertoo nopeuden
    Text 0,0,"Turnspeed:"+Speed+"  - Use arrow keys to change speed."
    //Muuttaa kulmaa
    Kulma=WrapAngle(Kulma+Speed)
    For i = 1 To 360 //Käy kellon reunat läpi
        kulma+1//Lisää kulmaa
        Dot 200+Cos(Kulma)*50,150-Sin(Kulma)*50// Piirtää kellon reunat
        If (i Mod 30)=0 Then //Tarkistaa pitääkö laittaa tuntiviiva
            Line 200+Cos(Kulma)*49,150-Sin(Kulma)*49,200+Cos(Kulma)*45,150-Sin(Kulma)*45 //Piirtää tuntiviivan
        EndIf
    Next i
    
    For i = 1 To 2 //Käy viisarit läpi
        Angle(2,1)=WrapAngle(Angle(2,1)-Speed)//Käämtää isoa viisaria
        Color 255,55,55 //Väri
        Line Viisarit(i,1),Viisarit(i,2),Viisarit(i,1)+Cos(Angle(i,1))*Angle(i,2),Viisarit(i,2)-Sin(Angle(i,1))*Angle(i,2)
    Next i
    
    If U>5 Then//Tarkistaa pitääkö tuntiviisaria liikuttaa
        Angle(1,1)=WrapAngle(Angle(1,1)-(Speed))//kääntää tuntiviisaria
        U=0// Tuntiviisarin kääntö tarkistuksen nollaaminen
    Else
        If Speed=0 Then U=0 //nollaa tuntiviisarin käännön jos kello pysähtyy
        If Speed=0=0 Then U+1//Lisää tunti viisarin kääntöö aikaa JOS kello ei ole pysähdyksissä.
    EndIf
        
    For i = 1 To 360 // Käydään pisteet läpi
        Color i/2+75, 0, 0
        Angle2(i)=WrapAngle(Angle2(i)+Speed*4)//Speedin kerrointa voi vaihtaa...
        Dot Piste(i,1),Piste(i,2) //Tähän voisi laittaa myös jotain muuta... Vaikka Text Piste(i,1),Piste(i,2),"#"
        Dot Piste(i,1)+1,Piste(i,2) //Lisää effektin kokoa
        Dot Piste(i,1)-1,Piste(i,2) //Lisää effektin kokoa
        Dot Piste(i,1),Piste(i,2)+1 //Lisää effektin kokoa
        Dot Piste(i,1),Piste(i,2)-1 //Lisää effektin kokoa
        Piste(i,1)=200+Cos(Angle2(i))*InOut //laskee pisteelle x sijainnin
        Piste(i,2)=150-Sin(Angle2(i))*InOut //laskee pisteelle y sijainnin
    Next i
    
    //Vetää takaisin ja työntää... Effektin pisteitäsiis
    If InOut = 50 Then OutIn=1
    If InOut = 150 Then OutIn=0
    If OutIn = 0 Then InOut-1 Else InOut+1
    
    DrawScreen 
Forever 

Hieman unessa taas... Meinasin laittaa ellun effektin tuohon koodikseni...

PS. Tunti viisari toimii vain melkein oikein... kait... Heittelee hieman...

Edit:
Niin taas olin aivan unessa tätä tehdessä ja sekin unohtui... Kiva koodata iltaisin, mutta unohtelee aina kaikkie pientä.

Code: Select all

SetWindow "Second hand of time" //Ohjelman nimi

//Alku sähellystä
Dim Viisarit (2,2) //Viisarien Dim
Dim Angle(2,2) As Float //Kulmia ja pituuksia
Dim Piste(360,2) //Effektin X,Y
Dim Angle2(360) //Effektien Paikka Cos ja Sin Avulla Anglekakkosesta

Kulma=90//Alkusäätöä... Voi vaihtaa jos haluaa

//Viisareitten sijainti ja pituus yms.
For i = 1 To 2
    Viisarit(i,1)=200
    Viisarit(i,2)=150
    Angle(i,1)=Kulma
    Angle(i,2)=I*25.5
Next i

//Alku suunta/nopeus voi vaihtaa jos haluaa... Toimii tosin nuolillakin...
Speed=0.0 As Float

//Effektin säätöä
Kulma2=90 //Alku kulmaa
InOut=100 //50-150 välillä

//Sijoittaa effektin Yyt ja X:t
For i = 1 To 360
    Angle2(i)=Kulma2
    Piste(i,1)=200+Cos(Angle2(i))*InOut
    Piste(i,2)=150-Sin(Angle2(i))*InOut
    Kulma2+1
Next i


Repeat //Silmukan alku
    // Säätää nopeutta
    If KeyDown(CbKeyRight) And Speed<80 Then 
        Speed+1
        odotus+3
    EndIf
    If KeyDown(CbKeyLeft) And Speed>-80 Then
        Speed-1
        odotus+3
    EndIf
    If odotus>0 Then Odotus-1
    //Kertoo nopeuden
    Text 0,0,"Turnspeed:"+Float(Speed)/10+"  - Use arrow keys to change speed."
    //Muuttaa kulmaa
    Kulma=WrapAngle(Kulma+Float(Speed)/10)
    For i = 1 To 360 //Käy kellon reunat läpi
        kulma+1//Lisää kulmaa
        Dot 200+Cos(Kulma)*50,150-Sin(Kulma)*50// Piirtää kellon reunat
        If (i Mod 30)=0 Then //Tarkistaa pitääkö laittaa tuntiviiva
            Line 200+Cos(Kulma)*49,150-Sin(Kulma)*49,200+Cos(Kulma)*45,150-Sin(Kulma)*45 //Piirtää tuntiviivan
        EndIf
    Next i
    
    For i = 1 To 2 //Käy viisarit läpi
        Angle(2,1)=WrapAngle(Angle(2,1)-Float(Speed)/10)//Käämtää isoa viisaria
        Color 255,55,55 //Väri
        Line Viisarit(i,1),Viisarit(i,2),Viisarit(i,1)+Cos(Angle(i,1))*Angle(i,2),Viisarit(i,2)-Sin(Angle(i,1))*Angle(i,2)
    Next i
    
    If U>5 Then//Tarkistaa pitääkö tuntiviisaria liikuttaa
        Angle(1,1)=WrapAngle(Angle(1,1)-(Float(Speed)/10))//kääntää tuntiviisaria
        U=0// Tuntiviisarin kääntö tarkistuksen nollaaminen
    Else
        If Speed=0 Then U=0 //nollaa tuntiviisarin käännön jos kello pysähtyy
        If Speed=0=0 Then U+1//Lisää tunti viisarin kääntöö aikaa JOS kello ei ole pysähdyksissä.
    EndIf
        
    For i = 1 To 360 // Käydään pisteet läpi
        Color i/2+75, 0, 0
        Angle2(i)=WrapAngle(Angle2(i)+(Float(Speed)*4)/10)//Speedin kerrointa voi vaihtaa...
        Dot Piste(i,1),Piste(i,2) //Tähän voisi laittaa myös jotain muuta... Vaikka Text Piste(i,1),Piste(i,2),"#"
        Dot Piste(i,1)+1,Piste(i,2) //Lisää effektin kokoa
        Dot Piste(i,1)-1,Piste(i,2) //Lisää effektin kokoa
        Dot Piste(i,1),Piste(i,2)+1 //Lisää effektin kokoa
        Dot Piste(i,1),Piste(i,2)-1 //Lisää effektin kokoa
        Piste(i,1)=200+Cos(Angle2(i))*InOut //laskee pisteelle x sijainnin
        Piste(i,2)=150-Sin(Angle2(i))*InOut //laskee pisteelle y sijainnin
    Next i
    
    //Vetää takaisin ja työntää... Effektin pisteitäsiis
    If InOut = 50 Then OutIn=1
    If InOut = 150 Then OutIn=0
    If OutIn = 0 Then InOut-1 Else InOut+1
    
    DrawScreen 
Forever

Siinä olisi desimaali luvulla.

[Wingman]

tässä oma vääntämisen tulos...

Code: Select all

Koodia...

Cool... Alkuun olin et... Aikas hyödytön tää ku rupee lagii vaan... Sit selasin koodin läpi: Olin et oho... Scrollil saa häivytettyy näit nice...
Tein pienen kuvankin tuolla hauska...

Luulin tuossa päivä sitten etten ikinä opi käyttämään cossia ja siniä...

Yhdistin tuon Hypnon ja uuden kello effektini ja syntyi
Second Hand of Time

Code: Select all

SetWindow "Second hand of time" //Ohjelman nimi

//Alku sähellystä
Dim Viisarit (2,2) //Viisarien Dim
Dim Angle(2,2) As Float //Kulmia ja pituuksia
Dim Piste(360,2) //Effektin X,Y
Dim Angle2(360) //Effektien Paikka Cos ja Sin Avulla Anglekakkosesta

Kulma=90//Alkusäätöä... Voi vaihtaa jos haluaa

//Viisareitten sijainti ja pituus yms.
For i = 1 To 2
    Viisarit(i,1)=200
    Viisarit(i,2)=150
    Angle(i,1)=Kulma
    Angle(i,2)=I*25.5
Next i

//Alku suunta/nopeus voi vaihtaa jos haluaa... Toimii tosin nuolillakin...
Speed=0

//Effektin säätöä
Kulma2=90 //Alku kulmaa
InOut=100 //50-150 välillä

//Sijoittaa effektin Yyt ja X:t
For i = 1 To 360
    Angle2(i)=Kulma2
    Piste(i,1)=200+Cos(Angle2(i))*InOut
    Piste(i,2)=150-Sin(Angle2(i))*InOut
    Kulma2+1
Next i


Repeat //Silmukan alku
    // Säätää nopeutta
    If KeyHit(CbKeyRight) And Speed<8 Then Speed +1
    If KeyHit(CbKeyLeft) And Speed>-8 Then Speed-1
    //Kertoo nopeuden
    Text 0,0,"Turnspeed:"+Speed+"  - Use arrow keys to change speed."
    //Muuttaa kulmaa
    Kulma=WrapAngle(Kulma+Speed)
    For i = 1 To 360 //Käy kellon reunat läpi
        kulma+1//Lisää kulmaa
        Dot 200+Cos(Kulma)*50,150-Sin(Kulma)*50// Piirtää kellon reunat
        If (i Mod 30)=0 Then //Tarkistaa pitääkö laittaa tuntiviiva
            Line 200+Cos(Kulma)*49,150-Sin(Kulma)*49,200+Cos(Kulma)*45,150-Sin(Kulma)*45 //Piirtää tuntiviivan
        EndIf
    Next i
    
    For i = 1 To 2 //Käy viisarit läpi
        Angle(2,1)=WrapAngle(Angle(2,1)-Speed)//Käämtää isoa viisaria
        Color 255,55,55 //Väri
        Line Viisarit(i,1),Viisarit(i,2),Viisarit(i,1)+Cos(Angle(i,1))*Angle(i,2),Viisarit(i,2)-Sin(Angle(i,1))*Angle(i,2)
    Next i
    
    If U>5 Then//Tarkistaa pitääkö tuntiviisaria liikuttaa
        Angle(1,1)=WrapAngle(Angle(1,1)-(Speed))//kääntää tuntiviisaria
        U=0// Tuntiviisarin kääntö tarkistuksen nollaaminen
    Else
        If Speed=0 Then U=0 //nollaa tuntiviisarin käännön jos kello pysähtyy
        If Speed=0=0 Then U+1//Lisää tunti viisarin kääntöö aikaa JOS kello ei ole pysähdyksissä.
    EndIf
        
    For i = 1 To 360 // Käydään pisteet läpi
        Color i/2+75, 0, 0
        Angle2(i)=WrapAngle(Angle2(i)+Speed*4)//Speedin kerrointa voi vaihtaa...
        Dot Piste(i,1),Piste(i,2) //Tähän voisi laittaa myös jotain muuta... Vaikka Text Piste(i,1),Piste(i,2),"#"
        Dot Piste(i,1)+1,Piste(i,2) //Lisää effektin kokoa
        Dot Piste(i,1)-1,Piste(i,2) //Lisää effektin kokoa
        Dot Piste(i,1),Piste(i,2)+1 //Lisää effektin kokoa
        Dot Piste(i,1),Piste(i,2)-1 //Lisää effektin kokoa
        Piste(i,1)=200+Cos(Angle2(i))*InOut //laskee pisteelle x sijainnin
        Piste(i,2)=150-Sin(Angle2(i))*InOut //laskee pisteelle y sijainnin
    Next i
    
    //Vetää takaisin ja työntää... Effektin pisteitäsiis
    If InOut = 50 Then OutIn=1
    If InOut = 150 Then OutIn=0
    If OutIn = 0 Then InOut-1 Else InOut+1
    
    DrawScreen 
Forever 

Hieman unessa taas... Meinasin laittaa ellun effektin tuohon koodikseni...

PS. Tunti viisari toimii vain melkein oikein... kait... Heittelee hieman...

hienoa on, mutta yksi toive olisi: laita pyöriminen liukulukuna, saa hitaampiaki kelloja....

EDIT: muokkasin ittelleni ne liukuluvut...

[CCE]

Muistaakseni en ole tätä tänne vielä postannutkaan, kyseessä on siis simppeli linssiefekti CopyBoxilla.

Code: Select all

Type BLOCK
	Field x As Float
	Field y As Float
	Field xs As Float
	Field ys As Float
	Field w
	Field h
EndType

PositionCamera 200,-150	// muuten menee CopyBox ohi ruudusta
kuva=LoadImage("media\map.bmp")
cow=LoadImage("media\cow.bmp")

For i=0 To 2
uusi.BLOCK = New(BLOCK)
uusi\x=50
uusi\y=50
uusi\xs=Rnd(-2,2)
uusi\ys=Rnd(-2,2)
uusi\w=48
uusi\h=48
Next i
Repeat

	DrawImage kuva,0,0
	DrawImage cow, MouseX()-16, MouseY()-24
	Color cbBlue

	For iBlock.BLOCK = Each BLOCK
		iBlock\x = iBlock\x + iBlock\xs
		iBlock\y = iBlock\y + iBlock\ys
		If iBlock\x < 16 Then iBlock\xs = -iBlock\xs
		If iBlock\y < 16 Then iBlock\ys = -iBlock\ys
		If iBlock\x > ScreenWidth()-iBlock\w-16 Then iBlock\xs = -iBlock\xs
		If iBlock\y > ScreenHeight()-iBlock\h-16 Then iBlock\ys = -iBlock\ys
		pala = (iBlock\w / 8)
		For y=0 To iBlock\h/pala-1
		For x=0 To iBlock\w/pala-1
			'Dot iBlock\x+x*8, iBlock\y+y*8
			ax=iBlock\x+x*8
			ay=iBlock\y+y*8
			matka=Distance(x,y,4,4)
			px=16-x*2
			py=16-y*2
			CopyBox ax, ay, pala+px, pala+py, ax-px, ay-py
		Next x
		Next y
		
		'	Box iBlock\x-16, iBlock\y-16, iBlock\w+32, iBlock\h+32,0
	Next iBLock
	
		For iBlock.BLOCK = Each BLOCK
		Box iBlock\x-16, iBlock\y-16, iBlock\w+32, iBlock\h+32,0
	Next iBLock
	DrawScreen

Forever

[MaGetzUb]

Muistaakseni en ole tätä tänne vielä postannutkaan, kyseessä on siis simppeli linssiefekti CopyBoxilla.

Voihan vattu, ku oli hieno! Aika yksinkertainen toimimis tapa.

[Kille]

Tein tollasen matrix-jutun, mutta chr()-funktiolla en saa kuin nollia ja satunnaisia muita numeroita

Edit: Nyt toimii
Edit2: nyt ne tulee ylhäältä

Code: Select all

        SCREEN 800,500

        FrameLimit 20

        Type MAT
            Field kirjain$
            Field väri2
            Field posx
            Field posy
            Field spawn
        End Type

        Type WANHA
            Field kirj$
            Field väri
            Field x
            Field y
        End Type

        Repeat



        For i = 5 To ScreenWidth() Step 10
        If Rand(1,90)=1 Then
        n.MAT =New (MAT)
        n\kirjain$=Chr(Rand(32,255))
        n\väri2=255
        n\posx=i
        n\posy=1
        EndIf
        Next i

        For matrix.MAT = Each MAT
        Color 255,255,255
        Text matrix\posx,matrix\posy,matrix\kirjain$
        w.WANHA = New(WANHA)
        w\kirj$=Chr(Rand(32,255))
        w\väri=255
        w\x=matrix\posx
        w\y=matrix\posy-3
        matrix\spawn=False
        matrix\väri2-4
        matrix\posy+9
        matrix\kirjain$=Chr(Rand(32,255))
        If matrix\väri2<1 Then Delete matrix
        Next matrix

        For w.WANHA= Each WANHA
        Color 0,w\väri,0
        Text w\x,w\y,w\kirj$
        w\väri-5
        If w\väri<1 Then Delete w
        Next w

        DrawScreen

        Forever  

[koodaaja]

Tallennat kirjaimet lukuina. "Field kirjain$" ja "Field kirj$" ratkaisevat ongelman. On muuten oikein komea.

[Wingman]

Tein tollasen matrix-jutun, mutta chr()-funktiolla en saa kuin nollia ja satunnaisia muita numeroita

Edit: Nyt toimii

Code: Select all

    SCREEN 500,500

    FrameLimit 20

    Type MAT
        Field kirjain$
        Field väri2
        Field posx
        Field posy
        Field spawn
    End Type

    Type WANHA
        Field kirj$
        Field väri
        Field x
        Field y
    End Type

    Repeat



    For i = 5 To ScreenWidth() Step 10
    If Rand(1,120)=1 Then
    n.MAT =New (MAT)
    n\kirjain$=Chr(Rand(255))
    n\väri2=255
    n\posx=i
    n\posy=Rand(ScreenHeight())
    EndIf
    Next i

    For matrix.MAT = Each MAT
    Color 0,matrix\väri2,0
    Text matrix\posx,matrix\posy,matrix\kirjain$
    w.WANHA = New(WANHA)
    w\kirj$=Chr(Rand(255))
    w\väri=255
    w\x=matrix\posx
    w\y=matrix\posy-3
    matrix\spawn=False
    matrix\väri2-5
    matrix\posy+9
    matrix\kirjain$=Chr(Rand(255))
    If matrix\väri2<1 Then Delete matrix
    Next matrix

    For w.WANHA= Each WANHA
    Color 0,w\väri,0
    Text w\x,w\y,w\kirj$
    w\väri-5
    If w\väri<1 Then Delete w
    Next w

    DrawScreen

    Forever  

Wau, hienoa. Mutta eikös noiden pitäisi tulla aivan ylhäältä? näin olen itse käsittänyt...

[koodaaja]

Ainakin elokuvien efekti lähti muistaakseni juurikin tuolla tavalla ylälaidasta satunnaistaen. Ellei vähän alempaakin.