Sorry your browser is not supported!

`First, we are going to set up our player character (pc) variables.
`We will use a User Defined Type because it makes this code easy to read.
`I use floats for the stats, even though they will only be integers, because
`we may want to do some math with flaots later on. I don't want DB to convert
`the results to an integer unless we tell it to.
`I also expect to return to this and add more or make changes, but this is a good start.
Type Character
   Str as Float
   Dex as Float
   Con as Float
   Int as Float
   HP as Float
   Gold as Float
   Level as Float
   Name as String
EndType
`Notice that we CAN use INT, a reserved word, as a User Defined Type.

`Declare our player as a global variable.
Global Player as Character

` This is an array that will hold our map level.
Dim Dungeon(30,30)
Global Startx as Integer
Global Starty as Integer
Global Exitx as Integer
global Exity as Integer
Global PlayerX as Integer
Global PlayerY as Integer
Global LastTime as DWord
Global MonsterX as Integer
Global MonsterY as Integer
Global MonsterTimer as DWord
Global Monster as Character
Global Monster$ as String
Global Player$ as String
Global WallGray as DWord

WallGray=Rgb(100,100,100)

`Now, create our character.
CLS
Set Cursor 0,0
Input "Enter your character's name:",Player.Name
Print
Print "Welcome ";Player.Name
Wait 1000

`Generate some stats.
Do
   Cls
   Set Cursor 0,0
   Print Player.Name;", press [R] to re-roll stats, or [Y] to accept stats."
   Print
   `Randomize the stats. Picks a number from 2 to 10: rnd(4)=0-4. So 0-4 plus 0-4 equals 0-8.
   `Plus 2 = 2 to 10. There is also more of a chance of 5&6 results than there are of 2 or 10.
   Player.Str=rnd(4)+rnd(4)+2
   Player.Dex=rnd(4)+rnd(4)+2
   Player.Con=rnd(4)+rnd(4)+2
   Player.Int=rnd(4)+rnd(4)+2
   Player.HP=Player.str+player.con
   Player.Gold=(Player.Dex+Player.Con)*2
   `I based gold on Intelligence and dexterity since the smart and/or quick person (thief?)
   `should have more. And to balance that Hit Points is based on Str and Con.
   `Print the stats out.
   Print "Strength: ";Player.Str
   Print "Dexterity: ";Player.Dex
   Print "Constitution: ";Player.Con
   Print "Inteligence: ";Player.Int
   Print "Health: ";Player.HP
   Print "Gold: ";Player.Gold
   `Let the player choose to keep the stats or re-roll.
   Do
      a$=Lower$(Inkey$())
      If a$="r" or a$="y" Then Exit
   Loop
   if a$="y" Then Exit
Loop
Player.level=1

`This is added to create our player
Make_Player()

`We moved the Dungeon Construction code over to a function. This will make it easier to call from anywhere.
Randomize_Dungeon(Timer())
Draw_Dungeon()

playerx = startx
playery = starty
lastpx = playerx
lastpy = playery

Start_Monster()
LastTime=Timer()

Paste Image 1001,0,0

Do
   `Check for combat
   If PlayerX=MonsterX and PlayerY=MonsterY
      Player_Fight()
      Monster_Fight()
   Endif

   `Move the player
   playerx=playerx+rightkey()-leftkey(): `Left and right movement
   playery=playery+downkey()-upkey():  `Up and down movement
   `Check for a valid move and if enough time since last move has past.
   if Dungeon(playerx,playery)<1 or (Timer()-LastTime)<200
      playerx=lastpx
      playery=lastpy
   Endif

   `Reset timer if player was moved. This keeps us from zooming across the dungeon.
   IF lastpx<>playerx or lastpy<>playery
      LastTime=Timer()
      Player$=""
   Endif

   `And reposition the player.
   Clear_Light(PLayerX,PLayerY,2)
   Move_Monster()
   Paste Image 1,(playerx-1)*15,(playery-1)*15: `Player

   `Print out the player's stats and messages.
   Print_Stats()

   `Track our player's last position.
   lastpx=playerx
   lastpy=playery
Loop







Wait Key
End

`Draw Dungeon around the Player or monster
Function Clear_Light(dx,dy,r)
   For x=dx-r To dx+r
      For y=dy-r To dy+r
         If x<31 and y<31
            If Dungeon(x,y)=1
               Paste Image 1002,(x-1)*15,(y-1)*15
            Else
               Paste Image 1003,(x-1)*15,(y-1)*15
            Endif
            If x=Startx and y=Starty
               Ink Rgb(0,255,0),0
               Box (x-1)*15,(y-1)*15,x*15,y*15
            Endif
            If x=Exitx and y=Exity
               Ink Rgb(255,0,0),0
               Box (x-1)*15,(y-1)*15,x*15,y*15
            Endif
            If x=MonsterX and y=MonsterY
               Paste Image 2,(x-1)*15,(y-1)*15
            Endif
            If x=PlayerX and y=PLayerY
               Paste Image 1,(x-1)*15,(y-1)*15
            Endif
         Endif
      Next y
   Next x
EndFunction



Function Randomize_Dungeon(seed)
   Randomize seed
   `Create a Dungeon Level
   `Codes:
   `-1 = Solid wall. These walls are permanent and should not get replaced.
   ` 0 = Wall. These walls are temporary and can be replaced with ether open area or solid walls.
   ` 1 = Open. These are open areas and also should not be replaced.
   `First, clear out the dungeon.
   For x = 0 to 30
      For y = 0 to 30
         Dungeon(x,y)=0
      Next y
   Next x
   `First define our outside walls as solid.
   For i = 1 to 30
      Dungeon(i,1)=-1
      Dungeon(i,30)=-1
      Dungeon(1,i)=-1
      Dungeon(30,i)=-1
   Next i
   `Select our starting point "our entrance"
   startx=rnd(20)+5
   starty=rnd(20)+5
   Dungeon(startx,starty)=1
   `Now do our random map from that point.
   lastx=startx
   lasty=starty
   Set Cursor 0,0
   Do
      do
         `the random statements pick a number from -1 to 1 (or 0 to 2 minus 1).
         r=(rnd(1)*2)-1
         c=0
         if rnd(2)=1 then s=rnd(1) `this is used to keep a path going in the same direction.
         if s=1
            t=r:r=c:c=t `swap column and row
         Endif
         newx=lastx + r
         newy=lasty + c
         if Dungeon(newx,newy)=0 Then Exit
         if rnd(40)=3 `This keeps us from trying new directions forever.
            n=-1
            Do
               newx=rnd(28)+2
               newy=rnd(28)+2
               if Dungeon(newx,newy)=0 or (Dungeon(newx,newy)=1 and rnd(20)=1)
                  Dungeon(newx,newy)=0
                  exit
               Endif
               if rnd(100)<n `Again, when we run out of places, don't want to keep trying forever.
                  newx=0:newy=0 `setting these to 0 will tell us we're done.
                  Exit
               Endif
               inc n
            Loop
         Endif
         if newx=0 and newy=0 then exit
         if Dungeon(newx,newy)=0 Then exit
      Loop
      if newx=0 and newy=0 then exit
      Dungeon(newx,newy)=1 ` set our new open space.
      `this next part puts up some random solid walls around the last position.
      For i =-1 to 1
         If Dungeon(lastx+i,lasty)=0 and rnd(2)=0
            Dungeon(lastx+i,lasty)=-1
         Endif
      Next i
      For i =-1 to 1
         If Dungeon(lastx,lasty+i)=0 and rnd(2)=0
            Dungeon(lastx,lasty+i)=-1
         Endif
      Next i
      `Draw_Dungeon()
      lastx=newx
      lasty=newy
   Loop
Endfunction

Function Draw_Dungeon()
   cls
   Get Image 1002,0,0,15,15,1: ` A blank image for drawing clear space
   Ink WallGray,0
   Box 0,0,15,15
   Get Image 1003,0,0,15,15,1: ` A blank image for drawing wall space
   Ink Rgb(50,50,50),0
   Box 0,0,30*15,30*15
   Get Image 1001,0,0,30*15,30*15,1: ` A big blank square to cover our area.
   Ink WallGray,0
   For x= 1 to 30
      For y = 1 to 30
         If Dungeon(x,y)<1
            Box (x-1)*15,(y-1)*15,x*15,y*15
         Endif
      Next y
   Next x
   `Draw our Entrance
   Ink Rgb(0,255,0),0
   Box (startx-1)*15,(starty-1)*15,startx*15,starty*15
   `And last, make and draw our exit.
   Do
      exitx=Rnd(27)+2
      exity=rnd(27)+2
      If Dungeon(exitx,exity)=1
         d=(exitx-startx)*(exitx-startx)+(exity-starty)*(exity-starty)
         if d>8 Then exit
      Endif
   Loop
   Ink Rgb(255,0,0),0
   Box (exitx-1)*15,(exity-1)*15,exitx*15,exity*15
   Get Image 1000,0,0,30*15,30*15,1:` A picture of our map (a treasure for later on).
Endfunction

Function Make_Player()
   `What we do here is simply read in the data statements for each pixel, then capture the image.
   `c is our color. If we read c, and it's 0, then c= 0. Otherwise, if c=1, it will convert to white: rgb(255,255,255)
   Ink 0,0
   Box 0,0,25,25
   Local c as Dword
   Restore Character_Pic
   For y=0 to 14
      for x=0 to 14
         read c
         c=c*Rgb(255,255,255) `"c" is either 0 or 1. Multiply by White: RGB(255,255,255) and either get 0, or white.
         Dot x,y,c
      Next x
   Next y
   Get Image 1,0,0,15,15,1
Endfunction

Function Make_Monster()
   Ink 0,0
   Box 0,0,25,25
   Local c as Dword
   `We will be making changes to this later on to select more than one monster type
   Restore Spider_Pic
   For y=0 to 14
      for x=0 to 14
         read c
         c=c*Rgb(255,50,50): `"c" is either 0 or 1. Multiply by White RGB(255,255,255) and either get 0, or white.
         Dot x,y,c
      Next x
   Next y
   Get Image 2,0,0,15,15,1
   `We will be adding in moster stats in the next update.
Endfunction

Function Start_Monster()
   Make_Monster()
   Do
      x=rnd(27)+2
      y=rnd(27)+2
      if Dungeon(x,y)=1 Then Exit: `Looking for an open space
   Loop
   MonsterX=x
   MonsterY=y
   MonsterTimer=Timer()
   Monster.name="Spider"
   Monster.str=Rnd(5)+2
   Monster.dex=Rnd(5)+2
   Monster.con=Rnd(5)+2
   Monster.int=Rnd(5)+2
   Monster.hp=monster.str+monster.con
   Monster.gold=(Monster.dex+monster.int)*.5
Endfunction

Function Move_Monster()
   If Timer()-MonsterTimer<1000 Then ExitFunction: `We only want the monster to move once a second (for now).
   MonsterTimer=Timer(): `Reset our MonsterTimer
   Monster$=""
   IF rnd(20)=1
      Restore Spider_Talk
      Read m
      For i = 0 to Rnd(m-1)
         Read Monster$
      Next i
   Endif
   xdir=(PlayerX>MonsterX)-(PlayerX<MonsterX): `Add 1 if player is to the right, subtract 1 if the player it to the left.
   ydir=(PlayerY>MonsterY)-(PlayerY<MonsterY): `Same as the x, but verticle.
   `Now check for valid moves.. and move the monster
   nx=MonsterX+xdir
   ny=MonsterY+ydir
   If Dungeon(nx,ny)=1
      `Erase the previous monster position if the monster was not hidden.
      If Point((MonsterX-1)*15+7,(MonsterY-1)*15+7)<>WallGray Then Paste Image 1002,(MonsterX-1)*15,(MonsterY-1)*15
      MonsterX=nx
      MonsterY=ny
      `Draw the monster if the monster is not hidden.
      If Point((nx-1)*15+7,(ny-1)*15+7)<>WallGray Then Paste Image 2,(nx-1)*15,(ny-1)*15
      ExitFunction
   Endif
   nx=MonsterX+xdir
   ny=MonsterY
   If Dungeon(nx,ny)=1
      If Point((MonsterX-1)*15+7,(MonsterY-1)*15+7)<>WallGray Then Paste Image 1002,(MonsterX-1)*15,(MonsterY-1)*15
      MonsterX=nx
      MonsterY=ny
      If Point((nx-1)*15+7,(ny-1)*15+7)<>WallGray Then Paste Image 2,(nx-1)*15,(ny-1)*15
      ExitFunction
   Endif
   nx=MonsterX
   ny=MonsterY+ydir
   If Dungeon(nx,ny)=1
      If Point((MonsterX-1)*15+7,(MonsterY-1)*15+7)<>WallGray Then Paste Image 1002,(MonsterX-1)*15,(MonsterY-1)*15
      MonsterX=nx
      MonsterY=ny
      If Point((nx-1)*15+7,(ny-1)*15+7)<>WallGray Then Paste Image 2,(nx-1)*15,(ny-1)*15
      ExitFunction
   Endif
   If Point(( MonsterX - 1)*15+7,( MonsterY - 1)*15+7)<>WallGray Then Paste Image 2,( MonsterX - 1)*15,(MonsterY - 1)*15
   `If we get to here, there are no valid moves and the monster stays put.
Endfunction

Function Print_Stats()
   Ink 0,0
   Box 450,0,800,200
   Ink rgb(150,150,255),0
   Set Cursor 450,0
   Print "Name: ";Player.name
   Set Cursor 450,15
   Print "Str: ";str$(Player.str)
   Set Cursor 450,30
   Print "Dex: ";str$(Player.dex)
   Set Cursor 450,45
   Print "Con: ";str$(Player.con)
   Set Cursor 450,60
   Print "Int: ";str$(Player.int)
   Set Cursor 450,80
   Ink Rgb(255,0,0),0
   Print "Health: ";str$(Player.HP)
   Set Cursor 450,100
   Ink Rgb(255,255,0),0
   Print "Gold: ";str$(Player.gold)
   Set Cursor 450,150
   Ink Rgb(0,255,0),0
   Print Player$
   Set Cursor 450,165
   Ink Rgb(255,100,0),0
   Print Monster$
Endfunction

Function Monster_Fight()
   If Timer()-MonsterTimer<500 Then ExitFunction: `We only want the monster to attack once a second (for now).
   MonsterTimer=Timer(): `Reset our MonsterTimer
   ToHit=Monster.Dex+Rnd(10)
   Defense=Player.Dex+Rnd(10)
   Damage=Monster.Str+Rnd(10)
   Armor=Player.Con+Rnd(1)
   If ToHit>Defense and Damage>Armor
      Player.HP=Player.HP-(Damage-Armor)
      Monster$=Monster.Name+" hit "+Player.name+" for "+Str$(Damage-Armor)+"."
   Else
      Monster$=Monster.Name+" misses "+Player.name+"."
   Endif
Endfunction

Function Player_Fight()
   If Timer()-LastTime<500 Then ExitFunction
   LastTime=Timer(): `Reset our PlayerTimer
   ToHit=Player.Dex+Rnd(10)
   Defense=Monster.Dex+Rnd(10)
   Damage=Player.Str+Rnd(10)
   Armor=Monster.Con+Rnd(1)
   If ToHit>Defense and Damage>Armor
      Monster.HP=Monster.HP-(Damage-Armor)
      Player$=Player.Name+" hit "+Monster.name+" for "+Str$(Damage-Armor)+"."
   Else
      Player$=Player.Name+" misses "+Monster.name+"."
   Endif
Endfunction

Character_Pic:
data  0,1,0,0,0,0,0,1,1,0,0,0,0,0,0
data  0,1,0,0,0,0,1,1,1,1,0,0,0,0,0
data  0,0,1,0,0,0,1,1,1,1,0,0,0,0,0
data  0,0,1,0,0,0,0,1,1,0,0,0,0,0,0
data  0,0,0,1,0,0,1,1,1,1,1,0,0,0,0
data  0,0,0,1,0,1,1,1,0,0,1,1,1,0,0
data  0,0,0,0,1,1,0,1,0,1,1,1,1,0,0
data  0,0,0,0,1,0,1,1,1,0,1,1,0,0,0
data  0,0,0,0,0,0,1,1,1,0,1,1,0,0,0
data  0,0,0,0,0,0,1,1,1,1,1,0,0,0,0
data  0,0,0,0,0,0,1,1,0,1,1,0,0,0,0
data  0,0,0,0,0,0,1,1,0,1,1,0,0,0,0
data  0,0,0,0,0,0,1,1,0,1,1,0,0,0,0
data  0,0,0,0,0,1,1,1,0,1,1,1,0,0,0
data  0,0,0,0,0,1,1,1,0,1,1,1,0,0,0
Spider_Pic:
data  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
data  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
data  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
data  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
data  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
data  0,0,1,0,0,1,0,0,0,1,0,0,1,0,0
data  0,1,0,1,0,1,0,0,0,1,0,1,0,1,0
data  0,1,0,1,0,0,1,1,1,0,0,1,0,1,0
data  0,1,0,0,1,1,1,1,1,1,1,0,0,1,0
data  1,0,0,0,1,1,0,1,0,1,1,0,0,0,1
data  1,0,1,0,1,1,1,1,1,1,1,0,1,0,1
data  1,0,1,0,0,1,1,1,1,1,0,0,1,0,1
data  1,0,1,0,1,0,1,0,1,0,1,0,1,0,1
data  1,0,1,0,1,0,1,0,1,0,1,0,1,0,1
data  1,0,1,0,1,0,1,0,1,0,1,0,1,0,1

Spider_Talk:
Data 5
Data "Itsy bitsy spider..."
Data "Clik-clik-clickity-clik."
Data "Come here little fly."
Data "Come for my dinnerss?"
Data "Ssstick around!"

`Rpg challenge by Ric


`display settings
if check display mode(1024,768,32)=1 then set display mode 1024,768,32
sync on
sync rate 30

`camera and light settings
autocam off
set camera range 0.1,10000
color backdrop 0
hide light 0
set ambient light 20
make light 1
position light 1,200,100,200
set light range 1,100000

`set the randomize seed to the timer, so random events are different each time
randomize timer()

`set size of terrain
global matrixsize
matrixsize=100

`fog settings
fog on
fog color rgb(180,180,250)
fog distance matrixsize*0.6

`set initial value for object numbers
global object_seed
object_seed=1000000

`set initial value for image numbers
global image_seed
image_seed=1000000

`function calls for creating world
global grassimage
create_grass()
global skyimage
create_sky()
global waterimage
global water
create_water_image()
create_water()
terraform()
create_skysphere()

`set initial camera position
position camera matrixsize/2,get ground height(1,50,50)+2,matrixsize/2
ink 0,0


`****************************************

`main program loop
do

`function calls for continuous events
move_camera()
move_water()

`print screen fps
text 0,0,str$(screen fps())

`refresh screen
sync
loop

`****************************************

`functions

function terraform

`set size of terrain
rows=60
columns=60

`create terrain
make matrix 1,matrixsize,matrixsize,columns,rows

`set mountain peaks
number_of_peaks=rnd(35)+10
max_height=15

dim peakx(number_of_peaks)
dim peakz(number_of_peaks)
dim height(number_of_peaks)
for peak=1 to number_of_peaks
  `set x,z coordinates for peak
  peakx(peak)=rnd(columns-10)+5
  peakz(peak)=rnd(rows-10)+5
  `set height of peak
  height(peak)=rnd(max_height)+10
  `create peak
  set matrix height 1,peakx(peak),peakz(peak),height(peak)
next peak

num=rows*columns
dim obnum(rows+1,columns+1)
dim v#(rows,columns)

`give each tile an x,z coordinate for use later
for x=1 to rows
for z=1 to columns
obnum(x,z)=ob
ob=ob+1
next z
next x

`texture matrix
prepare matrix texture 1,grassimage,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


`adjust height of points between peaks
elasticity#=0.3
damping#=0

for time=1 to 100

for peak=1 to number_of_peaks
  set matrix height 1,peakx(peak),peakz(peak),height(peak)
next peak

for x=1+1 to rows-1
for z=1+1 to columns-1
if x<rows
distxp1#=get matrix height(1,x+1,z)-get matrix height (1,x,z)
endif
if x>1
distxm1#=get matrix height(1,x-1,z)-get matrix height (1,x,z)
endif
if z<columns
distzp1#=get matrix height(1,x,z+1)-get matrix height (1,x,z)
endif
if z>1
distzm1#=get matrix height(1,x,z-1)-get matrix height (1,x,z)
endif
vectorsum#=distxp1#+distxm1#+distzp1#+distzm1#
a#=vectorsum#*elasticity#
v#(obnum(x,z))=v#(obnum(x,z))+a#
set matrix height 1,x,z,get matrix height(1,x,z)+v#(obnum(x,z))
v#(obnum(x,z))=v#(obnum(x,z))*damping#
next z
next x
update matrix 1
next time



endfunction




function check_free_object_number

`this handy function means that you never have to worry about
`remembering object numbers.  You just give them names you can remember,
`and this function will find the next available number to assosciate
`with that name.  Just call the function by, for example, writing:
`
`ball=check_free_object_number
`make object sphere ball,1

object=object_seed
repeat
inc object
until object exist(object)=0

endfunction object

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_grass

`make a shaded box
box 0,0,100,100,rgb(100,150,100),rgb(50,200,20),rgb(80,0,10),rgb(150,200,0)

`and speckle it with random dots
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      r=rnd(150)
      g=rnd(250)
      b=rnd(100)
      ink rgb(r,g,b),0
      dot x,y
    endif
  next x
next y


grassimage=check_free_image_number()
get image grassimage,0,0,100,100

endfunction

function create_skysphere

`get image for sphere by taking snapshot of terrain
image=check_free_image_number()
set camera fov 90
position camera matrixsize/2.0,3,-matrixsize*0.3
sync
get image image,0,0,screen width(),screen height()
set camera fov 60

`sphere 1 (mountains near) - just a sphere textured with the captured image
object=check_free_object_number()
make object sphere object,matrixsize*2
set object cull object,0
texture object object,image
scale object texture object,3,1
set object texture object,2,1
set object fog object,0
set object light object,0
set object transparency object,4
position object object,matrixsize/2,0,matrixsize/2

`sphere 2 (mountains far) - and another one further out. The inner sphere must be
`transparent, though, to see this one.
object=check_free_object_number()
make object sphere object,matrixsize*3
set object cull object,0
texture object object,image
scale object texture object,4,1
set object texture object,2,1
set object fog object,0
set object light object,0
set object transparency object,4

`sphere 3 (sky) - a third, outer sphere for the sky
object=check_free_object_number()
make object sphere object,matrixsize*4
set object cull object,0
texture object object,skyimage
scale object texture object,1,1.8
set object light object,0
set object fog object,0

endfunction

function create_sky()
`creates a dark to light bluish gradient
cls
for n=0 to 250
  ink rgb(n,n,250),0
  line 0,n,250,n
next n

skyimage=check_free_image_number()
get image skyimage,0,0,250,250

endfunction


function create_water_image

`creates a shaded box
box 0,0,100,100,rgb(150,150,200),rgb(50,200,200),rgb(80,0,200),rgb(150,100,200)

`and speckles with white bits
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      r=(250)
      g=(250)
      b=(250)
      ink rgb(r,g,b),0
      dot x,y
    endif
  next x
next y


waterimage=check_free_image_number()
get image waterimage,0,0,100,100



endfunction


function create_water

`just a plane textured with the water image
water=check_free_object_number()
make object plain water,matrixsize*4,matrixsize*4
texture object water,waterimage
set object texture water,2,1
scale object texture water,4,4
xrotate object water,90
set object fog water,0
set object emissive water,rgb(220,220,200)

endfunction

function move_water

