sub-pixel NN blit

[dafhi]

Nearest Neighbor ;)

Code: Select all

/' -- sub-pixel nearest-neighbor blit - 2018 Aug 17 update 2 - by dafhi --

  a quality nearest-neighbor blit
  - update 2018 Aug 25 - fixed an issue with my imagevars class. (commented)
 
    options:
  1. transparency
  2. mirror mode via negative w or h
 
    about the code:
  1. relatively short
  2. efficient - clipping is calculated prior to the loop
   
  Scroll down to Main() to see how easy blit calls are,
  and when you're ready for some excitement, have a look in imagevars.blit.
   
  The imagevars udt is "just" a wrapper I use for many projects.

  License:
 
  Use and abuse. (Relsoft license)
 
'/

type myint as integer
type float as single

#Ifndef floor   '' http://www.freebasic.net/forum/viewtopic.php?p=118633
#Define floor(x) (((x)*2.0-0.5)shr 1)
#define ceil(x) (-((-(x)*2.0-0.5)shr 1))
  #EndIf

#Macro Alpha256(ret,back, fore, a256) '2017 Mar 26
  ret=((_
  (fore And &Hff00ff) * a256 + _
  (back And &Hff00ff) * (256-a256) + &H800080) And &Hff00ff00 Or (_
  (fore And &H00ff00) * a256 + _
  (back And &H00ff00) * (256-a256) + &H008000) And &H00ff0000) Shr 8
#EndMacro

type imagevars            ' 2018 Aug 16 - by dafhi
    '1. encapsulate standard metrics
    '2. convenient additional vars, subs and functions
    '3. quick reference for ScreenInfo & ImageInfo
    as myint              w,h,bpp,bypp,pitch,rate, num_pages, flags
    as string             driver_name
    as any ptr            im, pixels
    as ulong ptr          p32
    as myint              wm, hm, ub, pitchBy
    as single             wh, hh, diagonal, scale
    declare sub           get_info(as any ptr=0)
    declare sub           blit(byref as imagevars ptr, as float=0, as float=0, _
                                                       as float=0, as float=0, as boolean = false)
    declare sub           release
    declare constructor   (as any ptr=0)
    declare               destructor
   private:
    as float              x0, x1, xsteps, xs, x0s '' blit
    as myint              ix0, ix1, istepx
    as myint              iy0, iy1, istepy, ialpha
    as float              y0, y1, ysteps, y0s
    as ulong ptr          ps, pd
end type

Destructor.imagevars:  release
End Destructor

Sub imagevars.release
  If ImageInfo(im) = 0 Then ImageDestroy im
  im = 0
End Sub

constructor.imagevars(im as any ptr)
  'if im=0 then get_info:  exit constructor  ' 2018 Aug 25
  if im=0 then exit constructor              '
  
  if ImageInfo(im) = 0 then get_info im
end constructor

sub imagevars.get_info(im as any ptr)
    release
    if im=0 then:  pixels=screenptr
      ScreenInfo w,h, bpp,, pitch, rate, driver_name:  bypp=bpp\8 '2018 Jan 9
    elseif Imageinfo(im)=0 then
      ImageInfo im, w, h, bypp, pitch, pixels
      bpp = bypp * 8:  this.im = im
    endif:  pitchBy=pitch\bypp:  p32=pixels:  ub = w*h-1
    wm=w-1: wh=w/2
    hm=h-1: hh=h/2
    diagonal = sqr(wm*wm+hm*hm)
    scale = sqr(wm*wm+hm*hm) / sqr(.5) / 2 '' 2018 Aug 16
end sub

