Page 1 of 1

BigImageLib - valtavia kuvia, nopeasti

Posted: Tue Mar 04, 2008 6:42 pm
by JATothrim
Tämmöisen pienen kirjaston sain nyt viimein valmiiksi, BigImagelib
Kirjastolla voit hallita VALTAVAA monikerroksista kuvaa ilman että kone hyytyisi. (vastapainona ikävästi erittäin suurten kuvien luonnin hitaus)
Kirjoitin kokeeksi koko kirjaston ForceVariableDeclaration päällä, eli esittelin kaikki muuttujat koodissa ennen niiden käyttöä. 8-)
Ominaisuuksia, voit:
-Alustaa kuvan "taustalla"
-Piirtää toisen kuvan nopeasti kerrokseen.
-Maskata värillä koko kerroksen tai koko kuvan.
-Tyhjentää piirto värillä koko kerroksen tai koko kuvan.
-Tarkistaa pixelintarkasti törmääkö normaali kuva kerrokseen.
-Ja tietenkin voit pirtää kuvan kerroksen näytölle.
Kirjasto:

Code: Select all

//Kuvan Palikoitten koko ( isompi, nopeampi )
Const _BigImg_BlockW=128
Const _BigImg_BlockH=128

//Kuvan leveys ja korkeus palikoina
Global _BigImgWB As Integer
Global _BigImgHB As Integer
//Kuvan Todellinen koko
Global _BigImgWidth As Integer
Global _BigImgHeight As Integer
Global _BigImg_Layers As integer
Dim _BigImage(0,0,0) As Integer

//Alustaa Kuvan (leveys, korkeus pixeleissä)
Function BigImg_Init(width,height,layers=0)
    Dim x As Integer, y As Integer, z as integer
    Dim BlockSizeX As Integer, BlockSizeY As Integer
    
    For y=0 To _BigImgHB
        For x=0 To _BigImgWB
			For z=0 To layers
				If _BigImage(z,x,y)<>0 Then
					DeleteImage _BigImage(z,x,y)
					_BigImage(z,x,y)=0
				EndIf
			Next z
        Next x
    Next y
    _BigImgWB=RoundUp(width/_BigImg_BlockW)
    _BigImgHB=RoundUp(height/_BigImg_BlockH)
    _BigImgWidth=width
    _BigImgHeight=height
    ReDim _BigImage(layers,_BigImgWB,_BigImgHB)    
    For y=0 To _BigImgHB
        If y=_BigImgHB Then
            BlockSizeY=height-_BigImgHB*_BigImg_BlockH
        Else
            BlockSizeY=_BigImg_BlockH
        EndIf
        For x=0 To _BigImgWB
            If x=_BigImgWB Then
                BlockSizeX=width-_BigImgWB*_BigImg_BlockW
            Else
                BlockSizeX=_BigImg_BlockW
            EndIf
			For z=0 To layers
				_BigImage(z,x,y)=MakeImage(BlockSizeX,BlockSizeY)
			Next z
        Next x
    Next y
	_BigImg_Layers=layers
EndFunction

