Show Posts
This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.
In 3 lines, delta timed:Code: [Select]#Include Once "tinyptc.bi"
If( ptc_open( "PARALAX STARFIELD BY SHOCKWAVE", 800, 600 ) = 1 ) Then dim shared buffer(800*600) as double, px(200),py(200) as double ,ps(200) as double:for n=0 to 200:px(n)=rnd(1)*790:py(n)=rnd(1)*590:ps(n)=1+(rnd(1)*5):next :dim shared dv as double, old as double
0 for n=0 to 200: old=timer: if px(n)>0 and px(n)<800 then buffer(int(px(n))+(int(py(n))*800))=&hffffff: px(n)=px(n)+(ps(n)*dv) else px(n)=1: end if:next:ptc_update@buffer(0): sleep 1: dv=(timer-old)*40:erase buffer:if inkey$="" then 0
#include once "tinyptc_ext.bi"
const xres=640,yres=480,sf=512:Dim shared as integer size,q,w,a,x(sf),y(sf),s(sf),sb(xres*yres):size=8
for a=0 to sf-1:x(a)=(int(rnd(1)*xres)-1):y(a)=1+(int(rnd(1)*yres)-1):s(a)=1+(int(rnd(1)*8)):next:ptc_setdialog(0,"Fullscreen?",0,1)
If( ptc_open( "Starfield in less than 10 lines of code", XRES, YRES ) = 0 ) Then
End -1:End If
#define pp(x,y,argb) sb(y*XRES+x)=argb
While(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE):for a=0 to sf-1: x(a)=x(a)-s(a):if x(a)<=0 then x(a)=(xres-1):y(a)=1+(int(rnd(1)*yres)-1)
for q=1 to size:for w=1 to size:if x(a)+q>0 and x(a)+q<xres-3 and (y(a)+w)>0 and (y(a)+w)<yres-2 then pp(x(a)+q,(y(a)+w),rgb(s(a)*16,s(a)*16,s(a)*16))
next:next:next:ptc_update @sb(0):erase sb:Wend:ptc_close():end
Keep up the fantastic work. Massive thanks mate and Karma+ #include once "fmod.bi"
#Include once "tinyptc_ext.bi"
Dim Shared As Integer Xres,Yres,Value
Xres=640:Yres=480:Value=0
Dim Shared As Integer MySong
Dim Shared As Uinteger Buffer(XRES*YRES)
#define pp(x,y,argb) buffer(y*XRES+x)=argb
FSOUND_Init(48000, 4, 0)
MySong = FSOUND_Sample_Load(FSOUND_FREE, "StangeByDPC.mp3", 0, 0, 0)
FSOUND_Sample_SetMode(MySong, FSOUND_LOOP_NORMAL)
FSOUND_DSP_GetFFTUnit()
PTC_ALLOWCLOSE(0)
PTC_SETDIALOG(0,"MP3 Player Test",1,0)
IF (PTC_OPEN("Coded by AndyRCM aka DrewPee",XRES,YRES)=0) THEN
END-1
END IF
FSOUND_PlaySound(FSOUND_FREE, MySong)
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
PTC_UPDATE@Buffer(0)
FSOUND_Update
value=FSOUND_DSP_GetSpectrum()
print value;" ";
WEND
Just me being dumb (as usual). Very much appreciated!
'
' draw image alpha
' for drewpee.
'
option explicit
option static
Dim Shared as Integer bc,a,qq
bc=256
Dim Shared as Integer x(bc),y(bc),x1(bc),y1(bc),alp(bc)
const as integer SCREEN_WWIDTH=640
const as integer SCREEN_HEIGHT=480
const as integer IMAGE_WWIDTH=24
const as integer IMAGE_HEIGHT=24
#include once "tinyptc_ext++.bi"
dim shared as uinteger screen_buffer( SCREEN_WWIDTH * SCREEN_HEIGHT )
dim shared as uinteger image_buffer ( IMAGE_WWIDTH * IMAGE_HEIGHT )
declare sub draw_image_alpha( byval pos_x as integer, byval pos_y as integer, byval alpha_val as integer )
declare sub graphics ( byval title as string, byval wwidth as integer, byval height as integer, byval options as integer=1 )
declare sub init_demo ()
declare sub run_demo ()
declare function alpha_blend( byval col1 as uinteger, byval col2 as uinteger, byval alpha as integer ) as uinteger
for a=1 to bc
x(a)=int(rnd(1)*(SCREEN_WWIDTH-image_wwidth))
y(a)=int(rnd(1)*(SCREEN_HEIGHT-image_height))
qq=int(rnd(1)*16)
if qq<=8 then x1(a)=1+int(rnd(1)*2):y1(a)=1+int(rnd(1)*2)
if qq>=9 then x1(a)=-1+int(rnd(1)*-2):y1(a)=-1+int(rnd(1)*-2)
alp(a)=32+int(rnd(1)*128)
next a
init_demo()
run_demo()
sub clear_screen()
for a as integer=0 to (SCREEN_WWIDTH*SCREEN_HEIGHT)-1
screen_buffer(a)=0
next
end sub
sub draw_image_alpha( byval pos_x as integer, byval pos_y as integer, byval alpha_val as integer )
dim as integer alpha_col=256-alpha_val
dim as integer x,y
dim as uinteger col1, col2
for y=0 to IMAGE_HEIGHT-1
for x=0 to IMAGE_WWIDTH-1
if ((x+pos_x)>0) and ((x+pos_x)<SCREEN_WWIDTH-1) and ((y+pos_y)>0) and ((y+pos_y)<SCREEN_HEIGHT-1) then
col1=screen_buffer( (x+pos_x)+(y+pos_y)*SCREEN_WWIDTH )
col2= image_buffer( (x) +(y) * IMAGE_WWIDTH )
' method 1.
if col2<>0 then screen_buffer((x+pos_x)+(y+pos_y) * SCREEN_WWIDTH )= alpha_blend( col1, col2, alpha_val )
' method 2.
if col2<>0 then
screen_buffer( ( x+pos_x )+( y+pos_y ) * SCREEN_WWIDTH )= _
((((col1 and &hff00ff ) *alpha_val+( col2 and &hff00ff )*alpha_col ) and &hff00ff00 ) shr 8 ) or _
((((col1 and &hff00ff00) shr 8)*alpha_val+((col2 and &hff00ff00) shr 8 )*alpha_col ) and &hff00ff00 )
end if
end if
next
next
end sub
sub graphics( byval title as string, byval wwidth as integer, byval height as integer, byval options as integer=1 )
if options=0 then
ptc_setdialog( 1, "full screen mode?", 0, 0 )
else
ptc_setdialog( 0, "", 0, 1 )
end if
ptc_allowclose( 1 )
if ( ptc_open( title, wwidth, height )=0 ) then end -1
end sub
sub init_demo()
graphics( "dRaw IMaGe aLPhA", 640, 480 )
dim as integer x,y
for y=0 to image_height-1
for x=0 to image_wwidth-1
image_buffer( (x)+(y)*image_wwidth )=&hffffd000' mellow yellow with alpha channel set to 255
next
next
end sub
sub run_demo()
while inkey<>chr(27)
clear_screen()
for a=1 to bc
draw_image_alpha(x(a),y(a),alp(a))
x(a)=x(a)+x1(a)
y(a)=y(a)+y1(a)
if x(a)>=(SCREEN_WWIDTH-image_wwidth) then x1(a)=-x1(a)
if x(a)<=0 then x1(a)=-x1(a)
if y(a)>=(SCREEN_HEIGHT-image_height) then y1(a)=-y1(a)
if y(a)<=0 then y1(a)=-y1(a)
next a
ptc_update ( @screen_buffer(0) )
wend
end sub
function alpha_blend( byval col1 as uinteger, byval col2 as uinteger, byval alpha as integer ) as uinteger
dim as integer inv_alpha
dim as integer r,g,b
dim as integer r1,r2
dim as integer g1,g2
dim as integer b1,b2
if alpha > 255 then alpha = 255
if alpha < 0 then alpha = 0
inv_alpha = 255 - alpha
r1=( col1 shr 16) and &hff
g1=( col1 shr 8) and &hff
b1=( col1 ) and &hff
r2=(col2 shr 16) and &hff
g2=(col2 shr 8 ) and &hff
b2=(col2 ) and &hff
r=(( r1 * alpha ) or ( r2 * inv_alpha)) shr 8
g=(( g1 * alpha ) or ( g2 * inv_alpha)) shr 8
b=(( b1 * alpha ) or ( b2 * inv_alpha)) shr 8
return (r shl 16)or(g shl 8)or(b)
end function