Rem Project: snowscene
Rem Created: 01/12/2005 20:00:06
 
Rem ***** Main Source File *****
 
`Snowy Island by Ric
 
detail=80
 
`display settings
if check display mode(1024,768,32)=1 then set display mode 1024,768,32
sync on
sync rate 35
hide mouse
 
autocam off
hide light 0
color backdrop 0
set ambient light 0
make light 1
set light range 1,3
 
 
create bitmap 1,screen width(),screen height()
 
`snowflake image
make object sphere 1,1,4,4
position object 1,0,0,1.5
sync
snowflake=free_image()
get image snowflake,screen width()*.25,screen height()*.25,screen width()*.75,screen width()*.75,1
delete object 1
 
position light 1,0,0,-1
set light range 1,2
 
make object sphere 1,1,100,100
set object specular power 1,20
set object specular 1,rgb(255,255,255)
position camera 0,0,-2
sync
sun=free_image()
get image sun,screen width()/4,screen height()/4,screen width()*.75,screen height()*.75,1
set object light 1,0
sync
flare1=free_image()
get image flare1,screen width()/4,screen height()/4,screen width()*.75,screen height()*.75,1
delete object 1
 
delete bitmap 1
text 0,0,"Please wait (approx 60 seconds) ......"
sync
 
`camera and light settings
 
set camera range 0.01,10000
position camera 64,0,64
color backdrop 0
set ambient light 20
 
 
`set the randomize seed to the timer, so random events are different each time
randomize timer()
 
`set size of terrain
global matrixsize
matrixsize=128
 
`fog settings
fog on
fog color rgb(200,200,200)
fog distance matrixsize
 
`set initial value for object numbers
global object_seed
object_seed=1000000
 
`set initial value for image numbers
global image_seed
image_seed=1000000
 
`position light for world illumination
position light 1,200,80,200
set light range 1,100000
make object cube 1,1
hide object 1
position object 1,light position x(1),light position y(1),light position z(1)
 
global skyimage
create_sky()
global snowimage
create_snowimage()
global snow
 
global height#
global rows
global columns
global terrainimage
`set size of terrain
rows=detail
columns=detail
global peaksoff
global peaksoff2
global dim peakx(100)
global dim peakz(100)
global dim peakh(100)
global dim peakx2(100)
global dim peakz2(100)
global dim peakh2(100)
terraform()
Matrix_to_Object(1000,1,128,128,rows,rows,rows,rows,rows,rows)
 
`make some buildings
global doortexture
make_door_texture()
global housetexture
make_house_texture()
`set house variables
global number_of_houses
number_of_houses=15
`set up an array to store house numbers
global dim house(number_of_houses)
global dim door(number_of_houses)
global dim roof(number_of_houses)
 
for house_number=1 to number_of_houses
  make_house(house_number)
next house_number
 
`make trees
global theta#
global numberoftrees
numberoftrees=40
global treenumberseed
treenumberseed=free_object()
global dim treeimage(numberoftrees+treenumberseed)
global resolution
resolution=6
global bark
create_bark()
`text 0,0,"Please wait ......"
`sync
for number=1+treenumberseed to numberoftrees+treenumberseed
create_tree(number)
ink rgb(255,255,255),0
`text 0,0,"Generating trees: "+str$(number-treenumberseed)+" out of "+str$(numberoftrees)
`sync
next number
gosub calculate_shadows
delete object 1000
delete bitmap 2
set current bitmap 0
`hide buildings for skysphere image grab
for n=house(1) to house(number_of_houses)+2
hide object n
next n
 
global sphere1
global sphere2
global sphere3
create_skysphere()
create_snow()
 
 
for n=house(1) to house(number_of_houses)+2
show object n
next n
 
