PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Swarmbots

https://www.purebasic.fr/english/viewtopic.php?t=33306

Page 1 of 1

Swarmbots

Posted: Fri Jul 18, 2008 9:39 pm
by ProphetOfDoom
You need to compile this with Threadsafe enabled. It won't compile on Linux. Admittedly it's not really AI. They're a bit stoopid. They just float around and munch the green stuff. Oh well.

Code: Select all



EnableExplicit

; Element type

Structure LLElement
	*Next.LLElement
	*Previous.LLElement
	*List.LLElementList
EndStructure


Structure LLElementList
	*First.LLElement
	*Last.LLElement
	Size.l
EndStructure

Structure Entity Extends LLElement
  Type.l
  x.f
  y.f
EndStructure

Structure Creature Extends Entity
  xv.f
  yv.f
EndStructure


Structure Swarmbot Extends Creature
  xd.f ; x destination
  yd.f ; y destination
  State.l
  Energy.f
  ID.l ; ID number
EndStructure

Structure Food Extends Entity
  Amount.f
EndStructure

Structure Sector
  *Occupants.LLElementList
EndStructure

Structure Timer
  Freq.l
  Ticks.l
EndStructure




; PureBasic Visual Designer v3.95 build 1485 (PB4Code)


;- Window Constants
;
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #Text_0
  #Text_1
  #Text_2
  #Text_3
  #CheckBox_0
  #CheckBox_1
  #CheckBox_2
  #Spin_0
  #Spin_1
  #Spin_2
  #Spin_3
EndEnumeration



