Nearest Neighbor Image Scaling - Problem while translating a java snippet

New to FreeBASIC? Post your questions here.
Pitto
Posts: 119
Joined: Nov 19, 2012 19:58

Nearest Neighbor Image Scaling - Problem while translating a java snippet

Postby Pitto » Mar 01, 2017 15:23

Hi all,

I'm trying to translate a snippet for Nearest Neighbor Image Scaling. But I've some troubles. I receive a "segmentation violation signal" in run-time.

Here's the code I wish translate (2nd box): http://tech-algorithm.com/articles/near ... e-scaling/

Here's my implementation (see resizePixels(...) function):

Code: Select all

#include once "fbgfx.bi"
#include once "crt/string.bi"


#ifndef getPixelAddress
    #define getPixelAddress(img,row,col) cast(any ptr,img) + _
        sizeof(FB.IMAGE) + (img)->pitch * (row) + (img)->bpp * (col)
#endif

function resizePixels(   byval img as FB.Image ptr, _
                  w1 as integer, _
                  h1 as integer, _
                  w2 as integer, _
                  h2 as integer) as FB.Image ptr
                  
    dim as FB.Image ptr temp = imagecreate(w2,h2)
   
    dim x_ratio as integer = (int((w1 shl 16)/w2)) +1
    dim y_ratio as integer = (int((h1 shl 16)/h2)) +1
    dim as integer x2, y2, i, j
   
    for i = 1 to (h2)
      for j = 1 to (w2)
         x2 = ((j*x_ratio) shr 16)
            y2 = ((i*y_ratio) shr 16)
         dim as FB.Image ptr pt = getPixelAddress(img,x2,y2)
         temp[(i*w2)+j] = *pt
      next j
    next i
   
    return temp
   
end function