sunplane=free_object()
make object plain sunplane,160*4/3.0,160
set object fog sunplane,0
texture object sunplane,sun
set object light sunplane,0
ghost object on sunplane,2
set object transparency sunplane,2
flareplane1=free_object()
make object plain flareplane1,0.3*4/3.0,0.3
texture object flareplane1,flare1
set object light flareplane1,0
set alpha mapping on flareplane1,20
position object flareplane1,0,-0.5,0
`reference object for distant light source
dummy=free_object()
make object cube dummy,1
hide object dummy
point object dummy,light position x(1),light position y(1),light position z(1)
move object dummy,10000
 
`make snowflakes
radius=100
height=30
velocity#=0.12
numberofflakes=500
n=1000
make object box n,2*4/3.0,2,0.01
set object light n,0
texture object n,snowflake
set object transparency n,1
set object fog n,0
ghost object on n,2
set alpha mapping on n,40
 
for n=1001 to 1000+numberofflakes
instance object n,1000
set object transparency n,1
set object fog n,0
ghost object on n,2
set alpha mapping on n,40
position object n,camera position x()+rnd(radius*2)-radius,camera position y()+rnd(height),camera position z()+rnd(radius*2)-radius
rotate object n,rnd(360),rnd(360),rnd(360)
next n
 
position camera 64,height#+2+get ground height(1,64,64),64
 
 
 
 
`main program loop
do
 
move_camera()
move_trees()
 
position object sunplane,camera position x(),camera position y(),camera position z()
point object sunplane,object position x(dummy),object position y(dummy),object position z(dummy)
move object sunplane,128*7
point object sunplane,camera position x(),camera position y(),camera position z()
 
for n=1000 to 1000+numberofflakes
position object n,object position x(n),object position y(n)-velocity#,object position z(n)
yrotate object n,object angle y(n)+1
if object position y(n)<get ground height(1,object position x(n),object position z(n))
position object n,camera position x()+rnd(radius*2)-radius,camera position y()+height,camera position z()+rnd(radius*2)-radius
endif
next n
text 0,0,str$(screen fps())
 
sync
loop
 
`****************************************
 
`functions
 
function terraform
 
`create terrain
make matrix 1,matrixsize,matrixsize,columns,rows
set matrix 1,0,0,0,2,0,1,0
 
for peak=1 to 50
peakh(peak)=rnd(15)+5
peakx(peak)=rnd(rows-8)+4
peakz(peak)=rnd(rows-8)+4
set matrix height 1,peakx(peak),peakz(peak),peakh(peak)
next peak
update matrix 1
 
 
for times=1 to 120
if times>=90 then peaksoff=1
smooth_matrix(1,rows,rows)
next times
peaksoff=0
 
 
endfunction
 
function smooth_matrix(matnum,tilex,tilez)
 
for x=2 to tilex-2
for z=2 to tilez-2
b=-get matrix height(matnum,x,z)+get matrix height(matnum,x,z+1)
d=-get matrix height(matnum,x,z)+get matrix height(matnum,x+1,z)
f=-get matrix height(matnum,x,z)+get matrix height(matnum,x,z-1)
h=-get matrix height(matnum,x,z)+get matrix height(matnum,x-1,z)
total=b+d+f+h
 
set matrix height matnum,x,z,get matrix height(matnum,x,z)+total*0.1
 
next z
next x
 
 
 
for peak=1 to 100
`peakh(peak)=peakh(peak)*0.999
if matnum=1
  if peaksoff=0 then set matrix height 1,peakx(peak),peakz(peak),peakh(peak)
endif
if matnum=2
  if peaksoff=0 then set matrix height 2,peakx2(peak),peakz2(peak),peakh2(peak)
endif
next peak
 
update matrix matnum
endfunction
 
function free_object
 
object=object_seed
repeat
inc object
until object exist(object)=0
 
endfunction object
 
function check_free_object_number
 
object=object_seed
repeat
inc object
until object exist(object)=0
 
endfunction object
 
function free_image
 
image=image_seed
repeat
inc image
until image exist(image)=0
 
endfunction image
 
 
 
function create_skysphere
 
`get image for sphere by taking snapshot of terrain
terrainimage=free_image()
set camera fov 90
fog off
position camera matrixsize/2.0,3,-matrixsize*0.3
sync
get image terrainimage,0,0,screen width(),screen height()
fog on
fog color rgb(200,200,200)
fog distance matrixsize
set camera fov 60
 
 
sphere2=free_object()
make object sphere sphere2,matrixsize*10
set object collision off sphere2
xrotate object sphere2,180
`yrotate object sphere2,30
set object cull sphere2,0
texture object sphere2,terrainimage
set object texture sphere2,2,0
scale object texture sphere2,8,2.6
set object fog sphere2,0
set object transparency sphere2,2
ghost object on sphere2,5
set alpha mapping on sphere2,20
set object emissive sphere2,rgb(80,60,100)
`set object specular power sphere2,100
`fade object sphere2,200
`set object light sphere2,0
position object sphere2,matrixsize/2,-135,matrixsize/2
 
