Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Clyde on January 27, 2007
-
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.
'
' 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.
-
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
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
-
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.
-
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.
-
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.
-
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.
-
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>
-
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.
-
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!
-
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.
-
Nice one and cheers Nino I'll check it out.
@StoneMonkey: I'll try the for loops as single.
-
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 ;)
'
' 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>
'
' 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
-
You could look here too..
*TOPIC* (http://dbfinteractive.com/index.php?topic=1236.0)
The source I released here has some real time scaling of a rect. That's how the scroll zoom works :)
-
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.
-
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.
-
ahh right no probs mate ill flick through your source tomorow im always intrested in finding out new ways of doing stuff cheers ;)
-
Cheers all you've been a real help and many thanks.