'bmp_load() function has been written by noop
'http://www.freebasic.net/forum/viewtopic.php?t=24586
Function bmp_load( ByRef filename As Const String ) As Any Ptr

    Dim As Long filenum, bmpwidth, bmpheight
    Dim As Any Ptr img

    '' open BMP file
    filenum = FreeFile()
    If Open( filename For Binary Access Read As #filenum ) <> 0 Then Return NULL

        '' retrieve BMP dimensions
        Get #filenum, 19, bmpwidth
        Get #filenum, 23, bmpheight

    Close #filenum

    '' create image with BMP dimensions
    img = ImageCreate( bmpwidth, Abs(bmpheight) )

    If img = NULL Then Return NULL

    '' load BMP file into image buffer
    If BLoad( filename, img ) <> 0 Then ImageDestroy( img ): Return NULL

    Return img

End Function

screenres 800, 600, 32

dim as FB.Image ptr img = bmp_load( "test.bmp" )

If img = NULL Then
    print "bmp_load failed"
else
    dim as FB.Image ptr imgs = resizePixels(img,img->width, img->height, img->width,img->height)
    if imgs then
        put (10,10),imgs,alpha
        imageDestroy(imgs)
    end if
    imageDestroy(img)
end if
sleep


Thanks in advance.
counting_pine
Site Admin
Posts: 6230
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Nearest Neighbor Image Scaling - Problem while translating a java snippet

Postby counting_pine » Mar 01, 2017 19:09

You have:

Code: Select all

dim as FB.Image ptr pt = getPixelAddress(img,x2,y2)
temp[(i*w2)+j] = *pt

But it looks like 'temp' is an image, like 'img', so shouldn't both be accessed the same way?
Maybe it needs to be:

Code: Select all

dim as FB.Image ptr pt = getPixelAddress(img,x2,y2)
*getPixelAddress(temp, j, i) = *pt

By the way, 'int1 / int2' in Java translates fairly neatly to 'int1 \ int2' in FB.
Pitto
Posts: 119
Joined: Nov 19, 2012 19:58

Re: Nearest Neighbor Image Scaling - Problem while translating a java snippet

Postby Pitto » Mar 04, 2017 21:11

Hi counting_pine,

thanks for the tips. I've fixed the code a little. Seems to work fine with 2x, 4x, 8x…
There is still a problem, the first column of pixels of the scaled image seems to be shifted up placing pixels of opposite side. See http://pasteboard.co/FuQHJewqc.gif

Could it be a pointer dimension issue?

Thanks in advance

Code: Select all

#include once "fbgfx.bi"
#include once "crt/string.bi"

#ifndef getPixelAddress
    #define getPixelAddress(img,row,col) cast(any ptr,img) + _
        sizeof(FB.IMAGE) + (img)->pitch * (row) + (img)->bpp * (col)
#endif


function resizePixels(byval img_source as FB.Image ptr, _
                  w1 as integer, _
                  h1 as integer, _
                  w2 as integer, _
                  h2 as integer) as FB.Image ptr
                 
    dim as FB.Image ptr temp = imagecreate(w2,h2)

    dim x_ratio as integer = (int((w1 shl 16)\w2)) +1
    dim y_ratio as integer = (int((h1 shl 16)\h2)) +1
   
    dim as integer x2, y2, i, j


    for i = 0 to (h2-1)
      for j = 0 to (w2-1)
         
      x2 = ((j*x_ratio) shr 16)
            y2 = ((i*y_ratio) shr 16)
           
         dim as FB.Image ptr pt = getPixelAddress(img_source,x2,y2)
         dim as FB.Image ptr a = getPixelAddress(temp,j,i)
         
         a->bpp = pt->bpp
         
      next j
    next i
   
    return temp
   
end function

Function bmp_load( ByRef filename As Const String ) As Any Ptr

    Dim As Long filenum, bmpwidth, bmpheight
    Dim As Any Ptr img

    '' open BMP file
    filenum = FreeFile()
    If Open( filename For Binary Access Read As #filenum ) <> 0 Then Return NULL

        '' retrieve BMP dimensions
        Get #filenum, 19, bmpwidth
        Get #filenum, 23, bmpheight

    Close #filenum

    '' create image with BMP dimensions
    img = ImageCreate( bmpwidth, Abs(bmpheight) )

    If img = NULL Then Return NULL

    '' load BMP file into image buffer
    If BLoad( filename, img ) <> 0 Then ImageDestroy( img ): Return NULL

    Return img

End Function

screenres 640, 480, 32

dim as FB.Image ptr img = bmp_load( "test.bmp" )

dim as integer new_w, new_h
new_w = 256
new_h = 256

If img = NULL Then
    print "bmp_load failed"
else
    dim as FB.Image ptr imgs = resizePixels(img,img->width, img->height,  new_w, new_h)
    if imgs then
        draw string (50 + img->width, 40), "original image " + str(img->width) + "*" + str(img->height)
        put (50,50),img,alpha
        draw string (50, 60 + img->height), "scaled image" + str(new_w) + "*" + str(new_h)
        put (50,70 + img->height),imgs,alpha
        imageDestroy(imgs)
    end if
    imageDestroy(img)
end if
sleep
D.J.Peters
Posts: 8189
Joined: May 28, 2005 3:28
Contact:

Re: Nearest Neighbor Image Scaling - Problem while translating a java snippet

Postby D.J.Peters » Mar 04, 2017 21:32

In my fbGFXAddon (written in FreeBASIC) you can find many fast gfx stuff may be you can learn something from it (if you like)

' graphic context
BeginFrame EndFrame setWindow getLeft getRight getTop getBottom getWidth getHeight getCenter getCenterY
setColor setRed setGreen setBlue setAlpha getColor getRed getGreen getBlue getAlpha
setFillColor setFillRed setFillGreen setFillBlue setFillAlpha getFillColor getFillRed getFillGreen getFillBlue getFillAlpha
setBoarderColor setBoarderRed setBoarderGreen setBoarderBlue setBoarderAlpha getBoarderColor getBoarderRed getBoarderGreen getBoarderBlue getBoarderAlpha
setClearColor setClearRed setClearGreen setClearBlue setClearAlpha getClearColor getClearRed getClearGreen getClearBlue getClearAlpha

' fast integer drawing
GetPixel DrawPixel FillBoundary DrawHLine DrawVLine DrawLine DrawRectangle FillRectangle DrawCircle FillCircle DrawElipse FillElipse DrawTriangle FillTriangle DrawCurve DrawArc DrawPie FillPie

' image drawing
LoadImage (bmp,pcx, jpg, tga, png, dds ...)
DrawImage (scaled,rotated,colorkey,clipped)
getImageWidth getImageHeight getImageCenter getImageCenterY

' vector drawing
BeginPoints EndPoints BeginLines EndLines BeginLineLoop EndLineLoop BeginPolygon EndPolygon BeginComplexPolygon EndComplexPolygon AddVertex AddTransformedVertex AddCurve AddArc AddPie PushMatrix PopMatrix Identiy Rotate Scale Translate AngleDegree

you can get it from here: viewtopic.php?f=14&t=25058&p=224638

Joshy

How ever here are a 32-bit (12 : 20) fixed point image scaler (8,15/16,24/32 - bit):

Code: Select all

#include "fbgfx.bi"

type FIXED as long ' 12:20

function ImageScale(byval s as fb.Image ptr, _
                    byval w as integer, _
                    byval h as integer) as fb.Image ptr
  #macro SCALELOOP()
  for ty = 0 to t->height-1
    ' address of the row
    pr=ps+(y shr 20)*sp
    x=0 ' first column
    for tx = 0 to t->width-1
      *pt=pr[x shr 20]
      pt+=1 ' next column
      x+=xs ' add xstep value
    next
    pt+=tp ' next row
    y+=ys ' add ystep value
  next
  #endmacro
  ' no source image
  if s        =0 then return 0
  ' source widh or height legal ?
  if s->width <1 then return 0
  if s->height<1 then return 0
  ' target min size ok ?
  if w<2 then w=1
  if h<2 then h=1
  ' create new scaled image
  dim as fb.Image ptr t=ImageCreate(w,h,RGB(0,0,0))
  ' x and y steps in fixed point 12:20
  dim as FIXED xs=&H100000*(s->width /t->width ) ' [x] [S]tep
  dim as FIXED ys=&H100000*(s->height/t->height) ' [y] [S]tep
  dim as integer x,y,ty,tx
  select case as const s->bpp
  case 1 ' color palette
    dim as ubyte    ptr ps=cptr(ubyte ptr,s)+32 ' [p]ixel   [s]ource
    dim as uinteger     sp=s->pitch             ' [s]ource  [p]itch
    dim as ubyte    ptr pt=cptr(ubyte ptr,t)+32 ' [p]ixel   [t]arget
    dim as uinteger     tp=t->pitch - t->width  ' [t]arget  [p]itch
    dim as ubyte    ptr pr                      ' [p]ointer [r]ow
    SCALELOOP()
  case 2 ' 15/16 bit
    dim as ushort   ptr ps=cptr(ushort ptr,s)+16
    dim as uinteger     sp=(s->pitch shr 1)
    dim as ushort   ptr pt=cptr(ushort ptr,t)+16
    dim as uinteger     tp=(t->pitch shr 1) - t->width
    dim as ushort   ptr pr
    SCALELOOP()
  case 4 ' 24/32 bit
    dim as ulong    ptr ps=cptr(uinteger ptr,s)+8
    dim as uinteger     sp=(s->pitch shr 2)
    dim as ulong    ptr pt=cptr(uinteger ptr,t)+8
    dim as uinteger     tp=(t->pitch shr 2) - t->width
    dim as ulong    ptr pr
    SCALELOOP()
  end select
  return t
  #undef SCALELOOP
end function
'
' main
'
dim as integer scr_w,scr_h
ScreenInfo scr_w,scr_h
scr_w*=0.75:scr_h=scr_w/16*9

ScreenRes scr_w,scr_h,32

' create or load an source image
const as integer img_s = 3 ' 4,5, 8,12, 64 ... <- change it
dim as fb.Image ptr  img = ImageCreate(img_s,img_s,0)
' a test pattern (checker board)
for y as integer=0 to img_s-1
  for x as integer=0 to img_s-1
    if (x and 1)=1 xor (y and 1) = 0 then
      pset img,(x,y),RGB(255,255,255)
    end if
  next
next

dim as integer os,s
dim as single w,ws=0.05
while Inkey()=""
  s=sin(w)*scr_w\3+scr_w\3+1:w+=ws
  if os<>s then
    ' create a FAST scaled version of the source image
    dim as fb.image ptr scaled=ImageScale(img,s,s)
    if scaled<>0 then
      ScreenLock : cls
        ' draw the source image in the top left corner
        put (0,0),img,PSET
        ' draw the scaled image at the center of the screen
        put (scr_w\2 - s\2,scr_h\2-s\2),scaled,PSET
      ScreenUnlock
      ' destroy the scaled image
      ImageDestroy scaled
    end if
    os=s
  end if
  sleep 20
wend
' destroy the the source image
if img then ImageDestroy img
Pitto
Posts: 119
Joined: Nov 19, 2012 19:58

Re: Nearest Neighbor Image Scaling - Problem while translating a java snippet

Postby Pitto » Mar 05, 2017 9:59

I was left speechles. Very good piece of code.
I'll study and implement it on FBB.
Thanks a lot!
Best regards
BasicCoder2
Posts: 3596
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Nearest Neighbor Image Scaling - Problem while translating a java snippet

Postby BasicCoder2 » Mar 06, 2017 0:10

Indeed. Joshy must be the most prolific writer of high quality general purpose code extensions for FreeBasic.
For some reason I wasn't conscious of fbgfxaddon.bi although I must have seen the post.
It could benefit with explanations of how to use it beyond the paucity of examples provided.
There are things I don't understand such as the use of dim as RenderContext rc. Is this some kind of screen command?
There are two main things missing from FreeBasic compared with VB, pen size and the easy loading and use of fonts.
.
D.J.Peters
Posts: 8189
Joined: May 28, 2005 3:28
Contact:

Re: Nearest Neighbor Image Scaling - Problem while translating a java snippet

Postby D.J.Peters » Mar 06, 2017 0:31

BasicCoder2 I don't like to hijack a thread next time ask in the right posting please.

How ever if you take a look in the *.bi the render context use screenres the deault values are 640 x 480 x 32 bits no fullscreen.

you can overwrite one or all default settings like this:
dim as RenderContext rc = RenderContext(800,600,16)

Joshy

Code: Select all

type RenderContext
  declare constructor(byval iWidth as integer=640, byval iHeight as integer=480, byval iBits as integer=32, byval bFullscreen as boolean=false)
 ...
end type

Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 7 guests