Efektit

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

Re: Efektit

Post by Valtzu » Wed Sep 17, 2008 4:59 pm

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

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

Re: Efektit

Post by MaGetzUb » Wed Sep 17, 2008 6:13 pm

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.

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

Re: Efektit

Post by Valtzu » Wed Sep 17, 2008 8:48 pm

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

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

Re: Efektit

Post by Ruuttu » Thu Sep 18, 2008 6:50 pm

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

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

Re: Efektit

Post by Valtzu » Thu Sep 18, 2008 6:53 pm

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. :D
Tämä on ilmeisesti konekohtaista, koska itse en ainakaan havainnut hidastumisia.

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

Re: Efektit

Post by MAVmaggot » Thu Sep 18, 2008 7:25 pm

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

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

Re: Efektit

Post by Someday coder » Thu Sep 25, 2008 5:27 pm

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

Post by Ris » Fri Sep 26, 2008 5:07 pm

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 

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

Re: Efektit

Post by MaGetzUb » Tue Sep 30, 2008 6:02 pm

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
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

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

Re: Efektit

Post by JATothrim » Thu Oct 02, 2008 9:28 pm

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...
ohjelmoi C++:lla rekursiivisesti instantioidun templaten, jonka jokainen instantiaatio instantioi sekundäärisen singleton-template-luokan, jonka jokainen instanssi käynistää säikeen tulostakseen 'jea'.

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

Re: Efektit

Post by MaGetzUb » Fri Oct 03, 2008 8:36 pm

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.. :D :?:
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

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

Re: Efektit

Post by tuhoojabotti » Sat Oct 04, 2008 1:58 am

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
Imagedev.tuhoojabotti.com — “Programmer (noun): An organism that turns caffeine into code.”

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

Re: Efektit

Post by MaGetzUb » Sat Oct 04, 2008 11:06 am

Juman gekko! Tuo oli hieno.. Varmana tulee jollekki käyttöä.. Ehkäpä jopa minulle.. Riippuu vähän.. :D
Solar Eclipse
Meneillä olevat Projektit:
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

Post by SuojelusPerkele » Sun Oct 05, 2008 6:47 pm

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!

Image
Blooddrunk Game Industry [BGI] :

Unlimited 1.0 = 100%
-Päivityksiä suunnitteilla

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

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

Re: Efektit

Post by MaGetzUb » Sun Oct 05, 2008 7:10 pm

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

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

Re: Efektit

Post by axu » Mon Oct 06, 2008 11:24 pm

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 :roll:
Image

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

Re: Efektit

Post by Jonhu » Tue Oct 07, 2008 12:29 pm

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


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 » Tue Oct 07, 2008 3:54 pm

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

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

Re: Efektit

Post by Sly_Jack0 » Tue Oct 07, 2008 5:32 pm

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

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

Re: Efektit

Post by Someday coder » Fri Oct 17, 2008 2:00 pm

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

Post Reply

Who is online

Users browsing this forum: No registered users and 10 guests