Sorry your browser is not supported!

sync on
sync rate 25
hide mouse
autocam off
position camera 0,5,0
color backdrop rgb(100,100,155)
fog on
fog color rgb(100,100,155)
fog distance 2000

`grass
for x=1 to 10
for y=1 to 10
ink rgb(rnd(100),rnd(155)+100,0),0
dot x,y
next y
next x
get image 1000,1,1,10,10
make object plain 1000,2000,2000
xrotate object 1000,-90
texture object 1000,1000
scale object texture 1000,10,10
set object texture 1000,2,0

`particle properties
numberofparticles=10000
dim x#(numberofparticles)
dim y#(numberofparticles)
dim xspeed#(numberofparticles)
dim yspeed#(numberofparticles)
dim brightness(numberofparticles)
dim a#(numberofparticles)
dim e#(numberofparticles) `phase angle
for particle=1 to numberofparticles
x#(particle)=rnd(screen width())
y#(particle)=rnd(screen height())
xspeed#(particle)=(rnd(3000)/1000.0)
e#(particle)=rnd(360)
brightness(particle)=rnd(100)+100
a#(particle)=gaussian(2*screen width())-screen width() `amplitude
gravitya#=.01
gravityb#=1.0
omega#=0.0006 `primary angular velocity
phi#=2.0 `secondary angular velocity
next particle

do
inc counter
if counter>1000 then counter=0
if counter=100 or counter=110 or counter=400
color backdrop rgb(255,255,255)
else
color backdrop rgb(100,100,155)
endif

gosub particles
control camera using arrowkeys 0,1,1
if counter/2.0=int(counter/2.0) then sync
loop

particles:

text 0,0,str$(screen fps())
lock pixels

`tornado particles
for particle=1 to numberofparticles step 2
inc y#(particle),gravityb#
if y#(particle)>0 and y#(particle)<screen height() and x#(particle)>0 and x#(particle)<screen width() then set_locked_pixel(x#(particle),y#(particle),rgb(brightness(particle),brightness(particle),200))
x#(particle)=(500/y#(particle)^1.5)*a#(particle)*sin(theta#+e#(particle))+screen width()/2+(20*sin(y#(particle)+psi#))
theta#=wrapvalue(theta#)+omega#
if y#(particle)>=screen height()/1.5 then dec y#(particle),screen height()
next particle
psi#=wrapvalue(psi#)+phi#

`background particles
for particle=2 to numberofparticles step 2
inc y#(particle),gravityb#
if y#(particle)>screen height()-1 then y#(particle)=1
if y#(particle)>0 and y#(particle)<screen height() and x#(particle)>0 and x#(particle)<screen width() then set_locked_pixel(x#(particle),y#(particle),rgb(brightness(particle),brightness(particle),200))
inc x#(particle),xspeed#(particle)
if x#(particle)>screen width()-1 then x#(particle)=1
next particle
unlock pixels
return

