Efektit

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
User avatar
ukkeli
Active Member
Posts: 123
Joined: Thu Jan 28, 2010 10:01 pm

Re: Efektit

Post by ukkeli » Tue Apr 12, 2011 7:59 am

5 Ja 6 Fps:sän välissä. Hieno efekti!
...

User avatar
Timblex
Advanced Member
Posts: 252
Joined: Sun Apr 11, 2010 10:37 am
Location: Kouvola

Re: Efektit

Post by Timblex » Tue Apr 12, 2011 8:00 am

en saa paljon iloa noista kun fps on tasaisesti 1
Entinen timpe99...
Demokisa 2013 demo valmis, Check it out!

User avatar
MetalRain
Active Member
Posts: 188
Joined: Sun Mar 21, 2010 12:17 pm
Location: Espoo

Re: Efektit

Post by MetalRain » Tue Apr 12, 2011 10:56 am

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

koodia..
Käyttämällä kuvia toistuvan text-komennon sijaan nousi FPS 20 -> 30. Mietin vielä olisiko yhdellä copybox-silmukalla pärjännyt, kun yhdistäisi nuo efektit myös koodissa toisiinsa, vaan eipä varmaan.

Erittäin nätti efekti kuitenkin (:

Code: Select all

// Ascii metaballs made with CoolBasic

SCREEN 400,400

Const Grid = 10
Global Fluidize_img
Global sw, sh
   
sw = ScreenWidth()
sh = ScreenHeight()

w = sw / Grid
h = sh / Grid
   
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


Dim timg(255)

For i=0 To 255
    timg(i)=MakeImage(Grid,Grid)
    DrawToImage(timg(i))
    Color i*(0.5+i/512.0), 0 , i*(i/255.0)*0.5
    Text 0, 0, "@"
    DrawToScreen 
Next i
 
w2 = (w Shr 1)
h2 = (h Shr 1)

w10 = ((w - Grid) Shr 1)
h10 = ((h - Grid) Shr 1)

Repeat

   angle# = WrapAngle(angle# + 5)

   t# = (Timer() / Grid)
   
   For b.ball = Each ball
        b\x = w2 + Sin(b\mod1 * t#) * w10
        b\y = h2 + Cos(b\mod2 * t#) * h10
   Next b
   
    
   For x = 0 To w
   
      x10 = x*Grid
   
      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)
         Next b
         
         targetx = x10 + Cos(x10+ang)*amp# + Rnd(-randscale#,randscale#)
         targety = y*grid - Sin(y*grid+ang)*amp# + Rnd(-randscale#,randscale#)
         
         If n# > 0 Then DrawImage timg(Int(Min(n*255.0,255))),x10,y*Grid

      Next y
   Next x
   
   Fluidize(angle,2,1)
   
   SetWindow "Ascii meatballs w/ Fluidize() | " + FPS()
   
   DrawScreen OFF
Forever


Function Fluidize(ang#,amp#,id)

    randscale# = amp#/3.0

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

            Select id
                Case 1
                    targetx = x + Cos(x+ang)*amp# + Rnd(-randscale#,randscale#)
                    targety = y - Sin(y+ang)*amp# + Rnd(-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

DJ-Filbe
Devoted Member
Posts: 854
Joined: Sat Feb 20, 2010 3:18 pm

Re: Efektit

Post by DJ-Filbe » Tue Apr 12, 2011 7:19 pm

Vielä vähän editointia, tästä tuli sitten joku koralliriuttaefekti tjsp :D

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
         If Rand(0,20)=0 then 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
ja FPS nousi alkuperäiseen verrattuna 20 -> 30

Tässä vielä se kuvaversio. FPS ei itselläni juuri parane.

Code: Select all

// Ascii metaballs made with CoolBasic

SCREEN 400,400

Const Grid = 10
Global Fluidize_img
Global sw, sh
   
sw = ScreenWidth()
sh = ScreenHeight()

w = sw / Grid
h = sh / Grid
   
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


Dim timg(255)

For i=0 To 255
    timg(i)=MakeImage(Grid,Grid)
    DrawToImage(timg(i))
    Color i*(0.5+i/512.0), 0 , i*(i/255.0)*0.5
    Text 0, 0, "#"
    DrawToScreen
Next i

w2 = (w Shr 1)
h2 = (h Shr 1)

w10 = ((w - Grid) Shr 1)
h10 = ((h - Grid) Shr 1)

Repeat

   angle# = WrapAngle(angle# + 5)

   t# = (Timer() / Grid)
   
   For b.ball = Each ball
        b\x = w2 + Sin(b\mod1 * t#) * w10
        b\y = h2 + Cos(b\mod2 * t#) * h10
   Next b
   
   
   For x = 0 To w
   
      x10 = x*Grid
   
      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)
         Next b
         
         targetx = x10 + Cos(x10+ang)*amp# + Rnd(-randscale#,randscale#)
         targety = y*grid - Sin(y*grid+ang)*amp# + Rnd(-randscale#,randscale#)
         
         If n# > 0 And Rand(0,20) = 0 Then DrawImage timg(Int(Min(n*255.0,255))),x10,y*Grid

      Next y
   Next x
   
   Fluidize(angle,2,1)
   
   SetWindow "Ascii meatballs w/ Fluidize() | " + FPS()
   
   DrawScreen OFF
Forever


Function Fluidize(ang#,amp#,id)

    randscale# = amp#/3.0

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

            Select id
                Case 1
                    targetx = x + Cos(x+ang)*amp# + Rnd(-randscale#,randscale#)
                    targety = y - Sin(y+ang)*amp# + Rnd(-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
valscion
Moderator
Moderator
Posts: 1588
Joined: Thu Dec 06, 2007 8:46 pm
Location: Espoo
Contact:

Re: Efektit

Post by valscion » Wed Apr 13, 2011 1:02 pm

DJ-Filbe wrote:Vielä vähän editointia, tästä tuli sitten joku koralliriuttaefekti tjsp :D

Code: Select all

...
ja FPS nousi alkuperäiseen verrattuna 20 -> 30

Tässä vielä se kuvaversio. FPS ei itselläni juuri parane.

Code: Select all

...
Heh, ihan hauskan näköinen. Kuvaversio oli ainakin itselläni selkeästi nopeampi, FPS 31 -> 61
cbEnchanted, uudelleenkirjoitettu runtime. Uusin versio: 0.4.1 — Nyt myös sorsat GitHubissa!
NetMatch - se kunnon nettimättö-deathmatch! Avoimella lähdekoodilla varustettu
vesalaakso.com

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

Re: Efektit

Post by Kille » Wed Apr 13, 2011 3:25 pm

Hienoa.
Minulla olivat nuo FPS:t täsmälleen samat, ja tasaisesti pysyivät. Jotenkin jännä tämä cb:n portaittainen(?) nopeus.
ZEPPELIN
Jatkoa tulossa... tällä kertaa lataus ei kestä viikkoa

User avatar
atomimalli
Moderator
Moderator
Posts: 227
Joined: Wed Aug 29, 2007 3:55 pm

Re: Efektit

Post by atomimalli » Wed Apr 13, 2011 4:36 pm

Nopeuksien portaittaisuus johtuu siitä, että drawscreen odottaa aina seuraavaan ruudunpäivitykseen. Loput viimeisestä framesta menee vain odotteluun, jolloin frame kestää aina tasamäärän ruudunpäivityksiä jos laskenta-aika framejen välillä ei erityisemmin vaihtele. Tämän vuoksi yleisimmät fps:ät ova 60 jaettuna jollain tasaluvulla: 60, 30, 20, 15, 12, 10, 8 jne.
Ruudunpäivityksen odottamisen voi kiertää päivittämällä kuvan printillä drawscreenin sijaan. Siinä on kyllä omat ongelmansa, joten en suosittele sitä. Sillä pääsee vaikka moneen sataan fpsään, mutta kuva alkaa repeillä kun se päivittyy ruudunpiirron aikana. Drawscreenin odotus on tehty tämän estämiseksi.

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

Re: Efektit

Post by MaGetzUb » Wed Apr 13, 2011 4:57 pm

atomimalli wrote:Nopeuksien portaittaisuus johtuu siitä, että drawscreen odottaa aina seuraavaan ruudunpäivitykseen. Loput viimeisestä framesta menee vain odotteluun, jolloin frame kestää aina tasamäärän ruudunpäivityksiä jos laskenta-aika framejen välillä ei erityisemmin vaihtele. Tämän vuoksi yleisimmät fps:ät ova 60 jaettuna jollain tasaluvulla: 60, 30, 20, 15, 12, 10, 8 jne.
Ruudunpäivityksen odottamisen voi kiertää päivittämällä kuvan printillä drawscreenin sijaan. Siinä on kyllä omat ongelmansa, joten en suosittele sitä. Sillä pääsee vaikka moneen sataan fpsään, mutta kuva alkaa repeillä kun se päivittyy ruudunpiirron aikana. Drawscreenin odotus on tehty tämän estämiseksi.
Eli CoolBasic ei käytä Print komennon ruudunpäivityksessä tuplapuskurointia? Vai käyttääkö koko CoolBasic edes ollenkaan kyseistä kikkaa?
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
atomimalli
Moderator
Moderator
Posts: 227
Joined: Wed Aug 29, 2007 3:55 pm

Re: Efektit

Post by atomimalli » Wed Apr 13, 2011 5:27 pm

Kyllä cbssä on kaksoispuskurointi. Sekä print että drawscreen kopioivat takapuskurin näytölle. Drawscreenissä on viive syncin takia ja printissä kopiointi sen takia ettei tarvisi käyttää drawscreeniä aina sen seurana ja toisaalta siksi että muuten drawscreen kadottaisi printillä tehdyn tekstin. Print vaikuttaa etupuskuriin piirrolta, koska se päivittää sen välittömästi, mutta se piirtää käytännön syistä kuitenkin takapuskuriin.

Printin kanssa säätäessä kannattaa huomata koordinaattivääristymät, kun osoitin menee alalaitaan. En muista, pystyikö niitä kunnolla kiertää locatella :o

User avatar
ItzRaines
Active Member
Posts: 211
Joined: Sat Feb 05, 2011 7:59 pm

Re: Efektit

Post by ItzRaines » Thu Apr 14, 2011 4:32 pm

Eräänlainen tutka, sekä kolmisen kappaletta "kohteita" Jos jatkan tämän työstämistä niin luultavasti kohteet muutan objekteiksi, kuten myös tutkan piikin, jolloin saadaan vähän elävyyttä mukaan.

Code: Select all

SetWindow "Radar Beta GeG S.T.S ItzRaines 2011"
DrawToWorld ON
FrameLimit 20
ClsColor 64,64,64
radarfont=LoadFont("impact",20)
SetFont radarfont
a=0
x=Rand(-90,90)
y=Rand(-90,90)
i=Rand(-90,90)
s=Rand(-90,90)
g=Rand(-90,90)
j=Rand(-90,90)
o=Rand(-3,3)
u=Rand(-3,3)
t=Rand(-3,3)
r=Rand(-3,3)
h=Rand(-3,3)
m=Rand(-3,3)

Repeat
   
    If a=360 Then 
        x+o
        y+u
        i+t
        s+r
        g+h
        j+m
    EndIf
    
    Color 255,0,0
    Line 0,0,Cos(a)*140,-Sin(a)*140
    Circle x,y,10
    Circle i,s,10
    Circle g,j,10
    
    Color 192,192,192
    Circle -5,5,10
    Circle -50,50,100,OFF
    Circle -75,75,150,OFF
    Circle -100,100,200,OFF
    Circle -125,125,250,OFF
    Line -150,0,150,0
    Line 0,-150,0,150
    Text 10,5,"FPS:  "+FPS()
    Text 210,5,a
    Text 10,40,x
    Text 40,40,","+y
    Text 10,60,i
    Text 40,60,","+s
    Text 10,80,g
    Text 40,80,","+j
   
    a=WrapAngle(a)
    a=a+1.8
    
    DrawScreen 
Until EscapeKey()

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 » Thu Apr 14, 2011 4:58 pm

Öö oisko kannattanu käyttää taulukoita ja silmukoita sen sijaan että teet noin älyttömän monta muuttujaa?

User avatar
ItzRaines
Active Member
Posts: 211
Joined: Sat Feb 05, 2011 7:59 pm

Re: Efektit

Post by ItzRaines » Thu Apr 14, 2011 5:32 pm

temu92 wrote:Öö oisko kannattanu käyttää taulukoita ja silmukoita sen sijaan että teet noin älyttömän monta muuttujaa?
Heti juu kun opettelen ne.

User avatar
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Efektit

Post by Wingman » Thu Apr 14, 2011 7:39 pm

eikö noiden kohteiden pitäisi liikkua silloin kun 'piikki' menee kohteen yli, eikä silloin kun piikkin kulma on 0
- - - -

DJ-Filbe
Devoted Member
Posts: 854
Joined: Sat Feb 20, 2010 3:18 pm

Re: Efektit

Post by DJ-Filbe » Thu Apr 14, 2011 7:46 pm

Wingman wrote:eikö noiden kohteiden pitäisi liikkua silloin kun 'piikki' menee kohteen yli, eikä silloin kun piikkin kulma on 0
Samaa ihmettelin minäkin.

User avatar
ItzRaines
Active Member
Posts: 211
Joined: Sat Feb 05, 2011 7:59 pm

Re: Efektit

Post by ItzRaines » Thu Apr 14, 2011 8:38 pm

DJ-Filbe wrote:
Wingman wrote:eikö noiden kohteiden pitäisi liikkua silloin kun 'piikki' menee kohteen yli, eikä silloin kun piikkin kulma on 0
Samaa ihmettelin minäkin.
Toki juu, en minä niin typerä ole.
Heti kun joku kertoo, että miten saan piirtokomennoilla tehdyt pallot päivittymään, kun piirtokomennolla tehty viiva luistaa sen yli..

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

Re: Efektit

Post by Latexi95 » Thu Apr 14, 2011 10:05 pm

ItzRaines wrote: Heti kun joku kertoo, että miten saan piirtokomennoilla tehdyt pallot päivittymään, kun piirtokomennolla tehty viiva luistaa sen yli..

Code: Select all

kohteenkulma# = GetAngle(tutkan_keskipisteX,tutkan_keskipisteY,kohdeX,kohdeY)
if kohteenkulma > vanhakulma and kohteenkulma < vanhakulma+kulmanlisäys then
//Päivitä paikka
endif
uusikulma = vanhakulma + kulmanlisäys
Nuo "vanhakulma", "uusikulma" ja "kulmanlisäys" ovat siis sen pyörivän viivan.

User avatar
ItzRaines
Active Member
Posts: 211
Joined: Sat Feb 05, 2011 7:59 pm

Re: Efektit

Post by ItzRaines » Thu Apr 14, 2011 10:07 pm

Latexi95 wrote:
ItzRaines wrote: Heti kun joku kertoo, että miten saan piirtokomennoilla tehdyt pallot päivittymään, kun piirtokomennolla tehty viiva luistaa sen yli..

Code: Select all

kohteenkulma# = GetAngle(tutkan_keskipisteX,tutkan_keskipisteY,kohdeX,kohdeY)
if kohteenkulma > vanhakulma and kohteenkulma < vanhakulma+kulmanlisäys then
//Päivitä paikka
endif
uusikulma = vanhakulma + kulmanlisäys
Toivottavasti onnistuu minulta yhtä helposti, kuin vaikuttaa tuossa.
Kiitän. Katsotaas sitten käytännössä huomisen puolella. Nyt eikun nukkumatit vaan kaikille! :mrgreen:

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

Re: Efektit

Post by MaGetzUb » Wed Apr 20, 2011 9:02 pm

Tässä tämmöinen yksinkertainen efekti:

Code: Select all

FrameLimit 40 'rajoita nopeutta

kartta = LoadMap("Media\cdm2.til","Media\tileset.bmp")
PlayObject kartta,0,0,1

ukko = LoadObject ("Media\guy.bmp",72)

SetupCollision ukko, kartta, 1, 4, 2

Repeat

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

    UpdateGame

    CloneCameraPosition ukko
    DrawGame
    BlackHole(MouseX(), MouseY())
    
    
    DrawScreen

Forever

Function BlackHole(x, y, r=30)
    Lock SCREEN()
    For i = 0 To 360
        px = x+Cos(i)*r
        py = y-Sin(i)*r
        px = Max(1, Min(px, ScreenWidth()))
        py = Max(1, Min(py, ScreenHeight()))
        col = GetPixel2(px, py, SCREEN())
        Color 0, 0, col
        Line px, py, x, y
    Next i
    Unlock SCREEN()
EndFunction 
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 26, 2011 8:47 am

ItzRaines wrote:
DJ-Filbe wrote:
Wingman wrote:eikö noiden kohteiden pitäisi liikkua silloin kun 'piikki' menee kohteen yli, eikä silloin kun piikkin kulma on 0
Samaa ihmettelin minäkin.
Toki juu, en minä niin typerä ole.
Heti kun joku kertoo, että miten saan piirtokomennoilla tehdyt pallot päivittymään, kun piirtokomennolla tehty viiva luistaa sen yli..
En nyt sanoisi että tämä olisi esimerkeistä parhain, mutta jotain tämän suuntaista:

Code: Select all

Randomize Timer()

FrameLimit 60

Type TARGET
    Field x As Float 'Koordinaatit
    Field y As Float
    Field c As Float 'Kohteen väri
    Field a As Float 'Kohteen kulma
    Field xDist As Integer 'Etäisyydet keskipisteestä
    Field yDist As Integer
EndType

DrawToWorld ON,ON,OFF

For i=0 To 9
    t.TARGET = New(TARGET)
    t\a=Rand(360)
    t\xDist=Rand(5,100)
    t\yDist=Rand(5,100)
    t\x=Cos(t\a)*xDist
    t\y=Sin(t\a)*yDist
    t\c=0
Next i



Repeat

    a#=WrapAngle(a+.5)
    Color 255,255,255
    Text 0,0,a
    lineX=Cos(a)*125
    lineY=Sin(a)*125
    aCheck#=GetAngle(0,0,lineX,lineY)
    
    Color 255,0,0
    For i=0 To 3
        Circle -25-(i*25),25+(i*25),50+(i*50),0
    Next i
    
    Line -125,0,125,0
    Line 0,125,0,-125
    
    For t.TARGET = Each TARGET
        ' Kun kulmat osuvat kohdilleen, täräytetään kohteen väri maksimiin.
        If GetAngle(0,0,t\x,t\y)>=aCheck-.25 And GetAngle(0,0,t\x,t\y)<=aCheck+.25 Then t\c=255
        t\a=t\a-0.01 'Liikutellaan kohteita
        t\x=Cos(t\a)*t\xDist
        t\y=Sin(t\a)*t\yDist
        
        If t\c>0 Then 'Jos kohteen väri on suurempi kuin 0, piirretään se ja feidataan väriä mustaan
            t\c=t\c-3.0
            Color 0,t\c,0
            Circle t\x-2, t\y+2, 4
        EndIf
    Next t
    
    Color 0,255,0
    Line 0,0,lineX,lineY
        
    
    DrawScreen
Forever
End

User avatar
MetalRain
Active Member
Posts: 188
Joined: Sun Mar 21, 2010 12:17 pm
Location: Espoo

RotoZoomer

Post by MetalRain » Tue Apr 26, 2011 1:14 pm

Olikohan se Marcoder joka aikoinaan teki pelin jossa pelimaailmaa pystyi pyörittämään. Sen innoittamana tein aikoinaan systeemin joka pyörittelee tilekartan tilet ja piirtää kartan kuvina tile kerrallaan. Koska pelkkä pyörittely ei riitä niin ymppäsin MaGetzUbin zoomaussysteemin samaan ja aika perus rotozoomeri siitä sitten tuli.

Code: Select all

// global variables often needed for other calculations
Global AmountOfRotation  As integer
Global RotationPrecision As Float
Global RotatedMapTileSize As integer
Dim RotatedMapTiles( 1, 1) As integer
Dim RotatedMapData( 1, 1) As integer 
Global UnrotatedTileset As integer 
Global UnrotatedMap As integer
Global RotatedMapWidth As integer, RotatedMapHeight As integer
Global RotatedMapX As Float, RotatedMapY As Float, RotatedMapAng As Float, RotatedMapHotspotX As Float, RotatedMapHotspotY As Float

Global SW,SH,ZoomBuffer,ZoomImage

SCREEN 1024,768

SW = ScreenWidth()
SH = ScreenHeight()

LoadRotatedMap("media\cdm2.til","media\tileset.bmp",48)

PositionRotatedMap(ang#,0,0,RotatedMapWidth*RotatedMapTileSize/2,RotatedMapheight*RotatedMapTileSize/2)

DrawToWorld ON

Repeat

    RotatedMapAng = WrapAngle( RotatedMapAng + MouseDown(2) - MouseDown(1) )
    
    DrawRotatedMap()
    
    sx = (KeyDown(cbkeya)-KeyDown(cbkeyd))*3
    sy = (KeyDown(cbkeyw)-KeyDown(cbkeys))*3
    
    RotatedMapHotspotX  = RotatedMapHotspotX + Cos(RotatedMapAng)* -sx + Cos(RotatedMapAng+90.0)* -sy
    RotatedMapHotspotY = RotatedMapHotspotY + Sin(RotatedMapAng)* sx + Sin(RotatedMapAng+90.0)* sy
    
    // tällä saadaan aikaan sulava Zoom
    times# = Min(Max(1, times# + MouseMoveZ()*0.5),20)
    zoom# = CurveValue (Float(1.0/Float(times)),zoom#,25.0)
     
    ZoomToXY(0,0,zoom#)
     
    DrawImage ZoomImage, 0,0
    
    DrawGame
    
    Color cbwhite
    
    Text 0,0,"FPS: "+FPS()
    Text 0,20,"Use WASD to move, mouse wheel to zoom and mouse keys to rotate."
    
    Circle sw/2-2/(zoom#/2.0),sh/2-2/(zoom#/2.0),5/zoom#,1

    DrawScreen 
    
Forever

Function ZoomToXY(x#,y#,zoom#)

    zoom#=Max(Min(zoom#,1.0),0.01)

    If Not ZoomBuffer Then ZoomBuffer = MakeImage(SW, SH)
    If Not ZoomImage Then ZoomImage = MakeImage(SW, SH)

    UpdateGame
    
    PositionCamera x# - (SW * zoom#/2.0) + SW/2.0, y# + (SH * zoom#/2.0) - SH/2.0
    
    DrawGame

    DrawToWorld OFF
    DrawToImage ZoomBuffer //Tyhennetään kuvapuskuri1:n jääneet turhat rojut maalaamalla se mustaksi.
        Color cbblack
        Box 0, 0, SW, SH
    DrawToImage ZoomImage //Tyhennetään kuvapuskuri2:n jääneet turhat rojut maalaamalla se mustaksi myös.
        Color cbblack
        Box 0, 0, SW, SH
    DrawToScreen 
    
    For i = 0 To Int(SW)
        CopyBox Int(i*zoom#), 0, 1, SH, i, 0, SCREEN(), Image(ZoomBuffer)
    Next i
    For i = 0 To Int(SH)
        CopyBox 0, Int(i*zoom#), SW, 1, 0, i, Image(ZoomBuffer), Image(ZoomImage)
    Next i
    
    //nyt ei tarvitse tyhjätä näyttöä ennen piirtoa
    MaskImage ZoomImage,255,0,255
End Function 

Function PositionRotatedMap(ang#,x#=0,y#=0,hotspotx#=0,hotspoty#=0)
    RotatedMapX = x#
    RotatedMapY = y#
    RotatedMapAng = ang#
    RotatedMapHotspotX = hotspotx
    RotatedMapHotspotY = hotspoty
End Function 

Function DrawRotatedMap()

    DrawToWorld OFF,ON 
    
    rang = RoundDown( RotatedMapAng / RotationPrecision + 0.5) Mod (AmountOfRotation+1)
    
    margin=1

    //these don't require tile coordinates, so lets calculate them before loop
    cx# = Cos( RotatedMapAng ) * (RotatedMapTileSize-margin)
    cy# = Cos( RotatedMapAng + 90.0) * (RotatedMapTileSize-margin)
    
    sx# = Sin( RotatedMapAng ) * (-RotatedMapTileSize+margin)
    sy# = Sin( RotatedMapAng + 90.0 ) * (-RotatedMapTileSize+margin) 
    
    hcx# = Cos( RotatedMapAng ) * -RotatedMapHotspotX
    hcy# = Cos( RotatedMapAng +90.0) * -RotatedMapHotspotY
    
    hsx# = Sin( RotatedMapAng ) * RotatedMapHotspotX 
    hsy# = Sin( RotatedMapAng +90.0) * RotatedMapHotspotY

    //draw tiles if image is available
    For tx=1 To RotatedMapWidth
        For ty=1 To RotatedMapHeight
        
            tile = RotatedMapTiles( RotatedMapData(tx,ty), rang)

            If tile Then 
                DrawImage tile, RotatedMapX + cx# * tx  + cy# * ty + hcx + hcy,  RotatedMapY + sx * tx + sy * ty + hsx + hsy
            EndIf 
        Next ty
    Next tx

End Function 

Function LoadRotatedMap(mappath$,tilesetpath$,rotation=64)

    t=Timer()

    SetWindow "Loading rotated tilemap, please wait."

    AmountOfRotation = rotation

    UnrotatedMap = LoadMap(mappath$,tilesetpath$)
    
    ShowObject UnrotatedMap,OFF
    
    RotatedMapWidth = MapWidth()
    RotatedMapHeight = MapHeight()
    
    RotatedMapTileSize = ObjectSizeX(UnrotatedMap)/MapWidth()

    UnrotatedTileset = LoadImage(tilesetpath$)
    
    tilesetw = ImageWidth(UnrotatedTileset)/RotatedMapTileSize
    tileseth = ImageHeight(UnrotatedTileset)/RotatedMapTileSize
    
    ReDim RotatedMapTiles( tilesetw*tileseth+1, AmountOfRotation )

    RotationPrecision = 360.0 / Float( AmountOfRotation + 1 ) 
    
    ReDim RotatedMapData( MapWidth(), MapHeight())
    
    
    //check map for used tiles
    For x=1 To RotatedMapWidth
        For y=1 To RotatedMapHeight
            
            RotatedMapData(x,y) = GetMap2(1,x,y)
            If RotatedMapData(x,y)=0 Then RotatedMapData(x,y) = GetMap2(0,x,y)

            value = RotatedMapData(x,y)
            
            //only loads tiles not loaded before
            If value<>0 Then 
                If RotatedMapTiles( value, 0)=0 Then 
                
                    SetWindow "Loading rotated tilemap, please wait. "+(Float(x*RotatedMapHeight+y)/Float(RotatedMapWidth*RotatedMapHeight))*100.0+" %"

                    //get the right tile coordinates
                    tx = ((value-1) Mod tilesetw) 
                    ty = RoundDown((value-1) / tilesetw) 
                    
                    //copy tile from tileset
                    RotatedMapTiles( value, 0 ) = MakeImage( RotatedMapTileSize , RotatedMapTileSize)
                    CopyBox tx * RotatedMapTileSize , ty * RotatedMapTileSize , RotatedMapTileSize , RotatedMapTileSize , 0, 0, Image( UnrotatedTileset ), Image( RotatedMapTiles( value, 0 ) )
                    ResizeImage RotatedMapTiles( value, 0 ),RotatedMapTileSize,-RotatedMapTileSize
                    RotateImage RotatedMapTiles( value, 0 ), -0 * RotationPrecision
                    
                    //tile rotation
                    For a = 1 To AmountOfRotation
                        RotatedMapTiles( value, a ) = CloneImage( RotatedMapTiles( value, 0 ))
                        RotateImage RotatedMapTiles( value, a ), -a * RotationPrecision 
                    Next a
                EndIf 
            EndIf 
            
        Next y
    Next x
    
    t= Timer()-t
    
    SetWindow "Rotated tilemap was loaded with "+rotation+" rotations in "+(t/1000.0)+" seconds."
End Function
EDIT: Muokkasinpa tätä niin että kartan pyörityspistettä saa muutettua.
Last edited by MetalRain on Fri Apr 29, 2011 7:38 am, edited 1 time in total.

Post Reply