## Efektit

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Valtzu
Active Member
Posts: 115
Joined: Sun Aug 26, 2007 2:40 pm
Location: Sauvo
Contact:

### Re: Efektit

Syksyn pimeyteen hidas ilotulitus-efekti, klikkaamalla räjähdys

Code: Select all

``````Const SW = 800
Const SH = 600

Const MAX_PARTS_PER_EXPLOSION = 300

SCREEN SW,SH,0,0

Type raketti
Field x#
Field y#
Field sx#
Field sy#
Field r#
Field g#
Field b#
Field gs#
Field m
Field id As Integer
End Type

Type explosion
Field count As Short
End Type

Const GRAVITY = 0.02

PositionMouse SW/2,SH/2

Repeat
PutPixel MouseX(),MouseY(),16777215
If MouseHit(1) Then MakeExplosion()
UpdateAll()
Color 255,255,255
Text 0,0,FPS()
DrawScreen
Forever

Function UpdateAll()
Lock
For iR.raketti = Each raketti

tmp.explosion = ConvertToType(iR\id)

iR\x = iR\x + iR\sx
iR\y = iR\y + iR\sy+iR\gs

iR\gs=iR\gs+GRAVITY*(1.0-0.2*(iR\m=0))

iR\sx = iR\sx + (Abs(iR\sx)>=0.4) * -Sgn(iR\sx) * (0.3+0.1*(iR\m=0))
iR\sx = iR\sx + (Abs(iR\sx)<0.4) * -Sgn(iR\sx) * 0.001
iR\sy = iR\sy + (Abs(iR\sy)>=0.4) * -Sgn(iR\sy) * (0.3+0.1*(iR\m=0))
iR\sy = iR\sy + (Abs(iR\sy)<0.4) * -Sgn(iR\sy) * 0.001

If iR\m = 0 Then PutPixel iR\x,iR\y,Int(iR\r Shl 16 +iR\g Shl 8+iR\b)

If tmp\count<MAX_PARTS_PER_EXPLOSION And Rand(10)=0 And (iR\r>150 Or iR\g>150 Or iR\b>150) Then
PoE(iR\id,iR\x,iR\y,0,0,Max(0,iR\r-30),Max(0,iR\g-30),Max(0,iR\b-30),0,Rnd(0,0.5))
tmp\count = tmp\count + 1
EndIf

iR\r=Max(0,iR\r-1)
iR\g=Max(0,iR\g-1)
iR\b=Max(0,iR\b-1)

If iR\y > SH Or (iR\r<20 And iR\g<20 And iR\b<20) Then
Delete iR
tmp\count = tmp\count - 1
EndIf
Next iR
Unlock
For iR.raketti = Each raketti
If iR\m = 1 Then
Color iR\r,iR\g,iR\b
Line iR\x,iR\y,iR\x-iR\sx/2,iR\y-iR\sY/2
Color Max(0,iR\r-70),Max(0,iR\g-70),Max(0,iR\b-70)
Line iR\x-iR\sx/2,iR\y-iR\sY/2,iR\x-iR\sx,iR\y-iR\sY
EndIf
Next iR
Color cbwhite
If tmp<>NULL Then Text 0,15,tmp\count
End Function