`Function borrowed from Coding Fodder's Rain code
function set_locked_pixel(x,y,color_value)
   start=get pixels pointer()
   repeat_number=get pixels pitch()
   bits_per_pixel=bitmap depth(num)/8
   pointer=start+y*repeat_number+x*bits_per_pixel
   *pointer=color_value
endfunction



function gaussian(range#)

   r=0
   for a = 1 to range#/10
      inc r, rnd(range#)
   next a

   r=int(10*r/range#)

endFunction r

rem catmullrom vector order: control, pt1, pt2, control
rem hermite vector order: pt1, control, pt2, control

set display mode 800,600,32

randomize timer()

rem 2d vector type
type vector
   x as float
   y as float
   w as float
endtype


rem 2 vectors as line segment's endpoints, 2 vectors for control points
type hermiteline
   a as vector
   b as vector
   c as vector
   d as vector
endtype


rem number of points defining hermite spline
spline_total = 5

rem get screen dimensions
width = screen width()
height = screen height()

rem array of hermite splines
dim spline(spline_total) as hermiteline

for t = 1 to spline_total
   if t > 1
      spline(t).a.x = spline(t-1).c.x
      spline(t).a.y = spline(t-1).c.y
      spline(t).b.x = spline(t-1).d.x
      spline(t).b.y = spline(t-1).d.y
   else
      spline(t).a.x = rnd(width)
      spline(t).a.y = rnd(height)
      spline(t).b.x = (rnd(200)-100) + spline(t).a.x
      spline(t).b.y = (rnd(200)-100) + spline(t).a.y
   endif
   spline(t).c.x = rnd(width)
   spline(t).c.y = rnd(height)
   spline(t).d.x = (rnd(200)-100) + spline(t).c.x
   spline(t).d.y = (rnd(200)-100) + spline(t).c.y
next t


rem vector points for hermite splines
null = make vector2(1)
null = make vector2(2)
null = make vector2(3)
null = make vector2(4)

rem result vector
null = make vector2(5)
null = make vector2(6)


rem more steps mean a smoother curve in the spline
steps = 20

rem colors of rainbow
dim colors(7) as dword
colors(1) = rgb(255,0,0)
colors(2) = rgb(213,0,213)
colors(3) = rgb(0,0,255)
colors(4) = rgb(0,255,255)
colors(5) = rgb(0,255,0)
colors(6) = rgb(255,255,0)
colors(7) = rgb(255,0,0)

p_total = 100
dim particles(p_total) as vector
for t = 1 to p_total
   particles(t).x = rnd(width)
   particles(t).y = 0
   particles(t).w = rnd(5)+1
next t

DO
   cls

   for t = 1 to spline_total
      rem allow user to click on spline point
      if mouseclick() and movePoint = 0
         if abs(mousex()-spline(t).a.x) < 4 and abs(mousey()-spline(t).a.y) < 4 then movePoint = t
      endif

      rem create hermite spline
      for s = 1 to steps
         rem get the 4 vectors
         set vector2 1,spline(t).a.x,spline(t).a.y
         set vector2 2,spline(t).b.x,spline(t).b.y
         set vector2 3,spline(t).c.x,spline(t).c.y
         set vector2 4,spline(t).d.x,spline(t).d.y

         time# = s
         hermite vector2 5,1,2,3,4,(time#-1.0)/steps
         hermite vector2 6,1,2,3,4, time#/steps

         rem make rainbow
         offset = -6
         c = 1
         for r = 1 to 6
            ink colors(c),0
            line x vector2(5), y vector2(5)+offset,x vector2(6), y vector2(6)+offset
            line x vector2(5), y vector2(5)+offset+1,x vector2(6), y vector2(6)+offset+1
            inc offset,2
            inc c
         next r

         rem draw circle to show spline points
         ink rgb(255,255,255),0
         circle spline(t).a.x,spline(t).a.y,4
         circle spline(t).c.x,spline(t).c.y,4

      next s
   next t


   rem rain particles
   lock pixels
      for p = 1 to p_total

      particles(p).y = particles(p).y + particles(p).w

      for t = 1 to spline_total

         rem create hermite spline
         for s = 1 to steps
            rem get the 4 vectors
            set vector2 1,spline(t).a.x,spline(t).a.y
            set vector2 2,spline(t).b.x,spline(t).b.y
            set vector2 3,spline(t).c.x,spline(t).c.y
            set vector2 4,spline(t).d.x,spline(t).d.y

            time# = s
            hermite vector2 5,1,2,3,4,(time#-1.0)/steps
            hermite vector2 6,1,2,3,4, time#/steps

            x1 = x vector2(5)
            y1 = y vector2(5)
            x2 = x vector2(6)
            y2 = y vector2(6)
            rem keep low to high order of points
            if x2 < x1
               temp = x1
               x1 = x2
               x2 = temp
               temp = y1
               y1 = y2
               y2 = temp
            endif

            if particles(p).x >= x1 and particles(p).x <= x2
               if point_line(particles(p).x, particles(p).y, x1, y1, x2, y2) >= 0
                  particles(p).x = rnd(width)
                  particles(p).y = 0
               endif
            endif

            if particles(p).y >= height
               particles(p).x = rnd(width)
               particles(p).y = 0
               particles(p).w = rnd(5)+1
            endif

         next s
      next t
      rem draw raindrop
      set_locked_pixel(particles(p).x, particles(p).y, rgb(255,255,255))
   next p
   unlock pixels



   rem allow user to move spline points (control points stay in original locations)
   if movePoint > 0
      spline(movePoint).a.x = mousex()
      spline(movePoint).a.y = mousey()
      if movePoint > 1
         spline(movePoint-1).c.x = spline(movePoint).a.x
         spline(movePoint-1).c.y = spline(movePoint).a.y
      endif
   endif

   if mouseclick() = 0 then movePoint = 0

   if spacekey() then resetSplines(spline_total)

loop



REM give new random coordinates for points
function resetSplines(spline_total as integer )
   for t = 1 to spline_total
      if t > 1
         spline(t).a.x = spline(t-1).c.x
         spline(t).a.y = spline(t-1).c.y
         spline(t).b.x = spline(t-1).d.x
         spline(t).b.y = spline(t-1).d.y
      else
         spline(t).a.x = rnd(width)
         spline(t).a.y = rnd(height)
         spline(t).b.x = (rnd(200)-100) + spline(t).a.x
         spline(t).b.y = (rnd(200)-100) + spline(t).a.y
      endif
      spline(t).c.x = rnd(width)
      spline(t).c.y = rnd(height)
      spline(t).d.x = (rnd(200)-100) + spline(t).c.x
      spline(t).d.y = (rnd(200)-100) + spline(t).c.y
   next t
endfunction


REM if point(px,py) is right or left of line segment (x1,y1),(x2,y2)
REM return negative if left, positive if right, 0 if on
function point_line(px#,py#, x1#,y1#,x2#,y2#)
   dp# = (x2# - x1#) * (py# - y1#) - (px# - x1#) * (y2# - y1#)
endfunction dp#


REM function borrowed from Coding Fodder's Rain code
function set_locked_pixel(x as integer, y as integer, color_value as dword )
   start = get pixels pointer()
   repeat_number = get pixels pitch()
   bits_per_pixel = bitmap depth(num)/8
   pointer = start + y*repeat_number + x*bits_per_pixel
   *pointer = color_value
endfunction

make object box 1,4000,5,4000
color object 1,RGB(00,00,00)
make object sphere 2,25
color object 2,RGB(100,100,100)

randomize timer()
set ambient light 0 : make light 1
position light 1,1000,1000,1000
point light 1,1000,0,1000
set light range 1,1500
sync on : sync rate 1000

color ambient light RGB (250,250,250)

do
if upkey() = 1 then move object 2,7

if leftkey()=1 then ya =  wrapvalue(ya-1)
if rightkey()=1 then ya =  wrapvalue(ya+1)
yrotate object 2,ya

x#=object position x(2)
y#=object position y(2)
z#=object position z(2)
a#=object angle y(2)
d#=250
h#=185
s#=40
set camera to follow x#,y#,z#,a#,d#,h#,s#,1
set ambient light 0
hide light 1
light = rnd(400)
color backdrop RGB(50,50,50)
if light = 5 then : lightning = 1 : count = 30
if lightning = 1 and count > 0 then set ambient light 100 : color backdrop RGB(150,150,150)


dec count
sync
loop

REM Project: Weather challenge
REM Created: 2/10/2005 9:01:35 PM
REM By Coding Fodder
REM ***** Main Source File *****
REM
REM Not cleaned up yet Kinda trashy coding with cool results

sync on:sync rate 0
autocam off
fog on
position camera 2500,500,2500
global strike
global strike2
global counter
global counter2
x_size=5000
z_size=5000
x_tiles=100
z_tiles=100
seed=0

if seed=0 then seed=timer()

type matrix
   x_grids as integer
   z_grids as integer
   grid_spacing as float
endtype

dim matrices(4) as matrix

create bitmap 1,16,16
make memblock from bitmap 1,1
for i=0 to 15
   for j=0 to 15
      read color
      set_memblock_pixel(1,i,j,color)
   next j
next i
make bitmap from memblock 1,1
delete memblock 1
get image 1,0,0,15,15



make matrix 1,5000,5000,100,100
position matrix 1,50,-10,50

for m=1 to 2
   my_matrix(m,100,100,50)
   Matrix_form_function(m,"seed "+str$(seed)+" sin 150 200 1,150 200 1 0 5 3,0 5 3 5 10 3,5 10 3 8 15 3,8 15 3 0 10 3,0 10 3 0 8 3,0 8 3 roughen 6 300 ",2,700)
   set_matrix_normals(m)
   if m=1
   for i=1 to 100
      for j=1 to 100
         set_uv(m,i,j,(i-1)/10.0,(j-1)/10.0)
      next j
   next i
   endif

   make mesh from memblock m,m
   change mesh m,0,m
   texture object m,1
next m
`remstart
create bitmap 3,12,1
make memblock from bitmap 3,3
for i=0 to 11
   read color
   set_memblock_pixel(3,i,0,color)