//Alustaa kuvaa pykälän kerralla, voit tehdä samalla jotain muuta
//kutsu kunnes palauttaa -1, muuten palauttaa desimaaliluvun joka kertoo edistymisen.
Global _BI_IS_X As integer, _BI_IS_Y As integer,_BI_IS_Count As integer
_BI_IS_X=-1
_BI_IS_Y=-1
Function BigImg_InitSteped(width,height,layers=0)
    Dim x As Integer, y As Integer, z as integer
    Dim BlockSizeX As Integer, BlockSizeY As Integer

    If _BI_IS_X=-1 And _BI_IS_Y=-1

		For y=0 To _BigImgHB
			For x=0 To _BigImgWB
				For z=0 To layers
					If _BigImage(z,x,y)<>0 Then
						DeleteImage _BigImage(z,x,y)
						_BigImage(z,x,y)=0
					EndIf
				Next z
			Next x
		Next y
		_BigImgWB=RoundUp(width/_BigImg_BlockW)
		_BigImgHB=RoundUp(height/_BigImg_BlockH)
		_BigImgWidth=width
		_BigImgHeight=height
		ReDim _BigImage(layers,_BigImgWB,_BigImgHB)
		_BigImg_Layers=layers
		_BI_IS_X=0
		_BI_IS_Y=0
		_BI_IS_Count=0
	Else
		
		If _BI_IS_Y=_BigImgHB Then
			BlockSizeY=height-_BigImgHB*_BigImg_BlockH
		Else
			BlockSizeY=_BigImg_BlockH
		EndIf
		
		If _BI_IS_X=_BigImgWB Then
			BlockSizeX=width-_BigImgWB*_BigImg_BlockW
		Else
			BlockSizeX=_BigImg_BlockW
		EndIf
		For z=0 To layers
			_BigImage(z,_BI_IS_X,_BI_IS_Y)=MakeImage(BlockSizeX,BlockSizeY)
		Next z
		
		If _BI_IS_Y=_BigImgHB And _BI_IS_X=_BigImgWB
			_BI_IS_Y=-1
			_BI_IS_X=-1
			Return -1
		EndIf
		_BI_IS_X=_BI_IS_X+1
		If _BI_IS_X>_BigImgWB
			_BI_IS_Y=_BI_IS_Y+1
			_BI_IS_X=0
		EndIf
		_BI_IS_Count=_BI_IS_Count+1
		Return Float(_BI_IS_Count)/Float(_BigImgHB*_BigImgWB)
	EndIf
EndFunction

//Poistaa kuvan, ja vaihtoehtoisesti myös nollaa sen taulukon.
Function BigImg_Delete(cleardim=0)
    Dim x As Integer, y As Integer, z As integer
    For y=0 To _BigImgHB
        For x=0 To _BigImgWB
			For	z=0 To _BigImg_Layers
				If _BigImage(z,x,y)<>0 Then
					DeleteImage _BigImage(z,x,y)
					_BigImage(z,x,y)=0
				EndIf
			Next z
        Next x
    Next y
    _BigImgWB=0
    _BigImgHB=0
	_BigImg_Layers=0
    If cleardim=0 Then ReDim _BigImage(0,0,0)
EndFunction

//apu funktio
Function Range(val,_max,_min=0)
    If val<_min Then Return _min
    If val>_max Then Return _max
    Return val
EndFunction

//Piirrä kuvan kerrokseen toinen kuva.
Function BigImg_AddImg(img,x,y,Layer=0)
    Dim StartX As Integer, StartY As Integer, EndX As Integer, EndY As Integer
    Dim ImgW   As Integer, ImgH   As Integer
    Dim CutX   As Integer, CutY   As Integer, CutW As Integer, CutH As Integer
    Dim CutPX  As Integer, CutPY  As Integer
    Dim BX     As Integer, BY     As Integer
    ImgW=ImageWidth(img)
    ImgH=ImageHeight(img)
    StartX=Range(RoundDown(x/_BigImg_BlockW),_BigImgWB)
    StartY=Range(RoundDown(y/_BigImg_BlockH),_BigImgHB)
    EndX=Range(RoundUp((x+ImgW)/_BigImg_BlockW),_BigImgWB)
    EndY=Range(RoundUp((y+ImgH)/_BigImg_BlockH),_BigImgHB)
    For BY=StartY To EndY
        For BX=StartX To EndX
            If BX=StartX Then
                CutX=x-_BigImg_BlockW*BX
                CutW=CutX+ImgW
                CutW=Range(CutW,_BigImg_BlockW)
                CutW=CutW-CutX
            ElseIf BX=EndX Then
                CutX=0
                CutW=(x+ImgW)-_BigImg_BlockW*EndX
            Else
                CutX=0
                CutW=_BigImg_BlockW
            EndIf
            
            If BY=StartY Then
                CutY=y-_BigImg_BlockH*BY
                CutH=CutY+ImgH
                CutH=Range(CutH,_BigImg_BlockH)
                CutH=CutH-CutY
            ElseIf BY=EndY
                CutY=0
                CutH=(y+ImgH)-_BigImg_BlockH*EndY
            Else
                CutY=0
                CutH=_BigImg_BlockH
            EndIf
            DrawToImage _BigImage(Layer,BX,BY)
            DrawImageBox img,CutX,CutY,CutPX,CutPY,CutW,CutH
            CutPX=CutPX+CutW
        Next BX
        CutPX=0
        CutPY=CutPY+CutH
    Next BY
    DrawToScreen
