no more flicker. then i cranked up the line count.
seemed slow so i squeezed in my algorithm for comparison
Code: Select all
/'
anti-aliased lines comparison - 2024 Apr 26 - by dafhi
cairo's clearscreen is faster than Line (0,0)-(w,h), col, bf
.. so i kept that. otherwise, cairo has always been slow.
not to throw shade; anti-aliasing is not 'easy'
try these compiler options suggested by UEZ / deltarho,
reformatted by me
-gen gcc -arch native -Wc -Ofast,-mfpmath=sse,-funroll-loops
updates
aaline.int_lo and int_hi (optimized)
fps text
animation stops but window will stay open
'/
#include once "cairo/cairo.bi"
dim shared as short scrw
dim shared as short scrh
dim shared as boolean use_cairo = false
Function setscreen(_xres As Integer,_yres As Integer) As cairo_t Ptr
scrw = _xres
scrh = _yres
Screenres scrw,scrh,32
Var surface = cairo_image_surface_create_for_data(Screenptr(), _
CAIRO_FORMAT_ARGB32,scrw,scrh,scrw*4)
return cairo_create(surface)
End Function
'' reduced text hack(s)
#define sng as single
#define dbl as double
dim shared sng back_r = 0
dim shared sng back_g = 0
dim shared sng back_b = 0
sub SetBackgroundColour( r sng = 0, g sng = 0, b sng = 0, a sng = 1 )
back_r = r
back_g = g
back_b = b
end sub
type s2D
sng a,b
end type
const Tau = 8*atn(1)
const pi = 4*atn(1)
type tLine
as s2D cen = type(rnd, rnd)
sng angle = rnd * Tau
sng iangle = .05 * rnd*rnd*(rnd - .5)
sng slen = 150 * (rnd*rnd + .2)
sng slen_off = rnd
sng swid = 12 * (rnd*rnd*rnd*rnd*rnd + 1/25)
sng r = (rnd + 0)
sng g = (rnd + 0)
sng b = (rnd + 0)
sng a = 1
end type
#define oper operator
oper *( l sng, r as s2D) as s2D: return type( l*r.a, l*r.b): end oper
oper *( l as s2D, r sng) as s2D: return type( r*l.a, r*l.b): end oper
oper *( l as s2D, r as s2D) as s2D: return type( l.a*r.a, l.b*r.b): end oper
oper +( l as s2D, r as s2D) as s2D: return type( l.a+r.a, l.b+r.b): end oper
oper -( l as s2D, r as s2D) as s2D: return type( l.a-r.a, l.b-r.b): end oper
dim shared as tLine Lines()
sub SetLineCount( c as short )
redim Lines( c - 1 )
end sub
type imvars '' helper
declare sub get_info( byref p as any ptr = 0 )
as long w '' apparently imageinfo no longer likes integer
as long h
as long pitch,rate
as long bypp,bpp
as any ptr pixels, im
as string driver_name
end type
sub imvars.get_info( byref p as any ptr )
if p = 0 then
ScreenInfo w,h, bpp, bypp, pitch, rate, driver_name
pixels = screenptr
else
ImageInfo p, w, h, bypp, pitch, pixels
endif
im = p
end sub
#define min( a, b) iif( (a)<(b), (a), (b) )
#define max( a, b) iif( (a)>(b), (a), (b) )
/' -- Anti-aliased line generator - 2016 Aug 6 - by dafhi
'/
Type ScanIntercepts
as double ab,cd,bc,da
End Type
type AaLine
As single x0,y0,x1,y1,wid=1,alpha=1,endcap
as ulong col=&HFFFFFFFF
declare sub render_target(byref buf as imvars)
declare sub draw(x0 as single=0, y0 as single=0, x1 as single=0, y1 as single=0, col as ulong=&HFFFFFFFF)
as imvars ptr im
private:
declare sub calc
as single sx0,sy0,sx1,sy1,ax,bx,cx,dx,ay,by,cy,dy
As single ayi,byi,cyi,dyi
As single dxL,bxR,axL,axR,cxL,cxR
as ulong ptr cBL,cBR,cTL,cTR 'window pixels: bottom-left, ..
as integer w,wm,hm,pitchx,pitchy,wmprev,hmprev
as single halfdx,halfdy, abslope_small, abslope_large
as single slen,swid, sdx,sdy, angle, scosa,ssina, cenx,ceny
As Single lenBy2, smallBy2,largeBy2
As single da0,da1,ab0,ab1,bc0,bc1,cd0,cd1
as single cenabx, cenaby, cencdx, cencdy
as integer yflipped, xyflipped
as ScanIntercepts sc0x, sc1x, sc0y, sc1y
as single a(Any), _alpha
declare sub handle_infinity
declare sub re_center
declare sub init
declare sub xyflip
declare sub yflip
declare sub octant
declare sub corners
Declare function int_lo(in As Single,clip As Single) As single
Declare function int_hi(in As Single,clip As Single) As Single
Declare Function xbound(x As Single) As Integer
Declare Function ybound(yLo As single,yHi As single,y As single) As Integer
declare sub scanwrite(xL0 As integer, xR1 as integer, y As integer)
Declare Function areasubt(ceptL As Single,ceptR As Single,edgeLo As Single) As Single
Declare Sub subt_ab(xL As single, xR As single,y As Integer)
Declare Sub subt_cd(xL As single, xR As single,y As Integer)
Declare Sub subt_da(x0 As single, x1 As single)
Declare Sub subt_bc(x0 As single, x1 As single)
Declare Function area_oversubtracted(vx As Single,vy As Single,ix As integer,iy As Integer) As Single
declare sub scanlines_adb(y0 as integer, y1 as single)
declare sub scanlines_cdb(y0 as integer, y1 as integer)
declare sub scanlines_abcd(y0 as integer, y1 as single)
declare sub scanlines_db(y0 as integer, y1 as single)
End Type
Sub AaLine.render_target(byref p as imvars)
im = @p
end sub
sub AaLine.init
wm=im->w-1: hm=im->h-1
if wm<>wmprev or hm<>hmprev then
dim as integer ubmax = wm: if hm > ubmax then ubmax = hm
if ubmax > ubound(a) then ReDim a(ubmax)
wmprev=wm: hmprev=hm
end If
pitchx=1: pitchy=im->pitch \ im->bypp
cBL=im->pixels: cTL=cBL+hm*pitchy
cBR=CBL+wm: cTR=cTL+wm: yflipped=0: xyflipped=0: _alpha=256*alpha
End sub
Sub AaLine.yflip
pitchy=-pitchy: yflipped=-1
swap cBL,cTL: swap cBR,cTR
ceny=hm+1-ceny: ssina=-ssina
end sub
sub AaLine.xyflip
swap cTL,cBR: xyflipped = -1
swap wm,hm: swap pitchx,pitchy
swap cenx,ceny: swap scosa,ssina
end sub
sub AaLine.re_center
lenBy2=slen/2
scosa=cos(angle)*lenBy2: ssina=sin(angle)*lenBy2
var dx0=im->w/2-x0, dy0=im->h/2-y0
var dx1=im->w/2-x1, dy1=im->h/2-y1
if dx0*dx0+dy0*dy0 < dx1*dx1+dy1*dy1 then 'point 0 closest to center
cenx=x0+scosa
ceny=y0+ssina
else
cenx=x1-scosa
ceny=y1-ssina
endif
end sub
sub AaLine.handle_infinity
sdx=x1-x0: sdy=y1-y0
slen=sqr(sdx*sdx+sdy*sdy)
if slen>1e9 then: slen=1e9
const sincos=1e9*sqr(1/2)
sdx=sincos*sgn(sdx)
sdy=sincos*sgn(sdy)
endif
if sdx=0 then
if sdy<0 then: angle= -pi/2
else: angle=pi/2: endif
else: angle=atn(sdy/sdx): if sdx<0 then angle+=pi
endif
re_center
swid=wid
if swid>1e9 then swid=1e9
slen+=endcap*swid
if slen < wid then
angle+=pi/2: swap swid,slen
end if: lenBy2=slen/2
'' temp fix for fbc
if angle=0 or abs(angle-pi)<0.00001 then angle += 0.0001
scosa=cos(angle)*lenBy2: ssina=sin(angle)*lenBy2
End sub
Sub AaLine.octant
if scosa<0 then scosa=-scosa: ssina=-ssina
if ssina<0 then yflip
if ssina>scosa then xyflip
w=wm+1
x0=cenx-scosa: x1=cenx+scosa
y0=ceny-ssina: y1=ceny+ssina
End sub
sub AaLine.corners
abslope_small=ssina/scosa: smallBy2=abslope_small/2
abslope_large=scosa/ssina: largeBy2=abslope_large/2
dim as single widByLen = swid/slen
dim as single hdxwid = ssina*widByLen, hdywid = scosa*widByLen
ax=x0+hdxwid: bx=x1+hdxwid: cx=x1-hdxwid: dx=x0-hdxwid
ay=y0-hdywid: by=y1-hdywid: cy=y1+hdywid: dy=y0+hdywid
ayi=Int(ay): byi=Int(by): cyi=Int(cy): dyi=Int(dy)
dxL=Int(dx): axL=Int(ax): axR=Int(ax)
bxR=Int(bx): cxL=Int(cx): cxR=Int(cx)
If dxL<0 Then: dxL=0: EndIf: If bxR>wm then: bxR=wm: endif
If axL<0 Then: axL=0: EndIf: If axR>wm Then: axR=wm: EndIf
If cxL<0 Then: cxL=0: EndIf: If cxR>wm Then: cxR=wm: EndIf
End Sub
Function AaLine.xbound(x As Single) As Integer
return x>=0 And x<w
End Function
Function AaLine.ybound(yLo As single,yHi As single,y As single) As Integer
return y>=yLo And y<= yHi
End Function
Function AaLine.areasubt(ceptL As Single,ceptR As Single,edgeL As Single) As Single
Dim As Single len_tri
If ceptL<edgeL Then ' ceptL
len_tri=ceptR-edgeL ' -+-----+
Return len_tri*len_tri*largeBy2 ' \####|
Else: Dim As Integer edgep=edgeL+1 ' \###|
If ceptR<edgep Then ' \##|
Return ceptR-edgeL-smallBy2 ' -----+-+
Else ' ceptR
len_tri=edgep-ceptL
Return 1-len_tri*len_tri*largeby2: EndIf
EndIf
End Function
Sub AaLine.subt_ab(x0 As single, x1 As single,y As integer)
sc1y.ab=cenaby+(x0-cenabx)*abslope_small
For x As Single=x0 To x1
sc0y.ab=sc1y.ab
sc1y.ab+=abslope_small
a(x)-=areasubt(sc0y.ab,sc1y.ab,y)
Next
end Sub
Sub AaLine.subt_cd(x0 As single, x1 As single,y As Integer)
sc1y.cd=cencdy+(x0-cencdx)*abslope_small
For x As Single=x0 To x1
sc0y.cd=sc1y.cd
sc1y.cd+=abslope_small
a(x)-=1-areasubt(sc0y.cd,sc1y.cd,y)
Next
end sub
sub AaLine.subt_da(x0 As single, x1 As single)
For x As Integer=x0 To x1
a(x)-=areasubt(sc1x.da,sc0x.da,x)
Next
end sub
Sub AaLine.subt_bc(x0 As single, x1 As single)
For x As single=x0 To x1
a(x)-=1-areasubt(sc1x.bc,sc0x.bc,x)
Next
End Sub
Function AaLine.area_oversubtracted(vx As Single,vy As Single,ix As integer,iy As Integer) As single
vx=Abs(vx-ix)
vy=Abs(vy-iy)
var ceptYleft=vy-vx*abslope_small
Dim As Single areaL
' area "low and left" of vertex
If ceptYleft<0 Then 'triangle
areaL=vy*vy*largeBy2
Else 'trapezoid
areaL=vx*(ceptYleft+vy)/2
End If
' area "low and right" of vertex
Var ceptXBottom=vx+vy*abslope_small
Var ixp=ix+1
If ceptXBottom<=1 Then 'triangle
Return areaL + vy*vy*smallBy2
Else 'trapezoid
Var vx1=1-vx
Return areaL+vx1*(vy-vx1*largeBy2)
EndIf
End Function
Sub AaLine.scanwrite(xL0 As integer, xR1 as integer, y As integer)
dim as ulong ptr p=@cBL[xL0*pitchx+y*pitchY]
for x as integer=xL0 to xR1
dim as ulong a256 = _alpha * a(x)
*p=((_
(col And &Hff00ff) * a256 + _
(*p And &Hff00ff) * (256-a256) + &H800080) And &Hff00ff00 Or (_
(col And &H00ff00) * a256 + _
(*p And &H00ff00) * (256-a256) + &H008000) And &H00ff0000) Shr 8
p+=pitchx
next
End Sub
Function AaLine.int_lo(in As Single,clip As Single) As Single
' If in<clip Then: Return Int(clip): Else: Return Int(in): EndIf
return iif(in<clip, int(clip), int(in))
End Function
Function AaLine.int_hi(in As Single,clip As Single) As Single
'If in>clip Then: Return Int(clip): Else: Return Int(in): EndIf
return iif(in>clip, int(clip), int(in))
End Function
sub AaLine.scanlines_abcd(y0 as integer, y1 as single)
if y0<0 then y0=0
if y1>hm then y1=hm
sc0x.cd=sc1x.cd: sc1x.cd=cencdx+(y0-cencdy)*abslope_large
sc0x.bc=sc1x.bc: sc1x.bc=bx-(y0-by)*abslope_small
for y As Integer=y0 to y1
sc0x=sc1x
sc1x.ab+=abslope_large
sc1x.cd+=abslope_large
sc1x.da-=abslope_small
sc1x.bc-=abslope_small
Dim As Integer inda=ybound(ayi,dyi,y)
Dim As Integer inab=ybound(ayi,byi,y)
Dim As Integer incd=ybound(dyi,cyi,y)
Dim As Integer inbc=ybound(byi,cyi,y)
Dim As single xL1=-1,xL0=wm+1
If inda Then
da0=int_lo(sc1x.da,dxL): If da0<xL0 Then xL0=da0
da1=int_hi(sc0x.da,axR): If da1>xL1 Then xL1=da1
EndIf
If incd Then
cd0=int_lo(sc0x.cd,dxL): If cd0<xL0 Then xL0=cd0
cd1=int_hi(sc1x.cd,cxR): If cd1>xL1 Then xL1=cd1
EndIf
Dim As single xR1=-1,xR0=wm+1
If inab Then
ab0=int_lo(sc0x.ab,axL): If ab0<xR0 Then xR0=ab0
ab1=int_hi(sc1x.ab,bxR): If ab1>xR1 Then xR1=ab1
EndIf
If inbc Then
bc0=int_lo(sc1x.bc,cxL): If bc0<xR0 Then xR0=bc0
bc1=int_hi(sc0x.bc,bxR): If bc1>xR1 Then xR1=bc1
EndIf
For x as integer=xL0 to xR1
a(x)=1
Next
If inda Then subt_da da0,da1
If inab Then subt_ab ab0,ab1,y
If inbc Then subt_bc bc0,bc1
If incd Then subt_cd cd0,cd1,y
If y=ayi And xbound(ax) Then
a(axL)+=area_oversubtracted(ax,ay,axL,ayi)
EndIf
If y=byi And xbound(bx) Then
a(bxR)+=area_oversubtracted(by,bx,byi,bxR+1)
EndIf
If y=cyi And xbound(cx) Then
a(cxR)+=area_oversubtracted(cx,cy,cxR+1,cyi+1)
EndIf
If y=dyi And xbound(dx) Then
a(dxL)+=area_oversubtracted(dy,dx,dyi+1,dxL)
EndIf
scanwrite xL0,xR1,y
next
end sub
sub AaLine.scanlines_adb(y0 as integer, y1 as single)
if y0<0 then y0=0
if y1>hm then y1=hm
if ax < w-cx then 'bc closest
cenabx=bx: cenaby=by
cencdx=cx: cencdy=cy
else
cenabx=ax: cenaby=ay
cencdx=dx: cencdy=dy
end if
sc1x.da=ax-(y0-ay)*abslope_small
sc1x.ab=cenabx+(y0-cenaby)*abslope_large
for y As Integer=y0 to y1
sc0x.da=sc1x.da: sc1x.da-=abslope_small
sc0x.ab=sc1x.ab: sc1x.ab+=abslope_large
Dim As single xL1=-1,xL0=wm+1
da0=int_lo(sc1x.da,dxL): If da0<xL0 Then xL0=da0
da1=int_hi(sc0x.da,axR): If da1>xL1 Then xL1=da1
Dim As single xR1=-1,xR0=wm+1
ab0=int_lo(sc0x.ab,axL): If ab0<xR0 Then xR0=ab0
ab1=int_hi(sc1x.ab,bxR): If ab1>xR1 Then xR1=ab1
For x as integer=xL0 to xR1
a(x)=1
Next
subt_da da0,da1
subt_ab ab0,ab1,y
If y=ayi And xbound(ax) Then
a(axL)+=area_oversubtracted(ax,ay,axL,ayi)
EndIf
scanwrite xL0,xR1,y
next
end sub
sub AaLine.scanlines_cdb(y0 as integer, y1 as integer)
if y0<0 then y0=0
if y1>hm then y1=hm
for y As Integer=y0 to y1
sc0x.cd=sc1x.cd: sc1x.cd+=abslope_large
sc0x.bc=sc1x.bc: sc1x.bc-=abslope_small
Dim As single xL1=-1,xL0=wm+1
cd0=int_lo(sc0x.cd,dxL): If cd0<xL0 Then xL0=cd0
cd1=int_hi(sc1x.cd,cxR): If cd1>xL1 Then xL1=cd1
Dim As single xR1=-1,xR0=wm+1
bc0=int_lo(sc1x.bc,cxL): If bc0<xR0 Then xR0=bc0
bc1=int_hi(sc0x.bc,bxR): If bc1>xR1 Then xR1=bc1
For x as integer=xL0 to xR1
a(x)=1
Next
subt_bc bc0,bc1
subt_cd cd0,cd1,y
If y=cyi And xbound(cx) Then
a(cxR)+=area_oversubtracted(cx,cy,cxR+1,cyi+1)
EndIf
scanwrite xL0,xR1,y
next
end sub
sub AaLine.scanlines_db(y0 as integer, y1 as single)
if y0<0 then y0=0
if y1>hm then y1=hm
for y As Integer=y0 to y1
sc0x.ab=sc1x.ab: sc1x.ab+=abslope_large
sc0x.cd=sc1x.cd: sc1x.cd+=abslope_large
Dim As single xL1=-1,xL0=wm+1
cd0=int_lo(sc0x.cd,dxL): If cd0<xL0 Then xL0=cd0
cd1=int_hi(sc1x.cd,cxR): If cd1>xL1 Then xL1=cd1
Dim As single xR1=-1,xR0=wm+1
ab0=int_lo(sc0x.ab,axL): If ab0<xR0 Then xR0=ab0
ab1=int_hi(sc1x.ab,bxR): If ab1>xR1 Then xR1=ab1
For x as integer=xL0 to xR1
a(x)=1
Next
subt_ab ab0,ab1,y
subt_cd cd0,cd1,y
scanwrite xL0,xR1,y
next
end sub
Sub AaLine.calc
handle_infinity
if slen <= 0 then exit sub
if im=0 or im->bpp <> 32 then
static as integer show_msg=1
if show_msg then
if im->im=0 then: ? "AaLine: invalid render target"
else: print "AaLine: target must be 32bpp"
end if: sleep 1000: show_msg=0
endif
end if
init
octant
corners
if dyi<=byi then
scanlines_adb ayi,dyi-1
if dyi<byi-1 then
scanlines_abcd dyi, dyi
scanlines_db dyi+1, byi-1
scanlines_abcd byi, byi
else
scanlines_abcd dyi, byi
end if
scanlines_cdb byi+1,cyi
else
scanlines_adb ayi,byi-1
scanlines_abcd byi, dyi
scanlines_cdb dyi+1,cyi
end if
End sub
sub AaLine.draw(_x0 as single,_y0 as single,_x1 as single,_y1 as single,_col as ulong)
x0=_x0: x1=_x1: y0=_y0: y1=_y1: col=_col: calc
end sub
'
' ------------------------ AaLine
dim shared as imvars buf
dim shared as aaLine g_aaLine
sub _draw_lines( c as cairo_t ptr )
g_aaLine.render_target buf
'' cairo clearscreen faster on my system
#if 1
cairo_paint(c)
#else
line (0,0)-(scrw,scrh), _
rgb(back_r*255.499,back_g*255.499,back_b*255.499), bf
#endif
for i as long = 0 to ubound(lines)
dim byref as tLine L = Lines(i)
static as s2D p0, p1, cen, halfSeg
halfSeg = L.slen * type( cos( L.angle ), sin( L.angle ) )
L.angle += L.iangle
cen = L.cen * type(scrw,scrh)
p0 = cen + halfSeg * L.slen_off
p1 = cen - halfSeg * (1 - L.slen_off)
if use_cairo then
cairo_set_line_width( c, L.swid )
cairo_set_source_rgba c, L.r,L.g,L.b,L.a
cairo_move_to( c, p0.a, p0.b )
cairo_line_to( c, p1.a, p1.b )
cairo_stroke c
else
g_aaLine.wid = L.swid
g_aaLine.draw p0.a,p0.b, p1.a,p1.b, _
rgba( 255.499 * L.r, 255.499 * L.g, 255.499 * L.b, 255.499 * L.a)
endif
next
end sub
sub my_scr_update( c as cairo_t ptr )
cairo_set_source_rgba c, back_r, back_g, back_b, 1
screenlock
_draw_lines c
ScreenUnLock
end sub
function round(in dbl, places as ubyte = 2) as string
dim as integer mul = 10 ^ places
return str(csng( int(in * mul + .5) / mul) )
End Function
sub main
Dim As cairo_t Ptr C=setscreen( 800, 600 )
SetBackgroundColour .0,.0,.0, 1
SetLineCount 3000
buf.get_info 0 '' custom image class
dim dbl fps_update_interval = 1
dim dbl t = timer, tp
dim dbl t_report_next = t + fps_update_interval
dim dbl t_demo_timeout = t + 50
dim dbl fps0, fps1
locate 2,2
print "press 'x' to compare algorithms"
sleep 2500
dim as string kstr
do
my_scr_update c
kstr = lcase(inkey)
select case kstr
case "x"
use_cairo = not use_cairo
case is <> ""
exit do
end select
tp = t
t = Timer
if t >= t_demo_timeout then exit do
fps0 = fps1
fps1 = 1 / (t - tp)
if t >= t_report_next then
t_report_next += fps_update_interval
windowtitle "fps " + round( (fps0 + fps1) / 2, 1 ) + " (" + iif(use_cairo, "cairo)", "dafhi's algorithm)" )
endif
sleep 15
loop
locate 2,1
print "Demo finished."' Exiting .."
Sleep '1600
cairo_destroy(c)
End Sub
Main()