next i
make bitmap from memblock 3,3
set current bitmap 0
lock pixels
for i=1 to 256
   for j=1 to 256
      x#=i*100.0/256.0*50.0
      z#=j*100.0/256.0*50.0
      h#=get ground height(1,x#,z#)
      hmap=0
      if h#>30.0 then hmap=1
      if h#>70.0 then hmap=2
      if h#>120.0 then hmap=3
      if h#>170.0 then hmap=4
      if h#>220.0 then hmap=5
      if h#>270.0 then hmap=6
      if h#>320.0 then hmap=7
      if h#>370.0 then hmap=8
      if h#>420.0 then hmap=9
      if h#>470.0 then hmap=10
      if h#>520.0 then hmap=11
      color=get_memblock_pixel(3,hmap,0)
      red=rgbr(color)
      green=rgbg(color)
      blue=rgbb(color)
      red=red+rnd(20)-10
      blue=blue+rnd(20)-10
      green=green+rnd(20)-10
      if red<0 then red=0
      if green<0 then green=0
      if blue<0 then blue=0
      if red>255 then red=255
      if green>255 then green=255
      if blue>255 then blue=255
      set_locked_pixel(256-i,256-j,rgb(red,green,blue))
   next j
next i
delete memblock 3
delete bitmap 3
delete memblock 1
delete memblock 2
delete bitmap 1
unlock pixels
get image 2,0,0,255,255
texture object 2,2

set current bitmap 0
ghost object on 2
make object plain 3,5000,5000
xrotate object 3,-90
create bitmap 3,640,480
color=rgb(0,0,200)
box 0,0,640,480,color,color,color,color
get image 3,0,0,639,479
texture object 3,3

set object specular 3,rgb(0,0,200)
set object specular power 3,100

set current bitmap 0
ghost object on 3
position object 3,2500,0,2500

make object plain 4,640,480
position object 4,0,0,50
lock object on 4
color object 4,RGB(255,255,255)
ghost object on 4

