Page 23 of 34

Re: Efektit

Posted: Tue Apr 12, 2011 7:59 am
by ukkeli
5 Ja 6 Fps:sän välissä. Hieno efekti!

Re: Efektit

Posted: Tue Apr 12, 2011 8:00 am
by Timblex
en saa paljon iloa noista kun fps on tasaisesti 1

Re: Efektit

Posted: Tue Apr 12, 2011 10:56 am
by MetalRain
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

Re: Efektit

Posted: Tue Apr 12, 2011 7:19 pm
by DJ-Filbe
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

Re: Efektit

Posted: Wed Apr 13, 2011 1:02 pm
by valscion
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

Re: Efektit

Posted: Wed Apr 13, 2011 3:25 pm
by Kille
Hienoa.
Minulla olivat nuo FPS:t täsmälleen samat, ja tasaisesti pysyivät. Jotenkin jännä tämä cb:n portaittainen(?) nopeus.

Re: Efektit

Posted: Wed Apr 13, 2011 4:36 pm
by atomimalli
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.

Re: Efektit

Posted: Wed Apr 13, 2011 4:57 pm
by MaGetzUb
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?

Re: Efektit

Posted: Wed Apr 13, 2011 5:27 pm
by atomimalli
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

Re: Efektit

Posted: Thu Apr 14, 2011 4:32 pm
by ItzRaines
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()

Re: Efektit

Posted: Thu Apr 14, 2011 4:58 pm
by temu92
Öö oisko kannattanu käyttää taulukoita ja silmukoita sen sijaan että teet noin älyttömän monta muuttujaa?

Re: Efektit

Posted: Thu Apr 14, 2011 5:32 pm
by ItzRaines
temu92 wrote:Öö oisko kannattanu käyttää taulukoita ja silmukoita sen sijaan että teet noin älyttömän monta muuttujaa?
Heti juu kun opettelen ne.

Re: Efektit

Posted: Thu Apr 14, 2011 7:39 pm
by Wingman
eikö noiden kohteiden pitäisi liikkua silloin kun 'piikki' menee kohteen yli, eikä silloin kun piikkin kulma on 0

Re: Efektit

Posted: Thu Apr 14, 2011 7:46 pm
by DJ-Filbe
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.

Re: Efektit

Posted: Thu Apr 14, 2011 8:38 pm
by ItzRaines
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..

Re: Efektit

Posted: Thu Apr 14, 2011 10:05 pm
by Latexi95
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.

Re: Efektit

Posted: Thu Apr 14, 2011 10:07 pm
by ItzRaines
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:

Re: Efektit

Posted: Wed Apr 20, 2011 9:02 pm
by MaGetzUb
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 

Re: Efektit

Posted: Tue Apr 26, 2011 8:47 am
by Misthema
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

RotoZoomer

Posted: Tue Apr 26, 2011 1:14 pm
by MetalRain
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.