years ago i translated to FB and posted somewhere on this forum.
wrote a new one from scratch, thinking i could make it shorter.
mission accomplished.
Code: Select all
h blit alpha - 2024 Jan 9 - by dafhi
watching a space-shooter playthrough, i decided to code a run-length
blit in freebasic
recommended -gen gcc options from UEZ / DeltaRho comments
-arch native -Wc -Ofast,-mfpmath=sse,-funroll-loops
update
removed a ton of unnecess. code
reorganized
'/
' -- boilerplate - 2023 May 12 - by dafhi
'
#define flo(x) (((x)*2.0-0.5)shr 1) '' replaces int (and faster) - http://www.freebasic.net/forum/viewtopic.php?p=118633
#undef int
#define int as integer
#define sng as single
#define dbl as double
#define decl declare
#define oper operator
#define prop property
#define csr constructor
#define min( a, b) iif( (a)<(b), (a), (b) )
#define max( a, b) iif( (a)>(b), (a), (b) )
' ------------------- boilerplate
'' A function that creates an image buffer with the same
'' dimensions as a BMP image, and loads a file into it.
Const NULL As Any Ptr = 0
Function bmp_load( ByRef filename As Const String ) As Any Ptr '' https://www.freebasic.net/wiki/KeyPgBload
Dim As Long filenum, bmpwidth, bmpheight
Dim As Any Ptr img
'' open BMP file
filenum = FreeFile()
If Open( filename For Binary Access Read As #filenum ) <> 0 Then Return NULL
'' retrieve BMP dimensions
Get #filenum, 19, bmpwidth
Get #filenum, 23, bmpheight
Close #filenum
'' create image with BMP dimensions
img = ImageCreate( bmpwidth, Abs(bmpheight) )
If img = NULL Then Return NULL
'' load BMP file into image buffer
If BLoad( filename, img ) <> 0 Then ImageDestroy( img ): Return NULL
Return img
End Function
/' -- 2024 Jan 8 - by dafhi
generic image info w/ zoom (useful for debugs)
'/
type imvars
declare csr
declare csr( as any ptr )
declare oper cast() as any ptr
declare oper let( as any ptr )
decl sub get_info( byref p as any ptr = 0 )
decl sub zoom( as long=0, as long=0, as long = -1, as long = -1, as ubyte = 1 ) '2023 May 11
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
oper imvars.cast as any ptr
return im
end oper
oper imvars.let( p as any ptr )
get_info p
end oper
csr imvars
end csr
csr imvars( p as any ptr )
this = p
end csr
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
sub imvars.zoom( xdes as long, ydes as long, wid as long, hgt as long, size as ubyte )
var sizem = size - 1
dim as long wmdes, hmdes
ScreenInfo wmdes, hmdes, bpp, bypp, pitch, rate, driver_name
wmdes -= 1
hmdes -= 1
var x1=xdes + (wid-1)*size: x1=min( x1, wmdes )
var y1=ydes + (hgt-1)*size: y1=min( y1, hmdes )
line (xdes-2, ydes-2) - (x1+size, y1+size), rgb(255,0,255), b
for y as long=ydes to y1 step size
var ysrc = (y-ydes)\size
for x as long=xdes to x1 step size
var xsrc = (x-xdes)\size
line (x, y)-(x+sizem, y+sizem), _
point( xsrc, ysrc ), bf
next
next
End Sub
namespace rl_blit ' run-length sprites - 2024 Jan 8 - by dafhi
/' -- basic use
screenres 800,600, 32
rl_blit.dest_surface 0 '' window
var mask_col = rgb(0,0,0) '' default imagecreate fill is magenta
dim as any ptr my_fb_image = imagecreate(50,50, mask_col)
for n as long = 1 to 8
circle my_fb_image, (5+rnd*30, 5+rnd*30), 2+rnd*3, rnd * culng(-1)
next
put (0,0), my_fb_image, pset '' pset = copy blit
? "generated sprite"
sleep 1500
cls
dim as rl_blit.sprite sprite
sprite.encode my_fb_image, mask_col
for n as long = 1 to 30
sprite.blit rnd * 200, rnd * 200
next
screenlock
screenunlock
locate 2,2
? "run length encoded"
sleep
-------- '/
dim as imvars des
type t_cliprect field = 2
decl constructor
decl constructor( int = -1, int = -1, int = -1, int = -1 )
decl sub set( int = -1, int = -1, int = -1, int = -1 )
decl oper let( as imvars )
as short x0, x1 = -1
as short y0, y1 = -1
decl oper cast as string
end type
csr t_cliprect '' constructor
end csr
csr t_cliprect( x0 int, y0 int, x1 int, y1 int )
set x0, y0, x1, y1
end csr
oper t_cliprect.cast as string
return _
"x0: " + str(x0) + _
" x1:" + str(x1) + _
" y0:" + str(y0) + _
" y1:" + str(y1)
end oper
oper t_cliprect.let( i as imvars )
x0 = 0: x1 = i.w-1
y0 = 0: y1 = i.h-1
end oper
sub t_cliprect.set( xa int, ya int, xb int, yb int )
x0 = iif(xa < 0, x0, xa)
x1 = iif(xb < 0, x1, xb)
y0 = iif(ya < 0, y0, ya)
y1 = iif(yb < 0, y1, yb)
end sub
dim as t_cliprect clip_rect
sub dest_surface( p as any ptr = 0 )
des.get_info p '' old: grab p '' 2024 Jan 8
clip_rect = des
end sub
type _run_length field = 2 '' align
as ushort offs '
as ushort lenm ' length minus 1
end type
type _scanline field = 1 ''
as _run_length rl(any)
as ulong col(any)
as ushort csegs
end type
type sprite
declare csr
declare csr( filename as string, as ulong = rgb( 255,0,255) )
declare csr( as any ptr, as ulong = rgb( 255,0,255) )
declare sub encode( byref as imvars, as ulong )
declare sub blit( int=0, int=0 )
as ushort w
as ushort h
declare sub _blit__scan(int)
as _scanline _sl(any)
as ulong _bgcol
end type
csr sprite '' constructor
end csr
' encode support - namespace globals
dim as imvars ptr p_src
dim as _scanline sl
sub _encode__scan( y int, bgcol as ulong )
dim as ulong ptr p32_src = p_src->pixels
p32_src += y * p_src->pitch \ 4
sl.csegs = 0
var lenm = -1
var col_idx = -1
for x int = 0 to p_src->w - 1
if p32_src[x] <> bgcol then
if lenm = -1 then
sl.rl(sl.csegs).offs = x
sl.csegs += 1
endif
col_idx += 1
sl.col(col_idx) = p32_src[x]
pset(x,y), p32_src[x]
lenm += 1
if x = p_src->w - 1 then
sl.rl( sl.csegs - 1 ).lenm = lenm
end if
elseif lenm > -1 then
sl.rl(sl.csegs - 1).lenm = lenm
lenm = -1
end if
next x
if sl.csegs > 0 then '' 2023 May 12
redim preserve sl.col( col_idx )
redim preserve sl.rl( sl.csegs - 1 )
else
redim sl.col(0)
redim sl.rl(0)
sl.rl(0).lenm = -1 '' prevent scanline blit
endif
end sub
sub sprite.encode( byref im_src as imvars, bgcol as ulong )
_bgcol = bgcol
w = im_src.w
h = im_src.h
dim int max_segs = (im_src.w + 2) \ 2
redim _sl(im_src.h - 1)
p_src = @im_src
for y int = 0 to im_src.h - 1
redim sl.rl(max_segs - 1)
redim sl.col(im_src.w - 1)
_encode__scan y, bgcol
_sl(y) = sl
next y
end sub
csr sprite( p as any ptr, bgcol as ulong )
encode type<imvars>(p), bgcol
end csr
csr sprite( filename as string, bgcol as ulong )
encode bmp_load(filename), bgcol
end csr
'' decode support - namespace globals
dim as ulong ptr pdLeft
dim int y_src
dim as t_cliprect cr '' clipper for user-spec vs actual window
dim as _run_length ptr rl
sub sprite._blit__scan( x_des int ) '' 2024 Jan 8
dim as ulong ptr p32_src = @_sl(y_src).col(0)
for i_seg int = 0 to _sl(y_src).csegs - 1
rl = @_sl(y_src).rl( i_seg )
var x_des0 = x_des + rl->offs
var x_des1 = min(x_des0 + rl->lenm, cr.x1)
var clip0 = iif( x_des0 < cr.x0, cr.x0 - x_des0, 0 )
dim as long x_src = clip0
for ix_des int = x_des0+clip0 to x_des1
pdLeft[ix_des] = p32_src[ x_src ]
x_src += 1
next
p32_src += rl->lenm + 1
next
end sub
sub sprite.blit( xx_des int, yy_des int )
cr.x1 = min(des.w - 1, clip_rect.x1)
cr.y1 = min(des.h - 1, clip_rect.y1)
cr.x0 = max(clip_rect.x0, 0)
cr.y0 = max(clip_rect.y0, 0)
pdLeft = cast( any ptr, des.pixels ) + _
iif( yy_des < cr.y0, cr.y0, yy_des ) * des.pitch
var y0_src = iif( yy_des < cr.y0, cr.y0 - yy_des, 0 )
var y1_src = yy_des + h-1
y1_src = h - 1 - iif( y1_src > cr.y1, y1_src - cr.y1, 0 )
for y_src = y0_src to y1_src
_blit__scan xx_des
pdleft += des.pitch \ des.bypp
next
end sub
end namespace ' ------ rl_blit
'
' ---- Main
'
function procedural_image( w int = 10, h int = 10, bgcol as ulong = 0, messy as boolean = true ) as any ptr
dim as any ptr im_temp = imagecreate( w,h, bgcol )
for i int = 1 to 3*sqr( w + h )
var col = rgb(rnd*255,rnd*255,rnd*255)
if messy then pset im_temp, (rnd*w,rnd*h), col
if messy andalso rnd < .3 then line im_temp, (rnd*w,rnd*h)-(rnd*w,rnd*h), col
next
return im_temp
end function
dim shared as rl_blit.sprite sprite
sub rand_sprite_and_encode
var siz = 59
dim as ulong bgcol = rgb(0,0,0)
dim as imvars im_temp = procedural_image( siz, siz, bgcol )
sprite.encode im_temp, bgcol
end sub
' -------------
var w = 800
var h = 600
screenres w,h, 32 '' gfx init must precede mem buf / load bmp
rand_sprite_and_encode
var win2_x = 10
var win2_y = 80
var zoom = 4
rl_blit.dest_surface 0 '' window
dim shared sng cenx, ceny, rad
with rl_blit.clip_rect
rad = sqr( (.x1 - .x0) ^ 2 + (.y1 - .y0) ^ 2 )
end with
locate 1,1
print "generated sprite"
sprite.blit 0,0
rl_blit.des.zoom win2_x, win2_y, sprite.w*4, sprite.h*1.1, zoom
sleep 1500
cls
dim int x = 0
dim int y = 0
dim shared as imvars im_temp
sub manual_clip_adjust
with rl_blit.clip_rect
.set 5, 5, 50, 50
cenx = ((.x0 + .x1) - sprite.w) / 2
ceny = ((.y0 + .y1) - sprite.h) / 2
rad = sqr( (.x1 - .x0) ^ 2 + (.y1 - .y0) ^ 2 )
im_temp = imagecreate( .x1+1 - .x0, .y1+1 - .y0, rgb(32,32,32) )
draw string im_temp, (6,15), "CLIP"
draw string im_temp, (6,25), "RECT"
end with
end sub
manual_clip_adjust
const tau = 8 * atn(1) '' 2 * pi
type angle_and_increment
decl oper cast as double
decl oper cast as string
dbl a = rnd * tau
sng ia = .03 * (.3 + rnd)
end type
oper angle_and_increment.cast as double
return a
end oper
oper angle_and_increment.cast as string
return str(a)
end oper
dim as angle_and_increment a0, a1
var t_demo_secs = 12
windowtitle "run time " + str(t_demo_secs) + " seconds"
var t_demo_end = timer + t_demo_secs * 1000
var sleep_amount = 1
for t as double = timer to t_demo_end
var dt = .07 * sleep_amount
var a1sin = .75 * rad
x = cenx + a1sin * cos(a0)
y = ceny + .4* a1sin * sin(a1)
a0.a += a0.ia * dt
a1.a += a0.ia * dt * 1.414
screenlock
with rl_blit.clip_rect '' background
put (.x0,.y0), im_temp, pset
end with
sprite.blit x, y
rl_blit.des.zoom win2_x, win2_y, sprite.w*2, sprite.h*1.0, zoom
screenunlock
sleep sleep_amount
if inkey<>"" then exit for
next
imagedestroy im_temp '' "CLIP RECT" background
locate 1,1
? "demo finished."
sleep
another way to "run length" blit - use vectors
Code: Select all
/'
3d point cloud -- 2023 May 27 - by dafhi
'/
'#include "../util.bas"
#define flo(x) (((x)*2.0-0.5)shr 1) '' replaces int (and faster) - http://www.freebasic.net/forum/viewtopic.php?p=118633
#undef int
#define int as integer
#define sng as single
function min( a as double, b as double ) as double
return iif( a < b, a, b)
end function
function max( a as double, b as double ) as double
return iif( a > b, a, b)
end function
const tau = 8 * atn(1)
type v3float as single
type v3 '' dodicat introduced us to this wild nomenclature
declare function rodrigues( as v3, sng, sng) as v3
as v3float x,y,z
declare property mag as v3float
declare property norm as v3
declare sub rand
End Type
sub v3.rand
y=2*(rnd-.5): var r=sqr(1-y*y)
z=rnd*tau: x=r*cos(z): z=r*sin(z)
End Sub
property v3.mag as v3float
return sqr(x*x+y*y+z*z)
end property
property v3.norm as v3
var s = 1/ max( mag, .001 )
return type(x*s,y*s,z*s)
end property
function v3.rodrigues( _norm as v3, sina sng, cosa sng) as v3
static sng dot: dot=(1-cosa)*(_norm.x*x+_norm.y*y+_norm.z*z)
return type(_
_norm.x*dot + x*cosa + (_norm.y*z - _norm.z*y)*sina, _
_norm.y*dot + y*cosa + (_norm.z*x - _norm.x*z)*sina, _
_norm.z*dot + z*cosa + (_norm.x*y - _norm.y*x)*sina)
End function
type tStackInfo
declare constructor
declare sub reset
declare property yep_resize as boolean
dim int i, u
end type
constructor tStackInfo: reset
end constructor
sub tStackInfo.reset: u = -1: i = -1
end sub
property tStackInfo.yep_resize as boolean
i += 1: var ret_val = i > u
u = iif( ret_val, 1.5*(i), u )
return ret_val
end property
#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
operator -(r as v3) as v3: return type(-r.x, -r.y, -r.z): end operator
operator -(l as v3,r as v3) as v3: return type(l.x-r.x,l.y-r.y,l.z-r.z): end operator
operator +(l as v3,r as v3) as v3: return type(l.x+r.x, l.y+r.y, l.z+r.z): end operator
operator /(l as v3,r as v3float) as v3: dim as v3float s = 1/r: return type(l.x*s,l.y*s,l.z*s): end operator
operator *(l as v3,r as v3float) as v3: return type(l.x*r,l.y*r,l.z*r): end operator
operator *(l as v3float, r as v3) as v3: return type(l*r.x,l*r.y,l*r.z): end operator
operator *(l as v3,r as v3) as v3: return type(l.x*r.x,l.y*r.y,l.z*r.z): end operator
type axis3
declare constructor
declare function rot( as v3 ) as v3
as v3 vx,vy,vz
as v3 pos
end type
constructor axis3
vx = type(1,0,0)
vy = type(0,1,0)
vz = type(0,0,1)
end constructor
function axis3.rot( i as v3 ) as v3
#if 1
return vx * i.x + vy * i.y + vz * i.z
#else
return type( _
vx.x * i.x + vy.x * i.y + vz.x * i.z, _
vx.y * i.x + vy.y * i.y + vz.y * i.z, _
vx.z * i.x + vy.z * i.y + vz.z * i.z)
#endif
end function
'
' --------- util
'#include "../imvars.bas"
/' -- 2023 May 12 - by dafhi
generic image info w/ zoom (useful for debugs)
'/
type imvars
declare constructor
declare constructor( byref as any ptr = 0 )
declare sub get_info( byref p as any ptr = 0 )
declare sub zoom( as long=0, as long=0, as long = -1, as long = -1, as ubyte = 1 ) '2023 May 11
as long w '' apparently imageinfo no longer likes integer
as long h
as long pitch,rate
as long bypp,bpp
as any ptr pixels
as string driver_name
end type
constructor imvars
end constructor
constructor imvars( byref p as any ptr )
get_info p
end constructor
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
end sub
sub imvars.zoom( xdes as long, ydes as long, wid as long, hgt as long, size as ubyte )
var sizem = size - 1
dim as long wmdes, hmdes
ScreenInfo wmdes, hmdes, bpp, bypp, pitch, rate, driver_name
wmdes -= 1
hmdes -= 1
var x1=xdes + (wid-1)*size: x1=min( x1, wmdes )
var y1=ydes + (hgt-1)*size: y1=min( y1, hmdes )
line (xdes-2, ydes-2) - (x1+size, y1+size), rgb(255,0,255), b
for y as long=ydes to y1 step size
var ysrc = (y-ydes)\size
for x as long=xdes to x1 step size
var xsrc = (x-xdes)\size
line (x, y)-(x+sizem, y+sizem), _
point( xsrc, ysrc ), bf
next
next
End Sub
type t_cliprect field = 2
as ushort x0, x1
as ushort y0, y1
declare operator cast as string
end type
operator t_cliprect.cast as string
#if 1
return _
"x0: " + str(x0) + _
" x1:" + str(x1) + _
" y0:" + str(y0) + _
" y1:" + str(y1)
#else
return "rect (" + str(x0) + "," + str(y0) + _
") - " + str(x1) + "," + str(y1) + ")"
#endif
end operator
'
' ------------------- imvars.bas
type v3c extends v3
as ulong col
end type
function procedural_image( w int = 10, h int = 10, bgcol as ulong = 0, messy as boolean = true ) as any ptr
dim as any ptr im_temp = imagecreate( w,h, bgcol )
for i int = 1 to .1*(w*h)
var col = rgb(rnd*255,rnd*255,rnd*255)
if messy then pset im_temp, (rnd*w,rnd*h), col
if messy andalso rnd < .3 then line im_temp, (rnd*w,rnd*h)-(rnd*w,rnd*h), col
next
return im_temp
end function
sub encode( im as any ptr, bg as ulong = rgb(255,0,255), des() as v3c )
dim as long w,h,pitch, bypp
dim as ulong ptr pixels
dim as tStackInfo si
ImageInfo im, w, h, bypp, pitch, pixels
for y as long = 0 to h-1
dim as ulong ptr row = pixels + pitch*y\bypp
for x as long = 0 to w-1
if row[x]<> bg then
if si.yep_resize then redim preserve des(si.u)
des(si.i).x = (x-(w-1)/2) / max(1,w-1)
des(si.i).y = (y-(h-1)/2) / max(1,h-1)
des(si.i).col = row[x]
endif
next
next
redim preserve des(si.i)
end sub
type DotVars '' 2023 May 30
union
Type: As UByte b,g,r,a
End Type
As ULong col
end union
as v3 o,p
as single rad = 1
as boolean flag
End Type
type tView3D
as single iris_diam = 2
as single focus_z = 1
End Type
namespace AaDot '2023 May 30 - by dafhi
dim as imvars ptr im
sub render_target(byref buf as imvars ptr): im = buf
end sub
dim as t_cliprect _clipped '' namespace globals
dim sng _slope_by_rad
dim sng _metaball_alpha_scalar '' March 21
dim sng draw_dist_from_center '' May 12
dim sng dx, dy, dx0, dySQ
dim as ulong ptr px
dim int _alpha
sub _cliprect_calc( x sng, y sng, rad_multed sng ) '' May 30
_clipped.x0 = max( flo( x - rad_multed ), 0 )
_clipped.x1 = min( flo( x + rad_multed ), im->w-1 )
_clipped.y0 = max( flo( y - rad_multed ), 0 )
_clipped.y1 = min( flo( y + rad_multed ), im->h-1 )
end sub
sub _precalcs( x sng, y sng, col as ulong = -1, rad sng = 10)
draw_dist_from_center = 1 '' May 30
_metaball_alpha_scalar = min( rad, .003 ) '' March 21
_cliprect_calc x, y, rad * draw_dist_from_center
_slope_by_rad = 1 / max(rad, .001)
dx0 = (_clipped.x0 - x) * _slope_by_rad
end sub
sub _scan( col as ulong, plot_y int )
px = im->pixels + plot_y * (im->pitch)
dySQ = dy * dy
dx = dx0
for plot_x int = _clipped.x0 to _clipped.x1
dim int alpha = _alpha * (1 - (dx*dx+dySQ))
Alpha256( px[plot_x], px[plot_x], col, max(alpha,0) )
dx += _slope_by_rad
next
dy += _slope_by_rad
end sub
sub _draw( x sng, y sng, col as ulong = -1, rad sng = 10)
_alpha = 256.499 * (col shr 24) / 255
dy = (_clipped.y0 - y) * _slope_by_rad
for plot_y int = _clipped.y0 to _clipped.y1
_scan col, plot_y
next
end sub
sub draw( x sng, y sng, col as ulong = -1, rad sng = 10)
_precalcs x, y, col, rad
_draw x, y, col, rad
end sub
dim as dotvars ptr p
dim int alpha_thresh = 20 ''render-time hack
dim sng r_expan
dim as dotvars result
dim as tView3D vie
sub defocus_draw(byref pdv as dotvars ptr)', rad_scalar sng = 1)
p = @result '' namespace globals p and result
with *pdv
r_expan = vie.iris_diam * abs(.p.z - vie.focus_z)
result.rad = .rad + r_expan
result.col = .col
result.a = 255.499 * .rad * .rad / (result.rad * result.rad)
'' Sep 19 - reduce radius if low alpha
result.rad = iif( result.a > alpha_thresh, result.rad, _
result.rad * result.a / iif(alpha_thresh=0,1,alpha_thresh) )
draw .p.x, .p.y, result.col, result.rad
End With
End Sub
end namespace
var w = 800, wh = w/2
var h = 600, hh = h/2
ScreenRes w,h, 32
dim as imvars buf = 0
aadot.render_target @buf
var general_scale_2d = (wh+hh)
dim as v3c points()
var bg = rgb(0,0,0)
var messy = true
var im = procedural_image( 50,50, bg, messy )
encode im, bg, points()
put (0,0),im,pset
sleep 700
imagedestroy im
var demo_seconds = 4
var tp = timer, run_time = 0# '' # = double
var report_next = tp + 1.5
aadot.vie.iris_diam = 18
aadot.vie.focus_z = 2
aadot.alpha_thresh = 15 '' alpha value less than this will reduce dot radius.
'' Namespace AaDot for hows and whys
dim as axis3 axis0
dim as double angl_i
dim as v3 normal = type(1,2,0).norm
axis0.pos.z = 1.5
while run_time < demo_seconds
var axis = axis0
axis.vx = axis.vx.rodrigues( normal, cos(angl_i), sin(angl_i) )
axis.vy = axis.vy.rodrigues( normal, cos(angl_i), sin(angl_i) )
axis.vz = axis.vz.rodrigues( normal, cos(angl_i), sin(angl_i) )
screenlock
cls
for i as long = 0 to ubound(points)
static as dotvars dotv
dotv.p = axis.rot( points(i) )
dotv.p.z += axis.pos.z
var z_inv = general_scale_2d / max( dotv.p.z, .001 )
dotv.p.x = (axis.pos.x + dotv.p.x) * z_inv + wh
dotv.p.y = (axis.pos.y + dotv.p.y) * z_inv + hh
dotv.rad = min(8, .015*z_inv)
dotv.col = points(i).col
aadot.defocus_draw @dotv
next
var t = timer
dim sng dt = t - tp
tp = t
axis0.pos.z += dt * .3
angl_i += .4 * dt
run_time += dt
static sng dt2, dt_sum
if run_time < 1.75 then
locate 2,2
elseif t > report_next then
dt_sum = dt + dt2
var m = str(report_next)
windowtitle "FPS: " + str( 2 / dt_sum ) '' deltatime avg
report_next += 1
endif
dt2 = dt
screenunlock
sleep 1
wend
locate 2,50
? "done!"
sleep 1500