`hide object 1
hide object 4

create bitmap 10,8,64
make memblock from bitmap 10,10
for j=0 to 63
   for i=0 to 7
      read color
      set_memblock_pixel(10,i,j,color)
   next i
next j
make bitmap from memblock 10,10
delete memblock 10
get image 10,0,0,7,63

sprite 1,0,0,10
set current bitmap 0
do
   angle#=wrapvalue(angle#+0.5)
   wave#=sin(angle#)*5
   position object 3,2500,wave#,2500
   text 1,1,str$(screen fps())+" "+str$(seed)
   control camera using arrowkeys 0,3,2
   position camera camera position x(),get ground height(1,camera position x(),camera position z())+50,camera position z()

   if mouseclick()=1 then strike=1
   if strike=1 then lightning()

   sync
loop

function lightning()
   if strike2=0
    size sprite 1,mousey()/8,mousey()
    show sprite 1
    offset sprite 1,-mousex(),0

    show object 4
      inc counter2
      if counter2=6
        strike2=1
        mirror sprite 1
        inc counter
        counter2=0
      endif
   else
      inc counter2
      hide object 4
      hide sprite 1
      if counter2=5
         strike2=0
         inc counter
         counter2=0
      endif
   endif
   if counter=10
      strike2=0
      hide object 4
      counter=0
      strike=0
   endif
endfunction

function my_matrix(num,x_grids,z_grids,grid_spacing)
   matrices(num).x_grids=x_grids
   matrices(num).z_grids=z_grids
   matrices(num).grid_spacing=grid_spacing
   make memblock num,(6*x_grids*z_grids*32)+12
   write memblock dword num,0,274
   write memblock dword num,4,32
   write memblock dword num,8,6*x_grids*z_grids

   for i=1 to x_grids+1
      for j=1 to z_grids+1
         position_vert(num,i,j,i*grid_spacing,-10.0,j*grid_spacing)
         num1#=(1+matrices(num).x_grids-i)
         num2#=matrices(num).x_grids
         num3#=(1+matrices(num).z_grids-j)
         num4#=matrices(num).z_grids
         set_uv(num,i,j,num1#/num2#,num3#/num4#)
         set_normals(num,i,j,0,1,0)
      next j
   next i
   make mesh from memblock num,num
   make object num,num,1
endfunction

function set_normals(num,i,j,nx#,ny#,nz#)
   x=6*matrices(num).x_grids
   if i<matrices(num).x_grids+1 and j<matrices(num).z_grids+1
      set_normal_x(num,1+(i-1)*6+x*(j-1),nx#)
      set_normal_y(num,1+(i-1)*6+x*(j-1),ny#)
      set_normal_z(num,1+(i-1)*6+x*(j-1),nz#)
      set_normal_x(num,4+(i-1)*6+x*(j-1),nx#)
      set_normal_y(num,4+(i-1)*6+x*(j-1),ny#)
      set_normal_z(num,4+(i-1)*6+x*(j-1),nz#)
   endif
   if i>1 and j<matrices(num).z_grids+1
      set_normal_x(num,6+(i-2)*6+x*(j-1),nx#)
      set_normal_y(num,6+(i-2)*6+x*(j-1),ny#)
      set_normal_z(num,6+(i-2)*6+x*(j-1),nz#)
   endif
   if i>1 and j>1
      set_normal_x(num,3+(i-2)*6+x*(j-2),nx#)
      set_normal_y(num,3+(i-2)*6+x*(j-2),ny#)
      set_normal_z(num,3+(i-2)*6+x*(j-2),nz#)
      set_normal_x(num,5+(i-2)*6+x*(j-2),nx#)
      set_normal_y(num,5+(i-2)*6+x*(j-2),ny#)
      set_normal_z(num,5+(i-2)*6+x*(j-2),nz#)
   endif
   if i<matrices(num).x_grids+1 and j>1
      set_normal_x(num,2+(i-1)*6+x*(j-2),nx#)
      set_normal_y(num,2+(i-1)*6+x*(j-2),ny#)
      set_normal_z(num,2+(i-1)*6+x*(j-2),nz#)
   endif
endfunction

function set_uv(num,i,j,u#,v#)
 x=6*matrices(num).x_grids
   if i<matrices(num).x_grids+1 and j<matrices(num).z_grids+1
      set_U(num,1+(i-1)*6+x*(j-1),u#)
      set_v(num,1+(i-1)*6+x*(j-1),v#)
      set_u(num,4+(i-1)*6+x*(j-1),u#)
      set_v(num,4+(i-1)*6+x*(j-1),v#)
   endif
   if i>1 and j<matrices(num).z_grids+1
      set_u(num,6+(i-2)*6+x*(j-1),u#)
      set_v(num,6+(i-2)*6+x*(j-1),v#)
   endif
   if i>1 and j>1
      set_u(num,3+(i-2)*6+x*(j-2),u#)
      set_v(num,3+(i-2)*6+x*(j-2),v#)
      set_u(num,5+(i-2)*6+x*(j-2),u#)
      set_v(num,5+(i-2)*6+x*(j-2),v#)
   endif
   if i<matrices(num).x_grids+1 and j>1
      set_u(num,2+(i-1)*6+x*(j-2),u#)
      set_v(num,2+(i-1)*6+x*(j-2),v#)
   endif
endfunction

function position_vert(num,i,j,x#,y#,z#)
 x=6*matrices(num).x_grids
   if i<matrices(num).x_grids+1 and j<matrices(num).z_grids+1
      set_vertex_x(num,1+(i-1)*6+x*(j-1),x#)
      set_vertex_y(num,1+(i-1)*6+x*(j-1),y#)
      set_vertex_z(num,1+(i-1)*6+x*(j-1),z#)
      set_vertex_x(num,4+(i-1)*6+x*(j-1),x#)
      set_vertex_y(num,4+(i-1)*6+x*(j-1),y#)
      set_vertex_z(num,4+(i-1)*6+x*(j-1),z#)
   endif
   if i>1 and j<matrices(num).z_grids+1
      set_vertex_x(num,6+(i-2)*6+x*(j-1),x#)
      set_vertex_y(num,6+(i-2)*6+x*(j-1),y#)
      set_vertex_z(num,6+(i-2)*6+x*(j-1),z#)
   endif
   if i>1 and j>1
      set_vertex_x(num,3+(i-2)*6+x*(j-2),x#)
      set_vertex_y(num,3+(i-2)*6+x*(j-2),y#)
      set_vertex_z(num,3+(i-2)*6+x*(j-2),z#)
      set_vertex_x(num,5+(i-2)*6+x*(j-2),x#)
      set_vertex_y(num,5+(i-2)*6+x*(j-2),y#)
      set_vertex_z(num,5+(i-2)*6+x*(j-2),z#)
   endif
   if i<matrices(num).x_grids+1 and j>1
      set_vertex_x(num,2+(i-1)*6+x*(j-2),x#)
      set_vertex_y(num,2+(i-1)*6+x*(j-2),y#)
      set_vertex_z(num,2+(i-1)*6+x*(j-2),z#)
   endif
endfunction


rem  Accessor and mutator functions for vertex data
function Polygons(num)
   polyg=memblock dword(num,8)/3
endfunction polyg

function get_vertex_x(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+12)
endfunction result#

function get_vertex_y(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+16)
endfunction result#

function get_vertex_z(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+20)
endfunction result#

function set_vertex_x(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+12,val#
endfunction

function set_vertex_y(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+16,val#
endfunction

function set_vertex_z(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+20,val#
endfunction



function get_normal_x(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+24)
endfunction result#

function get_normal_y(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+28)
endfunction result#

function get_normal_z(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+32)
endfunction result#

function set_normal_x(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+24,val#
endfunction

function set_normal_y(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+28,val#
endfunction

function set_normal_z(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+32,val#
endfunction



function get_U(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+36)
endfunction result#

function get_V(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+40)
endfunction result#

function set_U(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+36,val#
endfunction

function set_V(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+40,val#
endfunction

function Matrix_form_function(num,format$,scale#,offset#)
 continue=1
   width=matrices(num).x_grids
   length=matrices(num).z_grids
   dim sinarray1#(width/4)
   dim sinarray2#(length/4)
   dim cosarray1#(width/4)
   dim cosarray2#(length/4)
   dim radialcos#(40)

   strlength=len(format$)
   position=1
   while continue=1
      locate=next_command(format$,position)
      command$=lower$(right$(Left$(format$,locate),locate-position+1))

      position=locate+2

      select command$
         case "sin":funct$="sin":begin=0:wavenum=1:endcase
         case "cos":funct$="cos":begin=0:wavenum=1:endcase
         case "radialcos":funct$="rcos":begin=0:wavenum=1:endcase
         case "rimwall":funct$="rwall":endcase
         case "seed":randomize (val(right$(left$(format$,next_command(format$,position)),next_command(format$,position)-position+1))):position=next_command(format$,position)+2:endcase
         case "wn":wavenum=val(right$(left$(format$,next_command(format$,position)),next_command(format$,position)-position+1)):position=next_command(format$,position)+2:endcase
         case "ct":centerx=val(right$(left$(format$,next_command(format$,position)),next_command(format$,position)-position+1)):position=next_command(format$,position)+2
                   centerz=val(right$(left$(format$,next_command(format$,position)),next_command(format$,position)-position+1)):position=next_command(format$,position)+2:endcase
         case " "::endcase
         case ","::endcase
         case "roughen":rough=1:roughstart=val(right$(left$(format$,next_command(format$,position)),next_command(format$,position)-position+1)):position=next_command(format$,position)+2
         roughamount=val(right$(left$(format$,next_command(format$,position)),next_command(format$,position)-position+1)):position=next_command(format$,position)+2:endcase
         case ")"::endcase
         case default:i=val(command$):inc begin:endcase
      endselect

      if begin>0
         select funct$
            case "sin"
               select begin
                  case 1:min=i:endcase
                  case 2:max=i:endcase
                  case 3
                     select i
                        case 1:sinarray1#(wavenum)=scale#*(rnd(max-min)+max):endcase
                        case 2:sinarray1#(wavenum)=scale#*(-1*(rnd(max-min)+max)):endcase
                        case 3:sinarray1#(wavenum)=scale#*((-1)^(rnd(2))*(rnd(max-min)+max)):endcase
                     endselect
                  endcase
                  case 4:min=i:endcase
                  case 5:max=i:endcase
                  case 6
                     select i
                        case 1:sinarray2#(wavenum)=scale#*(rnd(max-min)+max):endcase
                        case 2:sinarray2#(wavenum)=scale#*(-1*(rnd(max-min)+max)):endcase
                        case 3:sinarray2#(wavenum)=scale#*((-1)^(rnd(2))*(rnd(max-min)+max)):endcase
                     endselect
                     inc wavenum
                     begin=0
                  endcase
               endselect
            endcase

            case "cos"
               select begin
                  case 1:min=i:endcase
                  case 2:max=i:endcase
                  case 3
                     select i
                        case 1:cosarray1#(wavenum)=scale#*(rnd(max-min)+max):endcase
                        case 2:cosarray1#(wavenum)=scale#*(-1*(rnd(max-min)+max)):endcase
                        case 3:cosarray1#(wavenum)=scale#*((-1)^(rnd(2))*(rnd(max-min)+max)):endcase
                     endselect
                  endcase
                  case 4:min=i:endcase
                  case 5:max=i:endcase
                  case 6
                     select i
                        case 1:cosarray2#(wavenum)=scale#*(rnd(max-min)+max):endcase
                        case 2:cosarray2#(wavenum)=scale#*(-1*(rnd(max-min)+max)):endcase
                        case 3:cosarray2#(wavenum)=scale#*((-1)^(rnd(2))*(rnd(max-min)+max)):endcase
                     endselect
                     inc wavenum
                     begin=0
                  endcase
               endselect
            endcase

            case "rcos"
               select begin
                  case 1:min=i:endcase
                  case 2:max=i:endcase
                  case 3
                     select i
                        case 1:radialcos#(wavenum)=scale#*(rnd(max-min)+max):endcase
                        case 2:radialcos#(wavenum)=scale#*(-1*(rnd(max-min)+max)):endcase
                        case 3:radialcos#(wavenum)=scale#*((-1)^(rnd(2))*(rnd(max-min)+max)):endcase
                     endselect
                     inc wavenum
                     begin=0
                  endcase
               endselect
            endcase
         endselect
      endif

      if rough=1
         scaling#=roughamount
         for i=roughstart to width/4
            sinarray1#(i)= scaling#*scale#*(rnd(10))*((-1)^(rnd(2)))/700.0
            sinarray2#(i)= scaling#*scale#*(rnd(10))*((-1)^(rnd(2)))/700.0
            cosarray1#(i)= scaling#*scale#*(rnd(10))*((-1)^(rnd(2)))/700.0
            cosarray2#(i)= scaling#*scale#*(rnd(10))*((-1)^(rnd(2)))/700.0
            radialcos#(i)=scaling#*scale#*(rnd(10))*((-1)^(rnd(2)))/200.0
            scaling#=scaling#*0.94

         next i
         rough=0
      endif
   if position >= strlength then continue=0
   endwhile

   for i=0 to width
      for j=0 to length
         height#=0
         for x=1 to width/4
            height#=height#+(sinarray1#(x)*sin((x*i*180.0)/width))+(cosarray1#(x)*cos((x*i*180.0)/width))
         next x

         for y= 1 to length/4
            height#=height#+(sinarray2#(y)*sin((y*j*180.0)/length))+(cosarray2#(y)*cos((y*j*180.0)/length))
         next y

         distance#=sqrt(((width/2)-i)^2+((length/2)-j)^2)
         for x=1 to 40
            height#=height#+(radialcos#(x)*cos((x*distance#*180/width)))
         next x

         position_vert(num,i+1,j+1,(i+1)*matrices(num).grid_spacing,height#-offset#,(j+1)*matrices(num).grid_spacing)
         if num=1 then set matrix height 1,i,j,height#-offset#
      next j
   next i
   make mesh from memblock num,num
   change mesh num,0,num
   if num=1 then update matrix 1
   undim sinarray1#(0)
   undim sinarray2#(0)
   undim cosarray1#(0)
   undim cosarray2#(0)
   undim radialcos#(0)

endfunction

function next_command(format$,position)
   found=0
   length=len(format$)
   locate=position
   while found=0

      if locate>length
         found=1
      else
         if mid$(format$,locate)=" " or mid$(format$,locate)=","
            found=1
         endif
      endif
      inc locate
   endwhile
   locate=locate-2
endfunction locate

function set_matrix_normals(num)
   r=make vector3(vector)
      for i=2 to matrices(num).x_grids-1
         for j=2 to matrices(num).z_grids-1
            us#=((get_vertex_y(num,1+(i-2)*6+(j-1)*matrices(num).x_grids*6)-get_vertex_y(num,1+(i)*6+(j-1)*matrices(num).x_grids*6))/matrices(num).grid_spacing)
            vs#=((get_vertex_y(num,1+(i-1)*6+(j-2)*matrices(num).x_grids*6)-get_vertex_y(num,1+(i-1)*6+(j)*matrices(num).x_grids*6))/matrices(num).grid_spacing)
            set vector3 vector,us#,1,vs#
            normalize vector3 norm,vector
            set_normals(num,i,j,x vector3(norm),y vector3(norm),z vector3(norm))
         next j
      next i
   make mesh from memblock num,num
   change mesh num,0,num
endfunction

function set_memblock_pixel(memblock,x,y,color)
   width=memblock dword(memblock,0)
   height=memblock dword(memblock,4)
   depth=memblock dword(memblock,8)
   if x>-1 and y>-1 and x<width and y<height
      pointer=y*width*depth/8+x*depth/8+12
      write memblock dword memblock,pointer,color
   endif
endfunction

function get_memblock_pixel(memblock,x,y)
   width=memblock dword(memblock,0)
   height=memblock dword(memblock,4)
   depth=memblock dword(memblock,8)
   if x>-1 and y>-1 and x<width and y<height
      pointer=y*width*depth/8+x*depth/8+12
      value=memblock dword(memblock,pointer)
   endif
endfunction value

function set_locked_pixel(x,y,color_value)
   start=get pixels pointer()
   repeat_number=get pixels pitch()
   bits_per_pixel=bitmap depth(num)/8
   pointer=start+y*repeat_number+x*bits_per_pixel
   *pointer=color_value
endfunction

DATA -16777216,-16316665,-15527149,-15922164,-16316410,-15658222,-14869218,-15396076,-16382713,-16776959,-16776960,-16777215,-16645886,-16777215,-16776960,-16777216
DATA -16777216,-15592942,-9474193,-14869476,-16513531,-15987187,-15592684,-15659761,-15793144,-16383486,-16711680,-16777216,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16119286,-15000804,-15527149,-16316665,-16316664,-16382202,-15530744,-9501146,-15203318,-16579837,-16645629,-16710911,-16711167,-16711423,-16777216
DATA -16777215,-16711680,-16579836,-15987444,-15395307,-15461358,-15988213,-15792631,-14612719,-15135470,-15593454,-15856628,-15724016,-15395564,-16119799,-16711422
DATA -16382970,-16645887,-16448251,-15264234,-14013910,-14014167,-15001318,-15856114,-15922161,-15198440,-14606560,-15263722,-14606048,-12303294,-14869987,-15725551
DATA -15988467,-16645375,-16579579,-15395563,-14013654,-13421773,-14146010,-15263977,-15593454,-15132648,-14868963,-15198186,-15066855,-14803683,-14476254,-13557455
DATA -16185847,-16645886,-16514045,-15987187,-14934755,-14014166,-14146009,-15001062,-15592428,-15198182,-14803426,-15198185,-15855857,-16053749,-15594223,-15397356
DATA -16382461,-15790077,-15856380,-16053237,-15658220,-15066596,-15001061,-15461355,-15592939,-14803682,-13882582,-14343132,-15527149,-16251129,-16448507,-16514301
DATA -15395833,-13290744,-14935290,-15987702,-15790061,-15790318,-15921905,-15987444,-15658735,-14737632,-13685202,-13553616,-14935269,-15987444,-16316921,-16513787
DATA -14474726,-14211824,-15198711,-16185336,-16119542,-15987956,-15987957,-15790578,-15066854,-14211290,-14145238,-14408923,-14671585,-15066598,-15658478,-15526892
DATA -12960711,-15198444,-16250616,-16514044,-16447482,-15790065,-15000805,-15000548,-14211545,-12566977,-13817043,-15198441,-14737890,-14079446,-15197927,-14605791
DATA -15263721,-16053492,-16316921,-16579323,-16447481,-15592686,-14145755,-14606048,-14408411,-12829381,-14013911,-15329513,-15263974,-14935264,-15592938,-15592430
DATA -16711166,-16711424,-14606046,-15461613,-16185079,-15856114,-15395307,-15395308,-15330027,-14803684,-14540253,-14211546,-13948625,-15455823,-15394523,-16381945
DATA -16777216,-16777215,-10921639,-14606304,-16053493,-16250873,-16184566,-16119543,-16119800,-15922162,-15066341,-13356236,-12500923,-12170916,-14539472,-16382201
DATA -16777216,-16777216,-14145753,-15329769,-16185079,-16250616,-16184565,-16250872,-16448508,-16382714,-15921907,-14935013,-13290443,-11711155,-14606047,-16448251
DATA -16777216,-16777216,-16316923,-16382714,-16316666,-15855857,-15461099,-15724784,-16448251,-16580605,-16579838,-16316666,-15724270,-15197928,-15987444,-16645887

DATA -536462,-7679992,-15684847,-15690223,-9395701,-9402101,-8164061,-8171997,-8095918,-6645352,-3947582,-1381913

DATA -16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-1835773,-197381,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-197381,-197381,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-1835773,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-1835773,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-1835773,-1835773,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-197381,-16777216,-1835773,-16777216,-1835773,-1835773
DATA -16777216,-16777216,-197381,-16777216,-1835773,-197381,-1835773,-16777216
DATA -16777216,-16777216,-197381,-16777216,-16777216,-197381,-1835773,-16777216
DATA -16777216,-16777216,-1835773,-16777216,-16777216,-1835773,-1835773,-16777216
DATA -16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-1835773,-16777216
DATA -16777216,-16777216,-197381,-1835773,-16777216,-16777216,-1835773,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-197381,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-197381,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-197381,-1835773,-1835773,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-197381,-1835773,-16777216,-197381,-16777216,-16777216
DATA -16777216,-16777216,-197381,-16777216,-16777216,-197381,-16777216,-16777216
DATA -16777216,-16777216,-197381,-16777216,-16777216,-197381,-16777216,-16777216
DATA -16777216,-197381,-197381,-16777216,-16777216,-197381,-16777216,-16777216
DATA -16777216,-1835773,-16777216,-16777216,-16777216,-197381,-16777216,-16777216
DATA -16777216,-1835773,-16777216,-16777216,-16777216,-197381,-16777216,-16777216
DATA -1835773,-1835773,-16777216,-16777216,-16777216,-197381,-1835773,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-16777216,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-16777216,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-16777216,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-1835773,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-1835773,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-1835773,-1835773,-16777216,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-197381,-197381,-16777216,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-197381,-197381,-16777216,-1835773,-1835773,-16777216
DATA -16777216,-16777216,-197381,-197381,-16777216,-16777216,-1835773,-16777216
DATA -16777216,-16777216,-197381,-197381,-16777216,-16777216,-1835773,-1835773
DATA -16777216,-1835773,-1835773,-1835773,-1835773,-16777216,-16777216,-1835773
DATA -16777216,-1835773,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216
DATA -1835773,-1835773,-16777216,-1835773,-1835773,-16777216,-16777216,-16777216
DATA -1835773,-16777216,-16777216,-197381,-197381,-16777216,-16777216,-16777216

box 20,20,60,60
wait key

function solid_circle(x,y,radius,color)
lock pixels
ptr=get pixels pointer()
this=get pixels pitch()
that =bitmap depth()/8
for i=1 to radius*2
   for j=1 to radius*2
      pointer=ptr+((y+j-radius)*this)+(x-radius+i)*that
      if (radius-i)^2+(radius-j)^2<=radius^2 then *pointer=color
   next j
next i
unlock pixels
endfunction

      for i = 1 to 6
         x = rain(t).x + sin(angle)*i
         y = rain(t).y + cos(angle)*i
         pDot(x,y,rgb(0,0,255-i*30))
      next i

backdrop on
color backdrop 0
sync on
sync rate 0
hide mouse

Global width = 640
Global height = 480

type particle
   x as float
   y as float
   vx as float
   vy as float
   f as float
   g as float
   color as dword
endtype


amount = 3000
dim rain(amount) as particle

for t = 1 to amount
   rain(t).x = rnd(width)
   rain(t).y = rnd(height)
   rain(t).color = rgb(0,0,255)
next t


repeat

   lock pixels

   for t = 1 to amount
      oldx = rain(t).x
      oldy = rain(t).y
      rain(t).x = rain(t).x + rain(t).vx*rain(t).f
      rain(t).y = rain(t).y + rain(t).vy*rain(t).f + rain(t).g
      if rain(t).g < 5 then rain(t).g = rain(t).g + 0.01
      if rain(t).f > 0
         rain(t).f = rain(t).f - 0.1
      else
         rain(t).f = 0
      endif


      rem if rain hits ball
      if ((rain(t).x-mousex())^2 + (rain(t).y-mousey())^2) <= 100
         x# = (rain(t).x - mousex())/10.0
         y# = (rain(t).y - mousey())/10.0

         rain(t).vx = x#
         rain(t).vy = y#
         rain(t).f = 4
      endif
      if rain(t).y >= height OR rain(t).y <= 0 OR rain(t).x >= width OR rain(t).x <= 0
         rain(t).x = rnd(width)
         rain(t).y = 1
         rain(t).vx = 0
         rain(t).vy = 0
         rain(t).g = 0
         `rain(t).color = rgb(200,200,rnd(55)+200)
         rain(t).color = rgb(0,0,255)
      endif


      angle = wrapvalue(atanfull(oldx-rain(t).x,oldy-rain(t).y))
      pDot(rain(t).x,rain(t).y,rain(t).color)

      for i = 1 to 6
         x = rain(t).x + sin(angle)*i
         y = rain(t).y + cos(angle)*i
         pDot(x,y,rgb(0,0,255-i*30))
      next i
   next t

   unlock pixels

   circle mousex(), mousey(),10

   sync
