Page 1 of 1
LoadTexImage
Posted: Sat Feb 16, 2008 4:23 pm
by cheeshelmet.jr
Funktio tekee jonkun kuvan taustan pohjalta kuvasta texturoidun. Funktio on hieman hidas. Funktio esimerkin kanssa selventää asiaa:
Code: Select all
Function LoadTexImage(back$,tex$)
img_back=LoadImage(back)
img_tex=LoadImage(tex)
img_ready=MakeImage(ImageWidth(img_back),ImageHeight(img_back))
DrawToImage img_ready
For x=0 To ImageWidth(img_back)/ImageWidth(img_tex)
For y=0 To ImageHeight(img_back)/ImageHeight(img_tex)
DrawImage img_tex,x*ImageWidth(img_tex),y*ImageHeight(img_tex)
Next y
Next x
DrawToScreen
DrawImage img_back,0,0
For x=0 To ImageWidth(img_back)
For y=0 To ImageHeight(img_back)
If GetPixel(x,y)=-16777216 Then
DrawToImage img_ready
Color 0,0,0
Dot x,y
DrawToScreen
EndIf
Next y
Next x
Return img_ready
End Function
SCREEN 800,800
img=LoadTexImage("Media\level.bmp","Media\grass.bmp")
DrawImage img,0,0
DrawScreen
WaitKey
Parametrit:
back$= Texturoitavan kuvan pohja! huom. mustaa väriä ei texturoida kaikki muuta värit kyllä!
tex$= Textuuri jolla kuva päällystetään
PS.risuja ja ruusuja kiitos!
Re: LoadTexImage
Posted: Sat Feb 16, 2008 5:47 pm
by Ruuttu
Ihan toimiva, mutta aivan liian hidas vaikkapa pelissä käytettäväksi. Toki tuo on kätevä jos haluaa tehdä yhdestä "tasosta" monia eri versioita, mutta lataustauko olisi aivan liian pitkä. Nopealla silmäilyllä en kyllä itsekään keksinyt keinoa saada tuota nopeammaksi...
Re: LoadTexImage
Posted: Sun Feb 17, 2008 11:39 pm
by Henkru
Tämä nopeuttaa hiukan, kun käyttää GetPixel2:sta
Code: Select all
Function LoadTexImage(back$,tex$)
img_back=LoadImage(back)
img_tex=LoadImage(tex)
img_ready=MakeImage(ImageWidth(img_back),ImageHeight(img_back))
DrawToImage img_ready
For x=0 To ImageWidth(img_back)/ImageWidth(img_tex)
For y=0 To ImageHeight(img_back)/ImageHeight(img_tex)
DrawImage img_tex,x*ImageWidth(img_tex),y*ImageHeight(img_tex)
Next y
Next x
DrawToScreen
DrawImage img_back,0,0
Lock
For x=0 To ImageWidth(img_back)
For y=0 To ImageHeight(img_back)
If GetPixel2(x,y)=-16777216 Then
DrawToImage img_ready
Color 0,0,0
Dot x,y
DrawToScreen
EndIf
Next y
Next x
Unlock
Return img_ready
End Function
Re: LoadTexImage
Posted: Mon Feb 18, 2008 9:14 am
by cheeshelmet.jr
No kokeilin hakea tähän lisää nopeutta ja omalla koneella sain tällä funktiolla luotua 4.1s nopeammin kuvan kuin edelliselläni. Funktio:
Code: Select all
Function LoadTexImage(back$,tex$)
img_back=LoadImage(back)
img_tex=LoadImage(tex)
img_ready=MakeImage(ImageWidth(img_back),ImageHeight(img_back))
DrawToImage img_ready
For x=0 To ImageWidth(img_back)/ImageWidth(img_tex)
For y=0 To ImageHeight(img_back)/ImageHeight(img_tex)
DrawImage img_tex,x*ImageWidth(img_tex),y*ImageHeight(img_tex)
Next y
Next x
DrawToScreen
Lock Image(img_back)
For x=0 To ImageWidth(img_back)
For y=0 To ImageHeight(img_back)
If GetPixel2(x,y,Image(img_back))=-16777216 Then
DrawToImage img_ready
Color 0,0,0
Dot x,y
DrawToScreen
EndIf
Next y
Next x
Unlock Image(img_back)
Return img_ready
End Function
SCREEN 800,800
t=Timer()
img=LoadTexImage("Media\level.bmp","Media\grass.bmp")
AddText "aikaa kului: "+(Timer()-t)+"ms"
Repeat
DrawImage img,MouseX()-400,MouseY()-400
DrawScreen
Forever
Re: LoadTexImage
Posted: Mon Feb 18, 2008 11:27 am
by Valtzu
Itse sain kutistettua ajan 1,9 sekuntiin korvaamalla Dot-funktion PutPixel2:lla
Code: Select all
Function LoadTexImage(back$,tex$)
img_back=LoadImage(back)
img_tex=LoadImage(tex)
img_ready=MakeImage(ImageWidth(img_back),ImageHeight(img_back))
DrawToImage img_ready
For x=0 To ImageWidth(img_back)/ImageWidth(img_tex)
For y=0 To ImageHeight(img_back)/ImageHeight(img_tex)
DrawImage img_tex,x*ImageWidth(img_tex),y*ImageHeight(img_tex)
Next y
Next x
DrawToScreen
Lock Image(img_back)
Lock Image(img_ready)
For x=0 To ImageWidth(img_back)
For y=0 To ImageHeight(img_back)
If GetPixel2(x,y,Image(img_back))=-16777216 Then PutPixel2 x,y,0,Image(img_ready)
Next y
Next x
Unlock Image(img_ready)
Unlock Image(img_back)
Return img_ready
End Function
SCREEN 800,800
t=Timer()
img=LoadTexImage("Media\level.bmp","Media\grass.bmp")
Color cbwhite
AddText "aikaa kului: "+(Timer()-t)+"ms"
Repeat
DrawImage img,MouseX()-400,MouseY()-400
DrawScreen
Forever
EDIT: Jaaha, itse en koskenut niihin kohtiin, olisi tietysti pitänyt tarkistaa koko muu koodi...
Re: LoadTexImage
Posted: Mon Feb 18, 2008 12:02 pm
by Harakka
Tuli MAV, koska kävit kuvan pikselit läpi nollasta kuvan leveyteen, eli yhden pikselin liikaa. Muutin koodia ihan vähän (lisäsin -1), nyt pitäisi toimia.
Code: Select all
Function LoadTexImage(back$,tex$)
img_back=LoadImage(back)
img_tex=LoadImage(tex)
img_ready=MakeImage(ImageWidth(img_back),ImageHeight(img_back))
DrawToImage img_ready
For x=0 To ImageWidth(img_back)/ImageWidth(img_tex)
For y=0 To ImageHeight(img_back)/ImageHeight(img_tex)
DrawImage img_tex,x*ImageWidth(img_tex),y*ImageHeight(img_tex)
Next y
Next x
DrawToScreen
Lock Image(img_back)
Lock Image(img_ready)
For x=0 To ImageWidth(img_back)-1
For y=0 To ImageHeight(img_back)-1
If GetPixel2(x,y,Image(img_back))=-16777216 Then PutPixel2 x,y,0,Image(img_ready)
Next y
Next x
Unlock Image(img_ready)
Unlock Image(img_back)
Return img_ready
End Function
SCREEN 800,800
t=Timer()
img=LoadTexImage("Media\level.bmp","Media\grass.bmp")
Color cbwhite
AddText "aikaa kului: "+(Timer()-t)+"ms"
Repeat
DrawImage img,MouseX()-400,MouseY()-400
DrawScreen
Forever
Re: LoadTexImage
Posted: Mon Feb 18, 2008 12:07 pm
by cheeshelmet.jr
Harakka wrote:Tuli MAV, koska kävit kuvan pikselit läpi nollasta kuvan leveyteen, eli yhden pikselin liikaa. Muutin koodia ihan vähän (lisäsin -1), nyt pitäisi toimia.
Itselläni ei tullut minkään näköistä mavia.
Re: LoadTexImage
Posted: Wed Feb 20, 2008 8:32 am
by MaGetzUb
Jos tällä on sama loppu tulos, kuin regaliksen pelin kartalla niin tässä on oma systeemi, käyttää vanhoilta foorumeilta saatua funktiota (DrawRepeatImage)
Code: Select all
//Tämä funkkari käyttää (oliko se) Atomimallin (vai...) Spunten funkkaria...
//Palautetaan kuva objektina...
Function Make_PixMap(_IMG$,_Texture$,MSKR=0,MSKG=255,MSKB=0)
oldr = getRGB(1) //Vanha komponentti R talteen
oldg = getRGB(2)//Sama G:lle
oldb = getRGB(3)//Ja sama B:lle
Obj = MakeObject(0)//Tehään kenttä obj
ObjectOrder Objbg,-1//Pistetään kenttä obj päällimmäiseksi
IMG = LoadImage (_IMG$)//Ladataan kentän maskattava pinta
Texture = LoadImage (_Texture$)//Ladataan tekstuuri
MaskImage IMG ,MSKR,MSKG,MSKB//Maskataan maskattava pinta
W=ImageWidth(IMG)*2 //Levennetään kentän leveys 2x
H=ImageHeight(IMG)*2//Sama pituudelle
ResizeImage Img,W,H//Nyt muutetaan kentän koko
STexture=MakeImage(W,H)//Loppu tekstuuri
DrawToImage stexture//Piirretään loppu tekstuuriin
DrawRepeatingImage(texture,0,0,W,H)//Piirretään tekstuuri tekstuurikuvaan.
//Nyt piirretään maskattava kuva tekstuuriin
DrawToScreen
DrawToImage STexture
DrawImage Img,0,0
DrawToScreen
PaintObject Obj,-STexture
Return obj
EndFunction
Function DrawRepeatingImage( img , startx , starty , width , height )
' haetaan kuvan dimensiot
imgwidth# = ImageWidth( img )
imgheight# = ImageHeight( img )
' lasketaan kuinka monesti kuva menee alueelle
repeatx = RoundDown( width/imgwidth )
repeaty = RoundDown( height/imgheight )
' piirretään kuva
For y = 0 To repeaty
For x = 0 To repeatx
If x = repeatx Then
If y = repeaty Then
DrawImageBox img , startx + x*imgwidth , starty + y*imgheight , 0 , 0 , (width-x*imgwidth) , (height-y*imgheight)
Else
DrawImageBox img , startx + x*imgwidth , starty + y*imgheight , 0 , 0 , (width-x*imgwidth) , imgheight
EndIf
Else
If y = repeaty Then
DrawImageBox img , startx + x*imgwidth , starty + y*imgheight , 0 , 0 , imgwidth , (height-y*imgheight)
Else
DrawImage img , startx + x*imgwidth , starty + y*imgheight
EndIf
EndIf
Next x
Next y
EndFunction