Sorry your browser is not supported!

Type Entity_List_Type
   EntityID as Integer
   Food as Integer
   Water as Integer
EndType

Function Initialize_Array_Entity_List()
   Dim InitArrayEntity_List(0)
   If InitArrayEntity_List(0) Then ExitFunction
   InitArrayEntity_List(0)=1
   Dim Entity_List(999) as Entity_List_Type
   Dim Entity_ListTop(0) as Integer
   Entity_ListTop(0)=-1
EndFunction


`Entity_List_Add_EntityID(EntityID As Integer):Return Integer
`Performs a binary search for an index location in which to insert a new array element
`for the specified EntityID in sort order of ascending EntityID's. The array element is added
`and the EntityID is recorded the new array element.
`The return value is the index (array element) where the new EntityID was placed.
Function Entity_List_Add_EntityID(EntityID As Integer)
   Index=Entity_List_Find_EntityID_Place(EntityID)
   Entity_List_Insert_Element(Index)
   Entity_List(Index).EntityID=EntityID
EndFunction Index

`Entity_List_Delete_Element(Index as Integer)
`This function will delete an array element at the specified Index.
`If the index is not valid, the function will fail without exiting the program.
Function Entity_List_Delete_Element(Index as Integer)
   Initialize_Array_Entity_List()
   If Index<0 or Index>Entity_ListTop(0) Then ExitFunction
   Entity_ListTop(0)=Entity_ListTop(0)-1
   For i = Index to Entity_ListTop(0)
      Entity_List(i)=Entity_List(i+1)
   Next i
EndFunction

`Entity_List_Find_Entity(EntityID as Integer):Return Integer
`Binary searches through a sorted array for the specified EntityID.
`The return integer EntityID is the index of the array element for which the EntityID was found.
`If there are multiples of the same EntityID within the array, any one of the indexes may be returned.
`If the EntityID is not found, a -1 is returned.
Function Entity_List_Find_Entity(EntityID as Integer)
   Initialize_Array_Entity_List()
   Top=Entity_ListTop(0)
   Half=(Top+1)/2
   If Top<0 Then ExitFunction -1
   If EntityID<Entity_List(0).EntityID Then ExitFunction -1
   If EntityID=Entity_List(0).EntityID Then ExitFunction 0
   If EntityID=Entity_List(Top).EntityID Then ExitFunction Top
   If EntityID>Entity_List(Top).EntityID Then ExitFunction -1
   BSearch=Half
   For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15
      If BSearch<1 then BSearch=1
      If BSearch>Top then BSearch=Top
      If EntityID=Entity_List(BSearch).EntityID Then ExitFunction BSearch
      Half=(Half+1)/2
      If Half<1 then Half=1
      BSearch=BSearch+Half*(((EntityID=>Entity_List(BSearch).EntityID)-(EntityID<Entity_List(BSearch).EntityID)))
   Next i
EndFunction -1

`Entity_List_Insert_Element(Index as Integer)
`Increases the array by adding in an element at the specified index.
`If the Index is larger than the array size, the new element is added at
`the end of the array. Otherwise, the new element is inserted the specified
`index.
Function Entity_List_Insert_Element(Index as Integer)
   Initialize_Array_Entity_List()
   Entity_ListTop(0)=Entity_ListTop(0)+1
   If Entity_ListTop(0)=>Array Count(Entity_List())
      Array Insert At Bottom Entity_List()
   EndIf
   If Index=>Entity_ListTop(0) Then ExitFunction
   For i =Entity_ListTop(0)-1 To Index Step -1
      Entity_List(i+1)=Entity_List(i)
   Next i
EndFunction

`Entity_List_Find_EntityID_Place(EntityID as Integer):Return Integer
`This function is similar to the Entity_List_Find_EntityID() function in that it
`searches for a EntityID within a sorted array. However, if the EntityID is
`not found in this function, an index EntityID is returned where the search EntityID
`"fits" within the sorted array. For example: The array - 1,6,8,9 and the EntityID
`is 7, the return element will be 2 since 7 falls between elements 1 and 2 (6 & 9).
`If the EntityID is lower than any EntityID within the array, a 0 is returned.
`If the EntityID is larger than any EntityID within the array, Array Count()+1 is returned.
Function Entity_List_Find_EntityID_Place(EntityID as Integer)
   Initialize_Array_Entity_List()
   Top=Entity_ListTop(0)
   Half=(Top+1)/2
   If Top<0 Then ExitFunction 0
   If EntityID<=Entity_List(0).EntityID Then ExitFunction 0
   If EntityID=>Entity_List(Top).EntityID Then ExitFunction Top+1
   BSearch=Half
   For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15 elements.
      If BSearch<1 then BSearch=1
      If BSearch>Top then BSearch=Top
      If EntityID=Entity_List(BSearch).EntityID Then ExitFunction BSearch
      If EntityID>Entity_List(BSearch-1).EntityID And EntityID<=Entity_List(BSearch).EntityID then ExitFunction BSearch
      Half=(Half+1)/2
      If Half<1 then Half=1
      BSearch=BSearch+Half*(((EntityID=>Entity_List(BSearch).EntityID)-(EntityID<Entity_List(BSearch).EntityID)))
   Next i
   Top=Top+1
EndFunction Top

sync on
sync rate 45
set display mode 800, 600, 32
`set window on
autocam off
set camera range 1.0, 500.0

global simno = 10
global objno = 3
gosub textures
gosub world
gosub sims
gosub aim

for s = 10 to 10+simno
   sims(s,6) = 0
next s

do
ink  0, 0
text 0,0,"x position"+str$(mousey())+" "
text 0,10,"x angle"+str$(camera angle x(1))+" "
text 0,70,"y angle"+str$(camera angle y(1))+" "
text 0,20,"ad"+str$(sims(10,3))+" "
text 0,30,"dx"+str$(sims(10,4))+" "
text 50,30,"dx"+str$(object position x(9))+" "
text 0,40,"dz"+str$(sims(10,5))+" "
text 50,40,"dx"+str$(object position z(9))+" "
text 0,50,"ox"+str$(object position x(10))+" "
text 0,60,"oz"+str$(object position z(10))+" "
position object 1, camera position x(1),camera position y(1), camera position z(1)
`exture object 10,2
gosub cameramove
gosub bounds
gosub mousemove
gosub move
if spacekey() = 1
repeat
gosub mousemove
until inkey$() = "p"
endif
sync
loop

textures:
land = 1 : sky = 2 : farm = 3 : house = 4 : business = 5
create bitmap 1, 800,800
ink rgb(47,141,41), rgb(47,141,41)
box 50,50,150,150
ink rgb(89,155,227), rgb(160,138,90)
box 151,50,251,150
ink rgb(123,120,79), rgb(123,120,79)
box 252,50,352,150
ink rgb(255,0,0), rgb(255,0,0)
box 353,50,453,150
ink rgb(97,109,92), rgb(97,109,92)
box 454,50,554,150

get image 1, 50,50,150,150
get image 2, 151,50,251,150
get image 3, 252,50,352,150
get image 4, 353,50,453,150
get image 5, 454,50,554,150
delete bitmap 1
return

world:
make matrix 1, 1500,1000,100,100
position matrix 1, 0,0,0
prepare matrix texture 1, 1, 10,10
randomize matrix 1, 5
make camera 1
position camera 1, 750,75,400
point camera 1, 750,0,500
set ambient light 80
update matrix 1
make object sphere 1,-5000
texture object 1, 2
make object cube 9, 50
position object 9,439, 0,912
texture object 9, 3
make object cube 8, 50
position object 8, 750, 0,500
texture object 8, 4
make object cube 7, 50
position object 7, 1132, 0,821
texture object 7, 5
return

sims:
dim sims(simno,8)
for s= 10 to simno+10
   make object sphere s, 6
   position object s, 750,0,500
   h=get ground height (1, object position x(s), object position z(s))
   position object s, 750,h+6,500
   sims(s,1) = object position x(s)
   sims(s,2) = object position z(s)

next s
return

aim:
for s = 10 to 10+simno
if sims(s,6) = 0
   o = rnd(objno-1)+7
   if object position x(s) > object position x(8)-10 and object position x(s) < object position x(8)+10
      if o = 8
         o=o+1
         gosub locate
      else
         gosub locate
      endif
   else
      gosub locate
   endif
endif
next s
return

move:
for s = 10 to 10+simno
   bd = sims(s,3)
   bx = sims(s,4)
   bz = sims(s,5)
   h=get ground height (1, object position x(s), object position z(s))
   position object s, newxvalue(object position x(s),bd, 1), h+6, newzvalue(object position z(s), bd, 1)
   if object position x(s) > bx-10 and object position x(s) < bx+10 and object position z(s) > bz-10 and object position z(s) < bz+10
      sims(s,6) = 0
      gosub aim
   endif
next s
return

mousemove:
if mouseclick() = 2
xrotate camera 1, wrapvalue(camera angle x(1) + mousemovey()/5.0)
yrotate camera 1, wrapvalue(camera angle y(1) + mousemovex()/5.0)
if camera angle x(1)>89 and camera angle x(1)<180 then xrotate camera 89
if camera angle x(1)<271 and camera angle x(1)>180 then xrotate camera 271
endif
return

bounds:
if camera position x(1) < 100 then position camera 1, 101, camera position y(1), camera position z(1)
if camera position x(1) > 1400 then position camera 1, 1399,camera position y(1), camera position z(1)
if camera position y(1) < 10 then position camera 1, camera position x(1) ,11 , camera position z(1)
if camera position y(1) > 200 then position camera 1, camera position x(1) ,199 , camera position z(1)
if camera position z(1) < 100 then position camera 1, camera position x(1) ,camera position y(1) , 101
if camera position z(1) > 900 then position camera 1, camera position x(1) ,camera position y(1) , 899
return

cameramove:
if mousex() < 20 then position camera 1, camera position x(1)-3, camera position y(1), camera position z(1)
if mousex() > 780 then position camera 1, camera position x(1)+3, camera position y(1), camera position z(1)
if mousey() < 20 then position camera 1, camera position x(1), camera position y(1),camera position z(1)+3
if mousey() > 580 then position camera 1, camera position x(1), camera position y(1), camera position z(1)-3
return

locate:
dx = object position x(o) - object position x(s)
dz = object position z(o) - object position z(s)
ad = atanfull(dx,dz)
sims(s,3) = ad
sims(s,4) = object position x(o)`dx
sims(s,5) = object position z(o)`dz
sims(s,6) = 1
return

sync on
sync rate 45
set display mode 800, 600, 32
`set window on
autocam off
set camera range 1.0, 500.0

global simno = 10
global objno = 3
houseno = 1
farmno = 1
shopno = 1
gosub textures
gosub world
gosub sims
`gosub aim
dim res(3)
dim house(houseno,2)
dim farm(farmno,2)
dim shop(shopno,2)

for s = 10 to 10+simno
   sims(s,6) = 0
next s

maxhouseno=20
maxfarmno=20
maxshopno=20
res(1) = 1000
res(2) = 1000
res(3) = simno
house(1,1) = object position x(101)
house(1,2) = object position y(101)
farm(1,1) = object position x(201)
farm(1,2) = object position y(201)
shop(1,1) = object position x(301)
shop(1,2) = object position y(301)

