Sorry your browser is not supported!

Rem *** Include File: Player_Text_Functions.dba ***
Rem Created: 5/18/2006 11:15:19 PM

`The purpose of these functions is to create a dynamic text buffer that can be
`used to send messages to the player at a reasonable pace and to help prevent
`accidental duplicate messages.



`======================================================
`=========================Demo=========================
`======================================================
`Rem the demo out before using.

Sync On:Sync Rate 60
Initialize_Player_Text()

Add_Player_Text("This demonstrates...")
Add_Player_Text("how the text buffer...")
Add_Player_Text("works. There should...")

`Notice this line is repeated? It will not be repeated on the output.
Add_Player_Text("how the text buffer...")
Add_Player_Text("how the text buffer...")
Add_Player_Text("how the text buffer...")

Add_Player_Text("be a slight pause...")
Add_Player_Text("between text printing.")
Add_Player_Text("======================")

Do
   m$=Pull_Next_Player_Message()
   if m$<>""
      Print m$
   Endif
   Manage_Player_Messages()
   `Attempt to add this message every loop. It does not get added for a short while.
   Add_Player_Text("Testing input delay")
   Sync
Loop


End
`======================================================
`=======================End Demo=======================
`======================================================



`======================================================
`=======================Functions======================
`======================================================

`Intiialize the Player_Text_Buffer
Function Initialize_Player_Text()
   Dim Text_Buffer(-1) as TextBuffer
Endfunction

Type TextBuffer
   Message as String
   Printed as Word
Endtype

`Usefull constants
   `Returns the Text_Buffer array size
#Constant Text_Buffer_Size Array Count(Text_Buffer())
   `The delay in cycles before the next message is printed.
#Constant Text_Delay 60
   `How many cycles to retain the last message.
#Constant Text_Retain 1000

`Use this function to add text to the buffer
Function Add_Player_Text(txt as string)
   if txt="" Then Exitfunction
   i=Find_Player_Text(txt)
   if i=>0 Then Exitfunction
   Array Insert At Bottom Text_Buffer()
   Text_Buffer(Array Count(Text_Buffer())).message=txt
Endfunction

`This function is used by the previous fucntion to determine if the text is already in the list.
`The information is then used to prevent duplicating a message to the buffer.
Function Find_Player_Text(txt as string)
   If Text_Buffer_Size <0 Then Exitfunction -1
   index=-1
   For i = 0 to Text_Buffer_Size
      If Text_Buffer(i).message=txt
         index=i
         Exit
      Endif
   Next i
Endfunction index

`This function is used to pull the next message from the buffer (first in first out).
`It also set the Printed decay counter to 1, starting the message decay.
`It will not print the message until the alloted amount of cycles has passed.
Function Pull_Next_Player_Message()
   If Text_Buffer_Size <0 Then Exitfunction ""
   If Get_Last_Decay()>0 and Get_Last_Decay()< Text_Delay Then Exitfunction ""
   index=-1
   For i =0 to Text_Buffer_Size
      If Text_Buffer(i).Printed=0
         index=i
         exit
      Endif
   Next i
   if index<0 then Exitfunction ""
   msg$=Text_Buffer(index).message
   Text_Buffer(index).printed=1
Endfunction msg$


`This function decays messages in the buffer. Once a message has decayed enough, it is removed from the buffer.
`Message decay is a safety catch to prevent duplicate messages from entering buffer too quickly after the intial message.
`Message decay is also used to determine the timing before the next message is printed.
Function Manage_Player_Messages()
   If Text_Buffer_Size <0 Then Exitfunction

   For i = 0 to Text_Buffer_Size
      If Text_Buffer(i).Printed>0
         Inc Text_Buffer(i).Printed
      Endif
      If Text_Buffer(i).Printed> Text_Retain
         Array Delete Element Text_Buffer(),i
      Endif
   Next i
Endfunction

`This function is used to determine the 'decay' since the last message.
Function Get_Last_Decay()
   If Text_Buffer_Size <0 Then Exitfunction 0
   max=1001
   For i = 0 to Text_Buffer_Size
      If Text_Buffer(i).Printed>0 and Text_Buffer(i).Printed<Max
         max=Text_Buffer(i).Printed
      Endif
   Next i
   Decay=max*(max<1001)
Endfunction Decay

Rem *** Include File: object_buttons.dba ***
Rem Created: 5/6/2006 11:47:24 PM

Rem *****************************************
Rem *******************DEMO******************
Rem *****************************************

Sync On:Sync Rate 60:Autocam Off

`Initialize the object_buttons (Step 1)
Initialize_Object_Buttons()

`Make the objects and assign them as object_buttons (Step 2)
For i = 1 to 20
   Make Object Cube i,5
   Position Object i,Rnd(100)-50,-2,Rnd(100)-25
   Make_Object_Button(i,Int(i/5)+1,50,"Box"+Str$(i))
Next i

Do

`These are all the controls that are really needed
   Control Camera Using Arrowkeys 0,.3,1
   `Call the Active_Object_Button() function (Step 3)
   Active=Active_Object_Button()

   If Active>-1
      If Active_Button(0).Click=1 Then Turn Object Right Active_Button(0).ObjectID,1
      If Active_Button(0).Click=2 Then Turn Object Left Active_Button(0).ObjectID,1
   Endif