`sphere 3 (sky) - a third, outer sphere for the sky
sphere3=free_object()
make object sphere sphere3,matrixsize*20
set object collision off sphere3
set object cull sphere3,0
texture object sphere3,skyimage
scale object texture sphere3,1,1.8
set object light sphere3,0
set object fog sphere3,0
position object sphere3,matrixsize/2,0,matrixsize/2
 
endfunction
 
function create_sky()
`creates a dark to light bluish gradient
cls
for n=0 to 250
  ink rgb(n,n-20,n-40),0
  line 0,n,250,n
next n
 
skyimage=free_image()
get image skyimage,0,0,250,250
 
endfunction
 
function create_snowimage
 
create bitmap 1,128,128
set current bitmap 1
ink rgb(255,255,255),0
box 0,0,128,128
for n=0 to 5000
tone=rnd(40)+200
ink rgb(tone+15,tone+10,tone),0
dot rnd(128),rnd(128)
next n
snowimage=free_image()
get image snowimage,0,0,128,128
delete bitmap 1
 
endfunction
 
function create_snow
 
`snow=free_object()
`make object plain snow,matrixsize*12,matrixsize*12
`xrotate object snow,-90
`set object fog snow,0
`set object light snow,0
`texture object snow,snowimage
`position object snow,0,1,0
 
make matrix 2,matrixsize*12,matrixsize*12,40,40
set matrix 2,0,0,1,2,0,1,1
prepare matrix texture 2,snowimage,40,40
tile=1
for x=40-1 to 0 step -1
for z=0 to 40-1
set matrix tile 2,z,x,tile
inc tile
next z
next x
position matrix 2,-matrixsize*6,-10,-matrixsize*6
 
for peak=1 to 60
peakx2(peak)=rnd(40-4)+2
peakz2(peak)=rnd(40-4)+2
if peakx2(peak)<15 or peakx2(peak)>25
if peakz2(peak)<15 or peakz2(peak)>25
peakh2(peak)=rnd(20)+10
endif
endif
set matrix height 2,peakx2(peak),peakz2(peak),peakh2(peak)
next peak
update matrix 2
 
 
for times=1 to 100
if times>=96 then peaksoff=1
smooth_matrix(2,40,40)
next times
peaksoff=0
 
update matrix 2
 
endfunction
 
 
 
function move_camera
 
control camera using arrowkeys 0,0.2,3
position camera camera position x(),height#+.2+get ground height(1,camera position x(),camera position z()),camera position z()
if inkey$()="a" then inc height#,1
if inkey$()="z" then dec height#,1
endfunction
 
calculate_shadows:
undim pixelshaded1(128,128)
undim pixelshaded2(128,128)
dim pixelshaded1(128,128)
dim pixelshaded2(128,128)
`if light1>0
create bitmap 1,128,128
set current bitmap 1
ink rgb(255,255,255),0
box 0,0,128,128
for n=0 to 5000
tone=rnd(40)+200
ink rgb(tone+15,tone+15,tone),0
dot rnd(128),rnd(128)
next n
ink rgb(10,10,10),0
for y=0 to 128
for x=0 to 128
 