EndFunction

//Pirtää Kuvan kerroksen näytön koordinaatteihin.
Function BigImg_Draw(x,y,Layer=0)
    Dim StartX As Integer, StartY As Integer, EndX As Integer, EndY As Integer
    Dim BX As Integer, BY As Integer
    StartX=0
    StartY=0
    If x<0 Then StartX=Range(RoundUp(Abs(x)/_BigImg_BlockW),_BigImgWB)
    If y<0 Then StartY=Range(RoundUp(Abs(y)/_BigImg_BlockH),_BigImgHB)
    EndX=Range(RoundUp((ScreenWidth()-x)/_BigImg_BlockW),_BigImgWB)
    EndY=Range(RoundUp((ScreenHeight()-y)/_BigImg_BlockH),_BigImgHB)
    For BY=StartY To Min((StartY+EndY),_BigImgHB)
        For BX=StartX To Min((StartX+EndX),_BigImgWB)
            DrawImage _BigImage(Layer,BX,BY),x+BX*_BigImg_BlockW,y+BY*_BigImg_BlockH
        Next BX
    Next BY
EndFunction

//Tarkistaa pixelin tarkasti ovatko kuvat päällekkäin.
//(x1,y1) 1kuvan sijainti, (x2,y2) 2kuvan sijainti, (Layer) kerros
Function BigImg_Collision(x1,y1,img,x2,y2,Layer=0)
	Dim StartX As Integer, StartY As Integer, EndX As Integer, EndY As Integer
    Dim BX As Integer, BY As Integer, Collision As integer
    StartX=Range(RoundDown((x2-x1)/_BigImg_BlockW),_BigImgWB)
    StartY=Range(RoundDown((y2-y1)/_BigImg_BlockH),_BigImgHB)
    EndX=Range(RoundUp((x2+ImageWidth(img)-x1)/_BigImg_BlockW),_BigImgWB)
    EndY=Range(RoundUp((y2+ImageHeight(img)-y1)/_BigImg_BlockH),_BigImgHB)
    For BY=StartY To EndY
        For BX=StartX To EndX
            If ImagesCollide(_BigImage(Layer,BX,BY),x1+BX*_BigImg_BlockW,y1+BY*_BigImg_BlockH,0,img,x2,y2,0)
				Collision=1
			EndIf
        Next BX
    Next BY
	Return Collision 
EndFunction


//Tyhjentää kuvan nykyisellä piirovärillä
Function BigImg_Clear(Layer=-1)
	Dim BX     As Integer, BY     As Integer, Z As integer
	
	If Layer=-1
		For BY=0 To _BigImgHB
			For BX=0 To _BigImgWB
				For Z=0 To _BigImg_Layers
					DrawToImage _BigImage(Z,BX,BY)
					Box 0,0,_BigImg_BlockW,_BigImg_BlockH
				Next Z
			Next BX
		Next BY
	Else
		For BY=0 To _BigImgHB
			For BX=0 To _BigImgWB
				DrawToImage _BigImage(Layer,BX,BY)
				Box 0,0,_BigImg_BlockW,_BigImg_BlockH
			Next BX
		Next BY
	EndIf

	DrawToScreen
EndFunction