sub imagevars.blit(byref des as imagevars ptr, _x as float, _y as float, _w as float, _h as float, transparent as boolean)
    if _w=0 orelse _h=0 then exit sub
   
    ' Vars all float unless 'i' prefix
    ' image source denoted with suffix 's'
   
    #macro clip(f0, f1, i0, i1, _f, _wh, des_wh, steps, whs, istep, src0)
      istep = 1 + 2*(_wh<0)
      steps = whs / _wh
      f1 = _f + _wh
      if istep > 0 then
        f0 = _f + _f * (_f<0)               'if f0 < 0 then f0 = 0
        f1 += (f1-(des_wh)) * (f1>(des_wh)) 'if f1 > whm then f1 = whm
      else
        f0 = _f + (_f-(des_wh)) * (_f>(des_wh))
        f1 += f1 * (f1<0)
      endif
      i0 = floor( f0 + istep/2 )
      i1 = floor( f1 - istep/2 )
      src0 = (i0 +.5- _f) * steps
      steps *= istep                        'abs()
    #endmacro
   
    clip(x0, x1, ix0, ix1, _x, _w, des->w, xsteps, this.w, istepx, x0s)
    clip(y0, y1, iy0, iy1, _y, _h, des->h, ysteps, this.h, istepy, y0s)
    pd = des->p32 + iy0 * des->pitchBy      'pitch \ bypp
    x0s -= .5
    if transparent then
      for iy as myint = iy0 to iy1 step istepy
        ps = p32 + floor(y0s) * this.pitchBy
        pd = des->p32 + iy * des->pitchBy
        xs = x0s
        for ix as myint = ix0 to ix1 step istepx
          ialpha = 1 + ps[xs]shr 24
          alpha256(pd[ix], pd[ix], ps[xs], ialpha)
          xs += xsteps
        next:  y0s += ysteps
      next
    else
      for iy as myint = iy0 to iy1 step istepy
        ps = p32 + floor(y0s) * this.pitchBy
        pd = des->p32 + iy * des->pitchBy
        xs = x0s
        for ix as myint = ix0 to ix1 step istepx
          pd[ix] = ps[xs]
          xs += xsteps
        next:  y0s += ysteps
      next
    endif
End Sub
' -----------------


' -- backdrop
'
type v3
    as single         x,y,z
    declare operator  cast as ulong
end type
operator v3.cast as ulong
  return rgb( floor(255.999*x), floor(255.999*y), floor(255.999*z) )
End Operator

function clamp(in as single, hi as single=1, lo as single=0) as single
  if in < lo then return lo
  if in > hi then return hi
  return in
End Function

function hsv(h as single, s as single, v as single) as v3
    h -= 6*int(h/6)
    var x = clamp(2 - h - 2*(h-3)*(h>3))
    var y = clamp(h +     2*(h-2)*(h>2))
    var z = clamp(h - 2 + 2*(h-4)*(h>4))
    var lo=@x, mi=@y, hi=@z
    if *lo > *mi then swap lo, mi
    if *mi > *hi then swap mi, hi
    if *lo > *hi then swap lo, hi
    *lo = v * (*hi - s * (*hi - *lo))
    *mi = v * (*hi - s * (*hi - *mi))
    *hi *= v
    return type(x,y,z)
End function

sub background(byref buf as imagevars ptr)
    for y as long = 0 to buf->hm
      for x as long = 0 to buf->wm
        buf->p32[y*buf->pitchBy + x] = hsv(1 + y/buf->hm + x/buf->wm, .25, .8)
      Next
    Next
End Sub


'' https://www.freebasic.net/forum/viewtopic.php?f=17&t=19095&start=375#p248261
function prov_rnd as double
    static as ulong ms_state:  ms_state=214013*((ms_state+2531011)shr 1)
    return ms_state/culng(-1)
End Function


#ifndef pi
const   TwoPi = 8*atn(1)
const   Pi = 4*atn(1)
#EndIf

type sinevars
    as single             a=rnd*6.28, i = .0005 * (.05 + rnd)
    as single             bas = 0.5, scale = .5
    declare operator      cast as single
    declare sub           quick(as float=10)
end type
operator sinevars.cast as single
    a += i:  a-=twopi*int(a/twopi)
    return bas + scale * sin(a)
end operator
sub sinevars.quick(_bas as float): bas = _bas
    scale = bas / 2
End Sub