Procedure Open_Window_0()
  If OpenWindow(#Window_0, 412, 122, 320, 380, "Swarmbots AI Demo",  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar )
    If CreateGadgetList(WindowID(#Window_0))
      TextGadget(#Text_0, 160, 10, 160, 30, "Visual Range (Sectors): 0-32")
      TextGadget(#Text_1, 160, 60, 160, 30, "Max Speed (Pixels/10/Frame): 0-127")
      TextGadget(#Text_2, 160, 110, 160, 30, "Acceleration (Pixels/10/Frame/Frame): 0-15")
      TextGadget(#Text_3, 160, 160, 160, 30, "Swarminess: 0-100")
      CheckBoxGadget(#CheckBox_0, 20, 210, 130, 30, "Show relationship webs")
      CheckBoxGadget(#CheckBox_1, 20, 260, 130, 30, "Show ID numbers")
      CheckBoxGadget(#CheckBox_2, 20, 310, 130, 30, "Show grid")
      SpinGadget(#Spin_0, 20, 10, 130, 30, 0, 32,#PB_Spin_Numeric | #PB_Spin_ReadOnly)
      SpinGadget(#Spin_1, 20, 60, 130, 30, 0, 127,#PB_Spin_Numeric | #PB_Spin_ReadOnly)
      SpinGadget(#Spin_2, 20, 110, 130, 30, 0, 15,#PB_Spin_Numeric | #PB_Spin_ReadOnly)
      SpinGadget(#Spin_3, 20, 160, 130, 30, 0, 100,#PB_Spin_Numeric | #PB_Spin_ReadOnly)
      
    EndIf
  EndIf
EndProcedure




Declare.l ThreadProc(*Value)
Declare.l HandleInput()

Declare.l DrawGrid()

Declare.l CreateSwarmbot(x.l,y.l)
Declare.l UpdateSwarmbot(*sb.Swarmbot)
Declare.l DrawSwarmbot(*sb.Swarmbot)

Declare.l CreateFood(x,y)
Declare.l UpdateFood(*f.Food)
Declare.l DrawFood(*f.Food)

Declare.l UpdateEntities()
Declare.l DrawEntities()

Declare.l IndexNeighbours(*e.Entity,Range)

Declare.l CreateTimer(Freq)
Declare.l WaitTimer(*Timer.Timer)

Declare.f Atan2(a.f,b.f)
Declare.f FMod(a.f,b.f)

Declare.l LLRemoveElement(*Element.LLElement)
Declare.l LLAddElement(*Element.LLElement,*List.LLElementList)
Declare.l LLInsertElementAfter(*Element1.LLElement,*Element2.LLElement)
Declare.l LLInsertElementBefore(*Element1.LLElement,*Element2.LLElement)
Declare.l LLDestroyElementList(*ElementList.LLElementList)
Declare.l LLDestroyElement(*Element.LLElement)
Declare.l LLCreateElement(Size.l)
Declare.l LLCreateElementList()


Global THREAD_ON = 1
Global DRAW_GRID = 1


#FPS = 30

#SCREEN_WIDTH = 800
#SCREEN_HEIGHT = 600
#SCREEN_DEPTH = 32

#SECTOR_SIZE = 64

#MAP_WIDTH_SECTORS = 32
#MAP_HEIGHT_SECTORS = 32

#MAP_WIDTH_PIXELS = #SECTOR_SIZE * #MAP_WIDTH_SECTORS
#MAP_HEIGHT_PIXELS = #SECTOR_SIZE * #MAP_HEIGHT_SECTORS

#SCREEN_WIDTH_SECTORS = #SCREEN_WIDTH / #SECTOR_SIZE
#SCREEN_HEIGHT_SECTORS = #SCREEN_HEIGHT / #SECTOR_SIZE

Global Dim MAP.Sector(#MAP_WIDTH_SECTORS - 1,#MAP_HEIGHT_SECTORS - 1)

Define x,y

For y = 0 To #MAP_HEIGHT_SECTORS - 1
  For x = 0 To #MAP_WIDTH_SECTORS - 1
    MAP(x,y)\Occupants = LLCreateElementList()
  Next
Next

Global MAP_ORIGIN_X = 0
Global MAP_ORIGIN_Y = 0

#SCROLL_STEP = 8

; entity constants

Enumeration 1
  #ET_SWARMBOT
  #ET_FOOD
EndEnumeration

; entity neighbours array for fast access to entities
; near a particular sector

Global Dim *NEIGHBOURS.Entity(0)

; swarmbot constants/globals

#SB_SIZE = 16
Global SB_MAX_SPEED.f = 8
Global SB_RANGE = 4 ; number of sectors the swarmbot can "see"
Global SB_ACCELERATION.f = 0.4 ; how fast the swarmbot can accelerate
Global SB_AUTONOMY.f = 0.25 ; between 0 and 1, sets the swarmbots' inclination to swarm (low = very swarmy, high = very solitary)

Global SB_DRAW_RELATIONSHIP_WEBS = 1
Global SB_DRAW_ID_NUMBERS = 1

Global SB_NEXT_ID = 1

; swarmbot AI state constants

Enumeration 1
  #SB_STATE_CRUISING
  #SB_STATE_FEEDING
EndEnumeration


; food constants

#FOOD_SIZE = 8
#FOOD_ENERGY_INC = 0.05

RandomSeed(ElapsedMilliseconds())




Define i
Define *Timer = CreateTimer(1000 / #FPS)
Define Window = OpenWindow(1,0,0,#SCREEN_WIDTH,#SCREEN_HEIGHT,"Swarmbots AI Demo")
Define Pings
Define EventID

If Not IsWindow(1)
  MessageRequester("OOPS!","Sorry, could not open window.")
  End
EndIf



If Not InitSprite()
   MessageRequester("OOPS!","Sorry, could not initialise graphics environment.")
   End
EndIf

If Not OpenWindowedScreen(WindowID(1),0,0,#SCREEN_WIDTH,#SCREEN_HEIGHT,0,0,0)
   MessageRequester("OOPS!","Sorry, could not set graphics mode.")
   End
EndIf


If Not InitKeyboard()
   CloseScreen()
   MessageRequester("OOPS!","Sorry, could not initialise keyboard.")
   End
EndIf



RandomSeed(ElapsedMilliseconds())


Global THREAD = CreateThread(@ThreadProc(),0)


Procedure ThreadProc(*Value)
  Open_Window_0()
  If Not IsWindow(#Window_0)
    End
  EndIf

  SetGadgetState(#Spin_0,4)
  SetGadgetState(#Spin_1,80)
  SetGadgetState(#Spin_2,4)  
  SetGadgetState(#Spin_3,70)
  SetGadgetState(#CheckBox_2,1)

 
  Protected EventID
  
  While THREAD_ON
    EventID = WaitWindowEvent(2)
    
    If EventID = #PB_Event_CloseWindow
      Break
    EndIf



    SB_RANGE = GetGadgetState(#Spin_0)
    SB_MAX_SPEED = GetGadgetState(#Spin_1) / 10
    SB_ACCELERATION = GetGadgetState(#Spin_2) / 10
    SB_AUTONOMY = 1.0 - (GetGadgetState(#Spin_3) / 100.0)
    SB_DRAW_RELATIONSHIP_WEBS = GetGadgetState(#CheckBox_0)
    SB_DRAW_ID_NUMBERS = GetGadgetState(#CheckBox_1)
    DRAW_GRID = GetGadgetState(#CheckBox_2)

  Wend 
  
  
  CloseWindow(#Window_0)

EndProcedure


For i = 0 To 31
 CreateSwarmbot(Random(#MAP_WIDTH_PIXELS-1),Random(#MAP_HEIGHT_PIXELS-1))
 CreateFood(Random(#MAP_WIDTH_PIXELS - 1),Random(#MAP_HEIGHT_PIXELS - 1))
Next


;- Main

Repeat
   
  Pings = WaitTimer(*Timer)
  For i = 1 To Pings
    UpdateEntities()
    HandleInput()   
  Next
   

  EventID.l = WindowEvent();WaitWindowEvent(2)


  Select EventID
    Case #PB_Event_CloseWindow
      THREAD_ON = 0
      WaitThread(Thread)
      End
    Case #PB_Event_Gadget

  EndSelect

	ClearScreen(RGB(0,0,0))

  If StartDrawing(ScreenOutput())
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawGrid()
    DrawEntities()
    StopDrawing()
    FlipBuffers()
  EndIf


ForEver

End



Procedure HandleInput()
  ExamineKeyboard()

  If KeyboardPushed(#PB_Key_Escape)
    THREAD_ON = 0
    WaitThread(THREAD)
    End
  EndIf
  
  If KeyboardPushed(#PB_Key_Up)
    If MAP_ORIGIN_Y > 0
      MAP_ORIGIN_Y - #SCROLL_STEP
    EndIf
    If MAP_ORIGIN_Y < 0
      MAP_ORIGIN_Y = 0
    EndIf
  EndIf
  If KeyboardPushed(#PB_Key_Down)
    If MAP_ORIGIN_Y < #MAP_HEIGHT_PIXELS - #SCREEN_HEIGHT
      MAP_ORIGIN_Y + #SCROLL_STEP
    EndIf
    If MAP_ORIGIN_Y > #MAP_HEIGHT_PIXELS - #SCREEN_HEIGHT
      MAP_ORIGIN_Y = #MAP_HEIGHT_PIXELS - #SCREEN_HEIGHT
      If MAP_ORIGIN_Y < 0
        MAP_ORIGIN_Y = 0
      EndIf
    EndIf
  EndIf
  If KeyboardPushed(#PB_Key_Left)
    If MAP_ORIGIN_X > 0
      MAP_ORIGIN_X - #SCROLL_STEP
    EndIf
    If MAP_ORIGIN_X < 0
      MAP_ORIGIN_X = 0
    EndIf
  EndIf  
  If KeyboardPushed(#PB_Key_Right)
    If MAP_ORIGIN_X < #MAP_WIDTH_PIXELS - #SCREEN_WIDTH
      MAP_ORIGIN_X + #SCROLL_STEP
    EndIf
    If MAP_ORIGIN_X > #MAP_WIDTH_PIXELS - #SCREEN_WIDTH
      MAP_ORIGIN_X = #MAP_WIDTH_PIXELS - #SCREEN_WIDTH
      If MAP_ORIGIN_X < 0
        MAP_ORIGIN_X = 0
      EndIf
    EndIf
  EndIf
EndProcedure


Procedure DrawGrid()

  If DRAW_GRID = 0
    ProcedureReturn
  EndIf

  Protected ox = -(MAP_ORIGIN_X % #SECTOR_SIZE)
  Protected oy = -(MAP_ORIGIN_Y % #SECTOR_SIZE)
  
  ; calculate number of visible sectors
  Protected vsx = #SCREEN_WIDTH / #SECTOR_SIZE
  Protected vsy = #SCREEN_HEIGHT / #SECTOR_SIZE
  
  Protected x,y
  
  If ox <> 0
    vsx + 1
  EndIf
  
  If #SCREEN_WIDTH % #SECTOR_SIZE 
    vsx + 1
  EndIf
  
  If oy <> 0
    vsy + 1
  EndIf
  
  If #SCREEN_HEIGHT % #SECTOR_SIZE
    vsy + 1
  EndIf
  
  If vsx > #MAP_WIDTH_SECTORS
    vsx = #MAP_WIDTH_SECTORS
  EndIf

  If vsy > #MAP_HEIGHT_SECTORS
    vsy = #MAP_HEIGHT_SECTORS
  EndIf

  For y = 0 To vsy
    Box(ox,oy+y*#SECTOR_SIZE,vsx*#SECTOR_SIZE,1,RGB(0,128,255))
  Next
  
  For x = 0 To vsx
    Box(ox+x*#SECTOR_SIZE,oy,1,vsy*#SECTOR_SIZE,RGB(0,128,255))
  Next
   
EndProcedure

Procedure CreateSwarmbot(x.l,y.l)
  Protected *sb.Swarmbot = LLCreateElement(SizeOf(Swarmbot))
  Protected v.f,a.f
  Protected XSector.l,YSector.l
  
  If *sb
    *sb\Type = #ET_SWARMBOT
    *sb\x = x
    *sb\y = y
   
    *sb\ID = SB_NEXT_ID
    *sb\State = #SB_STATE_CRUISING
  
    *sb\Energy = 0.0

    v = (Random(SB_MAX_SPEED * 100) / 100)
    a = Random(628) / 100
  
    *sb\xv = v * Cos(a)
    *sb\yv = v * Sin(a)  

    *sb\xd = Random(#MAP_WIDTH_PIXELS - 1)
    *sb\yd = Random(#MAP_HEIGHT_PIXELS - 1)

    XSector = x / #SECTOR_SIZE
    YSector = y / #SECTOR_SIZE
  
    LLAddElement(*sb,MAP(XSector,YSector)\Occupants)
  
    SB_NEXT_ID + 1
  
  EndIf
  
  ProcedureReturn *sb

EndProcedure


Procedure UpdateSwarmbot(*sb.Swarmbot)
  Protected *e.Entity,*f.Food,*sb2.Swarmbot
  Protected XSector1.l,YSector1.l
  Protected XSector2.l,YSector2.l
  Protected sbx,sby
  Protected x,y,Width,XSector,YSector
  Protected a.f
  Protected xt.f
  Protected yt.f
  Protected c.f ; neighbour count
  Protected axv.f
  Protected ayv.f
  Protected i
  Protected aswarm.f ; angle towards swarm
  Protected aself.f ; angle of swarmbot
  Protected Attr.f
  Protected Food ; has the swarmbot found food?
  Protected Scale.f  
  Protected Dist.f

  ; calculate current sector of swarmbot
  sbx = Round(*sb\x,#PB_Round_Down)
  sby = Round(*sb\y,#PB_Round_Down)

  XSector1 = Round(sbx / #SECTOR_SIZE,#PB_Round_Down)
  YSector1 = Round(sby / #SECTOR_SIZE,#PB_Round_Down)

  ; move swarmbot
  *sb\x = *sb\x + *sb\xv ;* *sb\Energy
  *sb\y = *sb\y + *sb\yv ;* *sb\Energy

  ; calculate new sector of swarmbot
  sbx = Round(*sb\x,#PB_Round_Down)
  sby = Round(*sb\y,#PB_Round_Down)
 
  XSector2 = Round(sbx / #SECTOR_SIZE,#PB_Round_Down)
  YSector2 = Round(sby / #SECTOR_SIZE,#PB_Round_Down)
  
  ; wrap
  If *sb\x >= #SECTOR_SIZE * #MAP_WIDTH_SECTORS
    *sb\x = FMod(*sb\x,#SECTOR_SIZE * #MAP_WIDTH_SECTORS)
  ElseIf *sb\x < 0.0
    *sb\x = #SECTOR_SIZE * #MAP_WIDTH_SECTORS + *sb\x
  EndIf
  
  If *sb\y >= #SECTOR_SIZE * #MAP_HEIGHT_SECTORS
    *sb\y = FMod(*sb\y,#SECTOR_SIZE * #MAP_HEIGHT_SECTORS)
  ElseIf *sb\y < 0.0
    *sb\y = #SECTOR_SIZE * #MAP_HEIGHT_SECTORS + *sb\y
  EndIf
  
  ; if new sector is different from old, wrap sector if
  ; necessary, then remove swarmbot from the first sector's
  ; linked list and add it to the second
  If XSector2 <> XSector1 Or YSector2 <> YSector1
    If XSector2 < 0
      XSector2 = #MAP_WIDTH_SECTORS + XSector2
    ElseIf XSector2 > (#MAP_WIDTH_SECTORS - 1)
      XSector2 % (#MAP_WIDTH_SECTORS) ; - 1)
    EndIf
    If YSector2 < 0
      YSector2 = #MAP_HEIGHT_SECTORS + YSector2
    ElseIf YSector2 > (#MAP_HEIGHT_SECTORS - 1)
      YSector2 % (#MAP_HEIGHT_SECTORS) ; - 1)
    EndIf
    LLAddElement(*sb,MAP(XSector2,YSector2)\Occupants)
  EndIf

  ; keep speed within acceptable limits

  Protected Speed.f = Sqr(Pow(*sb\xv,2.0) + Pow(*sb\yv,2.0))
  
  If Speed > SB_MAX_SPEED

    Scale.f = (SB_MAX_SPEED / Speed)

    *sb\xv * Scale
    *sb\yv * Scale

  EndIf 

  ; index the entities within range of our swarmbot
  Protected NeighbourCount = IndexNeighbours(*sb,SB_RANGE)
  
  ; loop through neighbours: if any swarmbots are found then add up the  
  ; weighted direction vectors from the current swarmbot to each neighbour
  For i = 0 To NeighbourCount - 1
    If *NEIGHBOURS(i)\Type = #ET_SWARMBOT
      *sb2 = *Neighbours(i)
      Dist = Sqr(Pow(*sb2\x - *sb\x,2.0) + Pow(*sb2\y - *sb\y,2.0))
      a = ATan2(*sb2\y - *sb\y,*sb2\x - *sb\x)
      
      ; find out how attracted the swarmbot is to this particular neighbour.
      ; this returns a value between -1.0 and 1.0 based on the distance 
      ; between the swarmbots. very close swarmbots will be repelled by
      ; each other
      Attr = Sin(4.712389 * (1.0 - Dist / (SB_RANGE * #SECTOR_SIZE)))

      xt + Attr * Cos(a)
      yt + Attr * Sin(a)

      c + Abs(Attr)
    EndIf
  Next

  ; if there were any swarmbots nearby, find the average of all their positions
  ; relative to the swarmbot that the function was called for
  If c > 0.0
    axv = xt / c
    ayv = yt / c
      
    aswarm = ATan2(ayv,axv)

  EndIf

  Select *sb\State
  
    Case #SB_STATE_CRUISING

      
      aself = ATan2(*sb\yd - *sb\y,*sb\xd - *sb\x)

      ; find distance from destination
      Dist = Sqr(Pow(*sb\x - *sb\xd,2.0) + Pow(*sb\y - *sb\yd,2.0))
      
      ; if practically at destination, pick a new destination at random
      If Dist <= 100
        *sb\xd = Random(#MAP_WIDTH_PIXELS - 1)
        *sb\yd = Random(#MAP_HEIGHT_PIXELS - 1)
      EndIf
      
      For i = 0 To NeighbourCount - 1
        If *NEIGHBOURS(i)\Type = #ET_FOOD And *sb\Energy < 1.0
          *sb\State = #SB_STATE_FEEDING
        EndIf
      Next

    Case #SB_STATE_FEEDING
      
      For i = 0 To NeighbourCount - 1
        If *NEIGHBOURS(i)\Type = #ET_FOOD
          *f = *NEIGHBOURS(i)
          Dist = Sqr(Pow(*sb\x - *f\x,2.0) + Pow(*sb\y - *f\y,2.0))
          If Dist <= #FOOD_SIZE + #SB_SIZE
            If *sb\Energy < 1.0
              *sb\Energy + #FOOD_ENERGY_INC
              *f\Amount - #FOOD_ENERGY_INC
            Else
              *sb\State = #SB_STATE_CRUISING
              Break
            EndIf
          Else
            Food = 1
            
            aself = ATan2(*f\y - *sb\y,*f\x - *sb\x)
            
            Break
          EndIf
        EndIf
      Next

      If Food = 0 Or *sb\Energy >= 1.0
        aself = ATan2(*sb\yd - *sb\y,*sb\xd - *sb\x)
        *sb\State = #SB_STATE_CRUISING
      EndIf

  EndSelect
  
  If c = 0.0
    aswarm = aself
  EndIf
  
  Protected xr.f
  Protected yr.f
  
  xr = (1.0 - SB_AUTONOMY) * Cos(aswarm) + SB_AUTONOMY * Cos(aself)
  yr = (1.0 - SB_AUTONOMY) * Sin(aswarm) + SB_AUTONOMY * Sin(aself)
  
  
  a = ATan2(yr,xr)

  *sb\xv + SB_ACCELERATION * Cos(a)
  *sb\yv + SB_ACCELERATION * Sin(a)

  
EndProcedure




Procedure DrawSwarmbot(*sb.Swarmbot)
  Protected TW.l,TH.l
  Protected ID$
  Protected i,NeighbourCount,*sb2.Swarmbot
  
  If *sb
    
    If SB_DRAW_RELATIONSHIP_WEBS
      NeighbourCount = IndexNeighbours(*sb,SB_RANGE)
      
      For i = 0 To NeighbourCount - 1
        If *NEIGHBOURS(i)\Type = #ET_SWARMBOT
          *sb2 = *NEIGHBOURS(i)
          Line(*sb\x - MAP_ORIGIN_X,*sb\y - MAP_ORIGIN_Y,*sb2\x - *sb\x,*sb2\y - *sb\y,RGB(0,255,0))
        EndIf
      Next
   
    EndIf

    ; draw swarmbot
    Circle(*sb\x - MAP_ORIGIN_X,*sb\y - MAP_ORIGIN_Y,#SB_SIZE,RGB(255,0,0))
    Circle(*sb\x - MAP_ORIGIN_X,*sb\y - MAP_ORIGIN_Y,#SB_SIZE - 2,RGB(0,0,0))

  
    ID$ = Str(*sb\ID)
    TW = TextWidth(ID$)
    TH = TextHeight(ID$)
  
    If SB_DRAW_ID_NUMBERS
      ; draw ID number
      DrawText(*sb\x - 0.5 * TW - MAP_ORIGIN_X,*sb\y - 0.5 * TH - MAP_ORIGIN_Y,ID$,RGB(255,255,255),RGB(255,0,0))
    EndIf


  EndIf
  
  
  
EndProcedure

Procedure CreateFood(x,y)
  Protected *f.Food = LLCreateElement(SizeOf(Food))
  Protected XSector.l,YSector.l

  If *f
    *f\Type = #ET_FOOD
    *f\x = x
    *f\y = y
    *f\Amount = 1.0

    XSector = x / #SECTOR_SIZE
    YSector = y / #SECTOR_SIZE

    LLAddElement(*f,MAP(XSector,YSector)\Occupants)
  EndIf
  
  ProcedureReturn *f
  
EndProcedure

Procedure UpdateFood(*f.Food)
  Protected *n.Food
  If *f
    *n = *f\Next
    If *f\Amount <= 0
      LLDestroyElement(*f)
    EndIf
    ProcedureReturn *n
  EndIf

EndProcedure

Procedure DrawFood(*f.Food)
  If *f
    Circle(*f\x - MAP_ORIGIN_X,*f\y - MAP_ORIGIN_Y,#FOOD_SIZE * *f\Amount,RGB(0,255,0))
  EndIf
EndProcedure

Procedure UpdateEntities()
  Protected x.l,y.l
  Protected *e.Entity
  
  For y = 0 To #MAP_HEIGHT_SECTORS - 1
    For x = 0 To #MAP_WIDTH_SECTORS - 1
      ;Debug "looping thru occupants"
      *e = MAP(x,y)\Occupants\First
      While *e <> 0
        Select *e\Type
          Case #ET_SWARMBOT
            UpdateSwarmbot(*e)
          Case #ET_FOOD
            *e = UpdateFood(*e)
            Continue
        EndSelect

        *e = *e\Next
          
      Wend
    Next
  Next
EndProcedure

Procedure DrawEntities()
  Protected x.l,y.l
  Protected *e.Entity
  
  For y = 0 To #MAP_HEIGHT_SECTORS - 1
    For x = 0 To #MAP_WIDTH_SECTORS - 1
      *e = MAP(x,y)\Occupants\First
      While *e <> 0
        Select *e\Type
          Case #ET_SWARMBOT
            DrawSwarmbot(*e)
          Case #ET_FOOD
            DrawFood(*e)
        EndSelect
        
        *e = *e\Next
          
      Wend
    Next
  Next
EndProcedure

Procedure IndexNeighbours(*e.Entity,Range)

  Protected *i.Entity ; iterator
  Protected x,y
  Protected Width
  Protected c = 0 ; counter
  Protected Size = 16 ; current size of neighbours array
  Protected XSector,YSector

  If *e And Range > 0
    XSector = Round(*e\x / #SECTOR_SIZE,#PB_Round_Down)
    YSector = Round(*e\y / #SECTOR_SIZE,#PB_Round_Down)
    
    If XSector >= 0 And XSector < #MAP_WIDTH_SECTORS And YSector >= 0 And YSector < #MAP_HEIGHT_SECTORS
      Dim *NEIGHBOURS.Entity(Size)
      ; find nearby entities
      For y = -Range To Range
        Width = Sqr(Range * Range - y*y)
        For x = -Width To Width
          If (XSector + x) > 0 And (XSector + x) < (#MAP_WIDTH_SECTORS - 1)
            If (YSector + y) > 0 And (YSector + y) < (#MAP_HEIGHT_SECTORS - 1)

              *i = MAP(XSector + x,YSector + y)\Occupants\First
              While *i
                If *i <> *e
                
                  *NEIGHBOURS(c) = *i
                  
                  c + 1
                  If c > Size
                    Size + 16
                    ReDim *NEIGHBOURS.Entity(Size)
                  EndIf
                EndIf
                *i = *i\Next
              Wend
            EndIf
          EndIf
        Next
      Next     
    EndIf
  EndIf
  
  ProcedureReturn c
  
EndProcedure

Procedure CreateTimer(Freq)
  Protected *Timer.Timer = AllocateMemory(SizeOf(Timer))
  
  If *Timer
    *Timer\Ticks = ElapsedMilliseconds()
    *Timer\Freq = Freq
  EndIf
  
  ProcedureReturn *Timer
  
EndProcedure

Procedure WaitTimer(*Timer.Timer)
  Protected Elapsed
  Protected Pings

  If *Timer
    Repeat
      Elapsed = ElapsedMilliseconds()
      If Elapsed - *Timer\Ticks > *Timer\Freq
        Break
      EndIf
      Delay(1)
    ForEver
  
    Pings = (Elapsed - *Timer\Ticks) / *Timer\Freq  
    *Timer\Ticks = *Timer\Ticks + *Timer\Freq * Pings
  
  EndIf

  ProcedureReturn Pings

EndProcedure

Procedure DestroyTimer(*Timer.Timer)
  If *Timer
    FreeMemory(*Timer)
    ProcedureReturn 1
  EndIf
  ProcedureReturn 0
EndProcedure

Procedure.f Atan2(a.f,b.f)
   EnableASM
   FLD a
   FLD b
   FPATAN
   DisableASM
   ProcedureReturn
EndProcedure

Procedure.f FMod(a.f,b.f)
  Protected n.f

n.f = a/b

If n >= 0
	n = Round(n,#PB_Round_Down)
Else
	n = Round(n,#PB_Round_Up)
EndIf

ProcedureReturn a - n * b

EndProcedure

DisableExplicit

Procedure.l LLCreateElement(Size.l)
	Protected *Element.LLElement = 0
	*Element = AllocateMemory(Size)
	
	ProcedureReturn *Element
EndProcedure



Procedure.l LLCreateElementList()
  Protected *List.LLElementList
 
  *List = AllocateMemory(SizeOf(LLElementList))
  
	ProcedureReturn *List
EndProcedure

Procedure.l LLDestroyElement(*Element.LLElement)
	Protected Result = 0
	If *Element <> 0
		If *Element\List <> 0
			LLRemoveElement(*Element)
		EndIf
		FreeMemory(*Element)
		Result = 1
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure.l LLDestroyElementList(*ElementList.LLElementList)
	Protected Result = 0
	Protected *Element.LLElement
	Protected *Element2.LLElement

	;Debug "destroying Element list"
	;Debug ""

	If *ElementList <> 0
		*Element = *ElementList\First
		While Element <> 0
			count = count + 1
			;Debug "destroying Element " + count
			*Element2 = *Element\Next
			If Not LLDestroyElement(*Element)
				Result = 0
				ProcedureReturn Result
			EndIf
			*Element = *Element2			
		Wend
		FreeMemory(*ElementList)
		Result = 1
	EndIf
	ProcedureReturn Result
EndProcedure





Procedure.l LLInsertElementBefore(*Element1.LLElement,*Element2.LLElement)
	Protected Result = 0
	If *Element1 <> 0
		If *Element2 <> 0
			If *Element2\List <> 0
				If *Element1 <> *Element2

					If *Element1\List <> 0
						LLRemoveElement(*Element1)
					EndIf
			
					If *Element2 = *Element2\List\First
						*Element2\List\First = *Element1
					EndIf

					*Element1\List = *Element2\List	
					*Element1\Previous = *Element2\Previous
					*Element1\Next = *Element2
					*Element2\Previous = *Element1
					
					*Element2\List\Size = *Element2\List\Size + 1
					Result = 1

				EndIf
			EndIf
		EndIf
	EndIf
	ProcedureReturn Result
EndProcedure


Procedure.l LLInsertElementAfter(*Element1.LLElement,*Element2.LLElement)
	Protected Result = 0

	If *Element1 <> 0
		If *Element2 <> 0
			If *Element2\List <> 0
				If *Element1 <> *Element2

					If *Element1\List <> 0
						LLRemoveElement(*Element1)
						; Remove
					EndIf
					
					If *Element2 = *Element2\List\Last
						*Element2\List\Last = *Element1
					EndIf
					
					*Element1\List = *Element2\List
					*Element1\Next = *Element2\Next
					*Element1\Previous = *Element2
					*Element2\Next = *Element1
			
					*Element2\List\Size = *Element2\List\Size + 1
					Result = 1
				;Else
				;	Debug "Elements are the same."
				EndIf
			;Else
			;	Debug "Element2 isn't attached to a list."
			EndIf
		;Else
		;	Debug "Element2 is 0."
		EndIf
	;Else
	;	Debug "Element1 is 0"
	EndIf
	ProcedureReturn Result
EndProcedure



Procedure.l LLAddElement(*Element.LLElement,*List.LLElementList)
	Protected Result = 0
	If *Element <> 0
		If *List <> 0
			
			If *Element\List <> 0
				LLRemoveElement(*Element)
				; Remove
			EndIf
			
			If *List\First = 0
				*List\First = *Element
			EndIf
			
			If *List\Last <> 0
				*List\Last\Next = *Element
				*Element\Previous = *List\Last
			EndIf

			*List\Last = *Element
			*Element\Next = 0
			*Element\List = *List
			
			*List\Size = *List\Size + 1
			Result = 1	
		EndIf
	EndIf
	ProcedureReturn Result
EndProcedure

Procedure.l LLRemoveElement(*Element.LLElement)
	Protected Result = 0
	
	If *Element <> 0
		If *Element\List <> 0

			If *Element = *Element\List\First
				*Element\List\First = *Element\Next
			EndIf

			If *Element = *Element\List\Last
				*Element\List\Last = *Element\Previous
			EndIf

			If *Element\Previous <> 0
				*Element\Previous\Next = *Element\Next 
			EndIf

			If *Element\Next <> 0
				*Element\Next\Previous = *Element\Previous
			EndIf

			*Element\List\Size = *Element\List\Size - 1
			*Element\List = 0
			*Element\Next = 0
			*Element\Previous = 0
			Result = 1
		EndIf
	EndIf
	ProcedureReturn Result
EndProcedure

Posted: Fri Jul 18, 2008 9:42 pm
by ProphetOfDoom
I forgot to mention you can scroll around the map with the arrow keys!

Posted: Fri Jul 18, 2008 10:23 pm
by Rook Zimbabwe
That is soooo cool... Does the green stuff randomly regrow?

Why don't the bots bounce off the walls?

Keep up the good work! 8)

Posted: Fri Jul 18, 2008 11:30 pm
by Kaeru Gaman
yeah, thats cool!

a reset-button would be nice, and a zoom...

what next?
let them get Hungry,
add a possibility to seed the greed stuff,
make them spawn...

Posted: Sat Jul 19, 2008 5:13 am
by Rook Zimbabwe
Let them get Hungry,
And some of them randomly turn cannibal!!! (change color and attack the others making them smaller and slower! while making themselves BIGGER and FASTER!)

CANNIBALS are loners, but herbivores are herd creatures so they can gang up on a CARNIVORE that gets too near and attack it making it smaller and slower... eventually killing it.

Dang... talk about dynamic social interaction!

Posted: Sat Jul 19, 2008 6:03 am
by idle
cool and very nice formated code too!

Will remind myself to look at it every once in a while, then maybe I'll feel compelled to clean up my act.





:D

Posted: Sat Jul 19, 2008 7:29 pm
by ProphetOfDoom
That is soooo cool... Does the green stuff randomly regrow?
Hi again Rook! No the green stuff doesn't regrow. It would be neater if it did. I just feel a proper "eco-system" is somewhat beyond me. I might add some more feature to this... not sure... it wasn't sposed to even grow to 1000 lines...
Why don't the bots bounce off the walls?
I was going to merge it into a space game, where everything would wrap round giving the impression of infinity. Also, things bouncing off other things very quickly turns into maths, and then calculus, and then differential equations. :shock: And I still haven't got my head around that stuff despite all the For Dummies books I've been reading.
yeah, thats cool!

a reset-button would be nice, and a zoom...

what next?
let them get Hungry,
add a possibility to seed the greed stuff,
make them spawn...
If I get time I will do these things, cool ideas! And I will leave it in the public domain. (BTW people can do what they like with the code). The reason I didn't allow placing food/swarmbots with the mouse was simply that I am new and I didn't understand PB's mouse commands! I found a demo on the forums tho so I should be okay now.
And some of them randomly turn cannibal!!! (change color and attack the others making them smaller and slower! while making themselves BIGGER and FASTER!)

CANNIBALS are loners, but herbivores are herd creatures so they can gang up on a CARNIVORE that gets too near and attack it making it smaller and slower... eventually killing it.

Dang... talk about dynamic social interaction!
LOL I'm not a team, I am only one coder.
idle wrote:cool and very nice formated code too!

Will remind myself to look at it every once in a while, then maybe I'll feel compelled to clean up my act.

:D
Yeah it's ironic. I'm really obsessive-compulsive about how I write my code. It has to be ultra-neat and concise. And yet the room I'm coding in is so messy you can hardly see the floor, and hasn't been vaccumed in 18 months or more... lol.

Posted: Sat Jul 19, 2008 8:05 pm
by Rook Zimbabwe
add a possibility to seed the greed stuff
OK here it is... a CONSUMED variable... when the buggers have consumed a certain amount... plants/each other... they poop from 0-4 seeds randomly wherever thay are ranging and these grow into plants!!!

Automatic biosphere... 8)

Posted: Thu Sep 25, 2008 10:39 pm
by Pforzheimer
Nice program, but still a lot to do :-)
I made something about virtual live, 20 years ago on the ATARI ST,
there where female and male beeings. They had sex and children... :D
It was a litlle like spore v0.01 beta :-)

Your swarmbots don't compile on PB 4.30 beta 2 without changes.

If you declare
Declare.l ThreadProc(*Value)
you must take

Code: Select all

Procedure.l ThreadProc(*Value)
not only
Procedure ThreadProc(*Value)
...and some minor changes, to make it compile :-)

It would be nice, if you could take the dimensions of the desktop,
i program a lot on my EEE PC 900, which has a 1024x600 screen.
Maybe you can use this:

Code: Select all

NbDesktops = ExamineDesktops()
If NbDesktops = 0
  MessageRequester("Error", "Can't examine Desktops", 0)
  screenx = 800
  screeny = 600
Else
  screenx = DesktopWidth(0)
  screeny = DesktopHeight(0)
EndIf
Greetings from
Pforzheimer

----------------------------------
forget about my typos and mistakes :-)
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited