Resize Image Routine Up The Swannie

[Clyde]

Hi fellow dudes,

I've been working on an Image Resize Routine in Freebasic with TinyPTC. But am having big troubles & problems with using floats / decimal sizes. And would love some help on fixing it please.

The code below, as you'll see works well with integer sizes. And  as for the float method looks cack and gappy.

Code: [Select]

'
' Resize Image Routine in Freebasic and TinyPTC.
' By Clyde Sometime And In A Distant Land In January '07
'

Option Explicit
Option Static

#Include Once "tinyptc.bi"
#Include Once "windows.bi"
#Include Once "crt.bi"

Const XRES=640
Const YRES=480

Const XRES2=XRES/2
Const YRES2=YRES/2

Const ARES=XRES*YRES

Dim Shared ScreenBuffer(ARES)
Dim Shared ImageData(128,128)

Dim Shared ImageW
Dim Shared ImageH

Declare Sub DrawImageResized( ByVal PosX As Single, ByVal PosY As Single, ByVal SizeX As Single, ByVal SizeY As Single )
Declare Sub FeedPixels( Byval x As Integer, Byval y As Integer, Byval col As Integer)

Declare Sub InitializeExample()
Declare Sub RunExample()

Declare Function KeyHit( ByVal KeyChar As Integer ) As Integer

InitializeExample()
RunExample()
PTC_Close()
End


Sub DrawImageResized( ByVal PosX As Single, ByVal PosY As Single, ByVal SizeX As Single, ByVal SizeY As Single )
   
    Dim col
    Dim As Single x,y
    Dim As Single xx,yy
   
    For y=0 to ImageW-1
        For x=0 to ImageH-1
           
            Col=ImageData(x,y)
           
            For yy=0 To SizeY-1
                For xx=0 To SizeX-1
           
                    FeedPixels( (x*SizeX)+(PosX-xx),(y*SizeY)+(PosY-yy),Col)
                   
                Next
            Next
           
        Next
    Next

End sub


Sub FeedPixels( Byval x As Integer, Byval y As Integer, Byval col As Integer)
       
    If X>0 and X<XRES-1 and Y>0 and Y<YRES-1 Then
        ScreenBuffer(Y * XRES + X) = col
    End If

End Sub


Sub InitializeExample()
   
    Dim x,y
   
    If( ptc_open( "Image Resizer Example", XRES, YRES ) = 0 ) Then
End -1                                   
End If
   
    '
    ' Create test image.
    '
    ImageW=32 : ImageH=32
   
    For y=0 To ImageH-1
        For x=0 To ImageW-1
           
            ImageData(x,y)=&HFF00FF
           
        Next
    Next
   
End Sub


Sub RunExample()

    Dim As Integer SizeX1, SizeY1
    Dim As Single  SizeX2, SizeY2
   
    While KeyHit(27)<>TRUE
       
        SizeX1=2
        SizeY1=3
       
        SizeX2=2.25
        SizeY2=3.75
       
        DrawImageResized(050,050,SizeX1,SizeY1)
        DrawImageResized(150,050,SizeX2,SizeY2)

        PTC_Update @ScreenBuffer(0)
        Erase ScreenBuffer
       
    Wend
   
End Sub


Function KeyHit( ByVal KeyChar As Integer ) As Integer

    If (GetAsyncKeyState(KeyChar) AND 32768) Then
        Return True
    Else
        Return False
    End if

End Function

Cheers and huge thanks for your help,
Clyde.

[ninogenio]

hiya clyde the problem is that your going to have to integerize at some point so try this out.

the way i would like it done is in scanlines with each scanline interpolated by x amount  dependant on the rect width so you would have something like.

interpole = image_width / size_x

for x = 0 to size_x
       buffer(x+y*screenx) = image(u+v*screenx)
       u += interpole
next

and youd have something similar for the v coord

have a look at this exmple i did for rdc it should give you a better idea of what im on about.

http://dbfinteractive.com/index.php?topic=1199.0

Code: [Select]

Sub DrawImageResized( ByVal PosX As Single, ByVal PosY As Single, ByVal SizeX As Single, ByVal SizeY As Single )
   
    Dim col
    Dim As Single x,y
    Dim As Single xx,yy
   
    For y=0 to ImageW-1
        For x=0 to ImageH-1
           
            Col=ImageData(x,y)
           
            For yy=0 To SizeY-1
                For xx=0 To SizeX-1
           
                    FeedPixels( int(x)*int(SizeX)+int(PosX)-int(xx),int(y)*int(SizeY)+int(PosY)-int(yy),Col)
                   
                Next
            Next
           
        Next
    Next