`shadows cast by objects
for object=house(1) to house(number_of_houses)
if object exist(object)
ray1#=intersect object(object,x,get ground height(1,x,y),y,light position x(1),light position y(1),light position z(1))
if ray1#=0 then ray1#=1000
if ray1#<0 then ray1#=1
if ray1#<=100
  tone=100+ray1#*10
  `if pixelshaded2(x,y)=1 or pixelshaded1(x,y)=1 then tone=tone/1.5
  if tone>255 then tone=255
  ink rgb(tone,tone,tone),0
  dot x,128-y
  `pixelshaded1(x,y)=1
endif
endif
next object
 
`shadows cast by trees
for object=1+treenumberseed+1000 to numberoftrees+treenumberseed+1000
if object exist(object)
ray1#=intersect object(object,x,get ground height(1,x,y),y,light position x(1),light position y(1),light position z(1))
if ray1#=0 then ray1#=1000
if ray1#<0 then ray1#=1
if ray1#<=100
  tone=100+ray1#*10
  `if pixelshaded2(x,y)=1 or pixelshaded1(x,y)=1 then tone=tone/1.5
  if tone>255 then tone=255
  ink rgb(tone,tone,tone),0
  dot x,128-y
  `pixelshaded1(x,y)=1
endif
endif
next object
 
`shadows cast by terrain - matrix converted to object 1000
ray2#=intersect object(1000,x,get ground height(1,x,y)+0.1,y,light position x(1),light position y(1),light position z(1))
if ray2#=0 then ray2#=1000
if ray2#<0 then ray2#=1
if ray2#<=100
  tone=100+ray2#*10
 
  `if pixelshaded2(x,y)=1 or pixelshaded1(x,y)=1 then tone=tone/1.5
  if tone>255 then tone=255
  ink rgb(tone,tone,tone),0
  dot x,128-y
  `pixelshaded1(x,y)=1
endif
 
 
next x
next y
blur bitmap 1,3
shadowmap=5000000
get image shadowmap,0,0,128,128
 
delete bitmap 1
`set light mapping on 2,shadowmap
 `(light1 exist)
 
`texture matrix
prepare matrix texture 1,shadowmap,rows,columns
tile=1
for x=rows-1 to 0 step -1
for z=0 to columns-1
set matrix tile 1,z,x,tile
inc tile
next z
next x
`endif
update matrix 1
 
return
 
function Matrix_to_Object( object, matrixnum, matxsize#, matzsize#, matxsegs, matzsegs, tilex, tilez, limbx, limbz )
   `safety in case limbx and limbz is smaller than the texture x and z
   a = 0
   if limbx < tilex then limbx = tilex : a = 1
   if limbz < tilez then limbz = tilez : a = 1
   if a > 0
      sync
      print "limbx or limbz was less than tilex or tilez : Error corrected"
      print "Press any key to continue."
      sync
      wait key
   endif
   `safety in case matxsegs and matzsegs is not evenly divisible by tilex and tilez
   if matxsegs mod tilex > 0
      EXIT PROMPT "Number of matrix xsegs not evenly divisible by tilex", "Texture tilex error"
      end
   endif
   if matzsegs mod tilez > 0
      EXIT PROMPT "Number of matrix zsegs not evenly divisible by tilez", "Texture tilez error"
      end
   endif
   `safety in case matxsegs and matzsegs is not evenly divisible by tilex and tilez
   if matxsegs mod limbx > 0
      EXIT PROMPT "Number of matrix xsegs not evenly divisible by limbx", "Texture tilex error"
      end
   endif
   if matzsegs mod limbz > 0
      EXIT PROMPT "Number of matrix zsegs not evenly divisible by limbz", "Texture tilez error"
      end
   endif
 
   `calc the number of polys in the matrix
   num_mat_polys = (matxsegs*matzsegs)*2
   `make array to store vert info
   `storage indexs = poly number, vert number, x/y/z vert pos/norm/uv
   `polys are numbered starting from left to right, front to
   `back, one row at a time (with 2 polys per tile)
   dim vert_store#(num_mat_polys,2,7)
 
   `calc the width and depth of each tile on the matrix
   `formula size#/number
   mat_x_wide# = matxsize#/matxsegs
   mat_z_deep# = matzsize#/matzsegs
 
 
`******************************************************************************
   `get vert position data
   `placeholder variable for poly numbers
   a = 1
   `one row at a time (front to back)
   for j = 0 to matzsegs - 1
      `one tile at a time (left to right)
      for i = 0 to matxsegs - 1
 
         `tile top left poly info
 
         `bottom left vert (x,y,z)
         vert_store#(a,0,0) = i*mat_x_wide#
         vert_store#(a,0,1) = GET MATRIX HEIGHT(matrixnum, i, j)
         vert_store#(a,0,2) = j*mat_z_deep#
         `top left vert (x,y,z)
         vert_store#(a,1,0) = i*mat_x_wide#
         vert_store#(a,1,1) = GET MATRIX HEIGHT(matrixnum, i, j+1)
         vert_store#(a,1,2) = (j+1)*mat_z_deep#
         `top right vert (x,y,z)
         vert_store#(a,2,0) = (i+1)*mat_x_wide#
         vert_store#(a,2,1) = GET MATRIX HEIGHT(matrixnum, i+1, j+1)
         vert_store#(a,2,2) = (j+1)*mat_z_deep#
         inc a, 1
 
         `tile bottom right poly info
 
         `bottom left vert (x,y,z)
         vert_store#(a,0,0) = i*mat_x_wide#
         vert_store#(a,0,1) = GET MATRIX HEIGHT(matrixnum, i, j)
         vert_store#(a,0,2) = j*mat_z_deep#
         `top right vert (x,y,z)
         vert_store#(a,1,0) = (i+1)*mat_x_wide#
         vert_store#(a,1,1) = GET MATRIX HEIGHT(matrixnum, i+1, j+1)
         vert_store#(a,1,2) = (j+1)*mat_z_deep#
         `bottom right vert (x,y,z)
         vert_store#(a,2,0) = (i+1)*mat_x_wide#
         vert_store#(a,2,1) = GET MATRIX HEIGHT(matrixnum, i+1, j)
         vert_store#(a,2,2) = j*mat_z_deep#
         inc a, 1
      next i
   next j
