April 25, 2024, 03:01:24 AM

News:

IonicWind Snippit Manager 2.xx Released!  Install it on a memory stick and take it with you!  With or without IWBasic!


Greatings by Jolly roger

Started by pistol350, September 05, 2007, 12:46:00 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

pistol350


openconsole
locate 23,1
print "Press Q to exit"
color 15,9
DECLARE "kernel32",GetTickCount(),int
def sfx[31],sfy[31],snflky,snflkx,r:int
def ch1,ch2,ch3,ch4,ch5,bgimage[22],spcs22,blankline,bckbuffer[22]:string
'set up snowflake initial positions
for snowflake=1 to 30
  sfx[snowflake]=1+rnd(79)
  sfy[snowflake]=-rnd(20)
next snowflake
'set up initial background image
ch1=chr$(255):ch2=ch1+ch1:ch3=ch2+ch1:ch4=ch2+ch2:ch5=ch2+ch3
spcs22="                      "
blankline=spcs22+spcs22+spcs22+"              "
bgimage[8]=spcs22+ch4+"   "+ch5+"   "+ch3+"    "+ch4+"  "+ch5+"   "+spcs22
bgimage[9]=spcs22+ch1+"   "+ch1+"  "+ch1+"      "+ch1+"   "
bgimage[9]=bgimage[9]+ch1+"  "+ch1+"      "+ch1+"       "+spcs22
bgimage[10]=spcs22+ch1+"   "+ch1+"  "+ch1+"      "+ch1+"   "
bgimage[10]=bgimage[10]+ch1+"  "+ch1+"      "+ch1+"       "+spcs22
bgimage[11]=spcs22+ch4+"   "+ch5+"  "+ch5+"  "+ch1+"      "+ch5+"   "+spcs22
bgimage[12]=spcs22+ch1+"      "+ch1+"      "+ch1+"   "+ch1+"  "+ch1+"      "+ch1+"       "+spcs22
bgimage[13]=bgimage[12]
bgimage[14]=spcs22+ch1+"      "+ch5+"  "+ch1+"   "+ch1+"   "+ch4+"  "+ch5+"   "+spcs22
for row=1 to 7
  bgimage[row]=blankline
  bgimage[row+14]=blankline
next row
lastframetime=GetTickCount()
'main loop
do
  'move snowflakes down one line
  for snowflake=1 to 30
    sfy[snowflake]=sfy[snowflake]+1
    'if off bottom of display area,reset to top
    if sfy[snowflake]>21 then gosub resetsnowflake
  next snowflake
  for snowflake=1 to 30
    'check if in position can stick
    if (sfy[snowflake]>7) & (sfy[snowflake]<15) & (sfx[snowflake]>22) & (sfx[snowflake]<56)
      snflky=sfy[snowflake]:snflkx=sfx[snowflake]
      if mid$(bgimage[snflky],snflkx,1)=ch1
        'make snowflake stick by copying snowflake character onto background image
        bgimage[snflky]=left$(bgimage[snflky],snflkx-1)+"*"+mid$(bgimage[snflky],snflkx+1)
        'reset snowflake to top of screen
        gosub resetsnowflake
      endif
    endif
  next snowflake
  'copy background image to backbuffer
  for row=1 to 21
    bckbuffer[row]=bgimage[row]
  next row
  'draw snowflakes to backbuffer
  for snowflake=1 to 30
    if sfy[snowflake]>0
      snflky=sfy[snowflake]:snflkx=sfx[snowflake]
      bckbuffer[snflky]=left$(bckbuffer[snflky],snflkx-1)+"*"+mid$(bckbuffer[snflky],snflkx+1)
    endif
  next snowflake
  'wait loop so runs at 10 frames per second
  do
    timesincelastframe=GetTickCount()-lastframetime
  until timesincelastframe>=100
  lastframetime=GetTickCount()
  'show backbuffer
  locate 1,1
  for row=1 to 21
    print bckbuffer[row],
  next row
until ucase$(inkey$)="Q"
closeconsole
end

sub resetsnowflake
  sfy[snowflake]=1
'weight snowflake x position so stick more evenly
  r=rnd(40)
  select r
    case 1
      sfx[snowflake]=23
    case 2
      sfx[snowflake]=30
    case 3
      sfx[snowflake]=37
    case 4
      sfx[snowflake]=41
    case 5
      sfx[snowflake]=44
    case 6
      sfx[snowflake]=51
    default
      sfx[snowflake]=1+rnd(79)
  endselect
return
Regards,

Peter B.