End sub


[rdc]

I ran this through Insight and the problem appears to be the rounding occurring in the FeePixels routines. You are passing a float value to an integer value (x and y parms of FeedPixels) and the value is being rounded on the implicit conversion to an integer. For example 155.75 will round to 156. Stepping through the program you can the x, y value jump at times when the rounding occurs.

I think that is the problem, but I am not sure of a solution.

Heh. Too slow.

[Clyde]

Thanks Nino and RDC.

Allthough I am still stuck and in a pickle, as I am using Dim ImageData(Width,Height), and am unsure on how to implement interpolating ( have never dealt with them before ). And with converting to integers, isnt what Im hoping to achieve and have a scaled image in floats.

Cheers,
Clyde.

[ninogenio]

right nps mate where exactly is this routine going ie are you planing on texturing an image onto the quad and resize to whatever size the quad is.

because thats no problem ill take you through it and show you how to interpolate.

[Clyde]

Thanks dude. its not being used on 3D models or anything like that dude. Its just for Scaling & Drawing 2D images with, and using Data(x,y)=Col, in a tinyptc environment.

[ninogenio]

no problem mate i find that affine interpolating in a 2d way is very fast and effective at sprite bliting and resizing gime a few hours and ill be back but thats only if you wish i dont want to jump in and take over or anything mate

<edit is it 2d images you want to work with or solid blocks of color>

[Clyde]

If you could super mate and thankyou; my attempt could be the wrong way of resizing 2D imagery. I'd like it to still use the old ways of a 2 dimensional array if thats possible.

Cheers and many thanks,
Clyde.

[Stonemonkey]

Hi clyde, it's happening because the yy and xx loops are counting up in 1's so when the size value is 3.75 it will only count up to 3.

EDIT: I think!

[ninogenio]

here you go mate this is how i would personally do it but its up to you it was pu together very quickly but itll give you an idea of what im going on about.

[Clyde]

Nice one and cheers Nino I'll check it out.
@StoneMonkey: I'll try the for loops as single.

[ninogenio]

hey clyde that last code post of mine was a bit of a rough draft this one should be a fair bit quicker and eisyer to look at as there was a lot of unecessary stuff in there if theres anything your unshure about just give me shout 

Code: [Select]

'
' Resize Image Routine in Freebasic and TinyPTC.
' By Clyde Sometime And In A Distant Land In January '07
'

Option Explicit
Option Static

#Include Once "tinyptc.bi"
#Include Once "windows.bi"
#include once "bmpload.bi"
#Include Once "crt.bi"


Type Sprite_Inf

     x as single
     y as single
     iu as single
     iv as single
     u as single
     v as single
     Width as single
     Height as single
     ScanW as single

End Type


Const XRES=640
Const YRES=480

Const XRES2=XRES/2
Const YRES2=YRES/2

Const ARES=XRES*YRES

Dim Shared ScreenBuffer(ARES)

Declare Sub DrawImageResized( ByVal PosX As Single, ByVal PosY As Single, ByVal SizeX As Single, ByVal SizeY As Single )
Declare Sub Image_Scan( byval S as Sprite_Inf )

Declare Sub FeedPixels( Byval x As Integer , Byval y As Integer , Byval col As Integer )

Declare Sub InitializeExample()
Declare Sub RunExample()
                             
declare sub Load_Image( byval GraphicLocation as string , Image as BITMAP_RGBImageRecR ptr )
declare sub Free_Image( image as BITMAP_RGBImageRecR ptr )

Declare Function KeyHit( ByVal KeyChar As Integer ) As Integer

dim shared graphic as BITMAP_RGBImageRecR ptr
Load_Image( "graphic.bmp" , graphic )

Dim Shared ImageData(graphic->sizex,graphic->sizey)

Dim Shared ImageW
Dim Shared ImageH

InitializeExample()

Free_Image( graphic )

RunExample()
PTC_Close()
End