`******************************************************************************
 
 
`******************************************************************************
   `calc normals for polys
   `Thanks to ADR for posting this code on the DBP forums :)
   for i = 1 to num_mat_polys
      `acuire vert positions
      P1X# = vert_store#(i,0,0)
      P1Y# = vert_store#(i,0,1)
      P1Z# = vert_store#(i,0,2)
      P2X# = vert_store#(i,1,0)
      P2Y# = vert_store#(i,1,1)
      P2Z# = vert_store#(i,1,2)
      P3X# = vert_store#(i,2,0)
      P3Y# = vert_store#(i,2,1)
      P3Z# = vert_store#(i,2,2)
 
      null = make vector3(1)
      null = make vector3(2)
      null = make vector3(3)
 
      ` -- calculate the two directional vectors for the adj and opp edges...
      set vector3 1, P1X#, P1Y#, P1Z#
      set vector3 2, P2X#, P2Y#, P2Z#
      set vector3 3, P3X#, P3Y#, P3Z#
      subtract vector3 2, 2, 1
      subtract vector3 3, 3, 1   ` -- vector 3 and 1 are now directional vectors
      normalize vector3 2,2      ` -- normalize em
      normalize vector3 3,3
      cross product vector3 1, 2,3  ` -- use the origin vector (1) to store the face normal
      normalize vector3 1,1
 
      `save normals (all 3 verts have same normals)
      vert_store#(i,0,3) = x vector3(1)
      vert_store#(i,0,4) = y vector3(1)
      vert_store#(i,0,5) = z vector3(1)
      vert_store#(i,1,3) = vert_store#(i,0,3)
      vert_store#(i,1,4) = vert_store#(i,0,4)
      vert_store#(i,1,5) = vert_store#(i,0,5)
      vert_store#(i,2,3) = vert_store#(i,0,3)
      vert_store#(i,2,4) = vert_store#(i,0,4)
      vert_store#(i,2,5) = vert_store#(i,0,5)
 
      null = delete vector3(1)
      null = delete vector3(2)
      null = delete vector3(3)
   next i