//Maskaa Kuva r,g,b arvoilla
Function BigImg_Mask(r=0,g=0,b=0,Layer=-1)
	Dim BX As Integer, BY As Integer, Z As integer
	
	If Layer=-1
		For BY=0 To _BigImgHB
			For BX=0 To _BigImgWB
				For Z=0 To _BigImg_Layers
					MaskImage  _BigImage(Z,BX,BY),r,g,b
				Next Z
			Next BX
		Next BY
	Else
		For BY=0 To _BigImgHB
			For BX=0 To _BigImgWB
				MaskImage  _BigImage(Layer,BX,BY),r,g,b
			Next BX
		Next BY
	EndIf
	
EndFunction
ja vielä esimerkki:

Code: Select all

SCREEN 800,600

Dim ret As Float
//aivan JÄRJETTÖMÄN ISO KUVA + 2 kerrosta
Repeat
	ret=BigImg_InitSteped(6000,6000,1)
	Text 0,0,ret*100+"%"
	Box 0,100,ScreenWidth()*ret,30
	DrawScreen
Until ret=-1

Dim br(1) As Integer
br(0)=MakeImage(64,64)
br(1)=MakeImage(64,64)
DrawToImage br(0)
    Color 123,90,0
    Ellipse 0,0,64,64
DrawToScreen
DrawToImage br(1)
    Color 103,70,0
    Ellipse 0,0,64,64
DrawToScreen


Dim x As Float,y As Float

Color 255,0,255
BigImg_Clear()
BigImg_Mask(255,0,255)
Repeat
    
    If MouseDown(1) Then
		BigImg_AddImg(br(0),MouseX()-x,MouseY()-y)
		BigImg_AddImg(br(1),MouseX()-x,MouseY()-y,1)
	EndIf
	If KeyDown(cbkeyc) Then Color cbblack:BigImg_Clear()
	BigImg_Draw(x*0.9,y*0.9,1)
    BigImg_Draw(x,y)

    x=x+(LeftKey()-RightKey())*6
    y=y+(UpKey()-DownKey())*6

	Color 123,90,0
    Ellipse MouseX(),MouseY(),64,64

	Color 255,0,255
	Text 0,0,"Pixel-Pixel Collision:"+BigImg_Collision(x,y,br(0),MouseX(),MouseY())
	Text 0,12,"Fps:"+FPS()
DrawScreen
Until KeyDown(cbkeyesc)
BigImg_Delete()
Mielestäni kirjasto sopisi hyvin KARTAKSI vaikka liero klooniin. Kokeilkaa pois, Kommenteja :D

Re: BigImageLib - valtavia kuvia, nopeasti

Posted: Tue Mar 04, 2008 7:11 pm
by Harakka
Vaikuttaa lupaavalta, mutta mav tuli. Kopioin funktiot esimerkkikoodin perään ja ohjelma kaatui tällä rivillä:

Code: Select all

ret=BigImg_InitSteped(6000,6000,1)
Aa, nyt toimiikin kun laitoin koodit toisin päin. Suosittelisin muuttamaan systeemiä ihan yleisen tavan vuoksi: funktiot ladotaan yleensä koodin loppuun.

EDIT: Latauksessa prosentit mene pari prosenttia yli sadan. Pikkujuttu minkä voisi kuitenkin korjata. :) Muuten toimii hyvin.

Re: BigImageLib - valtavia kuvia, nopeasti

Posted: Wed Mar 05, 2008 1:54 pm
by JATothrim
Juu, BigImg_InitSteped palauttaa vähän sekavan prosenttimäärän, vaan syytä en keksinyt miksi luku heittää niin paljon. ( luovutin 1h näpläämisen jälkeen )

Ja Kirjastohan on tarkoitettu sisällyttää koodiisi includella, kuten SDK:n kirjastot. ( sen takiahan se on kirjasto )
Tämän kirjaston kanssa voi tulla muistin kannalta ongelma, oma koneeni hyytyi nätisti 10000x10000x2 kokoisella kuvalla, mutta ei kaatunut :roll: .

