sRGB delta map

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

sRGB delta map

Post by dafhi »

Code: Select all

/' 
    sRGB image pair delta - 2021 Feb 27 - by dafhi
  
  envisioned for progressive refinement rendering applications
  
  class tImagePair
    sRGBpair( x, y).col( page_0_or_1 )
    
    delta map .out() with, in rare cases, low granularity.  simply uncomment
    "def best_granularity" before tImagePair for fuller results.


  - update -
  
  - removed tImagePair._resize_out,
    redim out() placed in .assign_dims
  + .assign_dims logic simplified
'/



' -- hacks ---------------
#undef int

#define int     as integer
#define sng     as single

#define decl    declare
#define csr     constructor

#define ac      as const
' ----- hacks --
  

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

#define min( a, b) iif( (a)<(b), (a), (b) )
#define max( a, b) iif( (a)>(b), (a), (b) )

function clamp( in sng, hi sng = 1, lo sng = 0) sng
  return min( max( lo, in), hi)
End Function
  
Const GrayscaleRGB = 65536 + 256 + 1



type sRGB
  sng         a, b, c
End Type

operator +( l ac sRGB, r ac sRGB) ac sRGB
  return type( l.a+r.a, l.b+r.b, l.c+r.c):  end operator


Type sRGB_sum
  declare operator  Cast ac ULong '' ac = as const
  as sRGB           sum
  sng               iter
End Type

operator sRGB_sum.Cast ac ulong
  Static sng m:  m = 255.5 / iter
    Return RGB( _
  clamp( sum.a*m, 255.499), _
  clamp( sum.b*m, 255.499), _
  clamp( sum.c*m, 255.499) )
End operator


operator +( l ac sRGB_sum, r ac sRGB_sum) ac sRGB_sum
  return type<sRGB_sum>( l.sum+r.sum, l.iter+r.iter):  end operator



Type SRGB_pair
  As sRGB_sum     col(1)
  decl property   dcol_squared int
End Type

property SRGB_pair.dcol_squared int
  static as ulong a:  a = col(0)
  static as ulong b:  b = col(1)
  Static Int x:  x = (a And 255) - (b And 255)
  Static Int y:  y = ((a Shr 8) And 255) - ((b Shr 8) And 255)
  Static Int z:  z = ((a Shr 16) And 255) - ((b Shr 16) And 255)
  Return x*x + y*y + z*z
End property



'' uncomment, at performance cost
'#define best_granularity

Type tImagePair
  int               w, h, page
  As UByte          out( any, any)
  As SRGB_pair      sRGBpair( any, any)
  
  decl Sub          write_alphas '' granularity as a side-effect happens here
  decl Sub          show( int = 0, int = 0, as any ptr = 0)
  decl Sub          assign_dims( Int = 0, Int = 0)
  decl Sub          test_pattern( _
                      sng=0, sng=0, sng=0, _
                      sng=0, sng=0, sng=0, _
                      sng=0, sng=0, sng=0)
    Private:
  decl property     _find_rgb_max int
  as SRGB_pair ptr  _p_sRGBp
  as ubyte ptr      _p_out
End Type


property tImagePair._find_rgb_max int
  const scale_to_ubyte sng = 255.499 / ( 3 * 255 * 255)
  var   found_max = 0
  
  For i Int = 0 To w*h-1
    
    #ifdef best_granularity
      '' best granularity
      found_max   = max( _p_sRGBp[i].dcol_squared, found_max)
    #else
      '' higher (but rare) chance for low granularity 
      _p_out[i]   = scale_to_ubyte * _p_sRGBp[i].dcol_squared
      found_max   = max( _p_out[i], found_max)
    #endif
  
  Next:  return found_max
End property


sub tImagePair.write_alphas
  var scalar = 255.499 / _find_rgb_max
  For i Int = 0 To w*h-1
    #ifdef best_granularity
      _p_out[i] = _p_sRGBp[i].dcol_squared * scalar
    #else
      _p_out[i] *= scalar
    #endif
  next
End Sub


Sub tImagePair.show( offx int, offy int, im as any ptr)
  write_alphas
  For y Int = 0 To h-1
    For x Int = 0 To w-1
      PSet im, (x + offx, y + offy), out(x,y) * GrayscaleRGB
    Next
  Next
End Sub


Sub tImagePair.assign_dims( _w Int, _h Int)
  var new_w = (_w > 0 and _w <> w) or w < 1
  var new_h = (_h > 0 and _h <> h) or h < 1
  if not (new_w or new_h) then exit sub
  w = _w
  h = _h
  if w < 1 andalso h < 1 then w = 400:  h = 400
  ReDim sRGBpair( w-1, h-1):  _p_sRGBp = @sRGBpair(0,0)
  redim out( w-1, h-1):  _p_out = @out(0,0)
  page = 0
End Sub


Sub tImagePair.test_pattern( _
    red_x sng, red_y sng, red_rnd sng, _
    grn_x sng, grn_y sng, grn_rnd sng, _
    blu_x sng, blu_y sng, blu_rnd sng)
 
  assign_dims
  
  static sng iter:  iter = 1
  static sng ix:  ix = 1 / w
  static sng iy:  iy = 1 / h
 
  var _page = page and 1
  
  For y Int = 0 To h-1
    var sy = y * iy
    
    For x int = 0 To w-1
      var sx = x * ix
      
      var red = red_x*sx + red_y*sy + red_rnd*rnd
      var grn = grn_x*sx + grn_y*sy + grn_rnd*rnd
      var blu = blu_x*sx + blu_y*sy + blu_rnd*rnd
      
      sRGBpair(x,y).col(_page) += _
        type<sRGB_sum>(red, grn, blu, iter)
    
    Next
  Next
  
  page = 1 - page

End Sub


var w = 800
var h = 600

screenres w, h, 32

Dim As tImagePair ip

var red_x = 1
var grn_y = 1
var blu_rand = 0


ip.test_pattern _ '' flips internal "page" variable but you can set it yourself
  red_x,0,0, _
  0,grn_y,0, _
  0,0,blu_rand

ip.test_pattern _
  0,0,0, _
  0,0,0, _
  0,0,0

ip.show 10, 10

sleep
Post Reply