do
ink  0, 0
text 0,0,"y position"+str$(mousey())+" "
text 0,10,"x position"+str$(mousex())+" "
text 0,20,"ad"+str$(sims(10,3))+" "
text 0,30,"dx"+str$(sims(10,4))+" "
text 50,30,"dx"+str$(object position x(201))+" "
text 0,40,"dz"+str$(sims(10,5))+" "
text 50,40,"dx"+str$(object position z(201))+" "
text 0,50,"ox"+str$(object position x(10))+" "
text 0,60,"oz"+str$(object position z(10))+" "
`text 0,70,"hx"+str$(build(2,1))+" "
position object 1, camera position x(1),camera position y(1), camera position z(1)
gosub cameramove
gosub bounds
gosub mousemove
gosub move
if spacekey() = 1
repeat
gosub mousemove
until inkey$() = "p"
endif
gosub screen
sync
loop

textures:
`land = 1 : sky = 2 : farm = 3 : house = 4 : shop = 5
create bitmap 1, 800,800
ink rgb(47,141,41), rgb(47,141,41)
box 50,50,150,150
ink rgb(89,155,227), rgb(160,138,90)
box 151,50,251,150
ink rgb(123,120,79), rgb(123,120,79)
box 252,50,352,150
ink rgb(255,0,0), rgb(255,0,0)
box 353,50,453,150
ink rgb(97,109,92), rgb(97,109,92)
box 454,50,554,150

get image 1, 50,50,150,150
get image 2, 151,50,251,150
get image 3, 252,50,352,150
get image 4, 353,50,453,150
get image 5, 454,50,554,150
delete bitmap 1
return

world:
make matrix 1, 1500,1000,100,100
position matrix 1, 0,0,0
prepare matrix texture 1, 1, 10,10
randomize matrix 1, 5
make camera 1
position camera 1, 750,600,500
point camera 1, 750,0,500
set ambient light 80
update matrix 1
make object sphere 1,-5000
texture object 1, 2
make object cube farmno+200, 50
position object farmno+200,439, 0,912
texture object farmno+200, 3
make object cube houseno+100, 50
position object houseno+100, 750, 0,500
texture object houseno+100, 4
make object cube shopno+300, 50
position object shopno+300, 1132, 0,821
texture object shopno+300, 5

return

sims:
dim sims(simno,8)
for s= 10 to 10+simno
   make object sphere s, 6
   position object s, 750,0,500
   h=get ground height (1, object position x(s), object position z(s))
   position object s, 750,h+6,500
   sims(s,1) = object position x(s)
   sims(s,2) = object position z(s)
next s
return

aim:
for s = 10 to 10+simno
if sims(s,6) = 0
   o = rnd(objno-1)
   if object position x(s) > object position x(101)-10 and object position x(s) < object position x(101)+10
      if o = 8
         zz = rnd(1)
         if zz = 0
            o = shopno+300
         else
            o = farmno+200
         endif
         gosub locate
      else
         gosub locate
      endif
   else
      o = houseno+100
      gosub locate
   endif
endif
next s
return

move:
for s = 10 to 10+simno
   bd = sims(s,3)
   bx = sims(s,4)
   bz = sims(s,5)
   h=get ground height (1, object position x(s), object position z(s))
   position object s, newxvalue(object position x(s),bd, 1), h+6, newzvalue(object position z(s), bd, 1)
   if object position x(s) > bx-10 and object position x(s) < bx+10 and object position z(s) > bz-10 and object position z(s) < bz+10
      sims(s,6) = 0

      gosub aim
   endif
next s
return

mousemove:
if mouseclick() = 2
xrotate camera 1, wrapvalue(camera angle x(1) + mousemovey()/5.0)
yrotate camera 1, wrapvalue(camera angle y(1) + mousemovex()/5.0)
if camera angle x(1)>89 and camera angle x(1)<180 then xrotate camera 89
if camera angle x(1)<271 and camera angle x(1)>180 then xrotate camera 271
endif
return

bounds:
if camera position x(1) < 100 then position camera 1, 101, camera position y(1), camera position z(1)
if camera position x(1) > 1400 then position camera 1, 1399,camera position y(1), camera position z(1)
if camera position y(1) < 10 then position camera 1, camera position x(1) ,11 , camera position z(1)
if camera position y(1) > 1000 then position camera 1, camera position x(1) ,999 , camera position z(1)
if camera position z(1) < 100 then position camera 1, camera position x(1) ,camera position y(1) , 101
if camera position z(1) > 900 then position camera 1, camera position x(1) ,camera position y(1) , 899
if inkey$() = "z" then position camera 1, camera position x(1), camera position y(1)+2, camera position z(1)
if inkey$() = "x" then position camera 1, camera position x(1), camera position y(1)-2, camera position z(1)
return

cameramove:
if mousex() < 20 then position camera 1, camera position x(1)-3, camera position y(1), camera position z(1)
if mousex() > 780 then position camera 1, camera position x(1)+3, camera position y(1), camera position z(1)
if mousey() < 20 then position camera 1, camera position x(1), camera position y(1),camera position z(1)+3
if mousey() > 580 then position camera 1, camera position x(1), camera position y(1), camera position z(1)-3
return

locate:
dx = object position x(o) - object position x(s)
dz = object position z(o) - object position z(s)
ad = atanfull(dx,dz)
sims(s,3) = ad
sims(s,4) = object position x(o)`dx
sims(s,5) = object position z(o)`dz
sims(s,6) = 1
return

screen:
ink rgb(255,0,0), rgb(255,0,0)
box 20,500,180,515
ink rgb(123,120,79), rgb(123,120,79)
box 20,520,180,535
ink rgb(97,109,92), rgb(97,109,92)
box 20,540,180,555
ink rgb(137,160,233), rgb(137,160,233)
box 220,500,370,515
box 220,520,370,535
box 220,540,370,555
box 220,560,370,575

ink rgb(0,0,0), rgb(0,0,0)
text 25,502, "Build House(-100 Money,+ 10 Pop)"
text 25,522, "Build Farm(-100 Money)"
text 25,542, "Build Shop(-100 Money)"
text 225,502, "Money = "+str$(res(1))+" "
text 225,522, "Food = "+str$(res(2))+" "
text 225,542, "Population = "+str$(res(3))+" "
text 225,562, "Houses("+str$(houseno)+") : Farms("+str$(farmno)+") : Shops("+str$(shopno)+")"

if mouseclick() = 1
   if mousey() < 500 and mousey() > 515 and mousex() > 20 and mousex() < 180 then gosub placehouse
   if mousey() < 520 and mousey() > 535 and mousex() > 20 and mousex() < 180 then gosub placefarm
   if mousey() < 540 and mousey() > 555 and mousex() > 20 and mousex() < 180 then gosub placeshop
endif
return

placehouse:
if housno <> maxhouseno
   repeat
   xcoord = (mousex()/2)*5
   ycoord = (mousey()/4)*5
   text 200,200,"move mouse to change place coords"
   text 200,210,"xcoord of placement"+str$(xcoord)
   text 200,220,"ycoord of placement"+str$(ycoord)
   until mouseclick() = 1
   if mouseclick() = 1
      objno = objno+1
      houseno = houseno + 1
      make object cube houseno+100,50
      position object housemno+200,xcoord, 0,ycoord
      texture object houseno+200, 4
   endif
endif
return

placefarm:
if farmno <> maxfarmno
   repeat
   xcoord = (mousex()/2)*5
   ycoord = (mousey()/4)*5
   text 200,200,"move mouse to change place coords"
   text 200,210,"xcoord of placement"+str$(xcoord)
   text 200,220,"ycoord of placement"+str$(ycoord)
   until mouseclick() = 1
   if mouseclick() = 1
      objno = objno+1
      farmno = farmno + 1
      make object cube farmno+100,50
      position object farmno+200,xcoord, 0,ycoord
      texture object farmno+200, 3
   endif
endif
return

placeshop:
if shopno <> maxshopno
   repeat
   xcoord = (mousex()/2)*5
   ycoord = (mousey()/4)*5
   text 200,200,"move mouse to change place coords"
   text 200,210,"xcoord of placement"+str$(xcoord)
   text 200,220,"ycoord of placement"+str$(ycoord)
   until mouseclick() = 1
   if mouseclick() = 1
      objno = objno+1
      shopno = shopno + 1
      make object cube shopno+100,50
      position object shopno+200,xcoord, 0,ycoord
      texture object shopno+200, 3
   endif
endif
return

simstarget:

if mouseclick() = 1 and mousey() < 500
   picks = pick object(mousex(), mousey(),10,99)
   texture object picks, 2
endif
If mouseclick() = 2 and mousey() < 500
   pickb = pick object(mousex(),mousey(),100,220)
   dx = object position x(pickb) - object position x(picks)
   dz = object position z(pickb) - object position z(picks)
   ad = atanfull(dx,dz)
   sims(picks,3) = ad
   sims(picks,4) = object position x(pickb)`dx
   sims(picks,5) = object position z(pickb)`dz
   sims(picks,6) = 1
endif

sync on
sync rate 45
set display mode 800, 600, 32
`set window on
autocam off
set camera range 1.0, 500.0

global simno = 10
global objno = 3
houseno = 1
farmno = 1
shopno = 1
dim sims(simno,8)
gosub textures
gosub world
gosub sims

gosub aim
dim res(3)
dim house(houseno,2)
dim farm(farmno,2)
dim shop(shopno,2)

for s = 10 to 10+simno
   sims(s,6) = 0
next s

maxhouseno=20
maxfarmno=20
maxshopno=20
res(1) = 1000
res(2) = 1000
res(3) = simno
house(1,1) = object position x(101)
house(1,2) = object position y(101)
farm(1,1) = object position x(151)
farm(1,2) = object position y(151)
shop(1,1) = object position x(201)
shop(1,2) = object position y(201)


do
gosub screen
ink  0, 0
text 0,0,"y position"+str$(mousey())+" "
text 0,10,"x position"+str$(mousex())+" "
text 0,20,"ad"+str$(sims(20,3))+" "
text 0,30,"dx"+str$(sims(20,4))+" "
text 50,30,"dx"+str$(object position x(201))+" "
text 0,40,"dz"+str$(sims(20,5))+" "
text 50,40,"dx"+str$(object position z(201))+" "
text 0,50,"ox"+str$(object position x(10))+" "
text 0,60,"oz"+str$(object position z(10))+" "
position object 1, camera position x(1),0, camera position z(1)
gosub cameramove
gosub bounds
gosub move
if spacekey() = 1
repeat
until inkey$() = "p"
endif
if inkey$()= "h" then gosub placehouse
if inkey$()= "f" then gosub placefarm
if inkey$()= "s" then gosub placeshop
if res(1) < 0
repeat
text 300,200,"Youve run out of money"
text 300,220,"Press space to quit"
until spacekey() = 1
endif
if res(2) < 0
repeat
text 300,200,"Youve run out of food"
text 300,220,"Press space to quit"
until spacekey() = 1
endif

sync
loop

textures:
`land = 1 : sky = 2 : farm = 3 : house = 4 : shop = 5
create bitmap 1, 800,800
ink rgb(47,141,41), rgb(47,141,41)
box 50,50,150,150
ink rgb(89,155,227), rgb(160,138,90)
box 151,50,251,150
ink rgb(123,120,79), rgb(123,120,79)
box 252,50,352,150
ink rgb(255,0,0), rgb(255,0,0)
box 353,50,453,150
ink rgb(97,109,92), rgb(97,109,92)
box 454,50,554,150
ink rgb(255,255,255), rgb(255,255,255)
box 555,50,655,150

get image 1, 50,50,150,150
get image 2, 151,50,251,150
get image 3, 252,50,352,150
get image 4, 353,50,453,150
get image 5, 454,50,554,150
get image 6, 555,50,655,150
delete bitmap 1
return

world:
make matrix 1, 1500,1000,100,100
position matrix 1, 0,0,0
prepare matrix texture 1, 1, 10,10
randomize matrix 1, 5
make camera 1
position camera 1, 750,800,500
point camera 1, 750,0,500
set ambient light 80
update matrix 1
make object sphere 1,-5000
texture object 1, 2
make object cube farmno+150, 50
position object farmno+150,439, 0,912
texture object farmno+150, 3
make object cube houseno+100, 50
position object houseno+100, 750, 0,500
texture object houseno+100, 4
make object cube shopno+200, 50
position object shopno+200, 1132, 0,821
texture object shopno+200, 5

