Sorry your browser is not supported!

if no obstacles
  rotate object to destination
else
  evade obstacle by rotating object left or right
endif
move object

  
function MoveVehicle(ID)	`made by Neuro Fuzzy, this is little edited to suit this program
						`link to His tutorial: http://www.neurofuzzydev.com/V/D/43a.htm
						`link to download full vectors tutorial: 
						`http://forum.thegamecreators.com/?m=forum_view&t=133126&b=7
  a = 1
  null = make vector3(a)
  set vector3 a, vehicle(ID).Dx - object position x(vehicle(ID).object), 0, vehicle(ID).Dz - object position z(vehicle(ID).object)
  distance# = length vector3(a)

  Rem PJY - check the length of this vector.
 
  Rem PJY - now we test to find out if the selected cube is pointing at the targeted cube
  Rem PJY - we do this by comparing the angle between the vector representing the selected cube's direction
  Rem PJY - and the vector 90 degrees to the side of that
  normalize vector3 a, a
  b = 2
  null = make vector3(b)
  set vector3 b, limb position x(vehicle(ID).object, 1) - object position x(vehicle(ID).object), 0, limb position z(vehicle(ID).object, 1) - object position z(vehicle(ID).object)
  normalize vector3 b, b
  Rem PJY - calculate angle between direction of selected cube and vector towards the target cube
  angle# = acos(dot product vector3(a, b))
  Rem PJY - create a cross product vector c to determine in which direction to turn selected cube
  c = 3
  null = make vector3(c)
  set vector3 c, 0, 1, 0
  cross product vector3 c, b, c
  angle2# = acos(dot product vector3(a, c))
  
  null = delete vector3(b)
  null = delete vector3(c)
  null = delete vector3(a)

  Rem PJY - if the selected cube is not pointing at the targeted cube, turn it towards the targeted cube
  if angle# > 0.1
    if angle2# <> 0
      Rem PJY - select whether to turn right or left
      if angle2# >= 90
        turn object right vehicle(ID).object, vehicle(ID).RotationSpeed
	  else
		turn object left vehicle(ID).object, vehicle(ID).RotationSpeed
	  endif
	endif
  endif
 
  Rem PJY - now depending on the angle and the distance between the cubes
  Rem PJY - we move the selected cube. The reason for the following code is that
  Rem PJY - without it in certain situations the selected cube could begin
  Rem PJY - "orbiting" the targeted cube, i.e. where it is moving so much per turn
  Rem PJY - that it is not decreasing the angle
  
  `all of the following code meaning is to slow down object 
  `when it is near or in big angle with it destination point
  `the best way to set angles, distances and slow down/acelerate values
  `is to experiment. 
  `all these values varie with different box sizes, speeds, stop distances 
  
  `if vehicle is near destination- slow it down
  if distance#< 20 and distance#> 3
    DistChange#=((20-distance#)/20)
  else 
    if distance#> 20 then DistChange#=1
  endif

  `if vehicle has big angle to destination- slow it down
  if angle# >70
    AngleChange#=((180-angle#)/300)
  else
    if angle# <=70
      AngleChange#=((180-angle#)/180)
    endif
  endif

  `that's the speed that vehicle should move 
  PreferedSpeed#=vehicle(ID).maxspeed*DistChange#*AngleChange#
   
  `and here we calculate speed that vehicle can gain
  if vehicle(ID).speed < PreferedSpeed# - 0.01
    inc vehicle(ID).speed, vehicle(ID).traction
  else
    if vehicle(ID).speed > PreferedSpeed# + 0.01
      dec vehicle(ID).speed, vehicle(ID).traction
    endif
  endif 
  
  oldx#=  object position x (vehicle(ID).object)
  oldy#=  object position y (vehicle(ID).object)
  oldz#=  object position z (vehicle(ID).object)
  
  move object vehicle(ID).object, Vehicle(ID).speed  `when we set Vehicles speed, now can finally move it, YeY!
  
  newx#=  object position x (vehicle(ID).object)
  newy#=  object position y (vehicle(ID).object)
  newz#=  object position z (vehicle(ID).object) 
  
  lenghtX#=(newx#-oldx#)*100
  lenghtY#=(newy#-oldy#)*100
  lenghtZ#=(newz#-oldz#)*100

  col=sc_raycast (obj,newx#,newy#,newz#,newx#+lenghtX#,newy#+lenghtY#,newz#+lenghtZ#, 1) 
  `exclude object 1 which is terrain 

  if col>=10 then text 100,100,"collision "+str$(col)
  
  `get coordinates of object 
  Ox#=object position x(Vehicle(ID).object)
  Oz#=object position z(Vehicle(ID).object)
  Oy#=get terrain ground height (1,Ox#,Oz#)+4
  `and place it on terrain
  position object Vehicle(ID).object,Ox#,Oy#,Oz#

endfunction
  

REM ------------------------11110001111--------------------------
REM           ____       A-Star by proteus1935
REM          /   / /    ___  ___  ___  ___    ___
REM         /___/ /__  ___/ /__/ /  / /__    /__  _/
REM        /     /  / /__/ /   /__/ ___/   /     / 
REM -------------------------------------------------------------
REM A-Star functions
REM Not yet fully optimized but works allright...
REM
REM		edited by Kiaurutis ;]
	

DIM_AREA:

global map_height : map_height =50
global map_width  : map_width =50
global openlistnb
global Dim map(map_width,map_height,7)
rem map(x,y,data)
rem map(x,y,1) walkability 2 = unwalkable
rem map(x,y,2) = parent tile X
rem map(x,y,3) = parent tile Y
rem map(x,y,4) = TILE G
rem map(x,y,5) = TILE H
rem map(x,y,6) = TILE F
rem map(x,y,7) = LIST 0 = none , 1 = open , 2 = closed

type tile
x as integer
y as integer
f as integer
endtype
global dim lowF(1)
global dim start(1)
global dim target(1)
global dim openlist(map_width * map_height) as tile : rem openlist
global dim path(10000,1)

global dim XYZ(3) as float
global cubes as integer
cubes=3

`OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
`OOO PROGRAM START OOO
`OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO

sync on
sync rate 60
autocam off
MakeTerrain()

Da_loop:

do
 movecamera()
 clear(map_width,map_height)
 mouse_tile()
 fill_map()

if spacekey()=1
steps = A_star()
`print "steps taken : " ; steps
draw_path(steps)
endif
sync
`cls

loop
end

`OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
`OOO PROGRAM END OOO
`OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO

function clear(x,y)

for Cx = 0 to x
for Cy = 0 to y
for t = 2 to 7 step 1
map(cx,cy,t)=0
next t
next cy
next cx

endfunction

`^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

function mouse_tile()

ink RGB(255,255,255),0
text 10,10, "left/right mouse button to set start end/pos"
text 10,25, "space to show path"
text 10,40, "arrowkeys to move camera"
text 10,55, "+- to add/clear obstacles"
pickpoint()
tileX = abs(XYZ(1))
text 10,155, "Tiles:"
text 10,170, "tileX: "+str$(tileX)
tileY = abs(XYZ(3))
text 100,185, "tileY: "+str$(tileY)

if mouseclick() =1 
  pickpoint()
  position object 2, xyz(1),xyz(2),xyz(3)
  start(0)= tilex : start(1) = tiley
endif

if mouseclick() =2
  pickpoint()
  position object 3, xyz(1),xyz(2),xyz(3)
  target(0)=tilex: target(1)=tiley
endif

if keystate(78) =1 and map(tileX,tileY,1)=0
  map(tileX,tileY,1)=2 : rem sets tile to unwalkable
  inc cubes
  make object cube cubes, 1
  tileheight#= 1`get terrain ground height (1, tilex, tiley)
  position object cubes,tileX,tileheight,tileY
  color object cubes, rgb (255,0,0) 
endif
REM ERASE TILE
if keystate(74) =1 then map(tileX,tileY,1)=0
endfunction

`^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

function fill_map()
for x = 0 to map_width
for y = 0 to map_height
if map(x,y,1) = 1 then ink RGB(47,221,60),0
if map(x,y,1) = 2 then ink RGB(114,134,141),0
if map(x,y,1) >0 then BOX 10*x+1,10*y+1,10*(x+1)-1,10*(y+1)-1
next y
next x
ink RGB(47,156,198),0
BOX 10*start(0)+1,10*start(1)+1,10*(start(0)+1)-1,10*(start(1)+1)-1
ink RGB(255,0,0),0
BOX 10*target(0)+1,10*target(1)+1,10*(target(0)+1)-1,10*(target(1)+1)-1
endfunction

`^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Function A_star()
st = timer()
REM ADD START TILE TO OPENLIST
openlistnb =1
openlist(1).x = start(0) : openlist(1).y = start(1)
openlist(1).f = H(start(0),start(1))
map(start(0),start(1),6)= map(start(0),start(1),5)
map(start(0),start(1),4)= 0
map(start(0),start(1),7)= 1 : rem flag it
map(start(0),start(1),2) = start(0)
map(start(0),start(1),3) = start(1)
lowf(0) = 0 : lowf(1) = 0
Finished = 0 : rem NOT DONE YET

repeat

Rem check for the lowest F
if getlowestF() = 0 then exit
Rem Add it to closed list
map(lowf(0),lowf(1),7) = 2
REM Check 8 adjacent tiles
for X = -1 to 1
for Y = -1 to 1
if  (x = 0) and (y = 0) = 1
else
cuX = lowf(0)
cuY = lowf(1)
adX = lowf(0) + X
adY = lowf(1) + Y
   rem check if walkable/notclosed if 1 then move on
`  if is_walkable_and_not_closed(adX,adY) = 1
if adx = -1 or ady = -1 or adx = 65 or ady = 49
else
if map(adx,ady,1) = 0 : rem is walkable
if map(adx,ady,7) <> 2: rem is not closed
      rem check if not opened
      if map(adX,adY,7) = 0
         map(adx,ady,7) = 1
         map(adX,adY,2) = cuX:rem set parent X
         map(adX,adY,3) = cuY:rem set parent Y
         map(adX,adY,4) = map(cuX,cuY,4) + movecost(X,Y) :rem set G (Nicely done!)
         map(adX,adY,5) = H(adX,adY) : rem set H
         if map(adX,adY,5) = 0 then FINISHED = 2
         map(adX,adY,6) = map(adX,adY,4) + map(adX,adY,5): rem set F
         add2open(adX,adY,map(adx,ady,6)) : rem add to open list
      else : rem this means that it is already opened
       if map(adX,adY,7)=1
         if map(adX,adY,4) > map(cuX,cuY,4) + movecost(X,Y)

         map(adX,adY,2) = cuX :rem set new parent X
         map(adX,adY,3) = cuY :rem set new parent Y
         map(adX,adY,4) = map(cuX,cuY,4) + movecost(X,Y) :rem set G (Nicely done!)
         map(adX,adY,6) = map(adX,adY,4) + map(adX,adY,5): rem set F
         endif

         endif : rem  if G is better
      endif : rem if not opened

   endif : rem is walkabe & not closed
   endif
endif
endif
next Y
next X
REM QUIT WHEN DONE
`if FINISHED = 1 then exit

until finished > 0

if finished = 2
 `print "path found in "; timer() - st ; "ms"
 tx = target(0)
 ty = target(1)
 t=0
 repeat
 inc t
 path(t,0) = map(tx,ty,2)
 path(t,1) = map(tx,ty,3)
 tx = path(t,0)
 ty = path(t,1)
BOX 10*tx+1,10*ty+1,10*(tx+1)-1,10*(ty+1)-1
 until tx = start(0) and ty = start(1)
 steps = t
 else
 `print "path not found in "; timer() -st;"ms"
 steps = 0
endif

`^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

endfunction steps

REM this function was made just for this demo
function draw_path(steps)
for t = 1 to steps
tx = path(t,0)
ty = path(t,1)
BOX 10*tx+1,10*ty+1,10*(tx+1)-1,10*(ty+1)-1
next t
endfunction

`^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

function add2open(adX,adY,f)
inc openlistnb
openlist(openlistnb).x = adx
openlist(openlistnb).y = ady
openlist(openlistnb).f = f
endfunction

`^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

function H(x,y)
rem deltas based on goal tile
distance = (abs(x - target(0))+ abs(y - target(1)))*10
endfunction distance
function movecost(X,y)
cost = 14
if X * Y = 0 then cost = 10
endfunction cost
function getlowestF()
final =999999
rem openlistnb = array count(openlist(0))
for t = 1 to openlistnb
if openlist(t).f < final then final = openlist(t).f :finalt = t
next t
lowf(0) = openlist(finalt).x
lowf(1) = openlist(finalt).y
if final = 999999 then result = 0 else result =1
openlist(finalt).f = 999999

endfunction result

`^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

function MakeTerrain()

//   load image "TerrainTexture.bmp", 101
//   load image "TerrainDetail.tga", 102
//   load image "TerrainDetail.tga", 103
//   
//   make object terrain 1                              ` create the terrain object
//   set terrain heightmap 1, "HeightMap.bmp"           ` set the heightmap
//   set terrain scale 1, 1, 0.02, 1                    ` set the scale
//   set terrain split 1, 16                            ` split value by 16 * 16
//   set terrain tiling 1, 4                            ` detail map tiling
//   set terrain light 1, 1, -0.25, 0, 1, 1, 0.78, 0.5  ` light - xdir, ydir, zdir, red, green, blue, intensity
//   set terrain texture 1, 101, 102                        ` base and detail texture
//   build terrain 1                                    ` finally build the terrain
//   position object 1, 0,0,0						   ` position terrain at zero coordinates
//   sc_setupComplexObject 1,1,2                        ` setup collision on the terrain

make object plane 1, 100,100
position object 1, 0,0,0
xrotate object 1, 90
color object 1, rgb(100,200,100)
 
position camera 0,50,-60
xrotate camera 40
`yrotate camera 180

make object sphere 2, 1
color object 2, rgb(0,255,0) 

make object sphere 3, 1
color object 3, rgb(255,0,255) 

sync

wait 100 

endfunction

`^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

function PickPoint()

  pickState = Pick Object (mouseX(), mouseY(), 1, 1)
  cx# = camera position x()
  cy# = camera position y()
  cz# = camera position z()
  If pickState =1
    Dist# = Get Pick Distance()
    Pick Screen mouseX(), mouseY(), Dist#
    XYZ(1) = cx# + get pick vector x()
    XYZ(2) = cy# + get pick vector y()
    XYZ(3) = cz# + get pick vector z()
    ink RGB(255,255,255),0
    text 10,80,"picking:" 
    text 10,100,"X:"+str$(XYZ(1))
    text 10,115,"Y:"+str$(XYZ(2))
    text 10,130,"Z:"+str$(XYZ(3))
  endif
  
endfunction

`^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

function movecamera()

   if upkey()=1 then move camera 5
   if downkey()=1 then move camera -5
   if leftkey()=1 then yrotate camera wrapvalue(camera angle y()-2)
   if rightkey()=1 then yrotate camera wrapvalue(camera angle y()+2)
   position camera camera position x(), 50, camera position z()
   
endfunction