`And this is extra, but not needed, to display information. You can rem this section out.
   Set Cursor 0,0
   if Active>-1
      Print "Active Button"
      Print "Return Value= ";Active_Button(0).Return_Value
      Print "Index =       ";Active_Button(0).Index
      Print "Object =      ";Active_Button(0).ObjectID
      Print "Object Range= ";Int(Active_Button(0).Range)
      Print "Object Name=  ";Active_Button(0).Name
      Print "Mouseclick=   ";Active_Button(0).Click
   Else
      Print "Last Active Button"
      Print "Return Value= ";Last_Active_Button(0).Return_Value
      Print "Index =       ";Last_Active_Button(0).Index
      Print "Object =      ";Last_Active_Button(0).ObjectID
      Print "Object Range= ";Int(Last_Active_Button(0).Range)
      Print "Object Name=  ";Last_Active_Button(0).Name
      Print "Mouseclick=   ";Last_Active_Button(0).Click
   Endif
   imax=Array Count(Object_Button())
   ink rgb(0,0,180),0
   for i = 0 to imax
      If Object In Screen(Object_Button(i).ObjectID)
         Center Text Object Screen X(Object_Button(i).ObjectID),Object Screen Y(Object_Button(i).ObjectID)-10,Get_Object_Button_Name(i)
      Endif
   Next i
   ink rgb(255,255,255),0

`Wrap up the loop.
   Sync
Loop


End

Rem *****************************************
Rem ***************END DEMO******************
Rem *****************************************












`Object buttons are used to turn objects into clickable buttons that return a value.
`This is very usefull for allowing the player to click on an object and have something happen.
`The value returned is determined at the time the object button is created.
`Also, the distance the object is from the camera can be specified in order for the object button to be "active"

`Note: Using Intialize_Object_Buttons clears out any previously defined Object Buttons. No objects are deleted or harmed.
Function Initialize_Object_Buttons()
   UnDim Object_Button()
   Dim Object_Button(-1) as Object_Buttons
   UnDim Object_Button_Name()
   Dim Object_Button_Name(-1) as Object_Button_Names
   Dim Active_Button(0) as ActiveButton
   Dim Last_Active_Button(0) as ActiveButton
   Null= Make Vector3(998)
EndFunction

Type Object_Buttons
   ObjectID as Word
   Return_Value as Integer
   Range as Float
   NameID as Word
EndType

Type Object_Button_Names
   Name as String
   ButtonID as Word
EndType

Type ActiveButton
   Index as Word
   ObjectID as Word
   Return_Value as Integer
   Range as Float
   Name as String
   Time as DWord
   Active as Boolean
   Click as Byte
Endtype


`Make_Object_Button assigns an object an Object_Button return value, a range, and a name
`If the ObjectID is not a valid existing Object Number, the function will fail and return a -1
`If the ObjectID is already assigned to an Object Button, the function will reassign that Object Button's values.
`Set the Range value to 0 or a negative value to allow for unlimited range.
`Setting the range can help speed up the code by reducing the number of object needed to be checked for.
`Naming objects is possible, but not always recommended as the text exchange may slow down the code considerably.
`However, the reference to the name (and vise-a-versa) use array index values to speed up the overall reference exchange.
`Use an empty string ("") to avoid assigning an Object Name.
`There is a limit of 1000 Object_Buttons available.

`The function returns the Object_Button_Index value, but it is not needed. However, using the index reference may increase
`the speed of the code since, without the index value, the index value needs to be looked up.

Function Make_Object_Button(ObjectID as Word,ReturnVal as Integer, Range as Float, Name as String)
   index as Integer
   index=-1

   If Object_Is_Valid(ObjectID)=0 Then ExitFunction index

   index = Array Count(Object_Button())+1
   if index>999
      index=-1
      Exitfunction index
   endif

   flag=0
   If index>0
      i=Get_Object_Button_Index(ObjectID)
      If i=-1
         flag=0
      Else
         index=i
      Endif
   Endif

   If Flag=0
      Array Insert At Bottom Object_Button()
   Endif
   Object_Button(index).ObjectID=ObjectID
   Object_Button(index).Return_Value=ReturnVal
   Object_Button(index).Range=Range
   If Len(name)>0
      Array Insert At Bottom Object_Button_Name()
      NameIndex=Array Count(Object_Button_Name())
      Object_Button_Name(NameIndex).Name=Name
      Object_Button_Name(NameIndex).ButtonID=index
      Object_Button(index).NameID=NameIndex
   Else
      Object_Button(index).NameID=-1
   Endif
Endfunction index


