Efektit

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
User avatar
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Efektit

Post by Wingman » Mon Apr 04, 2011 7:35 am

MaGetzUb wrote:Melko hankala saada tuo 3D vaikutelma toimimaan. :/
Miksi muuten ruudut tuhotaan tuossa Draw3d funktiossa? :?
niinpä, itse tyhjentäisin ruudut piirtämällä ne täyteen mustaa.
- - - -

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

Re: Efektit

Post by MaGetzUb » Mon Apr 04, 2011 3:19 pm

Wingman wrote:
MaGetzUb wrote:Melko hankala saada tuo 3D vaikutelma toimimaan. :/
Miksi muuten ruudut tuhotaan tuossa Draw3d funktiossa? :?
niinpä, itse tyhjentäisin ruudut piirtämällä ne täyteen mustaa.
Tai sitten vain komentaa piirtopuskurin kuvaksi ja tyhjentää sen CLS-komennolla. ;)
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

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

Re: Efektit

Post by Misthema » Tue Apr 05, 2011 12:27 am

Jotain randomia. En jaksanut tehdä mitään FPS-riippumattomuuksia tms. Kunhan kikkailin. =)

Code: Select all

Const SW = 640
Const SH = 480

SCREEN SW,SH
FrameLimit 60

Type BALLS
    Field x#
    Field y#
    Field a#
    Field aStart#
    Field z#
    Field r
    Field g
    Field b
    Field ord
End Type

For i=1 To 18
    ball.BALLS=New(BALLS)
    ball\aStart=i*20
    ball\z=50.0
    ball\x=SW/2+Cos(ball\aStart)*ball\z
    ball\y=SH/2+Sin(ball\aStart)*ball\z
    ball\r=0
    ball\g=0
    ball\b=0
    ball\ord = i Mod 2
Next i

angle#=0.0
angleTimer=Timer()
Repeat

    
    angle=WrapAngle(angle+.5)
    
    For k=0 To 1
        For i=0 To 1
            For bal.BALLS = Each BALLS
                bal\a=((bal\aStart+angle)+(i*90)) Mod 360
                bal\z=128+Cos(bal\a*4)*(64+(63*i))
                If k=0 Then
                    bal\x=SW/2-Cos(bal\a+angle)*(bal\z/1.5)
                    bal\y=SH/2-Sin(bal\a+angle)*(bal\z/1.5)
                Else
                    bal\x=SW/2-Cos(bal\a+angle)*(bal\z/2.5)
                    bal\y=SH/2+Sin(bal\a+angle)*(bal\z/2.5)
                EndIf
                bal\r=bal\z*4
                Color bal\r,bal\g,bal\b
                Circle bal\x-(bal\z/16),bal\y-(bal\z/16),bal\z/8,i
            Next bal
        Next i
    Next k
    
    DrawScreen 1-KeyDown(cbKeySpace)
    
    SetWindow Str(FPS())
Forever
End

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

Re: Efektit

Post by MaGetzUb » Wed Apr 06, 2011 9:44 pm

Tämmööstä metapallo hässäkkää tälläkertaa:

Code: Select all


Const SCRW = 800
Const SCRH = 600
Const GW = 16
Const GH = 16
Dim m(2, 1)
SCREEN SCRW, SCRH

BoxesX = Int(SCRW/GW)
BoxesY = Int(SCRH/GH)
Dim Bright(BoxesX, BoxesY, 2) As Float