Sub DrawImageResized( ByVal PosX As Single, ByVal PosY As Single, ByVal SizeX As Single, ByVal SizeY As Single )
   
    dim as integer y
    dim as single Ly , Lx

    dim as Sprite_Inf S
   
    S.y = posy + sizey + 3

    S.Width = ImageW
    S.Height = ImageH

    Ly = int(S.y) - int(posy)

    If Ly <= 0 Then Exit Sub

    S.Iv = S.Height / Ly

    S.y = posy
    S.x = posx + sizex

    Lx = int(S.x) - int(posx)

    If Lx <= 0 Then Exit Sub
       
    S.Iu = S.Width / Lx

    S.x = posx
    S.ScanW = Lx

    for y = 0 to sizey       

        S.y += 1
        S.v += S.Iv

        Image_Scan( S )

    next

end sub



sub Image_Scan( byval S as Sprite_Inf )
       
        dim as integer col
       
        while( S.ScanW >= 0 )

               col = ImageData(int(S.u),int(S.v))
               feedpixels( S.x , S.y , col )
               
               S.u += S.Iu

               S.ScanW -= 1
               S.x += 1

        wend

end sub



Sub FeedPixels( Byval x As Integer, Byval y As Integer, Byval col As Integer)
       
    If X>0 and X<XRES-1 and Y>0 and Y<YRES-1 Then
        ScreenBuffer(Y * XRES + X) = col
    End If

End Sub



Sub InitializeExample()
   
    Dim x,y
   
    If( ptc_open( "Image Resizer Example", XRES, YRES ) = 0 ) Then
End -1                                   
End If
   
    '
    ' Create test image.
    '
    ImageW=graphic->sizex : ImageH=graphic->sizey
   
    For y=0 To ImageH-1
        For x=0 To ImageW-1
           
            ImageData(x,y)=graphic->integer_buffer[x+y*ImageW]
           
        Next
    Next
   
End Sub



Sub RunExample()

    Dim As Integer SizeX1, SizeY1
    Dim As Single  SizeX2, SizeY2
   
    While KeyHit(27)<>TRUE
       
        SizeX1=422
        SizeY1=323
       
        SizeX2=122.25
        SizeY2=103.75
       
        DrawImageResized(050,050,SizeX1,SizeY1)
        DrawImageResized(150,050,SizeX2,SizeY2)

        PTC_Update @ScreenBuffer(0)
        Erase ScreenBuffer
       
    Wend
   
End Sub



Function KeyHit( ByVal KeyChar As Integer ) As Integer

    If (GetAsyncKeyState(KeyChar) AND 32768) Then
        Return True
    Else
        Return False
    End if

End Function



sub Load_Image( byval GraphicLocation as string , Image as BITMAP_RGBImageRecR ptr )
   
    Image = LoadBmp( GraphicLocation )
       
end sub



sub Free_Image( image as BITMAP_RGBImageRecR ptr )
   
    if image then                       
             if image->byte_buffer then                 
                    deallocate(image->byte_buffer)           
             end if
             if image->integer_buffer then                 
                    deallocate(image->integer_buffer)           
             end if
             deallocate(image)                     
    end if
   
end sub
<edit heres a quick test with shockwaves delta timing just to make shure it works with floats>

Code: [Select]

'
' Resize Image Routine in Freebasic and TinyPTC.
' By Clyde Sometime And In A Distant Land In January '07
'

Option Explicit
Option Static

#Include Once "tinyptc.bi"
#Include Once "windows.bi"
#include once "bmpload.bi"
#Include Once "crt.bi"


Type Sprite_Inf

     x as single
     y as single
     iu as single
     iv as single
     u as single
     v as single
     Width as single
     Height as single
     ScanW as single

End Type


Const XRES=640
Const YRES=480

Const XRES2=XRES/2
Const YRES2=YRES/2

Const ARES=XRES*YRES

Dim Shared ScreenBuffer(ARES)

Declare Sub DrawImageResized( ByVal PosX As Single, ByVal PosY As Single, ByVal SizeX As Single, ByVal SizeY As Single )
Declare Sub Image_Scan( byval S as Sprite_Inf )

Declare Sub FeedPixels( Byval x As Integer , Byval y As Integer , Byval col As Integer )

Declare Sub InitializeExample()
Declare Sub RunExample()
                             
declare sub Load_Image( byval GraphicLocation as string , Image as BITMAP_RGBImageRecR ptr )
declare sub Free_Image( image as BITMAP_RGBImageRecR ptr )

declare sub delta()

Declare Function KeyHit( ByVal KeyChar As Integer ) As Integer

dim shared graphic as BITMAP_RGBImageRecR ptr
Load_Image( "graphic.bmp" , graphic )