`Returns the Index of the Object, or -1 if the object is not an Object_Button
Function Get_Object_Button_Index(ObjectID as Word)
   index as Integer
   index=Array Count(Object_Button())
   if index<0 then Exitfunction -1
   flag=0
   For i = 0 to index
      if Object_Button(i).ObjectID=ObjectID
         flag=1
         index=i
         exit
      endif
   Next i
   if flag=0 then index=-1
Endfunction index

`Returns the Index of the first button assigned the name provided.
`This could be very slow if there are a lot of named Object Buttons.
Function Get_Object_Button_Index_By_Name(name as String)
   index as Integer
   index=Array Count(Object_Button_Name())
   if index<0 then Exitfunction index
   flag=0
   For i = 0 to index
      if Object_Button_Name(i).Name=Name
         flag=1
         index=i
         exit
      endif
   Next i
   if flag=0
      index=-1
      Exitfunction index
   Endif
   index=Object_Button_Name(i).ButtonID
Endfunction index

`This function returns the Name of the object by providing the Index
Function Get_Object_Button_Name(Index as integer)
   If Button_Index_Valid(Index)=0 then Exitfunction ""
   NameID=Object_Button(index).NameID
   Button_Name$=""
   If NameID>-1
      Button_Name$=Object_Button_Name(NameID).Name
   Endif
Endfunction Button_Name$

`This function returns the Name of the object by providing the ObjectID
Function Get_Object_Button_Name_By_Object(ObjectID as word)
   index=Get_Object_Button_Index(ObjectID)
   If Button_Index_Valid(Index)=0 then Exitfunction ""
   NameID=Object_Button(index).NameID
   Button_Name$=""
   If NameID>-1
      Button_Name$=Object_Button_Name(NameID).Name
   Endif
Endfunction Button_Name$

`This function safely returns the Object of the Object Button by providing the Index
Function Get_Object_Object_Button(Index as Integer)
   If Button_Index_Valid(Index)=0 then Exitfunction 0
   ObjectID = Object_Button(Index).ObjectID
Endfunction ObjectID

`This function returns the Object of the Object Button by providing the Name.
`Caution: this could be slow if there are a lot of assigned Object Button names.
Function Get_Object_Object_Button_By_Name(Name as String)
   Index=Get_Object_Button_Index_By_Name(Name)
   If Button_Index_Valid(Index)=0 then Exitfunction 0
   ObjectID = Object_Button(Index).ObjectID
Endfunction ObjectID

`Returns a 1 if the index is valid, otherwise a 0 is returned.
Function Button_Index_Valid(Index as Integer)
   flag=(index=>0 and index<=Array Count(Object_Button()))
Endfunction flag

`Safely checks if an integer is a valid object number and that object exists. 1=Valid Object, 0=Not Valid.
Function Object_Is_Valid(ObjectID as Integer)
   If ObjectID<1 Then Exitfunction 0
   If Object Exist(ObjectID)=0 Then Exitfunction 0
Endfunction 1

`Returns the range of the object_button from the camera using the index.
Function Get_Button_Range(index)
   Obj=Object_Button(index).ObjectID
   r#=-1
   If Obj=0 Then Exitfunction r#
   If Object_Is_Valid(Obj)=0 Then Exitfunction r#
   Set Vector3 998,Camera Position X()-Object Position X(Obj),Camera Position Y()-Object Position Y(Obj),Camera Position Z()-Object Position Z(Obj)
   r#=Length Vector3(998)
Endfunction r#

`Returns the index of the closest Object Button in range currently under the mouse. Returns a -1 if no button is under the mouse.
`Also completes the array Active_Button(0) with the active button values. The Active_Button(0).Time is the timer value when
`the array is last set. This way you can determine how long ago the button was last active. Active_Button(0).Active is a flag that
`is set if the object_button stored in the array is currently active, otherwise it is set to 0.
Function Active_Object_Button()
   imax=Array Count(Object_Button())
   if imax<0 then Exitfunction -1
   flag=-1
   d#=99999
   for i=0 to imax
      If Object_Is_Valid(Object_Button(i).ObjectID)
         If Object In Screen(Object_Button(i).ObjectID)
            r#=Get_Button_Range(i)
            if Object_Button(i).Range<=0 or Object_Button(i).Range>=r#
               f=Pick Object(MouseX(),MouseY(),Object_Button(i).ObjectID,Object_Button(i).ObjectID)
               If f>0 and r#<d#
                  flag=i
                  d#=r#
               Endif
            Endif
         Endif
      Endif
      Print
   Next i
   If Flag=-1
      `Store last button results
      If Active_Button(0).Active=1
         Last_Active_Button(0).Index=Active_Button(0).Index
         Last_Active_Button(0).ObjectID=Active_Button(0).ObjectID
         Last_Active_Button(0).Return_Value=Active_Button(0).Return_Value
         Last_Active_Button(0).Range=Active_Button(0).Range
         Last_Active_Button(0).Name=Active_Button(0).Name
         Last_Active_Button(0).Time=Active_Button(0).Time
         Last_Active_Button(0).Click=Active_Button(0).Click
      Endif

      Active_Button(0).Active=0
   Else
      `Store the Active Button Index
      Active_Button(0).Index=Flag
      `Store the active button Object Number
      Active_Button(0).ObjectID=Object_Button(Flag).ObjectID
      `Store the Active Object's Return Value
      Active_Button(0).Return_Value=Object_Button(Flag).Return_Value
      `Store the Active Object's Range
      Active_Button(0).Range=d#
      `Store the Active Object's Name
      Active_Button(0).Name=Get_Object_Button_Name(Flag)

      `These next values are useful for delayed reactions or storing data.

      `Store the Active Object's most recent activation timestamp
      Active_Button(0).Time=Timer()
      `Set the Active flag to indicate the Object_Button stored in this array is currently active or not.
      Active_Button(0).Active=1
      `Store mouse button state when the button was active
      Active_Button(0).Click=MouseClick()
   Endif
Endfunction Flag

Rem *** Include File: Targeting_Functions.dba ***
Rem Created: 5/14/2006 8:49:28 AM

`***DEMO***

