Sorry your browser is not supported!

Gosub INIT_VariablesAndDatastructures

gosub INIT_3DEnvironment

Rem Project: 007Terrain
Rem Created: 23/05/2006 01:02:57

Rem ***** Main Source File *****

Gosub INIT_VariablesAndDatastructures

gosub INIT_3DEnvironment

CreateMain()
CreateAllButtons()

rem **************************************************

set current bitmap 0
Action = -1

do
    paste image 1,0,0,1
    DrawButtons()

    if mouseclick()=1 and MouseClicked=0

        Action=CheckForButtonPress()
        ClearButtons( Action )

    endif

    MouseClicked=mouseclick()

    if Action=0

        if matrix exist(1) then delete matrix 1

        set cursor 34,260
        input "Segments: ", numseg
        set cursor 34,280
        input "Segment Size: ", segsize

        totsize# = numseg*segsize
        make matrix 1,totsize#,totsize#,numseg,numseg
        position matrix 1, -(totsize#/2),0,-(totsize#/2)

        position camera -(totsize#/2),100,-(totsize#/2)



        gosub MOVE_UpdateCamera

        Action = -1
        ClearButtons( Action )

    endif

    if Action=3 and CamControl=0

        hide mouse

        CamControl = 1

    endif

    if CamControl = 1

        gosub MOVE_GetPlayerInput
        gosub MOVE_UpdateCamera

        if mouseclick()=2
            show mouse
            CamControl=0
            Action=-1
            ClearButtons( Action )
        endif

    endif

    ink rgb(40,40,60),0
    text 200,36,"FPS: " + str$(screen fps())

    sync

loop

rem **************************************************

MOVE_GetPlayerInput:

    PD(0).Pitch# = mousemovey()
    PD(0).Yaw# = mousemovex()

    PD(0).Speed# = (keystate(17) - keystate(31))
    PD(0).Slide# = (keystate(32) - keystate(30))

return

rem **************************************************

MOVE_UpdateCamera:

    inc PD(0).XAng#, PD(0).Pitch#
    inc PD(0).YAng#, PD(0).Yaw#

    if PD(0).Slide# <>0

        SlideAng# = wrapvalue( PD(0).YAng# + ( PD(0).Slide# * 90 ) )

        Slidex# = newxvalue( PD(0).XPos#, SlideAng#, 0.1 )
        Slidez# = newzvalue( PD(0).ZPos#, SlideAng#, 0.1 )

        position camera Slidex#, PD(0).YPos#, Slidez#

    endif

    rotate camera PD(0).XAng#, PD(0).YAng#, PD(0).ZAng#
    move camera PD(0).Speed#*0.1

    PD(0).Xpos# = camera position x()
    PD(0).Ypos# = camera position y()
    PD(0).Zpos# = camera position z()

return

rem **************************************************

function CreateButton( BI, Image, State, BackColour, TextColour )

    if bitmap exist(2) then delete bitmap 2

    create bitmap 2,Buttons(BI).Width, Buttons(BI).Height
    cls BackColour

    set text font "Arial"
    set text to bold
    set text size 14

    x#=(Buttons(BI).Width)/2
    y#=((Buttons(BI).Height)/2) - (text height(Buttons(BI).Action$)/2)

    ink 0,0
    center text x#, y#, Buttons(BI).Action$

    blur bitmap 2,6

    if state = 0
        ink rgb(255,255,255),0
    else
        ink 0,0
    endif

    line 0,0,0,Buttons(BI).Height
    line 0,0,Buttons(BI).Width,0

    if state = 0
        ink 0,0
    else
        ink rgb(255,255,255),0
    endif

    line Buttons(BI).Width-2,Buttons(BI).Height-2, Buttons(BI).Width-2,0
    line Buttons(BI).Width-2,Buttons(BI).Height-2, 0,Buttons(BI).Height-2

    ink 0,0
    center text x#, y#, Buttons(BI).Action$

    blur bitmap 2,6

    ink TextColour,0
    center text x#, y#, Buttons(BI).Action$

    get image Image, 0, 0, Buttons(BI).Width, Buttons(BI).Height
    delete bitmap 2

endfunction Image

function CreateMain()

    create bitmap 1,1024,768

    cls rgb(100,100,100)

    ink rgb(1,1,1),0
    box 3,3,1021,765

    ink rgb(100,150,100),0
    box 4,4,1020,764

    ink rgb(1,1,1),0
    box 192,32,992,736

    ink 0,0
    box 194,34,990,734

    get image 1,0,0,1024,768
    delete bitmap 1

endfunction

function CreateAllButtons()

    restore ButtonData
    for l=0 to 5

        Buttons(l).State=-1

        read Buttons(l).Action$
        read Buttons(l).Xpos
        read Buttons(l).Ypos
        read Buttons(l).Width
        read Buttons(l).Height

        Buttons(l).ImageOff = CreateButton( l, (l*2)+2, 0, rgb( 100,50,50), rgb(255,255,0) )
        Buttons(l).ImageOn = CreateButton( l, (l*2)+3, 1, rgb( 100,50,50), rgb(255,255,0) )

    next l

endfunction

function CheckForButtonPress()

    ButtonPressed = -1

    for l=0 to 5

        xmin=Buttons(l).XPos
        ymin=Buttons(l).YPos
        xmax=Buttons(l).XPos+Buttons(l).Width
        ymax=Buttons(l).YPos+Buttons(l).Height

        if mousex() >= xmin and mousex() <= xmax and mousey() >= ymin and mousey() <= ymax

           Buttons(l).State = Buttons(l).State * -1
           ButtonPressed = l

        endif

    next l

endfunction ButtonPressed

function ClearButtons( Selected )

        for l = 0 to 5

            if l <> Selected then Buttons(l).State = -1

        next l

endfunction

function DrawButtons()

    for l=0 to 5

        if Buttons(l).State = 1

            img = Buttons(l).ImageOn

        else

            img = Buttons(l).ImageOff

        endif

        paste image img, Buttons(l).Xpos, Buttons(l).Ypos

    next l

endfunction

Rem *** Include File: Env.dba ***
Rem Created: 23/05/2006 01:06:08

Rem Included in Project: C:\Program Files\Dark Basic Software\Dark Basic Professional\Projects\007Terrain\007Terrain.dbpro

INIT_VariablesAndDatastructures:

    type Player_Data

        XPos#
        YPos#
        ZPos#

        XAng#
        YAng#
        ZAng#

        Pitch#
        Yaw#
        Roll#

        Slide#
        Speed#

    endtype

    dim PD(0) as Player_Data

    type Button

        State
        Action$
        XPos
        YPos
        Width
        Height
        ImageOff
        ImageOn


    endtype

    dim Buttons(5) as Button

return

rem **************************************************

INIT_3DEnvironment:

    set display mode 1024,768,32

    autocam off

    sync on
    sync rate 0

    set camera view 192,32,992,736

    set ambient light 15

    fog on
    fog color 100,100,200
    fog distance 2000

    backdrop on
    color backdrop rgb(100,100,125)

return

rem **************************************************

rem **************************************************

ButtonData:
data "NEW",34,32,128,32
data "LOAD",34,72,128,32
data "SAVE",34,112,128,32
data "CAMERA", 34,172,128,32
data "HEIGHT",34,212,128,32
data "TEXTURE",34,252,128,32

REM Project: Compo entry
REM Created: 24/05/2006 19:33:22
REM
REM ***** Main Source File *****
save=0

REM
input "Filename: ", file$
Cls
text 10, 10, "Map: "+file$
make matrix 1, 1000, 1000, 100, 100
SET MATRIX WIREFRAME ON 1
do
if mouseclick()=1 then input "X segment: ", X$
if mouseclick()=2 then input "Z segment: ", Z$
if controlkey()=1 then input "Height: ", Height$
SET MATRIX HEIGHT 1, val(X$), val(Z$), val(Height$)
update matrix 1
if spacekey()=1 then Matrix_to_object(1, 1, 1000, 1000, 100, 100, 100, 100, 100, 100, 0, 0) : save object file$+".dbo", 1 : inc save, 1
if save=1 and object exist(1) then Text 10, 10, "Save failed"
control camera using arrowkeys 0, 1, 1
loop

     `convert a matrix to an object
function Matrix_to_Object( object, matrixnum, matxsize#, matzsize#, matxsegs, matzsegs, tilex, tilez, limbx, limbz, begtexnum, endtexnum )
   `safety in case matxsegs and matzsegs is not evenly divisible by tilex and tilez
   if matxsegs mod tilex > 0
      EXIT PROMPT "Number of matrix xsegs not evenly divisible by tilex", "Texture tilex error"
      end
   endif
   if matzsegs mod tilez > 0
      EXIT PROMPT "Number of matrix zsegs not evenly divisible by tilez", "Texture tilez error"
      end
   endif
   `safety in case limbx and limbz is smaller than the texture x and z
   a = 0
   if limbx < tilex then limbx = tilex : a = 1
   if limbz < tilez then limbz = tilez : a = 1
   if a > 0
      sync
      print "limbx or limbz was less than tilex or tilez : Error corrected"
      sync
      wait key
   endif

   `calc the number of polys in the matrix
   num_mat_polys = (matxsegs*matzsegs)*2
   `make array to store vert info
   `storage indexs = poly number, vert number, x/y/z vert pos/norm/uv
   `polys are numbered starting from left to right, front to
   `back, one row at a time (with 2 polys per tile)
   dim vert_store#(num_mat_polys,2,7)

   `calc the width and depth of each tile on the matrix
   `formula size#/number
   mat_x_wide# = matxsize#/matxsegs
   mat_z_deep# = matzsize#/matzsegs


`******************************************************************************
   `get vert position data
   `placeholder variable for poly numbers
   a = 1
   `one row at a time (front to back)
   for j = 0 to matzsegs - 1
      `one tile at a time (left to right)
      for i = 0 to matxsegs - 1

         `tile top left poly info

         `bottom left vert (x,y,z)
         vert_store#(a,0,0) = i*mat_x_wide#
         vert_store#(a,0,1) = GET MATRIX HEIGHT(matrixnum, i, j)
         vert_store#(a,0,2) = j*mat_z_deep#
         `top left vert (x,y,z)
         vert_store#(a,1,0) = i*mat_x_wide#
         vert_store#(a,1,1) = GET MATRIX HEIGHT(matrixnum, i, j+1)
         vert_store#(a,1,2) = (j+1)*mat_z_deep#
         `top right vert (x,y,z)
         vert_store#(a,2,0) = (i+1)*mat_x_wide#
         vert_store#(a,2,1) = GET MATRIX HEIGHT(matrixnum, i+1, j+1)
         vert_store#(a,2,2) = (j+1)*mat_z_deep#
         inc a, 1

         `tile bottom right poly info

         `bottom left vert (x,y,z)
         vert_store#(a,0,0) = i*mat_x_wide#
         vert_store#(a,0,1) = GET MATRIX HEIGHT(matrixnum, i, j)
         vert_store#(a,0,2) = j*mat_z_deep#
         `top right vert (x,y,z)
         vert_store#(a,1,0) = (i+1)*mat_x_wide#
         vert_store#(a,1,1) = GET MATRIX HEIGHT(matrixnum, i+1, j+1)
         vert_store#(a,1,2) = (j+1)*mat_z_deep#
         `bottom right vert (x,y,z)
         vert_store#(a,2,0) = (i+1)*mat_x_wide#
         vert_store#(a,2,1) = GET MATRIX HEIGHT(matrixnum, i+1, j)
         vert_store#(a,2,2) = j*mat_z_deep#
         inc a, 1
      next i
   next j
`******************************************************************************


`******************************************************************************
   `calc normals for polys
   `Thanks to ADR for posting this code on the DBP forums :)
   for i = 1 to num_mat_polys
      `acuire vert positions
      P1X# = vert_store#(i,0,0)
      P1Y# = vert_store#(i,0,1)
      P1Z# = vert_store#(i,0,2)
      P2X# = vert_store#(i,1,0)
      P2Y# = vert_store#(i,1,1)
      P2Z# = vert_store#(i,1,2)
      P3X# = vert_store#(i,2,0)
      P3Y# = vert_store#(i,2,1)
      P3Z# = vert_store#(i,2,2)

      null = make vector3(1)
      null = make vector3(2)
      null = make vector3(3)

      ` -- calculate the two directional vectors for the adj and opp edges...
      set vector3 1, P1X#, P1Y#, P1Z#
      set vector3 2, P2X#, P2Y#, P2Z#
      set vector3 3, P3X#, P3Y#, P3Z#
      subtract vector3 2, 2, 1
      subtract vector3 3, 3, 1   ` -- vector 3 and 1 are now directional vectors
      normalize vector3 2,2      ` -- normalize em
      normalize vector3 3,3
      cross product vector3 1, 2,3  ` -- use the origin vector (1) to store the face normal
      normalize vector3 1,1

      `save normals (all 3 verts have same normals)
      vert_store#(i,0,3) = x vector3(1)
      vert_store#(i,0,4) = y vector3(1)
      vert_store#(i,0,5) = z vector3(1)
      vert_store#(i,1,3) = vert_store#(i,0,3)
      vert_store#(i,1,4) = vert_store#(i,0,4)
      vert_store#(i,1,5) = vert_store#(i,0,5)
      vert_store#(i,2,3) = vert_store#(i,0,3)
      vert_store#(i,2,4) = vert_store#(i,0,4)
      vert_store#(i,2,5) = vert_store#(i,0,5)

      null = delete vector3(1)
      null = delete vector3(2)
      null = delete vector3(3)
   next i
`******************************************************************************


`******************************************************************************
   `calc UV data for polys

   `save current x tile number
   xtiles = 1
   `save current z tile number
   ztiles = 1
   `calc how much to step each u data per tile
   stepu# = (1.0/tilex)
   `calc how much to step each v data per tile
   stepv# = (1.0/tilez)
   `set base u data for new set of tiles
   baseu# = 0
   `set base v data for new set of tiles
   basev# = 1-stepv#
   `poly number placeholder variable
   i = 1
   `from front to back
   for k = 1 to matzsegs
      `reset the number of x tiles to 1 and the u base to 0
      `at the beginning of each row
      xtiles = 1
      baseu# = 0
      `from left to right
      for l = 1 to matxsegs
         `2 polys per tile
         for m = 1 to 2
            `write all 3 verts of each matrix poly
            for j = 0 to 2
               `select which formula to apply depending on polygon side
               `and vert number (0 to 2)
               `j selects the vert number
               `m selects the polygon side (back/left or front right : 1 or 2)
               select j
                  case 0
                     if m = 1
                        testu# = baseu#
                        testv# = basev#+stepv#
                     else
                        testu# = baseu#
                        testv# = basev#+stepv#
                     endif
                  endcase
                  case 1
                     if m = 1
                        testu# = baseu#
                        testv# = basev#
                     else
                        testu# = baseu#+stepu#
                        testv# = basev#
                     endif
                  endcase
                  case 2
                     if m = 1
                        testu# = baseu#+stepu#
                        testv# = basev#
                     else
                        testu# = baseu#+stepu#
                        testv# = basev#+stepv#
                     endif
                  endcase
               endselect
               `store calculated data for each vert of each poly
               `u data
               vert_store#(i,j,6) = testu#
               `v data
               vert_store#(i,j,7) = testv#
            next j
            inc i, 1
         `next polygon side of this tile
         next m
         `update u data and xtiles place holder
         inc baseu#, stepu#
         inc xtiles, 1
         `reset data when texture tile width has been reached
         if xtiles > tilex
            baseu# = 0
            xtiles = 1
         endif
      `next x tile
      next l
      `update v data and ztiles place holder
      dec basev#, stepv#
      inc ztiles, 1
      `reset data when texture depth has been reached
      if ztiles > tilez
         basev# = 1-stepv#
         ztiles = 1
      endif
   `next z tile
   next k
`******************************************************************************


`******************************************************************************
   `make object from matrix verts

   `calc number of memblocks needed
   tempx = matxsegs/limbx
   tempz = matzsegs/limbz
   tempmem = tempx * tempz
   `make arrays to store memblock positions and memblock numbers
   dim membhold(tempx, tempz)
   dim mempos(tempmem)
   `enter memblock numbers for each texture tile based on the x and z limbs to use
   a = 1
   for i = 1 to tempz
      for j = 1 to tempx
         membhold(j, i) = a
         inc a, 1
      next j
   next i
   `calc the memblock size
   `formula is 12 byte header + ((( 32 bytes per vert * limb x segs)*(limb z segs * 2 polys))* 3 verts per poly)
   mat_mem_size = 12+(((32*limbx)*(limbz*2))*3)
   `make memblocks and write headers for each memblock and set the beginning
   `position for vert data to 12
   for i = 1 to tempmem
      make memblock i, mat_mem_size
      `write objects fvf format as 274
      write memblock dword i, 0, 274
      `write bytes per vert as 32 (8 floats xpos#,ypos#,zpos#,xnorm#,ynorm#,znorm#,u#,v#)
      write memblock dword i, 4, 32
      `write number of verts in matrix (polys*3)
      write memblock dword i, 8, ((limbx*limbz)*2)*3
      `set beginning position for vert data after header(0-8)+4 = 12
      mempos(i) = 12
   next i

   `image tile, row, and memblock placeholders
   xtile = 1
   ztile = 1
   xrow = 1
   xmem = 1
   zmem = 1
   `polygon placeholders (b=2 is 1 tile complete)
   b = 1
   `enter all polys' verts to memblock
   for i = 1 to num_mat_polys
      `select memblock number to write to use current x and z limb tile to pick
      tempmemnum = membhold(xmem, zmem)
      `write all 3 verts of each matrix poly
      for j = 0 to 2
         `xpos
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,0)
         `increment the current memblock position
         inc mempos(tempmemnum), 4
         `ypos
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,1)
         inc mempos(tempmemnum), 4
         `zpos
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,2)
         inc mempos(tempmemnum), 4
         `xnorm
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,3)
         inc mempos(tempmemnum), 4
         `ynorm
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,4)
         inc mempos(tempmemnum), 4
         `znorm
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,5)
         inc mempos(tempmemnum), 4
         `u data
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,6)
         inc mempos(tempmemnum), 4
         `v data
         write memblock float tempmemnum, mempos(tempmemnum), vert_store#(i,j,7)
         inc mempos(tempmemnum), 4
      next j
      `after each poly increase b by 1
      inc b, 1
      `after 2 polys have been completed 1 tile has been entered
      if b > 2
         `reset poly count to 1
         b = 1
         `move to next x tile
         inc xtile, 1
         `if at the next limb
         if xtile > limbx
            `reseet the x tile to 1
            xtile = 1
            `update the tile count to know when to move to the next row
            inc xrow, limbx
            `inc the xmem selector placeholder
            inc xmem, 1
            `if at the last xmem wide then start back at the begining
            if xmem > tempx
               xmem = 1
            endif
         endif
         `when at the end of the row
         if xrow > matxsegs
            `go back to the far left
            xrow = 1
            `update the number of rows done
            inc ztile, 1
            `when the number of rows done is > the preset depth
            if ztile > limbz
               `reset row count back to 1
               ztile = 1
               `move to the next zmem selector placeholder
               inc zmem, 1
               `if row count overlaps predetermined number
               if zmem > tempz
                  `wrap to 1
                  zmem = 1
               endif
            endif
         endif
      endif
   next i
   `undim arrays when done with them
   undim vert_store#(0,0,0)
   undim membhold(0, 0)
   undim mempos(0)
   `set the mesh number to use (can be replaced with a findfreemesh function)
   mesh = 1
   `make object and limbs from data setup
   for i = 1 to tempmem
      `make temp mesh from info
      make mesh from memblock mesh, i
      `delete temp memblock
      delete memblock i
      `if it is the first memblock mesh, use it as the base object
      if i = 1
         `make temp object for NGC
         make object object, mesh, begtexnum
      `else turn each memblock mesh into limbs
      else
         add limb object, i-1, mesh
      endif
      `delete temp mesh
      delete mesh mesh
   next i
   `texture limbs
   j = begtexnum + 1
   for i = 2 to tempmem
      texture limb object, i-1, j
      inc j, 1
      if j > endtexnum then j = begtexnum
   next i
   `unrem this to make the lighting look exactly like a matrix
   `set object light object, 0
