Sorry your browser is not supported!

sync on: sync rate 0

if file exist("c:results.txt") then delete file "C:results.txt"
open to write 1, "c:results.txt"

MyTime = timer()
for n = 1 to 1000

    for m = 1 to 100
    
        get image 1,1,1,50,50,1
        for x = 1 to 20
            make object plain x,50,50
            texture object x, 1     
        next x
        sync
        for x = 1 to 20
            delete object x     
        next x
        delete image 1
        text 5,5, str$(n) + " / 100"
        
    next m
    write string 1, str$(timer() - MyTime)
    MyTime = timer()    

next n

end

sync on: sync rate 0

if file exist("c:results.txt") then delete file "C:results.txt"
open to write 1, "c:results.txt"

MyTime = timer()
for n = 1 to 1000

    for m = 1 to 100
    
        get image 1,1,1,50,50,1
        dim MyArray()
        for x = 1 to 20
            make object plain x,50,50
            texture object x, 1
            set object light x, 0
            lock object on x 
            set object transparency x,1
            disable object zwrite x
            set alpha mapping on x, 100
            scale object x,100,100,100
            rotate object x,0,0,0
            position object x,-250 + (x*50),0,500
            add to queue MyArray() : MyArray() = 999    
        next x
        sync
        for x = 20 to 1 step -1
            delete object x
            array delete element MyArray(), x - 1    
        next x
        delete image 1
        text 5,5, str$(n) + " / 100"
    
        
    next m
    write string 1, str$(timer() - MyTime)
    MyTime = timer()    

next n

end

arraysize=500
dim somearray(arraysize)
somearray(3)=5500
undim somearray(arraysize)
newarraysize=600
dim somearray(newarraysize)

`-------------------------------------------------------------------------------------------------
InitBullets:
`-------------------------------------------------------------------------------------------------

#CONSTANT cnMaxBullets=100

`#CONSTANT cnTankShellSpeedMult=4.2  `2.1


type rtBullet
  rC as rtXYZ
  rA as rtXYZ
  Damage# 
  Speed#
  MaxTravel#
  Travel#
  iShooterType ` Tank, Man, Heli, whatever
  iShooterObjectID
  iShooterIndex ` Of the tank, Heli whatever
  iManIndex ` In theory - Equipment is usually driven by "men" so this is redundant if the shooter is a man
            ` but makes sense to say which GUY (regardless of the offending or firing vehicle)
            ` Note - for certain AI situations, there may not be a man at all in a vehicle (literally speaking)
  objBullet
endtype
global dim garBullet() as rtBullet   

type rtBulletInfo
  iTimeLastUpdate
  iTimeDif
endtype
global grBulletInfo as rtBulletInfo
grBulletInfo.iTimeLastUpdate=TimeR()
grBulletInfo.iTimeDif=1
return
`-------------------------------------------------------------------------------------------------



`-------------------------------------------------------------------------------------------------
Function FireBullet(p_X#,p_Y#, p_Z#, p_XA#,p_YA#, p_ZA#,p_Damage#, p_Speed#, p_MaxTravel#, p_iShooterType, p_iObjectID,p_iIndex, p_iManIndex)
  Array INSERT AT BOTTOM garBullet()
  INDEX = Array Count(garBullet(0))

  garBullet(INDEX).Damage#=p_Damage# 
  garBullet(INDEX).Speed#=p_Speed#
  garBullet(INDEX).MaxTravel#=p_MaxTravel#
  garBullet(INDEX).Travel#=0
  garBullet(INDEX).iShooterType=p_iShooterType ` Tank, Man, Heli, whatever
  garBullet(INDEX).iShooterObjectID=p_iObjectID ` Prevent Shooting Self
  garBullet(INDEX).iShooterIndex=p_iIndex ` Of the tank, Heli whatever
  garBullet(INDEX).iManIndex=p_iManIndex ` In theory - Equipment is usually driven by "men" so this is redundant if the shooter is a man
            ` but makes sense to say which GUY (regardless of the offending or firing vehicle) 
  garBullet(INDEX).rC.X#=p_X#
  garBullet(INDEX).rC.Y#=p_Y#
  garBullet(INDEX).rC.Z#=p_Z#
  
  garBullet(INDEX).rA.X#=p_XA#
  garBullet(INDEX).rA.Y#=p_YA#
  garBullet(INDEX).rA.Z#=p_ZA#

  garBullet(INDEX).objBullet=pvtGetNewID(cnObject)
