Code: Select all
const NFLEKS = 10000
type tFlake
as integer x,y
end type
sub InitFlake(iWidth as integer,iHeight as integer,byref aFlake as tFlake)
with aFlake
.y = -(iHeight*2)*rnd -1
.x = 1 + rnd*(iWidth-2)
end with
end sub
sub InitFlakes(iWidth as integer,iHeight as integer,flakes() as tFlake)
for i as integer=0 to NFLEKS-1
InitFlake(iWidth,iHeight,flakes(i))
next
end sub
function Init(iWidth as integer,iHeight as integer,flakes() as tFlake) as any ptr
const as string msg="MERRY CHRISTMAS!"
const as integer nChars=len(msg)
initFlakes(iWidth,iHeight,flakes())
var bg = imagecreate(iWidth,iHeight)
var txt= imagecreate(nChars*8,8)
draw string txt,(0,0),msg,15
var size=iWidth/(nChars*8)
var xs=(iWidth/2)-(nChars*4*size)
var ys=iHeight/2
for y as integer=0 to 7
var w=0.0
for x as integer=0 to nChars*8-1
if point(x,y,txt)<>0 then
line bg,(xs+40+x*size,(ys+sin(w)*size) + y*size)-step(size-1,size+2),32+x\2,BF
end if
w+=0.1
next
xs-=8
next
ImageDestroy(txt)
return bg
end function
sub UpdateFlakes(byval fg as any ptr, _
byval bg as any ptr, _
flakes() as tFlake)
static as integer iWidth,iHeight,iPitch,bgPitch
static as ubyte ptr FGPixels,BGPixels
dim as integer x,y,index,index2
if iPitch=0 orelse FGPixels=0 orelse BGPixels=0 then
imageinfo fg,iWidth,iHeight,,iPitch,FGPixels
imageinfo bg, , ,, ,BGPixels
line bg,(0,iHeight-1)-step(iWidth-1,0),15
end if
line fg,(0,0)-(iWidth-1,iHeight-1),0,BF
for i as integer=0 to NFLEKS-1
with flakes(i)
if .y<0 then
.y+=1
else
index=.y*iPitch+.x
index2=index+iPitch
if .y=iHeight-1 then
BGPixels[index]=15
InitFlake(iWidth,iHeight,flakes(i))
elseif BGPixels[index2]=0 then
FGPixels[index2]=15 : .y+=1
elseif BGPixels[index2-1]=0 then
.x-=1 : .y+=1
if .x<0 then
InitFlake(iWidth,iHeight,flakes(i))
BGPixels[index]=15
else
FGPixels[index2-1]=15
end if
elseif BGPixels[index2+1]=0 then
.x+=1 : .y+=1
if .x=iWidth then
InitFlake(iWidth,iHeight,flakes(i))
BGPixels[index]=15
else
FGPixels[index2+1]=15
end if
elseif BGPixels[index2-1]=0 andalso BGPixels[index-1]=0 then
FGPixels[index-1]=15
.x-=1
elseif BGPixels[index2+1]=0 andalso BGPixels[index+1]=0 then
FGPixels[index+1]=15
.x+=1
else
BGPixels[index]=15
InitFlake(iWidth,iHeight,flakes(i))
end if
end if
end with
next
end sub
'
' main
'
dim as tFlake Flakes(NFLEKS-1)
dim as integer iWidth,iHeight
screeninfo iWidth,iHeight
iWidth*=0.9
iHeight*=.5
screenres iWidth,iHeight
var fg=imagecreate(iWidth,iHeight)
var bg=init(iWidth,iHeight,flakes())
while inkey()=""
UpdateFlakes(fg,bg,flakes())
ScreenLock
put (0,0),bg,PSET
put (0,0),fg,TRANS
ScreenUnlock
Sleep 8
wend