return

sims:
`simno = res(3)
for s= 10 to 10+simno
   make object sphere s, 6
   position object s, 750,0,525
   h=get ground height (1, object position x(s), object position z(s))
   position object s, 750,h+6,525
   sims(s,1) = object position x(s)
   sims(s,2) = object position z(s)
next s
return


aim:
for s = 10 to 10+simno
if sims(s,6) = 0
   for h = 101 to 101+(houseno-1)
      if object position x(s) > object position x(h) - 20 and object position x(s) < object position x(h) + 20 and object position z(s) > object position z(h) - 20 and object position z(s) < object position z(h) + 20
         res(1) = res(1) - 20
         res(2) = res(2) - 20
         if res(1) < 0 then gosub dead
         if res(2) < 0 then gosub dead
         aa = rnd(1)
         if aa = 0
            af = rnd(farmno-1)
            bf = af+151
            o = bf
            gosub locate
         else
            aa = 1
            ss = rnd(shopno-1)
            bs = ss+201
            o=bs
            gosub locate
         endif
      else
         ah = rnd(houseno-1)
         bh = ah+101
         o = bh
         gosub locate
      endif
    next h
endif
next s
return


move:
for s = 10 to 10+simno
   bd = sims(s,3)
   bx = sims(s,4)
   bz = sims(s,5)
   h=get ground height (1, object position x(s), object position z(s))
   position object s, newxvalue(object position x(s),bd, 1), h+6, newzvalue(object position z(s), bd, 1)
   if object position x(s) > bx-20 and object position x(s) < bx+20 and object position z(s) > bz-20 and object position z(s) < bz+20
   for of = 151 to 151+(farmno-1)
      if object position x(s) > object position x(of)-20 and object position x(s) < object position x(of)+20 and object position z(s) > object position z(of)-20 and object position z(s) < object position z(of)+20
      res(2) = res(2) + 100
      endif
   next of
   for os = 201 to 201+(shopno-1)
      if object position x(s) > object position x(os)-20 and object position x(s) < object position x(os)+20 and object position z(s) > object position z(os)-20 and object position z(s) < object position z(os)+20
      res(1) = res(1) + 100
      endif
   next os
      sims(s,6) = 0
      gosub aim
   endif
next s
return

mousemove:
if mouseclick() = 2
xrotate camera 1, wrapvalue(camera angle x(1) + mousemovey()/5.0)
yrotate camera 1, wrapvalue(camera angle y(1) + mousemovex()/5.0)
if camera angle x(1)>89 and camera angle x(1)<180 then xrotate camera 89
if camera angle x(1)<271 and camera angle x(1)>180 then xrotate camera 271
endif
return

bounds:
if camera position x(1) < 100 then position camera 1, 101, camera position y(1), camera position z(1)
if camera position x(1) > 1400 then position camera 1, 1399,camera position y(1), camera position z(1)
if camera position y(1) < 10 then position camera 1, camera position x(1) ,11 , camera position z(1)
if camera position y(1) > 1000 then position camera 1, camera position x(1) ,999 , camera position z(1)
if camera position z(1) < 100 then position camera 1, camera position x(1) ,camera position y(1) , 101
if camera position z(1) > 900 then position camera 1, camera position x(1) ,camera position y(1) , 899
if inkey$() = "z" then position camera 1, camera position x(1), camera position y(1)+2, camera position z(1)
if inkey$() = "x" then position camera 1, camera position x(1), camera position y(1)-2, camera position z(1)
return

cameramove:
if mousex() < 20 then position camera 1, camera position x(1)-3, camera position y(1), camera position z(1)
if mousex() > 780 then position camera 1, camera position x(1)+3, camera position y(1), camera position z(1)
if mousey() < 20 then position camera 1, camera position x(1), camera position y(1),camera position z(1)+3
if mousey() > 580 then position camera 1, camera position x(1), camera position y(1), camera position z(1)-3
return

locate:
dx = object position x(o) - object position x(s)
dz = object position z(o) - object position z(s)
ad = atanfull(dx,dz)
sims(s,3) = ad
sims(s,4) = object position x(o)`dx
sims(s,5) = object position z(o)`dz
sims(s,6) = 1
return

screen:
ink rgb(255,0,0), rgb(255,0,0)
box 20,500,180,515
ink rgb(123,120,79), rgb(123,120,79)
box 20,520,180,535
ink rgb(97,109,92), rgb(97,109,92)
box 20,540,180,555
ink rgb(137,160,233), rgb(137,160,233)
box 220,500,370,515
box 220,520,370,535
box 220,540,370,555
box 220,560,370,575

ink rgb(0,0,0), rgb(0,0,0)
text 25,502, "Build House(-100 Money,+ 10 Pop)"
text 25,522, "Build Farm(-100 Money)"
text 25,542, "Build Shop(-100 Money)"
text 225,502, "Money = "+str$(res(1))+" "
text 225,522, "Food = "+str$(res(2))+" "
text 225,542, "Population = "+str$(res(3))+" "
text 225,562, "Houses("+str$(houseno)+") : Farms("+str$(farmno)+") : Shops("+str$(shopno)+")"
return

placehouse:
if houseno < maxhouseno and res(1) > 100 and res(3) < 90
   position camera 1, 750,800,500
   repeat
   xcoord = ((mousex()/4)*6) + 150
   ycoord = 1000-(mousey()/3)*5
   text 200,200,"move mouse to change place coords"
   text 200,210,"xcoord of placement"+str$(xcoord)
   text 200,220,"ycoord of placement"+str$(ycoord)
   until mouseclick() = 1 and inkey$() <> "h"
   if mouseclick() = 1
      objno = objno+1
      houseno = houseno + 1
      make object cube houseno+100,50
      position object houseno+100,xcoord, 0,ycoord
      texture object houseno+100, 4
      res(3) = res(3) + 5
      simno = simno+5
      for ff = 0 to 4
      make object sphere (res(3)+10)-ff, 6
      position object (res(3)+10)-ff, object position x(houseno+100), 0, object position z(houseno+100)
      next ff
   endif
endif
return

placefarm:
if farmno < maxfarmno and res(1) > 100
   position camera 1, 750,800,500
   repeat
   xcoord = ((mousex()/4)*6) + 150
   ycoord = 1000-(mousey()/3)*5
   text 200,200,"move mouse to change place coords"
   text 200,210,"xcoord of placement"+str$(xcoord)
   text 200,220,"ycoord of placement"+str$(ycoord)
   until mouseclick() = 1
   if mouseclick() = 1 and inkey$() <> "f"
      objno = objno+1
      farmno = farmno + 1
      make object cube farmno+150,50
      position object farmno+150,xcoord, 0,ycoord
      texture object farmno+150, 3
      res(1) = res(1) - 100
   endif
endif
return

placeshop:
if shopno < maxshopno and res(1) > 100
   position camera 1, 750,800,500
   repeat
   xcoord = ((mousex()/4)*6) + 150
   ycoord = 1000-(mousey()/3)*5
   text 200,200,"move mouse to change place coords"
   text 200,210,"xcoord of placement"+str$(xcoord)
   text 200,220,"ycoord of placement"+str$(ycoord)
   until mouseclick() = 1 and inkey$() <> "s"
   if mouseclick() = 1
      objno = objno+1
      shopno = shopno + 1
      make object cube shopno+200,50
      position object shopno+200,xcoord, 0,ycoord
      texture object shopno+200, 5
      res(1) = res(1) - 100
   endif
endif
return

simstarget:
if mouseclick() = 2 and mousey() < 500
   picks = pick object(mousex(), mousey(),10,99)
   texture object picks, 2
endif
If mouseclick() = 2 and mousey() < 500
   pickb = pick object(mousex(),mousey(),100,220)
   dx = object position x(pickb) - object position x(picks)
   dz = object position z(pickb) - object position z(picks)
   ad = atanfull(dx,dz)
   sims(picks,3) = ad
   sims(picks,4) = object position x(pickb)`dx
   sims(picks,5) = object position z(pickb)`dz
   sims(picks,6) = 1
endif
return

dead:
do
text 200,200,"You have run out of resources and you are now dead"
text 300,200,"Press space to quit"
end
loop
return

set display mode 1024,768,32
backdrop on
color backdrop 0
sync on

type resource
  x as float
  y as float
  z as float
  energy as integer
  active as integer
endtype
type animal
  x as float
  y as float
  z as float
  age as float
  sex as integer
  energy as integer
  hunt as integer
  parent as integer
  seek as integer
  active as integer
endtype
global max=300
global dim r(max) as resource
global dim a(max) as animal
global dim r_obj(max)
global dim a_obj(max)
global objnum as integer
global dim colour(2)
global camangle as integer
global camy as integer
camangle=20
colour(1)=rgb(0,0,255)
colour(2)=rgb(255,255,0)
global r_top=0
global a_top=0
global growth_rate as float
global energy_rate as float
global age_rate as float
growth_rate=0.5
energy_rate=1.0
age_rate=0.01
global fight_age=5
global death_age=100

make_textures()
ground()
make_resources()
make_animals()
position camera 0,75,0
point camera 50,75,50
pitch camera down camangle
global pause=0
while not escapekey()
  usercontrol()
  if mouseclick()=1
    obj=pick object(mousex(),mousey(),1,600)
  endif
  if not pause
    grow_resources()
    hunt_for_food()
    compete()
  endif
  if obj>0
    for i=1 to max
      if (a_obj(i)=obj)
        set cursor 0,0
        ink rgb(255,255,255),0
        print "Active ";a(i).active
        print "Energy ";a(i).energy
        print "Hunt ";a(i).hunt
        print "Seek ";a(i).seek
        print "Parent ";a(i).parent
        print "Resource ";r(a(i).seek).energy
        i=max
      endif
    next i
  endif
  sync
endwhile
exit

function compete()
  for i=1 to max
    if a(i).energy>0
      fight=0
      for j=1 to a_top-1
        if (i <> j)
          if object collision(a_obj(i),a_obj(j))
            dist#=sqrt((a(i).x-a(j).x)^2+(a(i).z-a(j).z)^2)
            xmove#=sqrt((a(i).x-a(j).x)^2/dist#)/10.0
            zmove#=sqrt((a(i).z-a(j).z)^2/dist#)/10.0
            if a(i).sex=a(j).sex
              if a(i).age<a(j).age or a(j).age<fight_age
                flight#=-1.0
              else
                if a(i).age=a(j).age
                  if a(i).energy<a(j).energy
                    flight#=-1.0
                  else
                    flight#=1.0
                    a(i).energy=a(i).energy+10
                    a(j).energy=a(j).energy-10
                    color object a_obj(i),rgb(255,0,0)
                    a(i).hunt=2
                    fight=1
                  endif
                endif
              endif
            else
              flight#=-1.0
              if a(i).parent=0 and a(j).parent=0 and a(i).age>fight_age and a(j).age>fight_age and a(i).energy>400 and a(j).energy>400
                make_baby(i)
                if a(i).sex=2
                  a(i).parent=1000
                else
                  a(j).parent=1000
                endif
              endif
            endif
            if a(j).x>a(i).x
              a(i).x=a(i).x+xmove#*flight#
            else
              a(i).x=a(i).x-xmove#*flight#
            endif
            if a(j).z>a(i).z
              a(i).z=a(j).z+zmove#*flight# 
            else
              a(i).z=a(j).z-zmove#*flight#  
            endif
          endif
        endif
      next j
      if fight=0
        color object a_obj(i),colour(a(i).sex)
        a(i).hunt=1
      endif
    else
      color object a_obj(i),rgb(64,64,64)
    endif
  next i
endfunction
function hunt_for_food()
  for i=1 to max
    if a(i).active=1
      animal_growth(i)
      if (a(i).energy>0) and (a(i).hunt=1)
        a(i).energy=a(i).energy-energy_rate
        dist#=1000.0
        seeking=1
        if a(i).seek=0
          seeking=0
        else
          if r(a(i).seek).energy=0
            a(i).seek=0
            seeking=0
          else
            if visible(i,a(i).seek)=0
              seeking=0
            endif
          endif
        endif
        if seeking=0
          for j=1 to r_top-1
            if (r(j).energy>0)
              if (r(j).x>a(i).x-a(i).age) && (r(j).x<a(i).x+a(i).age) && (r(j).z>a(i).z-a(i).age) && (r(j).z<a(i).z+a(i).age)
                eat_resource(i,j)
                a(i).seek=0
                j=r_top
                dist#=1000.0
              else
                distance#=sqrt((a(i).x-r(j).x)^2+(a(i).z-r(j).z)^2)
                if distance#<dist#
                  if visible(i,j)=1
                    dist#=distance#
                    a(i).seek=j
                  endif
                endif
              endif
            endif
          next j
        else
          if (r(a(i).seek).energy<10) then a(i).seek=0
          if (r(a(i).seek).x>a(i).x-a(i).age) && (r(a(i).seek).x<a(i).x+a(i).age) && (r(a(i).seek).z>a(i).z-a(i).age) && (r(a(i).seek).z<a(i).z+a(i).age)
            eat_resource(i,j)
            a(i).seek=0
          else
            dist#=sqrt((a(i).x-r(a(i).seek).x)^2+(a(i).z-r(a(i).seek).z)^2)
          endif
        endif
        if dist#<1000.0
          xmove#=sqrt((a(i).x-r(a(i).seek).x)^2/dist#)/10.0
          zmove#=sqrt((a(i).z-r(a(i).seek).z)^2/dist#)/10.0
          if r(a(i).seek).x>a(i).x
            a(i).x=a(i).x+xmove#
          else
            a(i).x=a(i).x-xmove#
          endif
          if r(a(i).seek).z>a(i).z
            a(i).z=a(i).z+zmove#   
          else
            a(i).z=a(i).z-zmove#   
          endif
          a(i).y=get ground height(1,a(i).x,a(i).z)
          position object a_obj(i),a(i).x,a(i).y+a(i).age/2,a(i).z
        endif
      else
        color object a_obj(i),rgb(64,64,64)
      endif
      if a(i).energy<=0
        a(i).age=a(i).age-0.5
        if a(i).age<0
          remove_animal(i)
          new_resource(i)
        endif
      endif
    endif
  next i
endfunction
function visible(i,j)
  see=1
  for x=1 to a_top-1
    if (x<>i)
      if intersect object(a_obj(x),a(i).x,1,a(i).z,r(j).x,1,r(j).z)>0
        see=0
        x=a_top
      endif
    endif
  next x
endfunction see
function eat_resource(i,j)
  if (r(j).energy>10)
    food=10
  else
    food=r(j).energy
  endif
  a(i).energy=a(i).energy+food
  r(j).energy=r(j).energy-food
endfunction
function animal_growth(i)
  a(i).age=a(i).age+age_rate
  if a(i).age>death_age then a(i).energy=0
  size=a(i).age*20
  if size>400 then size=400
  scale object a_obj(i),size,size,size
  if a(i).parent>0 then dec a(i).parent
  energy=a(i).energy/10
  if energy>255 then energy=255
  set object emissive a_obj(i),rgb(energy,energy,energy)
  set object ambience a_obj(i),rgb(energy,energy,energy)
endfunction
function resource_growth(i)
  size=r(i).energy
  scale object r_obj(i),size,size,size
  position object r_obj(i),r(i).x,r(i).y+size/200.0,r(i).z
endfunction
function grow_resources()
  for i=1 to r_top-1
    if (r(i).energy > 0)
      r(i).energy=r(i).energy+growth_rate
      resource_growth(i)  
    endif
  next i
endfunction
function nextobj()
  inc objnum
endfunction objnum
function nextanimal()
  inc a_top
  if a_top>max then a_top=1
  if object visible(a_obj(a_top))
    a_top=0
    for i=1 to max
      if not object visible(a_obj(i))
        a_top=i
        i=max
      endif
    next i
  endif
endfunction a_top
function nextresource()
  inc r_top
  if r_top>max then r_top=1
  if object visible(r_obj(r_top))
    r_top=0
    for i=1 to max
      if not object visible(r_obj(i))
        r_top=i
        i=max
      endif
    next i
  endif
endfunction r_top
function new_resource(i)
  camx=camera position x()
  camy=camera position y()
  camz=camera position z()
  for bush=-10 to 10 step 20
    j=nextresource()
    if (j>0)
      r(j).energy=int(rnd(300))+300
      r(j).x=a(i).x+bush
      r(j).z=a(i).z+bush
      r(j).y=get ground height(1,r(j).x,r(j).z)
      color object r_obj(i),rgb(0,255,0)
      size=r(j).energy
      scale object r_obj(j),size,size,size
      position object r_obj(j),r(j).x,r(j).y+size/200,r(j).z
      show object r_obj(j)
    endif
  next bush
  position camera camx,camy,camz
endfunction
function make_resources()
  for i=1 to max
    r(i).energy=int(rnd(300))+300
    r(i).x=int(rnd(1000))
    r(i).z=int(rnd(1000))
    r(i).y=get ground height(1,r(i).x,r(i).z)
    r_obj(i)=nextobj()
    make object sphere r_obj(i),1
    color object r_obj(i),rgb(0,255,0)
    size=r(i).energy
    scale object r_obj(i),size,size,size
    if (i<=100)
      position object r_obj(i),r(i).x,r(i).y+size/200,r(i).z
      r(i).active=1
    else
      hide object r_obj(i)
      r(i).active=0
    endif
  next i
  r_top=100
endfunction
function make_baby(parent)
  camx=camera position x()
  camy=camera position y()
  camz=camera position z()
  i=nextanimal()
  if (i>0)
    reset_animal(i)
    a(i).x=object position x(a_obj(parent))
    a(i).z=object position z(a_obj(parent))
    a(i).y=get ground height(1,a(i).x,a(i).z)
    size=a(i).age*20
    scale object a_obj(i),size,size,size
    color object a_obj(i),colour(a(i).sex)
    position object a_obj(i),a(i).x,a(i).y+a(i).age/2,a(i).z
  endif
  position camera camx,camy,camz
endfunction
function reset_animal(i)
  a(i).age=5
  a(i).sex=int(rnd(1))+1
  a(i).hunt=1
  a(i).parent=0
  a(i).seek=0
  a(i).energy=500+int(rnd(20))
  a(i).active=1
  show object a_obj(i)
endfunction
function remove_animal(i)
  a(i).active=0
  hide object a_obj(i)
endfunction  
function make_animals()
  for i=1 to max
    a_obj(i)=nextobj()
    make object cube a_obj(i),5
    set object collision to boxes a_obj(i)
    set object collision on a_obj(i)
    set object ambient a_obj(i),1
    if (i<=20)
      reset_animal(i)
      a(i).x=int(rnd(1000))
      a(i).z=int(rnd(1000))
      a(i).y=get ground height(1,a(i).x,a(i).z)
      size=a(i).age*20
      scale object a_obj(i),size,size,size
      color object a_obj(i),colour(a(i).sex)
      position object a_obj(i),a(i).x,a(i).y+a(i).age/2,a(i).z
    else
      hide object a_obj(i)
      a(i).active=0
      a(i).energy=0
    endif
  next i
  a_top=20
endfunction
function ground()
  make matrix 1,1000,1000,25,25
  randomize matrix 1,5
  prepare matrix texture 1,1,1,1
  position matrix 1,0,0,0
  update matrix 1
endfunction

function usercontrol()
  if leftkey()
    pitch camera up camangle
    turn camera left 1.0
    pitch camera down camangle
  endif
  if rightkey()
    pitch camera up camangle
    turn camera right 1.0
    pitch camera down camangle
  endif
  if upkey()
    pitch camera up camangle
    move camera 3.0
    pitch camera down camangle
  endif
  if downkey()
    pitch camera up camangle
    move camera -3.0
    pitch camera down camangle
  endif
  if spacekey() then pause=1
  if returnkey() then pause=0
endfunction

function make_textures()
  create bitmap 1,256,256
  ink rgb(64,64,64),0
  box 0,0,255,255
  ink rgb(96,96,64),0
  for i=1 to 100
    x=int(rnd(255))
    y=int(rnd(255))
    line 0,x,255,x
    line y,0,y,255
  next i
  get image 1,0,0,255,255
  set current bitmap 0
endfunction

REM Project: Mini-Sim
REM Created: 12/20/2008 10:07:32 PM
REM For TGC DBPro Coding Challenge
REM ***** Main Source File *****
REM

REM Project: Mini-Sim
REM Created: 12/20/2008 10:07:32 PM
REM For TGC DBPro Coding Challenge
REM ***** Main Source File *****
REM set display mode
set display mode 1208,800,0

REM Variables start
foodbh = 2
waterbh = 2
simc = 1
food = 10
water = 10
day = 1
pp1 = 41
pp2 = 368
pops = 20
waterl = 2
foodl = 2
note1 = 187
note2 = 153
rem variables end

remstart
rem make starting sim
make object sphere 1,0.5
color object 1, rgb (250,0,0)

rem make starting buildings
make object box 2,2,foodbh,2
   position object 2,4,0,0
      color object 2, rgb (103,72,52)

make object box 3,2,waterbh,2
    position object 3,-4,0 ,0
      color object 3, rgb (0,70,250)
rem Make Playing area.
make object box 4,10,0.1,10:position object 4,0,-0.55,0
color object 4, rgb (250,250,250)
sync
REM position camera
position camera 0,10,-10
      point camera 0,0,0
remend

set cursor 26,300
print " Where would you like your population to work? Type food or water."


set cursor 30,5
   print "Population " ; simc
set cursor 30,30
      print "Food(-2 a day per person) " ; food
set cursor 30,55
         print "Water(Loss same as food) " ; water
set cursor 30,80
            print "Day " ; day




sync
do
remstart
by = mousex()
bx = mousey()
bz = mousez()

if upkey()=1
set cursor 500,0
print "x " ; by
   print "y " ;bx
      print "z " ; bz
endif
remend






set cursor 23,416
   input  pa$
gosub parse






sync
loop

parse:



select pa$

   case "food"
     fa = rnd(5)

            if fa = 0
               set cursor pp1,pp2 : print "You slave over the fields but return with no crop(+0)"
            endif
            if fa = 1
               set cursor pp1,pp2: print "You slave over the fields but return with little(+1)"
               food = food+1
            endif
            if fa = 2
               set cursor pp1,pp2: print "You slave over the fields but return under par(+2)" : food = food+2
            endif
            if fa = 3
               set cursor pp1,pp2: print "You slave over the fields and score average(+3)" : food = food+3
            endif
            if fa = 4
               set cursor pp1,pp2: print "You slave over the fields and get a hefty sum(+4)" : food = food+4
            endif
            if fa = 5
               set cursor pp1,pp2: print "You slave over the fields and make it big!(+5)" : food = food+5
            endif



   endcase

   case "water"
      wa = rnd(5)
            if wa = 0
               set cursor pp1,pp2 : print "You get water from the river but trip and dump it all(+0)"
            endif
            if wa = 1
               set cursor pp1,pp2: print "You get water fromt he river but lose almost all of it(+1)"
               water = food+1
            endif
            if wa = 2
               set cursor pp1,pp2: print "You get water from the river but lost a decent amount(+2)" : water = water+2
            endif
            if wa = 3
               set cursor pp1,pp2: print "You get water from the river and get an average amount(+3)" : water = water+3
            endif
            if wa = 4
               set cursor pp1,pp2: print "You get water from the river and take back a large sum(+4)" : water = water+4
            endif
            if wa = 5
               set cursor pp1,pp2: print "You get water from the river and don't lose a drop!(+5)" : water = water+5
            endif
   endcase
endselect




useage = useage+1
if useage = 2
useage = 0
   day = day+1
    water =  water - waterl
        food = food - foodl
endif

if simc <1
   water = water+simc
      food = food+simc
endif

if food >= pops
simc = simc+1
   waterl = waterl+2
      foodl = foodl+2
         pops = pops+10
            set cursor note1,200
               print "Congratulations, you've gained a population!"
endif

if food <= 0
simc = simc - 1
   foodl = foodl-2
      waterl = waterl-2
         set cursor note1,100
            print "Your food supply got to low and a person has died!"
endif
if water <= 0
simc = simc - 1
   foodl = foodl-2
      waterl = waterl-2
         set cursor note1,125
            print "Your water supply got to low and a person has died!"
endif

if water <= 5
set cursor note1,150
   print "WARNING! : Your water supply is getting low!"
endif

if food <=5
set cursor note1,175
   print "WARNING! : Your food supply is getting low!"
endif

if simc <= 0
gosub fail
endif


sync


 wait 0500

   CLS


set cursor 26,300
print " Where would you like your population to work? Type food or water."

set cursor 30,5
   print "Population " ; simc
set cursor 30,30
      print "Food(-2 a day per person) " ; food
set cursor 30,55
         print "Water(Loss same as food) " ; water
set cursor 30,80
            print "Day " ; day

sync
return


fail:
cls

set cursor note1,note2 : set text size 72
   print "YOU!"
      wait 1000
         cls
set cursor note1,note2 : set text size 72
   print "HAVE!"
      wait 1000
         cls
set cursor note1,note2 : set text size 72
   print "FAILED!"
      wait 1000
         cls
set cursor note1,note2 : set text size 24
   print "Your entire population is dead...game will exit in 5 seconds"
      wait 5000
         end
   return

sync on : sync rate 60
set display mode 1024,768,32
randomize timer()
hide mouse

set text font "arial black"
set text size 16

textheight=text height("TestString")

`======= Variable Setup ===============