`Remstart
Initiate_Targeting()

Add_To_Combat_List(1,3)
Add_To_Combat_List(5,3)

Print "Source 1's Target: ";Get_Combat_Target(1)
Print "Source 5's Target: ";Get_Combat_Target(5)
Print "Target 3's Source: ";Get_Combat_Source(3)
Print "The source is the first value added, not the lowest."
Wait Key
Delete_Source_From_Combat_List(1)
Print "<Deleted Source 1 from the combat list>"
Print "Target 3's Source: ";Get_Combat_Source(3)
Print "Notice that 3 changed it's source."
Wait Key
Print

Print "Object 5 --> Object 3: Add 7 Aggro"
Add_To_Aggression_List(5,3,7)
Print "Object 5 --> Object 4: Add 2 Aggro"
Add_To_Aggression_List(5,4,2)

Print
Print "Object 5's aggro target is..."
Print Get_Aggression_Target(5)
Wait Key
Print "Object 5 --> Object 4: Add 6 Aggro"
Add_Aggression(5,4,6)
Print
Print "Now Object 5's aggro target is..."
Print Get_Aggression_Target(5)
Wait Key
End

`Remend

`==============================================================================
`===============================Combat Functions===============================
`==============================================================================
Remstart
   These functions are used to track combatants and aggressions
   combat_list: Tracks each single Source to a single Target (can only attack one object at a time).
   Aggression_list: Tracks all Targets from a single Source that the Source is "mad" at.
                   The Aggression_list is used to sort and determine which object to attack next when multiple combatants are involved.

   Notes: These functions do not manipulate objects, they only manage combat and Aggression lists.
          No objects are validated using these functions.
Remend

`==============================================================================
`============================Intialization Function============================
`==============================================================================

Function Initiate_Targeting()
   Dim Combat_List(-1) as Targeting
   Dim Aggression_List(-1) as Targeting
   Dim Target_List(-1) as Targeting
Endfunction

Type Targeting
   SourceObj as Word
   TargetObj as Word
   Level as Integer
EndType


`==============================================================================
`============================Combat_List Functions=============================
`==============================================================================

`Returns the first Source Object targeting the Target Object (ObjectID) for combat.
Function Get_Combat_Source(ObjectID)
   If Array Count(Combat_List())<0 Then Exitfunction 0
   flag=0
   For i = 0 to Array Count(Combat_List())
      if Combat_List(i).TargetObj=ObjectID
         Flag=Combat_List(i).SourceObj
         Exit
      Endif
   Next i
Endfunction Flag

`Returns a Source Object's (ObjectID) combat target.
Function Get_Combat_Target(ObjectID)
   If Array Count(Combat_List())<0 Then Exitfunction 0
   flag=0
   For i = 0 to Array Count(Combat_List())
      if Combat_List(i).SourceObj=ObjectID
         Flag=Combat_List(i).TargetObj
         Exit
      Endif
   Next i
Endfunction Flag

`Add Source & Target Objects to the combat list. If the source object is already on the list, it will be replaced.
Function Add_To_Combat_List(SourceID,TargetID)
   Delete_Source_From_Combat_List(SourceID)
   Array Insert At Bottom Combat_List()
   i=Array Count(Combat_List())
   Combat_List(i).SourceObj=SourceID
   Combat_List(i).TargetObj=TargetID
Endfunction


`This function is to be used when the Source Object dies, or is no longer interested in the Target Object.
`This function will delete the ALL the instances from the combat list, though there should only be one at any given time.
Function Delete_Source_From_Combat_List(ObjectID)
   If Array Count(Combat_List())<0 Then Exitfunction
   flag=1
   While flag=1
      flag=0
      For i = 0 to Array Count(Combat_List())
         If Combat_List(i).SourceObj=ObjectID
            Array Delete Element Combat_List(),i
            flag=1
            Exit
         Endif
      Next i
   EndWhile
Endfunction

`Returns a 1 if the Object is the source or the target of combat
Function Check_For_Combat(ObjectID)
   If Array Count(Combat_List())<0 Then Exitfunction 0
   flag=0
   For i = 0 to Array Count(Combat_List())
      if Combat_List(i).SourceObj=ObjectID or Combat_List(i).TargetObj=ObjectID
         Flag=1
         Exit
      Endif
   Next i
Endfunction Flag


`This function should only be used when the Target Object 'dies' or is completely removed from combat.
`This function will delete the target from ALL combat sources.
Function Delete_Target_From_Combat_List(ObjectID)
   If Array Count(Combat_List())<0 Then Exitfunction
   flag=1
   While flag=1
      flag=0
      For i = 0 to Array Count(Combat_List())
         If Combat_List(i).TargetObj=ObjectID
            Array Delete Element Combat_List(),i
            flag=1
            Exit
         Endif
      Next i
   EndWhile
Endfunction


`This function will delete the specified source & target
Function Remove_From_Combat_List(Source,Target)
   If Array Count(Combat_List())<0 Then Exitfunction
   flag=1
   While flag=1
      flag=0
      For i = 0 to Array Count(Combat_List())
         If Combat_List(i).SourceObj=Source and Combat_List(i).TargetObj=Target
            Array Delete Element Combat_List(),i
            flag=1
            Exit
         Endif
      Next i
   EndWhile
