Watch the polygons on the cup flake away into nothing...

This demo uses memblocks to make the polygons, on a metallic looking cup, flake up and shrink away into nothing. It's quite a cool looking demo, especially with the sphere mapping.

Requires a download of a .3ds model, and a bitmap.
Sphere mapping support required.

                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    `Flaking polys
`By Hamish McHaggis
`22/9/03

randomize timer()

set display mode 800,600,32

`The rate at which the flakes accelerate upwards
flakeAccel#=0.001
`The rate at which all the flakes flake off
flakeTime#=0.05

`Setup
sync on
sync rate 40
hide mouse
autocam off

`Load cup
load object "cup.3ds",1
load image "room.jpg",1
set object smoothing 1,100
make object box 2,40,5,40
position object 2,0,-8,0

`Set up camera
position camera 0,7,-20
point camera 0,0,0

`Create new light
make light 1

`Make memblock from object
make mesh from object 1,1
make memblock from mesh 1,1
`Number of faces on the object
numFaces=memblock dword(1,8)/3

`Arrays for holding mesh data
dim faceX#(numFaces,3)
dim faceY#(numFaces,3)
dim faceZ#(numFaces,3)
dim faceHeight#(numFaces)
dim faceAcc#(numFaces)
dim faceStart(numFaces)

`Loop through faces
for y=1 to numFaces
   `Loop through vertices
   for x=1 to 3
      `Store 3D coords
      faceX#(y,x)=memblock float(1,12+(x-1)*32+(y-1)*96)
      faceY#(y,x)=memblock float(1,12+(x-1)*32+(y-1)*96+4)
      faceZ#(y,x)=memblock float(1,12+(x-1)*32+(y-1)*96+8)
   next x
   `Store average height of faces
   faceHeight#(y)=(faceY#(y,1)+faceY#(y,2)+faceY#(y,3))/3
next y

`Set the starting height of flaking
dist#=7

disable escapekey
repeat
   `Loop though faces
   for y=1 to numFaces
      `If the flaking 'plane' has reached them then accelerate them
      if faceStart(y)=1
         for x=1 to 3
            faceAcc#(y)=faceAcc#(y)+flakeAccel#
            faceY#(y,x)=faceY#(y,x)+faceAcc#(y)
            write memblock float 1,12+(x-1)*32+(y-1)*96,faceX#(y,x)
            write memblock float 1,12+(x-1)*32+(y-1)*96+4,faceY#(y,x)
            write memblock float 1,12+(x-1)*32+(y-1)*96+8,faceZ#(y,x)
         next x
         `Shrink faces
         faceX#(y,1)=curvevalue(faceX#(y,2),faceX#(y,1),50)
         faceY#(y,1)=curvevalue(faceY#(y,2),faceY#(y,1),50)
         faceZ#(y,1)=curvevalue(faceZ#(y,2),faceZ#(y,1),50)
         faceX#(y,2)=curvevalue(faceX#(y,3),faceX#(y,2),50)
         faceY#(y,2)=curvevalue(faceY#(y,3),faceY#(y,2),50)
         faceZ#(y,2)=curvevalue(faceZ#(y,3),faceZ#(y,2),50)
         faceX#(y,3)=curvevalue(faceX#(y,1),faceX#(y,3),50)
         faceY#(y,3)=curvevalue(faceY#(y,1),faceY#(y,3),50)
         faceZ#(y,3)=curvevalue(faceZ#(y,1),faceZ#(y,3),50)
      else
         `Determine whether poly should start flaking
         if dist#<faceHeight#(y) and rnd(10)=0 then faceStart(y)=1
      endif
   next x

   `Bring flake plane lower
   dec dist#,flakeTime#

   `Change the object
   make mesh from memblock 1,1
   change mesh 1,1,1
   set sphere mapping on 1,1

   `Rotate camera
   a#=wrapvalue(a#+1)
   position camera sin(a#)*20,5,cos(a#)*20
   point camera 0,0,0

   position light 1,sin(a#)*10,5,cos(a#)*10

   sync
until escapekey()=1

`Unload
delete object 1
delete memblock 1
delete mesh 1
undim faceX#(0)
undim faceY#(0)
undim faceZ#(0)
undim faceHeight#(0)
undim faceAcc#(0)
undim faceStart(0)
flush video memory