version 1 - absolute beginner
Code: Select all
/' window fill via pointer - 2024 May 16 by dafhi
'/
type t_image_info
dim as long w,h, bypp,bpp, pitch,rate
dim as any ptr pixels, im
dim as string driver_name
end type
sub _gfx_release( byref i as t_image_info )
if imageinfo(i.im) = 0 then imagedestroy i.im
i.im = 0
end sub
sub get_screen( byref i as t_image_info )
_gfx_release i
ScreenInfo i.w, i.h, i.bpp, i.bypp, i.pitch, i.rate, i.driver_name
i.pixels = screenptr
end sub
sub fill( byref i as t_image_info, c as ulong = rgb(255,255,255) )
for y as long = 0 to i.h - 1
'' y * bytes per scanline
var p = cast( ulong ptr, i.pixels + y * i.pitch )
for x as long = 0 to i.w - 1
p[x] = c
next
next
end sub
screenres 800,600,32
dim as t_image_info buf
get_screen buf
fill buf, rgb(0,0,255)
sleep
example 2 - intermediate level. clipi rects have insane value, easily guarding against pointer errors during development
Code: Select all
/' clipped window fill via pointer - 2024 May 17 by dafhi
if you're a beginner, have a look at the For-Next loops in Fill()
update:
added whitespace to make Fill() stand out more
dark green is new fill color
'/
type t_image_info
dim as long w,h, bypp,bpp, pitch,rate
dim as any ptr pixels, im
dim as string driver_name
end type
sub _gfx_release( byref i as t_image_info )
if imageinfo(i.im) = 0 then imagedestroy i.im
i.im = 0
end sub
sub get_screen( byref i as t_image_info )
_gfx_release i
ScreenInfo i.w, i.h, i.bpp, i.bypp, i.pitch, i.rate, i.driver_name
i.pixels = screenptr
end sub
type clip_rect field = 2 '' 2 byte alignment
as short x, y
as short w, h
end type
#define min( a, b) iif( (a)<(b), (a), (b) )
#define max( a, b) iif( (a)>(b), (a), (b) )
sub _bounds_from_cliprect( byref cr as clip_rect, i as t_image_info, _
byref x0 as long, byref y0 as long, byref x1 as long, byref y1 as long )
if cr.w < 1 or cr.h < 1 then cr = type( 0,0, i.w, i.h )
x0 = max( cr.x, 0 )
y0 = max( cr.y, 0 )
x1 = min( x0 + cr.w - 1, i.w - 1 )
y1 = min( y0 + cr.h - 1, i.h - 1 )
end sub
sub Fill( byref i as t_image_info, c as ulong = rgb(255,255,255), cr as clip_rect = type(0,0,-1,-1) )
static as long x0,y0,x1,y1, y, x
_bounds_from_cliprect cr, i, x0,y0,x1,y1
for y = y0 to y1 '' y * bytes per scanline
var p = cast( ulong ptr, i.pixels + y * i.pitch )
for x = x0 to x1
p[x] = c
next
next
end sub
screenres 800,600,32
dim as t_image_info buf
get_screen buf
var x = 10
var y = 10
var w = buf.w - x * 2
var h = buf.h - y * 2
fill buf, rgb(0,128,0), type<clip_rect>( x,y, w, h )
sleep
- extra .. my new anti-aliased dot.. will probably post in own thread later
Code: Select all
/' anti-aliased dots - 2024 May 19 by dafhi
uses 1 sqr() per dot y
no if's in the render loop
custom RNG boosts performance 10% on my Linux
check your system: comment out lines 183, 184
'/
#define dbl as double '' reduced text
#define sng as single
function int2float( i as ulongint) dbl
return i / (2^64 + 2^12)
end function
namespace rng '' namespace allows local shared variables
dim as ulongint aa = 1, bb, a,b
sub states( a as ulongint = 1, b as ulongint = 0 )
aa = a
bb = b
end sub
function valu dbl
'' https://stackoverflow.com/questions/34426499/what-is-the-real-definition-of-the-xorshift128-algorithm
a = aa
b = bb
aa = b
a xor= a shl 23
a xor= a shr 18
a xor= b
a xor= b shr 5
bb = a
return int2float( a + b )
end function
end namespace '' rng
#define min( a, b) iif( (a)<(b), (a), (b) )
#define max( a, b) iif( (a)>(b), (a), (b) )
namespace my_drawspace '' 2024 May 19
type t_image_info
dim as long w,h, bypp, pitch,rate
dim as any ptr pixels, im
dim as string driver_name
end type
sub _gfx_release( byref i as t_image_info )
if imageinfo(i.im) = 0 then imagedestroy i.im
i.im = 0
end sub
sub _get_screen( byref i as t_image_info )
_gfx_release i
ScreenInfo i.w, i.h, , i.bypp, i.pitch, i.rate, i.driver_name
i.pixels = screenptr
end sub
sub _get_image( byref i as t_image_info, im as any ptr )
_gfx_release i
ImageInfo im, i.w, i.h, i.bypp, i.pitch, i.pixels
i.im = im
end sub
dim as t_image_info _im
dim as long wm, hm
sub render_target( im as any ptr ) '' a main sub
if im = 0 then
_get_screen _im
else
_get_image _im, im
endif
wm = _im.w - 1
hm = _im.h - 1
end sub
type t_draw_area field = 2 ' 2 byte elems
dim as short x0, y0
dim as short x1, y1
end type
sub _calc_cliprect( byref rc as t_draw_area, x as single, y as single, _
x1 as single, y1 as single )
rc.x0 = max( 0, x )
rc.y0 = max( 0, y )
rc.x1 = min( wm, x1 )
rc.y1 = min( hm, y1 )
end sub
function _window_initialized as boolean
return _im.h > 0
end function
end namespace '' my_drawspace
#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
namespace my_aadot '' 2024 May 19
dim as long a, x0, x1
dim as single sa, x, y, r, rSq, pel_y5, dySq, dx
sub _x_intercepts
dim as single q = sqr( rSq - (y-pel_y5)^2 )
x0 = max( int(x - q + .5), 0 )
x1 = min( int(x + q - .5), my_drawspace.wm )
dySq = (pel_y5 - y)^2
pel_y5 += 1
end sub
dim as my_drawspace.t_draw_area rc
sub draw( _x as single = 0, _y as single = 0, _r as single = 50, c as ulong = -1 )
using my_drawspace
if not _window_initialized then exit sub
x = _x
y = _y
r = _r
'' extras to y to prevent oob x0 x1 where radius nearly = y0 or y1
my_drawspace._calc_cliprect rc, x-r, y-r+.0001, x+r-1, y+r-1.0001
pel_y5 = rc.y0 + .5
rSq = r * r
sa = 256.4999 * (255-(c shr 24)) / 255 / rSq
for iy as long = rc.y0 to rc.y1
_x_intercepts
var p = cast( ulong ptr, _im.pixels + iy * _im.pitch ) '' pitch = bytes per scanline
for ix as long = x0 to x1
dx = (ix+.5 - x)
a = 256 - sa * (dx*dx + dySq)
alpha256( p[ix], p[ix], c, a )
next
next
end sub
end namespace '' my_aadot
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
var w = 800
var h = 600
screenres w,h, 32
my_drawspace.render_target 0
dim dbl fps_update_interval = 1
dim dbl fps0,fps1, t,t0=timer,tp
dim dbl t_report_next = t + fps_update_interval
#undef rnd
#define rnd rng.valu
do
tp = t
t = timer-t0
rng.states 1,0
randomize 0
screenlock
line(0,0)-(w,h), rgb(19,19,19), bf
for i as long = 1 to 9999
var offs = 1.5 + rnd * rnd* 95
var a = rnd*6.28 + t * 1 * (rnd - .5)
#define q rnd*255.4999
my_aadot.draw _
rnd * w + offs*cos(a), _
rnd * h + offs*sin(a), _
rnd*rnd*rnd*9, rgba(q,q,q,rnd*40)
next
screenunlock
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 )
endif
if inkey<>"" then end
sleep 5
loop while t < 40
? "fin!"
sleep