`******************************************************************************
 
 
`******************************************************************************
   `calc UV data for polys
 
   `save current x tile number
   xtiles = 1
   `save current z tile number
   ztiles = 1
   `calc how much to step each u data per tile
   stepu# = (1.0/tilex)
   `calc how much to step each v data per tile
   stepv# = (1.0/tilez)
   `set base u data for new set of tiles
   baseu# = 0
   `set base v data for new set of tiles
   basev# = 1-stepv#
   `poly number placeholder variable
   i = 1
   `from front to back
   for k = 1 to matzsegs
      `reset the number of x tiles to 1 and the u base to 0
      `at the beginning of each row
      xtiles = 1
      baseu# = 0
      `from left to right
      for l = 1 to matxsegs
         `2 polys per tile
         for m = 1 to 2
            `write all 3 verts of each matrix poly
            for j = 0 to 2
               `select which formula to apply depending on polygon side
               `and vert number (0 to 2)
               `j selects the vert number
               `m selects the polygon side (back/left or front right : 1 or 2)
               select j
                  case 0
                     if m = 1
                        testu# = baseu#
                        testv# = basev#+stepv#
                     else
                        testu# = baseu#
                        testv# = basev#+stepv#
                     endif
                  endcase
                  case 1
                     if m = 1
                        testu# = baseu#
                        testv# = basev#
                     else
                        testu# = baseu#+stepu#
                        testv# = basev#
                     endif
                  endcase
                  case 2
                     if m = 1
                        testu# = baseu#+stepu#
                        testv# = basev#
                     else
                        testu# = baseu#+stepu#
                        testv# = basev#+stepv#
                     endif
                  endcase
               endselect
               `store calculated data for each vert of each poly
               `u data
               vert_store#(i,j,6) = testu#
               `v data
               vert_store#(i,j,7) = testv#
            next j
            inc i, 1
         `next polygon side of this tile
         next m
         `update u data and xtiles place holder
         inc baseu#, stepu#
         inc xtiles, 1
         `reset data when texture tile width has been reached
         if xtiles > tilex
            baseu# = 0
            xtiles = 1
         endif
      `next x tile
      next l
      `update v data and ztiles place holder
      dec basev#, stepv#
      inc ztiles, 1
      `reset data when texture depth has been reached
      if ztiles > tilez
         basev# = 1-stepv#
         ztiles = 1
      endif
   `next z tile
   next k