`Used in FreeSprite function, to account for "theoretical" sprites
global FreeSpriteCounter
FreeSpriteCounter=4

`Screen divided into tiles for pathfinding, building
global TilesX
global TilesY
TilesX=screen width()/10
TilesY=screen height()/10

`Images
#Constant SimBaseImage       1
#Constant GrassImage         2
#Constant CrosshairsImage    3
#Constant ToolbarImage       4
#Constant ShrinkButtonImage  5
#Constant EnlargeButtonImage 6
#Constant WarehouseImage     7

`Sprites
#Constant CrosshairsSprite   1
#Constant ToolbarSprite      2
#Constant ShrinkButtonSprite 3
#Constant PlacementSprite    4

`Types
`In array Sims(0), info about each sim
type Sim
    Name as string
    LastName as string
    Sex as boolean `1=M, 0=F
    Skin as integer
    SpriteNo as integer
    TargetX as integer
    TargetY as integer
    PathStart as integer
    PathEnd as integer
    Target as integer
    PositionX as float
    PositionY as float
    TileX as integer
    TileY as integer
endtype

type AStarNode
    ParentX as integer
    ParentY as integer
    Closed as boolean
    F as integer
    H as integer
    G as integer
endtype

type Waypoint
    XPos as integer
    YPos as integer
endtype

`In array BuildingBases(0), info about buildings one could build
type BuildingBase
    Name as string
    XSize as integer
    YSize as integer
    WoodCost as integer
    TotalHealth as integer
    ImageNo as integer
    ClickOn as integer  `Img
    ClickOff as integer  `Img
    ClickOnBad as integer  `Img
    ClickOffBad as integer  `Img
    SpriteNo as integer