`moves the texture along a bit
scroll object texture water,0.0001,0.00016
`and moves the water up and down according to a sine wave
position object water,0,0.5*sin(theta#)+3,0
inc theta#,1

endfunction

function move_camera

control camera using arrowkeys 0,0.1,2
`set camera position to ground level
position camera camera position x(),get ground height(1,camera position x(),camera position z())+2,camera position z()
`if in water, set camera to water level
if camera position y()<object position y(water)+0.2 then position camera camera position x(),object position y(water)+0.2,camera position z()


endfunction

`Rpg challenge by Ric


`display settings
if check display mode(1024,768,32)=1 then set display mode 1024,768,32
sync on
sync rate 30

`camera and light settings
autocam off
set camera range 0.1,10000
color backdrop 0
hide light 0
set ambient light 20
make light 1
position light 1,200,100,200
set light range 1,100000

`set the randomize seed to the timer, so random events are different each time
randomize timer()

`set size of terrain
global matrixsize
matrixsize=100

`fog settings
fog on
fog color rgb(180,180,250)
fog distance matrixsize*0.6

`set initial value for object numbers
global object_seed
object_seed=1000000

`set initial value for image numbers
global image_seed
image_seed=1000000

`function calls for creating world
global grassimage
create_grass()
global doortexture
make_door_texture()
global housetexture
make_house_texture()
global skyimage
create_sky()
global waterimage
global water
global water2
create_water_image()
create_water()
terraform()
create_skysphere()
for house=1 to rnd(20)+5
  make_house()
next house

`set initial camera position
position camera matrixsize/2,get ground height(1,50,50)+2,matrixsize/2
ink 0,0


`****************************************

`main program loop
do

`function calls for continuous events
move_camera()
move_water()

`print screen fps
text 0,0,str$(screen fps())

`refresh screen
sync
loop

`****************************************

`functions

function terraform

`set size of terrain
rows=60
columns=60

`create terrain
make matrix 1,matrixsize,matrixsize,columns,rows

`set mountain peaks
number_of_peaks=rnd(35)+10
max_height=15

dim peakx(number_of_peaks)
dim peakz(number_of_peaks)
dim height(number_of_peaks)
for peak=1 to number_of_peaks
  `set x,z coordinates for peak
  peakx(peak)=rnd(columns-10)+5
  peakz(peak)=rnd(rows-10)+5
  `set height of peak
  height(peak)=rnd(max_height)+10
  `create peak
  set matrix height 1,peakx(peak),peakz(peak),height(peak)
next peak

num=rows*columns
dim obnum(rows+1,columns+1)
dim v#(rows,columns)

`give each tile an x,z coordinate for use later
for x=1 to rows
for z=1 to columns
obnum(x,z)=ob
ob=ob+1
next z
next x

`texture matrix
prepare matrix texture 1,grassimage,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


`adjust height of points between peaks
elasticity#=0.3
damping#=0

for time=1 to 100

for peak=1 to number_of_peaks
  set matrix height 1,peakx(peak),peakz(peak),height(peak)
next peak

for x=1+1 to rows-1
for z=1+1 to columns-1
if x<rows
distxp1#=get matrix height(1,x+1,z)-get matrix height (1,x,z)
endif
if x>1
distxm1#=get matrix height(1,x-1,z)-get matrix height (1,x,z)
endif
if z<columns
distzp1#=get matrix height(1,x,z+1)-get matrix height (1,x,z)
endif
if z>1
distzm1#=get matrix height(1,x,z-1)-get matrix height (1,x,z)
endif
vectorsum#=distxp1#+distxm1#+distzp1#+distzm1#
a#=vectorsum#*elasticity#
v#(obnum(x,z))=v#(obnum(x,z))+a#
set matrix height 1,x,z,get matrix height(1,x,z)+v#(obnum(x,z))
v#(obnum(x,z))=v#(obnum(x,z))*damping#
next z
next x
update matrix 1
next time



endfunction




function check_free_object_number

`this handy function means that you never have to worry about
`remembering object numbers.  You just give them names you can remember,
`and this function will find the next available number to assosciate
`with that name.  Just call the function by, for example, writing:
`
`ball=check_free_object_number
`make object sphere ball,1

object=object_seed
repeat
inc object
until object exist(object)=0

endfunction object

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_grass

`make a shaded box
box 0,0,100,100,rgb(100,150,100),rgb(50,200,20),rgb(80,0,10),rgb(150,200,0)

`and speckle it with random dots
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      r=rnd(150)
      g=rnd(250)
      b=rnd(100)
      ink rgb(r,g,b),0
      dot x,y
    endif
  next x
next y


grassimage=check_free_image_number()
get image grassimage,0,0,100,100

endfunction

function create_skysphere

`get image for sphere by taking snapshot of terrain
image=check_free_image_number()
set camera fov 90
position camera matrixsize/2.0,3,-matrixsize*0.3
sync
get image image,0,0,screen width(),screen height()
set camera fov 60

`sphere 1 (mountains near) - just a sphere textured with the captured image
object=check_free_object_number()
make object sphere object,matrixsize*2
set object cull object,0
texture object object,image
set object texture object,2,1
scale object texture object,3,1
set object fog object,0
set object light object,0
set object transparency object,4
position object object,matrixsize/2,0,matrixsize/2

`sphere 2 (mountains far) - and another one further out. The inner sphere must be
`transparent, though, to see this one.
object=check_free_object_number()
make object sphere object,matrixsize*2.5
yrotate object object,30
set object cull object,0
texture object object,image
set object texture object,2,1
scale object texture object,3,1
set object fog object,0
`set object light object,0
set object transparency object,4
ghost object on object,4
set object emissive object,rgb(180,150,250)
fade object object,70
position object object,matrixsize/2,0,matrixsize/2

`sphere 3 (sky) - a third, outer sphere for the sky
object=check_free_object_number()
make object sphere object,matrixsize*4
set object cull object,0
texture object object,skyimage
scale object texture object,1,1.8
set object light object,0
set object fog object,0

endfunction

function create_sky()
`creates a dark to light bluish gradient
cls
for n=0 to 250
  ink rgb(n,n,250),0
  line 0,n,250,n
next n

skyimage=check_free_image_number()
get image skyimage,0,0,250,250

endfunction


function create_water_image

`creates a shaded box
box 0,0,100,100,rgb(150,150,200),rgb(50,200,200),rgb(80,0,200),rgb(150,100,200)

`and speckles with white bits
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      r=(250)
      g=(250)
      b=(250)
      ink rgb(r,g,b),0
      dot x,y
    endif
  next x
next y


waterimage=check_free_image_number()
get image waterimage,0,0,100,100



endfunction


function create_water

`just a plane textured with the water image
water=check_free_object_number()
make object plain water,matrixsize*4,matrixsize*4
texture object water,waterimage
set object texture water,2,1
scale object texture water,4,4
xrotate object water,90
set object fog water,0
set object emissive water,rgb(220,220,200)
ghost object on water
set alpha mapping on water,20
water2=check_free_object_number()
make object plain water2,matrixsize*4,matrixsize*4
texture object water2,waterimage
xrotate object water2,90
position object water2,0,1,0
set object texture water2,2,1
scale object texture water2,4,4
set object light water2,0
set object fog water2,0

endfunction

function move_water

`moves the texture along a bit
scroll object texture water,0.001,0
scroll object texture water2,-0.001,0
`and moves the water up and down according to a sine wave
position object water,0,0.5*sin(theta#)+3,0
inc theta#,1

endfunction

function move_camera

control camera using arrowkeys 0,0.1,2
`set camera position to ground level
position camera camera position x(),get ground height(1,camera position x(),camera position z())+0.2,camera position z()
`if in water, set camera to water level
if camera position y()<object position y(water)+0.2 then position camera camera position x(),object position y(water)+0.2,camera position z()


endfunction

function make_house

house=check_free_object_number()
make object box house,2,2,1
set object cull house,0
texture object house,housetexture
scale object texture house,20,40
roof=check_free_object_number()
make object box roof,1.98,1,1
color object roof,rgb(80,80,80)
position object roof,0,1,0
xrotate object roof,45
glue object to limb roof,house,0
door=check_free_object_number()
make object box door,0.2,0.8,0.02
texture object door,doortexture
position object door,0,0,-0.5
glue object to limb door,house,0
x=rnd(matrixsize)
z=rnd(matrixsize)
position object house,x,get ground height(1,x,z),z
yrotate object house,rnd(360)

endfunction

function make_house_texture

cls
ink rgb(200,200,180),0
box 0,0,5,15
ink rgb(100,60,40),0
box 0,0,4,14
housetexture=check_free_image_number()
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=check_free_image_number()
get image doortexture,0,0,8,8,1

endfunction

sync on
sync rate 0
autocam off
set display mode 1280, 1024, 32
set ambient light 0
randomize timer()
color backdrop 0


#constant TEXTURE_SIZE 64

make memblock 1, 12 + (TEXTURE_SIZE * TEXTURE_SIZE * 4)
write memblock dword 1, 0, TEXTURE_SIZE
write memblock dword 1, 4, TEXTURE_SIZE
write memblock dword 1, 8, 32
c as dword
for x = 0 to TEXTURE_SIZE - 1
   for y = 0 to TEXTURE_SIZE - 1
      c = rgb(32, 128 + rnd(127), 32)
      write memblock dword 1, 12 + ((y*TEXTURE_SIZE)+x)*4, c
   next y
next x
make image from memblock 1, 1
delete memblock 1











`CONSTANTS
#constant W 64
#constant H 64
#constant MAPSCALE 4.0
#constant SMOOTHING_FACTOR 0.75
#constant SMOOTHING_ITTERATIONS 4
#constant USCALE 2.0
#constant VSCALE 2.0
#constant MAX_HEIGHT 50.0



`Control Keys
#constant KeyW 17
#constant KeyA 30
#constant KeyS 31
#constant KeyD 32

`Create the terrain
make memblock 1, 12 + (32 * 3 * 2 * W * H)
dim HEIGHTMAP#(W,H)
dim NORMALS#(W,H,3)
gosub GENERATE_TERRAIN

`Create the player + Data
Type Coord
   x#
   y#
   z#
EndType
Type PlayerData
   Pos as Coord
   moved as boolean
   Target as Coord
EndType
#constant PLAYER_SPEED 3.0

P as PlayerData
P.Pos.x# = 10
P.Pos.z# = 10
P.Target.x# = P.Pos.x# + 0.0001
P.Target.z# = P.Pos.z#

P.Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, P.Pos.x#, P.Pos.z#) + object size y(1) * 0.5
P.moved = 1
make object sphere 2, 1
position object 2, P.Pos.x#, P.Pos.y#, P.Pos.z#
null = make vector2(1)  :`Create a temporary vector for working out headings

make object sphere 3, 0.5  :`Target Object for when moving
set object transparency 3, 3
#constant TARGET_COLOR 0xFF0000
color object 3, TARGET_COLOR
a as DWORD
set point light 0, 0, 0, 0
set light range 0, 40



`Mouse Status
mouseStatus = 0

frameTime# = 1.0
startTime = timer()
do
   frameTime# = (frameTime# * 0.8) + ((timer() - startTime) * 0.2)
   startTime = timer()
   text 0,0, "FPS: " + str$(screen fps())

   a = curvevalue(0, a, 2000.0 / frameTime#)
   color object 3, (a << 24) || TARGET_COLOR


   if mouseclick() = 1 AND mouseStatus = 0
      mouseStatus = mouseclick()
      null = pick object(mousex(), mousey(), 1, 1)
      P.Target.x# = camera position x() + get pick vector x()
      P.Target.z# = camera position z() + get pick vector z()
      position object 3, P.Target.x#, GET_CUSTOM_TERRAIN_HEIGHT(1,P.Target.x#,P.Target.z#) + 0.25, P.Target.z#
      a = 255
   else
      if mouseclick() = 0 then mouseStatus = 0
   endif

   if P.Target.x# <> P.Pos.x# OR P.Target.z# <> P.Pos.z#
      set vector2 1, P.Target.x# - P.Pos.x#, P.Target.z# - P.Pos.z#
      normalize vector2 1, 1

      inc P.Pos.x#, x vector2(1) * frameTime# * 0.001 * PLAYER_SPEED
      inc P.Pos.z#, y vector2(1) * frameTime# * 0.001 * PLAYER_SPEED
      P.Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, P.Pos.x#, P.Pos.z#) + 0.5

      position object 2, P.Pos.x#, P.Pos.y#, P.Pos.z#

      position light 0, P.Pos.x#, P.Pos.y# + 10, P.Pos.z#
     ` point light 0, P.Pos.x#, P.Pos.y#, P.Pos.z#

      position camera P.Pos.x# + 10, P.Pos.y# + 10, P.Pos.z# + 10
      point camera P.Pos.x#, P.Pos.y#, P.Pos.z#
   endif


   sync
loop
end




function GET_CUSTOM_TERRAIN_HEIGHT(obj, x#, z#)
   height# = 1000.0 - intersect object(obj, x#, 1000, z#,  x#, -1000, z#)
endfunction height#


GENERATE_TERRAIN:
   for i = 0 to W
      for j = 0 to H
         HEIGHTMAP#(i, j) = rnd(MAX_HEIGHT)
      next j
   next i

   for iters = 0 to SMOOTHING_ITTERATIONS
      for i = 0   to W-1       : for j = 0 to H           : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR) + (HEIGHTMAP#(i+1,j) * (1.0-SMOOTHING_FACTOR)) : next j : next i
      for i = W-1 to 0  step -1: for j = 0 to H           : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR) + (HEIGHTMAP#(i+1,j) * (1.0-SMOOTHING_FACTOR)) : next j : next i
      for i = 0 to W           : for j = 0 to H-1         : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR) + (HEIGHTMAP#(i,j+1) * (1.0-SMOOTHING_FACTOR)) : next j : next i
      for i = 0 to W           : for j = H-1 to 0 step -1 : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR) + (HEIGHTMAP#(i,j+1) * (1.0-SMOOTHING_FACTOR)) : next j : next i
   next iters

   gosub UPDATE_TERRAIN
return





UPDATE_TERRAIN:


   ` CALCULATE NORMALS

   for i = 1 to W-1
      for j = 1 to H-1
         null = make vector3(1)
         null = make vector3(2)
         null = make vector3(3)
         null = make vector3(4)
         null = make vector3(5)
         null = make vector3(6)
         null = make vector3(7)
         null = make vector3(8)
         null = make vector3(9)

         set vector3 1,  MAPSCALE, HEIGHTMAP#(i,j) - HEIGHTMAP#(i+1,j  ),  0
         set vector3 2,         0, HEIGHTMAP#(i,j) - HEIGHTMAP#(i  ,j-1), -MAPSCALE
         set vector3 3, -MAPSCALE, HEIGHTMAP#(i,j) - HEIGHTMAP#(i-1,j  ),  0
         set vector3 4,         0, HEIGHTMAP#(i,j) - HEIGHTMAP#(i  ,j+1),  MAPSCALE


         cross product vector3 5, 1, 2
         cross product vector3 6, 2, 3
         cross product vector3 7, 3, 4
         cross product vector3 8, 4, 1

         add vector3 9, 9, 5
         add vector3 9, 9, 6
         add vector3 9, 9, 7
         add vector3 9, 9, 8
         divide vector3 9, 4
         normalize vector3 9, 9
         NORMALS#(i,j,0) = x vector3(9)
         NORMALS#(i,j,1) = y vector3(9)
         NORMALS#(i,j,2) = z vector3(9)
         null = delete vector3(1)
         null = delete vector3(2)
         null = delete vector3(3)
         null = delete vector3(4)
         null = delete vector3(5)
         null = delete vector3(6)
         null = delete vector3(7)
         null = delete vector3(8)
         null = delete vector3(9)
      next j
   next i


   if memblock exist(1) then delete memblock 1
   make memblock 1, 12 + (32 * 3 * 2 * W * H)

   write memblock dword 1,0,274 : `FVF FORMAT
   write memblock dword 1,4,32  : `SIZE PER VERT
   write memblock dword 1,8,W*H*2*3   : `VERT NO


   poly = 0
   for i = 0 to W-1
      for j = 0 to H-1
         ` ** POLY 1 **
         x = i   : z = j   : y# = HEIGHTMAP#(x,z) : n = 12 + (poly * 192)       : u = 0.0    : v = 0.0    : gosub CREATE_MESH_ENTRY
         x = i   : z = j+1 : y# = HEIGHTMAP#(x,z) : n = 12 + (poly * 192) + 32  : u = 0.0    : v = VSCALE : gosub CREATE_MESH_ENTRY
         x = i+1 : z = j   : y# = HEIGHTMAP#(x,z) : n = 12 + (poly * 192) + 64  : u = USCALE : v = 0.0    : gosub CREATE_MESH_ENTRY
         ` ** POLY 2 **
         x = i+1 : z = j   : y# = HEIGHTMAP#(x,z) : n = 12 + (poly * 192) + 96  : u = USCALE : v = 0.0    : gosub CREATE_MESH_ENTRY
         x = i   : z = j+1 : y# = HEIGHTMAP#(x,z) : n = 12 + (poly * 192) + 128 : u = 0.0    : v = VSCALE : gosub CREATE_MESH_ENTRY
         x = i+1 : z = j+1 : y# = HEIGHTMAP#(x,z) : n = 12 + (poly * 192) + 160 : u = USCALE : v = VSCALE : gosub CREATE_MESH_ENTRY

         inc poly
      next j
   next i


   make mesh from memblock 1, 1



   if object exist(1) = 1 then delete object 1
   make object 1, 1, 1

   position object 1, 0, 0, 0
   position camera CamX#, CamY#, CamZ#
   point camera 0,0,0
return


CREATE_MESH_ENTRY:
   write memblock float 1, n +  0, (x - (W/2)) * MAPSCALE  :`X
   write memblock float 1, n +  4, y#  `Y
   write memblock float 1, n +  8, (z - (H/2)) * MAPSCALE :`Z

   write memblock float 1, n + 12, NORMALS#(x,z,0)  :`NX
   write memblock float 1, n + 16, NORMALS#(x,z,1)  :`NY
   write memblock float 1, n + 20, NORMALS#(x,z,2)  :`NZ

   write memblock float 1, n + 24, u  :`X
   write memblock float 1, n + 28, v  :`Y
return

`Rpg challenge by Ric

`display settings
if check display mode(1024,768,32)=1 then set display mode 1024,768,32
sync on
sync rate 30

`camera and light settings
autocam off
set camera range 0.01,10000
color backdrop 0
hide light 0
set ambient light 20
make light 1


`set the randomize seed to the timer, so random events are different each time
randomize timer()

`set size of terrain
global matrixsize
matrixsize=100

`fog settings
fog on
fog color rgb(180,180,250)
fog distance matrixsize*0.6

`set initial value for object numbers
global object_seed
object_seed=1000000

`set initial value for image numbers
global image_seed
image_seed=1000000

`function calls for creating world
global wallpaper
global light
make_wallpaper()
global internaldoor
make_room()

`position light for world illumination
position light 1,200,100,200
set light range 1,100000

global grassimage
create_grass()
global doortexture
make_door_texture()
global housetexture
make_house_texture()
global skyimage
create_sky()
global waterimage
global water
global water2
global theta#
create_water_image()
create_water()
terraform()
create_skysphere()



`set house variables
global inroom
global numberofhouseentered
global number_of_houses
number_of_houses=rnd(20)+5
`set up an array to store house numbers
global dim house(number_of_houses)
global dim door(number_of_houses)
`make houses with numbers from 1 to max number of houses
for house_number=1 to number_of_houses
  make_house(house_number)
next house_number

`make dummy for camera to follow
make object cube 1,0.01
hide object 1
make object collision box 1,-0.05,-0.05,-0.05,0.05,0.05,0.05,0

global collision

`set initial player position
position object 1,matrixsize/2,get ground height(1,50,50)+2,matrixsize/2
ink 0,0


`****************************************

`main program loop
do

`function calls for continuous events
move_camera()
collision()
move_water()

`print screen fps
text 0,0,str$(screen fps())
text 0,20,"house number: "+str$(numberofhouseentered)
`refresh screen
sync
loop

`****************************************

`functions

function terraform

`set size of terrain
rows=60
columns=60

`create terrain
make matrix 1,matrixsize,matrixsize,columns,rows

`set mountain peaks
number_of_peaks=rnd(35)+10
max_height=15

dim peakx(number_of_peaks)
dim peakz(number_of_peaks)
dim height(number_of_peaks)
for peak=1 to number_of_peaks
  `set x,z coordinates for peak
  peakx(peak)=rnd(columns-10)+5
  peakz(peak)=rnd(rows-10)+5
  `set height of peak
  height(peak)=rnd(max_height)+10
  `create peak
  set matrix height 1,peakx(peak),peakz(peak),height(peak)
next peak

num=rows*columns
dim obnum(rows+1,columns+1)
dim v#(rows,columns)

`give each tile an x,z coordinate for use later
for x=1 to rows
for z=1 to columns
obnum(x,z)=ob
ob=ob+1
next z
next x

`texture matrix
prepare matrix texture 1,grassimage,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


`adjust height of points between peaks
elasticity#=0.3
damping#=0

for time=1 to 100

for peak=1 to number_of_peaks
  set matrix height 1,peakx(peak),peakz(peak),height(peak)
next peak

for x=1+1 to rows-1
for z=1+1 to columns-1
if x<rows
distxp1#=get matrix height(1,x+1,z)-get matrix height (1,x,z)
endif
if x>1
distxm1#=get matrix height(1,x-1,z)-get matrix height (1,x,z)
endif
if z<columns
distzp1#=get matrix height(1,x,z+1)-get matrix height (1,x,z)
endif
if z>1
distzm1#=get matrix height(1,x,z-1)-get matrix height (1,x,z)
endif
vectorsum#=distxp1#+distxm1#+distzp1#+distzm1#
a#=vectorsum#*elasticity#
v#(obnum(x,z))=v#(obnum(x,z))+a#
set matrix height 1,x,z,get matrix height(1,x,z)+v#(obnum(x,z))
v#(obnum(x,z))=v#(obnum(x,z))*damping#
next z
next x
update matrix 1
next time



endfunction




function check_free_object_number

`this handy function means that you never have to worry about
`remembering object numbers.  You just give them names you can remember,
`and this function will find the next available number to assosciate
`with that name.  Just call the function by, for example, writing:
`
`ball=check_free_object_number
`make object sphere ball,1

object=object_seed
repeat
inc object
until object exist(object)=0

endfunction object

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_grass

`make a shaded box
box 0,0,100,100,rgb(100,150,100),rgb(50,200,20),rgb(80,0,10),rgb(150,200,0)

`and speckle it with random dots
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      r=rnd(150)
      g=rnd(250)
      b=rnd(100)
      ink rgb(r,g,b),0
      dot x,y
    endif
  next x
next y


grassimage=check_free_image_number()
get image grassimage,0,0,100,100

endfunction

function create_skysphere

`get image for sphere by taking snapshot of terrain
image=check_free_image_number()
set camera fov 90
position camera matrixsize/2.0,3,-matrixsize*0.3
sync
get image image,0,0,screen width(),screen height()
set camera fov 60

`sphere 1 (mountains near) - just a sphere textured with the captured image
object=check_free_object_number()
make object sphere object,matrixsize*2
set object collision off object
set object cull object,0
texture object object,image
set object texture object,2,1
scale object texture object,3,1
set object fog object,0
set object light object,0
set object transparency object,4
position object object,matrixsize/2,0,matrixsize/2

`sphere 2 (mountains far) - and another one further out. The inner sphere must be
`transparent, though, to see this one.
object=check_free_object_number()
make object sphere object,matrixsize*2.5
set object collision off object
yrotate object object,30
set object cull object,0
texture object object,image
set object texture object,2,1
scale object texture object,3,1
set object fog object,0
`set object light object,0
set object transparency object,4
ghost object on object,4
set object emissive object,rgb(180,150,250)
fade object object,70
position object object,matrixsize/2,0,matrixsize/2

`sphere 3 (sky) - a third, outer sphere for the sky
object=check_free_object_number()
make object sphere object,matrixsize*4
set object collision off object
set object cull object,0
texture object object,skyimage
scale object texture object,1,1.8
set object light object,0
set object fog object,0

endfunction

function create_sky()
`creates a dark to light bluish gradient
cls
for n=0 to 250
  ink rgb(n,n,250),0
  line 0,n,250,n
next n

skyimage=check_free_image_number()
get image skyimage,0,0,250,250

endfunction


function create_water_image

`creates a shaded box
box 0,0,100,100,rgb(150,150,200),rgb(50,200,200),rgb(80,0,200),rgb(150,100,200)

`and speckles with white bits
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      r=(250)
      g=(250)
      b=(250)
      ink rgb(r,g,b),0
      dot x,y
    endif
  next x
next y


waterimage=check_free_image_number()
get image waterimage,0,0,100,100



endfunction


function create_water

`just a plane textured with the water image
water=check_free_object_number()
make object plain water,matrixsize*4,matrixsize*4
set object collision off water
texture object water,waterimage
set object texture water,2,1
scale object texture water,4,4
xrotate object water,90
set object fog water,0
set object emissive water,rgb(220,220,200)
ghost object on water
set alpha mapping on water,20
water2=check_free_object_number()
make object plain water2,matrixsize*4,matrixsize*4
set object collision off water2
texture object water2,waterimage
xrotate object water2,90
position object water2,0,1,0
set object texture water2,2,1
scale object texture water2,4,4
set object light water2,0
set object fog water2,0

endfunction

function move_water

`moves the texture along a bit
scroll object texture water,0.001,0
scroll object texture water2,-0.001,0
`and moves the water up and down according to a sine wave
position object water,0,0.5*sin(theta#)+3,0
inc theta#,1

endfunction

function move_camera

speed#=0
if upkey()=1 then speed#=0.1
if downkey()=1 then speed#=-0.1
if rightkey()=1 then yrotate object 1,object angle y(1)+2
if leftkey()=1 then yrotate object 1,object angle y(1)-2

`reposition dummy object
position object 1,object position x(1)+speed#*sin(object angle y(1)),object position y(1),object position z(1)+speed#*cos(object angle y(1))

`set camera to dummy object's position and orientation
position camera object position x(1),object position y(1),object position z(1)
yrotate camera object angle y(1)

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 collision on house(house)
set object cull house(house),0
texture object house(house),housetexture
scale object texture house(house),20,40
roof=check_free_object_number()
make object box roof,1.98,1,1
color object roof,rgb(80,80,80)
position object roof,0,1,0
xrotate object roof,45
glue object to limb roof,house(house),0
door(house)=check_free_object_number()
make object box door(house),0.2,0.8,0.02
texture object door(house),doortexture
position object door(house),0,0,-0.491
glue object to limb door(house),house(house),0

repeat
x=rnd(matrixsize)
z=rnd(matrixsize)
position object house(house),x,get ground height(1,x,z),z
until object position y (house(house))>3

yrotate object house(house),rnd(360)

endfunction

function make_house_texture

cls
ink rgb(200,200,180),0
box 0,0,5,15
ink rgb(100,60,40),0
box 0,0,4,14
housetexture=check_free_image_number()
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=check_free_image_number()
get image doortexture,0,0,8,8,1

endfunction

function make_wallpaper

cls
ink rgb(185,205,255),0
box 0,0,100,100
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      ink rgb(rnd(200),rnd(200),rnd(200)),0
      dot x,y
    endif
  next y
next x

wallpaper=check_free_image_number()
get image wallpaper,0,0,100,100

endfunction

function make_room

wall1=check_free_object_number()
make object box wall1,20,10,0.1
position object wall1,0,1004.8,-5
texture object wall1,wallpaper
scale object texture wall1,10,10

wall2=check_free_object_number()
make object box wall2,20,10,0.1
position object wall2,0,1004.8,5
texture object wall2,wallpaper
scale object texture wall2,10,10

wall3=check_free_object_number()
make object box wall3,10,10,0.1
yrotate object wall3,90
position object wall3,-10,1004.8,0
texture object wall3,wallpaper
scale object texture wall3,10,10

wall4=check_free_object_number()
make object box wall4,10,10,0.1
yrotate object wall4,90
position object wall4,10,1004.8,0
texture object wall4,wallpaper
scale object texture wall4,10,10

floor=check_free_object_number()
make object box floor,20,10,0.1
xrotate object floor,90
position object floor,0,999.8,0
color object floor,rgb(200,10,20)

ceiling=check_free_object_number()
make object box ceiling,20,10,0.1
xrotate object ceiling,90
position object ceiling,0,1006,0

make light 2
position light 2,9,1004,4
set light range 2,15
lamp=check_free_object_number()
make object plain lamp,0.5,0.5
position object lamp,8.4,1004,3.4
yrotate object lamp,45
texture object lamp,light_image()
set object transparency lamp,5
lampshade=check_free_object_number()
make object cone lampshade,1
position object lampshade,8.4,1004,3.4
ghost object on lampshade,3
lampwire=check_free_object_number()
make object plain lampwire,0.02,4
yrotate object lampwire,45
position object lampwire,8.41,1006,3.41

tabletop=check_free_object_number()
make object box tabletop,4,0.1,2
color object tabletop,rgb(200,100,60)
position object tabletop,7,1002,3
leg1=check_free_object_number()
make object box leg1,0.1,2,0.1
position object leg1,5.05,1001,2.05
leg2=check_free_object_number()
make object box leg2,0.1,2,0.1
position object leg2,8.95,1001,2.05
leg3=check_free_object_number()
make object box leg3,0.1,2,0.1
position object leg3,5.05,1001,3.95
leg4=check_free_object_number()
make object box leg4,0.1,2,0.1
position object leg4,8.95,1001,3.95
collisiondummy=check_free_object_number()
make object box collisiondummy,4,4,2
hide object collisiondummy
position object collisiondummy,7,1004,2

entity=check_free_object_number()
make object cube entity,0.5
color object entity,rgb(0,250,50)
position object entity,7,1002.3,3

internaldoor=check_free_object_number()
make object plain internaldoor,2,4
position object internaldoor,0,1001.8,-4.89
color object internaldoor,rgb(220,20,50)

endfunction

function enter_house(number)

inroom=1
hide light 1
position object 1,0,1003,-4
`position camera object position x(1),object position y(1),object position z(1)
point object 1,0,1003,5

endfunction

function exit_house()

position object 1,object position x(house(numberofhouseentered)),object position y(1),object position z(house(numberofhouseentered))
set object to object orientation 1,house(numberofhouseentered)
move object 1,-1
yrotate object 1,180
show light 1
inroom=0

endfunction

function light_image()


ink rgb(255,255,0),0
box 0,0,1,1
image=check_free_image_number()
get image image,0,0,1,1
cls
sphere1=check_free_object_number()
make object sphere sphere1,1,30,30
ghost object on sphere1
set object specular power sphere1,50
set object specular sphere1,rgb(200,200,200)
position light 1,0,-1,2
position object sphere1,0,0,3
texture object sphere1,image
a=int(screen width()/3.0)
b=int(screen height()/3.0)
c=int(screen width()*2/3.0)
d=int(screen height()*2/3.0)
sphere2=check_free_object_number()
make object sphere sphere2,0.3
position object sphere2,0,-0.2,3
ghost object on sphere2
sync
light=check_free_image_number()
get image light,a,b,c,d
delete object sphere1
delete object sphere2

endfunction light

function collision


collision=object collision(1,0)

`check collision with external doors
for number=1 to number_of_houses
  if collision=door(number)
    enter_house(number)
    numberofhouseentered=number
  endif
next number

`check collision with internal door
if collision=internaldoor then exit_house()

`apply sliding collision
if collision>1
position object 1,object position x(1)-get object collision x(),object position y(1),object position z(1)-get object collision z()
endif

`set dummy position to ground level
if inroom=0
  position object 1,object position x(1),get ground height(1,object position x(1),object position z(1))+0.2,object position z(1)
endif

`if in water, set dummy to water level
if object position y(1)<object position y(water)+0.2 then position object 1,object position x(1),object position y(water)+0.2,object position z(1)


endfunction

sync on
sync rate 0
autocam off
set display mode 1280, 1024, 32
set ambient light 0
randomize timer()
color backdrop 0


#constant TEXTURE_SIZE 64

make memblock 1, 12 + (TEXTURE_SIZE * TEXTURE_SIZE * 4)
write memblock dword 1, 0, TEXTURE_SIZE
write memblock dword 1, 4, TEXTURE_SIZE
write memblock dword 1, 8, 32
c as dword
for x = 0 to TEXTURE_SIZE - 1
   for y = 0 to TEXTURE_SIZE - 1
      c = rgb(32, 128 + rnd(127), 32)
      write memblock dword 1, 12 + ((y*TEXTURE_SIZE)+x)*4, c
   next y
next x
make image from memblock 1, 1
delete memblock 1






`Control Keys
#constant KeyW 17
#constant KeyA 30
#constant KeyS 31
#constant KeyD 32


`This is here so I can see the arguements easier :-)
`function GENERATE_TERRAIN(obj, img, W, H, MAX_HEIGHT#, SMOOTHING_ITTERATIONS, SMOOTHING_FACTOR#, MAPSCALE#, USCALE#, VSCALE#)

`Create the terrain
GENERATE_TERRAIN(1, 1, 64, 64, 50.0, 4, 0.75, 4.0, 2.0, 2.0)
position object 1, 0, 0, 0




`Create the player + Data
Type Coord
   x#
   y#
   z#
EndType
Type PlayerData
   Pos as Coord
   moved as boolean
   Target as Coord
EndType
#constant PLAYER_SPEED 3.0

P as PlayerData
P.Pos.x# = 10
P.Pos.z# = 10
P.Target.x# = P.Pos.x# + 0.0001
P.Target.z# = P.Pos.z#

P.Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, P.Pos.x#, P.Pos.z#) + object size y(1) * 0.5
P.moved = 1
make object sphere 2, 1
make object cone 3, 1
scale object 3, 50.0, 100.0, 50.0
make mesh from object 10, 3
delete object 3
add limb 2, 1, 10
rotate limb 2, 1, 90, 0, 0
offset limb 2, 1, 0.0, 0.0, 0.5

position object 2, P.Pos.x#, P.Pos.y#, P.Pos.z#
null = make vector2(1)  :`Create a temporary vector for working out headings


make object box 4, 0.1, 5.0, 0.1
set object collision to boxes 4
offset limb 4, 0, 0.0, 2.5, 0.0


glue object to limb 4, 2, 1
hide object 4



`Target Object stuff
make object sphere 3, 0.5  :`Target Object for when moving
set object transparency 3, 3
#constant TARGET_COLOR 0xFF0000
color object 3, TARGET_COLOR
a as DWORD
CLICK_DIST# = 0.0

`Lighting
set point light 0, 0, 0, 0
set light range 0, 40


`Enemy Data Stuff
#constant CREATION_TIMER 5000
EnemyTimer = 0

Type EnemyData
   Pos as Coord
   TimeToLive#
   Health#
EndType

Dim Enemies(5) as EnemyData

`Create Enemy Stats Panel
#constant STATS_IMG_W 16
#constant STATS_IMG_H 48
#constant STATS_IMG_TRANSPARENCY_MASK_A 0x66FFFFFF
#constant STATS_IMG_TRANSPARENCY_MASK_B 0x33FFFFFF

make memblock 1, 12 + (STATS_IMG_W * STATS_IMG_H * 4)
write memblock dword 1, 0, STATS_IMG_W
write memblock dword 1, 4, STATS_IMG_H
write memblock dword 1, 8, 32
for x = 0 to STATS_IMG_W - 1
   for y = 0 to STATS_IMG_H - 1
      if x > 3 AND x < 12 AND y > 3 AND y < 44
         write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, rgb(160, 160, 160) && STATS_IMG_TRANSPARENCY_MASK_B
      else
         write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, rgb(160, 160, 160) && STATS_IMG_TRANSPARENCY_MASK_A
      endif
   next y
next x
`TopLeft
x = 0 : y = 0 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = 1 : y = 0 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = 0 : y = 1 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0

`TopRight
x = STATS_IMG_W-1 : y = 0 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = STATS_IMG_W-2 : y = 0 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = STATS_IMG_W-1 : y = 1 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0

`BottomRight
x = STATS_IMG_W-1 : y = STATS_IMG_H-1 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = STATS_IMG_W-2 : y = STATS_IMG_H-1 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = STATS_IMG_W-1 : y = STATS_IMG_H-2 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0

`BottomLeft
x = 0 : y = STATS_IMG_H-1 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = 1 : y = STATS_IMG_H-1 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = 0 : y = STATS_IMG_H-2 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0


make image from memblock 100, 1
delete memblock 1


`Mouse Status
mouseStatus = 0

frameTime# = 1.0
startTime = timer()
do
   frameTime# = (frameTime# * 0.8) + ((timer() - startTime) * 0.2)
   startTime = timer()
   text 0,0, "FPS: " + str$(screen fps())

   if mouseclick() = 1 AND mouseStatus = 0
      P.moved = 1
      mouseStatus = mouseclick()
      null = pick object(mousex(), mousey(), 1, 1)
      P.Target.x# = camera position x() + get pick vector x()
      P.Target.z# = camera position z() + get pick vector z()
      position object 3, P.Target.x#, GET_CUSTOM_TERRAIN_HEIGHT(1,P.Target.x#,P.Target.z#) + 0.25, P.Target.z#
      point object 2, object position x(3), object position y(3), object position z(3)

      set vector2 1, P.Target.x# - P.Pos.x#, P.Target.z# - P.Pos.z#
      CLICK_DIST# = length vector2(1)*1.5
      a = 255
   else
      if mouseclick() = 0 then mouseStatus = 0
   endif

   if P.moved
      set vector2 1, P.Target.x# - P.Pos.x#, P.Target.z# - P.Pos.z#
      dist# = length vector2(1)

      if dist# < 0.1 then P.moved = 0

      a = (dist# / CLICK_DIST#) * 255.0
      color object 3, (a << 24) || TARGET_COLOR

      normalize vector2 1, 1

      inc P.Pos.x#, x vector2(1) * frameTime# * 0.001 * PLAYER_SPEED
      inc P.Pos.z#, y vector2(1) * frameTime# * 0.001 * PLAYER_SPEED
      P.Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, P.Pos.x#, P.Pos.z#) + 0.5

      position object 2, P.Pos.x#, P.Pos.y#, P.Pos.z#

      position light 0, P.Pos.x#, P.Pos.y# + 10, P.Pos.z#

      position camera P.Pos.x# + 10, P.Pos.y# + 10, P.Pos.z# + 10
      point camera P.Pos.x#, P.Pos.y#, P.Pos.z#
   endif


   if spacekey() then show object 4 else hide object 4


   text 10, 30, "T: " + str$(timer() - EnemyTimer)
   if timer() - EnemyTimer > CREATION_TIMER then gosub CREATE_ENEMY
   gosub PROCESS_ENEMIES

   sync
loop
end



PROCESS_ENEMIES:
   obj = 1000
   for obj = 1000 to 1005
      if object exist(obj)
         enemyId = obj-1000
         point object obj, P.Pos.x#, P.Pos.y#, P.Pos.z#
         if Enemies(enemyId).TimeToLive# < 0.5
            inc Enemies(enemyId).TimeToLive#, frameTime# * 0.001
         else
            move object obj, frameTime# * 0.0005
         endif
         position object obj, object position x(obj), GET_CUSTOM_TERRAIN_HEIGHT(1, object position x(obj), object position z(obj)) + Enemies(enemyId).TimeToLive#, object position z(obj)


         if object visible(4) AND object collision(4, obj) then dec Enemies(enemyId).Health#, frameTime# * 0.01
         if Enemies(enemyId).Health# <= 0
            delete object obj
         else
            make memblock from image 1, 100
            for x = 3 to 12
               for y = 44-int(Enemies(enemyId).Health#) to 44
                  write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, rgb(255, 0, 0) && STATS_IMG_TRANSPARENCY_MASK_A
               next y
            next x
            make image from memblock 101+enemyId, 1
            delete memblock 1

            paste image 101+enemyId, object screen x(obj), object screen y(obj) - STATS_IMG_H, 1
         endif

         text 100, enemyId*10, "H: " + str$(Enemies(enemyId).Health#)

      endif
   next obj
return





CREATE_ENEMY:
   EnemyTimer = timer()
   obj = 1000
   while object exist(obj) AND obj < 1005 : inc obj : endwhile

   if object exist(obj) = 0
      make object sphere obj, 1.0
      add limb obj, 1, 10
      rotate limb obj, 1, 90, 0, 0
      offset limb obj, 1, 0.0, 0.0, 0.5
      color object obj, rgb(255,255,0) && STATS_IMG_TRANSPARENCY_MASK_A
      `set object transparency obj, 5


      enemyID = obj - 1000
      Enemies(enemyID).Pos.x# = rnd(5.0)
      if rnd(1) then Enemies(enemyID).Pos.x# = -Enemies(enemyID).Pos.x# - 5.0 else inc Enemies(enemyID).Pos.x#, 5.0

      Enemies(enemyID).Pos.z# = rnd(5.0)
      if rnd(1) then Enemies(enemyID).Pos.z# = -Enemies(enemyID).Pos.z# - 5.0 else inc Enemies(enemyID).Pos.z#, 5.0

      inc Enemies(enemyID).Pos.x#, P.Pos.x#
      inc Enemies(enemyID).Pos.z#, P.Pos.z#

      Enemies(enemyId).Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, Enemies(enemyID).Pos.x#, Enemies(enemyID).Pos.z#) - 0.5

      position object obj, Enemies(enemyID).Pos.x#, Enemies(enemyID).Pos.y#, Enemies(enemyID).Pos.z#
      point object obj, P.Pos.x#, P.Pos.y#, P.Pos.z#
      Enemies(enemyId).TimeToLive# = -1.0
      Enemies(enemyId).Health# = 41.0
   endif
return








function GET_CUSTOM_TERRAIN_HEIGHT(obj, x#, z#)
   height# = 1000.0 - intersect object(obj, x#, 1000, z#,  x#, -1000, z#)
endfunction height#




function GENERATE_TERRAIN(obj, img, W, H, MAX_HEIGHT#, SMOOTHING_ITTERATIONS, SMOOTHING_FACTOR#, MAPSCALE#, USCALE#, VSCALE#)
   dim HEIGHTMAP#(W,H)
   dim NORMALS#(W,H,3)

   for i = 0 to W-1
      for j = 0 to H-1
         HEIGHTMAP#(i, j) = rnd(MAX_HEIGHT#)
      next j
   next i


   for iters = 0 to SMOOTHING_ITTERATIONS
      for i = 0   to W-1       : for j = 0 to H           : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i+1,j) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
      for i = W-1 to 0  step -1: for j = 0 to H           : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i+1,j) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
      for i = 0 to W           : for j = 0 to H-1         : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i,j+1) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
      for i = 0 to W           : for j = H-1 to 0 step -1 : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i,j+1) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
   next iters

remstart
   make memblock 1, 12 + (W*H*4)
   write memblock dword 1, 0, W
   write memblock dword 1, 4, H
   write memblock dword 1, 8, 32
   for i = 0 to W-1
      for j = 0 to H-1
         write memblock dword 1, 12 + ((j*W)+i)*4, rgb(HEIGHTMAP#(i,j)*4, HEIGHTMAP#(i,j)*4, HEIGHTMAP#(i,j)*4)
      next j
   next i
   make image from memblock 10, 1
remend



   ` CALCULATE NORMALS

   for i = 1 to W-1
      for j = 1 to H-1
         null = make vector3(1)
         null = make vector3(2)
         null = make vector3(3)
         null = make vector3(4)
         null = make vector3(5)
         null = make vector3(6)
         null = make vector3(7)
         null = make vector3(8)
         null = make vector3(9)

         set vector3 1,  MAPSCALE#, HEIGHTMAP#(i,j) - HEIGHTMAP#(i+1,j  ),  0
         set vector3 2,          0, HEIGHTMAP#(i,j) - HEIGHTMAP#(i  ,j-1), -MAPSCALE#
         set vector3 3, -MAPSCALE#, HEIGHTMAP#(i,j) - HEIGHTMAP#(i-1,j  ),  0
         set vector3 4,          0, HEIGHTMAP#(i,j) - HEIGHTMAP#(i  ,j+1),  MAPSCALE#


         cross product vector3 5, 1, 2
         cross product vector3 6, 2, 3
         cross product vector3 7, 3, 4
         cross product vector3 8, 4, 1

         add vector3 9, 9, 5
         add vector3 9, 9, 6
         add vector3 9, 9, 7
         add vector3 9, 9, 8
         divide vector3 9, 4
         normalize vector3 9, 9
         NORMALS#(i,j,0) = x vector3(9)
         NORMALS#(i,j,1) = y vector3(9)
         NORMALS#(i,j,2) = z vector3(9)
         null = delete vector3(1)
         null = delete vector3(2)
         null = delete vector3(3)
         null = delete vector3(4)
         null = delete vector3(5)
         null = delete vector3(6)
         null = delete vector3(7)
         null = delete vector3(8)
         null = delete vector3(9)
      next j
   next i


   if memblock exist(1) then delete memblock 1
   make memblock 1, 12 + (32 * 3 * 2 * W * H)

   write memblock dword 1,0,274 : `FVF FORMAT
   write memblock dword 1,4,32  : `SIZE PER VERT
   write memblock dword 1,8,W*H*2*3   : `VERT NO


   poly = 0
   for i = 0 to W-1
      for j = 0 to H-1
         ` ** POLY 1 **
         x = i   : z = j   : CREATE_MESH_ENTRY(1, 12 + (poly * 192)      , (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), 0.0    , 0.0    )
         x = i   : z = j+1 : CREATE_MESH_ENTRY(1, 12 + (poly * 192) +  32, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), 0.0    , VSCALE#)
         x = i+1 : z = j   : CREATE_MESH_ENTRY(1, 12 + (poly * 192) +  64, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), USCALE#, 0.0    )
         ` ** POLY 2 **
         x = i+1 : z = j   : CREATE_MESH_ENTRY(1, 12 + (poly * 192) +  96, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), USCALE#, 0.0    )
         x = i   : z = j+1 : CREATE_MESH_ENTRY(1, 12 + (poly * 192) + 128, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), 0.0    , VSCALE#)
         x = i+1 : z = j+1 : CREATE_MESH_ENTRY(1, 12 + (poly * 192) + 160, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), USCALE#, VSCALE#)
         inc poly
      next j
   next i


   make mesh from memblock 1, 1
   if object exist(obj) = 1 then delete object obj
   make object obj, 1, img
   delete mesh 1
   delete memblock 1
endfunction




function CREATE_MESH_ENTRY(memblockNum, n, x#, y#, z#, nx#, ny#, nz#, u#, v#)
   write memblock float 1, n +  0, x#
   write memblock float 1, n +  4, y#
   write memblock float 1, n +  8, z#
   write memblock float 1, n + 12, nx#
   write memblock float 1, n + 16, ny#
   write memblock float 1, n + 20, nz#
   write memblock float 1, n + 24, u#
   write memblock float 1, n + 28, v#
endfunction

sync on
sync rate 0
autocam off
set display mode 1280, 1024, 32
set ambient light 0
randomize timer()
color backdrop 0


#constant TEXTURE_SIZE 64

make memblock 1, 12 + (TEXTURE_SIZE * TEXTURE_SIZE * 4)
write memblock dword 1, 0, TEXTURE_SIZE
write memblock dword 1, 4, TEXTURE_SIZE
write memblock dword 1, 8, 32
c as dword
for x = 0 to TEXTURE_SIZE - 1
   for y = 0 to TEXTURE_SIZE - 1
      c = rgb(32, 128 + rnd(127), 32)
      write memblock dword 1, 12 + ((y*TEXTURE_SIZE)+x)*4, c
   next y
next x
make image from memblock 1, 1
delete memblock 1






`Control Keys
#constant KeyW 17
#constant KeyA 30
#constant KeyS 31
#constant KeyD 32


`This is here so I can see the arguements easier :-)
`function GENERATE_TERRAIN(obj, img, W, H, MAX_HEIGHT#, SMOOTHING_ITTERATIONS, SMOOTHING_FACTOR#, MAPSCALE#, USCALE#, VSCALE#)

`Create the terrain
GENERATE_TERRAIN(1, 1, 64, 64, 50.0, 4, 0.75, 4.0, 2.0, 2.0)
position object 1, 0, 0, 0




`Create the player + Data
Type Coord
   x#
   y#
   z#
EndType
Type PlayerData
   Pos as Coord
   moved as boolean
   Target as Coord
EndType
#constant PLAYER_SPEED 3.0

P as PlayerData
P.Pos.x# = 10
P.Pos.z# = 10
P.Target.x# = P.Pos.x# + 0.0001
P.Target.z# = P.Pos.z#

P.Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, P.Pos.x#, P.Pos.z#) + object size y(1) * 0.5
P.moved = 1
make object sphere 2, 1
make object cone 3, 1
scale object 3, 50.0, 100.0, 50.0
make mesh from object 10, 3
delete object 3
add limb 2, 1, 10
rotate limb 2, 1, 90, 0, 0
offset limb 2, 1, 0.0, 0.0, 0.5

position object 2, P.Pos.x#, P.Pos.y#, P.Pos.z#
null = make vector2(1)  :`Create a temporary vector for working out headings


make object box 4, 0.1, 5.0, 0.1
set object collision to boxes 4
offset limb 4, 0, 0.0, 2.5, 0.0


glue object to limb 4, 2, 1
hide object 4



`Target Object stuff
make object sphere 3, 0.5  :`Target Object for when moving
set object transparency 3, 3
#constant TARGET_COLOR 0xFF0000
color object 3, TARGET_COLOR
a as DWORD
CLICK_DIST# = 0.0

`Lighting
set point light 0, 0, 0, 0
set light range 0, 40


`Enemy Data Stuff
#constant CREATION_TIMER 5000
EnemyTimer = 0

Type EnemyData
   Pos as Coord
   TimeToLive#
   Health#
EndType

Dim Enemies(5) as EnemyData

`Create Enemy Stats Panel
#constant STATS_IMG_W 16
#constant STATS_IMG_H 48
#constant STATS_IMG_TRANSPARENCY_MASK_A 0x66FFFFFF
#constant STATS_IMG_TRANSPARENCY_MASK_B 0x33FFFFFF

make memblock 1, 12 + (STATS_IMG_W * STATS_IMG_H * 4)
write memblock dword 1, 0, STATS_IMG_W
write memblock dword 1, 4, STATS_IMG_H
write memblock dword 1, 8, 32
for x = 0 to STATS_IMG_W - 1
   for y = 0 to STATS_IMG_H - 1
      if x > 3 AND x < 12 AND y > 3 AND y < 44
         write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, rgb(160, 160, 160) && STATS_IMG_TRANSPARENCY_MASK_B
      else
         write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, rgb(160, 160, 160) && STATS_IMG_TRANSPARENCY_MASK_A
      endif
   next y
next x
`TopLeft
x = 0 : y = 0 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = 1 : y = 0 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = 0 : y = 1 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0

`TopRight
x = STATS_IMG_W-1 : y = 0 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = STATS_IMG_W-2 : y = 0 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = STATS_IMG_W-1 : y = 1 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0

`BottomRight
x = STATS_IMG_W-1 : y = STATS_IMG_H-1 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = STATS_IMG_W-2 : y = STATS_IMG_H-1 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = STATS_IMG_W-1 : y = STATS_IMG_H-2 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0

`BottomLeft
x = 0 : y = STATS_IMG_H-1 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = 1 : y = STATS_IMG_H-1 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0
x = 0 : y = STATS_IMG_H-2 : write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, 0


make image from memblock 100, 1
delete memblock 1


`Mouse Status
mouseStatus = 0

frameTime# = 1.0
startTime = timer()
do
   frameTime# = (frameTime# * 0.8) + ((timer() - startTime) * 0.2)
   startTime = timer()
   text 0,0, "FPS: " + str$(screen fps())

   if mouseclick() = 1 AND mouseStatus = 0
      P.moved = 1
      mouseStatus = mouseclick()
      null = pick object(mousex(), mousey(), 1, 1)
      P.Target.x# = camera position x() + get pick vector x()
      P.Target.z# = camera position z() + get pick vector z()
      position object 3, P.Target.x#, GET_CUSTOM_TERRAIN_HEIGHT(1,P.Target.x#,P.Target.z#) + 0.25, P.Target.z#
      point object 2, object position x(3), object position y(3), object position z(3)

      set vector2 1, P.Target.x# - P.Pos.x#, P.Target.z# - P.Pos.z#
      CLICK_DIST# = length vector2(1)*1.5
      a = 255
   else
      if mouseclick() = 0 then mouseStatus = 0
   endif

   if P.moved
      set vector2 1, P.Target.x# - P.Pos.x#, P.Target.z# - P.Pos.z#
      dist# = length vector2(1)

      if dist# < 0.1 then P.moved = 0

      a = (dist# / CLICK_DIST#) * 255.0
      color object 3, (a << 24) || TARGET_COLOR

      normalize vector2 1, 1

      inc P.Pos.x#, x vector2(1) * frameTime# * 0.001 * PLAYER_SPEED
      inc P.Pos.z#, y vector2(1) * frameTime# * 0.001 * PLAYER_SPEED
      P.Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, P.Pos.x#, P.Pos.z#) + 0.5

      position object 2, P.Pos.x#, P.Pos.y#, P.Pos.z#

      position light 0, P.Pos.x#, P.Pos.y# + 10, P.Pos.z#

      position camera P.Pos.x# + 10, P.Pos.y# + 10, P.Pos.z# + 10
      point camera P.Pos.x#, P.Pos.y#, P.Pos.z#
   endif


   if spacekey() then show object 4 else hide object 4


   text 10, 30, "T: " + str$(timer() - EnemyTimer)
   Set Cursor 0,50
   Print Object Position X(2)
   Print Object Position Y(2)
   Print Object Position Z(2)
   Print Object Position X(4)
   Print Object Position Y(4)
   Print Object Position Z(4)
   Set Cursor Object Screen X(4)-5,Object Screen Y(4)-12
   Print "(4)"
   if timer() - EnemyTimer > CREATION_TIMER then gosub CREATE_ENEMY
   gosub PROCESS_ENEMIES

   sync
loop
end



PROCESS_ENEMIES:
   obj = 1000
   for obj = 1000 to 1005
      if object exist(obj)
         enemyId = obj-1000
         point object obj, P.Pos.x#, P.Pos.y#, P.Pos.z#
         if Enemies(enemyId).TimeToLive# < 0.5
            inc Enemies(enemyId).TimeToLive#, frameTime# * 0.001
         else
            move object obj, frameTime# * 0.0005
         endif
         position object obj, object position x(obj), GET_CUSTOM_TERRAIN_HEIGHT(1, object position x(obj), object position z(obj)) + Enemies(enemyId).TimeToLive#, object position z(obj)


         if object visible(4) AND object collision(4, obj) then dec Enemies(enemyId).Health#, frameTime# * 0.01
         if Enemies(enemyId).Health# <= 0
            delete object obj
         else
            make memblock from image 1, 100
            for x = 3 to 12
               for y = 44-int(Enemies(enemyId).Health#) to 44
                  write memblock dword 1, 12 + ((y*STATS_IMG_W) + x)*4, rgb(255, 0, 0) && STATS_IMG_TRANSPARENCY_MASK_A
               next y
            next x
            make image from memblock 101+enemyId, 1
            delete memblock 1

            paste image 101+enemyId, object screen x(obj), object screen y(obj) - STATS_IMG_H, 1
         endif

         text 100, enemyId*10, "H: " + str$(Enemies(enemyId).Health#)

      endif
   next obj
return





CREATE_ENEMY:
   EnemyTimer = timer()
   obj = 1000
   while object exist(obj) AND obj < 1005 : inc obj : endwhile

   if object exist(obj) = 0
      make object sphere obj, 1.0
      add limb obj, 1, 10
      rotate limb obj, 1, 90, 0, 0
      offset limb obj, 1, 0.0, 0.0, 0.5
      color object obj, rgb(255,255,0) && STATS_IMG_TRANSPARENCY_MASK_A
      `set object transparency obj, 5


      enemyID = obj - 1000
      Enemies(enemyID).Pos.x# = rnd(5.0)
      if rnd(1) then Enemies(enemyID).Pos.x# = -Enemies(enemyID).Pos.x# - 5.0 else inc Enemies(enemyID).Pos.x#, 5.0

      Enemies(enemyID).Pos.z# = rnd(5.0)
      if rnd(1) then Enemies(enemyID).Pos.z# = -Enemies(enemyID).Pos.z# - 5.0 else inc Enemies(enemyID).Pos.z#, 5.0

      inc Enemies(enemyID).Pos.x#, P.Pos.x#
      inc Enemies(enemyID).Pos.z#, P.Pos.z#

      Enemies(enemyId).Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, Enemies(enemyID).Pos.x#, Enemies(enemyID).Pos.z#) - 0.5

      position object obj, Enemies(enemyID).Pos.x#, Enemies(enemyID).Pos.y#, Enemies(enemyID).Pos.z#
      point object obj, P.Pos.x#, P.Pos.y#, P.Pos.z#
      Enemies(enemyId).TimeToLive# = -1.0
      Enemies(enemyId).Health# = 41.0
   endif
return








function GET_CUSTOM_TERRAIN_HEIGHT(obj, x#, z#)
   height# = 1000.0 - intersect object(obj, x#, 1000, z#,  x#, -1000, z#)
endfunction height#




function GENERATE_TERRAIN(obj, img, W, H, MAX_HEIGHT#, SMOOTHING_ITTERATIONS, SMOOTHING_FACTOR#, MAPSCALE#, USCALE#, VSCALE#)
   dim HEIGHTMAP#(W,H)
   dim NORMALS#(W,H,3)

   for i = 0 to W-1
      for j = 0 to H-1
         HEIGHTMAP#(i, j) = rnd(MAX_HEIGHT#)
      next j
   next i


   for iters = 0 to SMOOTHING_ITTERATIONS
      for i = 0   to W-1       : for j = 0 to H           : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i+1,j) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
      for i = W-1 to 0  step -1: for j = 0 to H           : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i+1,j) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
      for i = 0 to W           : for j = 0 to H-1         : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i,j+1) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
      for i = 0 to W           : for j = H-1 to 0 step -1 : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i,j+1) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
   next iters

remstart
   make memblock 1, 12 + (W*H*4)
   write memblock dword 1, 0, W
   write memblock dword 1, 4, H
   write memblock dword 1, 8, 32
   for i = 0 to W-1
      for j = 0 to H-1
         write memblock dword 1, 12 + ((j*W)+i)*4, rgb(HEIGHTMAP#(i,j)*4, HEIGHTMAP#(i,j)*4, HEIGHTMAP#(i,j)*4)
      next j
   next i
   make image from memblock 10, 1
remend



   ` CALCULATE NORMALS

   for i = 1 to W-1
      for j = 1 to H-1
         null = make vector3(1)
         null = make vector3(2)
         null = make vector3(3)
         null = make vector3(4)
         null = make vector3(5)
         null = make vector3(6)
         null = make vector3(7)
         null = make vector3(8)
         null = make vector3(9)

         set vector3 1,  MAPSCALE#, HEIGHTMAP#(i,j) - HEIGHTMAP#(i+1,j  ),  0
         set vector3 2,          0, HEIGHTMAP#(i,j) - HEIGHTMAP#(i  ,j-1), -MAPSCALE#
         set vector3 3, -MAPSCALE#, HEIGHTMAP#(i,j) - HEIGHTMAP#(i-1,j  ),  0
         set vector3 4,          0, HEIGHTMAP#(i,j) - HEIGHTMAP#(i  ,j+1),  MAPSCALE#


         cross product vector3 5, 1, 2
         cross product vector3 6, 2, 3
         cross product vector3 7, 3, 4
         cross product vector3 8, 4, 1

         add vector3 9, 9, 5
         add vector3 9, 9, 6
         add vector3 9, 9, 7
         add vector3 9, 9, 8
         divide vector3 9, 4
         normalize vector3 9, 9
         NORMALS#(i,j,0) = x vector3(9)
         NORMALS#(i,j,1) = y vector3(9)
         NORMALS#(i,j,2) = z vector3(9)
         null = delete vector3(1)
         null = delete vector3(2)
         null = delete vector3(3)
         null = delete vector3(4)
         null = delete vector3(5)
         null = delete vector3(6)
         null = delete vector3(7)
         null = delete vector3(8)
         null = delete vector3(9)
      next j
   next i


   if memblock exist(1) then delete memblock 1
   make memblock 1, 12 + (32 * 3 * 2 * W * H)

   write memblock dword 1,0,274 : `FVF FORMAT
   write memblock dword 1,4,32  : `SIZE PER VERT
   write memblock dword 1,8,W*H*2*3   : `VERT NO


   poly = 0
   for i = 0 to W-1
      for j = 0 to H-1
         ` ** POLY 1 **
         x = i   : z = j   : CREATE_MESH_ENTRY(1, 12 + (poly * 192)      , (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), 0.0    , 0.0    )
         x = i   : z = j+1 : CREATE_MESH_ENTRY(1, 12 + (poly * 192) +  32, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), 0.0    , VSCALE#)
         x = i+1 : z = j   : CREATE_MESH_ENTRY(1, 12 + (poly * 192) +  64, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), USCALE#, 0.0    )
         ` ** POLY 2 **
         x = i+1 : z = j   : CREATE_MESH_ENTRY(1, 12 + (poly * 192) +  96, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), USCALE#, 0.0    )
         x = i   : z = j+1 : CREATE_MESH_ENTRY(1, 12 + (poly * 192) + 128, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), 0.0    , VSCALE#)
         x = i+1 : z = j+1 : CREATE_MESH_ENTRY(1, 12 + (poly * 192) + 160, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), USCALE#, VSCALE#)
         inc poly
      next j
   next i


   make mesh from memblock 1, 1
   if object exist(obj) = 1 then delete object obj
   make object obj, 1, img
   delete mesh 1
   delete memblock 1
endfunction




function CREATE_MESH_ENTRY(memblockNum, n, x#, y#, z#, nx#, ny#, nz#, u#, v#)
   write memblock float 1, n +  0, x#
   write memblock float 1, n +  4, y#
   write memblock float 1, n +  8, z#
   write memblock float 1, n + 12, nx#
   write memblock float 1, n + 16, ny#
   write memblock float 1, n + 20, nz#
   write memblock float 1, n + 24, u#
   write memblock float 1, n + 28, v#
endfunction

REM Modified version of RiiDii's character creation code, as found on the
REM DarkBasicPro Challenge thread, and then some to create bare bones of a
REM basic 3d RPG


Type Character
   Rage as Float
   Grace as Float
   Brains as Float
   MaxHP as Float
   HP as Float
   Money as Float
   Level as Float
   XP as Float
   Name as String
   Object as Integer
EndType
`Declare our player as a global variable.
Global Player as Character

Type Baddie
   Rage as Float
   Grace as Float
   Brains as Float
   HP as Float
   XPDrop as Integer
   MoneyDrop as Integer
   Name as String
   Object as Integer
Endtype

Dim Enemies(10) as Baddie

global Fighting as Integer

sync on: sync rate 60
randomize timer()

FirstTimeThrough = 0
Player.Object = 1
Fighting = 0
global Loopy as integer
global Attack as integer
Loopy = 500
Global AttackName$ as String

Do

   if FirstTimeThrough = 0
      NameCharacter()   `asks player for a name, keeps it.
      StatCharacter()   `creates random stats and either rerolls or keeps.
      MakeCube()        `makes our player object, colours it etc.
      MakeWorld()       `creates the floor plain, lights etc.
      MakeLevel()       `generates the buildings/walls of our environment
     ` BuildCity()
      GenerateBaddie()  `Might work.
      FirstTimeThrough = 1
      sync on
   endif

   if Fighting =0
      CubeMovement()       `controls the movement of our cube character.  WASD keys.
   Endif
   ThirdPerson()        `positions the camera in a 3rd-person style position.
   DrawStats()

   if Object Collision(1,0)>49
      if Object Collision(1,0)<100
         DrawBaddieStats()
         DoFight()
     endif
   endif

   if Player.XP>100*Player.Level
      Level()
   endif


   Sync
Loop



`Ask for a name for the character.  This happens only once.
Function NameCharacter()
   sync off
   `Now, create our character.
   CLS
   Set Cursor 0,0
   Input "Enter your cube's name:",Player.Name
   Print
   Print "Welcome ";Player.Name;" the Cube."
   Wait 1000
Endfunction


`Create initial stats for the character.  Currently random.  *Something to work on later.
Function StatCharacter()
   do
      Cls
      Set Cursor 0,0
      Print Player.Name;", press [R] to re-roll stats, or [Y] to accept stats."
      Print

      `100 stat points initially.  Previous method sometimes resulted in Brains=-1 (ironic, really)
      `So we've set a 'points left' and made sure each stat is always at least 1.

      Player.Rage=1
      Player.Grace=1
      Player.Brains=1
      AmountLeft=97

      Player.Rage=Player.Rage+rnd(AmountLeft)
      AmountLeft=AmountLeft-Player.Rage+1
      Player.Grace=Player.Grace+rnd(AmountLeft)
      AmountLeft=AmountLeft-Player.Grace+1
      Player.Brains=Player.Brains+AmountLeft

      Player.HP=Player.Rage+Player.Grace+Player.Brains
      Player.MaxHP=Player.HP
      Player.Money=(Player.Brains+Player.Grace)*2
      Player.Level=1
      `Still not got a good name or system for assigning the main unit of 'barter'.  Depends.

      `Print out the stats - note, Rage, Grace, and Brains correspond to Red, Green and Blue
      `respectively.  This will help people figure out the relative skills of an enemy, etc.
      Ink RGB(255,0,0),0
      Print "(R)age: ";Player.Rage
      Ink RGB(0,255,0),0
      Print "(G)race: ";Player.Grace
      Ink RGB(0,0,255),0
      Print "(B)rains: ";Player.Brains
      Ink RGB(255,255,255),0
      Print "Health: ";Player.HP;"/";Player.MaxHP
      Print "Monetary Units: ";Player.Money

      Ink RGB(INT(Player.Rage),INT(Player.Grace),INT(Player.Brains)),0
      Box 180,30,260,110
      Ink RGB(255,255,255),0
      `Let the player choose to keep the stats or re-roll.

      Do
         a$=Lower$(Inkey$())
         If a$="r" or a$="y"
            wait 300
            Exit
         endif
      Loop

      if a$="y" Then Exit
   loop
Endfunction


`Make our cubic avatar
Function MakeCube()

   make object cube Player.Object,Player.HP/10
   color object Player.Object, rgb(INT(Player.Rage),INT(Player.Grace),INT(Player.Brains))
   color backdrop 0
   make object collision box Player.Object,-7,-7,-7,7,7,7,0

EndFunction


`This creates our world (currently a plain object - bah)
Function MakeWorld()

   autocam off
   make object plain 4,800,800
   position object 4,0,0,0
   rotate object 4,-90,0,0
   color object 4,rgb(50,50,50)
   set object collision off 4

   color ambient light rgb(20,20,20)
   autocam on

EndFunction


`Move around using the WASD keys
Function CubeMovement()

   `Originally ripped from the monster hunt tutorial, changed most of it to allow vectors and rolling as well as WASD.
   CubeAngle#= Object Angle Y(Player.Object)
   PosX#=Object Position X(Player.Object)
   PosY#=Object Position Y(Player.Object)
   PosZ#=Object Position Z(Player.Object)

   `Keys for controlling the object.  WASD standard.
   If Keystate(17)=1  : `"W" key for forward.
      CubeSpeed# = 1.5

      CubeMoveX# = -sin(-Object Angle Y(Player.Object)) * CubeSpeed#
      CubeMoveZ# = cos(-Object Angle Y(Player.Object)) * CubeSpeed#

      `Update the positions in the X and Z using the vector.
      PosX#=PosX#+CubeMoveX#
      PosZ#=PosZ#+CubeMoveZ#

      `Put a bit of a 'rolling' tumble on it, so we know the cube's moving.
      CurrentXRot#=Object Angle X(Player.Object)
      Xrotate Object Player.Object,CurrentXRot#+5
   Endif

   If Keystate(31)=1  : `"S" key for reverse.
      CubeRevSpeed# = 1.0

      CubeRevMoveX# = -sin(-Object Angle Y(Player.Object)) * CubeRevSpeed#
      CubeRevMoveZ# = cos(-Object Angle Y(Player.Object)) * CubeRevSpeed#

      `Again, update the X and Z with the reversing vector.
      PosX#=PosX#-CubeRevMoveX#
      PosZ#=PosZ#-CubeRevMoveZ#

      `Put a bit of a 'rolling' tumble on it, so we know the cube's reversing.
      CurrentXRot#=Object Angle X(Player.Object)
      Xrotate Object Player.Object,CurrentXRot#-3

   Endif

   If Keystate(30)=1 then Yrotate Object Player.Object, Wrapvalue(CubeAngle#-1.5)  :`"A" for left.

   If Keystate(32)=1 then Yrotate Object Player.Object, Wrapvalue(CubeAngle#+1.5)  :`"D" for right.

   `Object collision (Want's it's own function soon, I believe.)
   if object collision (1,5) > 0
      dec PosX#,get object collision x()
      dec PosY#,get object collision y()
      dec PosZ#,get object collision z()
   endif

   `Apply all the position changes last, including collision.
   position object Player.Object, PosX#,4.5+(Player.Level/2),PosZ#

EndFunction


`TEST function to see what keys are being pressed and print their scancode.
Function TestKeys()
   Set Cursor 0,0
   Print SCANCODE()

EndFunction


`The camera control function to position it above and behind our cube.
Function ThirdPerson()

   `Special thanks to my bf for showing me his DarkSDK code that he wrote for 3rd Person.  Needed modifying to work.
   CameraOffset# = 50

   CameraHeight = Object Position Y(Player.Object)+30

   OffsetX# = -sin(-Object Angle Y(Player.Object)) * CameraOffset#
   OffsetZ# = cos(-Object Angle Y(Player.Object)) * CameraOffset#

   Position Camera 0, Object Position X(Player.Object)-OffsetX#, CameraHeight , Object Position Z(Player.Object)-OffsetZ#
   Point Camera 0, Object Position X(Player.Object), Object Position Y(Player.Object)+15, Object Position Z(Player.Object)

EndFunction


`Create the walls of our level/maze/city whatever.
Function MakeLevel()

   make object box 5,100,20,20
   make object collision box 5,-50,-10,-10,50,10,10,0
   position object 5, 150,0,120

Endfunction


`Try to generate some randomised baddies.  This will need a lot of work (especially placement).
Function GenerateBaddie()

   for i = 0 to array count(Enemies())

      Enemies(i).Rage=rnd(50)
      Enemies(i).Grace=rnd(50)
      Enemies(i).Brains=rnd(50)

     Enemies(i).HP=(Enemies(i).Rage+Enemies(i).Grace+Enemies(i).Brains)/6

      Enemies(i).XPDrop=(Enemies(i).Rage+Enemies(i).Grace+Enemies(i).Brains)/3
      Enemies(i).MoneyDrop=Enemies(i).XPDrop/2

      `Enemies(i).Name="EvilBall"
      if Enemies(i).Rage>Enemies(i).Grace
         if Enemies(i).Rage>Enemies(i).Brains
            Enemies(i).Name="Bezerker Ball"
         else
            Enemies(i).Name="Brainy Ball"
         endif
      else
         if Enemies(i).Grace>Enemies(i).Brains
            Enemies(i).Name="Ninja Ball"
         else
            Enemies(i).Name="Brainy Ball"
         endif
      endif

      Enemies(i).Object=50+i

      Make Object Sphere Enemies(i).Object,Enemies(i).HP
      Set Object Collision to Spheres Enemies(i).Object
      Set Object Collision on Enemies(i).Object
     ` Set Shadow Shading on Enemies(i).Object
      Position Object Enemies(i).Object,rnd(600)-300,Enemies(i).HP/2,rnd(600)-300
      Color Object Enemies(i).Object,rgb(Enemies(i).Rage,Enemies(i).Grace,Enemies(i).Brains)
   next i

Endfunction

`Draw the players stats in terms of colours in the top left of the screen.
Function DrawStats()

   set cursor 1,1
   Print Player.Name," The Cube"
   `ink rgb(Player.Rage,0,0),0
   ink rgb(255,0,0),0
   set cursor 1,17
   Print "Rage:"
   box 5,33,Player.Rage+5,43
   `ink rgb(0,Player.Grace,0),0
   ink rgb(0,255,0),0
   set cursor 1,43
   Print "Grace:"
   box 5,58,Player.Grace+5,68
   `ink rgb(0,0,Player.Brains),0
   ink rgb(0,0,255),0
   set cursor 1,68
   Print "Brains:"
   box 5,84,Player.Brains+5,94
   ink rgb(255,255,255),0
   `Ink RGB(INT(Player.Rage),INT(Player.Grace),INT(Player.Brains)),0
   if keystate(18)=1
      set cursor 1,94
      Print "XP: ",Player.XP
      set cursor 1,110
      Print "Money: ",Player.Money
   endif
EndFunction


`Draw the stats of the baddies when you collide with them.  Hopefully, this will trigger when a fight starts.
Function DrawBaddieStats()

   Collider= Object Collision(1,0)-50

   set cursor screen width()-Text Width (Enemies(Collider).Name)-Text Width (" The Enemy!"),1
   Print Enemies(Collider).Name," The Enemy!"

   ink rgb(255,0,0),0
   set cursor screen width()-Text Width("Rage:"),17
   Print "Rage:"
   box screen width()-Enemies(Collider).Rage-5,33,screen width()-5,43

   ink rgb(0,255,0),0
   set cursor screen width()-Text Width ("Grace:"),43
   Print "Grace:"
   box screen width()-Enemies(Collider).Grace-5,58,screen width()-5,68

   ink rgb(0,0,255),0
   set cursor screen width()-Text Width("Brains:"),68
   Print "Brains:"
   box screen width()-Enemies(Collider).Brains-5,84,screen width()-5,94

   ink rgb(255,255,255),0

EndFunction


`Fight function - this is the meat of the gameplay.  Press 1,2 or 3 to choose an attack.
Function DoFight()

   Fighting = 1

   ConSystemInk()
   center Text screen width()/2,screen height()-65,"Fight"
   ink rgb(255,255,255),0

   BattleTimer()

   CombatCamera()


`Some placeholder attack types and names.  I really want to change this soon.

If Keystate(2) = 1
   Attack = 1
   AttackName$ = "Rage Frenzy"
endif

If Keystate(3) = 1
   Attack = 2
   AttackName$ = "Stealth Stab"
endif

If Keystate(4) = 1
   Attack = 3
   AttackName$ = "Hard Math Problems"
endif

   if Attack > 0
      ink 0,0
      center Text screen width()/2,screen height()-45,AttackName$
      ink rgb(255,255,255),0
   endif

   if Loopy=0
      if Attack>0
         DamageBaddie()
         `KillBaddie()
         Attack=0
      endif
   endif

EndFunction


`Kills the baddie and gives goodies to the player.
Function KillBaddie()

   Fighting = 0
   Loopy = 500
   Player.XP = Player.XP + Enemies(Object Collision(1,0)-50).XPDrop
   Player.Money = Player.Money + Enemies(Object Collision(1,0)-50).MoneyDrop
   delete object Object Collision(1,0)

   `TEMP Player damaged section.
   `Player.HP = Player.HP-10
   `Scale Object 1,Player.HP,Player.HP,Player.HP


EndFunction


`When in combat, the character (and thus camera) swings around to look at the enemy.
Function CombatCamera()

XDiff = Object Position X(Object Collision(1,0)) - Object Position X(1)
ZDiff = Object Position Z(Object Collision(1,0)) - Object Position Z(1)

angle# = ATanFull(XDiff, ZDiff)

angle# = WrapValue(angle#)

AngleDiff# = Object Angle Y(1) - angle#

while (AngleDiff# < -180)
   AngleDiff# = AngleDiff# + 360
endwhile

while (AngleDiff# > 180)
   AngleDiff# = AngleDiff# - 360
endwhile

YRotate Object 1,Object Angle Y(1) - (AngleDiff#/20)

EndFunction


`Depending on the relative average skill levels of your opponent, change the ink colour.  A bit late, but never mind.
Function ConSystemInk()

BaddieID = Object Collision(1,0)-50

`RED
if Enemies(BaddieID).Rage+Enemies(BaddieID).Grace+Enemies(BaddieID).Brains > (Player.Rage+Player.Grace+Player.Brains)
   ink rgb(255,0,0),0
else

   `YELLOW
   if Enemies(BaddieID).Rage+Enemies(BaddieID).Grace+Enemies(BaddieID).Brains > ((Player.Rage+Player.Grace+Player.Brains)*0.6)
      ink rgb(255,255,0),0
   else

   `BLUE
      if Enemies(BaddieID).Rage+Enemies(BaddieID).Grace+Enemies(BaddieID).Brains > ((Player.Rage+Player.Grace+Player.Brains)*0.4)
         ink rgb(0,0,255),0
      else

         `PALE BLUE
         if Enemies(BaddieID).Rage+Enemies(BaddieID).Grace+Enemies(BaddieID).Brains < ((Player.Rage+Player.Grace+Player.Brains)*0.4)
            ink rgb(180,180,255),0
         endif
      endif
   endif
endif

EndFunction

`To increase the characters stats and level when they gain enough XP.
Function Level()

Player.Level = Player.Level+1
Player.Rage = Player.Rage+rnd(10)+5
Player.Grace = Player.Grace+rnd(10)+5
Player.Brains = Player.Brains+rnd(10)+5

Player.MaxHP = Player.MaxHP+rnd(10)+10
Player.HP = Player.MaxHP

Scale Object 1,Player.MaxHP,Player.MaxHP,Player.MaxHP

Color Object 1,rgb(Player.Rage,Player.Grace,Player.Brains)

Player.XP=Player.XP-(100*(Player.Level-1))

EndFunction


`Battle Timer should let the player do one attack over a length of time.
Function BattleTimer()
if Loopy = 0
   Loopy = 500
endif
if Loopy>0
   Loopy = Loopy - 1
endif

if Loopy > 250
   ink rgb(0,255,0),0
   else
      if Loopy > 100
         ink rgb(255,255,0),0
      else
         if Loopy > 50
            ink rgb(255,128,0),0
         else
            if Loopy < 51
               ink rgb(255,0,0),0
            endif
         endif
      endif
endif

box (screen width()/2)-Loopy/2,screen height()-45,(screen width()/2)+Loopy/2,screen height()-30
ink rgb(255,255,255),0

EndFunction

`Instead of killing the baddie in one hit, lets do him some damage.  The numbers are unbalanced.
Function DamageBaddie()

BaddieID = Object Collision(1,0)-50

If Attack = 1
   Enemies(BaddieID).HP = Enemies(BaddieID).HP - Player.Rage
   set cursor screen width()/2,screen height()/2
   Print "PLAYER DID ", Player.Rage, " DAMAGE TO ", Enemies(BaddieID).Name
endif

If Attack = 2
   Enemies(BaddieID).HP = Enemies(BaddieID).HP - (Player.Grace/2)*rnd(3)
   set cursor screen width()/2,screen height()/2
   Print "PLAYER DID ", (Player.Grace/2)*rnd(3), " DAMAGE TO ", Enemies(BaddieID).Name
endif

If Attack = 3
   Enemies(BaddieID).HP = Enemies(BaddieID).HP - (Player.Brains)+rnd(20)-10
   set cursor screen width()/2,screen height()/2
   Print "PLAYER DID ", (Player.Brains)+rnd(20)-10, " DAMAGE TO ", Enemies(BaddieID).Name
endif

if Enemies(BaddieID).HP < 1
   KillBaddie()
endif

EndFunction

sync on
sync rate 0
autocam off
set display mode 1280, 1024, 32
set ambient light 0
randomize timer()
color backdrop 0

`CONSTANTS GO HERE
`constants for the stats panel
   #constant STATS_IMG_W 16
   #constant STATS_IMG_H 48
   #constant STATS_IMG_TRANSPARENCY_MASK_A 0x66FFFFFF
   #constant STATS_IMG_TRANSPARENCY_MASK_B 0x33FFFFFF
`constant for enemy creation
   #constant ENEMY_WEAPON_SIZE 3.0
   #constant CREATION_TIMER 5000
`Map generation constants
   #constant TEXTURE_SIZE 64
`Control Keys (NOT CURRENTLY USED, but usefull to keep ;-) hehe)
   #constant KeyW 17
   #constant KeyA 30
   #constant KeyS 31
   #constant KeyD 32
`Player contants
   #constant TARGET_COLOR 0xFF0000  :`Used for the targetting blob
   #constant PLAYER_SPEED 3.0
   #constant PLAYER_WEAPON_SIZE 5.0


`Create the stats panel temaplate...
global STATS_IMG_SIZE
STATS_IMG_SIZE = 12 + (STATS_IMG_W * STATS_IMG_H * 4)
CREATE_STATS_PANEL_TEMPLATE()

make memblock 1, 12 + (TEXTURE_SIZE * TEXTURE_SIZE * 4)
write memblock dword 1, 0, TEXTURE_SIZE
write memblock dword 1, 4, TEXTURE_SIZE
write memblock dword 1, 8, 32
c as dword
for x = 0 to TEXTURE_SIZE - 1
   for y = 0 to TEXTURE_SIZE - 1
      c = rgb(32, 128 + rnd(127), 32)
      write memblock dword 1, 12 + ((y*TEXTURE_SIZE)+x)*4, c
   next y
next x
make image from memblock 1, 1
delete memblock 1




`This is here so I can see the arguements easier :-)
`function GENERATE_TERRAIN(obj, img, W, H, MAX_HEIGHT#, SMOOTHING_ITTERATIONS, SMOOTHING_FACTOR#, MAPSCALE#, USCALE#, VSCALE#)

`Create the terrain
GENERATE_TERRAIN(1, 1, 64, 64, 50.0, 4, 0.75, 4.0, 2.0, 2.0)
position object 1, 0, 0, 0




`Create the player + Data
Type Coord
   x#
   y#
   z#
EndType
Type PlayerData
   Pos as Coord
   moved as boolean
   Target as Coord
   Health#
EndType

`Create player details
P as PlayerData
P.Pos.x# = 10
P.Pos.z# = 10
P.Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, P.Pos.x#, P.Pos.z#) + object size y(1) * 0.5
P.Target.x# = P.Pos.x# + 0.0001
P.Target.z# = P.Pos.z#
P.Health# = 41

`Start the player as moved - this is to make sure everything starts in the right place.
P.moved = 1
`Create the player
CREATE_CHARACTER(2, 0xCCCCDD, PLAYER_WEAPON_SIZE)
`Position it
position object 2, P.Pos.x#, P.Pos.y#, P.Pos.z#
`Make health bar
MAKE_HEALTH_BAR(2, int(P.Health#))
`Create a temporary vector for working out headings
null = make vector2(1)



`Target Object stuff
make object sphere 3, 0.5  :`Target Object for when moving
set object transparency 3, 3
color object 3, TARGET_COLOR
a as DWORD
CLICK_DIST# = 0.0

`Lighting
set point light 0, 0, 0, 0
set light range 0, 40


`Enemy Data Stuff
EnemyTimer = 0

Type EnemyData
   Pos as Coord
   TimeToLive#
   Health#
EndType


`Create the enemies
Dim Enemies(5) as EnemyData
for i = 0 to 5
   `Create a new character, but with a smaller weapon.. Also comes in Yellow
   CREATE_CHARACTER(i+1000, rgb(255,255,0) && STATS_IMG_TRANSPARENCY_MASK_A, ENEMY_WEAPON_SIZE)
   Enemies(i).Health# = -1
   `Hide the object until its needed... Excluding would be better - but it is bugged, so hiding it is!
   hide object i+1000
next u
`This is used for calculating distances for firing from the enemy
null = make vector3(2)

global msg$


`Mouse Status
mouseStatus = 0

frameTime# = 1.0
startTime = timer()
do
   frameTime# = (frameTime# * 0.8) + ((timer() - startTime) * 0.2)
   startTime = timer()
   text 0,0, "FPS: " + str$(screen fps())
   paste image 10, screen width() - image width(10), 0

   if mouseclick() = 1 AND mouseStatus = 0
      P.moved = 1
      mouseStatus = mouseclick()
      null = pick object(mousex(), mousey(), 1, 1)
      P.Target.x# = camera position x() + get pick vector x()
      P.Target.z# = camera position z() + get pick vector z()
      position object 3, P.Target.x#, GET_CUSTOM_TERRAIN_HEIGHT(1,P.Target.x#,P.Target.z#) + 0.25, P.Target.z#
      point object 2, object position x(3), object position y(3), object position z(3)

      set vector2 1, P.Target.x# - P.Pos.x#, P.Target.z# - P.Pos.z#
      CLICK_DIST# = length vector2(1)*1.5
      a = 255
   else
      if mouseclick() = 0 then mouseStatus = 0
   endif

   if P.moved
      set vector2 1, P.Target.x# - P.Pos.x#, P.Target.z# - P.Pos.z#
      dist# = length vector2(1)

      if dist# < 0.1 then P.moved = 0

      a = (dist# / CLICK_DIST#) * 255.0
      color object 3, (a << 24) || TARGET_COLOR

      normalize vector2 1, 1

      inc P.Pos.x#, x vector2(1) * frameTime# * 0.001 * PLAYER_SPEED
      inc P.Pos.z#, y vector2(1) * frameTime# * 0.001 * PLAYER_SPEED
      P.Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, P.Pos.x#, P.Pos.z#) + 0.5

      position object 2, P.Pos.x#, P.Pos.y#, P.Pos.z#

      position light 0, P.Pos.x#, P.Pos.y# + 10, P.Pos.z#

      position camera P.Pos.x# + 10, P.Pos.y# + 10, P.Pos.z# + 10
      point camera P.Pos.x#, P.Pos.y#, P.Pos.z#
   endif

   `Show player health. This If statement is just to make sure nothing bad happens if its not made yet...
   if image exist(2)
      paste image 2, object screen x(2), object screen y(2) - STATS_IMG_H, 1
   endif



   if spacekey() then show limb 2,2 else hide limb 2,2


   text 0, 20, "T: " + str$(timer() - EnemyTimer)
   if timer() - EnemyTimer > CREATION_TIMER then CREATE_ENEMY() : EnemyTimer = timer()
   gosub PROCESS_ENEMIES

   sync
loop
end



PROCESS_ENEMIES:
   for obj = 1000 to 1005
      if object visible(obj)
         enemyId = obj-1000
         enemyImg = obj-900
         point object obj, P.Pos.x#, P.Pos.y#, P.Pos.z#
         if Enemies(enemyId).TimeToLive# < 0.5
            inc Enemies(enemyId).TimeToLive#, frameTime# * 0.001
         else
            move object obj, frameTime# * 0.0005
         endif
         position object obj, object position x(obj), GET_CUSTOM_TERRAIN_HEIGHT(1, object position x(obj), object position z(obj)) + Enemies(enemyId).TimeToLive#, object position z(obj)

         Enemies(enemyId).Pos.x# = object position x(obj)
         Enemies(enemyId).Pos.y# = object position y(obj)
         Enemies(enemyId).Pos.z# = object position z(obj)
         set vector3 2, Enemies(enemyId).Pos.x# - P.Pos.x#,  Enemies(enemyId).Pos.y# - P.Pos.y#,  Enemies(enemyId).Pos.z# - P.Pos.z#
         if length vector3(2) < ENEMY_WEAPON_SIZE+0.5
            show limb obj,2
            if object collision(obj, 2)
               dec P.Health#, frameTime# * 0.01
               MAKE_HEALTH_BAR(2, int(P.Health#))
            endif
         else
            hide limb obj, 2
         endif


         if limb visible(2,2) AND object collision(2, obj)
            `If enemy hit, then rediuce its health
            dec Enemies(enemyId).Health#, frameTime# * 0.05
            MAKE_HEALTH_BAR(enemyImg, int(Enemies(enemyId).Health#))
         endif

         `If the image exists (which it should, we just made it) then paste it. This is mainly to avoid crashes
         if image exist(enemyImg)
            paste image enemyImg, object screen x(obj), object screen y(obj) - STATS_IMG_H, 1
         endif

         `If the enemy is out of health - delete it
         if Enemies(enemyId).Health# <= 0
            hide object obj
            inc P.Health#, 20.0
            if P.Health# > 41 then P.Health# = 41
         endif
      endif
   next obj
return




function CREATE_ENEMY()
   obj = 1000
   while Enemies(obj-1000).Health# > 0 AND obj < 1005 : inc obj : endwhile

   if object exist(obj)
      show object obj
      `Create Image and array index for this enemy object
      enemyImg = obj - 900
      enemyID = obj - 1000

      `Create a random position for the enemy
      Enemies(enemyID).Pos.x# = rnd(5.0)
      Enemies(enemyID).Pos.z# = rnd(5.0)
      `If rnd(1) = 1 then position the object in the negative x/z direction, otherwise positive.
      `The static 5 is to make sure its a fair minimum distance from the player when spawned
      if rnd(1) then Enemies(enemyID).Pos.x# = -Enemies(enemyID).Pos.x# - 5.0 else inc Enemies(enemyID).Pos.x#, 5.0
      if rnd(1) then Enemies(enemyID).Pos.z# = -Enemies(enemyID).Pos.z# - 5.0 else inc Enemies(enemyID).Pos.z#, 5.0

      `This offsets the enemy so the random position above is relative to the player
      inc Enemies(enemyID).Pos.x#, P.Pos.x#
      inc Enemies(enemyID).Pos.z#, P.Pos.z#

      `Now we know exactly where the enemy is - we can work out how high up to put it
      Enemies(enemyId).Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, Enemies(enemyID).Pos.x#, Enemies(enemyID).Pos.z#) - 0.5

      `Now we have all 3 coords, we can position and point.
      position object obj, Enemies(enemyID).Pos.x#, Enemies(enemyID).Pos.y#, Enemies(enemyID).Pos.z#
      point object obj, P.Pos.x#, P.Pos.y#, P.Pos.z#

      `TimeToLive# is the vertical offset. It starts at -1.0 as that puts it underground.
      `When its +0.5 then its above ground and can start heading for the player
      Enemies(enemyId).TimeToLive# = -1.0
      `Starting health - might be a strange number, but it just makes the health bar easier ;-)
      Enemies(enemyId).Health# = 41.0
      `Create the health bar
      MAKE_HEALTH_BAR(enemyImg, int(Enemies(enemyId).Health#))
   endif

endfunction




function MAKE_HEALTH_BAR(img, health)
   `Create memblock if it doesn't exist
   if memblock exist(img) = 0 then make memblock img, STATS_IMG_SIZE
   `Copy in the template memblock image
   copy memblock 99, img, 0, 0, STATS_IMG_SIZE
   `Loop through the middle bar and write in the required bar pixels
   for x = 3 to 12
      for y = 44-health to 44
         write memblock dword img, 12 + ((y*STATS_IMG_W) + x)*4, rgb(255, 0, 0) && STATS_IMG_TRANSPARENCY_MASK_A
      next y
   next x
   `Turn it into an image :-)
   make image from memblock img, img
endfunction




function CREATE_CHARACTER(obj, c, weaponLength#)
   `Main body of character
   make object sphere obj, 1
   `The nose - mainly so you know where you're going ;-)
   make object cone 10000, 1
   `Scale the nose to make it more "nosey"
   scale object 10000, 50.0, 100.0, 50.0
   `Turn it into a mesh so it can be added as a limb
   make mesh from object 10, 10000
   `Add the mesh to the bodo object
   add limb obj, 1, 10
   `rotate and offset it to put it in the right place
   rotate limb obj, 1, 90, 0, 0
   offset limb obj, 1, 0.0, 0.0, 0.5
   `Make the bar-o-spacekey
   make object cone 10001, 1
   `Offset it so it pivots on its end
   offset limb 10001, 0, 0.0, 0.0, 0.5
   `scale it up to make it a big bar-o-death
   scale object 10001, 100, 100, 100*weaponLength#
   `Rotate it so it points out front and is not a bar-o-suicide
   rotate limb 10001, 0, -90, 0, 0
   `turn it into a mesh
   make mesh from object 11, 10001
   `add that mesh to the player
   add limb obj, 2, 11
   `hide the limb so we can fire when needed
   hide limb obj, 2
   `Color the object in
   color object obj, c

   set object collision to polygons obj

   `cleanup
   delete object 10000
   delete object 10001
   delete mesh 10
   delete mesh 11
endfunction








function GET_CUSTOM_TERRAIN_HEIGHT(obj, x#, z#)
   height# = 1000.0 - intersect object(obj, x#, 1000, z#,  x#, -1000, z#)
endfunction height#




function GENERATE_TERRAIN(obj, img, W, H, MAX_HEIGHT#, SMOOTHING_ITTERATIONS, SMOOTHING_FACTOR#, MAPSCALE#, USCALE#, VSCALE#)
   dim HEIGHTMAP#(W,H)
   dim NORMALS#(W,H,3)

   for i = 0 to W-1
      for j = 0 to H-1
         HEIGHTMAP#(i, j) = rnd(MAX_HEIGHT#)
      next j
   next i


   for iters = 0 to SMOOTHING_ITTERATIONS
      for i = 0   to W-1       : for j = 0 to H           : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i+1,j) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
      for i = W-1 to 0  step -1: for j = 0 to H           : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i+1,j) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
      for i = 0 to W           : for j = 0 to H-1         : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i,j+1) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
      for i = 0 to W           : for j = H-1 to 0 step -1 : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i,j+1) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
   next iters


   colValue = 255 / MAX_HEIGHT#
   make memblock 1, 12 + (W*H*4)
   write memblock dword 1, 0, W
   write memblock dword 1, 4, H
   write memblock dword 1, 8, 32
   for i = 0 to W-1
      for j = 0 to H-1
         c = HEIGHTMAP#(i,j)*colValue
         write memblock dword 1, 12 + ((j*W)+i)*4, rgb(c,c,c)
      next j
   next i
   make image from memblock 10, 1




   ` CALCULATE NORMALS

   for i = 1 to W-1
      for j = 1 to H-1
         null = make vector3(1)
         null = make vector3(2)
         null = make vector3(3)
         null = make vector3(4)
         null = make vector3(5)
         null = make vector3(6)
         null = make vector3(7)
         null = make vector3(8)
         null = make vector3(9)

         set vector3 1,  MAPSCALE#, HEIGHTMAP#(i,j) - HEIGHTMAP#(i+1,j  ),  0
         set vector3 2,          0, HEIGHTMAP#(i,j) - HEIGHTMAP#(i  ,j-1), -MAPSCALE#
         set vector3 3, -MAPSCALE#, HEIGHTMAP#(i,j) - HEIGHTMAP#(i-1,j  ),  0
         set vector3 4,          0, HEIGHTMAP#(i,j) - HEIGHTMAP#(i  ,j+1),  MAPSCALE#


         cross product vector3 5, 1, 2
         cross product vector3 6, 2, 3
         cross product vector3 7, 3, 4
         cross product vector3 8, 4, 1

         add vector3 9, 9, 5
         add vector3 9, 9, 6
         add vector3 9, 9, 7
         add vector3 9, 9, 8
         divide vector3 9, 4
         normalize vector3 9, 9
         NORMALS#(i,j,0) = x vector3(9)
         NORMALS#(i,j,1) = y vector3(9)
         NORMALS#(i,j,2) = z vector3(9)
         null = delete vector3(1)
         null = delete vector3(2)
         null = delete vector3(3)
         null = delete vector3(4)
         null = delete vector3(5)
         null = delete vector3(6)
         null = delete vector3(7)
         null = delete vector3(8)
         null = delete vector3(9)
      next j
   next i


   if memblock exist(1) then delete memblock 1
   make memblock 1, 12 + (32 * 3 * 2 * W * H)

   write memblock dword 1,0,274 : `FVF FORMAT
   write memblock dword 1,4,32  : `SIZE PER VERT
   write memblock dword 1,8,W*H*2*3   : `VERT NO


   poly = 0
   for i = 0 to W-1
      for j = 0 to H-1
         ` ** POLY 1 **
         x = i   : z = j   : CREATE_MESH_ENTRY(1, 12 + (poly * 192)      , (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), 0.0    , 0.0    )
         x = i   : z = j+1 : CREATE_MESH_ENTRY(1, 12 + (poly * 192) +  32, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), 0.0    , VSCALE#)
         x = i+1 : z = j   : CREATE_MESH_ENTRY(1, 12 + (poly * 192) +  64, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), USCALE#, 0.0    )
         ` ** POLY 2 **
         x = i+1 : z = j   : CREATE_MESH_ENTRY(1, 12 + (poly * 192) +  96, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), USCALE#, 0.0    )
         x = i   : z = j+1 : CREATE_MESH_ENTRY(1, 12 + (poly * 192) + 128, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), 0.0    , VSCALE#)
         x = i+1 : z = j+1 : CREATE_MESH_ENTRY(1, 12 + (poly * 192) + 160, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), USCALE#, VSCALE#)
         inc poly
      next j
   next i


   make mesh from memblock 1, 1
   if object exist(obj) = 1 then delete object obj
   make object obj, 1, img
   delete mesh 1
   delete memblock 1
endfunction




function CREATE_MESH_ENTRY(memblockNum, n, x#, y#, z#, nx#, ny#, nz#, u#, v#)
   write memblock float 1, n +  0, x#
   write memblock float 1, n +  4, y#
   write memblock float 1, n +  8, z#
   write memblock float 1, n + 12, nx#
   write memblock float 1, n + 16, ny#
   write memblock float 1, n + 20, nz#
   write memblock float 1, n + 24, u#
   write memblock float 1, n + 28, v#
endfunction




function CREATE_STATS_PANEL_TEMPLATE()
   `Create Stats Panel
   make memblock 99, STATS_IMG_SIZE
   write memblock dword 99, 0, STATS_IMG_W
   write memblock dword 99, 4, STATS_IMG_H
   write memblock dword 99, 8, 32
   for x = 0 to STATS_IMG_W - 1
      for y = 0 to STATS_IMG_H - 1
         if x > 3 AND x < 12 AND y > 3 AND y < 44
            write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, rgb(160, 160, 160) && STATS_IMG_TRANSPARENCY_MASK_B
         else
            write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, rgb(160, 160, 160) && STATS_IMG_TRANSPARENCY_MASK_A
         endif
      next y
   next x
   `TopLeft
   x = 0 : y = 0 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = 1 : y = 0 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = 0 : y = 1 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0

   `TopRight
   x = STATS_IMG_W-1 : y = 0 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = STATS_IMG_W-2 : y = 0 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = STATS_IMG_W-1 : y = 1 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0

   `BottomRight
   x = STATS_IMG_W-1 : y = STATS_IMG_H-1 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = STATS_IMG_W-2 : y = STATS_IMG_H-1 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = STATS_IMG_W-1 : y = STATS_IMG_H-2 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0

   `BottomLeft
   x = 0 : y = STATS_IMG_H-1 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = 1 : y = STATS_IMG_H-1 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = 0 : y = STATS_IMG_H-2 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0

endfunction

   paste image 10, screen width() - image width(10), 0

sync on
sync rate 0
autocam off
set display mode 1280, 1024, 32
set ambient light 0
randomize timer()
color backdrop 0

`CONSTANTS GO HERE
`constants for the stats panel
   #constant STATS_IMG_W 16
   #constant STATS_IMG_H 48
   #constant STATS_IMG_TRANSPARENCY_MASK_A 0x66FFFFFF
   #constant STATS_IMG_TRANSPARENCY_MASK_B 0x33FFFFFF
`constant for enemy creation
   #constant ENEMY_WEAPON_SIZE 3.0
   #constant CREATION_TIMER 5000
`Map generation constants
   #constant TEXTURE_SIZE 64
`Control Keys (NOT CURRENTLY USED, but usefull to keep ;-) hehe)
   #constant KeyW 17
   #constant KeyA 30
   #constant KeyS 31
   #constant KeyD 32
`Player contants
   #constant TARGET_COLOR 0xFF0000  :`Used for the targetting blob
   #constant PLAYER_SPEED 3.0
   #constant PLAYER_WEAPON_SIZE 5.0


`Create the stats panel temaplate...
global STATS_IMG_SIZE
STATS_IMG_SIZE = 12 + (STATS_IMG_W * STATS_IMG_H * 4)
CREATE_STATS_PANEL_TEMPLATE()

make memblock 1, 12 + (TEXTURE_SIZE * TEXTURE_SIZE * 4)
write memblock dword 1, 0, TEXTURE_SIZE
write memblock dword 1, 4, TEXTURE_SIZE
write memblock dword 1, 8, 32
c as dword
for x = 0 to TEXTURE_SIZE - 1
   for y = 0 to TEXTURE_SIZE - 1
      c = rgb(32, 128 + rnd(127), 32)
      write memblock dword 1, 12 + ((y*TEXTURE_SIZE)+x)*4, c
   next y
next x
make image from memblock 1, 1
delete memblock 1




`This is here so I can see the arguements easier :-)
`function GENERATE_TERRAIN(obj, img, W, H, MAX_HEIGHT#, SMOOTHING_ITTERATIONS, SMOOTHING_FACTOR#, MAPSCALE#, USCALE#, VSCALE#)

`Create the terrain
GENERATE_TERRAIN(1, 1, 64, 64, 50.0, 4, 0.75, 4.0, 2.0, 2.0)
position object 1, 0, 0, 0




`Create the player + Data
Type Coord
   x#
   y#
   z#
EndType
Type PlayerData
   Pos as Coord
   moved as boolean
   Target as Coord
   Health#
EndType

`Create player details
P as PlayerData
P.Pos.x# = 10
P.Pos.z# = 10
P.Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, P.Pos.x#, P.Pos.z#) + object size y(1) * 0.5
P.Target.x# = P.Pos.x# + 0.0001
P.Target.z# = P.Pos.z#
P.Health# = 41

`Start the player as moved - this is to make sure everything starts in the right place.
P.moved = 1
`Create the player
CREATE_CHARACTER(2, 0xCCCCDD, PLAYER_WEAPON_SIZE)
`Position it
position object 2, P.Pos.x#, P.Pos.y#, P.Pos.z#
`Make health bar
MAKE_HEALTH_BAR(2, int(P.Health#))
`Create a temporary vector for working out headings
null = make vector2(1)



`Target Object stuff
make object sphere 3, 0.5  :`Target Object for when moving
set object transparency 3, 3
color object 3, TARGET_COLOR
a as DWORD
CLICK_DIST# = 0.0

`Lighting
set point light 0, 0, 0, 0
set light range 0, 40


`Enemy Data Stuff
EnemyTimer = 0

Type EnemyData
   Pos as Coord
   TimeToLive#
   Health#
EndType


`Create the enemies
Dim Enemies(5) as EnemyData
for i = 0 to 5
   `Create a new character, but with a smaller weapon.. Also comes in Yellow
   CREATE_CHARACTER(i+1000, rgb(255,255,0) && STATS_IMG_TRANSPARENCY_MASK_A, ENEMY_WEAPON_SIZE)
   Enemies(i).Health# = -1
   `Hide the object until its needed... Excluding would be better - but it is bugged, so hiding it is!
   hide object i+1000
next u
`This is used for calculating distances for firing from the enemy
null = make vector3(2)

global msg$


`Mouse Status
mouseStatus = 0

frameTime# = 1.0
startTime = timer()
do
   frameTime# = (frameTime# * 0.8) + ((timer() - startTime) * 0.2)
   startTime = timer()
   text 0,0, "FPS: " + str$(screen fps())
   paste image 10, screen width() - TEXTURE_SIZE, 0

   if mouseclick() = 1 AND mouseStatus = 0
      P.moved = 1
      mouseStatus = mouseclick()
      null = pick object(mousex(), mousey(), 1, 1)
      P.Target.x# = camera position x() + get pick vector x()
      P.Target.z# = camera position z() + get pick vector z()
      position object 3, P.Target.x#, GET_CUSTOM_TERRAIN_HEIGHT(1,P.Target.x#,P.Target.z#) + 0.25, P.Target.z#
      point object 2, object position x(3), object position y(3), object position z(3)

      set vector2 1, P.Target.x# - P.Pos.x#, P.Target.z# - P.Pos.z#
      CLICK_DIST# = length vector2(1)*1.5
      a = 255
   else
      if mouseclick() = 0 then mouseStatus = 0
   endif

   if P.moved
      set vector2 1, P.Target.x# - P.Pos.x#, P.Target.z# - P.Pos.z#
      dist# = length vector2(1)

      if dist# < 0.1 then P.moved = 0

      a = (dist# / CLICK_DIST#) * 255.0
      color object 3, (a << 24) || TARGET_COLOR

      normalize vector2 1, 1

      inc P.Pos.x#, x vector2(1) * frameTime# * 0.001 * PLAYER_SPEED
      inc P.Pos.z#, y vector2(1) * frameTime# * 0.001 * PLAYER_SPEED
      P.Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, P.Pos.x#, P.Pos.z#) + 0.5

      position object 2, P.Pos.x#, P.Pos.y#, P.Pos.z#

      position light 0, P.Pos.x#, P.Pos.y# + 10, P.Pos.z#

      position camera P.Pos.x# + 10, P.Pos.y# + 10, P.Pos.z# + 10
      point camera P.Pos.x#, P.Pos.y#, P.Pos.z#
   endif

   `Show player health. This If statement is just to make sure nothing bad happens if its not made yet...
   if image exist(2)
      paste image 2, object screen x(2), object screen y(2) - STATS_IMG_H, 1
   endif



   if spacekey() then show limb 2,2 else hide limb 2,2


   text 0, 20, "T: " + str$(timer() - EnemyTimer)
   if timer() - EnemyTimer > CREATION_TIMER then CREATE_ENEMY() : EnemyTimer = timer()
   gosub PROCESS_ENEMIES

   sync
loop
end



PROCESS_ENEMIES:
   for obj = 1000 to 1005
      if object visible(obj)
         enemyId = obj-1000
         enemyImg = obj-900
         point object obj, P.Pos.x#, P.Pos.y#, P.Pos.z#
         if Enemies(enemyId).TimeToLive# < 0.5
            inc Enemies(enemyId).TimeToLive#, frameTime# * 0.001
         else
            move object obj, frameTime# * 0.0005
         endif
         position object obj, object position x(obj), GET_CUSTOM_TERRAIN_HEIGHT(1, object position x(obj), object position z(obj)) + Enemies(enemyId).TimeToLive#, object position z(obj)

         Enemies(enemyId).Pos.x# = object position x(obj)
         Enemies(enemyId).Pos.y# = object position y(obj)
         Enemies(enemyId).Pos.z# = object position z(obj)
         set vector3 2, Enemies(enemyId).Pos.x# - P.Pos.x#,  Enemies(enemyId).Pos.y# - P.Pos.y#,  Enemies(enemyId).Pos.z# - P.Pos.z#
         if length vector3(2) < ENEMY_WEAPON_SIZE+0.5
            show limb obj,2
            if object collision(obj, 2)
               dec P.Health#, frameTime# * 0.01
               MAKE_HEALTH_BAR(2, int(P.Health#))
            endif
         else
            hide limb obj, 2
         endif


         if limb visible(2,2) AND object collision(2, obj)
            `If enemy hit, then rediuce its health
            dec Enemies(enemyId).Health#, frameTime# * 0.05
            MAKE_HEALTH_BAR(enemyImg, int(Enemies(enemyId).Health#))
         endif

         `If the image exists (which it should, we just made it) then paste it. This is mainly to avoid crashes
         if image exist(enemyImg)
            paste image enemyImg, object screen x(obj), object screen y(obj) - STATS_IMG_H, 1
         endif

         `If the enemy is out of health - delete it
         if Enemies(enemyId).Health# <= 0
            hide object obj
            inc P.Health#, 20.0
            if P.Health# > 41 then P.Health# = 41
         endif
      endif
   next obj
return




function CREATE_ENEMY()
   obj = 1000
   while Enemies(obj-1000).Health# > 0 AND obj < 1005 : inc obj : endwhile

   if object exist(obj)
      show object obj
      `Create Image and array index for this enemy object
      enemyImg = obj - 900
      enemyID = obj - 1000

      `Create a random position for the enemy
      Enemies(enemyID).Pos.x# = rnd(5.0)
      Enemies(enemyID).Pos.z# = rnd(5.0)
      `If rnd(1) = 1 then position the object in the negative x/z direction, otherwise positive.
      `The static 5 is to make sure its a fair minimum distance from the player when spawned
      if rnd(1) then Enemies(enemyID).Pos.x# = -Enemies(enemyID).Pos.x# - 5.0 else inc Enemies(enemyID).Pos.x#, 5.0
      if rnd(1) then Enemies(enemyID).Pos.z# = -Enemies(enemyID).Pos.z# - 5.0 else inc Enemies(enemyID).Pos.z#, 5.0

      `This offsets the enemy so the random position above is relative to the player
      inc Enemies(enemyID).Pos.x#, P.Pos.x#
      inc Enemies(enemyID).Pos.z#, P.Pos.z#

      `Now we know exactly where the enemy is - we can work out how high up to put it
      Enemies(enemyId).Pos.y# = GET_CUSTOM_TERRAIN_HEIGHT(1, Enemies(enemyID).Pos.x#, Enemies(enemyID).Pos.z#) - 0.5

      `Now we have all 3 coords, we can position and point.
      position object obj, Enemies(enemyID).Pos.x#, Enemies(enemyID).Pos.y#, Enemies(enemyID).Pos.z#
      point object obj, P.Pos.x#, P.Pos.y#, P.Pos.z#

      `TimeToLive# is the vertical offset. It starts at -1.0 as that puts it underground.
      `When its +0.5 then its above ground and can start heading for the player
      Enemies(enemyId).TimeToLive# = -1.0
      `Starting health - might be a strange number, but it just makes the health bar easier ;-)
      Enemies(enemyId).Health# = 41.0
      `Create the health bar
      MAKE_HEALTH_BAR(enemyImg, int(Enemies(enemyId).Health#))
   endif

endfunction




function MAKE_HEALTH_BAR(img, health)
   `Create memblock if it doesn't exist
   if memblock exist(img) = 0 then make memblock img, STATS_IMG_SIZE
   `Copy in the template memblock image
   copy memblock 99, img, 0, 0, STATS_IMG_SIZE
   `Loop through the middle bar and write in the required bar pixels
   for x = 3 to 12
      for y = 44-health to 44
         write memblock dword img, 12 + ((y*STATS_IMG_W) + x)*4, rgb(255, 0, 0) && STATS_IMG_TRANSPARENCY_MASK_A
      next y
   next x
   `Turn it into an image :-)
   make image from memblock img, img
endfunction




function CREATE_CHARACTER(obj, c, weaponLength#)
   `Main body of character
   make object sphere obj, 1
   `The nose - mainly so you know where you're going ;-)
   make object cone 10000, 1
   `Scale the nose to make it more "nosey"
   scale object 10000, 50.0, 100.0, 50.0
   `Turn it into a mesh so it can be added as a limb
   make mesh from object 10, 10000
   `Add the mesh to the bodo object
   add limb obj, 1, 10
   `rotate and offset it to put it in the right place
   rotate limb obj, 1, 90, 0, 0
   offset limb obj, 1, 0.0, 0.0, 0.5
   `Make the bar-o-spacekey
   make object cone 10001, 1
   `Offset it so it pivots on its end
   offset limb 10001, 0, 0.0, 0.0, 0.5
   `scale it up to make it a big bar-o-death
   scale object 10001, 100, 100, 100*weaponLength#
   `Rotate it so it points out front and is not a bar-o-suicide
   rotate limb 10001, 0, -90, 0, 0
   `turn it into a mesh
   make mesh from object 11, 10001
   `add that mesh to the player
   add limb obj, 2, 11
   `hide the limb so we can fire when needed
   hide limb obj, 2
   `Color the object in
   color object obj, c

   set object collision to polygons obj

   `cleanup
   delete object 10000
   delete object 10001
   delete mesh 10
   delete mesh 11
endfunction








function GET_CUSTOM_TERRAIN_HEIGHT(obj, x#, z#)
   height# = 1000.0 - intersect object(obj, x#, 1000, z#,  x#, -1000, z#)
endfunction height#




function GENERATE_TERRAIN(obj, img, W, H, MAX_HEIGHT#, SMOOTHING_ITTERATIONS, SMOOTHING_FACTOR#, MAPSCALE#, USCALE#, VSCALE#)
   dim HEIGHTMAP#(W,H)
   dim NORMALS#(W,H,3)

   for i = 0 to W-1
      for j = 0 to H-1
         HEIGHTMAP#(i, j) = rnd(MAX_HEIGHT#)
      next j
   next i


   for iters = 0 to SMOOTHING_ITTERATIONS
      for i = 0   to W-1       : for j = 0 to H           : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i+1,j) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
      for i = W-1 to 0  step -1: for j = 0 to H           : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i+1,j) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
      for i = 0 to W           : for j = 0 to H-1         : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i,j+1) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
      for i = 0 to W           : for j = H-1 to 0 step -1 : HEIGHTMAP#(i, j) = (HEIGHTMAP#(i,j) * SMOOTHING_FACTOR#) + (HEIGHTMAP#(i,j+1) * (1.0-SMOOTHING_FACTOR#)) : next j : next i
   next iters


   colValue = 255 / MAX_HEIGHT#
   make memblock 1, 12 + (W*H*4)
   write memblock dword 1, 0, W
   write memblock dword 1, 4, H
   write memblock dword 1, 8, 32
   for i = 0 to W-1
      for j = 0 to H-1
         c = HEIGHTMAP#(i,j)*colValue
         write memblock dword 1, 12 + ((j*W)+i)*4, rgb(c,c,c)
      next j
   next i
   make image from memblock 10, 1




   ` CALCULATE NORMALS

   for i = 1 to W-1
      for j = 1 to H-1
         null = make vector3(1)
         null = make vector3(2)
         null = make vector3(3)
         null = make vector3(4)
         null = make vector3(5)
         null = make vector3(6)
         null = make vector3(7)
         null = make vector3(8)
         null = make vector3(9)

         set vector3 1,  MAPSCALE#, HEIGHTMAP#(i,j) - HEIGHTMAP#(i+1,j  ),  0
         set vector3 2,          0, HEIGHTMAP#(i,j) - HEIGHTMAP#(i  ,j-1), -MAPSCALE#
         set vector3 3, -MAPSCALE#, HEIGHTMAP#(i,j) - HEIGHTMAP#(i-1,j  ),  0
         set vector3 4,          0, HEIGHTMAP#(i,j) - HEIGHTMAP#(i  ,j+1),  MAPSCALE#


         cross product vector3 5, 1, 2
         cross product vector3 6, 2, 3
         cross product vector3 7, 3, 4
         cross product vector3 8, 4, 1

         add vector3 9, 9, 5
         add vector3 9, 9, 6
         add vector3 9, 9, 7
         add vector3 9, 9, 8
         divide vector3 9, 4
         normalize vector3 9, 9
         NORMALS#(i,j,0) = x vector3(9)
         NORMALS#(i,j,1) = y vector3(9)
         NORMALS#(i,j,2) = z vector3(9)
         null = delete vector3(1)
         null = delete vector3(2)
         null = delete vector3(3)
         null = delete vector3(4)
         null = delete vector3(5)
         null = delete vector3(6)
         null = delete vector3(7)
         null = delete vector3(8)
         null = delete vector3(9)
      next j
   next i


   if memblock exist(1) then delete memblock 1
   make memblock 1, 12 + (32 * 3 * 2 * W * H)

   write memblock dword 1,0,274 : `FVF FORMAT
   write memblock dword 1,4,32  : `SIZE PER VERT
   write memblock dword 1,8,W*H*2*3   : `VERT NO


   poly = 0
   for i = 0 to W-1
      for j = 0 to H-1
         ` ** POLY 1 **
         x = i   : z = j   : CREATE_MESH_ENTRY(1, 12 + (poly * 192)      , (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), 0.0    , 0.0    )
         x = i   : z = j+1 : CREATE_MESH_ENTRY(1, 12 + (poly * 192) +  32, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), 0.0    , VSCALE#)
         x = i+1 : z = j   : CREATE_MESH_ENTRY(1, 12 + (poly * 192) +  64, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), USCALE#, 0.0    )
         ` ** POLY 2 **
         x = i+1 : z = j   : CREATE_MESH_ENTRY(1, 12 + (poly * 192) +  96, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), USCALE#, 0.0    )
         x = i   : z = j+1 : CREATE_MESH_ENTRY(1, 12 + (poly * 192) + 128, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), 0.0    , VSCALE#)
         x = i+1 : z = j+1 : CREATE_MESH_ENTRY(1, 12 + (poly * 192) + 160, (x - (W/2)) * MAPSCALE#, HEIGHTMAP#(x,z), (z - (H/2)) * MAPSCALE#,   NORMALS#(x,z,0), NORMALS#(x,z,1), NORMALS#(x,z,2), USCALE#, VSCALE#)
         inc poly
      next j
   next i


   make mesh from memblock 1, 1
   if object exist(obj) = 1 then delete object obj
   make object obj, 1, img
   delete mesh 1
   delete memblock 1
endfunction




function CREATE_MESH_ENTRY(memblockNum, n, x#, y#, z#, nx#, ny#, nz#, u#, v#)
   write memblock float 1, n +  0, x#
   write memblock float 1, n +  4, y#
   write memblock float 1, n +  8, z#
   write memblock float 1, n + 12, nx#
   write memblock float 1, n + 16, ny#
   write memblock float 1, n + 20, nz#
   write memblock float 1, n + 24, u#
   write memblock float 1, n + 28, v#
endfunction




function CREATE_STATS_PANEL_TEMPLATE()
   `Create Stats Panel
   make memblock 99, STATS_IMG_SIZE
   write memblock dword 99, 0, STATS_IMG_W
   write memblock dword 99, 4, STATS_IMG_H
   write memblock dword 99, 8, 32
   for x = 0 to STATS_IMG_W - 1
      for y = 0 to STATS_IMG_H - 1
         if x > 3 AND x < 12 AND y > 3 AND y < 44
            write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, rgb(160, 160, 160) && STATS_IMG_TRANSPARENCY_MASK_B
         else
            write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, rgb(160, 160, 160) && STATS_IMG_TRANSPARENCY_MASK_A
         endif
      next y
   next x
   `TopLeft
   x = 0 : y = 0 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = 1 : y = 0 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = 0 : y = 1 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0

   `TopRight
   x = STATS_IMG_W-1 : y = 0 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = STATS_IMG_W-2 : y = 0 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = STATS_IMG_W-1 : y = 1 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0

   `BottomRight
   x = STATS_IMG_W-1 : y = STATS_IMG_H-1 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = STATS_IMG_W-2 : y = STATS_IMG_H-1 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = STATS_IMG_W-1 : y = STATS_IMG_H-2 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0

   `BottomLeft
   x = 0 : y = STATS_IMG_H-1 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = 1 : y = STATS_IMG_H-1 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
   x = 0 : y = STATS_IMG_H-2 : write memblock dword 99, 12 + ((y*STATS_IMG_W) + x)*4, 0
endfunction

`Rpg challenge by Ric

`display settings
if check display mode(1024,768,32)=1 then set display mode 1024,768,32
sync on
sync rate 30
hide mouse

global name$
titles()

`camera and light settings
autocam off
set camera range 0.01,10000
color backdrop 0
hide light 0
set ambient light 20
make light 1


`creat sounds

createsound("wave",1,6200,10000,2000,30,0.01,10,5,0,0,0.05)
createsound("foot steps",2,200,20,8000,.1,4.0,2.1,10,9.2,9.2,10)
createsound("ding",3,800,1000,6000,0,0.2,0.1,.5,1.2,0.2,10)
createsound("vibrato1",4,500,8000,8000,-0.0001,0.03,0.1,0.4,0,0,.1)
createsound("vibrato2",5,400,8000,8000,-0.0002,0.03,0.1,0.4,0,0,.1)
createsound("vibrato3",6,600,8000,8000,-0.0003,0.03,0.1,0.4,0,0,.1)



`set the randomize seed to the timer, so random events are different each time
randomize timer()

`set size of terrain
global matrixsize
matrixsize=100

`fog settings
fog on
fog color rgb(180,180,250)
fog distance matrixsize*0.6

`set initial value for object numbers
global object_seed
object_seed=1000000

`set initial value for image numbers
global image_seed
image_seed=1000000

create bitmap 1,screen width(),screen height()
set current bitmap 1

`function calls for creating world
global wallpaper
global light
make_wallpaper()
global internaldoor
global dim table(2000000)
global dim collisiondummy(2000000)
global room
make_room()


`position light for world illumination
position light 1,200,100,200
set light range 1,100000

global grassimage
create_grass()
global doortexture
make_door_texture()
global housetexture
make_house_texture()
global skyimage
create_sky()
global waterimage
global water
global water2
global theta#
create_water_image()
create_water()
global terrainimage
terraform()
global sphere1
global sphere2
global sphere3
create_skysphere()



`set house variables
global inroom
global numberofhouseentered
global number_of_houses
number_of_houses=rnd(20)+5
`set up an array to store house numbers
global dim house(number_of_houses)
global dim door(number_of_houses)
`make houses with numbers from 1 to max number of houses
for house_number=1 to number_of_houses
  make_house(house_number)
next house_number

global internaltowerdoor
global tower
global towerdoor
global key
global keyshaft
global navigator
make_tower()
make_tower_room()

`make dummy for camera to follow
make object cube 1,0.01
hide object 1
make object collision box 1,-0.05,-0.05,-0.05,0.05,0.05,0.05,0

global collision
global flying
global introover
global footsteptimer
global info
global unlocked
global blob

ink 0,0
set text size 20

set current bitmap 0

`set initial player position
position object 1,matrixsize/2,get ground height(1,50,50)+2,matrixsize/2

`set initial camera position before intro
position camera object position x(1),1.5,-100

global map
setup_navigator()

gosub beginning

loop sound 1



`****************************************

`main program loop
do

if returnkey()=1 then flying=1

`message subroutines
gosub display_message


`function calls for continuous events
if introover=0 then intro()
if introover=1 then move_camera()
if introover=1 then collision()
move_water()

if gotnavigator=1 then navigate()

`text 0,0,str$(screen fps())
`text 0,20,"house number: "+str$(numberofhouseentered)
`text 0,500,str$(table(tower))
sync
loop

`****************************************

`functions

function terraform

`set size of terrain
rows=60
columns=60

`create terrain
make matrix 1,matrixsize,matrixsize,columns,rows

`set mountain peaks
number_of_peaks=rnd(35)+10
max_height=15

dim peakx(number_of_peaks)
dim peakz(number_of_peaks)
dim height(number_of_peaks)
for peak=1 to number_of_peaks
  `set x,z coordinates for peak
  peakx(peak)=rnd(columns-10)+5
  peakz(peak)=rnd(rows-10)+5
  `set height of peak
  height(peak)=rnd(max_height)+10
  `create peak
  set matrix height 1,peakx(peak),peakz(peak),height(peak)
next peak

num=rows*columns
dim obnum(rows+1,columns+1)
dim v#(rows,columns)

`give each tile an x,z coordinate for use later
for x=1 to rows
for z=1 to columns
obnum(x,z)=ob
ob=ob+1
next z
next x

`texture matrix
prepare matrix texture 1,grassimage,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


`adjust height of points between peaks
elasticity#=0.3
damping#=0

for time=1 to 100

for peak=1 to number_of_peaks
  set matrix height 1,peakx(peak),peakz(peak),height(peak)
next peak

for x=1+1 to rows-1
for z=1+1 to columns-1
if x<rows
distxp1#=get matrix height(1,x+1,z)-get matrix height (1,x,z)
endif
if x>1
distxm1#=get matrix height(1,x-1,z)-get matrix height (1,x,z)
endif
if z<columns
distzp1#=get matrix height(1,x,z+1)-get matrix height (1,x,z)
endif
if z>1
distzm1#=get matrix height(1,x,z-1)-get matrix height (1,x,z)
endif
vectorsum#=distxp1#+distxm1#+distzp1#+distzm1#
a#=vectorsum#*elasticity#
v#(obnum(x,z))=v#(obnum(x,z))+a#
set matrix height 1,x,z,get matrix height(1,x,z)+v#(obnum(x,z))
v#(obnum(x,z))=v#(obnum(x,z))*damping#
next z
next x
update matrix 1
next time



endfunction




function check_free_object_number

`this handy function means that you never have to worry about
`remembering object numbers.  You just give them names you can remember,
`and this function will find the next available number to assosciate
`with that name.  Just call the function by, for example, writing:
`
`ball=check_free_object_number
`make object sphere ball,1

object=object_seed
repeat
inc object
until object exist(object)=0

endfunction object

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_grass

`make a shaded box
box 0,0,100,100,rgb(100,150,100),rgb(50,200,20),rgb(80,0,10),rgb(150,200,0)

`and speckle it with random dots
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      r=rnd(150)
      g=rnd(250)
      b=rnd(100)
      ink rgb(r,g,b),0
      dot x,y
    endif
  next x
next y


grassimage=check_free_image_number()
get image grassimage,0,0,100,100

endfunction

function create_skysphere

`get image for sphere by taking snapshot of terrain
terrainimage=check_free_image_number()
set camera fov 90
position camera matrixsize/2.0,3,-matrixsize*0.3
sync
get image terrainimage,0,0,screen width(),screen height()
set camera fov 60

`sphere 1 (mountains near) - just a sphere textured with the captured image
sphere1=check_free_object_number()
make object sphere sphere1,matrixsize*4
set object collision off sphere1
set object cull sphere1,0
texture object sphere1,terrainimage
set object texture sphere1,2,1
scale object texture sphere1,3,1
set object fog sphere1,0
set object light sphere1,0
set object transparency sphere1,4
position object sphere1,matrixsize/2,0,matrixsize/2

`sphere 2 (mountains far) - and another one further out. The inner sphere must be
`transparent, though, to see this one.
sphere2=check_free_object_number()
make object sphere sphere2,matrixsize*5
set object collision off sphere2
yrotate object sphere2,30
set object cull sphere2,0
texture object sphere2,terrainimage
set object texture sphere2,2,1
scale object texture sphere2,3,1
set object fog sphere2,0
set object transparency sphere2,4
ghost object on sphere2,4
set object emissive sphere2,rgb(180,150,250)
fade object sphere2,70
position object sphere2,matrixsize/2,0,matrixsize/2

`sphere 3 (sky) - a third, outer sphere for the sky
sphere3=check_free_object_number()
make object sphere sphere3,matrixsize*6
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,250),0
  line 0,n,250,n
next n

skyimage=check_free_image_number()
get image skyimage,0,0,250,250

endfunction


function create_water_image

`creates a shaded box
box 0,0,100,100,rgb(150,150,200),rgb(50,200,200),rgb(80,0,200),rgb(150,100,200)

`and speckles with white bits
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      r=(250)
      g=(250)
      b=(250)
      ink rgb(r,g,b),0
      dot x,y
    endif
  next x
next y


waterimage=check_free_image_number()
get image waterimage,0,0,100,100



endfunction


function create_water

`just 2 planes textured with the water image
`top layer
water=check_free_object_number()
make object plain water,matrixsize*8,matrixsize*8
set object collision off water
texture object water,waterimage
set object texture water,2,1
scale object texture water,8,8
xrotate object water,90
set object fog water,0
set object emissive water,rgb(220,220,200)
ghost object on water
set alpha mapping on water,20
`bottom layer
water2=check_free_object_number()
make object plain water2,matrixsize*8,matrixsize*8
set object collision off water2
texture object water2,waterimage
xrotate object water2,90
position object water2,0,1,0
set object texture water2,2,1
scale object texture water2,8,8
set object light water2,0
set object fog water2,0

endfunction

function move_water

`moves the texture along a bit
scroll object texture water,0.001,0
scroll object texture water2,-0.001,0
`and moves the water up and down according to a sine wave
position object water,0,0.5*sin(theta#)+3,0
inc theta#,1

`adjust wave volume according to height above water
volume#=600/(object position y(1)+1)
if volume#>100 then volume#=100
if volume#<80 then volume#=80
set sound volume 1,volume#

endfunction

function move_camera

walkmode=1
if shiftkey()=1 then walkmode=2
speed#=0
if upkey()=1 then speed#=0.05*walkmode
if downkey()=1 then speed#=-0.05
if rightkey()=1 then yrotate object 1,object angle y(1)+2
if leftkey()=1 then yrotate object 1,object angle y(1)-2
if inkey$()="a" then position object 1,object position x(1),object position y(1)+0.1,object position z(1)
if inkey$()="z" then position object 1,object position x(1),object position y(1)-0.11,object position z(1)

`reposition dummy object
position object 1,object position x(1)+speed#*sin(object angle y(1)),object position y(1),object position z(1)+speed#*cos(object angle y(1))

`set camera to dummy object's position and orientation
position camera object position x(1),object position y(1),object position z(1)
yrotate camera object angle y(1)

`play footstep sound
if object position y(1)>object position y(water)+0.4
  if speed#<>0 and footsteptimer=0 then play sound 2
  inc footsteptimer
  if  footsteptimer>20/walkmode then footsteptimer=0
endif

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 collision on house(house)
set object cull house(house),0
texture object house(house),housetexture
scale object texture house(house),20,40
roof=check_free_object_number()
make object box roof,1.98,1,1
color object roof,rgb(80,80,80)
position object roof,0,1,0
xrotate object roof,45
glue object to limb roof,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)
position object house(house),x,get ground height(1,x,z),z
until object position y (house(house))>3

`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(100,60,40),0
box 0,0,4,14
housetexture=check_free_image_number()
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=check_free_image_number()
get image doortexture,0,0,8,8,1

endfunction

function make_wallpaper

cls
ink rgb(185,205,255),0
box 0,0,100,100
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      ink rgb(rnd(200),rnd(200),rnd(200)),0
      dot x,y
    endif
  next y
next x

wallpaper=check_free_image_number()
get image wallpaper,0,0,100,100

endfunction

function make_room

wall1=check_free_object_number()
make object box wall1,20,10,0.1
position object wall1,0,1004.8,-5
texture object wall1,wallpaper
scale object texture wall1,10,10

wall2=check_free_object_number()
make object box wall2,20,10,0.1
position object wall2,0,1004.8,5
texture object wall2,wallpaper
scale object texture wall2,10,10

wall3=check_free_object_number()
make object box wall3,10,10,0.1
yrotate object wall3,90
position object wall3,-10,1004.8,0
texture object wall3,wallpaper
scale object texture wall3,10,10

wall4=check_free_object_number()
make object box wall4,10,10,0.1
yrotate object wall4,90
position object wall4,10,1004.8,0
texture object wall4,wallpaper
scale object texture wall4,10,10

floor=check_free_object_number()
make object box floor,20,10,0.1
xrotate object floor,90
position object floor,0,999.8,0
color object floor,rgb(200,10,20)

ceiling=check_free_object_number()
make object box ceiling,20,10,0.1
xrotate object ceiling,90
position object ceiling,0,1006,0

make light 2
position light 2,9,1004,4
set light range 2,15
lamp=check_free_object_number()
make object plain lamp,0.5,0.5
position object lamp,8.4,1004,3.4
yrotate object lamp,45
texture object lamp,light_image()
set object transparency lamp,5
lampshade=check_free_object_number()
make object cone lampshade,1
position object lampshade,8.4,1004,3.4
ghost object on lampshade,3
lampwire=check_free_object_number()
make object plain lampwire,0.02,4
yrotate object lampwire,45
position object lampwire,8.41,1006,3.41

make_table(room)
position object table(room),7,1002,3

entity=check_free_object_number()
make object cube entity,0.5
color object entity,rgb(0,250,50)
position object entity,7,1002.3,3

internaldoor=check_free_object_number()
make object plain internaldoor,2,4
position object internaldoor,0,1001.8,-4.89
color object internaldoor,rgb(220,20,50)

endfunction

function enter_house(number)
if unlocked=1
  inroom=1
  show light 2
  hide light 1
  hide light 3
  position object 1,0,1003,-4
  point object 1,0,1003,5
else
  play sound 3
  ink rgb(0,255,0),0
  text 0,20,"Door is locked"
  sync
  wait 1000
  ink 0,0
endif
endfunction

function exit_house()

position object 1,object position x(house(numberofhouseentered)),object position y(1),object position z(house(numberofhouseentered))
set object to object orientation 1,house(numberofhouseentered)
move object 1,-1
yrotate object 1,180
show light 1
inroom=0

endfunction

function light_image()


ink rgb(255,255,0),0
box 0,0,1,1
image=check_free_image_number()
get image image,0,0,1,1
cls
sphere1=check_free_object_number()
make object sphere sphere1,1,30,30
ghost object on sphere1
set object specular power sphere1,50
set object specular sphere1,rgb(200,200,200)
position light 1,0,-1,2
position object sphere1,0,0,3
texture object sphere1,image
a=int(screen width()/3.0)
b=int(screen height()/3.0)
c=int(screen width()*2/3.0)
d=int(screen height()*2/3.0)
sphere2=check_free_object_number()
make object sphere sphere2,0.3
position object sphere2,0,-0.2,3
ghost object on sphere2
sync
light=check_free_image_number()
get image light,a,b,c,d
delete object sphere1
delete object sphere2

endfunction light

function collision


collision=object collision(1,0)

`check collision with external doors
for number=1 to number_of_houses
  if collision=door(number)
    enter_house(number)
    numberofhouseentered=number
  endif
next number

if collision=collisiondummy(room) then info=3

if collision=towerdoor then enter_tower()

`check collision with internal door
if collision=internaldoor then exit_house()
if collision=internaltowerdoor then exit_tower()

`apply sliding collision
if collision>1
position object 1,object position x(1)-get object collision x(),object position y(1),object position z(1)-get object collision z()
endif

if collision=collisiondummy(tower)
  hide object key
  hide object keyshaft
  hide object navigator
  info=2
endif

`set dummy position to ground level
if inroom=0 and flying=0
  position object 1,object position x(1),get ground height(1,object position x(1),object position z(1))+0.2,object position z(1)
endif

`if in water, set dummy to water level and bob up and down
if object position y(1)<object position y(water)+0.2 then position object 1,object position x(1),object position y(water)+0.2+0.1*sin(theta#*5),object position z(1)


endfunction

function intro

`camera zoom effect
position camera object position x(1),curvevalue(object position y(1),camera position y(),80),curvevalue(object position z(1),camera position z(),80)
camy#=get ground height(1,camera position x(),camera position z())+0.2
if camy#<object position y(water)+0.2 then camy#=object position y(water)+0.2
position camera camera position x(),camy#,camera position z()
if camera position z()>object position z(1)-0.2
  introover=1:info=1
  position camera object position x(1),object position y(1),object position z(1)
endif

endfunction

`subroutine for setting character options etc.
beginning:
play sound 4:play sound 5:play sound 6
fog color 0
fadein#=0
repeat
fog color rgb(fadein#*0.01*180,fadein#*0.01*180,fadein#*0.01*250)
for object=water to sphere3
set alpha mapping on object,fadein#
next object
inc fadein#,0.5
sync
until fadein#=>100
wait 1000
play sound 3
repeat
text 0,20,"This is an automated message from the Blue Island Central Information System."
text 0,40,"Please enter your user name:"
if keydown=0
  letter$=inkey$()
  name$=name$+letter$
  if keystate(14)=1 then name$=left$(name$,len(name$)-2)
  keydown=1
endif
if inkey$()="" and keystate(14)=0 then keydown=0
text 0,80,name$
sync
until returnkey()=1

repeat
ink 0,0
text 0,20,"Greetings, "+name$+". You are being scanned. Please wait......"
ink rgb(0,255,0),0
line 0,y,screen width(),y
line 0,screen height()-y,screen width(),screen height()-y
inc y,4
sync
until y>=screen height()
ink 0,0
text 0,20,"You have been cleared for access."
text 0,40,"Press any key to transport to shore."
sync
wait key
return

function createsound(name$,soundnumber,frequency#,length#,loudness#,bend#,decay#,vibratospeed#,vibratodepth#,tremelospeed#,tremelodepth#,attack#)

outWord as word
dword1 as dword: dword2 as dword: dword3 as dword: dword4 as dword
dword5 as dword: dword6 as dword: dword7 as dword

samples=int((length#/1000)*44100)

if memblock exist(1) then delete memblock 1
make memblock 1,samples*2+28

` write 28 memblock header bytes
dword1=1      ` gg query: is this the number of channels?
dword2=2      ` gg query: is this the number of bytes per sample?
dword3=22050  ` gg query: seems to be half the number of samples per second - why?
dword4=88200  ` gg query: is this the number of bytes per second?
dword5=4      ` gg query: what does this represent?
dword6=16     ` gg query:     (ditto)            ?
dword7=0      ` gg query:     (ditto)            ?

position=0
write memblock dword 1, position, dword1 : inc position,4
write memblock dword 1, position, dword2 : inc position,4
write memblock dword 1, position, dword3 : inc position,4
write memblock dword 1, position, dword4 : inc position,4
write memblock dword 1, position, dword5 : inc position,4
write memblock dword 1, position, dword6 : inc position,4
write memblock dword 1, position, dword7 : inc position,4

rem generate and write wave
riseinloudness#=loudness#
for x=1 to samples
  outInteger=int(sin((x/122.5)*(frequency#+vibratodepth#*sin(theta#)))*(loudness#-fallinloudness#-riseinloudness#+tremelodepth#*sin(phi#)))*3.0
  if outInteger <-32767 then outInteger=-32767  ` gg query: is this the valid range?
  if outInteger>32767 then outInteger=32767     ` gg query:       (ditto)          ?
  outWord=outInteger
  inc theta#,vibratospeed#
  inc phi#,tremelospeed#
  dec frequency#,bend#

  if fallinloudness#<loudness#
    inc fallinloudness#,decay#
  endif

  if riseinloudness#>0
    dec riseinloudness#,attack#
  endif

  write memblock word 1, position, outWord : inc position,2
next x

if sound exist(soundnumber)=1 then delete sound soundnumber

make sound from memblock 999, 1 ` assumes you won't need sound number 999!
clone sound soundnumber, 999
delete sound 999

` memblock no longer required
delete memblock 1

endfunction

display_message:

if info=1
if dingplayed=0 then play sound 3:dingplayed=1
text 0,20,"Transport complete.  Please proceed to the Information Building (the tallest building on the island)"
text 0,40,"to receive further instructions.  Use arrowkeys to move."
inc messagetime
if messagetime>300 then info=0:messagetime=0:dingplayed=0
endif

if info=2
if dingplayed=0 then play sound 3:dingplayed=1:unlocked=1
text 0,20,"We're glad you finally made it, "+name$+".  Your task is to find the weapon, and"
text 0,40,"move it clear of the rising water.  Unfortunately, it's location is unknown."
text 0,60,"This key will enable you to unlock the doors of all buildings on the island."
text 0,80,"And you might find this electronic navigation system useful too."
text 0,100,"Get searching, "+name$+", and good luck."
inc messagetime
if messagetime>1000 then info=0:messagetime=0:dingplayed=0:gotnavigator=1
endif

if info=3
if dingplayed=0 then play sound 3:dingplayed=1:ink rgb(0,255,0),0
text 0,20,"Don't get too excited ......."
text 0,40,"That's as far as the storyline goes at the moment - "
text 0,60,"there's no actual bomb yet!  Feel free to keep roaming - why not go for a swim? ;)"
inc messagetime
if messagetime>1000 then info=0:messagetime=0:dingplayed=0

endif

return

function titles()

sync
set text font "arial"
set text size 60
ink rgb(120,120,250),0
text 300,50,"Blue Island"
set text size 20
text 200,200,"Attention:  Blue Island is in trouble."
text 200,220,"A massive tectonic shift has caused a surge in sea water, which"
text 200,240,"will almost completely submerge the island within 3 hours."
text 200,280,"All citizens have been evacuated, but one vital item remains"
text 200,300,"left on the island - a nuclear weapon.  Unfortunately, it is set"
text 200,320,"to detonate upon contact with water.  This would result in the "
text 200,340,"complete annihilation of Blue Island.  Your job is to make sure this"
text 200,360,"this doesn't happen."
text 200,400,"Press any key to continue"
sync
wait key
cls
text 0,20,"Please wait...."
sync

endfunction

function make_tower()

tower=check_free_object_number()
make object box tower,2,10,2
texture object tower,housetexture
set object cull tower,0
scale object texture tower,20,40
roof=check_free_object_number()
make object box roof,2.5,2,2.5
color object roof,rgb(80,80,80)
position object roof,0,5,0
glue object to limb roof,tower,0
spire=check_free_object_number()
make object cone spire,2
color object spire,rgb(80,80,80)
position object spire,0,6,0
glue object to limb spire,tower,0

towerdoor=check_free_object_number()
make object box towerdoor,0.2,0.4,0.02
texture object towerdoor,doortexture

repeat
x=rnd(matrixsize)
z=rnd(matrixsize)
position object tower,x,get ground height(1,x,z),z
until object position y(tower)>3
position object towerdoor,object position x(tower),get ground height(1,object position x(tower),object position z(tower)-0.991)+0.2,object position z(tower)-0.992
`yrotate object tower,rnd(360)

endfunction

function enter_tower

  inroom=1
  hide light 1
  hide light 2
  show light 3
  position object 1,0,2003,-4
  point object 1,0,2003,5

endfunction

function make_table(number)

table(number)=check_free_object_number()
make object box table(number),4,0.1,2
color object table(number),rgb(200,100,60)
leg1=check_free_object_number()
make object box leg1,0.1,2,0.1
position object leg1,-1.95,-1,-0.95
glue object to limb leg1,table(number),0
leg2=check_free_object_number()
make object box leg2,0.1,2,0.1
position object leg2,1.95,-1,-0.95
glue object to limb leg2,table(number),0
leg3=check_free_object_number()
make object box leg3,0.1,2,0.1
position object leg3,-1.95,-1,0.95
glue object to limb leg3,table(number),0
leg4=check_free_object_number()
make object box leg4,0.1,2,0.1
position object leg4,1.95,-1,0.95
glue object to limb leg4,table(number),0
collisiondummy(number)=check_free_object_number()
make object box collisiondummy(number),4,4,2
hide object collisiondummy(number)
glue object to limb collisiondummy(number),table(number),0

endfunction

function make_tower_room()

wall1=check_free_object_number()
make object box wall1,20,10,0.1
position object wall1,0,2004.8,-10
texture object wall1,wallpaper
scale object texture wall1,10,10

wall2=check_free_object_number()
make object box wall2,20,10,0.1
position object wall2,0,2004.8,10
texture object wall2,wallpaper
scale object texture wall2,10,10

wall3=check_free_object_number()
make object box wall3,20,10,0.1
yrotate object wall3,90
position object wall3,-10,2004.8,0
texture object wall3,wallpaper
scale object texture wall3,10,10

wall4=check_free_object_number()
make object box wall4,20,10,0.1
yrotate object wall4,90
position object wall4,10,2004.8,0
texture object wall4,wallpaper
scale object texture wall4,10,10

floor=check_free_object_number()
make object box floor,20,20,0.1
xrotate object floor,90
position object floor,0,1999.8,0
color object floor,rgb(100,10,200)

ceiling=check_free_object_number()
make object box ceiling,20,20,0.1
xrotate object ceiling,90
position object ceiling,0,2006,0

make_table(tower)
position object table(tower),0,2002,0

make light 3
position light 3,0,2004,-0.1
set light range 3,5
lamp=check_free_object_number()
make object plain lamp,0.5,0.5
position object lamp,0,2004,0
texture object lamp,light
set object transparency lamp,5
lampshade=check_free_object_number()
make object cone lampshade,1
position object lampshade,0,2004,0
ghost object on lampshade,3
lampwire=check_free_object_number()
make object plain lampwire,0.02,4
position object lampwire,0,2006,0.01

key=check_free_object_number()
make object sphere key,0.2
color object key,rgb(255,255,0)
position object key,0,2002.15,0
keyshaft=check_free_object_number()
make object box keyshaft,0.5,0.1,0.1
color object keyshaft,rgb(255,255,0)
position object keyshaft,0.25,2002.15,0
navigator=check_free_object_number()
make object box navigator,0.5,0.2,0.3
color object navigator,rgb(255,0,50)
position object navigator,-1,2002.15,0



internaltowerdoor=check_free_object_number()
make object plain internaltowerdoor,2,4
position object internaltowerdoor,0,2001.8,-9.89
color object internaltowerdoor,rgb(220,20,50)

endfunction

function exit_tower

position object 1,object position x(tower),object position y(1),object position z(tower)
set object to object orientation 1,tower
move object 1,-2
yrotate object 1,180
show light 1
inroom=0

endfunction

function setup_navigator

make camera 1
set camera fov 1,120
position camera 1,matrixsize/2.0,25,matrixsize/2.0
xrotate camera 1,90
mapimage=check_free_image_number()
set camera to image 1,mapimage,256,256
map=check_free_object_number()
make object plain map,1,1
texture object map,mapimage
position object map,2,-1.5,4
lock object on map
hide object map

endfunction

function navigate

show object map

endfunction

`Rpg challenge by Ric

`display settings
if check display mode(1024,768,32)=1 then set display mode 1024,768,32
sync on
sync rate 30
hide mouse

global name$
titles()

`camera and light settings
autocam off
set camera range 0.01,10000
color backdrop 0
hide light 0
set ambient light 20
make light 1


`creat sounds

createsound("wave",1,6200,10000,2000,30,0.01,10,5,0,0,0.05)
createsound("foot steps",2,200,20,8000,.1,4.0,2.1,10,9.2,9.2,10)
createsound("ding",3,800,1000,6000,0,0.2,0.1,.5,1.2,0.2,10)
createsound("vibrato1",4,500,8000,8000,-0.0001,0.03,0.1,0.4,0,0,.1)
createsound("vibrato2",5,400,8000,8000,-0.0002,0.03,0.1,0.4,0,0,.1)
createsound("vibrato3",6,600,8000,8000,-0.0003,0.03,0.1,0.4,0,0,.1)



`set the randomize seed to the timer, so random events are different each time
randomize timer()

`set size of terrain
global matrixsize
matrixsize=100

`fog settings
fog on
fog color rgb(180,180,250)
fog distance matrixsize*0.6

`set initial value for object numbers
global object_seed
object_seed=1000000

`set initial value for image numbers
global image_seed
image_seed=1000000

create bitmap 1,screen width(),screen height()
set current bitmap 1

`function calls for creating world
global wallpaper
global light
make_wallpaper()
global internaldoor
global dim table(2000000)
global dim collisiondummy(2000000)
global room
make_room()


`position light for world illumination
position light 1,200,100,200
set light range 1,100000

global grassimage
create_grass()
global doortexture
make_door_texture()
global housetexture
make_house_texture()
global skyimage
create_sky()
global waterimage
global water
global water2
global theta#
create_water_image()
create_water()
global terrainimage
terraform()
global sphere1
global sphere2
global sphere3
create_skysphere()



`set house variables
global inroom
global numberofhouseentered
global number_of_houses
number_of_houses=rnd(20)+5
`set up an array to store house numbers
global dim house(number_of_houses)
global dim door(number_of_houses)
`make houses with numbers from 1 to max number of houses
for house_number=1 to number_of_houses
  make_house(house_number)
next house_number

global internaltowerdoor
global tower
global towerdoor
global key
global keyshaft
global navigator
make_tower()
make_tower_room()

`make dummy for camera to follow
make object cube 1,0.01
hide object 1
make object collision box 1,-0.05,-0.05,-0.05,0.05,0.05,0.05,0

global collision
global flying
global introover
global footsteptimer
global info
global unlocked
global blob

ink 0,0
set text size 20

set current bitmap 0

`set initial player position
position object 1,matrixsize/2,get ground height(1,50,50)+2,matrixsize/2

`set initial camera position before intro
position camera object position x(1),1.5,-100

global map
global pointer
setup_navigator()

gosub beginning

loop sound 1



`****************************************

`main program loop
do

if returnkey()=1 then flying=1

`message subroutines
gosub display_message


`function calls for continuous events
if introover=0 then intro()
if introover=1 then move_camera()
if introover=1 then collision()
move_water()

if gotnavigator=1 then navigate()

`text 0,0,str$(screen fps())
`text 0,20,"house number: "+str$(numberofhouseentered)
`text 0,500,str$(table(tower))
sync
loop

`****************************************

`functions

function terraform

`set size of terrain
rows=60
columns=60

`create terrain
make matrix 1,matrixsize,matrixsize,columns,rows

`set mountain peaks
number_of_peaks=rnd(35)+10
max_height=15

dim peakx(number_of_peaks)
dim peakz(number_of_peaks)
dim height(number_of_peaks)
for peak=1 to number_of_peaks
  `set x,z coordinates for peak
  peakx(peak)=rnd(columns-10)+5
  peakz(peak)=rnd(rows-10)+5
  `set height of peak
  height(peak)=rnd(max_height)+10
  `create peak
  set matrix height 1,peakx(peak),peakz(peak),height(peak)
next peak

num=rows*columns
dim obnum(rows+1,columns+1)
dim v#(rows,columns)

`give each tile an x,z coordinate for use later
for x=1 to rows
for z=1 to columns
obnum(x,z)=ob
ob=ob+1
next z
next x

`texture matrix
prepare matrix texture 1,grassimage,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


`adjust height of points between peaks
elasticity#=0.3
damping#=0

for time=1 to 100

for peak=1 to number_of_peaks
  set matrix height 1,peakx(peak),peakz(peak),height(peak)
next peak

for x=1+1 to rows-1
for z=1+1 to columns-1
if x<rows
distxp1#=get matrix height(1,x+1,z)-get matrix height (1,x,z)
endif
if x>1
distxm1#=get matrix height(1,x-1,z)-get matrix height (1,x,z)
endif
if z<columns
distzp1#=get matrix height(1,x,z+1)-get matrix height (1,x,z)
endif
if z>1
distzm1#=get matrix height(1,x,z-1)-get matrix height (1,x,z)
endif
vectorsum#=distxp1#+distxm1#+distzp1#+distzm1#
a#=vectorsum#*elasticity#
v#(obnum(x,z))=v#(obnum(x,z))+a#
set matrix height 1,x,z,get matrix height(1,x,z)+v#(obnum(x,z))
v#(obnum(x,z))=v#(obnum(x,z))*damping#
next z
next x
update matrix 1
next time



endfunction




function check_free_object_number

`this handy function means that you never have to worry about
`remembering object numbers.  You just give them names you can remember,
`and this function will find the next available number to assosciate
`with that name.  Just call the function by, for example, writing:
`
`ball=check_free_object_number
`make object sphere ball,1

object=object_seed
repeat
inc object
until object exist(object)=0

endfunction object

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_grass

`make a shaded box
box 0,0,100,100,rgb(100,150,100),rgb(50,200,20),rgb(80,0,10),rgb(150,200,0)

`and speckle it with random dots
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      r=rnd(150)
      g=rnd(250)
      b=rnd(100)
      ink rgb(r,g,b),0
      dot x,y
    endif
  next x
next y


grassimage=check_free_image_number()
get image grassimage,0,0,100,100

endfunction

function create_skysphere

`get image for sphere by taking snapshot of terrain
terrainimage=check_free_image_number()
set camera fov 90
position camera matrixsize/2.0,3,-matrixsize*0.3
sync
get image terrainimage,0,0,screen width(),screen height()
set camera fov 60

`sphere 1 (mountains near) - just a sphere textured with the captured image
sphere1=check_free_object_number()
make object sphere sphere1,matrixsize*4
set object collision off sphere1
set object cull sphere1,0
texture object sphere1,terrainimage
set object texture sphere1,2,1
scale object texture sphere1,3,1
set object fog sphere1,0
set object light sphere1,0
set object transparency sphere1,4
position object sphere1,matrixsize/2,0,matrixsize/2

`sphere 2 (mountains far) - and another one further out. The inner sphere must be
`transparent, though, to see this one.
sphere2=check_free_object_number()
make object sphere sphere2,matrixsize*5
set object collision off sphere2
yrotate object sphere2,30
set object cull sphere2,0
texture object sphere2,terrainimage
set object texture sphere2,2,1
scale object texture sphere2,3,1
set object fog sphere2,0
set object transparency sphere2,4
ghost object on sphere2,4
set object emissive sphere2,rgb(180,150,250)
fade object sphere2,70
position object sphere2,matrixsize/2,0,matrixsize/2

`sphere 3 (sky) - a third, outer sphere for the sky
sphere3=check_free_object_number()
make object sphere sphere3,matrixsize*6
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,250),0
  line 0,n,250,n
next n

skyimage=check_free_image_number()
get image skyimage,0,0,250,250

endfunction


function create_water_image

`creates a shaded box
box 0,0,100,100,rgb(150,150,200),rgb(50,200,200),rgb(80,0,200),rgb(150,100,200)

`and speckles with white bits
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      r=(250)
      g=(250)
      b=(250)
      ink rgb(r,g,b),0
      dot x,y
    endif
  next x
next y


waterimage=check_free_image_number()
get image waterimage,0,0,100,100



endfunction


function create_water

`just 2 planes textured with the water image
`top layer
water=check_free_object_number()
make object plain water,matrixsize*8,matrixsize*8
set object collision off water
texture object water,waterimage
set object texture water,2,1
scale object texture water,8,8
xrotate object water,90
set object fog water,0
set object emissive water,rgb(220,220,200)
ghost object on water
set alpha mapping on water,20
`bottom layer
water2=check_free_object_number()
make object plain water2,matrixsize*8,matrixsize*8
set object collision off water2
texture object water2,waterimage
xrotate object water2,90
position object water2,0,1,0
set object texture water2,2,1
scale object texture water2,8,8
set object light water2,0
set object fog water2,0

endfunction

function move_water

`moves the texture along a bit
scroll object texture water,0.001,0
scroll object texture water2,-0.001,0
`and moves the water up and down according to a sine wave
position object water,0,0.5*sin(theta#)+3,0
inc theta#,1

`adjust wave volume according to height above water
volume#=600/(object position y(1)+1)
if volume#>100 then volume#=100
if volume#<80 then volume#=80
set sound volume 1,volume#

endfunction

function move_camera

walkmode=1
if shiftkey()=1 then walkmode=2
speed#=0
if upkey()=1 then speed#=0.05*walkmode
if downkey()=1 then speed#=-0.05
if rightkey()=1 then yrotate object 1,object angle y(1)+2
if leftkey()=1 then yrotate object 1,object angle y(1)-2
if inkey$()="a" then position object 1,object position x(1),object position y(1)+0.1,object position z(1)
if inkey$()="z" then position object 1,object position x(1),object position y(1)-0.11,object position z(1)

`reposition dummy object
position object 1,object position x(1)+speed#*sin(object angle y(1)),object position y(1),object position z(1)+speed#*cos(object angle y(1))

`set camera to dummy object's position and orientation
position camera object position x(1),object position y(1),object position z(1)
yrotate camera object angle y(1)

`play footstep sound
if object position y(1)>object position y(water)+0.4
  if speed#<>0 and footsteptimer=0 then play sound 2
  inc footsteptimer
  if  footsteptimer>20/walkmode then footsteptimer=0
endif

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 collision on house(house)
set object cull house(house),0
texture object house(house),housetexture
scale object texture house(house),20,40
roof=check_free_object_number()
make object box roof,1.98,1,1
color object roof,rgb(80,80,80)
position object roof,0,1,0
xrotate object roof,45
glue object to limb roof,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)
position object house(house),x,get ground height(1,x,z),z
until object position y (house(house))>3

`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(100,60,40),0
box 0,0,4,14
housetexture=check_free_image_number()
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=check_free_image_number()
get image doortexture,0,0,8,8,1

endfunction

function make_wallpaper

cls
ink rgb(185,205,255),0
box 0,0,100,100
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      ink rgb(rnd(200),rnd(200),rnd(200)),0
      dot x,y
    endif
  next y
next x

wallpaper=check_free_image_number()
get image wallpaper,0,0,100,100

endfunction

function make_room

wall1=check_free_object_number()
make object box wall1,20,10,0.1
position object wall1,0,1004.8,-5
texture object wall1,wallpaper
scale object texture wall1,10,10

wall2=check_free_object_number()
make object box wall2,20,10,0.1
position object wall2,0,1004.8,5
texture object wall2,wallpaper
scale object texture wall2,10,10

wall3=check_free_object_number()
make object box wall3,10,10,0.1
yrotate object wall3,90
position object wall3,-10,1004.8,0
texture object wall3,wallpaper
scale object texture wall3,10,10

wall4=check_free_object_number()
make object box wall4,10,10,0.1
yrotate object wall4,90
position object wall4,10,1004.8,0
texture object wall4,wallpaper
scale object texture wall4,10,10

floor=check_free_object_number()
make object box floor,20,10,0.1
xrotate object floor,90
position object floor,0,999.8,0
color object floor,rgb(200,10,20)

ceiling=check_free_object_number()
make object box ceiling,20,10,0.1
xrotate object ceiling,90
position object ceiling,0,1006,0

make light 2
position light 2,9,1004,4
set light range 2,15
lamp=check_free_object_number()
make object plain lamp,0.5,0.5
position object lamp,8.4,1004,3.4
yrotate object lamp,45
texture object lamp,light_image()
set object transparency lamp,5
lampshade=check_free_object_number()
make object cone lampshade,1
position object lampshade,8.4,1004,3.4
ghost object on lampshade,3
lampwire=check_free_object_number()
make object plain lampwire,0.02,4
yrotate object lampwire,45
position object lampwire,8.41,1006,3.41

make_table(room)
position object table(room),7,1002,3

entity=check_free_object_number()
make object cube entity,0.5
color object entity,rgb(0,250,50)
position object entity,7,1002.3,3

internaldoor=check_free_object_number()
make object plain internaldoor,2,4
position object internaldoor,0,1001.8,-4.89
color object internaldoor,rgb(220,20,50)

endfunction

function enter_house(number)
if unlocked=1
  inroom=1
  show light 2
  hide light 1
  hide light 3
  position object 1,0,1003,-4
  point object 1,0,1003,5
else
  play sound 3
  ink rgb(0,255,0),0
  text 0,20,"Door is locked"
  sync
  wait 1000
  ink 0,0
endif
endfunction

function exit_house()

position object 1,object position x(house(numberofhouseentered)),object position y(1),object position z(house(numberofhouseentered))
set object to object orientation 1,house(numberofhouseentered)
move object 1,-1
yrotate object 1,180
show light 1
inroom=0

endfunction

function light_image()


ink rgb(255,255,0),0
box 0,0,1,1
image=check_free_image_number()
get image image,0,0,1,1
cls
sphere1=check_free_object_number()
make object sphere sphere1,1,30,30
ghost object on sphere1
set object specular power sphere1,50
set object specular sphere1,rgb(200,200,200)
position light 1,0,-1,2
position object sphere1,0,0,3
texture object sphere1,image
a=int(screen width()/3.0)
b=int(screen height()/3.0)
c=int(screen width()*2/3.0)
d=int(screen height()*2/3.0)
sphere2=check_free_object_number()
make object sphere sphere2,0.3
position object sphere2,0,-0.2,3
ghost object on sphere2
sync
light=check_free_image_number()
get image light,a,b,c,d
delete object sphere1
delete object sphere2

endfunction light

function collision


collision=object collision(1,0)

`check collision with external doors
for number=1 to number_of_houses
  if collision=door(number)
    enter_house(number)
    numberofhouseentered=number
  endif
next number

if collision=collisiondummy(room) then info=3

if collision=towerdoor then enter_tower()

`check collision with internal door
if collision=internaldoor then exit_house()
if collision=internaltowerdoor then exit_tower()

`apply sliding collision
if collision>1
position object 1,object position x(1)-get object collision x(),object position y(1),object position z(1)-get object collision z()
endif

if collision=collisiondummy(tower)
  hide object key
  hide object keyshaft
  hide object navigator
  info=2
endif

`set dummy position to ground level
if inroom=0 and flying=0
  position object 1,object position x(1),get ground height(1,object position x(1),object position z(1))+0.2,object position z(1)
endif

`if in water, set dummy to water level and bob up and down
if object position y(1)<object position y(water)+0.2 then position object 1,object position x(1),object position y(water)+0.2+0.1*sin(theta#*5),object position z(1)


endfunction

function intro

`camera zoom effect
position camera object position x(1),curvevalue(object position y(1),camera position y(),80),curvevalue(object position z(1),camera position z(),80)
camy#=get ground height(1,camera position x(),camera position z())+0.2
if camy#<object position y(water)+0.2 then camy#=object position y(water)+0.2
position camera camera position x(),camy#,camera position z()
if camera position z()>object position z(1)-0.2
  introover=1:info=1
  position camera object position x(1),object position y(1),object position z(1)
endif

endfunction

`subroutine for setting character options etc.
beginning:
play sound 4:play sound 5:play sound 6
fog color 0
fadein#=0
repeat
fog color rgb(fadein#*0.01*180,fadein#*0.01*180,fadein#*0.01*250)
for object=water to sphere3
set alpha mapping on object,fadein#
next object
inc fadein#,0.5
sync
until fadein#=>100
wait 1000
play sound 3
repeat
text 0,20,"This is an automated message from the Blue Island Central Information System."
text 0,40,"Please enter your user name:"
if keydown=0
  letter$=inkey$()
  name$=name$+letter$
  if keystate(14)=1 then name$=left$(name$,len(name$)-2)
  keydown=1
endif
if inkey$()="" and keystate(14)=0 then keydown=0
text 0,80,name$
sync
until returnkey()=1

repeat
ink 0,0
text 0,20,"Greetings, "+name$+". You are being scanned. Please wait......"
ink rgb(0,255,0),0
line 0,y,screen width(),y
line 0,screen height()-y,screen width(),screen height()-y
inc y,4
sync
until y>=screen height()
ink 0,0
text 0,20,"You have been cleared for access."
text 0,40,"Press any key to transport to shore."
sync
wait key
return

function createsound(name$,soundnumber,frequency#,length#,loudness#,bend#,decay#,vibratospeed#,vibratodepth#,tremelospeed#,tremelodepth#,attack#)

outWord as word
dword1 as dword: dword2 as dword: dword3 as dword: dword4 as dword
dword5 as dword: dword6 as dword: dword7 as dword

samples=int((length#/1000)*44100)

if memblock exist(1) then delete memblock 1
make memblock 1,samples*2+28

` write 28 memblock header bytes
dword1=1      ` gg query: is this the number of channels?
dword2=2      ` gg query: is this the number of bytes per sample?
dword3=22050  ` gg query: seems to be half the number of samples per second - why?
dword4=88200  ` gg query: is this the number of bytes per second?
dword5=4      ` gg query: what does this represent?
dword6=16     ` gg query:     (ditto)            ?
dword7=0      ` gg query:     (ditto)            ?

position=0
write memblock dword 1, position, dword1 : inc position,4
write memblock dword 1, position, dword2 : inc position,4
write memblock dword 1, position, dword3 : inc position,4
write memblock dword 1, position, dword4 : inc position,4
write memblock dword 1, position, dword5 : inc position,4
write memblock dword 1, position, dword6 : inc position,4
write memblock dword 1, position, dword7 : inc position,4

rem generate and write wave
riseinloudness#=loudness#
for x=1 to samples
  outInteger=int(sin((x/122.5)*(frequency#+vibratodepth#*sin(theta#)))*(loudness#-fallinloudness#-riseinloudness#+tremelodepth#*sin(phi#)))*3.0
  if outInteger <-32767 then outInteger=-32767  ` gg query: is this the valid range?
  if outInteger>32767 then outInteger=32767     ` gg query:       (ditto)          ?
  outWord=outInteger
  inc theta#,vibratospeed#
  inc phi#,tremelospeed#
  dec frequency#,bend#

  if fallinloudness#<loudness#
    inc fallinloudness#,decay#
  endif

  if riseinloudness#>0
    dec riseinloudness#,attack#
  endif

  write memblock word 1, position, outWord : inc position,2
next x

if sound exist(soundnumber)=1 then delete sound soundnumber

make sound from memblock 999, 1 ` assumes you won't need sound number 999!
clone sound soundnumber, 999
delete sound 999

` memblock no longer required
delete memblock 1

endfunction

display_message:

if info=1
if dingplayed=0 then play sound 3:dingplayed=1
text 0,20,"Transport complete.  Please proceed to the Information Building (the tallest building on the island)"
text 0,40,"to receive further instructions.  Use arrowkeys to move."
inc messagetime
if messagetime>300 then info=0:messagetime=0:dingplayed=0
endif

if info=2
if dingplayed=0 then play sound 3:dingplayed=1:unlocked=1:gotnavigator=1
text 0,20,"We're glad you finally made it, "+name$+".  Your task is to find the weapon, and"
text 0,40,"move it clear of the rising water.  Unfortunately, it's location is unknown."
text 0,60,"This key will enable you to unlock the doors of all buildings on the island."
text 0,80,"And you might find this electronic navigation system useful too."
text 0,100,"Get searching, "+name$+", and good luck."
inc messagetime
if messagetime>1000 then info=0:messagetime=0:dingplayed=0
endif

if info=3
if dingplayed=0 then play sound 3:dingplayed=1:ink rgb(0,255,0),0
text 0,20,"Don't get too excited ......."
text 0,40,"That's as far as the storyline goes at the moment - "
text 0,60,"there's no actual bomb yet!  Feel free to keep roaming - why not go for a swim? ;)"
inc messagetime
if messagetime>1000 then info=0:messagetime=0:dingplayed=0

endif

return

function titles()

sync
set text font "arial"
set text size 60
ink rgb(120,120,250),0
text 300,50,"Blue Island"
set text size 20
text 200,200,"Attention:  Blue Island is in trouble."
text 200,220,"A massive tectonic shift has caused a surge in sea water, which"
text 200,240,"will almost completely submerge the island within 3 hours."
text 200,280,"All citizens have been evacuated, but one vital item remains"
text 200,300,"left on the island - a nuclear weapon.  Unfortunately, it is set"
text 200,320,"to detonate upon contact with water.  This would result in the "
text 200,340,"complete annihilation of Blue Island.  Your job is to make sure this"
text 200,360,"this doesn't happen."
text 200,400,"Press any key to continue"
sync
wait key
cls
text 0,20,"Please wait...."
sync

endfunction

function make_tower()

tower=check_free_object_number()
make object box tower,2,10,2
texture object tower,housetexture
set object cull tower,0
scale object texture tower,20,40
roof=check_free_object_number()
make object box roof,2.5,2,2.5
color object roof,rgb(80,80,80)
position object roof,0,5,0
glue object to limb roof,tower,0
spire=check_free_object_number()
make object cone spire,2
color object spire,rgb(80,80,80)
position object spire,0,6,0
glue object to limb spire,tower,0

towerdoor=check_free_object_number()
make object box towerdoor,0.2,0.4,0.02
texture object towerdoor,doortexture

repeat
x=rnd(matrixsize)
z=rnd(matrixsize)
position object tower,x,get ground height(1,x,z),z
until object position y(tower)>3
position object towerdoor,object position x(tower),get ground height(1,object position x(tower),object position z(tower)-0.991)+0.2,object position z(tower)-0.992
`yrotate object tower,rnd(360)

endfunction

function enter_tower

  inroom=1
  hide light 1
  hide light 2
  show light 3
  position object 1,0,2003,-4
  point object 1,0,2003,5

endfunction

function make_table(number)

table(number)=check_free_object_number()
make object box table(number),4,0.1,2
color object table(number),rgb(200,100,60)
leg1=check_free_object_number()
make object box leg1,0.1,2,0.1
position object leg1,-1.95,-1,-0.95
glue object to limb leg1,table(number),0
leg2=check_free_object_number()
make object box leg2,0.1,2,0.1
position object leg2,1.95,-1,-0.95
glue object to limb leg2,table(number),0
leg3=check_free_object_number()
make object box leg3,0.1,2,0.1
position object leg3,-1.95,-1,0.95
glue object to limb leg3,table(number),0
leg4=check_free_object_number()
make object box leg4,0.1,2,0.1
position object leg4,1.95,-1,0.95
glue object to limb leg4,table(number),0
collisiondummy(number)=check_free_object_number()
make object box collisiondummy(number),4,4,2
hide object collisiondummy(number)
glue object to limb collisiondummy(number),table(number),0

endfunction

function make_tower_room()

wall1=check_free_object_number()
make object box wall1,20,10,0.1
position object wall1,0,2004.8,-10
texture object wall1,wallpaper
scale object texture wall1,10,10

wall2=check_free_object_number()
make object box wall2,20,10,0.1
position object wall2,0,2004.8,10
texture object wall2,wallpaper
scale object texture wall2,10,10

wall3=check_free_object_number()
make object box wall3,20,10,0.1
yrotate object wall3,90
position object wall3,-10,2004.8,0
texture object wall3,wallpaper
scale object texture wall3,10,10

wall4=check_free_object_number()
make object box wall4,20,10,0.1
yrotate object wall4,90
position object wall4,10,2004.8,0
texture object wall4,wallpaper
scale object texture wall4,10,10

floor=check_free_object_number()
make object box floor,20,20,0.1
xrotate object floor,90
position object floor,0,1999.8,0
color object floor,rgb(100,10,200)

ceiling=check_free_object_number()
make object box ceiling,20,20,0.1
xrotate object ceiling,90
position object ceiling,0,2006,0

make_table(tower)
position object table(tower),0,2002,0

make light 3
position light 3,0,2004,-0.1
set light range 3,5
lamp=check_free_object_number()
make object plain lamp,0.5,0.5
position object lamp,0,2004,0
texture object lamp,light
set object transparency lamp,5
lampshade=check_free_object_number()
make object cone lampshade,1
position object lampshade,0,2004,0
ghost object on lampshade,3
lampwire=check_free_object_number()
make object plain lampwire,0.02,4
position object lampwire,0,2006,0.01

key=check_free_object_number()
make object sphere key,0.2
color object key,rgb(255,255,0)
position object key,0,2002.15,0
keyshaft=check_free_object_number()
make object box keyshaft,0.5,0.1,0.1
color object keyshaft,rgb(255,255,0)
position object keyshaft,0.25,2002.15,0
navigator=check_free_object_number()
make object box navigator,0.5,0.2,0.3
color object navigator,rgb(255,0,50)
position object navigator,-1,2002.15,0



internaltowerdoor=check_free_object_number()
make object plain internaltowerdoor,2,4
position object internaltowerdoor,0,2001.8,-9.89
color object internaltowerdoor,rgb(220,20,50)

endfunction

function exit_tower

position object 1,object position x(tower),object position y(1),object position z(tower)
set object to object orientation 1,tower
move object 1,-2
yrotate object 1,180
show light 1
inroom=0

endfunction

function setup_navigator


fog off
set ambient light 80
set current bitmap 1
cls
cx#=camera position x()
cy#=camera position y()
cz#=camera position z()
position camera matrixsize/2.0,100,matrixsize/2.0
xrotate camera 90
mapimage=check_free_image_number()
sync
get image mapimage,0,0,screen width(),screen height(),1
set current bitmap 0
xrotate camera 0
position camera cx#,cy#,cz#
map=check_free_object_number()
make object plain map,1,1
texture object map,mapimage
position object map,2,-1.5,4
set object light map,0
lock object on map
hide object map
fog on
fog color rgb(180,180,250)
fog distance matrixsize*0.6
set ambient light 20

pointer=check_free_object_number()
make object cone pointer,0.05
color object pointer,rgb(255,0,0)
position object pointer,2,-1.5,3.9
set object emissive pointer,rgb(250,0,0)
lock object on pointer
hide object pointer

endfunction

function navigate

show object pointer
show object map
if inroom=0
  position object pointer,1.95+(object position x(1)-matrixsize/2.0)/matrixsize*0.55,-1.5+(object position z(1)-matrixsize/2.0)/matrixsize*1.1,3.9
  zrotate object pointer,-object angle y(1)
endif

endfunction