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