`  make object box garBullet(INDEX).objBullet,.5,.5,p_MaxTravel#
`  make object box garBullet(INDEX).objBullet,.1,.1,50
  make object box garBullet(INDEX).objBullet,.1,.1,5
  set object emissive garBullet(INDEX).objBullet, rgb(255,255,0)
  position object garBullet(INDEX).objBullet,p_X#, p_Y#, p_Z#
  rotate object garBullet(INDEX).objBullet,p_XA#, p_YA#, p_ZA#
`  move object garBullet(INDEX).objBullet,p_MaxTravel#/2 
endfunction
`-------------------------------------------------------------------------------------------------


`-------------------------------------------------------------------------------------------------
function UpdateBullets()
`-------------------------------------------------------------------------------------------------
  `repeat
  grBulletInfo.iTimeDif=(grClock.iTimer-grBulletInfo.iTimeLastUpdate)
  grBulletInfo.iTimeLastUpdate=grClock.iTimer
  `show object gc.objAngleFinder
  for i = 0 to Array Count(garBullet(0))
    bHitSomething=false
    Tenth#=(garBullet(i).Speed#* grBulletInfo.iTimeDif )/ 10
    position object gc.objAngleFinder, garBullet(i).rC.X#, garBullet(i).rC.Y#,garBullet(i).rC.Z#
    rotate object gc.objAngleFinder,garBullet(i).rA.X#, garBullet(i).rA.Y#,garBullet(i).rA.Z#
    for t =0 to Tenth#
      OldX#=object position x(gc.objAngleFinder)
      OldY#=object position y(gc.objAngleFinder)
      OldZ#=object position z(gc.objAngleFinder)
      move object gc.objAngleFinder,Tenth#
      inc garBullet(i).Travel#,Tenth#
      garBullet(i).rC.X#=object position x(gc.objAngleFinder)
      garBullet(i).rC.Y#=object position y(gc.objAngleFinder)
      garBullet(i).rC.Z#=object position z(gc.objAngleFinder)
      garBullet(i).rA.X#=object angle x(gc.objAngleFinder)
      garBullet(i).rA.Y#=object angle y(gc.objAngleFinder)
      garBullet(i).rA.Z#=object angle z(gc.objAngleFinder)
      position object garBullet(i).objBullet,garBullet(i).rC.X#, garBullet(i).rC.Y#, garBullet(i).rC.Z#


      objCollide = SC_rayCast ( 0, OldX#, OldY#, OldZ#, garBullet(i).rC.X#, garBullet(i).rC.y#, garBullet(i).rC.z#, garBullet(i).iShooterObjectID)
      if objCollide=0
        ` check for Ground Hit
        GY#=GroundHeight#(garBullet(i).rC.X#,garBullet(i).rC.z#)
        if garBullet(i).rC.Y#<=GY# 
          if garBullet(i).Damage#>10
            MakeExplosion(garBullet(i).rC.X#,GY#,garBullet(i).rC.Z#,  15, 15, 15) ` was scaled 17 when tank scale 100
          endif
          bHitSomething=true
          exit
        endif
      else
        garBullet(i).rC.X#=SC_getStaticCollisionX()   
        garBullet(i).rC.Y#=SC_getStaticCollisionY()   
        garBullet(i).rC.Z#=SC_getStaticCollisionZ()   
        `if garBullet(i).iShooterObjectID<>objCollide
          ` Check for Tank Hit
          `GY#=GroundHeight#(garBullet(i).rC.X#,garBullet(i).rC.z#)
          for w=0 to cnMaxTanks
            if (garTank(w).objHighPoly=objCollide)
              `if garBullet(i).Damage#>10
              `  MakeExplosion(garBullet(i).rC.X#,garBullet(i).rC.Y#,garBullet(i).rC.Z#,  15, 15, 15) ` was scaled 17 when tank scale 100
              `endif
              DamageTank(w,garBullet(i).Damage#)
              bHitSomething=true
              exit
            endif
          next w
          ` Check for Heli Hit
          for w=0 to cnMaxHelis
            if (garHeli(w).objHeli=objCollide)
              MakeExplosion(garBullet(i).rC.X#,garBullet(i).rC.Y#,garBullet(i).rC.Z#,  10, 10, 10) ` was scaled 17 when tank scale 100
              DamageHeli(w,garBullet(i).Damage#)
              `SC_SetObjectcollisionOff gaiTankShell(i)
              bHitSomething=true
              exit
            endif
          next w
          ` Check for Infantry Hit
          for w=0 to cnMaxMen
            if (garMan(w).objHighPolyIdle=objCollide)
              `MakeExplosion(garBullet(i).rC.X#,garBullet(i).rC.Y#,garBullet(i).rC.Z#,  15, 15, 15) ` was scaled 17 when tank scale 100
              DamageMan(w,garBullet(i).Damage#)
              bHitSomething=true
              exit
            endif
          next w
        `endif
      endif                

      if not bHitSomething 
        bHitSomething=((X#<0) or (X#>grTerrain.RealSize.X#) or (z#<0) or (z#>grTerrain.RealSize.Z#))
        ` But no explosion - just out of bounds
        exit  
      endif

      `If (grCamera.iPlayerView=cnPlayerCam_ChaseShell) and (grCamera.iMode=cnCameraMode_Tank)
      `  if sound playing(grSound.sndWind1)=0
      `    loop sound grSound.sndWind1
      `  endif
      `  Set camera to object orientation gc.objAngleFinder
      `  position camera X#,Y#,Z#
      `  position sound grSound.sndWind1,x#,y#,z#
      `  Move camera -10.5    
      `endif    

      if bHitSomething
        garBullet(i).Travel#=garBullet(i).MaxTravel#+1 ` Flags as "all Done"
        exit
      endif
    next t
    if bHitSomething
      garBullet(i).Travel#=garBullet(i).MaxTravel#+1 ` Flags as "all Done"
    endif
  next i
    
  if ARRAY COUNT (garBullet(0))>-1
    `cls 
    `Print "We Have a Bullet":sync:wait key
    i=0
    repeat
      `print "Begin Loop. Bullet Count:";ARRAY COUNT (garBullet(0))
      `set cursor 1,1
      `print "Our current Bullet:";i;" Traveled:";garBullet(i).Travel#;" MAx Travel:";garBullet(i).MaxTravel#
      `sync:wait key
      if garBullet(i).Travel#>=garBullet(i).MAxTravel#
        `print "We Deleting Bullet:";i
        `sync:wait key
        delete object garBullet(i).objBullet
        ARRAY DELETE ELEMENT garBullet(0), i
        `print "Deleted Bullet. Bullet Count:";ARRAY COUNT (garBullet(0)):sync:wait key
      else
        `print "We ARE NOT REMOVING Bullet:";i
        `sync:wait key
        inc i
      endif
    until ARRAY COUNT (garBullet(0))<i 
    `sync
  endif
  `until ARRAY COUNT (garBullet(0))=-1 
endfunction
`-------------------------------------------------------------------------------------------------


 

type Tile_t
   Head as integer
   ` Other tile information added as needed
endtype

type Unit_t
   PrevUnit as integer
   NextUnit as integer
   TileX    as integer
   TileY    as integer
   ` Other unit information added as needed
endtype

dim Tiles(4, 4) as Tile_t
dim FreeUnits() as integer
dim Units() as Unit_t

global FreeUnitCount as integer = -1

print "***Initialising***"
InitialiseTiles()
InitialiseUnits()

print ""
print "***Creating 4 units***"
UnitA = NewUnit()
UnitB = NewUnit()
UnitC = NewUnit()
UnitD = NewUnit()

print ""
print "***Adding all units to tile (0,0)***"
AddUnitToTile(UnitA, 0, 0)
AddUnitToTile(UnitB, 0, 0)
AddUnitToTile(UnitC, 0, 0)
AddUnitToTile(UnitD, 0, 0)

print ""
print "***Clearing all units from tile (0,0)"
ClearTileList(0, 0)

print ""
ShowTileList(0, 0)
print "The free list now contains "; FreeUnitCount+1; " items"

AddUnitToTile(UnitA, 0, 0)
AddUnitToTile(UnitB, 0, 0)
AddUnitToTile(UnitC, 0, 0)
AddUnitToTile(UnitD, 0, 0)
ShowTileList(0, 0)
FreeUnit(UnitC)
ShowTileList(0, 0)
wait key
end


function ShowTileList(TileX as integer, TileY as integer)
   local Unit as integer
   local TileCount as integer

   ` Get the pointer to the first in the list
   Unit = Tiles( TileX, TileY ).Head
   TileCount = 0

   print "Tile "; TileX; "/"; TileY; " contains ";

   ` Repeat while the unit number is a valid unit
   while Unit >= 0

      inc TileCount
      print Unit; " ";

      ` Get the next unit number
      Unit = Units( Unit ).NextUnit
   endwhile

   if TileCount = 0
      print "***nothing***"
   else
      print ""
   endif
endfunction

function ClearTileList(TileX as integer, TileY as integer)
   local Unit as integer

   Unit = Tiles( TileX, TileY ).Head
   while Unit >= 0
      FreeUnit( Unit )
      DeleteUnit( Unit )
      Unit = Tiles( TileX, TileY ).Head
   endwhile
endfunction

function AddUnitToTile(Unit as integer, TileX as integer, TileY as integer)
   local NextUnit as integer

   ` If this unit has a tile coord, it needs removing from that tile first
   if Units(Unit).TileX >= 0 then FreeUnit(Unit)

   print "Adding unit "; Unit; " to tile "; TileX; "/"; TileY

   ` Get the top of the current list
   NextUnit = Tiles( TileX, TileY ).Head

   ` Make this unit point to the old 'top' as the next, and none as the previous
   Units(Unit).NextUnit = NextUnit
   Units(Unit).PrevUnit = -1

   ` Make the old one point back to this one
   if NextUnit <> -1
      Units(NextUnit).PrevUnit = Unit
   endif

   ` Make the tile point to this unit
   Tiles(TileX, TileY).Head = Unit

   ` Store the tile coords
   Units(Unit).TileX = TileX
   Units(Unit).TileY = TileY
endfunction

function FreeUnit(Unit as integer)
   local PrevUnit as integer = -1
   local NextUnit as integer = -1

   if Units(Unit).TileX < 0 then exitfunction

   print "Removing unit "; Unit; " from tile "; Units(Unit).TileX; "/"; Units(Unit).TileY

   PrevUnit = Units(Unit).PrevUnit
   NextUnit = Units(Unit).NextUnit

   ` If not the end of the list, point the next unit back at the previous one
   if NextUnit >= 0
      Units(NextUnit).PrevUnit = PrevUnit
   endif

   ` If not at the top of the list, point the previous unit to the next one
   if PrevUnit >= 0
      Units(PrevUnit).NextUnit = NextUnit
   else
   ` If we are at the top of the list, make the tile point to the next unit
      Tiles( Units(Unit).TileX, Units(Unit).TileY ).Head = NextUnit
   endif

   Units(Unit).TileX = -1
   Units(Unit).TileY = -1
endfunction

function InitialiseTiles()
   local i as integer

   for i = 0 to array count( Tiles() )
      Tiles(i).Head = -1
   next i
endfunction

function InitialiseUnits()
   ` The units array is automatically has one item ... may change in future updates
`   DeleteUnit(0)
endfunction

function NewUnit()
   local NewItem as integer

   ` If the free list has something in, use the top one and decrease the counter
   if FreeUnitCount >= 0
      dec FreeUnitCount
      NewItem = FreeUnits( FreeUnitCount )
      print "Retrieved unit "; NewItem; " from the free list"
   else
   ` Otherwise, extend the units array and return that item
      array insert at bottom Units()
      NewItem = array count( Units() )
      print "Created a new unit "; NewItem
   endif

   ` Initialise the new unit
   Units(NewItem).PrevUnit = -1
   Units(NewItem).NextUnit = -1
   Units(NewItem).TileX    = -1
   Units(NewItem).TileY    = -1
endfunction NewItem

function DeleteUnit(Unit as integer)
   print "Adding unit "; Unit; " to the free list"
   ` Increase the free count
   inc FreeUnitCount

   ` If the list is too small, enlarge it
   if array count( FreeUnits() ) < FreeUnitCount then array insert at bottom FreeUnits()

   ` Store the unit in the free list at the top
   FreeUnits( FreeUnitCount ) = Unit
endfunction

type Image_t
   ImageGroup as integer   ` Key
   ImageId    as integer   ` Key
   Image      as integer   ` Value - the DBPro image number
endtype