Dim Shared ImageData(graphic->sizex,graphic->sizey)

Dim Shared ImageW
Dim Shared ImageH

InitializeExample()

Free_Image( graphic )

RunExample()
PTC_Close()
End



Sub DrawImageResized( ByVal PosX As Single, ByVal PosY As Single, ByVal SizeX As Single, ByVal SizeY As Single )
   
    dim as integer y
    dim as single Ly , Lx

    dim as Sprite_Inf S
   
    S.y = posy + sizey + 3

    S.Width = ImageW
    S.Height = ImageH

    Ly = S.y - posy

    If Ly <= 0 Then Exit Sub

    S.Iv = S.Height / Ly

    S.y = posy
    S.x = posx + sizex

    Lx = S.x - posx

    If Lx <= 0 Then Exit Sub
       
    S.Iu = S.Width / Lx

    S.x = posx
    S.ScanW = Lx

    for y = 0 to sizey       

        S.y += 1
        S.v += S.Iv

        Image_Scan( S )

    next

end sub



sub Image_Scan( byval S as Sprite_Inf )
       
        dim as integer col
       
        while( S.ScanW >= 0 )

               col = ImageData(int(S.u),int(S.v))
               feedpixels( S.x , S.y , col )
               
               S.u += S.Iu

               S.ScanW -= 1
               S.x += 1

        wend

end sub



Sub FeedPixels( Byval x As Integer, Byval y As Integer, Byval col As Integer)
       
    If X>0 and X<XRES-1 and Y>0 and Y<YRES-1 Then
        ScreenBuffer(Y * XRES + X) = col
    End If

End Sub



Sub InitializeExample()
   
    Dim x,y
   
    If( ptc_open( "Image Resizer Example", XRES, YRES ) = 0 ) Then
End -1                                   
End If
   
    '
    ' Create test image.
    '
    ImageW=graphic->sizex : ImageH=graphic->sizey
   
    For y=0 To ImageH-1
        For x=0 To ImageW-1
           
            ImageData(x,y)=graphic->integer_buffer[x+y*ImageW]
           
        Next
    Next
   
End Sub


dim shared as single size=1 , amount=5.7
dim shared as double m ,oldtime,newtime
dim shared ticks as integer

Sub RunExample()
   
    While KeyHit(27)<>TRUE

        DrawImageResized(050,050,size*2,size*3)
        DrawImageResized(150,050,Size*5,Size*4)

        PTC_Update @ScreenBuffer(0)

        ticks += 1
        delta()

        size += amount / newtime
        if size >= 100 then amount =- amount
        if size <= 1 then amount =- amount

        memset( @ScreenBuffer(0) , 0 , ARES*sizeof(Integer) )
       
    Wend
   
End Sub



sub delta()
   
    dim lpt as integer
    dim tst as string
    dim as double bb
    bb = timer
    if  bb-oldtime >=.2 then
        oldtime=timer
        newtime = ticks               
        newtime = newtime + 1
        ticks = 0
    end if
   
end sub



Function KeyHit( ByVal KeyChar As Integer ) As Integer

    If (GetAsyncKeyState(KeyChar) AND 32768) Then
        Return True
    Else
        Return False
    End if

End Function



sub Load_Image( byval GraphicLocation as string , Image as BITMAP_RGBImageRecR ptr )
   
    Image = LoadBmp( GraphicLocation )
       
end sub



sub Free_Image( image as BITMAP_RGBImageRecR ptr )
   
    if image then                       
             if image->byte_buffer then                 
                    deallocate(image->byte_buffer)           
             end if
             if image->integer_buffer then                 
                    deallocate(image->integer_buffer)           
             end if
             deallocate(image)                     
    end if
   
end sub

[Shockwave]

You could look here too..

*TOPIC*

The source I released here has some real time scaling of a rect. That's how the scroll zoom works

[ninogenio]

do you do your scaling difrent from me nick? ive not looked at the source btw.

the way ive done it was really the only way i could think of but it would be intresting to know of some other ways possibly quicker.

[Shockwave]

Probably have done it different, but to be honest I haven't looked at your source either!

Just thinking that maybe there might be something in there that Clyde could chop up for his own use.

[ninogenio]

ahh right no probs mate ill flick through your source tomorow im always intrested in finding out new ways of doing stuff cheers

[Clyde]

Cheers all you've been a real help and many thanks.