LoadTexImage

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
cheeshelmet.jr
Member
Posts: 75
Joined: Tue Aug 28, 2007 6:59 am

LoadTexImage

Post 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!
User avatar
Ruuttu
Devoted Member
Posts: 688
Joined: Thu Aug 30, 2007 5:11 pm
Location: Finland, Sipoo

Re: LoadTexImage

Post 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...
Henkru
Advanced Member
Posts: 359
Joined: Sun Aug 26, 2007 2:46 pm

Re: LoadTexImage

Post 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
cheeshelmet.jr
Member
Posts: 75
Joined: Tue Aug 28, 2007 6:59 am

Re: LoadTexImage

Post 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 
Valtzu
Active Member
Posts: 115
Joined: Sun Aug 26, 2007 2:40 pm
Location: Sauvo
Contact:

Re: LoadTexImage

Post 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...
Last edited by Valtzu on Mon Feb 18, 2008 12:46 pm, edited 1 time in total.
Harakka
Advanced Member
Posts: 430
Joined: Mon Aug 27, 2007 9:08 pm
Location: Salo
Contact:

Re: LoadTexImage

Post 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
Peli piirtokomennoilla - voittaja, Virtuaalilemmikkipeli - voittaja,
Sukellusvenepeli - voittaja, Paras tileset - voittaja
Vaihtuva päähenkilö - voittaja, Autopeli - voittaja sekä
Hiirellä ohjattava peli - voittaja B)
cheeshelmet.jr
Member
Posts: 75
Joined: Tue Aug 28, 2007 6:59 am

Re: LoadTexImage

Post 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.

Code: Select all

koodia....
Itselläni ei tullut minkään näköistä mavia.
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: LoadTexImage

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