`******************************************************************************
 
 
`******************************************************************************
   `make object from matrix verts
 
   `calc number of memblocks needed
   tempx = matxsegs/limbx
   tempz = matzsegs/limbz
   tempmem = tempx * tempz
   `make arrays to store memblock positions and memblock numbers
   dim membhold(tempx, tempz)
   dim mempos(tempmem)
   `enter memblock numbers for each texture tile based on the x and z limbs to use
   a = 1
   for i = 1 to tempz
      for j = 1 to tempx
         membhold(j, i) = a
         inc a, 1
      next j
   next i
   `calc the memblock size
   `formula is 12 byte header + ((( 32 bytes per vert * limb x segs)*(limb z segs * 2 polys))* 3 verts per poly)
   mat_mem_size = 12+(((32*limbx)*(limbz*2))*3)
   `make memblocks and write headers for each memblock and set the beginning
   `position for vert data to 12
   for i = 1 to tempmem
      make memblock i, mat_mem_size
      `write objects fvf format as 274
      write memblock dword i, 0, 274
      `write bytes per vert as 32 (8 floats xpos#,ypos#,zpos#,xnorm#,ynorm#,znorm#,u#,v#)
      write memblock dword i, 4, 32
      `write number of verts in matrix (polys*3)
      write memblock dword i, 8, ((limbx*limbz)*2)*3
      `set beginning position for vert data after header(0-8)+4 = 12
      mempos(i) = 12
   next i
 
   `image tile, row, and memblock placeholders
   xtile = 1
   ztile = 1
   xrow = 1
   xmem = 1
   zmem = 1
   `polygon placeholders (b=2 is 1 tile complete)
   b = 1
   `enter all polys' verts to memblock
   for i = 1 to num_mat_polys
      `select memblock number to write to use current x and z limb tile to pick
      tempmemnum = membhold(xmem, zmem)
      `write all 3 verts of each matrix poly
      for j = 0 to 2
         `xpos
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,0)
         `increment the current memblock position
         inc mempos(tempmemnum), 4
         `ypos
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,1)
         inc mempos(tempmemnum), 4
         `zpos
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,2)
         inc mempos(tempmemnum), 4
         `xnorm
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,3)
         inc mempos(tempmemnum), 4
         `ynorm
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,4)
         inc mempos(tempmemnum), 4
         `znorm
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,5)
         inc mempos(tempmemnum), 4
         `u data
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,6)
         inc mempos(tempmemnum), 4
         `v data
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,7)
         inc mempos(tempmemnum), 4
      next j
      `after each poly increase b by 1
      inc b, 1
      `after 2 polys have been completed 1 tile has been entered
      if b > 2
         `reset poly count to 1
         b = 1
         `move to next x tile
         inc xtile, 1
         `if at the next limb
         if xtile > limbx
            `reseet the x tile to 1
            xtile = 1
            `update the tile count to know when to move to the next row
            inc xrow, limbx
            `inc the xmem selector placeholder
            inc xmem, 1
            `if at the last xmem wide then start back at the begining
            if xmem > tempx
               xmem = 1
            endif
         endif
         `when at the end of the row
         if xrow > matxsegs
            `go back to the far left
            xrow = 1
            `update the number of rows done
            inc ztile, 1
            `when the number of rows done is > the preset depth
            if ztile > limbz
               `reset row count back to 1
               ztile = 1
               `move to the next zmem selector placeholder
               inc zmem, 1
               `if row count overlaps predetermined number
               if zmem > tempz
                  `wrap to 1
                  zmem = 1
               endif
            endif
         endif
      endif
   next i
   `undim arrays when done with them
   undim vert_store#(0,0,0)
   undim membhold(0, 0)
   undim mempos(0)
   `set the mesh number to use (can be replaced with a findfreemesh function)
   mesh = 1
   `make object and limbs from data setup
   for i = 1 to tempmem
      `make temp mesh from info
      make mesh from memblock mesh, i
      `delete temp memblock
      delete memblock i
      `if it is the first memblock mesh, use it as the base object
      if i = 1
         `make temp object for NGC
         make object object, mesh, 0
      `else turn each memblock mesh into limbs
      else
         add limb object, i-1, mesh
      endif
      `delete temp mesh
      delete mesh mesh
   next i
`******************************************************************************
endfunction
 
function make_house(house)
 
`give each house a numbered variable ( eg. house(1),house(2), etc,)
` and store the actual object number in that variable
house(house)=check_free_object_number()
make object box house(house),2,2,1
set object specular power house(house),2
set object specular house(house),rgb(220,200,200)
set object emissive house(house),rgb(220,200,200)
set object collision on house(house)
set object cull house(house),0
texture object house(house),housetexture
scale object texture house(house),20,40
roof(house)=check_free_object_number()
make object box roof(house),1.98,1,1
color object roof(house),rgb(220,220,230)
set object specular power roof(house),20
set object specular roof(house),rgb(150,150,150)
set object emissive roof(house),rgb(150,150,150)
position object roof(house),0,1,0
xrotate object roof(house),45
glue object to limb roof(house),house(house),0
door(house)=check_free_object_number()
make object box door(house),0.2,0.4,0.02
texture object door(house),doortexture
position object door(house),0,0,0
glue object to limb door(house),house(house),0
 
repeat
x=rnd(matrixsize)
z=rnd(matrixsize)
goodlocation=1
position object house(house),x,get ground height(1,x,z),z
if house>1
  for checkprevioushouses=1 to house-1
    if x<object position x(house(checkprevioushouses))+4 and x>object position x(house(checkprevioushouses))-4 and z<object position z(house(checkprevioushouses))+4 and z>object position z(house(checkprevioushouses))-4 then goodlocation=0
  next checkprevioushouses
endif
until goodlocation=1
 
`glue object to limb door(house),house(house),0
yrotate object house(house),rnd(360)
position object door(house),object position x(door(house)),get ground height(1,object position x(house(house))-0.5*sin(object angle y(house(house))),object position z(house(house))-0.5*cos(object angle y(house(house))))+0.2-object position y(house(house)),object position z(door(house))
position object door(house),object position x(door(house)),object position y(door(house)),object position z(door(house))-0.492
 