until spacekey()


function frictionDirection#(f as float)
   if f > 0 then exitfunction 1
   if f < 0 then exitfunction -1
endfunction 0


REM function borrowed from Coding Fodder's Rain code
function pDot(x as integer, y as integer, color_value as dword )
   if x > 0 and x < width and y > 0 and y < height
      start = get pixels pointer()
      repeat_number = get pixels pitch()
      bits_per_pixel = bitmap depth(num)/8
      pointer = start + y*repeat_number + x*bits_per_pixel
      *pointer = color_value
   endif
endfunction

Set Display Mode 1280,960,32
Hide Mouse
Color Backdrop 0
Set Ambient light 20
Set Point Light 0,0,0,0
Position Light 0,2000,90,90
Color Light 0,RGB(255,204,204)
Set Light Range 0,10000
sync on : sync rate 60 : Color Backdrop rgb(0,0,0)
set camera range 0,.5,7000
Position Camera 0,0,0,0
Autocam off
Set Image Colorkey 0,0,0
Randomize Timer()

Text$="Please wait... Creating world for PLANET STORM!"
Create Bitmap 1,Text Width(Text$)+5,Text Height(Text$)+5
Set Cursor 0,0
Ink RGB(231,223,84),0
Print Text$
Get Image 100,0,0,BitMap Width(),BitMap Height()
Delete Bitmap 1
Set Current Bitmap 0
Sprite 1,25,25,100
Sync
Sleep 5000
Delete Sprite 1