endtype

`In array Buildings(0), info about each individual building
type Building
    SpriteNo as integer
    Health as float
    BuildingType as integer
    XPos as integer
    YPos as integer
endtype

`Store building base data
DIM BuildingBases(1) as BuildingBase
BuildingBases(1).Name="Warehouse"
BuildingBases(1).XSize=8
BuildingBases(1).YSize=7
BuildingBases(1).WoodCost=5
BuildingBases(1).TotalHealth=100
BuildingBases(1).ImageNo=WarehouseImage

`Other arrays for info
DIM Buildings(0) as Building
DIM Sims(0) as Sim
DIM Paths(0) as Waypoint

`Name data for sims
NumberMFirsts=12
NumberFFirsts=9
NumberLasts=7

DIM MFirstNames$(NumberMFirsts)
DIM FFirstNames$(NumberFFirsts)
DIM LastNames$(NumberLasts)

`Used to store pathfinding and building info
DIM ScreenPaths(TilesX,TilesY)
`0=Empty
`1=BuiltOn
`2=UnderConstruction
`101+=BuildingOn

`Different possible skin colors (African, white)
DIM SkinColors(1) as dword
SkinColors(0)=rgb(230,213,172)
SkinColors(1)=rgb(155,123,49)

`Duh
gosub DIMNames

`Priorities of each action, play will change
BuildPriority=50
RepairPriority=20
FoodPriority=30

`Resources
wood=5
food=10
metal=0

`Adjustables
buildspeed as float
buildspeed=0.25


`======= Media Setup ==================

set image colorkey 1,1,1

gosub LOADMEDIA

ink rgb(230,230,230),0
set text font "arial"
set text size 10

`======= Setup Starting Colony ========

for c=1 to 5
    skincolor=rnd(1)
    array insert at bottom Sims(0)
    Sims(array count(Sims(0))).Name=MFirstNames$(rnd(NumberMFirsts))
    Sims(array count(Sims(0))).Sex=1
    Sims(array count(Sims(0))).LastName=LastNames$(rnd(NumberLasts))
    Sims(array count(Sims(0))).Skin=skincolor
    Sims(array count(Sims(0))).SpriteNo=FreeSprite()
    array insert at bottom Sims(0)
    Sims(array count(Sims(0))).Name=FFirstNames$(rnd(NumberFFirsts))
    Sims(array count(Sims(0))).Sex=0
    Sims(array count(Sims(0))).LastName=Sims(array count(Sims(0))-1).LastName
    Sims(array count(Sims(0))).Skin=skincolor
    Sims(array count(Sims(0))).SpriteNo=FreeSprite()
next c

for c=1 to array count(Sims(0))
    sprite Sims(c).SpriteNo,c*40+10,100,SimBaseImage
    set sprite diffuse Sims(c).SpriteNo,rgbr(SkinColors(Sims(c).Skin)),rgbg(SkinColors(Sims(c).Skin)),rgbb(SkinColors(Sims(c).Skin))
    Sims(c).PositionX=sprite x(Sims(c).SpriteNo)
    Sims(c).PositionY=sprite y(Sims(c).SpriteNo)
    Sims(c).TargetX=Sims(c).PositionX/10
    Sims(c).TargetY=Sims(c).PositionY/10
next c

`======================================
`====== MAIN LOOOOP ===================

do
cls

sprite CrosshairsSprite,mousex(),mousey(),CrosshairsImage

`Tile grass across screen
for x=0 to screen width()/100
    for y=0 to screen height()/100
        paste image GrassImage,x*100,y*100
    next y
next x

`Pathfind and move
gosub ControlSims

`Display all kinds of stuff the user needs
gosub ControlInformation

`Goes to a subroutine when clicked
if clicked=0 and mouseclick()=1
    clicked=1
    gosub Mouseclicks
endif
if mouseclick()=0 then clicked=0