Endfunction

`This function stores damage from the source for the target to be retrieved later.
Function Apply_Damage(Source,Damage)
   If Array Count(Combat_List())<0 Then Exitfunction
   flag=0
   For i = 0 to Array Count(Combat_List())
      if Combat_List(i).SourceObj=Source
         Flag=i
         Exit
      Endif
   Next i
   if flag>0
      Combat_List(flag).Level=Combat_List(flag).Level+Damage
   Endif
Endfunction

`This function retrieves the total damage for the target (and clears it out).
Function Retrieve_Damage(Target)
   If Array Count(Combat_List())<0 Then Exitfunction 0
   total=0
   For i = 0 to Array Count(Combat_List())
      if Combat_List(i).TargetObj=Target
         total=total+Combat_List(i).Level
         Combat_List(i).Level=0
      Endif
   Next i
Endfunction total


`==============================================================================
`===========================Aggression List Functions==========================
`==============================================================================

`Add a new Source & Target to the Aggression list. Level is the intial Aggression level.
Function Add_To_Aggression_List(SourceID,TargetID,Level)
   Array Insert At Bottom Aggression_List()
   i=Array Count(Aggression_List())
   Aggression_List(i).SourceObj=SourceID
   Aggression_List(i).TargetObj=TargetID
   Aggression_List(i).Level = Level
Endfunction

`Deletes all occurrences of the source from the Aggression_list. Should be used when the source dies, flees, or is removed from combat.
Function Delete_Source_From_Aggression_List(ObjectID)
   If Array Count(Aggression_List())<0 Then Exitfunction
   flag=1
   While flag=1
      flag=0
      For i = 0 to Array Count(Aggression_List())
         If Aggression_List(i).SourceObj=ObjectID
            Array Delete Element Aggression_List(),i
            flag=1
            Exit
         Endif
      Next i
   EndWhile
Endfunction

`Deletes all occurrences of the target from the Aggression_list. Should only be used when target dies or is removed from combat.
Function Delete_Target_From_Aggression_List(ObjectID)
   If Array Count(Aggression_List())<0 Then Exitfunction
   flag=1
   While flag=1
      flag=0
      For i = 0 to Array Count(Aggression_List())
         If Aggression_List(i).TargetObj=ObjectID
            Array Delete Element Aggression_List(),i
            flag=1
            Exit
         Endif
      Next i
   EndWhile
Endfunction

`Deletes all occurrences of the source-to-target from the Aggression_list. Should only be used when target dies or is removed from combat.
Function Remove_From_Aggression_List(Source,Target)
   If Array Count(Aggression_List())<0 Then Exitfunction
   flag=1
   While flag=1
      flag=0
      For i = 0 to Array Count(Aggression_List())
         If Aggression_List(i).TargetObj=Target and Aggression_List(i).SourceObj=Source
            Array Delete Element Aggression_List(),i
            flag=1
            Exit
         Endif
      Next i
   EndWhile
Endfunction

`Returns the highest Aggression level target of the specified source object.
Function Get_Aggression_Target(SourceID)
   If Array Count(Aggression_List())<0 Then Exitfunction 0
   hiObj=0
   hiAgr=-9999
   For i = 0 to Array Count(Aggression_List())
      If Aggression_List(i).SourceObj=SourceID
         if Aggression_List(i).Level>hiAgr
            hiAgr=Aggression_List(i).Level
            hiObj=Aggression_List(i).TargetObj
         Endif
      Endif
   Next i
Endfunction hiObj

`Returns the Aggression Level for the specifies Source and Target. If the Source & Target combination does not exist, a 0 will be returned.
Function Get_Aggression_Level(SourceID,TargetID)
   If Array Count(Aggression_List())<0 Then Exitfunction 0
   For i = 0 to Array Count(Aggression_List())
      If Aggression_List(i).SourceObj=SourceID and Aggression_List(i).TargetObj=TargetID
         Amount=Aggression_List(i).Level
      Endif
   Next i
Endfunction Amount

`Adds the Amount (which may be a negative value) to the Aggression().Level for the matching Source and Target
Function Add_Aggression(SourceID,TargetID,Amount)
   If Array Count(Aggression_List())<0 Then Exitfunction
   For i = 0 to Array Count(Aggression_List())
      If Aggression_List(i).SourceObj=SourceID and Aggression_List(i).TargetObj=TargetID
         Aggression_List(i).Level=Aggression_List(i).Level+Amount
      Else
         Add_To_Aggression_List(SourceID,TargetID,Amount)
      Endif
   Next i