CreateStarField()
CreatePlanet()
CreateClouds()

Make Object Sphere 4,1000,50,50
Texture Object 4,4
Make Object Sphere 5,1050,50,50
Texture Object 5,5
Ghost Object On 5
Fade Object 5,80
Position Object 4,-300,-80,3000
Position Object 5,-300,-80,3000
Make Object Sphere 6,1010,50,50
Texture Object 6,5
Ghost Object On 6
Fade Object 6,70
Position Object 6,-300,-80,3000

Turn Object Right 4,60
Pitch Object Down 4,20
Turn Object Right 5,62
Pitch Object Down 5,22
Turn Object Right 6,58
Pitch Object Down 6,18
Turn Object Right 6,170


Do
   Turn Object Right 4,.05
   Turn Object Right 5,.04
   Turn Object Right 6,.05
   If Rnd(200)=1 and Lightening<1
      Lightening=20
      Make Light 1
      Set Point Light 1,rnd(800)-700,Rnd(500)-220,2600
      Point Light 1,-300,-80,3000
   Endif
   If Lightening>0
      Color Light 1,Rgb(Rnd(255),Rnd(255),Rnd(255))
      Lightening=Lightening-1
      If Lightening<1
         Color Light 1,0
         Delete Light 1
      Endif
   Endif
   Sync