rad = 40 / GW
Repeat 

    a = a + 1
    m(0, 0) = SCRW/2 + Cos(a*Sin(a*1.5)*0.75) * SCRW/2.4
    m(0, 1) = SCRH/2 - Sin(a*Cos(a*1.5)*3) * SCRH/2.4
    
    m(1, 0) = SCRW/2 + Cos(120+a*Sin(a*1.5)*0.75) * SCRW/2.4
    m(1, 1) = SCRH/2 - Sin(120+a*Cos(a*1.5)*3) * SCRH/2.4
    
    m(2, 0) = SCRW/2 + Cos(240+a*Sin(a*1.5)*0.75) * SCRW/2.4
    m(2, 1) = SCRH/2 - Sin(240+a*Cos(a*1.5)*3) * SCRH/2.4
    
    For i = 0 To 2
        m(i, 0) = m(i, 0) / GW
        m(i, 1) = m(i, 1) / GH
    Next i
    
    For x = 0 To BoxesX
        For y = 0 To BoxesY
            If Slowdown Then 
                For i = 0 To 2
                    If Bright(x, y, i) Then Bright(x, y, i) = Bright(x, y, i) - Bright(x, y, i)*0.05
                Next i
            EndIf 
            For i = 0 To 2
                Bright(x, y, i) = Bright(x, y, i) + Float(rad)/((m(i, 0)-x)(m(i, 0)-x) + (m(i, 1)-y)(m(i, 1)-y))
                Bright(x, y, i) = Min(1, Bright(x, y, i))
            Next i

            Color Bright(x, y, 0)*255, Bright(x, y, 1)*255, Bright(x, y, 2)*255
            Box x*GW, y*GH, GW, GH
        Next y
    Next x
    
    If Timer() > slowtime + 2500 Then 
        slowdown = Not slowdown
        slowtime = Timer()
    EndIf 
    

DrawScreen
Forever  
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
TukeKoodi
Active Member
Posts: 142
Joined: Thu Feb 03, 2011 8:40 pm
Location: C:\Työpöytä

Re: Efektit

Post by TukeKoodi » Wed Apr 06, 2011 10:35 pm

MaGetzUb wrote:Tämmööstä metapallo hässäkkää tälläkertaa:

Code: Select all


Const SCRW = 800
Const SCRH = 600
Const GW = 16
Const GH = 16
Dim m(2, 1)
SCREEN SCRW, SCRH

BoxesX = Int(SCRW/GW)
BoxesY = Int(SCRH/GH)
Dim Bright(BoxesX, BoxesY, 2) As Float

rad = 40 / GW
Repeat 

    a = a + 1
    m(0, 0) = SCRW/2 + Cos(a*Sin(a*1.5)*0.75) * SCRW/2.4
    m(0, 1) = SCRH/2 - Sin(a*Cos(a*1.5)*3) * SCRH/2.4
    
    m(1, 0) = SCRW/2 + Cos(120+a*Sin(a*1.5)*0.75) * SCRW/2.4
    m(1, 1) = SCRH/2 - Sin(120+a*Cos(a*1.5)*3) * SCRH/2.4
    
    m(2, 0) = SCRW/2 + Cos(240+a*Sin(a*1.5)*0.75) * SCRW/2.4
    m(2, 1) = SCRH/2 - Sin(240+a*Cos(a*1.5)*3) * SCRH/2.4
    
    For i = 0 To 2
        m(i, 0) = m(i, 0) / GW
        m(i, 1) = m(i, 1) / GH
    Next i
    
    For x = 0 To BoxesX
        For y = 0 To BoxesY
            If Slowdown Then 
                For i = 0 To 2
                    If Bright(x, y, i) Then Bright(x, y, i) = Bright(x, y, i) - Bright(x, y, i)*0.05
                Next i
            EndIf 
            For i = 0 To 2
                Bright(x, y, i) = Bright(x, y, i) + Float(rad)/((m(i, 0)-x)(m(i, 0)-x) + (m(i, 1)-y)(m(i, 1)-y))
                Bright(x, y, i) = Min(1, Bright(x, y, i))
            Next i

            Color Bright(x, y, 0)*255, Bright(x, y, 1)*255, Bright(x, y, 2)*255
            Box x*GW, y*GH, GW, GH
        Next y
    Next x
    
    If Timer() > slowtime + 2500 Then 
        slowdown = Not slowdown
        slowtime = Timer()
    EndIf 
    

DrawScreen
Forever  
Tämähän on oikein hieno, joskin vähän hidas.
Aloittelija, koodaaja, jotain...
CbFUN :D

User avatar
TukeKoodi
Active Member
Posts: 142
Joined: Thu Feb 03, 2011 8:40 pm
Location: C:\Työpöytä