`******************************************************************************
endfunction

`align the specified objects to the specified side
function align_Obj_side( source as integer, dest as integer, source_side as integer, dest_side as integer )

   `get the vert position to test source for depending on side to line up
   select source_side
      `if side = 1 or left side test for the x axis min
      case 1
         vertpos1# = get_obj_min_vert( source, x_axis )
      endcase
      `if side = 2 or near side test for the z axis min
      case 2
         vertpos1# = get_obj_min_vert( source, z_axis )
      endcase
      `if side = 3 or right side test for the x axis max
      case 3
         vertpos1# = get_obj_max_vert( source, x_axis )
      endcase
      `if side = 4 or far side test for the z axis max
      case 4
         vertpos1# = get_obj_max_vert( source, z_axis )
      endcase
   endselect

   `get the vert position to test dest for depending on side to line up
   `uses same testing as above but stores to different variable
   select dest_side
      case 1
         vertpos2# = get_obj_min_vert( dest, x_axis )
      endcase
      case 2
         vertpos2# = get_obj_min_vert( dest, z_axis )
      endcase
      case 3
         vertpos2# = get_obj_max_vert( dest, x_axis )
      endcase
      case 4
         vertpos2# = get_obj_max_vert( dest, z_axis )
      endcase
   endselect

   `get the number of limbs in both objects for testing
   perform checklist for object limbs source
   sourcelimbqty = checklist quantity()-1
   empty checklist
   perform checklist for object limbs dest
   destlimbqty = checklist quantity()-1
   empty checklist

   `dim arrays to store vert info
   dim tempinfo#(0,3)
   dim tempvert(0)
   `dim array to tell which destination limbs need updating
   dim limbused(destlimbqty)
   for i = 0 to destlimbqty
      limbused(i) = 0
   next i
   `set placeholder vars
   matches = 0
   matched = 0
   updated = 0
   matches_found = 0

   rem Lock up source object data to obtain heights (quick means refresh or recreate)
   QuickRefreshFlag=1
   `cycle through limbs
   for j = 0 to sourcelimbqty
      LOCK VERTEXDATA FOR LIMB source, j, QuickRefreshFlag
      `cycle through each limb's verts
      for V = 0 to GET VERTEXDATA VERTEX COUNT()-1
         `gather info depending on the desired side
         select source_side
            `if side = 1 or left side test for the x axis min and save
            case 1
               x1# = GET VERTEXDATA POSITION X(V)
               if x1# = vertpos1#
                  `inc that you have found a matching vert and store info
                  inc matches, 1
                  dim tempinfo#(matches,3)
                  tempinfo#(matches,2)=GET VERTEXDATA POSITION Y(V)
               endif
            endcase
            `if side = 2 or near side test for the z axis min and save
            case 2
               z1# = GET VERTEXDATA POSITION Z(V)
               if z1# = vertpos1#
                  `inc that you have found a matching vert and store info
                  inc matches, 1
                  dim tempinfo#(matches,3)
                  tempinfo#(matches,2)=GET VERTEXDATA POSITION Y(V)
               endif
            endcase
            `if side = 3 or right side test for the x axis max and save
            case 3
               x1# = GET VERTEXDATA POSITION X(V)
               if x1# = vertpos1#
                  `inc that you have found a matching vert and store info
                  inc matches, 1
                  dim tempinfo#(matches,3)
                  tempinfo#(matches,2)=GET VERTEXDATA POSITION Y(V)
               endif
            endcase
            `if side = 4 or far side test for the z axis max and save
            case 4
               z1# = GET VERTEXDATA POSITION Z(V)
               if z1# = vertpos1#
                  `inc that you have found a matching vert and store info
                  inc matches, 1
                  dim tempinfo#(matches,3)
                  tempinfo#(matches,2)=GET VERTEXDATA POSITION Y(V)
               endif
            endcase
         endselect
      next V
      `store the number of matches per limb for later use
      `since I build the objects evenly it will be the same for each limb
      `and object
      if matches_found = 0
         if matches > 0
            num_matches = matches
            matches_found = 1
         endif
      endif
      `unlock data when finished to do next limb
      UNLOCK VERTEXDATA
   next j

   rem Lock up dest object data to capture info on what needs updating
   for j = 0 to destlimbqty
      LOCK VERTEXDATA FOR LIMB dest, j, QuickRefreshFlag
      for V = 0 to GET VERTEXDATA VERTEX COUNT()-1
         select dest_side
            `if side = 1 or left side test for the x axis min and save
            case 1
               x2# = GET VERTEXDATA POSITION X(V)
               if x2# = vertpos2#
                  inc matched, 1
                  dim tempvert(matched)
                  tempvert(matched) = V
                  limbused(j) = 1
               endif
            endcase
            `if side = 2 or near side test for the z axis min and save
            case 2
               z2# = GET VERTEXDATA POSITION Z(V)
               if z2# = vertpos2#
                  inc matched, 1
                  dim tempvert(matched)
                  tempvert(matched) = V
                  limbused(j) = 1
               endif
            endcase
            `if side = 3 or right side test for the x axis max and save
            case 3
               x2# = GET VERTEXDATA POSITION X(V)
               if x2# = vertpos2#
                  inc matched, 1
                  dim tempvert(matched)
                  tempvert(matched) = V
                  limbused(j) = 1
               endif
            endcase
            `if side = 4 or far side test for the z axis max and save
            case 4
               z2# = GET VERTEXDATA POSITION Z(V)
               if z2# = vertpos2#
                  inc matched, 1
                  dim tempvert(matched)
                  tempvert(matched) = V
                  limbused(j )= 1
               endif
            endcase
         endselect
      next V
      `unlock data when finished to do next limb
      UNLOCK VERTEXDATA
   next j

   `update vert positions that need it
   old = 1
   `check all limbs of destination object that need it
   for j = 0 to destlimbqty
      `if limb needs updating then do so else skip it
      if limbused(j) = 1
         LOCK VERTEXDATA FOR LIMB dest, j, QuickRefreshFlag
         `use the old var to tell when to move to another limb
         `use the matched var to make sure you don't go too far.
         for i = old to matched
            `since the verts are on opposite sides of the objects to line up
            `they will be in a different order to write than found
            `use the updated flag to set the order
            inc updated, 1
            if updated > 3 then updated = 1
            `select vert order to write depending on the side chosen
            if dest_side = leftside and  source_side = rightside
               `the vert order will be written in 1,2,3 order
               `but copied from 3,2,3 order
               if updated = 1
                  temp = tempvert(i)
                  tempx# = GET VERTEXDATA POSITION X(temp)
                  tempz# = GET VERTEXDATA POSITION Z(temp)
                  SET VERTEXDATA POSITION temp, tempx#, tempinfo#(i+2,2), tempz#
               endif
               if updated = 2
                  temp = tempvert(i)
                  tempx# = GET VERTEXDATA POSITION X(temp)
                  tempz# = GET VERTEXDATA POSITION Z(temp)
                  SET VERTEXDATA POSITION temp, tempx#, tempinfo#(i,2), tempz#
               endif
               if updated = 3
                  temp = tempvert(i)
                  tempx# = GET VERTEXDATA POSITION X(temp)
                  tempz# = GET VERTEXDATA POSITION Z(temp)
                  SET VERTEXDATA POSITION temp, tempx#, tempinfo#(i,2), tempz#
               endif
            endif
            if dest_side = nearside and  source_side = farside
               `the vert order will be written in 1,2,3 order
               `but copied from 1,1,3 order
               if updated = 1
                  temp = tempvert(i)
                  tempx# = GET VERTEXDATA POSITION X(temp)
                  tempz# = GET VERTEXDATA POSITION Z(temp)
                  SET VERTEXDATA POSITION temp, tempx#, tempinfo#(i,2), tempz#
               endif
               if updated = 2
                  temp = tempvert(i)
                  tempx# = GET VERTEXDATA POSITION X(temp)
                  tempz# = GET VERTEXDATA POSITION Z(temp)
                  SET VERTEXDATA POSITION temp, tempx#, tempinfo#(i-1,2), tempz#
               endif
               if updated = 3
                  temp = tempvert(i)
                  tempx# = GET VERTEXDATA POSITION X(temp)
                  tempz# = GET VERTEXDATA POSITION Z(temp)
                  SET VERTEXDATA POSITION temp, tempx#, tempinfo#(i,2), tempz#
               endif
            endif
            if dest_side = rightside and  source_side = leftside
               `the vert order will be written in 1,2,3 order
               `but copied from 2,2,3 order
               if updated = 1
                  temp = tempvert(i)
                  tempx# = GET VERTEXDATA POSITION X(temp)
                  tempz# = GET VERTEXDATA POSITION Z(temp)
                  SET VERTEXDATA POSITION temp, tempx#, tempinfo#(i+1,2), tempz#
               endif
               if updated = 2
                  temp = tempvert(i)
                  tempx# = GET VERTEXDATA POSITION X(temp)
                  tempz# = GET VERTEXDATA POSITION Z(temp)
                  SET VERTEXDATA POSITION temp, tempx#, tempinfo#(i,2), tempz#
               endif
               if updated = 3
                  temp = tempvert(i)
                  tempx# = GET VERTEXDATA POSITION X(temp)
                  tempz# = GET VERTEXDATA POSITION Z(temp)
                  SET VERTEXDATA POSITION temp, tempx#, tempinfo#(i,2), tempz#
               endif
            endif
            if dest_side = farside and  source_side = nearside
               `the vert order will be written in 1,2,3 order
               `but copied from 1,3,3 order
               if updated = 1
                  temp = tempvert(i)
                  tempx# = GET VERTEXDATA POSITION X(temp)
                  tempz# = GET VERTEXDATA POSITION Z(temp)
                  SET VERTEXDATA POSITION temp, tempx#, tempinfo#(i,2), tempz#
               endif
               if updated = 2
                  temp = tempvert(i)
                  tempx# = GET VERTEXDATA POSITION X(temp)
                  tempz# = GET VERTEXDATA POSITION Z(temp)
                  SET VERTEXDATA POSITION temp, tempx#, tempinfo#(i+1,2), tempz#
               endif
               if updated = 3
                  temp = tempvert(i)
                  tempx# = GET VERTEXDATA POSITION X(temp)
                  tempz# = GET VERTEXDATA POSITION Z(temp)
                  SET VERTEXDATA POSITION temp, tempx#, tempinfo#(i,2), tempz#
               endif
            endif
            `when you have written all ofthe changes for this limb move
            `on to the next
            if i = old + (num_matches - 1)
               old = i + 1
               exit
            endif
         next i
         UNLOCK VERTEXDATA
      endif
   next j

   `undim no longer needed arrays
   undim tempinfo#(0)
   undim tempvert(0)
   undim limbused(0)

endfunction


`get the min vert position for an object axi are 1=x 2=y 3=z
function get_obj_min_vert( obj as integer, axis as integer )

   `get the number of limbs to test for lowest vert positions
   perform checklist for object limbs obj
   limbqty = checklist quantity()
   empty checklist
   rem Lock and manipulate main object data (quick means refresh or recreate)
   QuickRefreshFlag=1
   `search through every limb's verts for the min positions to tell
   `whick is the left, near, or bottom side
   for j = 0 to limbqty-1
      LOCK VERTEXDATA FOR LIMB Obj, j, QuickRefreshFlag
      for V=0 to GET VERTEXDATA VERTEX COUNT()-1
         if V = 0 and j = 0
            if axis = x_axis
               min#=GET VERTEXDATA POSITION X(V)
            endif
            if axis = y_axis
               min#=GET VERTEXDATA POSITION Y(V)
            endif
            if axis = z_axis
               min#=GET VERTEXDATA POSITION Z(V)
            endif
         else
            if axis = x_axis
               nmin#=GET VERTEXDATA POSITION X(V)
            endif
            if axis = y_axis
               nmin#=GET VERTEXDATA POSITION Y(V)
            endif
            if axis = z_axis
               nmin#=GET VERTEXDATA POSITION Z(V)
            endif
            if nmin# < min# then min# = nmin#
         endif
      next V
      UNLOCK VERTEXDATA
   next j

endfunction min#

`get the max vert position for an object axi are 1=x 2=y 3=z
function get_obj_max_vert( obj as integer, axis as integer )

   `get the number of limbs to test for highest vert positions
   perform checklist for object limbs obj
   limbqty = checklist quantity()
   empty checklist
   rem Lock and manipulate main object data (quick means refresh or recreate)
   QuickRefreshFlag=1
   `search through every limb's verts for the max positions to tell
   `whick is the right, far, or top side
   for j = 0 to limbqty-1
      LOCK VERTEXDATA FOR LIMB Obj, j, QuickRefreshFlag
      for V=0 to GET VERTEXDATA VERTEX COUNT()-1
         if V = 0 and j = 0
            if axis = x_axis
               max#=GET VERTEXDATA POSITION X(V)
            endif
            if axis = y_axis
               max#=GET VERTEXDATA POSITION Y(V)
            endif
            if axis = z_axis
               max#=GET VERTEXDATA POSITION Z(V)
            endif
         else
            if axis = x_axis
               nmax#=GET VERTEXDATA POSITION X(V)
            endif
            if axis = y_axis
               nmax#=GET VERTEXDATA POSITION Y(V)
            endif
            if axis = z_axis
               nmax#=GET VERTEXDATA POSITION Z(V)
            endif
            if nmax# > max# then max# = nmax#
         endif
      next V
      UNLOCK VERTEXDATA
   next j

endfunction max#

`Terrain Editor program
`By Segan

Gosub _InitialiseGlobals
Gosub _SetupScreen

Make Matrix 1, 10, 10, 10, 10
Position Matrix 1, -5, 0, -5

Do
	
	MoveCamera(0.13)
	Sync
loop


Function MoveCamera(MoveSpeed#)
	`Notes:
	`CameraX, CameraY, CameraZ, CamPointX, CamPointY, CamPointZ and CamCirclePos 
	`all have to be globals and have to have values before function is called.
	
	tmove = 0
	Angle# = Camera Angle Y()
	tMoveSpeed# = MoveSpeed#
	If Shiftkey() = 0
		If Leftkey() = 1 Then tMove = 1: Angle# = wrapvalue(Angle#+270):Goto MoveCameraNext
		If Rightkey() = 1 Then tMove = 1: Angle# = wrapvalue(Angle#+90):Goto MoveCameraNext
		If Upkey() = 1 Then tMove = 1: Angle# = wrapvalue(Angle#): Goto MoveCameraNext
		If Downkey() = 1 Then tMove = 1: Angle# = wrapvalue(Angle#+180): Goto MoveCameraNext
	endif
	
	MoveCameraNext:
	
	If tMove = 1
		If Angle# >= 0 AND Angle# <= 180
			CameraX = Newxvalue(CameraX, Angle#, tMoveSpeed#)
			CamPointX = Newxvalue(CamPointX, Angle#, tMoveSpeed#)						
		Endif
		
		If Angle# >= 180 And Angle# <= 360
			CameraX = Newxvalue(CameraX, Angle#, tMoveSpeed#)	
			CamPointX = Newxvalue(CamPointX, Angle#, tMoveSpeed#)
		Endif
		
		If Angle# >= 270 Or Angle# <= 90
			CameraZ = Newzvalue(CameraZ, Angle#, tMoveSpeed#)
			CamPointZ = Newzvalue(CamPointZ, Angle#, tMoveSpeed#)
		Endif		
	
		If Angle# >= 90 And Angle# <= 270
			CameraZ = Newzvalue(CameraZ, Angle#, tMoveSpeed#)
			CamPointZ = Newzvalue(CamPointZ, Angle#, tMoveSpeed#)
		Endif		
	Endif
	
	Position Camera CameraX,CameraY,CameraZ
	Point Camera CamPointX, CamPointY, CamPointZ
	
	tempMouseMove = MouseMoveZ()  
	If tempMouseMove > 0 Then Move Camera MoveSpeed#*3
	If tempMouseMove < 0 Then Move Camera -MoveSpeed#*3
	
	CameraX = Camera Position X()
	CameraY = Camera Position Y()
	CameraZ = Camera Position Z()
	
	If Shiftkey() > 0
		If LeftKey() = 1 Then CamCirclePos = Wrapvalue(CamCirclePos - 1.0)
		If RightKey() = 1 Then CamCirclePos = Wrapvalue(CamCirclePos + 1.0)
		If Upkey() = 1 Then CameraY = CameraY + MoveSpeed#
		If Downkey() = 1 Then CameraY = CameraY - MoveSpeed#
	endif	
	
	AdjustCamX# = (Sin(CamCirclePos)*abs(CameraZ-CamPointZ))+CameraX
	AdjustCamZ# = (Cos(CamCirclePos)*abs(CameraZ-CamPointZ))+CameraZ-(CameraZ-CamPointZ)
	
	Position Camera AdjustCamX#,CameraY,AdjustCamZ#
	Point Camera CamPointX, CamPointY, CamPointZ
endfunction

`========================================================================
_InitialiseGlobals:

	`---------------------------------------------------------------------
	`Camera Variables:
	`---------------------------------------------------------------------
	Global CameraX As Float: CameraX = 0.0
	Global CameraY As Float: CameraY = 10.0
	Global CameraZ As Float: CameraZ = -5.0
	
	Global CamPointX As Float: CamPointX = 0.0
	Global CamPointY As Float: CamPointY = 0.0
	Global CamPointZ As Float: CamPointZ = 0.0
	
	Global CamCirclePos As Float: CamCirclePos = 180.0
	`!!!Perhaps temporary if a function to find them out can be made.!!!
	Global PointCameraX As Float: PointCameraX = 0
	Global PointCameraY As Float: PointCameraY = 0
	Global PointCameraZ As Float: PointCameraZ = 0
	
Return

`========================================================================
_SetupScreen:

	`Setup the screen
	Sync On: Sync Rate 60
	autocam off
	backdrop on

	`Setup the camera
	Position Camera CameraX,CameraY,CameraZ
	Point Camera PointCameraX,PointCameraY,PointCameraZ
Return

`Primatives and Level Editor!!!
`By Segan

Remstart
Thank Yous For this Project:

-Big thanks to IanM for creating his great Matrix1Utility Dll!

Remend


Gosub _InitialiseGlobals
Gosub _SetupScreen
`Sets up the matrix where everything will happen
CreateEnvironment()

`Now it's time for our main loop!
Do
	If Mouseclick() = 1 
		SegHeightTool()
	endif
	MoveCamera(0.13)
	DrawObjects()
	Sync
loop

`========================================================================
`FUNCTIONS THAT ARE CURRENTLY BEING EDITED
`========================================================================


Function CreateMatrix(X#, Y#, Z#, Width#, Height#, XSeg, ZSeg)
	Add To Queue Matrix(0)
	Arrayspot = Array Count(Matrix(0))
	Matrix(Arrayspot).Num = Get_Free_Matrix_Number()
	
	Matrix(Arrayspot).X = X#
	Matrix(Arrayspot).Y = Y#	
	Matrix(Arrayspot).Z = Z#	
	Matrix(Arrayspot).Width = Width#
	Matrix(Arrayspot).Height = Height#
	Matrix(Arrayspot).XSeg = XSeg
	Matrix(Arrayspot).ZSeg = ZSeg
	Matrix(Arrayspot).SegCoords = Make Memory((XSeg+1)*(ZSeg+1)*12)
	
	Make Matrix Matrix(Arrayspot).num, Width#, Height#, XSeg, ZSeg
	`!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	`Prepare Matrix Texture 1, GridImage, 1, 1 `The new textures will go here!
	`!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	Position Matrix Matrix(Arrayspot).num, X#,Y#,Z#
	Update Matrix Matrix(Arrayspot).num
	SYnc	
	For tx = 0 To XSeg
		For tz = 0 To ZSeg
			Position = ((tx)*(ZSeg+1)+tz)*12
			Poke Float Matrix(Arrayspot).SegCoords+Position, X#+(Width#/(XSeg))*(tx)
			Poke Float Matrix(Arrayspot).SegCoords+Position+4,Get Matrix Height(Matrix(Arrayspot).num, tx, tz)
			Poke Float Matrix(Arrayspot).SegCoords+Position+8, Z#+(Height#/(ZSeg))*(tz)
		next tz
	next tx
	
endfunction


Function CheckMatrixSegClick(MatrixNumber As Integer, Offset As Float)
	
	For tx = 0 To Matrix(MatrixNumber).XSeg
		For tz = 0 To Matrix(MatrixNumber).ZSeg
			Position = ((tx)*(Matrix(MatrixNumber).ZSeg+1)+tz)*12
			SegX# = Peek Float(Matrix(MatrixNumber).SegCoords+Position)
			SegY# = Peek Float(Matrix(MatrixNumber).SegCoords+Position+4)
			SegZ# = Peek Float(Matrix(MatrixNumber).SegCoords+Position+8)
			
			MouseClick3D("y", SegY#)
			If abs(D3ClickX-SegX#) < Offset And abs(D3ClickZ-SegZ#) < Offset
				MSCClickX = tx
				MSCClickZ = tz
				ExitFunction 1
			endif
		next tz
	next tx
	
endfunction 0


Function SegHeightTool()
	If CheckMatrixSegClick(1,.3) = 1 
		SegClickedX = MSCClickX
		SegClickedZ = MSCClickZ
		Repeat
			Position = ((SegClickedX)*(Matrix(1).ZSeg+1)+SegClickedZ)*12
			ZClicked# = Peek Float(Matrix(1).SegCoords+Position+8)
			MouseClick3D("z",ZClicked#)
			Set Matrix Height 1, (SegClickedX), (SegClickedZ), D3ClickY
			Update Matrix 1
			Poke Float Matrix(1).SegCoords+Position+4, D3ClickY
			Sync
		until MouseClick() <> 1
	endif
EndFunction


Function HillTool()
	If CheckMatrixSegClick(1,.2) = 1 
		SegClickedX = MSCClickX
		SegClickedZ = MSCClickZ
		Repeat
			Position = ((SegClickedX)*(Matrix(1).ZSeg+1)+SegClickedZ)*12
			ZClicked# = Peek Float(Matrix(1).SegCoords+Position+8)
			MouseClick3D("z",ZClicked#)
			Set Matrix Height 1, (SegClickedX), (SegClickedZ), D3ClickY
			Update Matrix 1
			Poke Float Matrix(1).SegCoords+Position+4, D3ClickY
			For x = -1 To 1 Step 2
				tx = x + SegClickedX
				`Repeat
					If tx < 0 Or tx > Matrix(1).XSeg Then Goto _HTNextXLoop	
					Position = 	((tx)*(Matrix(1).ZSeg+1)+SegClickedZ)*12			
				

					
					tx = tx + x
				`until 	
				_HTNextXLoop:
			next x
			

			
			
			
			Sync
		until MouseClick() <> 1
	endif
endfunction



Function CreateObject(ObjectType,X#,Y#,Z#)
	If ObjectType < 1 Or ObjectType > 1 `NEED TO CHANGE AS MORE OBJECT TYPES ARE ADDED
		cls: Text 0,0,"ERROR: Object Type Illegal in Create Object Function."
		Text 20,0,"Press any key to continue.": Sync: Wait Key: ExitFunction	
	Endif
	
	Add To Queue Objects(0)
	ArraySpot = Array Count(Objects())
	Objects(ArraySpot).Num = Get_Free_Object_Number()
	
	If ObjectType = 1 Then Make Object Cube Objects(ArraySpot).Num, 1
	`Need to add more objects here as the ability to make more is added
	
	Position Object Objects(ArraySpot).Num, X#, Y#, Z#
	
	Objects(ArraySpot).Prim = ObjectType
	Objects(ArraySpot).X = x#: Objects(ArraySpot).Y = y#: Objects(ArraySpot).Z = z#	
endfunction


Function DrawObjects()
	
	If Array Count(Objects()) > 0
		For TOB = 1 To Array Count(Objects())
			Position Object Objects(TOB).Num, Objects(TOB).X, Objects(TOB).Y, Objects(TOB).Z	
		next TOB
	Endif
	
endfunction


Function MoveCamera(MoveSpeed#)
	`Notes:
	`CameraX, CameraY, CameraZ, CamPointX, CamPointY, CamPointZ and CamCirclePos 
	`all have to be globals and have to have values before function is called.
	
	tmove = 0
	Angle# = Camera Angle Y()
	tMoveSpeed# = MoveSpeed#
	If Shiftkey() = 0
		If Leftkey() = 1 Then tMove = 1: Angle# = wrapvalue(Angle#+270):Goto MoveCameraNext
		If Rightkey() = 1 Then tMove = 1: Angle# = wrapvalue(Angle#+90):Goto MoveCameraNext
		If Upkey() = 1 Then tMove = 1: Angle# = wrapvalue(Angle#): Goto MoveCameraNext
		If Downkey() = 1 Then tMove = 1: Angle# = wrapvalue(Angle#+180): Goto MoveCameraNext
	endif
	
	MoveCameraNext:
	
	If tMove = 1
		If Angle# >= 0 AND Angle# <= 180
			CameraX = Newxvalue(CameraX, Angle#, tMoveSpeed#)
			CamPointX = Newxvalue(CamPointX, Angle#, tMoveSpeed#)						
		Endif
		
		If Angle# >= 180 And Angle# <= 360
			CameraX = Newxvalue(CameraX, Angle#, tMoveSpeed#)	
			CamPointX = Newxvalue(CamPointX, Angle#, tMoveSpeed#)
		Endif
		
		If Angle# >= 270 Or Angle# <= 90
			CameraZ = Newzvalue(CameraZ, Angle#, tMoveSpeed#)
			CamPointZ = Newzvalue(CamPointZ, Angle#, tMoveSpeed#)
		Endif		
	
		If Angle# >= 90 And Angle# <= 270
			CameraZ = Newzvalue(CameraZ, Angle#, tMoveSpeed#)
			CamPointZ = Newzvalue(CamPointZ, Angle#, tMoveSpeed#)
		Endif		

	Endif
	Remstart
	If Shiftkey() = 0
		If LeftKey() = 1 Then CameraX = CameraX - MoveSpeed#: CamPointX = CamPointX - MoveSpeed#
		If RightKey() = 1 Then CameraX = CameraX + MoveSpeed#: CamPointX = CamPointX + MoveSpeed#
		`If Upkey() = 1 Then CameraZ = CameraZ + MoveSpeed#: CamPointZ = CamPointZ + MoveSpeed#
		If Downkey() = 1 Then CameraZ = CameraZ - MoveSpeed#: CamPointZ = CamPointZ - MoveSpeed#
	Endif
	Remend
	
	Position Camera CameraX,CameraY,CameraZ
	Point Camera CamPointX, CamPointY, CamPointZ
	
	tempMouseMove = MouseMoveZ()  
	If tempMouseMove > 0 Then Move Camera MoveSpeed#*3
	If tempMouseMove < 0 Then Move Camera -MoveSpeed#*3
	
	CameraX = Camera Position X()
	CameraY = Camera Position Y()
	CameraZ = Camera Position Z()
	
	If Shiftkey() > 0
		If LeftKey() = 1 Then CamCirclePos = Wrapvalue(CamCirclePos - 1.0)
		If RightKey() = 1 Then CamCirclePos = Wrapvalue(CamCirclePos + 1.0)
		If Upkey() = 1 Then CameraY = CameraY + MoveSpeed#
		If Downkey() = 1 Then CameraY = CameraY - MoveSpeed#
	endif	
	
	AdjustCamX# = (Sin(CamCirclePos)*abs(CameraZ-CamPointZ))+CameraX
	AdjustCamZ# = (Cos(CamCirclePos)*abs(CameraZ-CamPointZ))+CameraZ-(CameraZ-CamPointZ)
	
	Position Camera AdjustCamX#,CameraY,AdjustCamZ#
	Point Camera CamPointX, CamPointY, CamPointZ
endfunction


Function CreateEnvironment()
	cls 0
	Ink RGB(0,0,0),0
	Box 0,0,20,20
	Ink RGB(255,255,255),RGB(255,255,255)
	Line 0,0,20,0
	Line 0,0,0,20
	Line 0,20,20,20
	Line 20,0,20,20
	
	GridImage = Get_Free_Image_Number()
	Get Image GridImage,0,0,20,20
	
	`Make Matrix 1, 10,10,10,10
	`Prepare Matrix Texture 1, GridImage, 1, 1
	`Position Matrix 1, -5,0,-5
	
	CreateMatrix(-5.0, 0.0, -5.0, 10.0, 10.0, 10, 10)
endfunction



`========================================================================
`COMPLETED FUNCTIONS
`========================================================================


Function Get_Free_Object_Number()
	Remstart
	This function just finds a free object, and then returns its number.
	This is so that objects can be given variable names rather than numbers!
	
	***Special Thanks to Ric in the Darkbasic Pro forums who I stole this 
	function from.***
	Remend	
	
	Do
		inc ObjectNumber
	 	If Object Exist(ObjectNumber) = 0 Then Exit
	Loop
EndFunction ObjectNumber


Function Get_Free_Image_Number()
	Remstart
	This function just finds a free image, and then returns its number.
	This is so that images can be given variable names rather than numbers!
	
	***Special Thanks to Ric in the Darkbasic Pro forums who I stole this 
	function from.***
	Remend	
	
	Do
		inc ImageNumber
		If Image Exist(ImageNumber) = 0 Then Exit
	loop
endfunction ImageNumber
 

Function Get_Free_Matrix_Number()
	Remstart
	This function just finds a free matrix, and then returns its number.
	This is so that matrixes can be given variable names rather than numbers!

	***Special Thanks to Ric in the Darkbasic Pro forums! I modeled this function
	after one I found in his program!***
	Remend
	
	Do
		inc MatrixNumber
		If Matrix Exist(MatrixNumber) = 0 Then Exit
	Loop

endfunction MatrixNumber


Function MouseClick3D(XYorZ$, PlainClicked#)
	Remstart
	This is a function that, using "Pick Screen" and some triangle trigonometry,
	figures out where the mouse is on a 2D plain in 3D space.
	
	XYorZ$ = The plane in question (X returns a position on the YZ plain etc.)
	PlainClicked# = The height of the plain 
						(if XYorZ$ = "y", PlainClicked# = Y co-ordinate of the plain)	
	
	Notes: This function uses the variables "D3ClickX" "D3ClickY" and "D3ClickZ"
			 as return values. 
	
	***Special thanks to CPU on the Darbasic Pro forums for providing a tutorial and
	example code which inspired this function.***
	Remend
	
	`Code that decides which dimension is held constant.
	XYorZ$ = lower$(XYorZ$) 
	If XYorZ$ = "x" Then PlainType = 1
	If XYorZ$ = "y" Then PlainType = 2
	If XYorZ$ = "z" Then PlainType = 3
	
	`Error Checking
	If PlainType = 0: Text 0,0,"Error: Invalid Parameter in XYMouseClick3D Function":Sync: Wait Key: ExitFunction : Endif
	
	`Determine the dimensions of one triangle (with a hypotenus of 1)
	Pick Screen MouseX(),MouseY(),1
	PickX# = Get Pick Vector X()
	PickY# = Get Pick Vector Y()
	PickZ# = Get Pick Vector Z()	
	
	`Calculate the length of the number of times bigger the second triangle is
	If PlainType = 1 Then Raylength# = (Camera Position X()-PlainClicked#)/PickX#: D3ClickX = PlainClicked#
	If PlainType = 2 Then Raylength# = (Camera Position Y()-PlainClicked#)/PickY#: D3ClickY = PlainClicked#
	If PlainType = 3 Then Raylength# = (Camera Position Z()-PlainClicked#)/PickZ#: D3ClickZ = PlainClicked#
	
	`Scale the triangle so that it is the right dimensions
	If PlainType <> 1 Then D3ClickX = Camera Position X() - (PickX#*Raylength#)
	If PlainType <> 2 Then D3ClickY = Camera Position Y() - (PickY#*Raylength#)
	If PlainType <> 3 Then D3ClickZ = Camera Position Z() - (PickZ#*Raylength#) 
EndFunction 

`========================================================================
_InitialiseGlobals:

	`---------------------------------------------------------------------
	`Camera Variables:
	`---------------------------------------------------------------------
	Global CameraX As Float: CameraX = 0.0
	Global CameraY As Float: CameraY = 10.0
	Global CameraZ As Float: CameraZ = -5.0
	
	Global CamPointX As Float: CamPointX = 0.0
	Global CamPointY As Float: CamPointY = 0.0
	Global CamPointZ As Float: CamPointZ = 0.0
	
	Global CamCirclePos As Float: CamCirclePos = 180.0
	`!!!Perhaps temporary if a function to find them out can be made.!!!
	Global PointCameraX As Float: PointCameraX = 0
	Global PointCameraY As Float: PointCameraY = 0
	Global PointCameraZ As Float: PointCameraZ = 0

	`---------------------------------------------------------------------
	`Variables Needed for Functions
	`---------------------------------------------------------------------
	
	`MouseClick3D globals:
	Global D3ClickX As Float
	Global D3ClickY As Float
	Global D3ClickZ As Float

	`CheckMatrixSegClick Variables
	Global MSCClickX As Integer
	Global MSCClickZ As Integer
	
	`Primative Object Variables
	Type tObject
		X As Float:	Y As Float: Z As Float
		Num As Integer
		Prim As Integer `This is the type of primative that is being made
	endtype

	`and the array that uses the type.
	Dim Objects(0) As TObject 
	
	
	`Matrix Variables
	Type tMatrix
		X As Float: Y As Float: Z As Float
		Num As Integer
		Width As Integer: Height As Integer
		XSeg As Integer: ZSeg As Integer		
		SegCoords As DWord
	endtype
	
	Dim Matrix(0) As tMatrix
	
	`Temporary Variables:
	Global GridImage

Return

`========================================================================
_SetupScreen:

	`Setup the screen
	Sync On: Sync Rate 60
	autocam off
	backdrop on

	`Setup the camera
	Position Camera CameraX,CameraY,CameraZ
	Point Camera PointCameraX,PointCameraY,PointCameraZ
	
Return

sync on : sync rate 0

`variables
#constant maxWorlds = 5
#constant maxTiles = 100
#constant maxHeight = 255.0

type tile
   offsetx# as float
   offsety# as float
   offsetz# as float
   turned as boolean
endtype
type world
   x# as float
   y# as float
   z# as float
   sx# as float
   sz# as float
   sy# as float
   tx as integer
   tz as integer
endtype

`initialize
dim World(maxWorlds) as world
dim Heightmap(maxWorlds, maxTiles+1, maxTiles+1) as float
dim Tile(maxWorlds, maxTiles, maxTiles) as tile

`<<<<<<<<<<<<<<<<<<< Temporary >>>>>>>>>>>>>>>>>>>>>>>>
World(1).sx# = 200.0
World(1).sy# = 50.0
World(1).sz# = 200.0
World(1).tx = 50
World(1).tz = 50
for y = 1 to 51 : for x = 1 to 51 : Heightmap(1, x, y) = rnd(50) : next x : next y
for y = 1 to 50 : for x = 1 to 50 : Tile(1, x, y).turned = rnd(1) : next x : next y

CreateWorldMesh(1)

make object 1, 1, 0
set object collision to polygons 1
`<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

`Create mouse pointer
make object cube maxWorlds + 1, 2

`Create vector for distances
null = make vector3(1)

a# = 0
do

   position camera -100, 100, -100
   point camera 0,0,0

   `Handle mouse in 3D
   gosub Handle3Dmouse

   sync
loop

`Handle mouse
Handle3Dmouse:

   `get camera information
   camx# = camera position x()
   camy# = camera position y()
   camz# = camera position z()

   `setup vector
   pick screen mousex(), mousey(), 1500
   mx# = get pick vector x()
   my# = get pick vector y()
   mz# = get pick vector z()
   set vector3 1, mx#, my#, mz#
   FullDistance# = length vector3(1)

   dist# = intersect object(1, camx#, camy#, camz#, camx# + mx#, camy# + my#, camz# + mz#)
   mx# = mx# / FullDistance# * dist#
   my# = my# / FullDistance# * dist#
   mz# = mz# / FullDistance# * dist#

   `Update pointer
   position object maxWorlds + 1, camx# + mx#, camy# + my#, camz# + mz#

return

`**************************
`Functions
`**************************

function CreateWorldMesh(w)

   `Calculate number of triangles
   Tri = World(w).tx * World(w).tz * 2

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   `Create a memblock (3 verts each triangle)
   make memblock w, 12 + (Tri * 3 * 36)
   write memblock dword w, 0, 338
   write memblock dword w, 4, 36
   write memblock dword w, 8, Tri * 3

   `Write memblocks
   for y = 1 to World(w).tx
      for x = 1 to World(w).tz

         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         remstart
         Our face looks this way if turned = FALSE
         +-----+
         |    /|
         |   / |
         | /   |
         |/    |
         +-----+
         else
         +-----+
         |    |
         |    |
         |    |
         |    |
         +-----+
         remend

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w
   delete memblock w

endfunction

function WriteVertex(mem, nr, x#, y#, z#, nx#, ny#, nz#, uvx#, uvy#)

   pos = 12 + ((nr-1)*36)

   write memblock float mem, pos, x#
   write memblock float mem, pos+4, y#
   write memblock float mem, pos+8, z#
   write memblock float mem, pos+12,nx#
   write memblock float mem, pos+16,ny#
   write memblock float mem, pos+20,nz#
   write memblock dword mem, pos+24, rgb(255,255,255)
   write memblock float mem, pos+28, uvx#
   write memblock float mem, pos+32, uvy#

endfunction

`Handle mouse
Handle3Dmouse:

   `get camera information
   camx# = camera position x()
   camy# = camera position y()
   camz# = camera position z()

   `setup vector
   pick screen mousex(), mousey(), 1500
   mx# = get pick vector x()
   my# = get pick vector y()
   mz# = get pick vector z()
   set vector3 1, mx#, my#, mz#
   FullDistance# = length vector3(1)

   dist# = intersect object(1, camx#, camy#, camz#, camx# + mx#, camy# + my#, camz# + mz#)
   mx# = mx# / FullDistance# * dist#
   my# = my# / FullDistance# * dist#
   mz# = mz# / FullDistance# * dist#

   `Update pointer
   position object maxWorlds + 1, camx# + mx#, camy# + my#, camz# + mz#

return

1) get 3D mouse position without looking at collision
2) Get length for scaling later
3) project a line from the camera -> 3D mouse position and get distance to intersection point.
4) rescale the offset values of the pick vector using the previously calculated length.

And again don't forget: to get the world values, you have to add the pick vector values to the camera position!

sync on : sync rate 0

`variables
#constant maxWorlds = 5
#constant maxTiles = 100
#constant maxHeight = 255.0

global MouseLocked as boolean
global WorldCursor as integer
global CHeight# as float
global CTool as integer

type tile
   offsetx# as float
   offsety# as float
   offsetz# as float
   turned as boolean
endtype
type world
   x# as float
   y# as float
   z# as float
   sx# as float
   sz# as float
   sy# as float
   tx as integer
   tz as integer
endtype

`initialize
dim World(maxWorlds) as world
dim Heightmap(maxWorlds, maxTiles+1, maxTiles+1) as float
dim Tile(maxWorlds, maxTiles, maxTiles) as tile

`<<<<<<<<<<<<<<<<<<< Temporary >>>>>>>>>>>>>>>>>>>>>>>>
World(1).sx# = 200.0
World(1).sy# = 50.0
World(1).sz# = 200.0
World(1).tx = 50
World(1).tz = 50
for y = 1 to 51 : for x = 1 to 51 : Heightmap(1, x, y) = rnd(50) : next x : next y
for y = 1 to 50 : for x = 1 to 50 : Tile(1, x, y).turned = rnd(1) : next x : next y

CreateWorldMesh(1)

make object 1, 1, 0
set object collision to polygons 1
`<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

`Create mouse pointer
make object cube maxWorlds + 1, 2
make object cube maxWorlds + 2, 1
color object maxWorlds + 2, rgb(255, 0, 0)
scale object maxWorlds + 2, 50, 50000, 50
ghost object on maxWorlds + 2

`Create vector for distances
null = make vector3(1)

`initialize
CTool = 1
CHeight# = 0.0

`initialize camera
position camera -100, 100, 100
point camera 0, 0, 0

do

   `Handle mouse in 3D if mouse is not locked
   if MouseLocked = 0
      gosub Handle3Dmouse

      `Change height
      if CTool = 1 and mouseclick() = 1
         if tx => 0 and tz => 0 and tx <= World(WorldCursor).tx and ty <= World(WorldCursor).tz
            Heightmap(WorldCursor, tx+1, tz+1) = CHeight#
            UpdateWorldMesh(WorldCursor)
            change mesh WorldCursor, 0, WorldCursor
         endif
      endif

   endif

   `Camera movement
   if controlkey() = 1

      `Reset mouse
      if MouseLocked = 0

         `Stop the screen to "jump" when pressing ctrl
         position mouse screen width()/2, screen height()/2
         null = mousemovex()
         null = mousemovey()

         `Lock mouse
         MouseLocked = 1
      endif

      `Rotate camera with the mouse
      rotate camera wrapvalue(camera angle x() + (mousemovey()*0.2)), wrapvalue(camera angle y() + (mousemovex()*0.2)), 0
      position mouse screen width()/2, screen height()/2

      `controls
      if keystate(17) = 1 then move camera 0.5
      if keystate(31) = 1 then move camera -0.5
      if keystate(30) = 1
         position camera newxvalue(camera position x(), wrapvalue(camera angle y()-90), 0.5), camera position y(), newzvalue(camera position z(), wrapvalue(camera angle y()-90), 0.5)
      endif
      if keystate(32) = 1
         position camera newxvalue(camera position x(), wrapvalue(camera angle y()+90), 0.5), camera position y(), newzvalue(camera position z(), wrapvalue(camera angle y()+90), 0.5)
      endif
   endif

   `Control HUD
   gosub HUDControl

   `Unlock
   if controlkey() = 0 and mousex() < screen width() - 20 then MouseLocked = 0

   sync
loop

`Handle mouse
Handle3Dmouse:

   `get camera information
   camx# = camera position x()
   camy# = camera position y()
   camz# = camera position z()

   `setup vector
   pick screen mousex(), mousey(), 1500
   mx# = get pick vector x()
   my# = get pick vector y()
   mz# = get pick vector z()
   set vector3 1, mx#, my#, mz#
   FullDistance# = length vector3(1)

   for w = 1 to maxWorlds
      if object exist(w) = 1
         dist# = intersect object(w, camx#, camy#, camz#, camx# + mx#, camy# + my#, camz# + mz#)

         if dist# > 0.0
            mx# = (mx# / FullDistance# * dist#)
            my# = (my# / FullDistance# * dist#)
            mz# = (mz# / FullDistance# * dist#)
            WorldCursor = w
         endif
      endif
   next w

   `Calc world coords
   mx# = camx# + mx#
   my# = camy# + my#
   mz# = camz# + mz#

   `Update pointer
   position object maxWorlds + 1, mx#, my#, mz#

   `Get second pointer position
   tx = int(World(WorldCursor).tx * (mx#+World(WorldCursor).sx#/2) / World(WorldCursor).sx# + 0.5)
   tz = int(World(WorldCursor).tz * (mz#+World(WorldCursor).sz#/2) / World(WorldCursor).sz# + 0.5)
   Ctx# = (tx * World(WorldCursor).sx# / World(WorldCursor).tx) - (World(WorldCursor).sx#/2)
   Ctz# = (tz * World(WorldCursor).sz# / World(WorldCursor).tz) - (World(WorldCursor).sz#/2)
   Cty# = 0.0
   position object maxWorlds + 2, Ctx#, Cty#, Ctz#

   set cursor 0, 0
   print tx
   print tz
   print WorldCursor

return

HUDControl:

   ink rgb(255, 0, 0), 0
   line screen width() - 10, screen height() - 20 - maxHeight, screen width() - 10, screen height() - 20
   ink rgb(0,255,0),0
   box screen width() - 11, screen height() - 21 - CHeight#, screen width() - 9, screen height() - 19 - CHeight#
   ink rgb(255,255,255),0
   center text screen width() - 10, 10, str$(CHeight#)

   if mousex() > screen width() - 20
      MouseLocked = 1
      if mouseclick() = 1
         CHeight# = screen height() - mousey() - 20
         if CHeight# > maxHeight then CHeight# = maxHeight
         if CHeight# < 0 then CHeight# = 0
      endif
   endif

return

`**************************
`Functions
`**************************

function UpdateWorldMesh(w)

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   for y = 1 to World(w).tz
      for x = 1 to World(w).tx
         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w

endfunction

function CreateWorldMesh(w)

   `Calculate number of triangles
   Tri = World(w).tx * World(w).tz * 2

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   `Create a memblock (3 verts each triangle)
   make memblock w, 12 + (Tri * 3 * 36)
   write memblock dword w, 0, 338
   write memblock dword w, 4, 36
   write memblock dword w, 8, Tri * 3

   `Write memblocks
   for y = 1 to World(w).tx
      for x = 1 to World(w).tz

         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         remstart
         Our face looks this way if turned = FALSE
         +-----+
         |    /|
         |   / |
         | /   |
         |/    |
         +-----+
         else
         +-----+
         |    |
         |    |
         |    |
         |    |
         +-----+
         remend

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w

endfunction

function WriteVertex(mem, nr, x#, y#, z#, nx#, ny#, nz#, uvx#, uvy#)

   pos = 12 + ((nr-1)*36)

   write memblock float mem, pos, x#
   write memblock float mem, pos+4, y#
   write memblock float mem, pos+8, z#
   write memblock float mem, pos+12,nx#
   write memblock float mem, pos+16,ny#
   write memblock float mem, pos+20,nz#
   write memblock dword mem, pos+24, rgb(255,255,255)
   write memblock float mem, pos+28, uvx#
   write memblock float mem, pos+32, uvy#

endfunction

null = make vector3(1)
null = make matrix4(3) : projection matrix4 3
null = make matrix4(4) : view matrix4 4
null = make matrix4(5) : world matrix4 5


function project3dTo2d(result as integer,x as float, y as float, z as float)
   set vector3 result,x,y,z
   view matrix4 4
   project vector3 result,result,3,4,5
endfunction

position object cursor, camera position x(), camera position y(), camera position z()
set object to camera orientation cursor
distance# = 0.0
repeat
   move object cursor, 0.5
   inc distance#, 0.5
until distance# >= 1500 or object position y(cursor) <= get ground height(matrix, object position x(cursor), object position z(cursor))

screenwidth2# = screen width() / 2.0
screenheight2# = screen height() / 2.0
scalefactor# = screen height() / 1.2

REM The offsetx#, offsety#, offsetz# variables is position at which
REM the camera is pointing to.


_Click_Matrix_Position:
   mouseposx#=mousex() - screenwidth2#
   mouseposy#=screenheight2# - mousey()

   dist#=sqrt((camera position x()-offsetx#)^2+(camera position y()-offsety#)^2+(camera position z()-offsetz#)^2)

   if mouseposy#<>0
      vectorang#=atanfull(scalefactor#,mouseposy#)
   else
      vectorang#=90.0
   endif

   if vectorang#+camera angle x()>90.965
      ratio#=mouseposy#/(sin((vectorang#+camera angle x() )-90.0))
      cursorposy#=ratio#*sin(180.0-vectorang#)
   else
      cursorposy#=1000000.0
   endif

   hyplength#=scalefactor#/sin(vectorang#)
   cursorposx#=(((ratio#*sin(90.0-camera angle x() ))/hyplength#)+1.0)*mouseposx#

   if mouseposx#<>0
      angtotal#=wrapvalue(camera angle y()-atanfull(mouseposy#,mouseposx#))
   else
      if mouseposy#<0
         angtotal#=wrapvalue(camera angle y()+90.0)
      else
         angtotal#=wrapvalue(camera angle y()-90.0)
      endif
   endif

   cameraang#=wrapvalue(360.0-camera angle y() )

   cosang#=cos(cameraang#)
   sinang#=sin(cameraang#)

   movex# = (dist#/scalefactor#)*((cosang#*cursorposx#)+((-1*sinang#)*cursorposy#))
   movez# = (dist#/scalefactor#)*((sinang#*cursorposx#)+(cosang#*cursorposy#))

   rem 3D position stored into these variables
   movex#=movex#+offsetx#
   movez#=movez#+offsetz#
   movey#=0

RETURN

remstart
`>>>>>>>>>>>>>>>>>>>>>>>> Controls <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
viewing: Crtl + wasd keys and mouse movement
Edit: Move the cursor over the world and click to edit the height
Change current height: Drag bar up/down on the right (255 = max)
Change current tool: up and down keys

Shortkeys:
W: Turns wireframe on/off (when in editing mode)
G: Turns ghost on/off (when in editing mode)
T: Turn tile when in 4-point mode.
remend

sync on : sync rate 100

`variables
#constant maxWorlds = 5
#constant maxTiles = 100
#constant maxHeight = 255.0
#constant maxTools = 2
#constant maxImages = 100

global MouseLocked as boolean
global WorldCursor as integer
global CHeight# as float
global CTool as integer
global WireFrame as integer
global Ghosted as integer

type tile
   offsetx# as float
   offsety# as float
   offsetz# as float
   turned as boolean
   tx as integer
   ty as integer
endtype
type world
   x# as float
   y# as float
   z# as float
   sx# as float
   sz# as float
   sy# as float
   tx as integer
   tz as integer
   img as integer
   imgx as integer
   imgy as integer
endtype

`initialize
dim World(maxWorlds) as world
dim Heightmap(maxWorlds, maxTiles+1, maxTiles+1) as float
dim Tile(maxWorlds, maxTiles, maxTiles) as tile

`<<<<<<<<<<<<<<<<<<< Temporary >>>>>>>>>>>>>>>>>>>>>>>>
World(1).sx# = 200.0
World(1).sy# = 50.0
World(1).sz# = 200.0
World(1).tx = 50
World(1).tz = 50

CreateWorldMesh(1)

make object 1, 1, 0
set object collision to polygons 1
`<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

`Create mouse pointer
make object cube maxWorlds + 1, 1
color object maxWorlds + 1, rgb(0, 0, 255)
set object emissive maxWorlds + 1, rgb(0,0,255)
for c = 1 to 4
   make object cube maxWorlds + 1 + c, 1
   color object maxWorlds + 1 + c, rgb(0, 255, 0)
   ghost object on maxWorlds + 1 + c
   set object emissive maxWorlds + 1 + c, rgb(0, 255, 0)
   hide object maxWorlds + 1 + c
next c

`Create vector for distances
null = make vector3(1)

`initialize
CTool = 1 : show object maxWorlds + 2
CHeight# = 0.0

`initialize camera
position camera -100, 100, 100
point camera 0, 0, 0

do

   `Handle mouse in 3D if mouse is not locked
   if MouseLocked = 0
      gosub Handle3Dmouse
      gosub EditWorld

      `show cursor
      if object visible(maxWorlds + 1) = 0 then show object maxWorlds + 1
   else

      if object visible(maxWorlds + 1) = 1 then hide object maxWorlds + 1

   endif

   `Camera movement
   if controlkey() = 1

      `Reset mouse
      if MouseLocked = 0

         `Stop the screen to "jump" when pressing ctrl
         position mouse screen width()/2, screen height()/2
         null = mousemovex()
         null = mousemovey()

         `Lock mouse
         MouseLocked = 1
      endif

      `Rotate camera with the mouse
      rotate camera wrapvalue(camera angle x() + (mousemovey()*0.2)), wrapvalue(camera angle y() + (mousemovex()*0.2)), 0
      position mouse screen width()/2, screen height()/2

      `controls
      if keystate(17) = 1 then move camera 0.5
      if keystate(31) = 1 then move camera -0.5
      if keystate(30) = 1
         position camera newxvalue(camera position x(), wrapvalue(camera angle y()-90), 0.5), camera position y(), newzvalue(camera position z(), wrapvalue(camera angle y()-90), 0.5)
      endif
      if keystate(32) = 1
         position camera newxvalue(camera position x(), wrapvalue(camera angle y()+90), 0.5), camera position y(), newzvalue(camera position z(), wrapvalue(camera angle y()+90), 0.5)
      endif
   endif

   `Control HUD
   gosub HUDControl

   `Unlock
   if controlkey() = 0 and mousex() < screen width() - 20 and mousey() < screen height() - 20 then MouseLocked = 0

   sync
loop

`Handle mouse
Handle3Dmouse:

   `get camera information
   camx# = camera position x()
   camy# = camera position y()
   camz# = camera position z()

   `setup vector
   pick screen mousex(), mousey(), 1500
   mx# = get pick vector x()
   my# = get pick vector y()
   mz# = get pick vector z()
   set vector3 1, mx#, my#, mz#
   FullDistance# = length vector3(1)

   `Get world and intersection point
   WorldCursor = 0
   for w = 1 to maxWorlds
      if object exist(w) = 1
         dist# = intersect object(w, camx#, camy#, camz#, camx# + mx#, camy# + my#, camz# + mz#)

         if dist# > 0.0
            mx# = (mx# / FullDistance# * dist#)
            my# = (my# / FullDistance# * dist#)
            mz# = (mz# / FullDistance# * dist#)
            WorldCursor = w
         endif
      endif
   next w

   `Calc world coords
   mx# = camx# + mx#
   my# = camy# + my#
   mz# = camz# + mz#

   `Update pointer
   position object maxWorlds + 1, mx#, my#, mz#

   `Get second pointer position
   tx# = World(WorldCursor).tx * (mx#+World(WorldCursor).sx#/2) / World(WorldCursor).sx#
   tz# = World(WorldCursor).tz * (mz#+World(WorldCursor).sz#/2) / World(WorldCursor).sz#
   select CTool
      case 1
         tx = int(tx# + 0.5) : tz = int(tz# + 0.5)
         PositionCursor(maxWorlds + 2, WorldCursor, tx, tz)
      endcase
      case 2
         tx = int(tx#) : tz = int(tz#)
         PositionCursor(maxWorlds + 2, WorldCursor, tx, tz)
         PositionCursor(maxWorlds + 3, WorldCursor, tx + 1, tz)
         PositionCursor(maxWorlds + 4, WorldCursor, tx, tz + 1)
         PositionCursor(maxWorlds + 5, WorldCursor, tx + 1, tz + 1)
      endcase
   endselect

return

EditWorld:

   `Change Edit Mode
   if upkey() = 1 and KeyHold = 0
      KeyHold = 1
      inc CTool
   endif
   if downkey() = 1 and KeyHold = 0
      KeyHold = 1
      dec CTool
   endif

   `Check
   if KeyHold > 0

      `Boundry
      if CTool < 1 then CTool = maxTools
      if CTool > maxTools then CTool = 1

      `Hide - unhide cursor
      select CTool
         case 1
            show object maxWorlds + 2
            hide object maxWorlds + 3
            hide object maxWorlds + 4
            hide object maxWorlds + 5
         endcase
         case 2
            for c = 1 to 4 : show object maxWorlds + 1 + c : next c
         endcase
      endselect
   endif

   `The editing itself
   if mouseclick() = 1

      `If mouse is clicked
      `Get tool
      select CTool
         case 1
            Heightmap(WorldCursor, tx + 1, tz + 1) = CHeight#
         endcase
         case 2

            if tx >= 0 and tz >= 0
               `First point
               if tx <= World(WorldCursor).tx and tz <= World(WorldCursor).tz
                  Heightmap(WorldCursor, tx + 1, tz + 1) = CHeight#

                  `Second point
                  if tx <= World(WorldCursor).tx - 1
                     Heightmap(WorldCursor, tx + 2, tz + 1) = CHeight#

                     `Third point
                     if tz <= World(WorldCursor).tz - 1
                        Heightmap(WorldCursor, tx + 2, tz + 2) = CHeight#
                     endif
                  endif

                  `Last point
                  if tz <= World(WorldCursor).tz -1
                     Heightmap(WorldCursor, tx + 1, tz + 2) = CHeight#
                  endif
               endif
            endif

         endcase
      endselect

      `Update world mesh
      UpdateWorldMesh(WorldCursor)
      change mesh WorldCursor, 0, WorldCursor

   endif

   `Right click
   if keystate(20) = 1 and CTool = 2 and KeyHold = 0
      KeyHold = 1

      `Boundries
      if tx >= 0 and tz >= 0
         if tx <= World(WorldCursor).tx - 1 and tz <= World(WorldCursor).tz - 1
            if Tile(WorldCursor, tx + 1, tz + 1).turned = 0
               Tile(WorldCursor, tx + 1, tz + 1).turned = 1
            else
               Tile(WorldCursor, tx + 1, tz + 1).turned = 0
            endif
         endif
      endif

      `Update world mesh
      UpdateWorldMesh(WorldCursor)
      change mesh WorldCursor, 0, WorldCursor
   endif

   `Wireframe on off
   if keystate(17) > 0 and KeyHold = 0
      KeyHold = 1
      Wireframe = abs(Wireframe - 1)
      if Wireframe = 1 then set object wireframe WorldCursor, 1 else set object wireframe WorldCursor, 0
   endif
   if keystate(34) > 0 and KeyHold = 0
      KeyHold = 1
      Ghosted = abs(Ghosted - 1)
      if Ghosted = 1 then ghost object on WorldCursor else ghost object off WorldCursor
   endif

   `Unlock keyhold
   if upkey() + downkey() + mouseclick() + keystate(17) + keystate(34) + keystate(20) = 0 then KeyHold = 0

return

HUDControl:

   `Display cursor information
   ink rgb(255, 255, 255), 0
   set cursor 0, 0
   print "Tile: ", tx, " : ", tz
   print "Pointed world: ", WorldCursor
   print "Current tool: ", CTool

   `Height indicator
   ink rgb(255, 0, 0), 0
   line screen width() - 10, screen height() - 20 - maxHeight, screen width() - 10, screen height() - 20
   ink rgb(0,255,0),0
   box screen width() - 11, screen height() - 21 - CHeight#, screen width() - 9, screen height() - 19 - CHeight#
   ink rgb(255,255,255),0
   center text screen width() - 10, 10, str$(CHeight#)

   `Right menu
   if mousex() > screen width() - 20
      MouseLocked = 1
      if mouseclick() = 1
         CHeight# = screen height() - mousey() - 20
         if CHeight# > maxHeight then CHeight# = maxHeight
         if CHeight# < 0 then CHeight# = 0
      endif
   endif

   `Bottom menu
   if mousey() > screen height() - 20
      MouseLocked = 1
   endif

   `Tools
   if button(60, screen height() - 10, "Tools") > 0 then gosub Tools
   if button(170, screen height() - 10, "Export") > 0 then gosub Export
   if button(280, screen height() - 10, "Exit") > 0 then end

return

Tools:

get image maxImages + 1, 0, 0, screen width(), screen height(), 1

`Initialize
FillWorld = 1
FillHeight = 0
FHeight = 0
THeight = 0
MouseTimer = 0
Tool = 1
GoOut = 0

do

   `Background
   paste image maxImages + 1, 0, 0

   `Background
   ink rgb(255, 255, 255), 0
   box 50, 50, 450, 350

   `Select tool
   if textbutton(85, 80, "<") > 0 and hold = 0
      hold = 1
      dec Tool
      if Tool < 1 then Tool = 1
   endif
   if textbutton(250, 80, ">") > 0 and hold = 0
      hold = 1
      inc Tool
      if Tool > 2 then Tool = 2
   endif

   `Display tool
   ink rgb(0, 0, 255), 0
   select Tool
      case 1
         text 100, 75, "Fill"
         gosub Fill
      endcase
      case 2
         text 100, 75, "Randomize"
         gosub WorldRand
      endcase
   endselect

   `Display quit button
   if button(200, 340, "Return") > 0 then GoOut = 1

   `Unlock mouse
   if mouseclick() = 0 then hold = 0

   `Quit tools
   if GoOut > 0
      repeat : until mouseclick() = 0
      return
   endif

   sync
loop

return

`>>>>> Tools <<<<<<<
Fill:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Height selecting
   ink 0, 0
   text 100, 115, "Height:"
   D = textbutton(250, 120, "<")
   U = textbutton(300, 120, ">")
   if U > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc FillHeight
   endif
   if D > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec FillHeight
   endif
   if D + U = 0 then MouseTimer = 0
   if FillHeight < 0 then FillHeight = 0
   if FillHeight > maxHeight then FillHeight = maxHeight
   ink 0, 0
   center text 275, 115, str$(FillHeight)

   `Apply button
   if button(200, 150, "Edit") > 0
      repeat
      until mouseclick() = 0
      if object exist(FillWorld) > 0
         for y = 1 to World(FillWorld).tz + 1
            for x = 1 to World(FillWorld).tx + 1
               Heightmap(FillWorld, x, y) = FillHeight
            next x
         next y
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
      endif
      GoOut = 1
   endif
return

WorldRand:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Display From and To Height
   ink 0, 0
   text 100, 115, "Min Height:"
   text 100, 135, "Max Height:"
   D1 = textbutton(250, 120, "<") : U1 = textbutton(300, 120, ">")
   D2 = textbutton(250, 140, "<") : U2 = textbutton(300, 140, ">")
   if U1 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc FHeight
   endif
   if D1 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec FHeight
   endif
   if U2 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc THeight
   endif
   if D2 > 0
      inc MouseTimer = 1
      if MouseTimer = 1 or MouseTimer > 50 then dec THeight
   endif

   `Boundries
   if FHeight < 0 then FHeight = 0
   if FHeight > maxHeight then FHeight = maxHeight
   if THeight < 0 then THeight = 0
   if THeight > maxHeight then THeight = maxHeight

   ink 0, 0
   center text 275, 115, str$(FHeight)
   center text 275, 135, str$(THeight)

   if D1 + U1 = 0 then MouseTimer = 0

   `Apply
   if button(200, 160, "Edit") > 0
      if object exist(FillWorld) > 0
         for y = 1 to World(FillWorld).tz + 1
            for x = 1 to World(FillWorld).tx + 1
               Heightmap(FillWorld, x, y) = FHeight + rnd(THeight - FHeight)
            next x
         next y
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
         GoOut = 1
      endif
   endif

return

`>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> EXPORT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Export:
return

`**************************
`Functions
`**************************

function textbutton(x, y, txt$)
   pressed = 0
   tx = text width(txt$) / 2
   ty = text height(txt$) / 2
   if mousex() > x - tx and mousex() < x + tx
      if mousey() > y - ty and mousey() < y + ty
         pressed = 1
      endif
   endif
   if pressed = 1 then ink rgb(0, 0, 255), 0 else ink 0, 0
   center text x, y - ty, txt$
   if mouseclick() = 0 then pressed = 0
endfunction pressed

function button(x, y, txt$)

   Pressed = 0

   `box
   ink 0, 0
   box x - 50, y - 8, x + 50, y + 8
   if mousex() > x - 50 and mousex() < x + 50 and mousey() > y - 8 and mousey() < y + 8
      ink rgb(100, 100, 255), 0
      Pressed = 1
   else
      ink rgb(255, 255, 255), 0
   endif
   box x - 49, y - 7, x + 49, y + 7

   `Text
   ink 0, 0
   center text x, y - text height(txt$)/2, txt$

   if mouseclick() = 0 then Pressed = 0

endfunction Pressed

function PositionCursor(cur, w, tx, tz)

   `Calculate position
   Ctx# = (tx * World(w).sx# / World(w).tx) - (World(w).sx#/2)
   Ctz# = (tz * World(w).sz# / World(w).tz) - (World(w).sz#/2)
   if tx >= 0 and tx <= World(w).tx
      if tz >= 0 and tz <= World(w).tz
         Cty# = World(w).sy# / maxHeight * Heightmap(w, tx + 1, tz + 1)
      endif
   endif

   `Update position
   position object cur, Ctx#, Cty#, Ctz#

endfunction

function UpdateWorldMesh(w)

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   for y = 1 to World(w).tz
      for x = 1 to World(w).tx
         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         `Turned tiles
         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w

endfunction

function CreateWorldMesh(w)

   `Calculate number of triangles
   Tri = World(w).tx * World(w).tz * 2

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   `Create a memblock (3 verts each triangle)
   make memblock w, 12 + (Tri * 3 * 36)
   write memblock dword w, 0, 338
   write memblock dword w, 4, 36
   write memblock dword w, 8, Tri * 3

   `Write memblocks
   for y = 1 to World(w).tx
      for x = 1 to World(w).tz

         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         remstart
         Our face looks this way if turned = FALSE
         +-----+
         |    /|
         |   / |
         | /   |
         |/    |
         +-----+
         else
         +-----+
         |    |
         |    |
         |    |
         |    |
         +-----+
         remend

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w

endfunction

function WriteVertex(mem, nr, x#, y#, z#, nx#, ny#, nz#, uvx#, uvy#)

   pos = 12 + ((nr-1)*36)

   write memblock float mem, pos, x#
   write memblock float mem, pos+4, y#
   write memblock float mem, pos+8, z#
   write memblock float mem, pos+12,nx#
   write memblock float mem, pos+16,ny#
   write memblock float mem, pos+20,nz#
   write memblock dword mem, pos+24, rgb(255,255,255)
   write memblock float mem, pos+28, uvx#
   write memblock float mem, pos+32, uvy#

endfunction

Our face looks this way if not turned
+-----+
|    /|
|   / |
| /   |
|/    |
+-----+
else
+-----+
|    |
|    |
|    |
|    |
+-----+

remstart
`>>>>>>>>>>>>>>>>>>>>>>>> Controls <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
viewing: Crtl + wasd keys and mouse movement
Edit: Move the cursor over the world and click to edit the height
Change current height: Drag bar up/down on the right (255 = max)
Change current tool: up and down keys

Shortkeys:
W: Turns wireframe on/off (when in editing mode)
G: Turns ghost on/off (when in editing mode)
T: Turn tile when in 4-point mode.
remend

sync on : sync rate 100

`variables
#constant maxWorlds = 5
#constant maxTiles = 100
#constant maxHeight = 255.0
#constant maxTools = 2
#constant maxImages = 100

global MouseLocked as boolean
global WorldCursor as integer
global CHeight# as float
global CTool as integer
global WireFrame as integer
global Ghosted as integer

type tile
   offsetx# as float
   offsety# as float
   offsetz# as float
   turned as boolean
   tx as integer
   ty as integer
endtype
type world
   x# as float
   y# as float
   z# as float
   sx# as float
   sz# as float
   sy# as float
   tx as integer
   tz as integer
   img as integer
   imgx as integer
   imgy as integer
endtype

`initialize
dim World(maxWorlds) as world
dim Heightmap(maxWorlds, maxTiles+1, maxTiles+1) as float
dim Tile(maxWorlds, maxTiles, maxTiles) as tile

`<<<<<<<<<<<<<<<<<<< Temporary >>>>>>>>>>>>>>>>>>>>>>>>
World(1).sx# = 200.0
World(1).sy# = 50.0
World(1).sz# = 200.0
World(1).tx = 50
World(1).tz = 50

CreateWorldMesh(1)

make object 1, 1, 0
set object collision to polygons 1
`<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

`Create mouse pointer
make object cube maxWorlds + 1, 1
color object maxWorlds + 1, rgb(0, 0, 255)
set object emissive maxWorlds + 1, rgb(0,0,255)
for c = 1 to 4
   make object cube maxWorlds + 1 + c, 1
   color object maxWorlds + 1 + c, rgb(0, 255, 0)
   ghost object on maxWorlds + 1 + c
   set object emissive maxWorlds + 1 + c, rgb(0, 255, 0)
   hide object maxWorlds + 1 + c
next c

`Create vector for distances
null = make vector3(1)

`initialize
CTool = 1 : show object maxWorlds + 2
CHeight# = 0.0

`initialize camera
position camera -100, 100, 100
point camera 0, 0, 0

do

   `Handle mouse in 3D if mouse is not locked
   if MouseLocked = 0
      gosub Handle3Dmouse
      if WorldCursor > 0 then gosub EditWorld

      `show cursor
      if object visible(maxWorlds + 1) = 0 then show object maxWorlds + 1
   else

      if object visible(maxWorlds + 1) = 1 then hide object maxWorlds + 1

   endif

   `Camera movement
   if controlkey() = 1

      `Reset mouse
      if MouseLocked = 0

         `Stop the screen to "jump" when pressing ctrl
         position mouse screen width()/2, screen height()/2
         null = mousemovex()
         null = mousemovey()

         `Lock mouse
         MouseLocked = 1
      endif

      `Rotate camera with the mouse
      rotate camera wrapvalue(camera angle x() + (mousemovey()*0.2)), wrapvalue(camera angle y() + (mousemovex()*0.2)), 0
      position mouse screen width()/2, screen height()/2

      `controls
      if keystate(17) = 1 then move camera 0.5
      if keystate(31) = 1 then move camera -0.5
      if keystate(30) = 1
         position camera newxvalue(camera position x(), wrapvalue(camera angle y()-90), 0.5), camera position y(), newzvalue(camera position z(), wrapvalue(camera angle y()-90), 0.5)
      endif
      if keystate(32) = 1
         position camera newxvalue(camera position x(), wrapvalue(camera angle y()+90), 0.5), camera position y(), newzvalue(camera position z(), wrapvalue(camera angle y()+90), 0.5)
      endif
   endif

   `Control HUD
   gosub HUDControl

   `Unlock
   if controlkey() = 0 and mousex() < screen width() - 20 and mousey() < screen height() - 20 then MouseLocked = 0

   sync
loop

`Handle mouse
Handle3Dmouse:

   `get camera information
   camx# = camera position x()
   camy# = camera position y()
   camz# = camera position z()

   `setup vector
   pick screen mousex(), mousey(), 1500
   mx# = get pick vector x()
   my# = get pick vector y()
   mz# = get pick vector z()
   set vector3 1, mx#, my#, mz#
   FullDistance# = length vector3(1)

   `Get world and intersection point
   WorldCursor = 0
   for w = 1 to maxWorlds
      if object exist(w) = 1
         dist# = intersect object(w, camx#, camy#, camz#, camx# + mx#, camy# + my#, camz# + mz#)

         if dist# > 0.0
            mx# = (mx# / FullDistance# * dist#)
            my# = (my# / FullDistance# * dist#)
            mz# = (mz# / FullDistance# * dist#)
            WorldCursor = w
         endif
      endif
   next w

   `Calc world coords
   mx# = camx# + mx#
   my# = camy# + my#
   mz# = camz# + mz#

   `Update pointer
   position object maxWorlds + 1, mx#, my#, mz#

   `Get second pointer position
   tx# = World(WorldCursor).tx * (mx#+World(WorldCursor).sx#/2) / World(WorldCursor).sx#
   tz# = World(WorldCursor).tz * (mz#+World(WorldCursor).sz#/2) / World(WorldCursor).sz#
   select CTool
      case 1
         tx = int(tx# + 0.5) : tz = int(tz# + 0.5)
         PositionCursor(maxWorlds + 2, WorldCursor, tx, tz)
      endcase
      case 2
         tx = int(tx#) : tz = int(tz#)
         PositionCursor(maxWorlds + 2, WorldCursor, tx, tz)
         PositionCursor(maxWorlds + 3, WorldCursor, tx + 1, tz)
         PositionCursor(maxWorlds + 4, WorldCursor, tx, tz + 1)
         PositionCursor(maxWorlds + 5, WorldCursor, tx + 1, tz + 1)
      endcase
   endselect

return

EditWorld:

   `Change Edit Mode
   if upkey() = 1 and KeyHold = 0
      KeyHold = 1
      inc CTool
   endif
   if downkey() = 1 and KeyHold = 0
      KeyHold = 1
      dec CTool
   endif

   `Check
   if KeyHold > 0

      `Boundry
      if CTool < 1 then CTool = maxTools
      if CTool > maxTools then CTool = 1

      `Hide - unhide cursor
      select CTool
         case 1
            show object maxWorlds + 2
            hide object maxWorlds + 3
            hide object maxWorlds + 4
            hide object maxWorlds + 5
         endcase
         case 2
            for c = 1 to 4 : show object maxWorlds + 1 + c : next c
         endcase
      endselect
   endif

   `The editing itself
   if mouseclick() = 1

      `If mouse is clicked
      `Get tool
      select CTool
         case 1
            Heightmap(WorldCursor, tx + 1, tz + 1) = CHeight#
         endcase
         case 2

            if tx >= 0 and tz >= 0
               `First point
               if tx <= World(WorldCursor).tx and tz <= World(WorldCursor).tz
                  Heightmap(WorldCursor, tx + 1, tz + 1) = CHeight#

                  `Second point
                  if tx <= World(WorldCursor).tx - 1
                     Heightmap(WorldCursor, tx + 2, tz + 1) = CHeight#

                     `Third point
                     if tz <= World(WorldCursor).tz - 1
                        Heightmap(WorldCursor, tx + 2, tz + 2) = CHeight#
                     endif
                  endif

                  `Last point
                  if tz <= World(WorldCursor).tz -1
                     Heightmap(WorldCursor, tx + 1, tz + 2) = CHeight#
                  endif
               endif
            endif

         endcase
      endselect

      `Update world mesh
      UpdateWorldMesh(WorldCursor)
      change mesh WorldCursor, 0, WorldCursor

   endif

   `Right click
   if keystate(20) = 1 and CTool = 2 and KeyHold = 0
      KeyHold = 1

      `Boundries
      if tx >= 0 and tz >= 0
         if tx <= World(WorldCursor).tx - 1 and tz <= World(WorldCursor).tz - 1
            if Tile(WorldCursor, tx + 1, tz + 1).turned = 0
               Tile(WorldCursor, tx + 1, tz + 1).turned = 1
            else
               Tile(WorldCursor, tx + 1, tz + 1).turned = 0
            endif
         endif
      endif

      `Update world mesh
      UpdateWorldMesh(WorldCursor)
      change mesh WorldCursor, 0, WorldCursor
   endif

   `Wireframe on off
   if keystate(17) > 0 and KeyHold = 0
      KeyHold = 1
      Wireframe = abs(Wireframe - 1)
      if Wireframe = 1 then set object wireframe WorldCursor, 1 else set object wireframe WorldCursor, 0
   endif
   if keystate(34) > 0 and KeyHold = 0
      KeyHold = 1
      Ghosted = abs(Ghosted - 1)
      if Ghosted = 1 then ghost object on WorldCursor else ghost object off WorldCursor
   endif

   `Unlock keyhold
   if upkey() + downkey() + mouseclick() + keystate(17) + keystate(34) + keystate(20) = 0 then KeyHold = 0

return

HUDControl:

   `Display cursor information
   ink rgb(255, 255, 255), 0
   set cursor 0, 0
   print "Tile: ", tx, " : ", tz
   print "Pointed world: ", WorldCursor
   print "Current tool: ", CTool

   `Height indicator
   ink rgb(255, 0, 0), 0
   line screen width() - 10, screen height() - 20 - maxHeight, screen width() - 10, screen height() - 20
   ink rgb(0,255,0),0
   box screen width() - 11, screen height() - 21 - CHeight#, screen width() - 9, screen height() - 19 - CHeight#
   ink rgb(255,255,255),0
   center text screen width() - 10, 10, str$(CHeight#)

   `Right menu
   if mousex() > screen width() - 20
      MouseLocked = 1
      if mouseclick() = 1
         CHeight# = screen height() - mousey() - 20
         if CHeight# > maxHeight then CHeight# = maxHeight
         if CHeight# < 0 then CHeight# = 0
      endif
   endif

   `Bottom menu
   if mousey() > screen height() - 20
      MouseLocked = 1
   endif

   `Tools
   if button(60, screen height() - 10, "Tools") > 0 then gosub Tools
   if button(170, screen height() - 10, "Export") > 0 then gosub Export
   if button(280, screen height() - 10, "Exit") > 0 then end

return

Tools:

get image maxImages + 1, 0, 0, screen width(), screen height(), 1

`Initialize
FillWorld = 1
FillHeight = 0
FHeight = 0
THeight = 0
MouseTimer = 0
Tool = 1
GoOut = 0

do

   `Background
   paste image maxImages + 1, 0, 0

   `Background
   ink rgb(255, 255, 255), 0
   box 50, 50, 450, 350

   `Select tool
   if textbutton(85, 80, "<") > 0 and hold = 0
      hold = 1
      dec Tool
      if Tool < 1 then Tool = 1
   endif
   if textbutton(250, 80, ">") > 0 and hold = 0
      hold = 1
      inc Tool
      if Tool > 2 then Tool = 2
   endif

   `Display tool
   ink rgb(0, 0, 255), 0
   select Tool
      case 1
         text 100, 75, "Fill"
         gosub Fill
      endcase
      case 2
         text 100, 75, "Randomize"
         gosub WorldRand
      endcase
   endselect

   `Display quit button
   if button(200, 340, "Return") > 0 then GoOut = 1

   `Unlock mouse
   if mouseclick() = 0 then hold = 0

   `Quit tools
   if GoOut > 0
      repeat : until mouseclick() = 0
      return
   endif

   sync
loop

return

`>>>>> Tools <<<<<<<
Fill:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Height selecting
   ink 0, 0
   text 100, 115, "Height:"
   D = textbutton(250, 120, "<")
   U = textbutton(300, 120, ">")
   if U > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc FillHeight
   endif
   if D > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec FillHeight
   endif
   if D + U = 0 then MouseTimer = 0
   if FillHeight < 0 then FillHeight = 0
   if FillHeight > maxHeight then FillHeight = maxHeight
   ink 0, 0
   center text 275, 115, str$(FillHeight)

   `Apply button
   if button(200, 150, "Edit") > 0
      repeat
      until mouseclick() = 0
      if object exist(FillWorld) > 0
         for y = 1 to World(FillWorld).tz + 1
            for x = 1 to World(FillWorld).tx + 1
               Heightmap(FillWorld, x, y) = FillHeight
            next x
         next y
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
      endif
      GoOut = 1
   endif
return

WorldRand:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Display From and To Height
   ink 0, 0
   text 100, 115, "Min Height:"
   text 100, 135, "Max Height:"
   D1 = textbutton(250, 120, "<") : U1 = textbutton(300, 120, ">")
   D2 = textbutton(250, 140, "<") : U2 = textbutton(300, 140, ">")
   if U1 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc FHeight
   endif
   if D1 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec FHeight
   endif
   if U2 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc THeight
   endif
   if D2 > 0
      inc MouseTimer = 1
      if MouseTimer = 1 or MouseTimer > 50 then dec THeight
   endif

   `Boundries
   if FHeight < 0 then FHeight = 0
   if FHeight > maxHeight then FHeight = maxHeight
   if THeight < 0 then THeight = 0
   if THeight > maxHeight then THeight = maxHeight

   ink 0, 0
   center text 275, 115, str$(FHeight)
   center text 275, 135, str$(THeight)

   if D1 + U1 = 0 then MouseTimer = 0

   `Apply
   if button(200, 160, "Edit") > 0
      if object exist(FillWorld) > 0
         for y = 1 to World(FillWorld).tz + 1
            for x = 1 to World(FillWorld).tx + 1
               Heightmap(FillWorld, x, y) = FHeight + rnd(THeight - FHeight)
            next x
         next y
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
         GoOut = 1
      endif
   endif

return

`>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> EXPORT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Export:
return

`**************************
`Functions
`**************************

function textbutton(x, y, txt$)
   pressed = 0
   tx = text width(txt$) / 2
   ty = text height(txt$) / 2
   if mousex() > x - tx and mousex() < x + tx
      if mousey() > y - ty and mousey() < y + ty
         pressed = 1
      endif
   endif
   if pressed = 1 then ink rgb(0, 0, 255), 0 else ink 0, 0
   center text x, y - ty, txt$
   if mouseclick() = 0 then pressed = 0
endfunction pressed

function button(x, y, txt$)

   Pressed = 0

   `box
   ink 0, 0
   box x - 50, y - 8, x + 50, y + 8
   if mousex() > x - 50 and mousex() < x + 50 and mousey() > y - 8 and mousey() < y + 8
      ink rgb(100, 100, 255), 0
      Pressed = 1
   else
      ink rgb(255, 255, 255), 0
   endif
   box x - 49, y - 7, x + 49, y + 7

   `Text
   ink 0, 0
   center text x, y - text height(txt$)/2, txt$

   if mouseclick() = 0 then Pressed = 0

endfunction Pressed

function PositionCursor(cur, w, tx, tz)

   `Calculate position
   Ctx# = (tx * World(w).sx# / World(w).tx) - (World(w).sx#/2)
   Ctz# = (tz * World(w).sz# / World(w).tz) - (World(w).sz#/2)
   if tx >= 0 and tx <= World(w).tx
      if tz >= 0 and tz <= World(w).tz
         Cty# = World(w).sy# / maxHeight * Heightmap(w, tx + 1, tz + 1)
      endif
   endif

   `Update position
   position object cur, Ctx#, Cty#, Ctz#

endfunction

function UpdateWorldMesh(w)

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   for y = 1 to World(w).tz
      for x = 1 to World(w).tx
         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         `Turned tiles
         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w

endfunction

function CreateWorldMesh(w)

   `Calculate number of triangles
   Tri = World(w).tx * World(w).tz * 2

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   `Create a memblock (3 verts each triangle)
   make memblock w, 12 + (Tri * 3 * 36)
   write memblock dword w, 0, 338
   write memblock dword w, 4, 36
   write memblock dword w, 8, Tri * 3

   `Write memblocks
   for y = 1 to World(w).tx
      for x = 1 to World(w).tz

         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         remstart
         Our face looks this way if turned = FALSE
         +-----+
         |    /|
         |   / |
         | /   |
         |/    |
         +-----+
         else
         +-----+
         |\    |
         | \   |
         |   \ |
         |    \|
         +-----+
         remend

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w

endfunction

function WriteVertex(mem, nr, x#, y#, z#, nx#, ny#, nz#, uvx#, uvy#)

   pos = 12 + ((nr-1)*36)

   write memblock float mem, pos, x#
   write memblock float mem, pos+4, y#
   write memblock float mem, pos+8, z#
   write memblock float mem, pos+12,nx#
   write memblock float mem, pos+16,ny#
   write memblock float mem, pos+20,nz#
   write memblock dword mem, pos+24, rgb(255,255,255)
   write memblock float mem, pos+28, uvx#
   write memblock float mem, pos+32, uvy#

endfunction

type World
   meshID as integer
   width as float
   depth as float
   xsegs as integer
   zsegs as integer
endtype

null = make vector3(1)
null = make vector3(2)
null = make matrix4(3) : projection matrix4 3
null = make matrix4(4) : view matrix4 4
null = make matrix4(5) : world matrix4 5

#constant N1 = 6
#constant N2 = 7
#constant N3 = 8
#constant N4 = 9
#constant T1 = 10
#constant T2 = 11

for t = 6 to 11
   null = make vector3(t)
next t



global myWorld as World

myWorld.meshID = 1
myWorld.width = 1000
myWorld.depth = 1000
myWorld.xsegs = 20
myWorld.zsegs = 20

`load image "D:\programming\dbpro projects\terrain_texture.jpg", 1

createWorldMesh(myWorld)
make object 1,1,0
position object 1,0,1,0

for z = 0 to myWorld.zsegs
   for x = 0 to myWorld.xsegs
   `setHeight(myWorld,x,z,rnd(20))
   next x
next z
make mesh from memblock 1,1
change mesh 1,0,1
`texture object 1,1
`scale object texture 1, 10, 10



sync on
sync rate 60

cy1# = 200
camera = 2

ink rgb(255,0,0),0

DO

   oldcx# = camera position x()
   oldcz# = camera position z()


   if camera = 1
      gosub _camera_control
   else
      gosub _control_camera

      if mousemovex() <> 0 OR mousemovey() <> 0 OR oldcx# <> camera position x() OR oldcz# <> camera position z()
         obj = pick object(mousex(), mousey(),1,1)
         if obj = 0

         else
            wx# = camera position x() + get pick vector x()
            wy# = camera position y() + get pick vector y()
            wz# = camera position z() + get pick vector z()
         endif
      endif

      if mouseclick() = 1 then raiseGround(wx#, wz#, 0.5)
      if mouseclick() = 2 then raiseGround(wx#, wz#, -0.5)

      if mouseclick() > 0 then calculateNormals(myWorld)

      outlineTile(myWorld, wx#, wz#)
   endif

   rem pick camera
   if inkey$() = "1" then camera = 1
   if inkey$() = "2" then camera = 2


   set cursor 0,0
   print screen fps()

   sync
LOOP





REM
function outlineTile(w as World,wx#,wz#)
   sx# = w.width / w.xsegs
   sz# = w.depth / w.zsegs
   tilex = wx# / sx#
   tilez = wz# / sz#

   project3dTo2d(1,tilex*sx#,getHeight#(w,tilex,tilez),tilez*sz#)
   x1 = x vector3(1)
   y1 = y vector3(1)

   project3dTo2d(1,tilex*sx#,getHeight#(w,tilex,tilez+1),(tilez+1)*sz#)
   x2 = x vector3(1)
   y2 = y vector3(1)

   project3dTo2d(1,(tilex+1)*sx#,getHeight#(w,tilex+1,tilez+1),(tilez+1)*sz#)
   x3 = x vector3(1)
   y3 = y vector3(1)

   project3dTo2d(1,(tilex+1)*sx#,getHeight#(w,tilex+1,tilez),tilez*sz#)
   x4 = x vector3(1)
   y4 = y vector3(1)

   line x1,y1,x2,y2
   line x2,y2,x3,y3
   line x3,y3,x4,y4
   line x1,y1,x4,y4
endfunction



REM
function raiseGround(wx#, wz#, height#)

   sx# = myWorld.width / myWorld.xsegs
   sz# = myWorld.depth / myWorld.zsegs
   x = (camera position x() + get pick vector x()) / sx#
   z = (camera position z() + get pick vector z()) / sz#

   setheight(myWorld, x, z, getHeight#(myWorld,x,z)+height#)
   setheight(myWorld, x, z+1, getHeight#(myWorld,x,z+1)+height#)
   setheight(myWorld, x+1, z+1, getHeight#(myWorld,x+1,z+1)+height#)
   setheight(myWorld, x+1, z, getHeight#(myWorld,x+1,z)+height#)

   make mesh from memblock myWorld.meshID, myWorld.meshID
   change mesh myWorld.meshID, 0, myWorld.meshID
   `texture object myWorld.meshID, 1
   `scale object texture myWorld.meshID, 10,10

endfunction




REM
function getHeight#(w as world, x as integer, z as integer)
   if x < 0 OR x > w.xsegs OR z < 0 OR z > w.zsegs then exitfunction 0.0
   height# = 0.0
   if x < w.xsegs and z < w.zsegs
      pos = z*w.xsegs*216 + x*216 + 12
      height# = memblock float(w.meshID, pos+4)
   else
      if x = w.xsegs
         if z = w.zsegs
            pos = (z-1)*w.xsegs*216 + (x-1)*216 + 12
            height# = memblock float(w.meshID, pos+76)
         else
            pos = z*w.xsegs*216 + (x-1)*216 + 12
            height# = memblock float(w.meshID, pos+184)
         endif
      else
         pos = (z-1)*w.xsegs*216 + x*216 + 12
         height# = memblock float(w.meshID, pos+40)
      endif
   endif
endfunction height#



REM set the height at (X,Z)
REM must set multiple verts per point because verts are not shared
function setHeight(w as World, x as integer, z as integer, height as float)
   if x < 0 OR x > w.xsegs OR z < 0 OR z > w.zsegs then exitfunction

   rem verts 3 and 5
   if x > 0 and z > 0
      tx = x-1
      tz = z-1
      pos = tz*w.xsegs*216 + tx*216 + 12
      write memblock float w.meshID, pos+76, height
      write memblock float w.meshID, pos+148, height
   endif

   rem vert 2
   if x < w.xsegs and z > 0
      tx = x
      tz = z-1
      pos = tz*w.xsegs*216 + tx*216 + 12
      write memblock float w.meshID, pos+40, height
   endif

   rem vert 6
   if x > 0 and z < w.xsegs
      tx = x-1
      tz = z
      pos = tz*w.xsegs*216 + tx*216 + 12
      write memblock float w.meshID, pos+184, height
   endif

   rem verts 1 and 4
   if x < w.xsegs and z < w.zsegs
      tx = x
      tz = z
      pos = tz*w.xsegs*216 + tx*216 + 12
      write memblock float w.meshID, pos+4, height
      write memblock float w.meshID, pos+112, height
   endif

endfunction



function project3dTo2d(result as integer,x as float, y as float, z as float)
   set vector3 result,x,y,z
   view matrix4 4
   project vector3 result,result,3,4,5
endfunction



_Control_Camera:
   cspd# = 2.0
   if upkey() then inc cz#,cspd#
   if downkey() then dec cz#,cspd#
   if rightkey() then inc cx#,cspd#
   if leftkey() then dec cx#,cspd#
   if scancode()=30 then inc cy1#,1
   if scancode()=44 then dec cy1#,1

   if cy1# < 0 then cy1# = 0

   position camera cx#,cy1#,cz#
   offsetx#=cx#
   offsety#=0
   offsetz#=cz#+200
   point camera offsetx#,offsety#,offsetz#
RETURN


_camera_control:
   spd# = 2
   if upkey()=1
    cx#=newxvalue(cx#,a#,spd#)
    cz#=newzvalue(cz#,a#,spd#)
   endif
   if downkey()=1
    cx#=newxvalue(cx#,a#,-spd#)
    cz#=newzvalue(cz#,a#,-spd#)
   endif
   if leftkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#-90.0),spd#)
    cz#=newzvalue(cz#,wrapvalue(a#-90.0),spd#)
   endif
   if rightkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#+90.0),spd#)
    cz#=newzvalue(cz#,wrapvalue(a#+90.0),spd#)
   endif

   cy# = getGroundHeight#(myWorld,cx#,cz#)
   a#=wrapvalue(a#+(mousemovex()/3.0))
   cxa#=cxa#+(mousemovey()/3.0)
   if cxa#<-90.0 then cxa#=-90.0
   if cxa#>90.0 then cxa#=90.0
   position camera cx#,cy#+40,cz#
   rotate camera wrapvalue(cxa#),a#,0
RETURN




REM returns the height on the world mesh at position (x,z)
function getGroundHeight#(w as World, x as float, z as float)
   id = w.meshID
   tsx# = w.width / w.xsegs
   tsz# = w.depth / w.zsegs

   row = z / tsz#
   column = x / tsx#

   if row < 0 OR row >= w.xsegs OR column < 0 OR column >= w.zsegs then exitfunction 0.0

   tile = row*w.xsegs + column
   znorm# = z - row * tsz#
   xnorm# = x - column * tsx#

   rem get the triangle
   if tsz#*xnorm# >= tsx#*znorm#
      pos = 12 + tile*216+112
      y1# = memblock float(id,pos)
      y2# = memblock float(id,pos+36)
      y3# = memblock float(id,pos+72)
      y# = y1#+(znorm#/tsz#)*(y2#-y3#)+(xnorm#/tsx#)*(y3#-y1#)
   else
      pos = 12 + tile*216+4
      y1# = memblock float(id,pos)
      y2# = memblock float(id,pos+36)
      y3# = memblock float(id,pos+72)
      y# = y1#+(znorm#/tsz#)*(y2#-y1#)+(xnorm#/tsx#)*(y3#-y2#)
   endif
endfunction y#















function calculateNormals(w as World)

   tsx# = w.width/w.xsegs
   tsz# = w.depth/w.zsegs

   for z = 1 to w.zsegs-1
      for x = 1 to w.xsegs-1

         count = 0

         rem root
         set vector3 2, x*tsx#, getHeight#(w,x,z), z*tsz#


         rem upper right
         set vector3 T1,0,getHeight#(w,x,z+1),tsz#
         set vector3 T2,tsx#,getHeight#(w,x+1,z),0
         subtract vector3 T1,T1,2
         subtract vector3 T2,2,T2
         cross product vector3 N1,T1,T2
         normalize vector3 N1, N1

         rem upper left
         set vector3 T1,0,getHeight#(w,x,z+1),tsz#
         set vector3 T2,-tsx#,getHeight#(w,x-1,z),0
         subtract vector3 T1,T1,2
         subtract vector3 T2,2,T2
         cross product vector3 N2,T1,T2
         normalize vector3 N2, N2

         rem lower left
         set vector3 T1,0,getHeight#(w,x,z-1),-tsz#
         set vector3 T2,-tsx#,getHeight#(w,x-1,z),0
         subtract vector3 T1,T1,2
         subtract vector3 T2,2,T2
         cross product vector3 N3,T1,T2
         normalize vector3 N3, N3

         rem lower right
         set vector3 T1,0,getHeight#(w,x,z-1),-tsz#
         set vector3 T2,tsx#,getHeight#(w,x+1,z),0
         subtract vector3 T1,T1,2
         subtract vector3 T2,2,T2
         cross product vector3 N4,T1,T2
         normalize vector3 N4, N4

         rem average 4 normals
         add vector3 N1,N1,N2
         add vector3 N1,N1,N3
         add vector3 N1,N1,N4
         divide vector3 N1,4
         `normalize vector3 N1, N1

         nx# = x vector3(N1)
         ny# = y vector3(N1)
         nz# = z vector3(N1)

         setNormal(w, x, z, nx#, ny#, nz#)


      next x
   next z
endfunction













function calculateNormals2(w as World)

   tsx# = w.width/w.xsegs
   tsz# = w.depth/w.zsegs

   for z = 1 to w.zsegs-1
      for x = 1 to w.xsegs-1

         count = 0

         rem upper right
         set vector3 T1,x*tsx#,getHeight#(w,x,z+1),(z+1)*tsz#
         set vector3 T2,(x+1)*tsx#,getHeight#(w,x+1,z),z*tsz#
         cross product vector3 N1,T1,T2
         normalize vector3 N1, N1

         rem upper left
         set vector3 T1,x*tsx#,getHeight#(w,x,z+1),(z+1)*tsz#
         set vector3 T2,(x-1)*tsx#,getHeight#(w,x-1,z),z*tsz#
         cross product vector3 N2,T1,T2
         normalize vector3 N2, N2

         rem lower left
         set vector3 T1,x*tsx#,getHeight#(w,x,z-1),(z-1)*tsz#
         set vector3 T2,(x-1)*tsx#,getHeight#(w,x-1,z),z*tsz#
         cross product vector3 N3,T1,T2
         normalize vector3 N3, N3

         rem lower right
         set vector3 T1,x*tsx#,getHeight#(w,x,z-1),(z-1)*tsz#
         set vector3 T2,(x+1)*tsx#,getHeight#(w,x+1,z),z*tsz#
         cross product vector3 N4,T1,T2
         normalize vector3 N4, N4

         rem average 4 normals
         add vector3 N1,N1,N2
         add vector3 N1,N1,N3
         add vector3 N1,N1,N4
         divide vector3 N1,4
         `normalize vector3 N1, N1

         nx# = x vector3(N1)
         ny# = y vector3(N1)
         nz# = z vector3(N1)


         `setNormal(w, x, z, nx#, ny#, nz#)


         subtract vector3 N1,N2,N1
         subtract vector3 N2,N3,N2

         cross product vector3 N1,N1,N2
         `normalize vector3 N1, N1

         nx# = x vector3(N1)
         ny# = y vector3(N1)
         nz# = z vector3(N1)

         setNormal(w, x, z, nx#, ny#, nz#)


      next x
   next z
endfunction






REM set the normal at (X,Z)
function setNormal(w as World, x as integer, z as integer, nx as float, ny as float, nz as float)
   if x < 0 OR x > w.xsegs OR z < 0 OR z > w.zsegs then exitfunction

   rem verts 3 and 5
   if x > 0 and z > 0
      tx = x-1
      tz = z-1
      pos = tz*w.xsegs*216 + tx*216 + 12
      write memblock float w.meshID, pos+84,nx
      write memblock float w.meshID, pos+88,ny
      write memblock float w.meshID, pos+92,nz

      write memblock float w.meshID, pos+156, nx
      write memblock float w.meshID, pos+160, ny
      write memblock float w.meshID, pos+164, nz
   endif

   rem vert 2
   if x < w.xsegs and z > 0
      tx = x
      tz = z-1
      pos = tz*w.xsegs*216 + tx*216 + 12
      write memblock float w.meshID, pos+48, nx
      write memblock float w.meshID, pos+52, ny
      write memblock float w.meshID, pos+56, nz
   endif

   rem vert 6
   if x > 0 and z < w.xsegs
      tx = x-1
      tz = z
      pos = tz*w.xsegs*216 + tx*216 + 12
      write memblock float w.meshID, pos+192, nx
      write memblock float w.meshID, pos+196, ny
      write memblock float w.meshID, pos+200, nz
   endif

   rem verts 1 and 4
   if x < w.xsegs and z < w.zsegs
      tx = x
      tz = z
      pos = tz*w.xsegs*216 + tx*216 + 12
      write memblock float w.meshID, pos+12, nx
      write memblock float w.meshID, pos+16, ny
      write memblock float w.meshID, pos+20, nz

      write memblock float w.meshID, pos+120, nx
      write memblock float w.meshID, pos+124, ny
      write memblock float w.meshID, pos+128, nz
   endif
endfunction



REM set the diffuse at (X,Z)
function setDiffuse(w as World, x as integer, z as integer, color as dword)
   if x < 0 OR x > w.xsegs OR z < 0 OR z > w.zsegs then exitfunction

   rem verts 3 and 5
   if x > 0 and z > 0
      tx = x-1
      tz = z-1
      pos = tz*w.xsegs*216 + tx*216 + 12
      write memblock dword w.meshID, pos+96, color
      write memblock dword w.meshID, pos+168, color
   endif

   rem vert 2
   if x < w.xsegs and z > 0
      tx = x
      tz = z-1
      pos = tz*w.xsegs*216 + tx*216 + 12
      write memblock dword w.meshID, pos+60, color
   endif

   rem vert 6
   if x > 0 and z < w.xsegs
      tx = x-1
      tz = z
      pos = tz*w.xsegs*216 + tx*216 + 12
      write memblock dword w.meshID, pos+204, color
   endif

   rem verts 1 and 4
   if x < w.xsegs and z < w.zsegs
      tx = x
      tz = z
      pos = tz*w.xsegs*216 + tx*216 + 12
      write memblock dword w.meshID, pos+24, color
      write memblock dword w.meshID, pos+132, color
   endif

endfunction




REM creates a matrix-like mesh
function createWorldMesh(w as World)

   id = w.meshID
   width# = w.width
   depth# = w.depth
   xsegs = w.xsegs
   zsegs = w.zsegs

   rem 6 verts per square, 36 bytes per vert
   size = 12 + xsegs*zsegs*6*36
   make memblock id, size

   rem write 12 byte header
   write memblock dword id, 0, 338
   write memblock dword id, 4, 36
   write memblock dword id, 8, xsegs*zsegs*6

   sizeX# = width# / xsegs
   sizeZ# = depth# / zsegs

   for z = 1 to zsegs
      for x = 1 to xsegs
         pos = 12 + (xsegs*(z-1) + (x-1))*216 : `216 bytes per square (36*6)

         x1# = (x-1)*sizeX#
         z1# = (z-1)*sizeZ#
         x2# = x*sizeX#
         z2# = z*sizeZ#

         u1# = x1#/width#
         v1# = z1#/depth#
         u2# = x2#/width#
         v2# = z2#/depth#

         writeVertex(id,pos,x1#,0,z1#,0,1,0,u1#,v1#)
         writeVertex(id,pos+36,x1#,0,z2#,0,1,0,u1#,v2#)
         writeVertex(id,pos+72,x2#,0,z2#,0,1,0,u2#,v2#)
         writeVertex(id,pos+108,x1#,0,z1#,0,1,0,u1#,v1#)
         writeVertex(id,pos+144,x2#,0,z2#,0,1,0,u2#,v2#)
         writeVertex(id,pos+180,x2#,0,z1#,0,1,0,u2#,v1#)

      next x
   next z

   make mesh from memblock id, id
endfunction




REM x,y,z, normals(x,y,z), diffuse color, UV
function writeVertex(id, pos, x#, y#, z#, nx#, ny#, nz#, u#, v#)
   write memblock float id, pos, x#
   write memblock float id, pos+4, y#
   write memblock float id, pos+8, z#
   write memblock float id, pos+12, nx#
   write memblock float id, pos+16, ny#
   write memblock float id, pos+20, nz#
   write memblock dword id, pos+24, rgb(255,255,255)
   write memblock float id, pos+28, u#
   write memblock float id, pos+32, v#
endfunction

rem particle deposition
function particle_matrix(xsegs, zsegs, iterations, h#)
   x = rnd(xsegs)
   z = rnd(zsegs)
   for i = 1 to iterations
      if x > 0 and x < xsegs and z > 0 and z < zsegs
         set matrix height 1,x,z,get matrix height(1,x,z)+h#
         heights#(x,z) = get matrix height(1,x,z)+h#
      endif
         v = rnd(3)+1
         select v
            case 1: inc x,1 : endcase
            case 2: dec x,1 : endcase
            case 3: inc z,1 : endcase
            case 4: dec z,1 : endcase
         endselect
   next i
   update matrix 1
endfunction

Rem Project: 007Terrain
Rem Created: 23/05/2006 01:02:57

Rem ***** Main Source File *****

rem **************************************************

    Gosub INIT_VariablesAndDatastructures

    InitDisplay()

    CreateMain()

    CreateButtons()

    CreateBrushTexture()

    DefaultTerrain()

rem **************************************************
rem **************************************************
rem **************************************************

    set current bitmap 0

    do

        rem **************************************************
        rem Refresh main GUI to enable menu change
        rem **************************************************

        paste image 1,0,0,1

        rem **************************************************
        rem Check for new action
        rem **************************************************

        MseBtn = mouseclick()

        if mousex() >= 24 and mousex() <=1000 and mousey() >= 24 and mousey() <=640

            rem Actions when mouse in viewport
            select OD(0).MainAction

                case 1

                     MoveCamera( MseBtn )

                endcase

                case 2

                    if controlkey() then MoveCamera( MseBtn )

                    CalcBrushCentrePoint()
                    CalcBrushPosition()

                    if MseBtn

                        if not controlkey() then  RaiseLower( MseBtn )

                    endif

                endcase

            endselect

        else

            rem Check for a menu button press

            if MseBtn

                Button = CheckMainButtons()

                if Button <> -1

                    Buttons(Button).State = 1
                    ClearButtonGroup( "MAIN", Button )

                    OD(0).Menu = Buttons(Button).Action
                    OD(0).Group = Buttons(Button).Title

                else

                    if OD(0).Menu <> -1

                        Button = CheckSubButtons( OD(0).Group )

                        if Button <> - 1

                            rem **************************************************
                            rem Instigate a repeat delay
                            rem **************************************************

                            if OD(0).LastButton = Button

                                Buttons(Button).State = 1
                                OD(0).Action = Buttons(Button).Action

                                if OD(0).RepeatCount = -1

                                    OD(0).RepeatCount = 1

                                else

                                    inc OD(0).RepeatCount

                                    if OD(0).RepeatCount >= OD(0).RepeatDelay

                                        OD(0).RepeatCount = 0
                                        OD(0).RepeatDelay = 10

                                    endif

                                endif

                            else

                                if OD(0).RepeatCount = -1

                                    Buttons(Button).State = 1
                                    OD(0).Action = Buttons(Button).Action
                                    OD(0).LastButton = Button

                                endif

                            endif

                        endif

                    endif

                endif

            else

                OD(0).Action = -1
                OD(0).RepeatCount = -1
                OD(0).LastButton = -1
                OD(0).RepeatDelay = 100

            endif

        endif

        rem **************************************************
        rem Display menu's and buttons in current state
        rem **************************************************

        ShowButtons( "MAIN" )

        if OD(0).Menu <> -1

            DisplaySubMenu()

        endif

        rem **************************************************
        rem Perform current action if any
        rem **************************************************

        if OD(0).Action <> -1

            PerformCurrentAction()

        endif

        rem **************************************************
        rem **************************************************

        sync

    loop

rem **************************************************
rem **************************************************
rem **************************************************
function RaiseLower( UpDown )

    Adjust# = BD(0).Magnitude / 10.0
    if UpDown = 2 then Adjust# = Adjust# * -1

    off# = TD(0).SegSize / -2

    boffx# = (BD(0).Width * off# ) + off#
    boffz# = (BD(0).Length * off# ) + off#

    if IsEven( BD(0).Width ) then boffx# = boffx# + off#
    if IsEven( BD(0).Length ) then boffz# = boffz# + off#

    obj = 10

    lock vertexdata for limb 1,0,2

    for z = 1 to BD(0).Length

        for x = 1 to BD(0).Width

            if object exist(obj) then delete object obj

            mrkx# = BD(0).Xpos + boffx# + ( x * TD(0).SegSize )
            mrkz# = BD(0).Zpos + boffz# + ( z * TD(0).SegSize )

            vert_x = int(mrkx# - ( TD(0).Segments * off# ) ) / TD(0).SegSize
            vert_z = int(mrkz# - ( TD(0).Segments * off# ) ) / TD(0).SegSize

            TWidth_Offset = ( TD(0).Segments * 6 )

            if vert_x >= 0 and vert_x < TD(0).Segments and vert_z >=0 and vert_z < TD(0).Segments

                rem 1st vertex
                prime_index = ( vert_x * 6 ) + ( vert_z * TWidth_Offset )
                ChangeVertexHeight( prime_index, Adjust# )

                if vert_x > 0

                    rem 2nd vertex
                    vert_index = prime_index - 1
                    if vert_index >=0 then ChangeVertexHeight( vert_index, Adjust# )

                    rem 3rd vertex
                    vert_index = prime_index - 4
                    if vert_index >=0 then ChangeVertexHeight( vert_index, Adjust# )

                endif

                if vert_z > 0

                    rem 4th vertex
                    vert_index = prime_index - ( TWidth_Offset + 2 )
                    if vert_index >=0 then ChangeVertexHeight( vert_index, Adjust# )

                    rem 5th vertex
                    vert_index = prime_index - ( TWidth_Offset - 1 )
                    if vert_index >=0 then ChangeVertexHeight( vert_index, Adjust# )

                    rem 6th vertex
                    vert_index = prime_index - ( TWidth_Offset - 3 )
                    if vert_index >=0 then ChangeVertexHeight( vert_index, Adjust# )

                endif

                clone object obj, 3
                position object obj, mrkx#,0,mrkz#

            endif

            inc obj

        next x

    next z

    unlock vertexdata

endfunction

function ChangeVertexHeight( vert_index, Adjust# )

    vx# = get vertexdata position x( vert_index )
    vy# = get vertexdata position y( vert_index )
    vz# = get vertexdata position z( vert_index )

    set vertexdata position vert_index, vx#, vy# + Adjust#, vz#

endfunction

function CircleFill( cx,cy,rad )

    radsq = rad^2

    for x = 0 to rad

        y = sqrt( radsq - ( x^2 ) )

        line cx+x, cy+y, cx+x, cy-1-y
        line cx-1-x, cy+y, cx-1-x, cy-1-y

    next x

endfunction

function IsEven( CheckNum# )

    if CheckNum# / 2 = Int(CheckNum# / 2)
        Result = 1
    else
        Result = 0
    endif

endfunction Result

function CalcBrushPosition()

    off# = TD(0).SegSize / -2

    boffx# = BD(0).Width * off#
    boffz# = BD(0).Length * off#

    if IsEven( BD(0).Width ) then boffx# = boffx# + off#
    if IsEven( BD(0).Length ) then boffz# = boffz# + off#

    msecntrx# = object screen x(3)
    msecntry# = object screen y(3)

    msedx# = mousex()-msecntrx#
    msedy# = msecntry# - mousey()

    Ypos# = camera position y()

    msed# = sqrt( ( msedx#^2 ) + (msedy#^2) )
    hma# = atanfull( msedx#, msedy# )

    hma#=wrapvalue(hma#+camera angle y())

    hmx# = newxvalue( BD(0).CentreX, hma#, msed# )
    hmz# = newzvalue( BD(0).CentreZ, hma#, msed# )

    BD(0).Xpos = int( hmx# / TD(0).SegSize ) * TD(0).SegSize
    BD(0).Zpos = int( hmz# / TD(0).SegSize ) * TD(0).SegSize

    position object 2, BD(0).Xpos + boffx#, 1, BD(0).Zpos + boffz#

endfunction

function CalcBrushCentrePoint()

    cya# = camera angle y()
    cxa# = wrapvalue(camera angle x())

    cht# = camera position y()

    if cxa# = 90 or cxa#=270
        zd#=0
    else
        zd# = cht# / tan( cxa# )
    endif

    hmcx# = newxvalue( camera position x(), cya#, zd# )
    hmcz# = newzvalue( camera position z(), cya#, zd# )

    BD(0).CentreX = int( hmcx# / TD(0).SegSize ) * TD(0).SegSize
    BD(0).CentreZ = int( hmcz# / TD(0).SegSize ) * TD(0).SegSize

    position object 3,BD(0).CentreX, 0, BD(0).CentreZ

endfunction

function MoveCamera( MoveType )

    Xpos# = camera position x()
    Ypos# = camera position y()
    Zpos# = camera position z()

    Xang# = camera angle x()
    Yang# = camera angle y()
    Zang# = camera angle z()

    XSpeed# = mousemovex()
    YSpeed# = mousemovez() / - 10.0
    ZSpeed# = mousemovey()

    rem Also need zoom keys incase no mouse wheel
    if YSpeed# = 0

        YSpeed# = ( keystate(31) - keystate(17) )
        YSpeed#=YSpeed# / 5.0

    endif

    SpeedScale# = ( Ypos# / 100 )
    if SpeedScale# > 1.0 then SpeedScale# = 1.0
    if SpeedScale# < 0.05 then SpeedScale# = 0.05

    select MoveType

        case 1

            XSpeed# = XSpeed# * SpeedScale#
            ZSpeed# = ZSpeed# * SpeedScale#

            Xpos# = newxvalue( Xpos#, Yang#, ZSpeed# )
            Zpos# = newzvalue( Zpos#, Yang#, ZSpeed# )

            Xpos# = newxvalue( Xpos#, wrapvalue( Yang# + 90 ), -XSpeed# )
            Zpos# = newzvalue( Zpos#, wrapvalue( Yang# + 90 ), -XSpeed# )

        endcase

        case 2

            inc YAng#, XSpeed#
            inc Xang#, ZSpeed#

            if wrapvalue(XAng#) >85 then XAng# = 85
            if wrapvalue(XAng#) <10 then XAng# = 10

        endcase

    endselect

    if YSpeed# <0 then YSpeed# = YSpeed# * SpeedScale#
    Ypos# = Ypos# + YSpeed#

    position camera Xpos#, Ypos#, Zpos#
    rotate camera XAng#, YAng#, ZAng#

endfunction

function DefaultTerrain()

    TD(0).Name = "Default"
    TD(0).Segments = 50
    TD(0).SegSize = 10
    TD(0).Saved = 0

    CreateTerrain()

    BD(0).Width = 1
    BD(0).Length = 1
    BD(0).Magnitude = 1

    OD(0).Menu = 4
    OD(0).MainAction = 1

endfunction

function CreateBrush( Shape )

    w# = BD(0).Width * TD(0).SegSize
    l# = BD(0).Length * TD(0).SegSize
    wseg = BD(0).Width * 2
    lseg = BD(0).Length * 2

    so# = TD(0).SegSize / -2

    if object exist(2) then delete object 2
    CreateFlatMesh( wseg, lseg, (TD(0).SegSize / 2) )
    make object 2, 1, 0
    delete mesh 1

    set object texture 2,0,8
    texture object 2,Shape

    ghost object on 2
    fade object 2, 50

    rem set object texture 2,0,4
    rem scale object texture 2,.5,.5
    Position object 2, so#,1,so#

    rem if matrix exist(2) then delete matrix 2
    rem make matrix 2, w#, l#, wseg, lseg
    rem ghost matrix on 2
    rem prepare matrix texture 2,100,2,1
    rem fill matrix 2,0,2
    rem position matrix 2, so#,1,so#

endfunction

function CreateBrushTexture()

    create bitmap 2,256,256
    ink rgb(200,200,255),rgb(200,200,255)

    box 0,0,256,256

    get image 2,0,0,256,256,1

    cls 0

    CircleFill( 128,128,127 )

    get image 3,0,0,256,256,1

endfunction

function CreateTerrain()

    TSize = TD(0).Segments*TD(0).SegSize
    offset# = TSize / -2

    if object exist(1) then delete object 1

    CreateFlatMesh( TD(0).Segments, TD(0).Segments, TD(0).SegSize )
    make object 1, 1, 0
    delete mesh 1

    set object wireframe 1,1
    set object cull 1,1

    position object 1, offset#,0,offset#

    position camera 0,100,0
    xrotate camera 10

endfunction

function WriteVertexToMemblock( Memblock, PTR, X#, Y#, Z#, NX#, NY#, NZ#, COL, U#, V# )

    Rem Vertex Xpos
    write memblock float Memblock, PTR, X#
    inc PTR,4

    Rem Vertex Ypos
    write memblock float Memblock, PTR, Y#
    inc PTR,4

    Rem Vertex Zpos
    write memblock float Memblock, PTR, Z#
    inc PTR,4

    rem Vertex Normal X
    write memblock float Memblock, PTR, NX#
    inc PTR,4

    rem Vertex Normal Y
    write memblock float Memblock, PTR, NY#
    inc PTR,4

    rem Vertex Normal Z
    write memblock float Memblock, PTR, NZ#
    inc PTR,4

    rem Vertex Colour
    write memblock dword Memblock, PTR, COL
    inc PTR,4

    rem Vertex Texture U Co-ord
    write memblock float Memblock, PTR, U#
    inc PTR,4

    rem Vertex Texture V Co-ord
    write memblock float Memblock, PTR, V#
    inc PTR,4

endfunction PTR

function CreateFlatMesh( Segx#, Segz#, SegSize# )

    Memblock=1
    VertexCount = (Segx#*Segz#)*6

    make memblock Memblock, (VertexCount * 36) + 12

    write memblock dword Memblock, 0, 338

    write memblock dword Memblock, 4, 36

    write memblock dword Memblock, 8, VertexCount

    PTR=12

    for z = 0 to Segz#-1

        for x = 0 to Segx#-1

            x#=x
            z#=z

            lft# = x#*SegSize#
            rgt# = (x#+1)*SegSize#
            btm# = z#*SegSize#
            top# = (z#+1)*SegSize#

            lftU# = x# / Segx#
            rgtU# = (x#+1) / Segx#
            btmV# = z# / Segz#
            topV# = (z#+1) / Segz#

            col =  rgb(rnd(50),rnd(100)+60,rnd(50))
            rem First triangle
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, btm#, 0, 1, 0, col , lftU#, btmV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# )

            rem Second Triangle
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, top#, 0, 1, 0, col, rgtU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# )

        next x

    next z

    make mesh from memblock 1, 1
    delete memblock 1

endfunction

function CreateButtons()

    sync
    restore ButtonData

    for l = 0 to ButtonCount(0)

        read Buttons( l ).Group
        read Buttons( l ).SubGroup
        read Buttons( l ).Title
        read Buttons( l ).Action
        read Buttons( l ).Xpos
        read Buttons( l ).Ypos
        read Buttons( l ).Width
        read Buttons( l ).Height

        Buttons( l ).State = -1

        if bitmap exist(2) = 1
            delete bitmap 2
        endif

        create bitmap 2, Buttons( l ).Width, Buttons( l ).Height

        Buttons( l ).UpImage = CreateButton( l, (l*2)+4, 0, rgb( 100,50,50), rgb(255,255,0) )
        Buttons( l ).DnImage = CreateButton( l, (l*2)+5, 1, rgb( 100,50,50), rgb(255,255,0) )

        delete bitmap 2

    next l

endfunction

function CreateButton( BI, ImageNum, State, BackColour, TextColour )

    cls BackColour

    set text font "Arial"
    set text to bold
    set text size 14

    x = ( Buttons( BI ).Width / 2 )
    y = ( Buttons( BI ).Height / 2 ) - 7

    Width = Buttons( BI ).Width
    Height = Buttons( BI ).Height

    ink 0,0
    center text x, y, Buttons( BI ).Title

    blur bitmap 2,6

    if state = 0
        ink rgb(255,255,255),0
    else
        ink 0,0
    endif

    line 1,1,1,Height-1
    line 1,1,Width-1,1

    if state = 0
        ink 0,0
    else
        ink rgb(255,255,255),0
    endif

    line Width-3,Height-3,Width-3,1
    line Width-3,Height-3,1,Height-3

    ink rgb(1,1,1),0
    center text x, y, Buttons( BI ).Title

    blur bitmap 2,6

    line 0,0,Width,0
    line 0,0,0,Height
    line 0,Height,Width,Height
    line Width,Height,Width,0

    ink TextColour,0
    center text x, y, Buttons( BI ).Title

    get image ImageNum, 0, 0, Width, Height

endfunction ImageNum

function CheckMainButtons()

    ButtonPressed = -1

    for l = 0 to 2

        xmin = Buttons( l ).Xpos
        ymin = Buttons( l ).Ypos
        xmax = xmin + Buttons( l ).Width
        ymax = ymin + Buttons( l ).Height

        if mousex() >= xmin and mousex() <= xmax and mousey() >= ymin and mousey() <= ymax

            ButtonPressed = l

        endif

    next l

endfunction ButtonPressed

function CheckSubButtons( Group$ )

    ButtonPressed = -1

    for l = 3 to ButtonCount(0)

        if Buttons(l).Group = Group$

            xmin = Buttons( l ).Xpos
            ymin = Buttons( l ).Ypos
            xmax = xmin + Buttons( l ).Width
            ymax = ymin + Buttons( l ).Height

            if mousex() >= xmin and mousex() <= xmax and mousey() >= ymin and mousey() <= ymax

                ButtonPressed = l

            endif

        endif

    next l

endfunction ButtonPressed

function ClearButtonGroup( Group$, Selected )

    for l = 0 to ButtonCount(0)

        if Buttons(l).Group = Group$

            if l <> Selected then Buttons(l).State = -1

        endif

    next l

endfunction

function ClearButtonSubGroup( SubGroup$, Selected )

    for l = 0 to ButtonCount(0)

        if Buttons(l).SubGroup = SubGroup$

            if l <> Selected then Buttons(l).State = -1

        endif

    next l

endfunction

function ShowButtons( Group$ )

    for l = 0 to ButtonCount(0)

        if Buttons( l ).Group = Group$

            if Buttons( l ).State = 1

                img = Buttons( l ).DnImage

            else

                img = Buttons( l ).UpImage

            endif

            paste image img, Buttons( l ).Xpos, Buttons( l ).Ypos

        endif

    next l

endfunction

function InitDisplay()

    set display mode 1024,768,32

    autocam off

    sync on
    sync rate 0

    set camera view 24,24,1000,640

    set ambient light 15

    fog on
    fog color 100,100,200
    fog distance 2000

    backdrop on
    color backdrop rgb(100,100,125)

endfunction

function CreateMain()

    create bitmap 1,1024,768

    cls rgb(100,100,100)

    ink rgb(1,1,1),0
    box 3,3,1021,765

    ink rgb(100,150,100),0
    box 4,4,1020,764

    rem Viewport
    ink rgb(1,1,1),0
    box 22,22,1002,642
    ink 0,0
    box 24,24,1000,640

    rem sub action panel
    ink rgb(1,1,1),0
    box 254,654,1002,746
    ink rgb(90,110,90),0
    box 256,656,1000,744

    get image 1,0,0,1024,768
    delete bitmap 1

endfunction

function DisplaySubMenu()

    ink rgb(10,40,10),0

    select OD(0).Menu

        rem File Menu
        case 1

            if object exist(2) then delete object 2

            text 270,666, "Filename"
            text 340,666, ":  " + TD(0).Name
            text 270,692, "Segments"
            text 340,692, ":  " + str$( TD(0).Segments )
            text 270,718, "Seg Size"
            text 340,718, ":  " + str$( TD(0).SegSize )

            OD(0).MainAction = 1

        endcase

        rem Mold Menu
        case 2

            text 270,666, "Brush Width"
            text 360,666, ":  " + str$( BD(0).Width )
            text 270,692, "Brush Length"
            text 360,692, ":  " + str$( BD(0).Length )
            text 270,718, "Magnitude"
            text 360,718, ":  " + str$( BD(0).Magnitude )

            if OD(0).MainAction <>2

                if Buttons(12).State = 1 then BD(0).MBShape = 2
                if Buttons(13).State = 1 then BD(0).MBShape = 3

                if BD(0).MBShape = 0

                    Buttons(12).State = 1
                    BD(0).MBShape = 2

                endif

                if object exist(3) then delete object 3
                make object sphere 3,2
                color object 3, rgb(255,0,0)

                CreateBrush( BD(0).MBShape )
                CalcBrushCentrePoint()
                CalcBrushPosition()

                OD(0).MainAction = 2

            endif

        endcase

        rem Paint Menu
        case 3

            text 270,666, "Brush Width"
            text 360,666, ":  " + str$( BD(0).Width )
            text 270,692, "Brush Length"
            text 360,692, ":  " + str$( BD(0).Length )
            text 270,718, "Magnitude"
            text 360,718, ":  " + str$( BD(0).Magnitude )

            OD(0).MainAction = 3

        endcase

        case 4

            text 270,660, "Welcome to the 007 Terrain Editor by McLaine."
            text 270,676, "In 'FILE' mode, move and turn by clicking and dragging in the viewport. 'W' & 'S' or mousewheel to zoom."
            text 270,692, "In 'MOLD' mode, Left Click in viewport to raise ground. Right Click to lower ground."
            text 270,708, "In 'MOLD' mode, hold control to allow camera movement as in 'FILE' mode."
            text 270,724, "There are some bugs, most notably 'NORM' and 'SMOOTH'. They work but are slow and unpredictable."

        endcase

    endselect

    ShowButtons( OD(0).Group )

endfunction

function PerformCurrentAction()

    select OD(0).Menu

        case 1

            FileAction()

        endcase

        case 2

            MoldAction()

        endcase

        case 3

            PaintAction()

        endcase

    endselect

endfunction

function FileAction()

    if OD(0).RepeatCount <= 0

       select OD(0).Action

           rem Load Terrain
           case 1

               set cursor 550,666
               input "Load file: ", fn$

           endcase

           rem Save Terrain
           case 2

               set cursor 550,666
               input "Save as: ", fn$

           endcase

           rem New Terrain
           case 3

               set cursor 550,666
               input "New filename: ", TD(0).Name
               set cursor 550,692
               input "Segments: ", TD(0).Segments
               set cursor 550,718
               input "Segment Size: ", TD(0).SegSize

               CreateTerrain()

           endcase

       endselect

    endif

    ClearButtonGroup( "FILE", -1 )
    OD(0).Action = -1

endfunction

function MoldAction()

    if OD(0).Action >=1 and OD(0).Action <=6

        if OD(0).RepeatCount <=0

            ChangeBrushSize()
            CreateBrush( BD(0).MBShape )

        endif

        ClearButtonSubGroup( "MBSIZE", -1 )

    endif

    if OD(0).Action = 7 or OD(0).Action = 8

        if OD(0).RepeatCount <=0

            ChangeBrushShape()
            CreateBrush( BD(0).MBShape )

        endif

        ClearButtonSubGroup( "MBSHAPE", OD(0).LastButton )

    endif

    if OD(0).Action >= 9 and OD(0).Action <=12

            ClearButtonSubGroup( "MBTYPE1", OD(0).LastButton )

    endif

    if OD(0).Action = 13

        if OD(0).RepeatCount <=0

            if TD(0).Solid = 0

                TD(0).Solid = 1
                set object wireframe 1, 0

            else

                TD(0).Solid = 0
                set object wireframe 1, 1

            endif

        else

            rem No Repeat
            OD(0).RepeatCount = 1

        endif

        if TD(0).Solid = 0 then ClearButtonSubGroup( "TTYPE", -1 )

    endif

    if OD(0).Action >= 13 and OD(0).Action <=15

        if OD(0).RepeatCount <=0

            select OD(0).Action

                case 14

                    lock vertexdata for limb 1,0
                    set object normals 1
                    unlock vertexdata

                endcase

                case 15

                    set object smoothing 1, 50

                endcase

            endselect

        else

            rem No Repeat
            OD(0).RepeatCount = 1

        endif

        ClearButtonSubGroup( "TEROP", -1 )

    endif

    OD(0).Action = -1

endfunction

function PaintAction()

endfunction

function ChangeBrushShape()

    select OD(0).Action

        case 7

            BD(0).MBShape = 2

        endcase

        case 8

            BD(0).MBShape = 3

        endcase

    endselect

endfunction

function ChangeBrushSize()

    select OD(0).Action

        rem Decrease Brush Width
        case 1

            if BD(0).Width > 1 then dec BD(0).Width

        endcase

        rem Increase Brush Width
        case 2

            if BD(0).Width < TD(0).Segments then inc BD(0).Width

        endcase

        rem Decrease Brush Length
        case 3

            if BD(0).Length > 1 then dec BD(0).Length

        endcase

        rem Increase Brush Length
        case 4

            if BD(0).Length < TD(0).Segments then inc BD(0).Length

        endcase

        rem Decrease Brush Magnitude
        case 5

            if BD(0).Magnitude > 1 then dec BD(0).Magnitude

        endcase

        rem Increase Brush Magnitude
        case 6

            if BD(0).Magnitude < 100 then inc BD(0).Magnitude

        endcase

    endselect

endfunction

rem **************************************************

INIT_VariablesAndDatastructures:

    type Camera

        XPos# as float
        YPos# as float
        ZPos# as float

        XAng# as float
        YAng# as float
        ZAng# as float

        Pitch# as float
        Yaw# as float
        Roll# as float

        Slide# as float
        Speed# as float

    endtype

    type Button

        Group as string
        SubGroup as string
        Title as string
        Action as integer
        Xpos as integer
        Ypos as integer
        Width as integer
        Height as integer
        State as integer
        UpImage as integer
        DnImage as integer

    endtype

    type Terrain

        Name as String
        Segments as integer
        SegSize as float
        Saved as integer
        Solid as integer

    endtype

    type Operation

        Menu as integer
        Group as string
        MainAction as integer
        Action as integer
        LastButton as integer
        RepeatCount as integer
        RepeatDelay as integer

    endtype

    type Brush

        Width as integer
        Length as integer
        Magnitude as integer
        MBShape as integer
        CentreX as float
        CentreZ as float
        Xpos as float
        Zpos as float

    endtype

    dim PD(0) as Camera
    dim TD(0) as Terrain
    dim OD(0) as Operation
    dim BD(0) as Brush

    dim ButtonCount(0) as integer
        ButtonCount(0)= 22

    dim Buttons( ButtonCount(0) ) as Button

return

rem **************************************************

ButtonData:
data "MAIN", "MAIN", "FILE", 1, 28, 656, 64, 24
data "MAIN", "MAIN", "MOLD", 2, 102, 656, 64, 24
data "MAIN", "MAIN", "PAINT", 3, 176, 656, 64, 24
data "FILE", "FILE", "LOAD", 1, 450, 660, 64, 24
data "FILE", "FILE", "SAVE", 2, 450, 688, 64, 24
data "FILE", "FILE", "NEW", 3, 450, 716, 64, 24
data "MOLD", "MBSIZE", "-", 1, 400, 660, 24, 24
data "MOLD", "MBSIZE", "+", 2, 430, 660, 24, 24
data "MOLD", "MBSIZE", "-", 3, 400, 688, 24, 24
data "MOLD", "MBSIZE", "+", 4, 430, 688, 24, 24
data "MOLD", "MBSIZE", "-", 5, 400, 716, 24, 24
data "MOLD", "MBSIZE", "+", 6, 430, 716, 24, 24
data "MOLD", "MBSHAPE", "SQUARE", 7, 500, 660, 64, 24
data "MOLD", "MBSHAPE", "ROUND", 8, 500, 688, 64, 24
data "MOLD", "MBTYPE1", "HILL", 9, 600, 674, 64, 24
data "MOLD", "MBTYPE1", "MOUND", 10, 600, 702, 64, 24
data "MOLD", "MBTYPE1", "PLATEAU", 11, 670, 674, 64, 24
data "MOLD", "MBTYPE1", "PEAK", 12, 670, 702, 64, 24
data "MOLD", "TTYPE", "SOLID", 13, 770, 660, 64, 24
data "MOLD", "TEROP", "NORM", 14, 770, 688, 64, 24
data "MOLD", "TEROP", "SMOOTH", 15, 770, 716, 64, 24
data "PAINT", "PBSIZE", "-", 1, 400, 660, 24, 24
data "PAINT", "PBSIZE", "+", 2, 430, 660, 24, 24
data "PAINT", "PBSIZE", "-", 3, 400, 688, 24, 24
data "PAINT", "PBSIZE", "+", 4, 430, 688, 24, 24