Function Sgn(luku#)
Return (luku>0)-(luku<0)
End Function

Function MakeExplosion()
n.explosion=New(explosion)
mx#=MouseX()
my#=MouseY()
c=20
fact#=360.0/c
For a = 0 To c-1
r=Rand(220,255)
g=Rand(0,200)
b=Rand(200,240)
PoE(ConvertToInteger(n),mx,my,Cos((a+Rnd(-1,1)) * fact) * 8.0,Sin((a+Rnd(-1,1)) * fact) * 8.0,r,g,b,1)
Next a
End Function

Function PoE(_id As Integer,x#,y#,sx#,sy#,r,g,b,m,gs#=0)
tmp.explosion=ConvertToType(_id)
If tmp\count>MAX_PARTS_PER_EXPLOSION Then Return False
tmp\count = tmp\count + 1
n.raketti = New(raketti)
n\x=x
n\y=y
n\sx=sx
n\sy=sy
n\r=r
n\g=g
n\b=b
n\m=m
n\gs=gs
n\id=_id
Return ConvertToInteger(n)
End Function
``````

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

### Re: Efektit

Tuo on hieno. Pistäppä vähä eri väreillä. Nii ja sit jotenki tuntuu et ku klikkaa kaks kertaa päällekkäi nii ne pikselit tulee justii samoihi paikkoihi.

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

### Re: Efektit

programmer of DSG wrote:Tuo on hieno. Pistäppä vähä eri väreillä. Nii ja sit jotenki tuntuu et ku klikkaa kaks kertaa päällekkäi nii ne pikselit tulee justii samoihi paikkoihi.
Tässäpä optimoitu ja eri väreillä oleva versio. Värit vaihtuvat 1-5 numeronäppäimillä.

Code: Select all

``````Const SW = 800
Const SH = 600
Const GRAVITY = 0.02

Const MAX_PARTS_PER_EXPLOSION = 300

SCREEN SW,SH,0,0

Type raketti
Field x#
Field y#
Field sx#
Field sy#
Field r#
Field g#
Field b#
Field gs#
Field m
Field id As Integer
End Type

Type explosion
Field count As Short
End Type

Dim COLORS(9,5) As Byte,sg(2) As Float

//      key  R    R    G    G    B    B
SetColor(1, 220, 255, 0,   200, 200, 240)
SetColor(2, 225, 255, 50,  150, 0,   50)
SetColor(3, 245, 255, 245, 255, 245, 255)
SetColor(4, 120, 200, 120, 200, 245, 255)
SetColor(5, 120, 180, 220, 255, 120, 180)

Global currentColor As Byte
currentColor = 1

PositionMouse SW/2,SH/2

Repeat
PutPixel MouseX(),MouseY(),16777215
If MouseHit(1) Then MakeExplosion()
UpdateAll()
Color 255,255,255
Text 0,0,FPS()
If Timer()>t Then
ScreenGamma Int(sg(0)),Int(sg(1)),Int(sg(2))
t=Timer()+20
sg(0) = CurveValue(0.0,sg(0),10.0)
sg(1) = CurveValue(0.0,sg(1),10.0)
sg(2) = CurveValue(0.0,sg(2),10.0)
EndIf
DrawScreen
Forever

Function SetColor(id,r1,r2,g1,g2,b1,b2)
COLORS(id,0)=r1:COLORS(id,1)=r2
COLORS(id,2)=g1:COLORS(id,3)=g2
COLORS(id,4)=b1:COLORS(id,5)=b2
End Function

Function UpdateAll()
For i=0 To 9
If KeyHit(2+i) Then currentColor = (i + 1)-(i=9)*10
Next i
cc=0
Lock
For iR.raketti = Each raketti

tmp.explosion = ConvertToType(iR\id)

If iR\m = 0 And iR\y>=0 Then PutPixel2 iR\x,iR\y,Int(iR\r Shl 16 +iR\g Shl 8+iR\b)

iR\x = iR\x + iR\sx
iR\y = iR\y + iR\sy+iR\gs

iR\gs=iR\gs+GRAVITY
m#=(3+(iR\m=0))/10.0

If iR\sx>0 Then
If iR\sx>0.4 Then iR\sx = iR\sx - m Else iR\sx = iR\sx - 0.001
ElseIf iR\sx<0 Then
If iR\sx<-0.4 Then iR\sx = iR\sx + m Else iR\sx = iR\sx + 0.001
EndIf

If iR\sy>0 Then
If iR\sy>0.4 Then iR\sy = iR\sy - m Else iR\sy = iR\sy - 0.001
ElseIf iR\sy<0 Then
If iR\sy<-0.4 Then iR\sy = iR\sy + m Else iR\sy = iR\sy + 0.001
EndIf

If tmp\count<MAX_PARTS_PER_EXPLOSION And Rand(10)=0 And (iR\r>150 Or iR\g>150 Or iR\b>150) Then
PoE(iR\id,iR\x,iR\y,0,0,Max(0,iR\r-30),Max(0,iR\g-30),Max(0,iR\b-30),0,Rnd(0,0.5))
tmp\count = tmp\count + 1
EndIf

iR\r=Max(0,iR\r-1)
iR\g=Max(0,iR\g-1)
iR\b=Max(0,iR\b-1)

If iR\y > SH-1 Or (iR\r<20 And iR\g<20 And iR\b<20) Or iR\x<0 Or iR\x>SW-1 Then
Delete iR
tmp\count = tmp\count - 1
EndIf
cc+1
Next iR
Unlock
For iR.raketti = Each raketti
If iR\m = 1 Then
Color iR\r,iR\g,iR\b
Line iR\x,iR\y,iR\x-iR\sx/2,iR\y-iR\sY/2
Color Max(0,iR\r-70),Max(0,iR\g-70),Max(0,iR\b-70)
Line iR\x-iR\sx/2,iR\y-iR\sY/2,iR\x-iR\sx,iR\y-iR\sY
EndIf
Next iR
Color cbwhite
Text 0,15,cc
End Function

Function MakeExplosion()
n.explosion=New(explosion)
mx#=MouseX()
my#=MouseY()
c=20
fact#=360.0/c
a_plus# = Rnd(0,359)
f2#=Rnd(7.5,8.0)
For a = 0 To c-1
r=Rand(COLORS(currentColor,0),COLORS(currentColor,1))
g=Rand(COLORS(currentColor,2),COLORS(currentColor,3))
b=Rand(COLORS(currentColor,4),COLORS(currentColor,5))
f#=f2+Rnd(0.0,0.5)
PoE(ConvertToInteger(n),mx,my,Cos((a+a_plus+Rnd(-1,1)) * fact) * f,Sin((a+a_plus+Rnd(-1,1)) * fact) * f,r,g,b,1)
Next a
sg(0)=r/4
sg(1)=g/4
sg(2)=b/4
ScreenGamma Int(sg(0)),Int(sg(1)),Int(sg(2))
End Function

Function PoE(_id As Integer,x#,y#,sx#,sy#,r,g,b,m,gs#=0)
tmp.explosion=ConvertToType(_id)
If tmp\count>MAX_PARTS_PER_EXPLOSION Then Return False
tmp\count = tmp\count + 1
n.raketti = New(raketti)
n\x=x
n\y=y
n\sx=sx
n\sy=sy
n\r=r
n\g=g
n\b=b
n\m=m
n\gs=gs
n\id=_id
Return ConvertToInteger(n)
End Function
``````

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

### Re: Efektit

Tuon screengamman käyttö hidastaa efektiä melkoisesti. Eikö esim. taustavärin muuttaminen ajaisi melkein saman asian (ilman hidastumista) ? Muuten erittäin nätti efekti.

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

### Re: Efektit

Ruuttu wrote:Tuon screengamman käyttö hidastaa efektiä melkoisesti. Eikö esim. taustavärin muuttaminen ajaisi melkein saman asian (ilman hidastumista) ? Muuten erittäin nätti efekti.
Tämä on ilmeisesti konekohtaista, koska itse en ainakaan havainnut hidastumisia.

MAVmaggot
Advanced Member
Posts: 468
Joined: Fri Aug 31, 2007 10:18 pm
Location: bitspace

### Re: Efektit

Itselläni toimi ainakin ihan suht-hyvällä fps:llä Ihan luonnollistahan se on, että miljuunasta dotista näytöllä fps vähän tippuu. Ja erittäin hieno ja tyylikäs efekti tack.

Someday coder
Active Member
Posts: 106
Joined: Wed Jul 30, 2008 5:04 pm

### Re: Efektit

Tässä tylsyyksissäni väsäsin tälläisen efektin, jossa eriväriset kirjaimet putoavat ja haihtuvat
kommentointi niukkaa ja voi olla melko purkkaa..

Code: Select all

``````//luodaan taulukot
Dim x(250) As Float
Dim y(250) As Float
Dim k(250) As String
Dim p(250) As Float
Dim v(250)
Dim r(250) As Float
Dim g(250) As Float
Dim b(250) As Float

//alku settingsit
For i=1 To 250

k(i)=Chr(Rand(1,26)+64)
p(i)=Rnd(0.1,0.25)
y(i)=339
r(i)=Rand(1,255)
g(i)=Rand(1,255)
b(i)=Rand(1,255)

Next i
nm=1

ShowMouse OFF

Repeat

SetWindow "fps: "+FPS()+", letters: "+m+""

Color 255,255,255

//väri säädöt
For i=1 To nm

y(i)=y(i)+p(i)*10

r(i)=r(i)-2
g(i)=g(i)-2
b(i)=b(i)-2

If r(i) <= 0 Then r(i) = 0
If g(i) <= 0 Then g(i) = 0
If b(i) <= 0 Then b(i) = 0

If r(i) <= 20 And g(i) <= 20 And b(i) <= 20 Then
r(i)=0
g(i)=0
b(i)=0
y(i)=400
m=m-1
EndIf

//piirretään ja lasketaan monta kirjainta

If y(i) < 300 Then
Color r(i),g(i),b(i)
Text x(i),y(i),""+k(i)+""
mm=mm+1
EndIf

Next i

m=mm
mm=0

If nm >= 249 Then nm=249

// tehdään kolme kirjainta:
For c=1 To 3

For i=1 To nm
If y(i) > 300 Then
nm=nm+1
r(i)=Rand(1,255)
g(i)=Rand(1,255)
b(i)=Rand(1,255)
x(i)=Rand(1,400)
y(i)=-10
Goto A
EndIf
Next i
A:

Next c

DrawScreen
Forever

``````

Ris
Active Member
Posts: 142
Joined: Wed Jul 02, 2008 8:27 pm

### Re: Efektit

Tein huvikseni tälläisen järjettömän efektin + rand testin.

Code: Select all

``````//Järjetön efekti ja samalla rand testi.
//Tehnyt Ris. Erittäin yksinkertainen koodi, eikö?

Const RuutuX = 400
Const RuutuY = 400

Const Dots1X = 1
Const Dots2X = 1
Const Dot1Y = 400
Const Dot2Y = 400
Const DotMäärä = 1000
Const Box1X = 1
Const Box2X = 1
Const Box1Y = 400
Const Box2Y = 400
Const Xkoko = 5
Const Ykoko = 5
Const Boxkiinteä = 1

SCREEN RuutuX,RuutuY
FrameLimit 60

sys=LoadFont("Lucida Console",11)
SetFont sys

Repeat

o+1 'Joka loopin alussa nostetaan muuttujan o arvoa yhdellä.

If o=30 Then  'Jos muuttuja m on 30, niin
ClearText 'poistetaan tekstit,
Cls       'tyhjennetään ruutu ja
o=0       'nollataan muuttuja o
EndIf

Randomize Timer() 'Alustetaan siemenluku ajan mukaan.

'Näillä 3 funktiolla sitten arvotaan dotit, boxit,linet, määrät ja niitten värit.
'Dotin määrä on tietenkin asetettu vakioon.

DrawDotsRand(Dots1X,Dot1Y,Dots2X,Dot2Y,Rand(0,255),Rand(0,255),Rand(0,255),DotMäärä)

DrawBoxsRand(Box1X,Box1Y,Box2X,Box2Y,Xkoko,Ykoko,Boxkiinteä,Rand(0,255),Rand(0,255),Rand(0,255),Rand(5,15))

DrawLinesRand(Rand(10,30),Rand(0,255),Rand(0,255),Rand(0,255),Rand(10,RuutuY),Rand(Timer(),RuutuY),Rand(-60,RuutuY),Rand(-100,RuutuY))

Color Rand(0,255),Rand(0,255),Rand(0,255) 'Tätä coloria ei tässä välttämättä tarvitse

Locate Rand(1,RuutuY),Rand(1,RuutuY) 'Arvotaan tekstien paikka.

AddText Rand(0,1)+" T "+ Rand(FPS(),100)
AddText Rand(0,2)+" e "+ Rand(FPS(),100)
AddText Rand(0,3)+" s "+ Rand(FPS(),100)
AddText Rand(0,4)+" t "+ Rand(FPS(),100)
AddText Rand(0,5)+" i "+ Rand(FPS(),100)

DrawScreen OFF

Forever

Function DrawDotsRand(x,y,xx,yy,r,g,b,määrä)
For i = 0 To määrä
Color r,g,b
Dot Rand(x,y),Rand(xx,yy)
Next i
End Function

Function DrawBoxsRand(x,y,xx,yy,kokoX,kokoY,kiinteä,r,g,b,määrä)
For i = 0 To määrä
Color r,g,b
Box Rand(x,y),Rand(xx,yy),kokoX,kokoY,kiinteä
Next i
End Function

Function DrawLinesRand(määrä,r,g,b,x1,y2,x4,y4)
For i = 0 To määrä
Color r,g,b
Line x1,y2,x4,y4
Next i
End Function ``````

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

### Re: Efektit

Tein tällaisen "Über hianon" Cos ja SIn kikkailun..

Code: Select all

``````Repeat

For angle = 0 To 360
Dot 200+Cos(xdist+angle)*50+Cos(angle)*Cos(xdist)*50,150-Sin(ydist+angle)*50-Sin(angle)*Sin(ydist)*50

Next angle

For i = 0 To 90 Step 2
Line 200+Cos(xdist+i)*-50+Cos(xdist+i)*Cos(xdist+i)*-50,150-Sin(ydist+i)*-50-Sin(ydist+i)*Sin(ydist+i)*-50,200+Cos(xdist+i)*50+Cos(xdist+i)*Cos(xdist+i)*50,150-Sin(ydist+i)*50-Sin(ydist+i)*Sin(ydist+i)*50
Next i

xdist = WrapAngle(xdist+1)
ydist = WrapAngle(ydist-1)

If Timer() > h + 500 Then
d = 1
h = Timer()

Else
d=0
EndIf
DrawScreen d
Forever ``````
Solar Eclipse
We're in a simulation, and God is trying to debug us.

JATothrim
Tech Developer
Posts: 606
Joined: Tue Aug 28, 2007 6:46 pm
Location: Kuopio

### Re: Efektit

Vaviskaa, te kurjat. Koodasin kuvan venytysfunktion mikä ei ole ihan siitä tavallisesta päästä. Systeemi toimii _lähes_ reaali aikaisesti pienillä/kuvilla venytyksillä, mutta alkaa sitten hidastua kuvakoon suuretessa. Funktio aikas lyhyt, joten kommentteja ei ole. Niin ja, tämä "venyttää" eikä "skaalaa"

Code: Select all

``````Global gScaled_Image
Const SCALE_BLOCK_SIZE = 1
Function ScaleImage(img%, botom_w#, right_s#)

imgW% = ImageWidth(img)
imgH% = ImageHeight(img)

new_width% = max(imgW, botom_w)
new_height% = max(imgH, right_s)

If gScaled_Image = 0
gScaled_Image = MakeImage(new_width, new_height)
Else
DeleteImage gScaled_Image
gScaled_Image = MakeImage(new_width, new_height)
EndIf

DrawToImage gScaled_Image

For y% = 0 To new_height Step SCALE_BLOCK_SIZE
width = imgW + (y / Float(new_height)) * (botom_w - imgW)

For x% = 0 To new_width Step SCALE_BLOCK_SIZE
draw_x# = (x / Float(width)) * Float(imgW)

height = imgH + (x / Float(new_width)) * (right_s - imgH)
draw_y# = (y / Float(height)) * Float(imgH)

DrawImageBox img, x, y, draw_x, draw_y, SCALE_BLOCK_SIZE, SCALE_BLOCK_SIZE
Next x%
Next y%

DrawToScreen

Return gScaled_Image
EndFunction

img = LoadImage("media\soldier.bmp")

Repeat
DrawImage ScaleImage(img, MouseX(), MouseY()), 0, 0
Text 300,0,FPS()
DrawScreen
Forever
``````
(Kokeilkaa miten tämän saisi viritettyä nopeammaksi, olisiko esim. copybox nopeampi?)
-On selkeästi impulsiivinen koodaaja joka...

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

### Re: Efektit

Tuo oli hieno, tomiva ja kätevä. Mitenköhän pitkälle tämän vanhan cb:n kuvan käsittely funktiot menevät. Minä sain tehtyä sen ruman kuvan kääntely funktion ja sinä sait tämän hianon kuvan venyttely funktion..
Solar Eclipse
We're in a simulation, and God is trying to debug us.

tuhoojabotti
Advanced Member
Posts: 485
Joined: Tue Aug 28, 2007 3:53 pm
Location: Suomi, Finland
Contact:

### Re: Efektit

Tein tämänlaisen jännän tutkan. Se toimii tilekartoilla ja objekteilla. Tuskin on ainoa, mutta paras varmasti on, no ei vaiskaan. parannella saa ja käyttääkkin.

Code: Select all

``````FrameLimit 50

tilemap = LoadMap("Media\cdm2.til","Media\tileset.bmp")
PlayObject tilemap,0,0,1
ObjectPickable tilemap,1
guy = LoadObject ("Media\guy.bmp",72)
guy2 = LoadObject ("Media\guy.bmp",72)
ObjectPickable guy2,2
MoveObject guy2,0,200
SetupCollision guy, tilemap, 1, 4, 2

//VARIABLES NEEDED
Const ACCURACY=1 //radar accuracy
Global ang#,fade,speed
ang=0.0 //angle of the pointer
fade=100 //fading speed of the result
speed=7 //speed of the pointer

Repeat

'Ukon ohjaus
If LeftKey() Then TurnObject guy,5
If RightKey() Then TurnObject guy,-5
If UpKey() Then MoveObject guy,2
If DownKey() Then MoveObject guy,-2

CloneCameraPosition guy
DrawGame
Color cbwhite
Text 0,0,FPS()

Radar(50,50,100,guy,tilemap,300)

DrawScreen
Forever

//x = radar drawing position (center)
//y = --||--
//r = radius of the radar circle
//obj = object we get the radar from
//map = tilemap used
//range# = range of the radarbeam
Function Radar(x,y,r,obj,map,range#)
//draw base
Color 0,40,0
Circle x-r/2,y-r/2,r,1
Color 0,80,0
Circle x-r/2,y-r/2,r,0
oldangle=ObjectAngle(obj) //save the old angle of the guy
For i=ang-fade To ang Step ACCURACY //loop trought a loop
RotateObject obj,i
ObjectPick obj
Dist#=Distance(PickedX(),PickedY(),ObjectX(obj),ObjectY(obj))
If Dist<range Then // if the picked object is in the range of the beam
rdist#=dist/range //make the distance good for the scale of the radar
If pickedobject()=map Then
Color 0,150+Max(i-ang,-110),0
Else //this ain't no wall, shoot it!
Color 200+Max(i-ang,-160),0,0
EndIf
Dot x+Cos(i)*r/2*rDist,y-Sin(i)*r/2*rDist
EndIf
Next i
RotateObject obj,oldangle //restore the old angle of the object
//update and draw teh pointer
ang+speed
Color 0,80,0
Line x,y,x+Cos(ang)*r/2,y-Sin(ang)*r/2
EndFunction
``````
dev.tuhoojabotti.com — “Programmer (noun): An organism that turns caffeine into code.”

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

### Re: Efektit

Juman gekko! Tuo oli hieno.. Varmana tulee jollekki käyttöä.. Ehkäpä jopa minulle.. Riippuu vähän..
Solar Eclipse
We're in a simulation, and God is trying to debug us.

SuojelusPerkele
Newcomer
Posts: 37
Joined: Tue Sep 09, 2008 4:17 pm

### Re: Efektit

tuhoojabotti wrote:Tein tämänlaisen jännän tutkan. Se toimii tilekartoilla ja objekteilla. Tuskin on ainoa, mutta paras varmasti on, no ei vaiskaan. parannella saa ja käyttääkkin.

Code: Select all

``````...helvetin hieno koodinpätkä...
``````
Perskules että onnii hieno!

Blooddrunk Game Industry [BGI] :

Unlimited 1.0 = 100%
-Päivityksiä suunnitteilla

Kollaa kestää!
-Suunnitteluvaiheessa
-Tower defence -tyylinen, torju kommunistivyöryt kannaksella
_____
Vertos

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

### Re: Efektit

Se olisi hieno, jos se piirtäisi vihun siihen radariin pelkkänä pallona, eikä vaa ääriviivana..
Solar Eclipse
We're in a simulation, and God is trying to debug us.

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

### Re: Efektit

Tässäpä parin illan koodaustyö: betaMetapallot! Sisältää reaaliaikaisen efektin, joka on sen verran hidas, että lisäsin myös animaation!
Jos haluat tietää lisää, esim. miten tämä on tehty kehoitan käymään Ohjelmointiputkassa

Code: Select all

``````////    MetaPallot by aXu   \\\\

Const SW = 100      'Pieni reso on cb-efekteissä hyvä
Const SH = 70
SCREEN SW*2,SH*2
SCREEN SW,SH,0,2
SetWindow "Metapallot",3
Dim p#(SW,SH,2)

SAFEEXIT OFF

Global MODE
//ASETUKSET\\
MODE =0            '0 = Reaaliaikainen, >0 = Nauhoitetaan näin pitkä animaatio(MODE*10), <0 Toista viimeisin animaatio

Const TailLen = .1  '"Hännän" pituus, 0 = ei häntää, 1 = maailmanloppu

Const BallCount = 2 'Pallojen määrä

Const FRAMETIME = 3 'Animaation Framerate, isompi tökkivämpi, pienempi sulavampi(kait)

W=SW*MODE*10
If W>10000 Then W=10000

If MODE > 0 Then Anim=MakeImage(W,SH*(MODE/10)+SH)  'Tehdään kuva johon animaatio piirretään(rivitetty tarpeen mukaan)
If MODE < 0 Then MODE = -MODE : Goto Animation      'Skipataan suoraan animaatioon

Type MetaBall
Field X#
Field Y#
Field VelX#
Field VelY#
Field Col
Field Radius
End Type

For i=0 To BallCount-1              'Luodaan Metapallot
Ball.MetaBall = New(MetaBall)
Ball\X=Rand(SW)
Ball\Y=Rand(SH)
Ball\VelX=Rnd(.8,3)*(Rand(1)*2-1)
Ball\VelY=Rnd(.8,3)*(Rand(1)*2-1)
Ball\Radius=Rand(10,40)         'Pallon koko
Ball\Col=Rand(2)                'Arvotaan pallon väri(0=RED,1=GREEN,2=BLUE)
Next i

Repeat
For x = 0 To SW         'Näillä tarkastetaan ruudun kaikki pisteet
For y = 0 To SH     'kommenteissa viittaan näihin koordinaatteihin P:llä
i=0
For Ball.MetaBall = Each MetaBall
If i = 0 Then
For c=0 To 2
p(x,y,c)=(p(x,y,c))*TailLen 'Tummennetaan pikseliä P
Next c
End If

D=Distance(x,y,Ball\X,Ball\Y)

If D<Ball\Radius*1.4 Then       'Tarkastetaan onko P lähempänä kuin Pallon säde/neliöjuuri kahden likiarvolla
c=Ball\Col                  'Mitä värikomponenttia "värjätään"
p(x,y,c) = p(x,y,c) + Ball\Radius / ( (Ball\X - x) * (Ball\X - x) + (Ball\Y - y) * (Ball\Y - y) + .00001 )  'Tässä on KAIKEN A ja O
EndIf

If i = BallCount-1 Then         'piirretään vasta viimeisten laskutoimitusten jälkeen
For c=0 To 2
If p(x,y,c) > 1 Then p(x,y,c) = 1   'Ei ylitetä yhtä(testaa kommentoida, niin näet miksi)
g#=g#+p(x,y,c)
Next c
g#=g#/3                     'Värikomponenttejen keskiarvo
If g# > 0.08 Or MODE Then   'Nopeuden vuoksi liian tummia pikseleitä ei piirretä
Color p(x,y,0) * 255 , p(x,y,1) * 255, p(x,y,2) * 255
If MODE Then
DrawToImage Anim    'Muokataan animaatiota
Dot x+SW*((Frame) Mod 100), y+SH*(Frame/100)
DrawToScreen
End If
Dot x, y                'Piirretään piste P
End If
End If

i+1             'Seuraava pallo.
Next Ball
Next y
Next x

For Ball.MetaBall = Each MetaBall
Ball\X=Ball\X+Ball\VelX/FRAMETIME   'Liikutetaan kaikkia palloja
Ball\Y=Ball\Y+Ball\VelY/FRAMETIME   'ja katsotaan myös törmäyksiä varten
If Ball\X<0 Or Ball\X>SW Then Ball\VelX=-Ball\VelX
If Ball\Y<0 Or Ball\Y>SH Then Ball\VelY=-Ball\VelY
Next Ball

If MODE Then
Color 255,255,255
Text 1,1,Frame+"/"+MODE*10
If Frame>MODE*10 Then Exit
End If

DrawScreen
Frame=Frame+1   'Vaihdetaan animaatioframe
Until EscapeKey()

If MODE Then
SaveImage Anim,"MetaBalls Animation.bmp"
DeleteImage Anim
Animation:
Anim=LoadAnimImage("MetaBalls Animation.bmp",SW,SH,0,MODE*10)
FrameLimit 60/FRAMETIME
Frame=0
Repeat
DrawImage Anim,0,0,Frame    'näytetään koko illan elokuva :D
Frame=Frame+1
DrawScreen
Until Frame+1>MODE*10
EndIf
``````
Last edited by axu on Tue Oct 07, 2008 9:10 pm, edited 1 time in total.
Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua

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

### Re: Efektit

tässä hypnotisoija xD Lataus vähän kestää. Ei mikään huippuhieno, mutta yksinketainen spiraali.. Tällä voi myös kilpailla koneen tehoja xD

Code: Select all

``````SCREEN 800,600
Dim images(360)

Text 0,0,"Laskee kuvien paikkoja... ottaa noin 5 sekunttia 1 ghz koneella"
Text 0,12,"Pienennä kuvan kokoa, jos kestää liian kauan.."
Text 0,24,"Jos haluat voit pistää smooth2d päälle(ottaa vähän lisää aikaa)"

pyorytys=MakeImage(300,300) ' Pienennä tai suurenna kuvan kokoa!
DrawToImage pyorytys
For s=1 To 5000
a+1
kuvio(1+a,1+a,a/40,ImageWidth(pyorytys)/2,ImageHeight(pyorytys)/2)
Next s
DrawToScreen

start_time=Timer()

'Smooth2D ON
For i=0 To 36
images(i*10)=CloneImage(pyorytys)
RotateImage images(i*10), i*10
Next i

aaa=Timer()-start_time
paikkax=ScreenWidth()/2-ImageWidth(pyorytys)/2
paikkay=ScreenHeight()/2

Repeat
DrawImage images(angle),paikkax,paikkay
angle=WrapAngle(angle+10)
If angle>360 Then angle=0

Color cbwhite
Text 100,500,"FPS: "+FPS()
Text 100,520,"Aikaa kului: "+aaa+"ms"
DrawScreen
Until EscapeKey()

Function kuvio(x1#,y1#,koko,alkux,alkuy)
x1# = Sin(x1#)*koko
y1# = -Cos(y1#)*koko
Dot x1#+alkux,y1#+alkuy
EndFunction

``````

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

### Re: Efektit

2816ms ilman smooth2d ja 8741ms sen kanssa! 3GHz prossu

Sly_Jack0
Devoted Member
Posts: 612
Joined: Mon Dec 10, 2007 9:25 am

### Re: Efektit

3608ms ilman Smooth2D:tä ja 9319ms Smmoth2D päällä.

Someday coder
Active Member
Posts: 106
Joined: Wed Jul 30, 2008 5:04 pm

### Re: Efektit

2840 ms ilman smooth2d:tä ja 8715 sen kanssa prossu on 2.6ghz dual core AMD