Re: Efektit

Post by TukeKoodi » Wed Apr 06, 2011 10:37 pm

Misthema wrote:Jotain randomia. En jaksanut tehdä mitään FPS-riippumattomuuksia tms. Kunhan kikkailin. =)

Code: Select all

Const SW = 640
Const SH = 480

SCREEN SW,SH
FrameLimit 60

Type BALLS
    Field x#
    Field y#
    Field a#
    Field aStart#
    Field z#
    Field r
    Field g
    Field b
    Field ord
End Type

For i=1 To 18
    ball.BALLS=New(BALLS)
    ball\aStart=i*20
    ball\z=50.0
    ball\x=SW/2+Cos(ball\aStart)*ball\z
    ball\y=SH/2+Sin(ball\aStart)*ball\z
    ball\r=0
    ball\g=0
    ball\b=0
    ball\ord = i Mod 2
Next i

angle#=0.0
angleTimer=Timer()
Repeat

    
    angle=WrapAngle(angle+.5)
    
    For k=0 To 1
        For i=0 To 1
            For bal.BALLS = Each BALLS
                bal\a=((bal\aStart+angle)+(i*90)) Mod 360
                bal\z=128+Cos(bal\a*4)*(64+(63*i))
                If k=0 Then
                    bal\x=SW/2-Cos(bal\a+angle)*(bal\z/1.5)
                    bal\y=SH/2-Sin(bal\a+angle)*(bal\z/1.5)
                Else
                    bal\x=SW/2-Cos(bal\a+angle)*(bal\z/2.5)
                    bal\y=SH/2+Sin(bal\a+angle)*(bal\z/2.5)
                EndIf
                bal\r=bal\z*4
                Color bal\r,bal\g,bal\b
                Circle bal\x-(bal\z/16),bal\y-(bal\z/16),bal\z/8,i
            Next bal
        Next i
    Next k
    
    DrawScreen 1-KeyDown(cbKeySpace)
    
    SetWindow Str(FPS())
Forever
End
Tosi siisti efekti. FPS ei kylläkään ollut kuin 27 - 31.
EDIT:

Woohoo! Member -> Active Member :D

Aloittelija, koodaaja, jotain...
CbFUN :D

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

Re: Efektit

Post by MaGetzUb » Wed Apr 06, 2011 10:50 pm

TukeKoodi wrote:
Misthema wrote:Jotain randomia. En jaksanut tehdä mitään FPS-riippumattomuuksia tms. Kunhan kikkailin. =)

Code: Select all

koodia
Tosi siisti efekti. FPS ei kylläkään ollut kuin 27 - 31.
EDIT:

Woohoo! Member -> Active Member :D

Joo tuota jos se liikkuisi hitaammin se näyttäisi paremmalta, mutta minkäs teet yyber liikuttelu koodinpätkä by me. ;)
Btw, aika kyseenalainen tuo Active Member huudahdus kun teit tuplapostina. :D
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

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

Re: Efektit

Post by Latexi95 » Fri Apr 08, 2011 8:52 pm

Tein Bézierin käyrän piirtofunktion.

Code: Select all

Global Accuracy
Accuracy = 30.0