Endfunction

`Adds the Amount (which may be a negative value) to the Aggression().Level for all the matching Targets.
Function Adjust_Aggression_For_Target(TargetID,Amount)
   If Array Count(Aggression_List())<0 Then Exitfunction
   For i = 0 to Array Count(Aggression_List())
      If Aggression_List(i).TargetObj=TargetID
         Aggression_List(i).Level=Aggression_List(i).Level+Amount
      Endif
   Next i
Endfunction



`==============================================================================
`============================Target_List Functions=============================
`==============================================================================

`Returns the first Source Object targeting the Target Object (ObjectID).
Function Get_Open_Target_Source(ObjectID)
   If Array Count(Target_List())<0 Then Exitfunction 0
   flag=0
   For i = 0 to Array Count(Target_List())
      if Target_List(i).TargetObj=ObjectID and Target_List(i).Level=0
         Flag=Target_List(i).SourceObj
         Exit
      Endif
   Next i
Endfunction Flag

Function Get_Locked_Target_Source(ObjectID)
   If Array Count(Target_List())<0 Then Exitfunction 0
   flag=0
   For i = 0 to Array Count(Target_List())
      if Target_List(i).TargetObj=ObjectID and Target_List(i).Level<>0
         Flag=Target_List(i).SourceObj
         Exit
      Endif
   Next i
Endfunction Flag

`Returns a Source Object's (ObjectID) non-locked Target.
Function Get_Open_Target(ObjectID)
   If Array Count(Target_List())<0 Then Exitfunction 0
   flag=0
   For i = 0 to Array Count(Target_List())
      if Target_List(i).SourceObj=ObjectID and Target_List(i).Level=0
         Flag=Target_List(i).TargetObj
         Exit
      Endif
   Next i
Endfunction Flag

`Returns a Source Object's (ObjectID) locked Target.
Function Get_Locked_Target(ObjectID)
   If Array Count(Target_List())<0 Then Exitfunction 0
   flag=0
   For i = 0 to Array Count(Target_List())
      if Target_List(i).SourceObj=ObjectID and Target_List(i).Level<>0
         Flag=Target_List(i).TargetObj
         Exit
      Endif
   Next i
Endfunction Flag

`Add Source & Target Objects to the Target list. If the source object is already on the list, it will be replaced.
`  The Locked_Flag is set to zero for unlocked targets, or one for locked targets.
Function Add_To_Target_List(SourceID,TargetID,Locked_Flag)
   Delete_Source_From_Target_List(SourceID)
   Array Insert At Bottom Target_List()
   i=Array Count(Target_List())
   Target_List(i).SourceObj=SourceID
   Target_List(i).TargetObj=TargetID
   Target_List(i).TargetObj=Locked_Flag
Endfunction

`Locks the specified Source's Target.
Function Target_List_Lock(SourceID)
   t=Get_Open_Target(SourceID)
   if t>0
      Add_To_Target_List(SourceID,t,1)
   Endif
Endfunction

`Unlocks the specified Source's Target.
Function Target_List_UnLock(SourceID)
   t=Get_Locked_Target(SourceID)
   if t>0
      Add_To_Target_List(SourceID,t,0)
   Endif
Endfunction

`This function is to be used when the Source Object dies, or is no longer interested in the Target Object(s).
`This function will delete the ALL the instances from the Target list.
Function Delete_Source_From_Target_List(ObjectID)
   If Array Count(Target_List())<0 Then Exitfunction
   flag=1
   While flag=1
      flag=0
      For i = 0 to Array Count(Target_List())
         If Target_List(i).SourceObj=ObjectID
            Array Delete Element Target_List(),i
            flag=1
            Exit
         Endif
      Next i
   EndWhile
Endfunction

`This function should only be used when the Target Object 'dies' or is completely removed from Target.
`This function will delete the target from ALL Target sources.
Function Delete_Target_From_Target_List(ObjectID)
   If Array Count(Target_List())<0 Then Exitfunction
   flag=1
   While flag=1
      flag=0
      For i = 0 to Array Count(Target_List())
         If Target_List(i).TargetObj=ObjectID
            Array Delete Element Target_List(),i
            flag=1
            Exit
         Endif
      Next i
   EndWhile
Endfunction


`This function will delete the specified source & target with the specified LockFlag
Function Remove_From_Target_List(Source,Target,LockFlag)
   If Array Count(Target_List())<0 Then Exitfunction
   flag=1
   While flag=1
      flag=0
      For i = 0 to Array Count(Target_List())
         If Target_List(i).SourceObj=Source and Target_List(i).TargetObj=Target and Target_List(i).Level=LockFlag
            Array Delete Element Target_List(),i
            flag=1
            Exit
         Endif
      Next i
   EndWhile
Endfunction

Rem *** Include File: Player_Text_Functions.dba ***
Rem Created: 5/18/2006 11:15:19 PM

