42 fps on my lines
Code: Select all
#include once "fbgfx.bi"
#define def #define
#undef int
def int as Integer
def sng as single
def flr(x) _ '' floor() by Stonemonkey
(((x)*2.0-0.5)shr 1)
'#include "inc/aaline.bas"
' ---- aaline.bas
'#include once "gmath.bas"
/' ------- gmath.bas 2017 Dec 7 - by dafhi -------- '/
#Ifndef flr '' http://www.freebasic.net/forum/viewtopic.php?p=118633
#Define flr(x) (((x)*2.0-0.5)shr 1)
#define ceil(x) (-((-(x)*2.0-0.5)shr 1))
#EndIf
#ifndef pi
const TwoPi = 8*atn(1)
const Pi = 4*atn(1)
const piBy2 = 2*atn(1)
const iPi = 1/Pi
const piBy4 = atn(1)
#EndIf
'#include once "imagevars.bas"
/' ------- imagevars 2018 Jan 9 - by dafhi -------- '/
Union UnionARGB
As Ulong col: Type: As UByte B,G,R,A: End Type
End Union
Type sng2D
As Single x,y
End Type
type myint as integer
type imagevars '' 2018 Jan 9 - 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 sub screen_init(w as myint=0, h as myint=0, bpp as myint=32, npages as myint=1, flags as myint=0)
declare sub create(w as myint=0, h as myint=0, col as ulong=&HFF000000)
declare destructor
private:
declare sub destroy
end type
Destructor.imagevars: destroy
End Destructor
Sub imagevars.Destroy(): If ImageInfo(im) = 0 Then ImageDestroy im: im = 0: endif: End Sub
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
sub imagevars.create(w as myint, h as myint, col as ulong)
destroy: get_info imagecreate(w,h,col)
End Sub
Sub imagevars.screen_init(w As myint, h As myint, _bpp as myint, _pages as myint, _flags as myint)
Destroy: ScreenRes w,h,_bpp,_pages,_flags: get_info
num_pages=_pages: flags=_flags: if num_pages > 1 then screenset 0,1
End sub
#Macro Alpha256(ret, back, fore, a256) '2020 Jan 27
scope
dim int aaa = (a256)
ret=((_
(fore And &Hff00ff) * aaa + _
(back And &Hff00ff) * ( 256 - aaa ) + &H800080) And &Hff00ff00 Or (_
(fore And &H00ff00) * aaa + _
(back And &H00ff00) * ( 256 - aaa ) + &H008000) And &H00ff0000) Shr 8
end scope
#EndMacro
'
' -------- imagevars
/' -- Anti-aliased lines - 2018 Jan 10 - by dafhi
' - usage -----------------------
dim as imagevars buf
buf.screen_init 800,600
aaline.render_target @buf
screenlock
line buf.im, (0,0)-(buf.wm, buf.hm), rgb(180,175,160), bf
aaline.wid = 50
aaline.draw 100,100,400,300, rgb(255,255,255)
screenunlock: sleep
' --------------------------------
I will update this project as time permits.
http://www.freebasic.net/forum/viewtopic.php?f=8&t=20719
'/
namespace AaLine
dim As single x0,y0,x1,y1,wid=1,endcap
dim As ulong col = -1
dim As imagevars ptr im
'' private
Type ScanIntercepts
as double ab,cd,bc,da
End Type
dim As single sx0,sy0,sx1,sy1,ax,bx,cx,dx,ay,by,cy,dy
dim As single ayi,byi,cyi,dyi
dim As single dxL,bxR,axL,axR,cxL,cxR
dim As ulong ptr cBL,cBR,cTL,cTR 'window pixels: bottom-left, ..
dim As integer w,wm,hm,pitchx,pitchy,wmprev,hmprev
dim As single abslope_small, abslope_large
dim As single slen,swid, sdx,sdy, angle, scosa,ssina, cenx,ceny
dim As Single lenBy2, smallBy2,largeBy2
dim As single da0,da1,ab0,ab1,bc0,bc1,cd0,cd1
dim As single cenabx, cenaby, cencdx, cencdy
dim As integer yflipped, xyflipped
dim As ScanIntercepts sc0x, sc1x, sc0y, sc1y
dim As single a(Any), _alpha
Sub render_target(byref p as imagevars ptr): im = p '2017 Sep 10
end sub
sub init
wm=im->wm: hm=im->hm
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->pitchBy
cBL=im->pixels: cTL=cBL+hm*pitchy
cBR=CBL+wm: cTR=cTL+wm: yflipped=0: xyflipped=0: _alpha=256*(col shr 24)/255
End sub
Sub yflip
pitchy=-pitchy: yflipped=-1
swap cBL,cTL: swap cBR,cTR
ceny=hm+1-ceny: ssina=-ssina
end sub
sub xyflip
swap cTL,cBR: xyflipped = -1
swap wm,hm: swap pitchx,pitchy
swap cenx,ceny: swap scosa,ssina
end sub
sub re_center
lenBy2=slen/2
scosa=cos(angle)*lenBy2: ssina=sin(angle)*lenBy2
var dx0=im->wh-x0, dy0=im->hh-y0 ''
var dx1=im->wh-x1, dy1=im->hh-y1 ''
const c = .5
if dx0*dx0+dy0*dy0 < dx1*dx1+dy1*dy1 then 'point 0 closest to center
cenx=x0+scosa+c ''
ceny=y0+ssina+c ''
else
cenx=x1-scosa+c ''
ceny=y1-ssina+c ''
endif
end sub
sub 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
'' fix to make compiler happy
if angle=0 or abs(angle-pi)<0.00001 then angle += 0.0001
scosa=cos(angle)*lenBy2: ssina=sin(angle)*lenBy2
End sub
Sub octant
if scosa<0 then scosa=-scosa: ssina=-ssina
if ssina<0 then yflip
if ssina>scosa then xyflip
w=wm+1
ax=cenx-scosa: bx=cenx+scosa '2017 June 4
ay=ceny-ssina: by=ceny+ssina '2017 June 4
End sub
sub 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
cx=bx-hdxwid: dx=ax-hdxwid: ax=ax+hdxwid: bx=bx+hdxwid '2017 June 4
cy=by+hdywid: dy=ay+hdywid: ay=ay-hdywid: by=by-hdywid '2017 June 4
ayi=flr(ay): byi=flr(by): cyi=flr(cy): dyi=flr(dy)
dxL=flr(dx): axL=flr(ax): axR=flr(ax)
bxR=flr(bx): cxL=flr(cx): cxR=flr(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 xbound(x As Single) As Integer
return x>=0 And x<w
End Function
Function ybound(yLo As single,yHi As single,y As single) As Integer
return y>=yLo And y<= yHi
End Function
Function 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 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 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 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 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 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 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 int_lo(in As Single,clip As Single) As Single
If in<clip Then: Return flr(clip): Else: Return flr(in): EndIf
End Function
Function int_hi(in As Single,clip As Single) As Single
If in>clip Then: Return flr(clip): Else: Return flr(in): EndIf
End Function
sub 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 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 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 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 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: ? "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 linedraw(_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
sub draw_by_vec(x as single, y as single, slen as single, angle as single,_col as ulong)
slen /= 2: dim as single sina = slen*sin(angle), cosa = sLen*cos(angle)
x0=x-cosa: x1=x+cosa: y0=y-sina: y1=y+sina: col=_col: calc
end sub
sub drawme
calc
End Sub
end namespace ' ---- aaline
#define pixel_r( c ) ( culng( c ) shr 16 and 255 )
#define pixel_g( c ) ( culng( c ) shr 8 and 255 )
#define pixel_b( c ) ( culng( c ) and 255 )
#define pixel_a( c ) ( culng( c ) shr 24 )
dim shared as integer sw = 800, sh = 600
function pixelAlphaD( byval src as ulongint, byval dst as ulongint, byval opacity2 as ubyte = 255, byval opacity1 as ubyte = 255 ) as ulongint
#if 1
opacity1 = ( ( culng( src shr 32 ) shr 24 ) * opacity1 ) shr 8
opacity2 = ( ( culng( src ) shr 24 ) * opacity2 ) shr 8
#else
opacity1 = ( ( src shr 56 ) * opacity1 ) shr 8
opacity2 = ( ( ( src shr 24 ) and 255 ) * opacity2 ) shr 8
#endif
#if 0
dim as ulong ptr ps = @src
dim as ulong ptr pd = @dst
alpha256( *pd, *pd, *ps, opacity2 )
ps += 1
pd += 1
alpha256( *pd, *pd, *ps, opacity1 )
return dst
#else
return _
( ( ( ( src shr 32 and &hff00ff ) * opacity1 + _
( dst shr 32 and &hff00ff ) * ( 255 - opacity1 ) ) and &hff00ff00 ) shr 8 or ( _
( ( ( src shr 32 ) shr 8 ) and &hff00ff ) * opacity1 + _
( ( ( dst shr 32 ) shr 8 ) and &hff00ff ) * ( 255 - opacity1 ) ) and &hff00ff00 ) shl 32 or _
( ( ( src and &hff00ff ) * opacity2 + _
( dst and &hff00ff ) * ( 255 - opacity2 ) ) and &hff00ff00 ) shr 8 or ( _
( ( src shr 8 ) and &hff00ff ) * opacity2 + _
( ( dst shr 8 ) and &hff00ff ) * ( 255 - opacity2 ) ) and &hff00ff00
#EndIf
end function
const as ulongint c32x2 = 1 + culngint(1) shl 32
const as single i256 = 256 / 255
sub wuPixelD( _
byval wx as single, _
byval wy as single, _
byval wc as ulong, _
byval buffer as ulong ptr = screenPtr() )
if( wx >= 0 andAlso wx + 1 <= sw - 1 andAlso wy >= 0 andAlso wy + 1 <= sh - 1 ) then
dim as integer x = flr( wx )
dim as integer y = flr( wy )
#if 1
dim as ulong ptr pxlt = buffer + sw * y + x
dim as ulong ptr pxlb = buffer + sw * ( y + 1 ) + x
var fx = wx - x
var fy = wy - y
var a = (wc shr 24) * i256
alpha256( *pxlb, *pxlb, wc, a * (1-fx) * fy )
alpha256( pxlb[1], pxlb[1], wc, a * fx * fy )
fy = 1 - fy
alpha256( *pxlt, *pxlt, wc, a * (1-fx) * fy )
alpha256( pxlt[1], pxlt[1], wc, a * fx * fy )
#else
var fx = ( wx - x ) * 255
var fy = ( wy - y ) * 255
dim as ulongint ptr pxlt = cptr( ulongint ptr, buffer + ( sw * y + x ) )
dim as ulongint ptr pxlb = cptr( ulongint ptr, buffer + ( sw * ( y + 1 ) + x ) )
#if 1
*pxlt = pixelAlphaD( wc * c32x2, *pxlt, _
( ( 255 - fx ) * ( 255 - fy ) ) shr 8, ( fx * ( 255 - fy ) ) shr 8 )
*pxlb = pixelAlphaD( wc * c32x2, *pxlb, _
( ( 255 - fx ) * fy ) shr 8, ( fx * fy ) shr 8 )
#else
*pxlt = pixelAlphaD( ( culngint( wc ) shl 32 ) or wc, *pxlt, _
( ( 255 - fx ) * ( 255 - fy ) ) shr 8, ( fx * ( 255 - fy ) ) shr 8 )
*pxlb = pixelAlphaD( ( culngint( wc ) shl 32 ) or wc, *pxlb, _
( ( 255 - fx ) * fy ) shr 8, ( fx * fy ) shr 8 )
#endif
#endif
end if
end sub
sub DDALineD( _
byval x1 as single, _
byval y1 as single, _
byval x2 as single, _
byval y2 as single, _
byval c as ulong, _
byval buffer as ulong ptr = screenPtr() )
dim as single dx, dy
dim as single x_inc, y_inc, x, y
dim as integer steps
dx = x2 - x1
dy = y2 - y1
if( dx = 0 ) then
x1 += 0.25
x2 += 0.25
end if
y1 += 0.25
y2 += 0.25
steps = flr( iif( abs( dx ) > abs( dy ), _
abs( dx ), abs( dy ) ) )
x_inc = dx / steps
y_inc = dy / steps
x = x1
y = y1
for i as integer = 0 to steps
wuPixelD( x, y, c, buffer )
x += x_inc
y += y_inc
next
end sub
type lines
as single x1
as single y1
as single x0
as single y0
as ulong col
end type
screenRes( sw, sh, 32, , fb.gfx_alpha_primitives )
dim as string k
dim as integer numLines = 1000
'dim as lines l( 0 to numLines - 1 )
dim as imagevars buf
buf.get_info
using aaline
render_target @buf
dim as lines l( 0 to numLines - 1 )
'randomize()
for i as integer = 0 to numLines - 1
with l( i )
.x1 = rnd() * sw
.y1 = rnd() * sh
.x0 = rnd() * sw
.y0 = rnd() * sh
.col = rgba( 255 * rnd(), 255 * rnd(), 255 * rnd(), 255 * rnd() )
end with
next
color( rgba( 0, 0, 0, 255 ), rgba( 255, 255, 255, 255 ) )
dim as double t, sum
dim as uinteger count
dim as boolean antiAlias = true'false
do
k = inkey()
if( k = "1" ) then
sum = 0.0
count = 0
antiAlias = true
end if
if( k = "2" ) then
sum = 0.0
count = 0
antiAlias = false
end if
t = timer()
screenLock()
cls()
for i as integer = 0 to numLines - 1
if( antiAlias = true ) then
wid = 1
lineDraw l( i ).x1, l( i ).y1, l( i ).x0, l( i ).y0, l( i ).col
'DDAlineD( l( i ).x1, l( i ).y1, l( i ).x0, l( i ).y0, l( i ).col )
else
line( l( i ).x1, l( i ).y1 ) - ( l( i ).x0, l( i ).y0 ), l( i ).col
end if
next
screenUnLock()
t = timer() - t
sum += t
count += 1
sleep( 1, 1 )
windowTitle( str( flr( 1 / ( sum / count ) ) ) & iif( antiAlias = true, " FPS (antialiased)", " FPS" ) )
loop until( k = chr( 27 ) )