Loop

Function CreateClouds()
Create Bitmap 1,640,480

Ink rgb(rnd(100)+50,rnd(100)+50,rnd(100)+50),0

For j = 1 to rnd(80)+50
Ink rgb(rnd(55)+200,rnd(55)+200,rnd(55)+200),0
Radius1 = Rnd(30)+20
Radius2 = Rnd(30)+20
cx=rnd(640)-1
cy=rnd(480)-1
For i = 0 to 360 Step 2
   Radius1=Radius1+(Rnd(4)-2)
   Radius2=Radius2+(Rnd(4)-2)
   If Radius1<1 Then Radius1=1
   If Radius2<1 Then Radius2=1
   x#=Cos(i)*(Radius2)+cx
   y#=Sin(i)*(Radius1)+cy
   Line cx,cy,x#,y#
   If x#>639
      x#=x#-639
      Line 0,cy,x#,y#
   Endif
   If x#<0
      x#=x#+639
      Line 639,cy,x#,y#
   Endif
Next i
Next j


For i = 1 to 5
Blur Bitmap 1,6
Next i

Get Image 5,1,1,639,479
Set Current Bitmap 0
Delete Bitmap 1
EndFunction

Function CreatePlanet()
create bitmap 1,640,480
Ink rgb(10,10,240),1

