Help time again please, i am stuck on the "fake?" alpha adding in the update feedback sub.
this works is by fitting as many time a scaled version of the source buffer can fit into the screen area, and is using a colour buffer to use as the range of 0-255.
you can use 0 or 1 in the update stars for a bit of movement.
'
' thanks for the random stuff by blitz amateur
' and rbz for doing the extension to tiny ptc.
'
option explicit
option static
#include once "tinyptc_ext++.bi"
const as integer STAR_QUOTA=100
type image_buffer
as integer wwidth, height
as integer wwidth2, height2
as uinteger ptr r_g_b
end type
declare sub clear_gfx_buffer ( byval buffer as image_buffer ptr )
declare sub create_stars ( byval dest_buffer as image_buffer ptr )
declare sub init_demo ()
declare sub run_demo ()
declare sub spring_clean ()
declare sub update_feedback ( byval dest_buffer as image_buffer ptr, byval srce_buffer as image_buffer ptr )
declare sub update_stars ( byval dest_buffer as image_buffer ptr, byval movement as integer=0 )
declare function create_colours ( byval val1 as integer, byval val2 as integer, byval val3 as integer ) as image_buffer ptr
declare function create_image_buffer( byval wwidth as integer,_
byval height as integer,_
byval mask as uinteger=&h000000 ) as image_buffer ptr
declare function float_rnd ( byval lower as single,_
byval upper as single ) as single
declare function int_rnd ( byval lower as integer,_
byval upper as integer ) as integer
declare function init_graphics ( byval wwidth as integer ,_
byval height as integer ,_
byval title_one as string ,_
byval title_two as string,_
byval windowz as integer=0) as image_buffer ptr
dim shared as image_buffer ptr screen_buffer,_
colour_buffer,_
radial_buffer_one,_
radial_buffer_two
dim shared as integer effect_pos_x, effect_pos_y
dim shared as single star_x( 0 to STAR_QUOTA-1 ),_
star_y( 0 to STAR_QUOTA-1 ),_
star_s( 0 to STAR_QUOTA-1 )
dim shared as integer star_c( 0 to STAR_QUOTA-1 )
init_demo ()
run_demo ()
spring_clean()
sub clear_gfx_buffer( byval buffer as image_buffer ptr )
for a as integer=0 to (buffer->wwidth*buffer->height)-1
buffer->r_g_b[a]=0
next
end sub
sub create_stars( byval dest_buffer as image_buffer ptr )
for a as integer=0 to STAR_QUOTA-1
star_x(a) =float_rnd(0,dest_buffer->wwidth-1)
star_y(a) =float_rnd(0,dest_buffer->height-1)
star_c(a) =int_rnd(32,64)
star_s(a) =int_rnd(1,3)
next
end sub
sub init_demo()
screen_buffer=init_graphics( 640,_
480,_
"radial alpha scaler",_
"full power mode?" )
colour_buffer=create_colours( 4,4,3 )
radial_buffer_one=create_image_buffer( screen_buffer->wwidth2, screen_buffer->height2 )
radial_buffer_two=create_image_buffer( screen_buffer->wwidth2, screen_buffer->height2 )
create_stars( radial_buffer_one )
end sub
sub run_demo()
while inkey<>chr(27)
clear_gfx_buffer( screen_buffer )
clear_gfx_buffer( radial_buffer_one )
update_stars( radial_buffer_one, 0 )
update_feedback( screen_buffer, radial_buffer_one )
ptc_update ( @screen_buffer->r_g_b[0] )
wend
end sub
sub spring_clean()
ptc_close()
end sub
sub update_feedback( byval dest_buffer as image_buffer ptr, byval srce_buffer as image_buffer ptr )
dim as integer x,y,col
dim as integer scale_xx, scale_yy
dim as integer pos_xx, pos_yy
dim as single xx,yy
dim as single scale_x, scale_y, scale_factor=0.85
dim as single pos_x, pos_y
pos_x=srce_buffer->wwidth2
pos_y=srce_buffer->height2
pos_xx=int(pos_x)
pos_yy=int(pos_y)
For y=0 to dest_buffer->height-1
yy=csng(y)
scale_y =pos_y+(yy-pos_y)*scale_factor
scale_yy=int(scale_y)
for x=0 To dest_buffer->wwidth-1
xx=csng(x)
scale_x =pos_x+(xx-pos_x)*scale_factor
scale_xx=int(scale_x)
if scale_xx>0 and scale_xx<srce_buffer->wwidth-1 and scale_yy>0 and scale_yy<srce_buffer->height-1 Then
col=srce_buffer->r_g_b[ (scale_xx)+(scale_yy)*srce_buffer->wwidth]
if col>0 then
dest_buffer->r_g_b[x+y*dest_buffer->wwidth]=colour_buffer->r_g_b[ col ]
srce_buffer->r_g_b[x+y*srce_buffer->wwidth]=srce_buffer->r_g_b[ (scale_xx)+(scale_yy)*srce_buffer->wwidth ]
end If
end If
next
next
end sub
sub update_stars( byval dest_buffer as image_buffer ptr, byval movement as integer=0 )
for a as integer=0 to STAR_QUOTA-1
if movement=1 then
star_y(a)+=star_s(a)
if star_y(a)>dest_buffer->height-1 then
star_y(a) =0
star_x(a) =float_rnd(0,dest_buffer->wwidth-1)
star_s(a) =int_rnd(1,3)
star_c(a) =int_rnd(16,133)
end if
end if
dest_buffer->r_g_b[ (int(star_x(a)))+(int(star_y(a)) )*dest_buffer->wwidth]=star_c(a)
next
end sub
function create_colours( byval val1 as integer, byval val2 as integer, byval val3 as integer ) as image_buffer ptr
dim as image_buffer ptr colours=create_image_buffer(1,256)
dim as integer r,g,b
for a as integer=0 to 255
r+=val1
g+=val2
b+=val3
if r>255 then r=255
if g>255 then g=255
if b>255 then b=255
colours->r_g_b[a]=( r shl 16 ) or ( g shl 16 ) or b
next
return colours
end function
function create_image_buffer( byval wwidth as integer, byval height as integer, byval mask as uinteger=&h000000 ) as image_buffer ptr
dim as image_buffer ptr buffer =callocate(len(image_buffer)+len(uinteger)*wwidth*height)
buffer->r_g_b =cast(uinteger pointer,cast(byte pointer,buffer)+len(image_buffer))
buffer->wwidth =wwidth
buffer->height =height
buffer->wwidth2 =wwidth
buffer->height2 =height
return buffer
end function
function init_graphics( byval wwidth as integer ,_
byval height as integer ,_
byval title_one as string ,_
byval title_two as string ,_
byval windowz as integer ) as image_buffer ptr
randomize timer()*1000.00
if windowz=0 then
ptc_setdialog(1,title_two,0,0)
else
ptc_setdialog( 0,"",0,1)
end if
ptc_allowclose(1)
' open tiny ptc gfx window?
if ( ptc_open( title_one, wwidth, height ) = 0 ) then end -1
return create_image_buffer( wwidth, height )
end function
function int_rnd( byval lower as integer, byval upper as integer) as integer
dim as integer value, dist, temp
if upper < lower then
temp=upper
upper=lower
lower=temp
end If
value=lower
dist = abs(lower-upper)
return ( rnd(1)*dist) + value
end function
function float_rnd(byval lower as single, byval upper as single) as single
dim as single temp, value, dist
if upper < lower then
temp =upper
upper =lower
lower =temp
end if
value = lower
dist = abs(lower-upper)
return (rnd(1)*dist) + value
end function
thankyou kindly,
Tr4nt0r the last st0rm tr00p3r
edit: added exe