Function DrawBezierCurve4(x1#,y1#,x2#,y2#,x3#,y3#,x4#,y4#)  
    t# = 1/Accuracy
    lastX# = x1#
    lastY# = y1#
    
    For i# = 1 To Accuracy-1
        t# = i / Accuracy
        x# = (1.0-t)^3*x1+3.0*(1.0-t)^2*t*x2+3.0*(1.0-t)*t^2*x3+t^3*x4
        y# = (1.0-t)^3*y1+3.0*(1.0-t)^2*t*y2+3.0*(1.0-t)*t^2*y3+t^3*y4
        Line lastX#,lastY#,x#,y#
        lastX# = x
        lastY# = y
    Next i#
    Line lastX#,lastY#,x4#,y4#
EndFunction

Function DrawBezierCurve3(x1#,y1#,x2#,y2#,x3#,y3#)  
    t# = 1/Accuracy
    lastX# = x1#
    lastY# = y1#
    
    For i# = 1 To Accuracy-1
        t# = i / Accuracy
        x# = (1.0-t)^2*x1#+2.0*(1.0-t)*t*x2+t^2*x3
        y# = (1.0-t)^2*y1#+2.0*(1.0-t)*t*y2+t^2*y3
        Line lastX#,lastY#,x#,y#
        lastX# = x
        lastY# = y
    Next i#
    Line lastX#,lastY#,x3#,y3#
EndFunction
SCREEN 800,600
x# = 200
y# = 150
ang# = 0
l# = 10
Repeat
    Text 10,10,"FPS:"+FPS()
    Text 10,20,"Lines per curve:"+Accuracy
    If KeyDown(cbKeyA) Then ang# = ang# + 0.4
    If KeyDown(cbKeyD) Then ang# = ang# - 0.4
    If KeyDown(cbKeyW) Then l# + 0.4
    If KeyDown(cbKeyS) Then l# - 0.4
    Accuracy = Max(3,Accuracy+(KeyDown(cbKeyQ)-KeyDown(cbKeyE)))
    If UpKey() Then y# - 0.3
    If DownKey() Then y# + 0.3
    If LeftKey() Then x# - 0.3
    If RightKey() Then x# + 0.3
    px1# = x#-Cos(ang)*l
    py1# = y#-Sin(ang)*l
    px2# = x + Cos(ang)*l
    py2# = y + Sin(ang)*l
    DrawBezierCurve3(0,100,px1#,py1#,x#,y#)
    DrawBezierCurve3(x#,y#,px2#,py2#,800,500)
    Line px1,py1,px2,py2
DrawScreen
Forever
Tein sekä 3:lle pisteelle, että 4 pisteelle.
Viiva piirretään funktioille annetujen pisteiden välille siten, että se kulkee ensimmäisen ja viimeisen pisteen kautta ja taipuu kohti muita pisteitä. DrawBezierCurve3 siis piirtää viivan (x1,y1):stä (x3,y3):een taivuttaen sitä (x2,y2):sta kohti ja DrawBezierCurve4 piirtää viivan (x1,y1):stä (x4,y4):een taivuttaen sitä (x2,y2):sta ja (x3,y3):sta kohti. Katsokaa esimerkki koodia, niin näette sen toimivan käytännössä.

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 » Fri Apr 08, 2011 9:01 pm

N:lle pisteelle toimiva olisi toki miellyttävämpi ratkaisu, eli esimerkiksi typestä haettaisiin pisteet ja piirrettäisiin niiden perusteella. Muistelen joskus toteuttaneenikin sellaisen CB:llä, eli ei pitäisi mahdotonta olla :)

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

Re: Efektit

Post by Latexi95 » Fri Apr 08, 2011 9:08 pm

koodaaja wrote:N:lle pisteelle toimiva olisi toki miellyttävämpi ratkaisu, eli esimerkiksi typestä haettaisiin pisteet ja piirrettäisiin niiden perusteella. Muistelen joskus toteuttaneenikin sellaisen CB:llä, eli ei pitäisi mahdotonta olla :)
Typeistä hakeminen == ei hyvä
Mutta voinhan koittaa nopeasti sellaisenkin väsätä... :lol:

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 » Fri Apr 08, 2011 9:25 pm

Kas, olen pastennut sen näköjään tännekin, löytyy sivulta 14. Mutta mitä ehdottaisit typejen sijaan? Taulukot, memblockit ja merkkijonot menevät kaikki turhan säätämisen puolelle.

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

Re: Efektit

Post by Latexi95 » Fri Apr 08, 2011 10:25 pm

koodaaja wrote:Kas, olen pastennut sen näköjään tännekin, löytyy sivulta 14. Mutta mitä ehdottaisit typejen sijaan? Taulukot, memblockit ja merkkijonot menevät kaikki turhan säätämisen puolelle.
Minä pidin ajatuksesta, että ne tallennettasiin muistipaloihin, joten tein siitäkin koodin pätkän. Käytin muuten vähän koodia sinun versiostasi. :D

Code: Select all

Global Accuracy
Accuracy = 10

Function MakeBezier(x#,y#)
    mem = MakeMEMBlock(8)
    PokeFloat mem,0,x
    PokeFloat mem,4,y
    Return mem
EndFunction

Function AddPoint(mem,x#,y#)
    s = MEMBlockSize(mem)
    ResizeMEMBlock mem,s+8
    PokeFloat mem,s,x#
    PokeFloat mem,s+4,y#
EndFunction

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

Function DrawBezierCurveN(mem)
    lastX# = PeekFloat(mem,0)
    lastY# = PeekFloat(mem,4)
    points = MEMBlockSize(mem)/8-1
    pointC = Accuracy*points-1
    For i = 1 To pointC
        x# = 0
        y# = 0
        t# = Float(i)/Float(pointC)
        For i2 = 0 To points
            B# = nCr(points, i2)*(t#^i2)*((1.0-t#)^(points-i2))
            x# = x# + B#*PeekFloat(mem,i2*8)
            y# = y# + B#*PeekFloat(mem,i2*8+4)
        Next i2
        Line lastX#,lastY#,x#,y#
        lastX# = x#
        lastY# = y#
    Next i
    Line lastX#,lastY#,PeekFloat(mem,points*8),PeekFloat(mem,points*8+4)
EndFunction

bezier = MakeBezier(200,150)

Repeat

    If MouseHit(1) Then AddPoint(bezier,MouseX(),MouseY())
    size = MEMBlockSize(bezier)
    If MouseHit(2) And size > 8 Then
        ResizeMEMBlock bezier,size-8
        size - 8
    EndIf
    For i = 0 To size/8-1
        Circle PeekFloat(bezier,i*8)-3,PeekFloat(bezier,i*8+4)-3,6,0
    Next i
    DrawBezierCurveN(bezier)
    DrawScreen
Forever
Lisäksi tämä on funktiona, joten se on helpommin hyödynnettävissä.

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 Apr 11, 2011 12:05 am

Löinpä sitten KilledWhale:n ASCII-metapallot ja Ruuttu:n Fluidize() -funkkarin yhteen. Tuli ihan kivan näkönen ehvekti:

Code: Select all

// Ascii metaballs made with CoolBasic

SCREEN 400, 400
	
sw = ScreenWidth()
sh = ScreenHeight()

Const Grid = 8
Global Fluidize_img
	
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

    angle# = WrapAngle(angle# + 5)

	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 n * 255, 0, n * 255
			Text x * 10, y * 10, "@"
		Next y
	Next x
	
	SetWindow "Ascii meatballs w/ Fluidize() | " + FPS()
    Fluidize(angle,2,1)
	DrawScreen OFF
Forever


Function Fluidize(ang#,amp#,id)
    sw = ScreenWidth()
    sh = ScreenHeight()
    halfsw = sw / 2
    halfsh = sh / 2
    randscale = amp/3

	If Fluidize_img = 0 Then
		Fluidize_img = MakeImage(ScreenWidth(),ScreenHeight())
	EndIf
    
    For Y = 1 To sh Step Grid
        For X = 1 To sw Step Grid

            Select id
                Case 1
                    targetx = x + Cos(x+ang)*amp + Rand(-randscale,randscale)
                    targety = y - Sin(y+ang)*amp + Rand(-randscale,randscale)
                Case 2
                    targetx = x + Cos(x+ang)*amp
                    targety = y
                Default
                    targetx = x + Cos(y+ang)*amp
                    targety = y + Cos(x+ang)*amp
            End Select
            
            CopyBox x,y,grid,grid,targetx,targety,SCREEN(),Image(Fluidize_img)
        
        Next X
    Next Y

	DrawImage Fluidize_img,0,0 
EndFunction

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

Re: Efektit

Post by Latexi95 » Mon Apr 11, 2011 4:00 pm

Misthema wrote:Löinpä sitten KilledWhale:n ASCII-metapallot ja Ruuttu:n Fluidize() -funkkarin yhteen. Tuli ihan kivan näkönen ehvekti:

Code: Select all

// Ascii metaballs made with CoolBasic

SCREEN 400, 400
	
sw = ScreenWidth()
sh = ScreenHeight()

Const Grid = 8
Global Fluidize_img
	
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

    angle# = WrapAngle(angle# + 5)

	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 n * 255, 0, n * 255
			Text x * 10, y * 10, "@"
		Next y
	Next x
	
	SetWindow "Ascii meatballs w/ Fluidize() | " + FPS()
    Fluidize(angle,2,1)
	DrawScreen OFF
Forever


Function Fluidize(ang#,amp#,id)
    sw = ScreenWidth()
    sh = ScreenHeight()
    halfsw = sw / 2
    halfsh = sh / 2
    randscale = amp/3

	If Fluidize_img = 0 Then
		Fluidize_img = MakeImage(ScreenWidth(),ScreenHeight())
	EndIf
    
    For Y = 1 To sh Step Grid
        For X = 1 To sw Step Grid

            Select id
                Case 1
                    targetx = x + Cos(x+ang)*amp + Rand(-randscale,randscale)
                    targety = y - Sin(y+ang)*amp + Rand(-randscale,randscale)
                Case 2
                    targetx = x + Cos(x+ang)*amp
                    targety = y
                Default
                    targetx = x + Cos(y+ang)*amp
                    targety = y + Cos(x+ang)*amp
            End Select
            
            CopyBox x,y,grid,grid,targetx,targety,SCREEN(),Image(Fluidize_img)
        
        Next X
    Next Y

	DrawImage Fluidize_img,0,0 
EndFunction
Hieno efekti vaikkakin ihailua hieman häiritsi se, että FPS oli 3... :D

User avatar
Viltzu
Guru
Posts: 1132
Joined: Sun Aug 26, 2007 5:45 pm
Location: Alavieska
Contact:

Re: Efektit

Post by Viltzu » Mon Apr 11, 2011 4:15 pm

Misthema wrote:Löinpä sitten KilledWhale:n ASCII-metapallot ja Ruuttu:n Fluidize() -funkkarin yhteen. Tuli ihan kivan näkönen ehvekti:

Code: Select all

// Ascii metaballs made with CoolBasic

SCREEN 400, 400
	
sw = ScreenWidth()
sh = ScreenHeight()

Const Grid = 8
Global Fluidize_img
	
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

    angle# = WrapAngle(angle# + 5)

	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 n * 255, 0, n * 255
			Text x * 10, y * 10, "@"
		Next y
	Next x
	
	SetWindow "Ascii meatballs w/ Fluidize() | " + FPS()
    Fluidize(angle,2,1)
	DrawScreen OFF
Forever


Function Fluidize(ang#,amp#,id)
    sw = ScreenWidth()
    sh = ScreenHeight()
    halfsw = sw / 2
    halfsh = sh / 2
    randscale = amp/3

	If Fluidize_img = 0 Then
		Fluidize_img = MakeImage(ScreenWidth(),ScreenHeight())
	EndIf
    
    For Y = 1 To sh Step Grid
        For X = 1 To sw Step Grid

            Select id
                Case 1
                    targetx = x + Cos(x+ang)*amp + Rand(-randscale,randscale)
                    targety = y - Sin(y+ang)*amp + Rand(-randscale,randscale)
                Case 2
                    targetx = x + Cos(x+ang)*amp
                    targety = y
                Default
                    targetx = x + Cos(y+ang)*amp
                    targety = y + Cos(x+ang)*amp
            End Select
            
            CopyBox x,y,grid,grid,targetx,targety,SCREEN(),Image(Fluidize_img)
        
        Next X
    Next Y

	DrawImage Fluidize_img,0,0 
EndFunction
Tämä oli kyllä niin mahtava. Hieman pienimmillä pisteillä oli kans jännän näköistä (Text x * 10, y * 10, "@" -> Box x*10, y*10, 3, 3 ja sellasta)
FPS oli siinä 20.

User avatar
Kille
Active Member
Posts: 249
Joined: Wed Aug 26, 2009 3:50 pm
Location: Juankoski

Re: Efektit

Post by Kille » Mon Apr 11, 2011 4:43 pm

Misthema wrote:Löinpä sitten KilledWhale:n ASCII-metapallot ja Ruuttu:n Fluidize() -funkkarin yhteen. Tuli ihan kivan näkönen ehvekti:

Code: Select all

// Ascii metaballs made with CoolBasic

SCREEN 400, 400
	
sw = ScreenWidth()
sh = ScreenHeight()

Const Grid = 8
Global Fluidize_img
	
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

    angle# = WrapAngle(angle# + 5)

	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 n * 255, 0, n * 255
			Text x * 10, y * 10, "@"
		Next y
	Next x
	
	SetWindow "Ascii meatballs w/ Fluidize() | " + FPS()
    Fluidize(angle,2,1)
	DrawScreen OFF
Forever


Function Fluidize(ang#,amp#,id)
    sw = ScreenWidth()
    sh = ScreenHeight()
    halfsw = sw / 2
    halfsh = sh / 2
    randscale = amp/3

	If Fluidize_img = 0 Then
		Fluidize_img = MakeImage(ScreenWidth(),ScreenHeight())
	EndIf
    
    For Y = 1 To sh Step Grid
        For X = 1 To sw Step Grid

            Select id
                Case 1
                    targetx = x + Cos(x+ang)*amp + Rand(-randscale,randscale)
                    targety = y - Sin(y+ang)*amp + Rand(-randscale,randscale)
                Case 2
                    targetx = x + Cos(x+ang)*amp
                    targety = y
                Default
                    targetx = x + Cos(y+ang)*amp
                    targety = y + Cos(x+ang)*amp
            End Select
            
            CopyBox x,y,grid,grid,targetx,targety,SCREEN(),Image(Fluidize_img)
        
        Next X
    Next Y

	DrawImage Fluidize_img,0,0 
EndFunction
Waau miten nätti. FPS tasasesti 31.
ZEPPELIN
Jatkoa tulossa... tällä kertaa lataus ei kestä viikkoa

User avatar
Ruuttu
Devoted Member
Posts: 687
Joined: Thu Aug 30, 2007 5:11 pm
Location: Finland, Sipoo

Re: Efektit

Post by Ruuttu » Mon Apr 11, 2011 6:40 pm

Makee on. Mulla ihan sama FPS, 31, ja hassusti tuntuu pyörivän siinä 31:n kohdalla vaikka esimerkiksi pienentäisi resoluutiota tai muuttaisi metapallojen määrän kolmesta yhteen. Mystistä.

User avatar
TukeKoodi
Active Member
Posts: 142
Joined: Thu Feb 03, 2011 8:40 pm
Location: C:\Työpöytä

Re: Efektit

Post by TukeKoodi » Mon Apr 11, 2011 9:46 pm

Mul oli FPS tasaisesti 4-5.
Aloittelija, koodaaja, jotain...
CbFUN :D

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

Re: Efektit

Post by Latexi95 » Mon Apr 11, 2011 10:07 pm

Hassua muuten, että FPS oli minulla 3. Prosessorin yhdenkään ytimen käyttö ei ollut 70% enempää missään vaiheessa ja näytönohjaimen käyttö oli kokoajan 0%. Enkä oikein usko tuon ohjelman niin paljon kirjoittavan jatkuvasti muistiin, että RAM jarruttaisi. Mikäköhän on tulppana...

Awaclus
Forum Veteran
Posts: 2939
Joined: Tue Aug 28, 2007 2:50 pm

Re: Efektit

Post by Awaclus » Mon Apr 11, 2011 10:53 pm

Minulla oli FPS epätasaisesti 0-2 (jos se vaihtelee ääretön prosenttia, niin silloin ei voida kai puhua kovin tasaisesta, vaikka se onkin vain kahden kokonaisluvun ero?)

Post Reply