For i = 0 to 480
   Line 0,i,640,i
Next i

For j = 1 to rnd(10)+7
Ink rgb(10,rnd(100)+50,10),1
Radius = Rnd(50)+25
cx=rnd(530)+55
cy=rnd(370)+55
For i = 0 to 720
   Radius=Radius+(Rnd(4)-2)
   x#=Cos(i/2)*(Radius)+cx
   y#=Sin(i/2)*(Radius)+cy
   Line cx,cy,x#,y#
   If x#>639
      x#=x#-639
      Line 0,cy,x#,y#
   Endif
   If x#<0
      x#=x#+639
      Line 639,cy,x#,y#
   Endif
Next i
Next j
For i = 1 to 5: Rem change back to 10
Blur Bitmap 1,6
Next i
Get Image 4,1,1,639,479
Set Current Bitmap 0
Delete Bitmap 1
EndFunction

Function CreateStarField()
create bitmap 1,1000,1000
For j = 1 to 3
For i = 1 to 1500
Ink rgb(200+rnd(55),200+rnd(55),200+rnd(55)),0
   Dot Rnd(1000),Rnd(1000)
Next i
Blur Bitmap 1,1
Next j
Get Image 16,0,0,999,950
Set Current Bitmap 0
Make Object Sphere 2, 10000
Texture Object 2,16
Scale Object Texture 2,8,8
Position Object 2,0,0,0
Set Object Light 2,0
Set Object Cull 2,0
Fade Object 2,1000
Delete Bitmap 1
Set Object Collision Off 2
CreateGas()
Get Image 2,1,1,639,479
Set Current Bitmap 0
Make Object Sphere 3,9000,50,50
Texture Object 3,2
Rem Scale Object Texture 3,.99,.99
Set Object Transparency 3,1
Set Object Cull 3,0
Ghost Object On 3
Set Object Light 3,0
Fade Object 3,20
Delete Bitmap 1
Set Object Collision Off 3
Rem Return Object 2 as Background Sphere (Starfield)
EndFunction

Function CreateGas()
Create Bitmap 1,640,480

Ink rgb(rnd(100)+50,rnd(100)+50,rnd(100)+50),0

For j = 1 to rnd(25)+25
Ink rgb(rnd(100)+50,rnd(100)+50,rnd(100)+50),0
Radius1 = Rnd(10)+10
Radius2 = Rnd(10)+10
cx=rnd(640)-1
cy=rnd(480)-1
For i = 0 to 360 Step 5
   Radius1=Radius1+(Rnd(2)-1)
   Radius2=Radius2+(Rnd(4)-2)
   If Radius1<1 Then Radius1=1
   If Radius2<1 Then Radius2=1
   x#=Cos(i)*(Radius2)+cx
   y#=Sin(i)*(Radius1)+cy
   Line cx,cy,x#,y#
   If x#>639
      x#=x#-639
      Line 0,cy,x#,y#
   Endif
   If x#<0
      x#=x#+639
      Line 639,cy,x#,y#
   Endif
Next i
Next j


For i = 1 to 3
Blur Bitmap 1,6
Next i

EndFunction

Create Bitmap 1,200,200
MyBlur1(1,.8)
MyBlur2(1)
End

Function MyBlur1(MapNum,percent#)
MW=Bitmap Width(MapNum)*percent#
MH=Bitmap Height(MapNum)*percent#
Create Bitmap 2,MW,MH
Delete BitMap 2
EndFunction

Function MyBlur2(MapNum)
percent#=(Rnd(10)+75)/100:` This is the line giving me problems
MW=Bitmap Width(MapNum)*percent#
MH=Bitmap Height(MapNum)*percent#
Create Bitmap 2,MW,MH
Delete BitMap 2
EndFunction

Sync on
tornadopieces=100
tornadostart=10
Dim x#(tornadopieces)
Dim y#(tornadopieces)
Dim z#(tornadopieces)
Dim xm#(tornadopieces)
Dim zm#(tornadopieces)
x#=0
z#=0

for I=tornadostart to tornadostart+tornadopieces
   tempI=i-tornadostart
   make object box i,1*(tempI+2),2,1*(tempI+2)
   position object i,0,tempI*2,0
   yrotate object i, rnd(360)
   xrotate object i, rnd(40)-20
   ghost object on i
   x#(tempI)=0
   y#(tempI)=i*2
   z#(tempI)=0
next I

position camera 0,80,-800
point camera 0,40,0
do
   if upkey()=1 then zm#=zm#+.1
   if downkey()=1 then zm#=zm#-.1
   if leftkey()=1 then xm#=xm#-.1
   if rightkey()=1 then xm#=xm#+.1
   xm#=xm#*.95
   zm#=zm#*.95
   x#=x#+xm#
   y#=0
   z#=z#+zm#
   position object tornadostart,x#,y#(0),z#
   x#(0)=x#
   z#(0)=z#
   for i= tornadostart+1 to tornadostart+tornadopieces
      tempi=i-tornadostart
      xm#(tempi)=xm#(tempi)+(x#(tempi-1)-x#(tempi))*.4
      zm#(tempi)=zm#(tempi)+(z#(tempi-1)-z#(tempi))*.4

      xm#(tempi)=xm#(tempi)*.5
      zm#(tempi)=zm#(tempi)*.5

      x#(tempi)=x#(tempi)+xm#(tempi)
      z#(tempi)=z#(tempi)+zm#(tempi)
      temp#=object angle y(i)
      yrotate object i,wrapvalue(temp#+((100-(i-tornadostart)+rnd(10))*.03))

      position object i,x#(tempi),y#(tempi),z#(tempi)
   next i
   sync
loop