`Debug Info
if controlkey()=1
    for x=1 to TilesX
        line x*10,0,x*10,screen height()
    next x
    for y=1 to TilesY
        line 0,y*10,screen width(),y*10
    next y
    for x=0 to 102
        for y=0 to 76
            if ScreenPaths(x,y)<>0 then text x*10+2,y*10,str$(ScreenPaths(x,y))
        next y
    next x
    for c=1 to array count(Sims(0))
        text Sims(c).TargetX*10,Sims(c).TargetY*10+10,"H"
        text Sims(c).TileX*10,Sims(c).TileY*10-10,"L"
        for d=Sims(c).PathStart to Sims(c).PathEnd
            text 100*c,10*(d-Sims(c).PathStart+1),str$(Paths(d).XPos)+" , "+str$(Paths(d).YPos)
        next d
    next c
    for c=1 to array count(Buildings(0))
        hide sprite Buildings(c).SpriteNo
    next c
endif
if controlkey()=0
    for c=1 to array count(Buildings(0))
        show sprite Buildings(c).SpriteNo
    next c
endif

sync
loop

`====== ==== ====== ===================
`======================================



ControlSims:

for c=1 to array count(Sims(0))
    TileX=sprite x(Sims(c).SpriteNo)/10
    TileY=sprite y(Sims(c).SpriteNo)/10
    TargetX=Sims(c).TargetX
    TargetY=Sims(c).TargetY
    movex=0
    movey=0
    `Determine movement direction
    if TileX<TargetX
        movex=1
    endif
    if TileX>TargetX
        movex=-1
    endif
    if TileY<TargetY
        movey=1
    endif
    if TileY>TargetY
        movey=-1
    endif
    if TileY=TargetY
        movey=0
    endif
    if TileX=TargetX
        movex=0
    endif
    if Sims(c).Target=0
        
        `Reassign Sim's targets
        for x=0 to 102
            for y=0 to 76
                if ScreenPaths(x,y)>100
                    Sims(c).Target=ScreenPaths(x,y)
                endif
            next y
        next x
        if Sims(c).Target>100
            AstarFindPath(c,Sims(c).Target-100)
        endif
        
    else
        
        `======= Move sim =======
        
        collide=0
        
        tempx#=Sims(c).PositionX
        tempy#=Sims(c).PositionY
        
        if movex<>0 and movey<>0
            `Move less diagonally
            inc tempx#,0.4*movex
            inc tempy#,0.4*movey
            else
            `Move more horizontally
            inc tempx#,0.56*movex
            inc tempy#,0.56*movey
        endif
        `Check if new position collides with another sim
        for d=c+1 to array count(Sims(0))
            if tempx#/10=Sims(d).TileX and tempy#/10=Sims(d).TileY
                collide=1
            endif
        next d
        if collide=0 and Sims(c).TargetX>0
            Sims(c).PositionX=tempx#
            Sims(c).PositionY=tempy#
        endif
        if TileX=TargetX and TileY=TargetY
            if Paths(Sims(c).PathStart).XPos>0
                Sims(c).TargetX=Paths(Sims(c).PathStart).XPos
                Sims(c).TargetY=Paths(Sims(c).PathStart).YPos
                array insert at element Paths(0),Sims(c).PathEnd
                array delete element Paths(0),Sims(c).PathStart
                else
                Sims(c).TargetX=-1
            endif
        endif
        sprite Sims(c).SpriteNo,Sims(c).PositionX,Sims(c).PositionY,SimBaseImage
        
        `======= Sim Build =======
        if Sims(c).TargetX=-1 and Sims(c).Target>100
            targetbuilding=Sims(c).Target-100
            targetbuildingtype=Buildings(targetbuilding).BuildingType
            buildingmaxhealth=BuildingBases(targetbuildingtype).TotalHealth
            inc Buildings(targetbuilding).Health,buildspeed
            buildingcurrenthealth#=Buildings(targetbuilding).Health
            if buildingcurrenthealth#>=buildingmaxhealth
                Buildings(targetbuilding).Health=buildingmaxhealth
                Sims(c).Target=0
                for x=0 to BuildingBases(targetbuildingtype).xsize-1
                    for y=0 to BuildingBases(targetbuildingtype).ysize-1
                        ScreenPaths(x+Buildings(targetbuilding).XPos,y+Buildings(targetbuilding).YPos)=1
                    next y
                next x
            endif
            alpha=(buildingcurrenthealth#/buildingmaxhealth)*255
            set sprite alpha Buildings(targetbuilding).SpriteNo,alpha
        endif
    endif
    Sims(c).TileX=Sims(c).PositionX/10
    Sims(c).TileY=Sims(c).PositionY/10
    
next c

return


ControlInformation:

`Mouseover sims - display info
for c=1 to array count(Sims(0))
    if mousex()<sprite x(Sims(c).SpriteNo)+10 and mousex()>sprite x(Sims(c).SpriteNo)
        if mousey()<sprite y(Sims(c).SpriteNo)+10 and mousey()>sprite y(Sims(c).SpriteNo)
            text mousex()+5,mousey()+5,Sims(c).Name+" "+Sims(c).LastName
            text mousex()+5,mousey()+15,str$(Sims(c).TargetX)
            text mousex()+5,mousey()+25,str$(Sims(c).TargetY)
        endif
    endif
next c

`Mouseover building buttons - color properly
for c=1 to array count(BuildingBases(0))
    if mousex()>820 and mousex()<820+text width(BuildingBases(c).Name) and mousey()>70+c*textheight and mousey()<70+(c+1)*textheight
        if Wood>=BuildingBases(c).WoodCost
            sptemp=BuildingBases(c).ClickOn
            else
            sptemp=BuildingBases(c).ClickOnBad
        endif
        else
        if Wood>=BuildingBases(c).WoodCost
            sptemp=BuildingBases(c).ClickOff
            else
            sptemp=BuildingBases(c).ClickOffBad
        endif
    endif
    sprite BuildingBases(c).SpriteNo,820,70+c*textheight,sptemp
next c

`When placing a building, displays and checks legality
if placing>0
    bad=0
    mousetilex=mousex()/10
    mousetiley=mousey()/10
    sprite PlacementSprite,mousetilex*10-10,mousetiley*10-10,BuildingBases(placing).ImageNo
    for x=-1 to BuildingBases(placing).XSize-2
        for y=-1 to BuildingBases(placing).YSize-2
            if mousetilex+x>102 or mousetiley+y>76
                bad=1
                else
                if mousetilex<=1 or mousetiley<=1
                    bad=1
                    else
                    if ScreenPaths(mousetilex+x,mousetiley+y)<>0 then bad=1
                endif
            endif
        next y
    next x
    if bad=1
        set sprite diffuse PlacementSprite,200,100,100
        else
        set sprite diffuse PlacementSprite,255,255,255
    endif
endif

return



Mouseclicks:

`Place a building if one is being placed and can be
if placing>0 and bad=0
    delete sprite PlacementSprite
    mousetilex=mousex()/10
    mousetiley=mousey()/10
    for x=-1 to BuildingBases(placing).xsize-2
        for y=-1 to BuildingBases(placing).ysize-2
            ScreenPaths(x+mousetilex,y+mousetiley)=2
        next y
    next x
    array insert at bottom Buildings(0)
    tempno=array count(Buildings(0))
    ScreenPaths(mousetilex-1,mousetiley-1)=tempno+100
    Buildings(tempno).SpriteNo=FreeSprite()
    sprite Buildings(tempno).SpriteNo,mousetilex*10-10,mousetiley*10-10,BuildingBases(placing).ImageNo
    set sprite alpha Buildings(tempno).SpriteNo,0
    Buildings(tempno).Health=1
    Buildings(tempno).BuildingType=placing
    Buildings(tempno).XPos=mousetilex-1
    Buildings(tempno).YPos=mousetiley-1
    placing=0
endif

`Control shrinking/enlarging of toolbar
if mousex()>915 and mousey()>2 and mousex()<945 and mousey()<22
    if sprite image(ShrinkButtonSprite)=ShrinkButtonImage
        sprite ShrinkButtonSprite,915,2,EnlargeButtonImage
        hide sprite ToolbarSprite
        for c=1 to array count(BuildingBases(0))
            hide sprite BuildingBases(c).SpriteNo
        next c
        else
        sprite ShrinkButtonSprite,915,2,ShrinkButtonImage
        show sprite ToolbarSprite
        for c=1 to array count(BuildingBases(0))
            show sprite BuildingBases(c).SpriteNo
        next c
    endif
endif

`Control pressing of build buttons
if sprite image(ShrinkButtonSprite)=ShrinkButtonImage
    for c=1 to array count(BuildingBases(0))
        if wood>=BuildingBases(c).WoodCost and placing=0
            if mousex()>820 and mousex()<820+text width(BuildingBases(c).Name) and mousey()>70+c*textheight and mousey()<70+(c+1)*textheight
                placing=c
            endif
        endif
    next c
endif

`Sim selection might go here

return



DIMNames:

MFirstNames$(0)="John"
MFirstNames$(1)="Brian"
MFirstNames$(2)="Alex"
MFirstNames$(3)="Kevin"
MFirstNames$(4)="Chris"
MFirstNames$(5)="Joe"
MFirstNames$(6)="Sam"
MFirstNames$(7)="Tim"
MFirstNames$(8)="Tom"
MFirstNames$(9)="Gary"
MFirstNames$(10)="Greg"
MFirstNames$(11)="Bruce"
MFirstNames$(12)="Tony"

FFirstNames$(0)="Ashley"
FFirstNames$(1)="Isabel"
FFirstNames$(2)="Jenny"
FFirstNames$(3)="Mary"
FFirstNames$(4)="Anne"
FFirstNames$(5)="Jane"
FFirstNames$(6)="Sally"
FFirstNames$(7)="Suzzie"
FFirstNames$(8)="Elizabeth"
FFirstNames$(9)="Katie"

LastNames$(0)="Samuelson"
LastNames$(1)="Miller"
LastNames$(2)="Jones"
LastNames$(3)="Jeffries"
LastNames$(4)="Owens"
LastNames$(5)="Smith"
LastNames$(6)="Cook"
LastNames$(7)="Reynolds"

return


`By IanM
function FillCircle( CX as integer, CY as integer, R as integer )
   local x as integer
   local y as integer
   local i as integer
   local s as integer

lock pixels
   s=R*0.70710678 : ` this number is sin(45) - precalculate!
   box CX-s, CY-s, CX+s+1, CY+s+1
   s=s+1 : ` Faster than 'inc s'?
   i=R*R
   for y=s to R
      x=sqrt( i-(y*y) )

      ` Draw top and bottom
      box CX-x, CY-y, CX+x+1, CY-y+1
      box CX-x, CY+y, CX+x+1, CY+y+1

      ` Draw left and right
      box CX-y, CY-x, CX-y+1, CY+x+1
      box CX+y, CY-x, CX+y+1, CY+x+1
   next y
unlock pixels

endfunction


function FreeSprite()

inc FreeSpriteCounter
tempno=FreeSpriteCounter

repeat
inc tempno
until sprite exist(tempno)=0

endfunction tempno


function FreeImage()

repeat
inc tempno
until image exist(tempno)=0

endfunction tempno



LOADMEDIA:
`Create sim, white so skin color is easily changed with diffuse
create bitmap 1,100,100
set current bitmap 1
cls rgb(1,1,1)
ink rgb(0,0,0),0
FillCircle(5,5,5)
ink rgb(255,255,255),0
FillCircle(5,5,4)
get image SimBaseImage,0,0,10,10,1

`Random grass
cls rgb(0,128,0)
for x=0 to 100
    for y=0 to 99
        if rnd(10)=5
            dot x,y,rgb(0,200,0)
            dot x,y+1,rgb(0,160,0)
        endif
    next y
next x
get image GrassImage,0,0,100,100

`Crosshairs (mouse image)
cls rgb(1,1,1)
ink rgb(200,200,200),0
line 5,0,5,10
line 0,5,10,5
get image CrosshairsImage,0,0,10,10,1
sprite CrosshairsSprite,mousex(),mousey(),CrosshairsImage
set sprite alpha CrosshairsSprite,200
offset sprite CrosshairsSprite,5,5
set sprite priority CrosshairsSprite,2

`Big toolbar on the right
delete bitmap 1
create bitmap 1,201,601
set current bitmap 1
cls rgb(107,107,107)
ink rgb(134,134,134),0
line 0,0,198,0
line 0,0,0,598
line 0,598,198,598
line 0,597,198,597
line 198,0,198,597
line 197,0,197,597
ink rgb(80,80,80),0
line 3,3,196,3
line 3,4,196,4
line 3,3,3,596
line 4,3,4,596
line 0,599,200,599
line 0,600,200,600
line 199,0,199,600
line 200,1,200,600
dot 200,0,rgb(1,1,1)
dot 0,600,rgb(1,1,1)
get image ToolbarImage,0,0,201,601,1
sprite ToolbarSprite,800,24,ToolbarImage
set sprite alpha ToolbarSprite,200
set sprite priority ToolbarSprite,1

`Shrink/enlarge toolbar buttons
delete bitmap 1
create bitmap 1,31,21
set current bitmap 1
cls rgb(107,107,107)
ink rgb(134,134,134),0
line 0,0,0,18
line 1,0,1,18
line 0,0,28,0
line 0,1,28,1
line 18,0,18,28
line 17,0,17,28
line 0,28,18,28
line 0,27,18,27
ink rgb(80,80,80),0
line 3,3,26,3
line 3,4,26,4
line 3,3,3,16
line 4,3,4,16
line 0,19,30,19
line 1,20,30,20
line 29,0,29,20
line 30,0,30,20
dot 30,0,rgb(1,1,1)
dot 0,20,rgb(1,1,1)
ink rgb(0,0,0),0
line 9,13,15,7
line 9,12,15,6
line 15,6,21,12
line 15,7,21,13
get image ShrinkButtonImage,0,0,30,20,1
ink rgb(107,107,107),0
box 8,5,22,14
ink rgb(0,0,0),0
line 9,7,15,13
line 9,6,15,12
line 15,12,21,6
line 15,13,21,7
get image EnlargeButtonImage,0,0,30,20,1
delete bitmap 1

sprite ShrinkButtonSprite,915,2,ShrinkButtonImage
set sprite priority ShrinkButtonSprite,1
set sprite alpha ShrinkButtonSprite,200

`Warehouse building image
create bitmap 1,80,70
ink rgb(0,0,0),0
box 0,0,80,70
ink rgb(231,231,211),0
box 1,1,79,69
ink rgb(0,0,0),0
box 5,5,75,65
ink rgb(95,95,95),0
box 6,6,74,64
ink rgb(192,192,192),0
box 8,8,74,64
ink rgb(148,148,148),0
for c=10 to 61 step 3
    line 8,c,74,c
next c
get image WarehouseImage,0,0,80,70,1

delete bitmap 1
set current bitmap 0

`Texts for building buildings (go in toolbar)
for c=1 to array count(BuildingBases(0))
    cls rgb(1,1,1)
    ink rgb(200,0,0),0
    text 0,0,BuildingBases(c).Name+" - "+str$(BuildingBases(c).WoodCost)
    BuildingBases(c).ClickOnBad=FreeImage()
    get image BuildingBases(c).ClickOnBad,0,0,text width(BuildingBases(c).Name+" - "+str$(BuildingBases(c).WoodCost)),textheight,1

    cls rgb(1,1,1)
    ink rgb(0,150,0),0
    text 0,0,BuildingBases(c).Name+" - "+str$(BuildingBases(c).WoodCost)
    BuildingBases(c).ClickOn=FreeImage()
    get image BuildingBases(c).ClickOn,0,0,text width(BuildingBases(c).Name+" - "+str$(BuildingBases(c).WoodCost)),textheight,1
    
    cls rgb(1,1,1)
    ink rgb(200,100,100),0
    text 0,0,BuildingBases(c).Name+" - "+str$(BuildingBases(c).WoodCost)
    BuildingBases(c).ClickOffBad=FreeImage()
    get image BuildingBases(c).ClickOffBad,0,0,text width(BuildingBases(c).Name+" - "+str$(BuildingBases(c).WoodCost)),textheight,1
    
    cls rgb(1,1,1)
    ink rgb(100,200,100),0
    text 0,0,BuildingBases(c).Name+" - "+str$(BuildingBases(c).WoodCost)
    BuildingBases(c).ClickOff=FreeImage()
    get image BuildingBases(c).ClickOff,0,0,text width(BuildingBases(c).Name+" - "+str$(BuildingBases(c).WoodCost)),textheight,1
    
    BuildingBases(c).SpriteNo=FreeSprite()
    sprite BuildingBases(c).SpriteNo,820,100+c*textheight,BuildingBases(c).ClickOffBad
    set sprite priority BuildingBases(c).SpriteNo,2

next c
return


function AStarFindPath(SimID,TargetObject)

DIM Open(TilesX,TilesY) as AStarNode

Open(Sims(SimID).TileX,Sims(SimID).TileY).ParentX=-1
Open(Sims(SimID).TileX,Sims(SimID).TileY).ParentY=-1
Open(Sims(SimID).TileX,Sims(SimID).TileY).F=999999998

TempXSize=BuildingBases(Buildings(TargetObject).BuildingType).XSize
TempYSize=BuildingBases(Buildings(TargetObject).BuildingType).YSize
TempXPos=Buildings(TargetObject).XPos
TempYPos=Buildings(TargetObject).YPos

repeat

`Find open tile with least F rating
curF=999999999
for x=1 to TilesX
    for y=1 to TilesY
        if Open(x,y).F<curF and Open(x,y).F>0 and Open(x,y).Closed=0
            curx=x
            cury=y
            curF=Open(x,y).F
        endif
    next y
next x
Open(curx,cury).Closed=1

`Check and open tiles around the selected
failed=1
for  x=-1 to 1
    for y=-1 to 1
        if x<>0 or y<>0
            if curx+x<TilesX and cury+y<TilesY and curx+x>0 and cury+y>0
                if ScreenPaths(curx+x,cury+y)=2 or ScreenPaths(curx+x,cury+y)=0 and Open(curx+x,cury+y).Closed<>1
                    failed=0
                    `If already open and G is better, reassign parent to current and recalc G and F
                    `Else, add to open list and record necessary
                    if Open(curx+x,cury+y).F>0
                        if Open(curx+x,cury+y).G>Open(curx,cury).G+10+(4*abs(x)*abs(y))
                            Open(curx+x,cury+y).ParentX=curx
                            Open(curx+x,cury+y).ParentY=cury
                            Open(curx+x,cury+y).G=Open(curx,cury).G+10+(4*abs(x)*abs(y))
                            Open(curx+x,cury+y).F=Open(curx+x,cury+y).G+Open(curx+x,cury+y).H
                        endif
                        else
                        Open(curx+x,cury+y).ParentX=curx
                        Open(curx+x,cury+y).ParentY=cury
                        Open(curx+x,cury+y).G=10+(4*abs(x)*abs(y))+Open(curx,cury).G
                        Open(curx+x,cury+y).H=10*(abs(x+curx-TempXPos-TempXSize/2)+abs(cury+y-TempYPos-TempYSize/2))
                        Open(curx+x,cury+y).F=Open(curx+x,cury+y).G+Open(curx+x,cury+y).H
                    endif
                endif
            endif
        endif
    next y
next x

`Check if we've reached the target
for x=-1 to TempXSize-2
    text (TempXPos+x)*10,(TempYPos-1)*10,"H"
    text (TempXPos+x)*10,(TempYPos+TempYSize-2)*10,"H"
    if Open(TempXPos+x,TempYPos-1).ParentX<>0
        ReachedTarget=1
        EndNodeX=TempXPos+x
        EndNodeY=TempYPos-1
    endif
    if Open(TempXPos+x,TempYPos+TempYSize-2).ParentX<>0
        ReachedTarget=1
        EndNodeX=TempXPos+x
        EndNodeY=TempYPos+TempYSize-2
    endif
next x
for y=-1 to TempYSize-2
    text (TempXPos-1)*10,(TempYPos+y)*10,"H"
    text (TempXPos+TempXSize-2)*10,(TempYPos+y)*10,"H"
    if Open(TempXPos-1,TempYPos+y).ParentX<>0
        ReachedTarget=1
        EndNodeX=TempXPos-1
        EndNodeY=TempYPos+y
    endif
    if Open(TempXPos+TempXSize-2,TempYPos+y).ParentX<>0
        ReachedTarget=1
        EndNodeX=TempXPos+TempXSize-2
        EndNodeY=TempYPos+y
    endif
next x

remstart
`Debug
for x=1 to TilesX
    for y=1 to TilesY
        if Open(x,y).ParentX>0
            if Open(x,y).Closed=1
                text x*10,y*10,"X"
                else
                text x*10-3,y*10,str$(Open(x,y).F)
            endif
        endif
        if Open(x,y).ParentX<0 then text x*10,y*10,"S"
    next y
next x
sync
wait key
remend

until ReachedTarget=1 or failed>0

`Save Path
if failed=0
    array insert at bottom Paths(0)
    Sims(SimID).PathStart=array count(Paths(0))
    repeat
        
        remstart
        `Debug
        text 10,10,str$(Sims(SimID).PathStart)
        text 10,20,str$(array count(Paths(0)))
        for x=1 to TilesX
            for y=1 to TilesY
                if x=tempx and y=tempy
                    text x*10,y*10,"@"
                    else
                    if Open(x,y).ParentX>0
                        if Open(x,y).Closed=1
                            text x*10,y*10,"X"
                            else
                            text x*10,y*10,"O"
                        endif
                    endif
                    if Open(x,y).ParentX<0 then text x*10,y*10,"S"
                endif
            next y
        next x
        sync
        wait key
        remend

    if Open(EndNodeX,EndNodeY).ParentX<>-1
        array insert at element Paths(0),Sims(SimID).PathStart
        Paths(Sims(SimID).PathStart).XPos=Open(EndNodeX,EndNodeY).ParentX
        Paths(Sims(SimID).PathStart).YPos=Open(EndNodeX,EndNodeY).ParentY
        NEndNodeX=Open(EndNodeX,EndNodeY).ParentX
        EndNodeY=Open(EndNodeX,EndNodeY).ParentY
        EndNodeX=NEndNodeX
    endif
        
    until Open(EndNodeX,EndNodeY).ParentX=-1
    
    Sims(SimID).PathEnd=array count(Paths(0))
    Sims(SimID).TargetX=Paths(Sims(SimID).PathStart).XPos
    Sims(SImID).TargetY=Paths(Sims(SimID).PathStart).YPos
    array insert at bottom Paths(0)
    array delete element Paths(0),Sims(SimID).PathStart
endif
if failed=1 then Sims(SimID).Target=0

UNDIM Open(0,0)

endfunction

Bmaczero and acelepage,
a very good array of coding skills and they most likely deserved to win in their own rights but i think that they didn't include enough resources or interactiveness to win this challenge.

Aarrowh,
Congratulations!, simple is sometimes the best. You included interactiveness, population inc and dec based on the players score and i think that its a good example of a text based sims game.

Rem Project: PinBall Construction
Rem Created: 7/7/2005 6:35:40 PM

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

Sync On: Sync Rate 60:Autocam Off
Global n#
Global cFlag as Integer
Global LimbMatrix As Integer
Global EyeVector As Integer
Global LookAtVector As Integer
Global LookUpVector As Integer
Global tx#
Global ty#
Global tz#
Global Score as Integer
Dim KickFlag(1) as Float
Dim mm(2) as Float
Dim Kick(2)
LimbMatrix=10
EyeVector=11
LookAtVector=12
LookUpVector=13
r = Make Matrix4( LimbMatrix )
r = Make Vector3(1)
r = Make Vector3(EyeVector)
r = Make Vector3(LookAtVector)
r = Make Vector3(LookUpVector)


Make Object Sphere 1,8,10,10
Scale Object 1,71.5,71.5,71.5
Set Object Collision To Spheres 1
Prepare_Limb(1,0)

Make Object Box 2,100,5,120
Make object Box 3,20,10,7
Offset Limb 3,0,8,0,0
Make Mesh From Object 3,3
Delete Object 3
Add Limb 2,1,3
Prepare_Limb(2,1)
Scale Limb 2,1,100,100,71.5
Offset Limb 2,1,-20,2.6,-50
Rotate Limb 2,1,0,30,0
Color Limb 2,1,Rgb(50,50,100)

Add Limb 2,2,3
Prepare_Limb(2,2)
Scale Limb 2,2,100,100,71.5
Offset Limb 2,2,20,2.6,-50
Rotate Limb 2,2,0,-210,0
Color Limb 2,2,Rgb(50,50,100)

Make Object Box 3,7,10,120
Make Mesh From Object 3,3
Delete Object 3
Add Limb 2,3,3
Offset Limb 2,3,-50,2.4,0
Add Limb 2,4,3
Offset Limb 2,4,50,2.4,0

Make Object Box 3,100,10,7
Make Mesh from Object 3,3
Delete Object 3
Add Limb 2,5,3
Offset Limb 2,5,0,2.4,60

Make Object Cylinder 3,5
Make Mesh From Object 3,3
Delete Object 3
Add Limb 2,6,3
Offset Limb 2,6,0,2.4,30
Scale Limb 2,6,100,120,100
Add Limb 2,7,3
Offset Limb 2,7,-9,2.4,20
Scale Limb 2,7,100,120,100
Add Limb 2,8,3
Offset Limb 2,8,9,2.4,20
Scale Limb 2,8,100,120,100

Make Object Box 3,20,8,4
Make Mesh From Object 3,3
Delete Object 3
Add Limb 2,9,3
Offset Limb 2,9,-30,2.4,-42
Rotate Limb 2,9,0,40,0
Add Limb 2,10,3
Offset Limb 2,10,30,2.4,-42
Rotate Limb 2,10,0,-220,0

Make Object Cube 3,6
Make Mesh From Object 3,3
Delete Object 3
Add Limb 2,11,3
Offset Limb 2,11,-48,2.4,-28
Rotate Limb 2,11,0,45,0
Add Limb 2,12,3
Offset Limb 2,12,48,2.4,-28
Rotate Limb 2,12,0,47,0

Make Object Box 3,2,8,7
Make Mesh From Object 3,3
Delete Object 3
Add Limb 2,13,3
Offset Limb 2,13,20,2.4,35
Add Limb 2,14,3
Offset Limb 2,14,29,2.4,34
Add Limb 2,15,3
Offset Limb 2,15,38,2.4,33

Make Object Box 3,21,8,3
Make Mesh From Object 3,3
Delete Object 3
Add Limb 2,16,3
Offset Limb 2,16,-31,2.4,-27
Rotate Limb 2,16,0,40,0
Add Limb 2,17,3
Offset Limb 2,17,31,2.4,-27
Rotate Limb 2,17,0,-220,0


Color Limb 2,0,RGB(100,100,254)

Set Object Collision Off 2
Position Camera 0,110,-20
Point Camera 0,0,0

Pitch Object Up 2,4
For i = 0 to 2
   Make Object Sphere 11+i,7.5
   Position Object 11+i,Limb Position X(2,6+i),Limb Position Y(2,6+i),Limb Position Z(2,6+i)
   Set Object Collision To Spheres 11+i
   Color Object 11+i,Rgb(255,0,0)
Next i

Make Object Box 14,17,7,2
Position Object 14,Limb Position X(2,16)+.5,Limb Position Y(2,16),Limb Position Z(2,16)+.5
Rotate Object 14,0,40,0
Set Object Collision To Boxes 14
Hide Object 14

Clone Object 15,14
Position Object 15,Limb Position X(2,17)-.5,Limb Position Y(2,17),Limb Position Z(2,17)+.5
Rotate Object 15,0,-220,0
Set Object Collision To Boxes 15
Hide Object 15

Restore RoleOvers
For i = 1 to 3
   Make Object Box 15+i,.5,.5,4
   Read x#,y#,z#
   Position Object 15+i,x#,Limb Position Y(2,6)+1,z#
   Color Object 15+i,0
   Set Object Collision To Boxes 15+i
Next i

Position Object 1,0,20,40


Do
   Turn Object Right 1,1
   If ReturnKey() And Object Position Y(1)<-20
      Position Object 1,35,20,40
      mm(0)=-(Rnd(30.0)/10.0+1.0)
      mm(1)=0
      mm(2)=0
   Endif
   tx#=Object Position X(1)
   ty#=Object Position Y(1)
   tz#=Object Position Z(1)
   Flipper(1)
   Flipper(2)
   If SpaceKey()
      Position Object 2,0,0,.5
   Else
      Position Object 2,0,0,0
   Endif
   mm(0)=mm(0)*(abs(mm(0))<=2.0)+2.0*(mm(0)>2.0)-2.0*(mm(0)<-2.0)
   mm(1)=mm(1)*(abs(mm(1))<=2.0)+2.0*(mm(1)>2.0)-2.0*(mm(1)<-2.0)
   mm(2)=mm(2)*(abs(mm(2))<=2.0)+2.0*(mm(2)>2.0)-2.0*(mm(2)<-2.0)
   Position Object 1,Object Position X(1)+mm(0),Object Position Y(1)+mm(1)-.25,Object Position Z(1)+mm(2)
   Kickers()
   c=Check_Collision(1,0,2,1,0)
   Position Object 1,fpos( 20 , 0 ), fpos( 20 , 1),fpos( 20 , 2)
   mm(0)=(Object Position X(1)-tx#)
   mm(1)=(Object Position Y(1)-ty#)
   mm(2)=(Object Position Z(1)-tz#)
   Sync_Flag=(Sync_Flag=0)
   If Sync_Flag
      Set Cursor 0,0
      Print "Score: ";Score
      Sync
   Endif
Loop

Function Flipper(side)
   ks=(side=1)*29+(side=2)*157
   ang#=(side=1)*30+(side=2)*-210
   If KickFlag(side-1)<60 and (KeyState(ks) or KickFlag(side-1)>0)
      KickFlag(side-1)=KickFlag(side-1)+5
      Rotate Limb 2,side,0,ang#-KickFlag(side-1)*((side=1)-(side=2)),0

      c=Check_Collision(2,side,1,1,0)
      If c
         Position Object 1,Object Position X(1)-mm(0)*.1,Object Position Y(1)-mm(1)*.15,Object Position Z(1)-mm(2)*.15
         tx#=Object Position X(1)
         ty#=Object Position Y(1)
         tz#=Object Position Z(1)
         Position Object 1,Object Position X(1)+mm(0)*.1,Object Position Y(1)+mm(1)*.15,Object Position Z(1)+mm(2)*.15
      Endif

   Endif
   If KickFlag(side-1)>59 and KeyState(ks)=0
      KickFlag(side-1)=0
      Rotate Limb 2,side,0,ang#,0
   Endif
Endfunction

Function Kickers()
   k=Object Collision(1,0)
   Select k
      Case 11,12,13
         If Kick(k-11)<1
            dx#=(Object Position X(1)-Object Position X(k))*.1+mm(0)*.1
            dy#=(Object Position Y(1)-Object Position Y(k))*.1+mm(1)*.15
            dz#=(Object Position Z(1)-Object Position Z(k))*.1+mm(2)*.1
            Position Object 1,Object Position X(1)-dx#,Object Position Y(1)-dy#,Object Position Z(1)-dz#
            tx#=Object Position X(1)
            ty#=Object Position Y(1)
            tz#=Object Position Z(1)
            Position Object 1,Object Position X(1)+dx#,Object Position Y(1)+dy#,Object Position Z(1)+dz#
            Kick(k-11)=7
            Score=Score+10
            Set Object Emissive k,Rgb(255,100,100)
         Endif
      EndCase
      Case 14
         dx#=1+mm(0)*.2
         dy#=0
         dz#=1+mm(2)*.2
         Position Object 1,Object Position X(1)-dx#,Object Position Y(1)-dy#,Object Position Z(1)-dz#
         tx#=Object Position X(1)
         ty#=Object Position Y(1)
         tz#=Object Position Z(1)
         Position Object 1,Object Position X(1)+dx#,Object Position Y(1)+dy#,Object Position Z(1)+dz#
         Score = Score + 1
      EndCase
      Case 15
         dx#=-1+mm(0)*.2
         dy#=0
         dz#=1+mm(2)*.2
         Position Object 1,Object Position X(1)-dx#,Object Position Y(1)-dy#,Object Position Z(1)-dz#
         tx#=Object Position X(1)
         ty#=Object Position Y(1)
         tz#=Object Position Z(1)
         Position Object 1,Object Position X(1)+dx#,Object Position Y(1)+dy#,Object Position Z(1)+dz#
         Score = Score + 1
      EndCase
      Case 16,17,18
         Score = Score + 2
      EndCase
   EndSelect
   For i = 11 to 13
      Kick(i-11)=Kick(i-11)-(Kick(i-11)>0)
      If Kick(i-11)=1
         Set Object Emissive i,0
      Endif
   Next i
EndFunction



Function Prepare_Limb(ObjectID,LimbID)
   Local tx#
   Local ty#
   Local tz#
   Local ac as Integer
   Local n as Integer
   Local _max as Integer
   `If Limb Exist(ObjectID,LimbID)=0
   `   ExitFunction
   `Endif
   arry=ObjectID*20+LimbID
   ac=Array Count(PreLimb())
   _max=1
   If ac>1
      For i = 1 to ac
         If _max<PreLimb(i)
            _max=PreLimb(i)
         Endif
      Next i
   Endif
   If ac<arry
      Dim PreLimb(arry) as Integer
      PreLimb(arry)=1
      Dim LMX(arry,_max) as Float
      Dim LMY(arry,_max) as Float
      Dim LMZ(arry,_max) as Float
   Endif
   Lock VertexData for Limb ObjectID,LimbID
   VIC=Get Vertexdata Index Count()
   n=0
   LMX(arry,n)=Get VertexData Position X(Get IndexData(0))
   LMY(arry,n)=Get VertexData Position Y(Get IndexData(0))
   LMZ(arry,n)=Get VertexData Position Z(Get IndexData(0))
   For i = 1 to VIC
      tx#=Get VertexData Position X(Get IndexData(i))
      ty#=Get VertexData Position Y(Get IndexData(i))
      tz#=Get VertexData Position Z(Get IndexData(i))
      flag=0
      For j=0 to n
         if Int(tx#*100)=Int(LMX(arry,j)*100) and Int(ty#*100)=Int(LMY(arry,j)*100) and Int(tz#*100)=Int(LMZ(arry,j)*100)
            flag=1
            Exit
         Endif
      Next j
      If flag=0
         n=n+1
         If n>_max
            _max=n
            PreLimb(arry)=n
            Dim LMX(arry,n) as Float
            Dim LMY(arry,n) as Float
            Dim LMZ(arry,n) as Float
         Endif
         LMX(arry,n)=tx#
         LMY(arry,n)=ty#
         LMZ(arry,n)=tz#
      Endif
   Next i
   PreLimb(arry)=n
   Unlock VertexData
Endfunction




Function Check_Collision(ObjectID as DWord,LimbID as DWord,TargetID as DWord,accuracy#,cycles)
arry=ObjectID*20+LimbID
if Array Count(cflag(0))<arry
   Dim cFlag(arry) as Integer
   Dim fpos(arry,2) as Float
   Dim n(arry) as Float
Endif
If Array Count(PreLimb())<arry
   Exit Prompt "Check_Collision():Limb was not prepared. Use Prepare_Limb() function first.","Error"
   End
Else
   If PreLimb(arry)<1
      Exit Prompt "Check_Collision():Limb was not prepared. Use Prepare_Limb() function first.","Error"
      End
   Endif
Endif

LimbMatrix4(LimbMatrix, ObjectID, LimbID)

ox#=Limb Position X(ObjectID,LimbID)
oy#=Limb Position Y(ObjectID,LimbID)
oz#=Limb Position Z(ObjectID,LimbID)
st=1.0/accuracy#
MC=PreLimb(arry)
If cFlag(arry)=0
n(arry)=1
fpos(arry,0)=ox#
fpos(arry,1)=oy#
fpos(arry,2)=oz#
Else
if n(arry)>1
n(arry)=2
fpos(arry,0)=fpos(arry,0)+ox#
fpos(arry,1)=fpos(arry,1)+oy#
fpos(arry,2)=fpos(arry,2)+oz#
Endif
Endif
For i = 0+cFlag(arry) to MC step st
   If Array Index Valid(LMZ(arry,i))=0
      Exit Prompt Str$(arry)+" : "+Str$(i) , ""
      End
   Endif
   Set Vector3 1,LMX(arry,i),LMY(arry,i),LMZ(arry,i)
   Transform Coords Vector3 1, 1, LimbMatrix
   d#=Intersect Object(TargetID,ox#,oy#,oz#,X Vector3(1),Y Vector3(1),Z Vector3(1))
   if d#>0
      Set Vector3 1,X Vector3(1)-ox#,Y Vector3(1)-oy#,Z Vector3(1)-oz#
      d2#=Length Vector3(1)
      id2#=d2#-d#
      Multiply Vector3 1,-(id2#/d2#)
      fpos(arry,0)=fpos(arry,0)+(ox#+X Vector3(1))*id2#
      fpos(arry,1)=fpos(arry,1)+(oy#+Y Vector3(1))*id2#
      fpos(arry,2)=fpos(arry,2)+(oz#+Z Vector3(1))*id2#
      n(arry)=n(arry)+id2#
   Endif
Next i
cFlag(arry)=cFlag(arry)+1
if cFlag(arry)>cycles
cFlag(arry)=0
Endif
fpos(arry,0)=fpos(arry,0)/n(arry)
fpos(arry,1)=fpos(arry,1)/n(arry)
fpos(arry,2)=fpos(arry,2)/n(arry)
Hit=(n(arry)>1)
EndFunction Hit

`Thanks to Dmitry K for this function!
Function LimbMatrix4(ResultMatrix, Object, Limb)
   AX#=Limb Direction X( Object, Limb ) : AY#=Limb Direction Y( Object, Limb ) : AZ#=Limb Direction Z( Object, Limb )
   CX#=Cos(AX#) : SX#=Sin(AX#) : CY#=Cos(AY#) : SY#=Sin(AY#) : CZ#=Cos(AZ#) : SZ#=Sin(AZ#)
   Set Vector3 EyeVector, Limb Position X( Object, Limb), Limb Position Y( Object, Limb), Limb Position Z( Object, Limb)
   Set Vector3 LookAtVector, -1.0*SZ#*(-1.0*SX#)+CZ#*SY#*CX#+Limb Position X(Object,Limb), CZ#*(-1.0*SX#)+SZ#*SY#*CX#+Limb Position Y(Object,Limb), CY#*CX#+Limb Position Z(Object,Limb)
   Set Vector3 LookUpVector, -SZ#*CX#+CZ#*SY#*SX#, CZ#*CX#+SZ#*SY#*SX#, CY#*SX#
   Build LookAt LHMatrix4 ResultMatrix, EyeVector, LookAtVector, LookUpVector
   r=Inverse Matrix4( ResultMatrix, ResultMatrix )
EndFunction

RoleOvers:
Data 25,2.4,35,34,2.4,34,43,2.4,33