Niin ja VOISIKO joku kokeilla tehdä nopeus vertailun, normaalilla 2000x2000 kuvalla ja kirjaston 2000x2000x1 kuvalla,
-pixelin tarkka törmäys ?
-kuvan tekemiseen mennyt aika ?
-kuvaan piirtoon mennyt aika ?
-piirto näytölle?
Itsekkin tämän voisin tehdä, mutta en nyt enää jaksa räpeltää tämän kanssa. :) olen laiska, myönnän.

Re: BigImageLib - valtavia kuvia, nopeasti

Posted: Wed Mar 05, 2008 9:25 pm
by cheeshelmet.jr
Hiano systeemi!! mutta huomasin tuossa leikkiessäni että tuo tunnistus ei toimi se bugittaa itselläni. Kokeilin sitä nykyseen projektiini ja se tunnistus temppuili välillä se tunnisti ja välillä ei.

Re: BigImageLib - valtavia kuvia, nopeasti

Posted: Thu Mar 06, 2008 11:24 pm
by Valtzu
Kätevä ja kaiken lisäksi nopea systeemi :)
Dark Code wrote:vastapainona ikävästi erittäin suurten kuvien luonnin hitaus
Toki voit nopeuttaa kuvanluontiprosessia harventamalla ruudunpiirtotiheyttä.. Esimerkkisi nopeammalla latauksella:

Code: Select all

SCREEN 800,600

Dim ret As Float
//aivan JÄRJETTÖMÄN ISO KUVA + 2 kerrosta
Repeat
   If i=0 Then 
      Text 0,0,ret*100+"%"
      Box 0,100,ScreenWidth()*ret,30
      DrawScreen
   EndIf
   i=(i+1) Mod 20
   ret=BigImg_InitSteped(6000,6000,1)
Until ret=-1

Dim br(1) As Integer
br(0)=MakeImage(64,64)
br(1)=MakeImage(64,64)
DrawToImage br(0)
    Color 123,90,0
    Ellipse 0,0,64,64
DrawToScreen
DrawToImage br(1)
    Color 103,70,0
    Ellipse 0,0,64,64
DrawToScreen


Dim x As Float,y As Float

Color 255,0,255
BigImg_Clear()
BigImg_Mask(255,0,255)
Repeat
   
    If MouseDown(1) Then
      BigImg_AddImg(br(0),MouseX()-x,MouseY()-y)
      BigImg_AddImg(br(1),MouseX()-x,MouseY()-y,1)
   EndIf
   If KeyDown(cbkeyc) Then Color cbblack:BigImg_Clear()
   BigImg_Draw(x*0.9,y*0.9,1)
    BigImg_Draw(x,y)

    x=x+(LeftKey()-RightKey())*6
    y=y+(UpKey()-DownKey())*6

   Color 123,90,0
    Ellipse MouseX(),MouseY(),64,64

   Color 255,0,255
   Text 0,0,"Pixel-Pixel Collision:"+BigImg_Collision(x,y,br(0),MouseX(),MouseY())
   Text 0,12,"Fps:"+FPS()
DrawScreen
Until KeyDown(cbkeyesc)
BigImg_Delete()


Re: BigImageLib - valtavia kuvia, nopeasti

Posted: Fri Mar 07, 2008 3:45 pm
by JATothrim
-Kiitos, nopeus olikin 1 sijalla projektissa.
Valtzu wrote:
Dark Code wrote:vastapainona ikävästi erittäin suurten kuvien luonnin hitaus
Toki voit nopeuttaa kuvanluontiprosessia harventamalla ruudunpiirtotiheyttä..
Ei noin, tottakai ruudun pirtäminen joka välissä hidastaa latausta, MUTTA kun alustat kuvan kerralla vaikka nyt 6000x3000x2 kokoiseksi niin se kestää. Koko ohjelma saattaa 'hyytyä' vähäksi aikaa. Silti suosittelen käyttämään tuota BigImg_Init(w,h,layers) funktiota, se on näet luultavasti vakaampi. (ja siistimpi)

Olisi yhä mukava kuulla joitain testi tuloksia... ;)