endfunction
 
function make_house_texture
 
cls
ink rgb(200,200,180),0
box 0,0,5,15
ink rgb(250,230,210),0
box 0,0,4,15
housetexture=free_image()
get image housetexture,0,0,5,15
 
endfunction
 
function make_door_texture
 
cls
colour=rgb(rnd(250),rnd(250),rnd(250))
ink colour,0
box 0,0,8,8
ink 0,0
box 1,1,3,3
box 5,1,7,3
ink colour-100,0
box 1,4,7,7
doortexture=free_image()
get image doortexture,0,0,8,8,1
 
endfunction
 
 
function check_free_image_number()
 
`this functionworks in the same way as the check_free_object function,
`except it works for images.
 
image=image_seed
repeat
inc image
until image exist(image)=0
 
endfunction image
 
 
function create_tree(number)
 
treeimage(number)=check_free_image_number()
bushiness=rnd(280)+60
droopiness#=(rnd(10)/10.0)+0.3
height#=rnd(5)/10.0
roundness=rnd(150)+50
fuzziness=rnd(2)
redness#=rnd(55)
density=rnd(4)+1
 
 
create bitmap 2,400,400
set current bitmap 2
cls
for l=1 to bushiness
if rnd(density)=0 then ink rgb(rnd(50)+200,rnd(20)+230,rnd(50)+200),0 else ink 0,0
for d=1 to bushiness
if rnd(density)=0 then dot d,l
next d
next l
get image treeimage(number),1,1,bushiness,bushiness
`set current bitmap 0
`delete bitmap 2
 
make object sphere number,0.01
`hide object number
limb=1
polarity=1
for a#=0.01 to 1.0 step 0.01*resolution
objectformesh=check_free_object_number()
make object sphere objectformesh,0.05+a#,5,5
make mesh from object limb,objectformesh
add limb number,limb,limb
delete object objectformesh
delete mesh limb
f#=rnd(fuzziness)/10.0
polarity=polarity*-1
offset limb number,limb,(f#*polarity),-(a#/(droopiness#/0.5)),(f#*polarity)
texture limb number,limb,treeimage(number)
inc limb
next a#
 
randomx#=rnd(1000)/10.0-40
randomz#=rnd(1000)/10.0-40
position object number,randomx#+50,get ground height(1,randomx#+50,randomz#+50)+1.2+height#,randomz#+50
scale object number,100-roundness#/2.0,roundness*a#,100-roundness#/2.0
set object transparency number,2
set object light number,0
make object cone 1000+number,1
scale object 1000+number,10+rnd(20),200+height#,10
position object 1000+number,randomx#+50,get ground height(1,randomx#+50,randomz#+50)+height#,randomz#+50
texture object 1000+number,bark
 
for n#=1.0 to 100.0/resolution
rotate limb number,n#,n#/50.0,0,0
next n#
 
endfunction
 
function delete_tree
 
 
for object=1 to numberoftrees
delete object 1000+object
delete object object
next object
 
endfunction
 
function move_trees()
 
for tree=1+treenumberseed to numberoftrees+treenumberseed
for n#=1.0 to 100.0/resolution
if object exist(tree)
if limb exist(tree,n#)=1 then scroll limb texture tree,n#,(((n#*resolution)/5.0)*sin(theta#+tree*10))*0.0001,(((n#*resolution)/3.0)*sin(theta#+tree*10))*0.00005
endif
inc theta#,0.01
next n#
next tree
 
endfunction
 
function create_bark
 
bark=check_free_image_number()
cls
box 0,0,500,500,rgb(100,80,40),rgb(70,30,20),rgb(150,120,80),rgb(80,60,20)
 
for x=1 to 2500
ink rgb(rnd(50)+50,40,20),0
dot rnd(500),rnd(500)
next x
for x=0 to 500
if rnd(3)=1
line x,0,x+rnd(100)-50,500
endif
next x
get image bark,0,0,500,500
 
endfunction