sub Main
   
    #undef rnd
    #define rnd prov_rnd
 
    dim as imagevars  buf, bg, im
   
    screenres 640, 480, 32
    buf.get_info
   
    bg.get_info imagecreate(buf.w, buf.h)
    background @bg
   
    im.get_info imagecreate(120,90, rgba(0,0,0,0))
    for y as long = 0 to 2999
      #define r255 rnd*256 - .5
      pset im.im, (rnd*im.wm, rnd*im.hm), rgb(r255,r255,r255)
      if rnd < .01 then line im.im, (rnd*im.w, rnd*im.h)-(rnd*im.w, rnd*im.h), rgb(r255,r255,r255)
    next

    dim as sinevars x,y,w,h
   
    x.quick buf.wh 
    y.quick buf.hh
    w.bas = 0:  w.scale = im.w * 3
    h.bas = 0:  h.scale = im.h * 3
   
    var transparent = true
   
    var t1 = timer + 30
    while timer < t1
      screenlock
        bg.blit @buf, 0,0, bg.w, bg.h
        im.blit @buf, x,y, w,h, transparent
      screenunlock
      sleep 1
      if inkey<>"" then exit sub
    wend
 
    sleep 2000

end sub

Main

[angros47]

It would be more understandable, I think, if you wrote a little intro about what this code will do, and why

[BasicCoder2]

What does this do with nothing between the statements?

Code: Select all

      screenlock
      screenunlock

I noticed it is required as otherwise there is only the top 1/3 filled with a color.
What I can make out is an image of lines is drawn and then copied to the display at random sizes.
Commenting the code I think would make it more valuable as a Tip and Trick contribution to beginners.

[paul doe]

What does this do with nothing between the statements?

Code: Select all

      screenlock
      screenunlock

@dafhi: While this does force a refresh of the screen, you can end up with 'garbage' on the screen if another routine also accesses the screen pointer (either for reading or writing), since you can never be actually sure in which order the operations arrive unless you acquire the lock.

@BasicCoder2: it's kind of a (risky) 'shortcut' to update the screen after you've accessed it directly (via screenPtr() ).

What I can make out is an image of lines is drawn and then copied to the display at random sizes.
Commenting the code I think would make it more valuable as a Tip and Trick contribution to beginners.

Here's the algorithm, written for clarity, and commented a little for a better understanding of the basic principle:

Code: Select all

sub drawScaledImageNN( _
  byval anImage as fb.image ptr, _
  byval x as integer, byval y as integer, _
  byval newWidth as integer, byval newHeight as integer )
  /'
    Draws a scaled image using Nearest-Neighbor interpolation
    
    First compute the sampling ratios. Each pixel in the source
    image will be sampled (read) at this interval. So, if you
    have an image of, say, 150x150 pixels, and you draw it at a
    size of 400x400 pixels, the sampling ratios would be:
    
    150 / 400 = 0.375
    
    That is, each pixel of the original image will be sampled at
    every 0.375 pixels.
    Note that the ratios can be different for each axis, which
    'stretches' the image.
  '/
  dim as single sampleX = anImage->width /( newWidth - 1 )
  dim as single sampleY = anImage->height / ( newHeight - 1 )
  
  /'
    And then, the image is simply drawn with the new width and
    height, using the color that is determined by the ratios.
  '/
  for row as integer = 0 to newHeight - 1
    for column as integer = 0 to newWidth - 1
      pset( x + column, y + row ), _
        point( sampleX * column, sampleY * row, anImage )
    next
  next
end sub

See also this resource. It contains a nice explanation, along with some easy to understand code.

EDIT: Small correction to give better results. Thanks to dodicat for noticing this.

[dafhi]

What does this do with nothing between the statements?

Code: Select all

      screenlock
      screenunlock

@dafhi: While this does force a refresh of the screen, you can end up with 'garbage' on the screen if another routine also accesses the screen pointer (either for reading or writing), since you can never be actually sure in which order the operations arrive unless you acquire the lock.