`The purpose of these functions is to create a dynamic text buffer that can be
`used to send messages to the player at a reasonable pace and to help prevent
`accidental duplicate messages.



`======================================================
`=========================Demo=========================
`======================================================
`Rem the demo out before using.

Sync On:Sync Rate 60
Initialize_Player_Text()
Update_TimeFactor()

Add_Player_Text("This demonstrates...",1)
Add_Player_Text("how the text buffer...",2)
Add_Player_Text("works. There should...",1)
Add_Player_Text("be a slight pause...",2)
Add_Player_Text("between text printing...",1)
Add_Player_Text("but no pause between...",2)
Add_Player_Text("different players.",1)
Add_Player_Text("======================",2)

Do
   Update_TimeFactor()
   for p = 1 to 2
      m$=Pull_Next_Player_Message(p)
      if m$<>""
         Print "Player ";p;": ";m$
      Endif
   Next p
   Manage_Player_Messages()
   `Attempt to add this message every loop. It does not get added for a short while.
   Add_Player_Text("Testing input delay",1)
   Sync
Loop


End
`======================================================
`=======================End Demo=======================
`======================================================



`======================================================
`=======================Functions======================
`======================================================

`Intiialize the Player_Text_Buffer
Function Initialize_Player_Text()
   Dim Text_Buffer(-1) as TextBuffer
Endfunction

Type TextBuffer
   Message as String
   Printed as Float
   Player as Integer
Endtype

`Usefull constants
   `Returns the Text_Buffer array size
#Constant Text_Buffer_Size Array Count(Text_Buffer())
   `The delay in cycles before the next message is printed.
#Constant Text_Delay 60
   `How many cycles to retain the last message.
#Constant Text_Retain 1000

`Use this function to add text to the buffer
Function Add_Player_Text(txt as string, player)
   if txt="" Then Exitfunction
   i=Find_Player_Text(txt,player)
   if i=>0 Then Exitfunction
   Array Insert At Bottom Text_Buffer()
   Text_Buffer(Array Count(Text_Buffer())).message=txt
   Text_Buffer(Array Count(Text_Buffer())).Player=Player
Endfunction

`This function is used by the previous function to determine if the text is already in the list.
`The information is then used to prevent duplicating a message to the buffer.
Function Find_Player_Text(txt as string,player)
   If Text_Buffer_Size <0 Then Exitfunction -1
   index=-1
   For i = 0 to Text_Buffer_Size
      If Text_Buffer(i).message=txt and Text_Buffer(i).player=player
         index=i
         Exit
      Endif
   Next i
Endfunction index

`This function is used to pull the next message from the buffer (first in first out).
`It also sets the Printed decay counter to 1, starting the message decay.
`It will not print the message until the alloted amount of cycles has passed.
Function Pull_Next_Player_Message(player)
   If Text_Buffer_Size <0 Then Exitfunction ""

   LD=Get_Last_Decay(player)
   If LD>0 and LD< Text_Delay Then Exitfunction ""
   index=-1
   For i =0 to Text_Buffer_Size
      If Text_Buffer(i).Player=player
         If Text_Buffer(i).Printed=0
            index=i
            exit
         Endif
      Endif
   Next i
   if index<0 then Exitfunction ""
   msg$=Text_Buffer(index).message
   Text_Buffer(index).printed=1

Endfunction msg$


`This function decays messages in the buffer. Once a message has decayed enough, it is removed from the buffer.
`Message decay is a safety catch to prevent duplicate messages from entering buffer too quickly after the intial message.
`Message decay is also used to determine the timing before the next message is printed.
Function Manage_Player_Messages()
   If Text_Buffer_Size <0 Then Exitfunction

   For i = 0 to Text_Buffer_Size
      If Text_Buffer(i).Printed>0
         Text_Buffer(i).Printed = Text_Buffer(i).Printed + TimeFactor
      Endif
      If Text_Buffer(i).Printed> Text_Retain
         Array Delete Element Text_Buffer(),i
      Endif
   Next i
Endfunction

`This function is used to determine the 'decay' since the last message.
Function Get_Last_Decay(player)
   If Text_Buffer_Size <0 Then Exitfunction 0
   max= Text_Retain + 1
   For i = 0 to Text_Buffer_Size
      If Text_Buffer(i).player=player
         If Text_Buffer(i).Printed>0 and Text_Buffer(i).Printed<Max
            max=Text_Buffer(i).Printed
         Endif
      Endif
   Next i
   Decay=max*(max<= Text_Retain )
Endfunction Decay


`This function creates a player list of players in the buffer.
Function Create_Buffer_Player_List()
   UnDim BufferPlayerList()
   Dim BufferPlayerList(-1)
   If Array Count(Text_Buffer())<0 Then Exitfunction
   For i = 0 To Array Count(Text_Buffer())
      player=Text_Buffer(i).player
      if Player_In_PlayerList(player)=0
         Array Insert At Bottom BufferPlayerList()
         index=Array Count(BufferPlayerList())
         BufferPlayerList(index)=player
      Endif
   Next i
Endfunction

