previous: "quality image downscaling"
Code: Select all
/' --- image scaler by dafhi - 2018 May 27 -------------------
two original scalers in a wrap
1. quick, if blit w or h > source w or h
2. quality, incorporating every source pixel
'/
'#include "general.bas"
'#include "anti-aliased-gfx-primitives/inc/base.bas"
'#include "aaline.bas"
'#include once "gmath.bas"
'#include once "imagevars.bas"
/' ------- imagevars 2018 Jan 9 - by dafhi -------- '/
type myint as integer
type imagevars '' 2018 Jan 16 - by dafhi
'1. quick reference for ScreenInfo & ImageInfo
'2. encapsulate standard metrics
'3. convenient additional vars, subs and functions
as myint w,h,bpp,bypp,pitch,rate, wm, hm, pitchBy, num_pages, flags 'helpers
as any ptr im, pixels
as ulong ptr p32
as string driver_name
declare sub get_info(im as any ptr=0)
as single wh, hh, diagonal
declare constructor (as any ptr=0)
declare sub destroy
declare destructor
end type
Destructor.imagevars: destroy
End Destructor
Sub imagevars.Destroy(): If ImageInfo(im) = 0 <> 0 Then ImageDestroy im: im = 0: endif: End Sub
constructor.imagevars(img as any ptr): if img<>0 then get_info img
end constructor
sub imagevars.get_info(im as any ptr)
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
wm=w-1: wh=w/2: diagonal = sqr(w*w+h*h)
hm=h-1: hh=h/2: p32=pixels
end sub
#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
Union UnionARGB
As Ulong col: Type: As UByte B,G,R,A: End Type
End Union
'
' ------------ imagevars.bas
#Ifndef floor
#Define floor(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
'
' ------------ gmath.bas
Type sng2D
As Single x,y
End Type
type image_scaler extends imagevars
declare function resize(byref dest as image_scaler ptr=0, x as single=0, y as single=0, w as single=0, h as single=0) as integer
private:
declare sub downscale_aascan(yDes as integer, alp as single)
Declare Sub skewRect_Render(ByRef dest As imagevars ptr, _
ByVal x As myint = 0, _
ByVal y As myint = 0, _
ByVal wid As myint = -1, _
ByVal hgt As myint = -1)
' higher quality but with grid artifact if blit w,h > source
declare sub downscale(byref dest as image_scaler ptr=0, x as single=0, y as single=0, w as single=0, h as single=0)
as imagevars ptr pdes '
as long yDes1D, ySrc1D '
as single sx, x_scal '
as single x_step, y_step
As sng2D ptA,ptB,ptC,ptD
as single sR(any), sG(any), sB(any), a(any)
as myint yDesT, yDesB
End Type
Sub image_scaler.SkewRect_Render(ByRef pDest As imagevars ptr, _
ByVal x As myint, ByVal y As myint, _
ByVal wid_ As myint, ByVal hgt_ As myint)
#Macro InterpolatePoint(dest_,from_,to_)
dest_.x = from_.x + lerp * (to_.x - from_.x)
dest_.y = from_.y + lerp * (to_.y - from_.y)
#EndMacro
#Macro LayerSource_Components(aa_mul1, aa_mul2)
aa_fractional = aa_mul1 * aa_mul2
sRed += aa_fractional * ptrSource->R
sGrn += aa_fractional * ptrSource->G
sBlu += aa_fractional * ptrSource->B
alpha_sum += aa_fractional
#EndMacro
#Macro BoundsCheckSource(aa_mul1, aa_mul2)
If srcY >= 0 andalso srcX >= 0 Then
If srcY < h andalso srcX < w Then
LayerSource_Components( aa_mul1, aa_mul2 )
EndIf
EndIf
#EndMacro
Dim As myint clipLeft,clipTop,xLeft=floor(x+.5),yTop=floor(y+.5)
If x < 0 Then clipLeft = -x: xLeft = 0
If y < 0 Then clipTop = -y: yTop = 0
Dim As myint xRight = xleft + wid_ - 1
Dim As myint yBot = ytop + hgt_ - 1
If xRight > pDest->wM Then xRight = pDest->wM
If yBot > pDest->hM Then yBot = pDest->hM
Dim As Single aa_fractional, xGridStep = 1 / (wid_) '2018 Jan 8
For yDest As myint = yTop To yBot
Dim As myint yGrid = yDest + ClipTop
Dim As single lerp = (yGrid - yTop) / (hgt_) '2018 Jan 8
Dim As sng2D ptAC, ptBD
InterpolatePoint( ptAC, ptA, ptC )
InterpolatePoint( ptBD, ptB, ptD )
Dim As UnionARGB Ptr pixDest = pDest->pixels + yDest * pDest->pitch
For xDest As myint = xLeft To xRight
Dim As myint xGrid = xDest + ClipLeft
Dim As sng2D srcFloatPos
lerp = (xGrid - xLeft) * xGridStep
InterpolatePoint( srcFloatPos, ptAC, ptBD )
Dim As myint srcX = floor(srcFloatPos.x)
Dim As myint srcY = floor(srcFloatPos.y)
Dim As Single aa_Left = srcX + 1 - srcFloatPos.x
Dim As Single aa_Top = srcY + 1 - srcFloatPos.y
Dim As Single aa_Right = 1 - aa_Left
Dim As Single aa_Bot = 1 - aa_Top
Dim As Single sRed, sGrn, sBlu
var alpha_sum = 0f
Dim As UnionARGB ptr ptrSource = pixels
ptrSource += srcY * pitchBy + srcX
BoundsCheckSource( aa_Left, aa_Top ) ''A
srcX += 1
ptrSource += 1
BoundsCheckSource( aa_Right, aa_Top ) ''B
srcY += 1
ptrSource += pitchBy
BoundsCheckSource( aa_Right, aa_Bot ) ''D
srcX -= 1
ptrSource -= 1
BoundsCheckSource( aa_Left, aa_Bot ) ''C
dim as long al = 256 * alpha_sum
Alpha256( pixDest[xDest].col, pixDest[xDest].col, rgb(sRed,sGrn,sBlu), al )
Next
Next
End Sub
sub image_scaler.downscale_aascan(yDes as integer, alp as single)
if yDes < 0 or yDes > pdes->hm then exit sub
#Macro SngAry()
sR(i) += al*((src and &HFF0000)shr 16)
sG(i) += al*((src and &HFF00)shr 8)
sB(i) += al*(src and &HFF)
#endmacro
yDes1D = yDes * pdes->pitchBy
dim as single al
for xSrc as long = 0 to wm
var xDesL = floor(sx): sx += x_step
var xDesR = floor(sx)
var i = yDes1D + xDesL
dim as ulong src = p32[ySrc1D + xSrc]
if xDesL < xDesR then
if xDesL >= 0 and xDesL < pdes->w then
al = (xDesR - (sx-x_step)) * alp
a(i) += al
SngAry()
endif
if xDesR >= 0 and xDesR < pdes->w then
al = (sx - xDesR) * alp
i += 1: a(i) += al
SngAry()
endif
elseif xDesL >= 0 and xDesL < pdes->w then
al = x_step * alp
a(i) += al
SngAry()
endif
next
end sub
sub image_scaler.downscale(byref dest as image_scaler ptr, x as single, y as single, _w as single, _h as single)'2017 Aug 17
' higher quality but with rendering artifacts if blit w,h > source w,h
dim as imagevars scr
if dest = 0 then: pdes = @scr: scr.get_info: else: pdes = dest: endif
var des_ub = pdes->pitch * pdes->h - 1
if ubound(sR)<>des_ub then 'sRGBA size of dest
redim sR(des_ub): redim sG(des_ub)
redim sB(des_ub): redim a(des_ub)
endif
if _w=0 then _w=pdes->w
if _h=0 then _h=pdes->h
var dest_x0 = floor(x): if dest_x0 < 0 then dest_x0 = 0
var dest_y0 = floor(y): if dest_y0 < 0 then dest_y0 = 0
var dest_x1 = floor(x + _w): if dest_x1 > pdes->wm then dest_x1 = pdes->wm
var dest_y1 = floor(y + _h): if dest_y1 > pdes->hm then dest_y1 = pdes->hm
'step 1: reset
for y as long = dest_y0 to dest_y1
var ipitch = y*pdes->pitchBy
for i as long = ipitch + dest_x0 to ipitch + dest_x1
sr(i)=0:sg(i)=0:sb(i)=0:a(i)=0
next
next
x_step = _w / w
y_step = _h / h
'step 2: accumulate
for ySrc as long = 0 to hm
yDesT = floor(y): y += y_step
yDesB = floor(y)
ySrc1D = ySrc * pitchBy: sx = x
if yDesT < yDesB then
downscale_aascan yDesT, yDesB - (y-y_step): sx = x
downscale_aascan yDesB, y - yDesB
else 'equal
downscale_aascan yDesT, y_step
endif
next: y -= y_step * h
'step 3: convert
for y as long = dest_y0 to dest_y1
var ipitch = y*pdes->pitchBy
for i as long = ipitch + dest_x0 to ipitch + dest_x1
dim as ulong col = rgb( sR(i), sG(i), sB(i) )
dim as long al = a(i)*256
alpha256(pdes->p32[i], pdes->p32[i], col, al)
next
next
end sub
function image_scaler.resize(byref dest as image_scaler ptr=0, x as single=0, y as single=0, parm_w as single=0, parm_h as single=0) as integer
if parm_w+.5 > w or parm_h+.5 > h then 'fast
var int_x0 = int(x), int_x1=int(x+parm_w)
var int_y0 = int(y), int_y1=int(y+parm_h)
var int_w = int_x1 - int_x0 + 1
var int_h = int_y1 - int_y0 + 1
var scale_x = w/parm_w
var scale_y = h/parm_h
ptA.x = scale_x * (int_x0 - x)
ptA.y = scale_y * (int_y0 - y)
ptD.x = pta.x + int_w * scale_x
ptD.y = ptA.y + int_h * scale_y
ptC.x = ptA.x: ptC.y = ptD.y
ptB.x = ptD.x: ptB.y = ptA.y
skewRect_Render dest, int_x0, int_y0, int_w, int_h
return 0
else
downscale dest,x,y,parm_w,parm_h
return 1 'quality
EndIf
End function
'
' ------------ image_scaler
type anglevars
as single a=rnd*6.28, i = 6.28*(.0015 * (.25 + rnd))
as single bas = 0.5, scale = .5
declare operator cast as single
end type
operator anglevars.cast as single
a += i: return bas + scale * sin(a)
end operator
sub main
dim as image_scaler buf, im
screenres 640, 480, 32
buf.get_info
im.get_info imagecreate( 201,201)
for i as long = 0 to im.wm step 10
line im.im,(i,0)-(i,im.hm)
line im.im,(0,i)-(im.wm,i)
next
var speed_fac = 1.0
dim as anglevars x,y,w,h
x.bas = buf.wh/2: x.scale = 150: x.i*=speed_fac
y.bas = buf.hh/2: y.scale = 150: y.i*=speed_fac
w.bas = im.w*.95: w.scale = im.wh/1: w.i*=speed_fac
h.bas = im.h*.95: h.scale = im.hh/1: h.i*=speed_fac
dim as string kstr
while kstr = ""
screenlock
cls
put (0,0), im.im, pset
var s="scaling: "
if im.resize( @buf, x, y, w, h )=1 then s+="quality" else s+="quick"
? s
screenunlock
sleep 15
kstr = inkey
wend
end sub
Main