Statistically speaking, it's probably better to just have the refresh. I pepper my code with out-of-the-box thinking. Tips and Tricks I consider above beginner. One last bit about that lock / unlock sequence .. I only use it for still images. But when I'm debugging I"ll use it for animation because you can't see print statements (maybe there's a debug print that circumvents) with a surface lock.

[dodicat]

Paul Doe.
Could you repair your model slightly.
Press any key to refresh, esc to end.

Code: Select all

Function resize(im As Any Ptr,Wdth As Single,Hght As Single) As Any Ptr
    Dim As Integer iw,ih,imx,imy
    Imageinfo im,iw,ih
    Dim As Any Ptr OutImage=Imagecreate(Wdth,Hght)
    For y As Long=0 To Hght-1
        imy= ih*y\(Hght-1)
        For x As Long=0 To Wdth-1
            imx= iw*x\(Wdth-1)
            Pset OutImage,(x,y),Point(imx,imy,im)
        Next x
    Next y
    Return OutImage
End Function

#include "fbgfx.bi"
Sub drawScaledImageNN( _
    Byval anImage As fb.image Ptr, _
    Byval x As Integer, Byval y As Integer, _
    Byval newWidth As Integer, Byval newHeight As Integer )
    /'
    Draws a scaled image Using Nearest-Neighbor interpolation
    
    First compute the sampling ratios. Each pixel in the source
    image will be sampled (Read) at This interval. So, If you
    have an image of, say, 150x150 pixels, And you Draw it at a
    size of 400x400 pixels, the sampling ratios would be:
    
    150 / 400 = 0.375
    
    That Is, each pixel of the original image will be sampled at
    every 0.375 pixels.
    Note that the ratios can be different For each axis, which
    'stretches' the image.
    '/
    Dim As Single sampleX = anImage->Width / newWidth
    Dim As Single sampleY = anImage->height / newHeight
    
    /'
    And Then, the image Is simply drawn With the New Width And
    height, Using the Color that Is determined by the ratios.
    '/
    For row As Integer = 0 To newHeight - 1
        For column As Integer = 0 To newWidth - 1
            Pset( x + column, y + row ), _
            Point( sampleX * column, sampleY * row, anImage )
        Next
    Next
End Sub

Screenres 1000,600,32
Width 1000\8,600\16
Do
    Cls
    Print "test image"+ String(50," ")+ "Paul Doe"+String(30," ")+"dodicat"
    Dim As Long w=200+Rnd*100-Rnd*100
    Dim As Long h=300+Rnd*200-Rnd*200
    Dim As Any Ptr im=Imagecreate(w,h,0)
    For n As Long=1 To 50
        Line im,(Rnd*w,Rnd*h)-(Rnd*w,Rnd*h),Rgb(Rnd*255,Rnd*255,Rnd*255)
        Circle im,(Rnd*w,Rnd*h),2+Rnd*5,Rgb(Rnd*255,Rnd*255,Rnd*255),,,,f
    Next
    Line im,(0,0)-(w-1,h-1),Rgb(255,255,255),b
    Put(5,20),im,Pset
    
    Dim As Long dy=Rnd*200-Rnd*200
    drawScaledImageNN(im,350,20,300,300+dy)
    
    Var ni=resize(im,300,300+dy)
    Put(680,20),ni,trans
    Sleep
    Imagedestroy ni
    Imagedestroy im
Loop Until Inkey=Chr(27)


  

[paul doe]

Paul Doe.
Could you repair your model slightly.

Yes. Done already (slight rounding error).

Statistically speaking, it's probably better to just have the refresh. I pepper my code with out-of-the-box thinking. Tips and Tricks I consider above beginner. One last bit about that lock / unlock sequence .. I only use it for still images. But when I'm debugging I"ll use it for animation because you can't see print statements (maybe there's a debug print that circumvents) with a surface lock.

You'll see what I mean soon enough =D

As for the print issue, you can log out to console:

Code: Select all

sub logDebugString( byref aString as const string )
  dim as long handle = freeFile()
  
  open cons for output as #handle
    ? #handle, aString
  close( handle )
end sub

This is also handy when you're fooling around with OpenGL code ;)