`This function returns a 1 if the player ID is already in the BufferPlayerList. Otherwise a 0 is returned.
Function Player_In_PlayerList(player)
   If Array Count(BufferPlayerList())<0 Then Exitfunction 0
   flag=0
   For i = 0 To Array Count(BufferPlayerList())
      If BufferPlayerList(i) = player
         flag=1
         exit
      Endif
   Next i
Endfunction flag












`======================================================
`From our Generic Functions.

#Constant Update_TimeFactor Update_TimeFactor()
#Constant TimeFactor TimeFactor(0)
Function Update_TimeFactor()
   Dim TimeStamp(0) as integer
   Dim TimeFactor(0) as float
   If TimeStamp(0)=0 Then TimeStamp(0)=Timer()-16
   t#=Timer()-TimeStamp(0)
   Timestamp(0)=Timer()
   `Shooting for 60 FPS, or 16 milliseconds each update.
   `If t#=16, then Timefactor = 1, or normal speed.
   `If t#=32 (approx 30 FPS), then the Timefactor = 2, or twice normal speed (because there are half as many updates)
   TimeFactor(0)=t#/16.0
Endfunction

`=====DEMO=====
Sync On: Sync Rate 60
t=5000

Do
   cls
   Set Cursor 0,0
   Print t
   `If only one of the next two calls works, then t will either = 5000 or t will continue to be reduced by
   `1000 every click. But if they both work, t will always equal 5000-1000, or 4000 (which will start at 3999).
   if Single_MouseClick(1)=1
      t=5000
   Endif
   if Single_MouseClick(2)=1
      t=t-1000
   Endif
   `This function call will set t to 10000 if the right mouse button is pressed.
   if Single_MouseClick(3)=2
      t=10000
   Endif
   dec t
   Sync
Loop
`===END DEMO===

`K is a unique key identifier for use by different function calls. This way, the results stored by
`one function call are not used in the next function call. All funcion calls receive their own unique results.
Function Single_MouseClick(K)
   s=Array Count(Mouse())-1
   Dim Mouse( s ) as MouseClicks

   flag= 0
   For index = 0 to s
      if Mouse(index).Key=k
         flag=1
         Exit
      Endif
   Next index

   if flag=0
      Array Insert At Bottom Mouse()
      Mouse(index).Key=k
   Endif

   If Mouse(index).Click=MouseClick()
      rv=0
   Else
      rv=MouseClick()
      Mouse(index).Click=rv
   Endif
Endfunction rv


Type MouseClicks
   Key
   Click
EndType

`Call Egg_Timer() with a unique identifier integer value (ID) and how many milliseconds to set the EggTimer to.
`Example Usage:
`Remstart
Sync On:Sync Rate 0
Do
  If Egg_Timer(17,2000) :`Print approximately every 2 seconds in white
     Print Get Time$()
  Endif

  If Egg_Timer(23,3000) :`Print approximately every 3 seconds in red.
    Ink Rgb(255,0,0),0
    Print Get Time$()
    Ink Rgb(255,255,255),0
  Endif

  If Egg_Timer(5,4000) :`Print approximately every 4 seconds in blue.
    Ink Rgb(0,0,255),0
    Print Get Time$()
    Ink Rgb(255,255,255),0
  Endif

  Sync
Loop
`Remend

Function Egg_Timer(ID,Setting)
   `Initialize Arrays
   Dim EggTimer(Array Count(EggTimer())-1) as EggTimers
   Dim LastEggTime(0) as Dword
   `Initialize our LastEggTime(). Also check if the Timer() has cycled back to 0.
   If LastEggTime(0)<1 or LastEggTime(0)>Timer()
      LastEggTime(0)=Timer()
   Endif
   Flag1=0:`Timer at 0 flag. 0=Not yet. 1=Done ("Ding!")
   Flag2=0:`Matching ID found flag. 0=Not Found. 1=Found
   Tick=Timer()-LastEggTime(0):`Tick is how much to reduce each EggTimer by. (Think "tick...tick...tick..." on an Egg Timer)
   `Cycle through and decrement all the EggTimers
   `PRint Array Count(EggTimer())
   For i = 0 to Array Count(EggTimer())
      `Reduce our EggTimer() as long as the value is greater than 0. Otherwise, set it to 0.
      EggTimer(i).EggTime=(EggTimer(i).EggTime-Tick)*(EggTimer(i).EggTime>0)
      `Check to see if this EggTimer is the one being called by the function.
      If EggTimer(i).ID=ID
         Flag2=1:`There is a matching ID.
         `Is the EggTime at 0 yet?
         If EggTimer(i).EggTime=0
            Flag1=1
            `Reset the EggTimer
            EggTimer(i).EggTime=Setting
         Endif
      Endif
   Next i

   `The EggTimer ID provided was not found: Create a new EggTimer.
   If Flag2=0
      Array Insert At Top EggTimer()
      EggTimer(0).ID=ID
      EggTimer(0).EggTime=Setting
   Endif
   LastEggTime(0)=Timer()
Endfunction Flag1

Type EggTimers
   ID
   EggTime
Endtype

backspace scan code=(go find it in the DBP section, scraggle post a scancode map there in one of the threads)
string$="bla bla bla test"

if scancode()=backspace scan code
  string$=backspace(string$,2)
endif
 
function backspace(str as string,backnum as integer)
  stringlen=len(str)
  tmpstring$=left$(str,stringlen-backnum)
  result$=tmpstring$
endfunction result$

if returnkey()=1 then set cursor (the line after the current where u want it..)