Senses

Listing of the Senses Modual by routines.
Bugs and hopefully, the fixes ... will be added as discoverd.
Please do not report bugs on this page ...
See Bug Reports for reporting of bugs and fixes in more detail.

By posting the entire code here ...
perhaps DB'ers might be afforded a way to explore the code and also
to understand a bit about why/how bugs crop up.
The discussion tab above may be used to post any questions about code ...
and hopefully, others will address them and provide answers.

Return to Moduals/Bas page.

---

NOTE: ... found errors indented in Table of Contents

Darwinbots version 2.37.4

Senses.bas Modual

Senses

Attribute VB_Name = "Senses"
'
'     S E N S E S
'

'This module is the most processor intensive.

Option Explicit

Dim Perfsquares(5000) As Long

'Dim Perfsquares(2048) As Long 'for a faster square root function, we store the first 2048 perfect squares

' Sets .sun to 1 if robot.aim is within 0.18 radians of 1.57 (Basically up)
' new version with less clutter.

Public Sub LandMark

Public Sub LandMark(ByVal iRobID As Integer)

rob(iRobID).mem(LandM) = 0
If rob(iRobID).aim > 1.39 And rob(iRobID).aim < 1.75 Then rob(iRobID).mem(LandM) = 1

End Sub

Public Sub touch

' touch: tells a robot whether it has been hit by another one
' and where: up, dn dx, sx
Public Sub touch(a As Integer, x As Single, y As Single)
  Dim xc As Single
  Dim yc As Single
  Dim dx As Single
  Dim dy As Single
  Dim tn As Single
  Dim ang As Single
  Dim aim As Single
  Dim dang As Single
  aim = 6.28 - rob(a).aim
  xc = rob(a).x + Half
  yc = rob(a).y + Half
  dx = x - xc
  dy = y - yc
  If dx <> 0 Then
    tn = dy / dx
    ang = Atn(tn)
    If dx < 0 Then ang = ang - 3.14
  Else
    ang = 1.57 * Sgn(dy)
  End If
  dang = ang - aim
  While dang < 0
    dang = dang + 6.28
  Wend
  While dang > 6.28
    dang = dang - 6.28
  Wend
  If dang > 5.49 Or dang < 0.78 Then rob(a).mem(hitup) = 1
  If dang > 2.36 And dang < 3.92 Then rob(a).mem(hitdn) = 1
  If dang > 0.78 And dang < 2.36 Then rob(a).mem(hitdx) = 1
  If dang > 3.92 And dang < 5.49 Then rob(a).mem(hitsx) = 1
  rob(a).mem(hit) = 1
End Sub

Public Sub taste

' taste: same as for touch, but for shots, and gives back
' also the flavour of the shot, that is, its shottype
' value
Public Sub taste(a As Integer, x As Long, y As Long, value As Integer)
  Dim xc As Single
  Dim yc As Single
  Dim dx As Single
  Dim dy As Single
  Dim tn As Single
  Dim ang As Single
  Dim aim As Single
  Dim dang As Single
  aim = 6.28 - rob(a).aim
  xc = rob(a).x + Half
  yc = rob(a).y + Half
  dx = x - xc
  dy = y - yc
  If dx <> 0 Then
    tn = dy / dx
    ang = Atn(tn)
    If dx < 0 Then ang = ang - 3.14
  Else
    ang = 1.57 * Sgn(dy)
  End If
  dang = ang - aim
  While dang < 0
    dang = dang + 6.28
  Wend
  While dang > 6.28
    dang = dang - 6.28
  Wend
  If dang > 5.49 Or dang < 0.78 Then rob(a).mem(shup) = value
  If dang > 2.36 And dang < 3.92 Then rob(a).mem(shdn) = value
  If dang > 0.78 And dang < 2.36 Then rob(a).mem(shdx) = value
  If dang > 3.92 And dang < 5.49 Then rob(a).mem(shsx) = value
  rob(a).mem(209) = dang * 200  'sysvar = .shang just returns the angle of the shot without the flavor
  rob(a).mem(shflav) = value    'sysvar = .shflav returns the flavor without the angle
End Sub

Public Sub erasesenses

' erases some senses
Public Sub erasesenses(n As Integer)
  Dim l As Integer
  With rob(n)
    .mem(hitup) = 0
    .mem(hitdn) = 0
    .mem(hitdx) = 0
    .mem(hitsx) = 0
    .mem(shup) = 0
    .mem(shdn) = 0
    .mem(shdx) = 0
    .mem(shsx) = 0
    .mem(214) = 0   'edge collision detection
    For l = 1 To 10 ' resets *trefvars
      .mem(455 + l) = 0
    Next l
    For l = 0 To 10     'resets
        .mem(trefxpos + l) = 0
    Next l
    .mem(472) = 0
  End With
End Sub

Public Sub WriteSenses

' writes some senses: view, .ref* vars, absvel
' pain, pleas, nrg
Public Sub WriteSenses(nd As node)
  Dim n As Integer
  Dim t As Integer
  n = nd.robn
  LandMark n
  With rob(n)
    If .view Then proximity nd, RobSize * 12
    If .lastopp > 0 Then
      lookoccurr n, .lastopp
    End If
    
    If Abs(.vx) > 100 Then .vx = 100 * Sgn(.vx) '2 new lines added to stop weird crashes
    If Abs(.vy) > 100 Then .vy = 100 * Sgn(.vy)
    
    If Abs(.nrg) > 32000 Then .nrg = 32000 * Sgn(.nrg)
    If .onrg < 0 Then .onrg = 0
    If .obody < 0 Then .obody = 0
    .mem(pain) = .onrg - .nrg
    .mem(pleas) = .nrg - .onrg
    .mem(bodloss) = .obody - .body
    .mem(bodgain) = .body - .obody
    .onrg = .nrg
    .obody = .body
    .mem(energy) = .nrg
    If .age = 0 And .mem(body) = 0 Then .mem(body) = .body 'to stop an odd bug in birth.  Don't ask
    If .Fixed Then .mem(215) = 1 Else .mem(215) = 0
    If .y <= 32000 Then .mem(217) = .y
    If .x <= 32000 Then .mem(219) = .x
    If OptionsForm.Daytime Then .mem(218) = 1 Else .mem(218) = 0
  End With
End Sub

Private Sub Checkleft

Private Sub Checkleft(field As Long, n As Integer, realfield As Long)
  Dim counter As Integer
  Dim robnumber As Integer
  Dim dx As Long
  Dim dy As Long
  Dim dissquared As Long
  Dim x As Long
  Dim y As Long
  Dim dis As Long
  
  With rob(n)
  x = rob(n).x
  y = rob(n).y
  End With
  
  dissquared = realfield * realfield
  
  'check out all the robots to the left
  counter = rob(n).order - 1
  
  If counter <> -1 Then
    robnumber = Roborder(counter)
    If robnumber <> -1 Then
      dx = x - rob(robnumber).x
    Else
      dx = field + 1
    End If
  Else
    Exit Sub
  End If
  
  If dx < 0 Then dx = -dx
  
  While dx < field
    dy = y - rob(robnumber).y
    If dy < 0 Then dy = -dy
    If dy < realfield Then
      dis = dy * dy + dx * dx
      If dis < dissquared Then target n, robnumber, dis
    End If
    
    counter = counter - 1
    If counter = -1 Then Exit Sub
    robnumber = Roborder(counter)
    
    dx = x - rob(robnumber).x
    If dx < 0 Then dx = -dx
  Wend
End Sub

Private Sub Checkright

Private Sub Checkright(field As Long, n As Integer, realfield As Long)
  Dim counter As Integer
  Dim robnumber As Integer
  Dim dx As Long
  Dim dy As Long
  Dim dissquared As Long
  
  Dim x As Long
  Dim y As Long
  Dim dis As Long
  
  With rob(n)
  x = rob(n).x
  y = rob(n).y
  End With
  
  dissquared = realfield * realfield
  'check out all the robots to the right
  
  counter = rob(n).order + 1
  robnumber = Roborder(counter)
  If robnumber <> -1 Then
    dx = rob(robnumber).x - x
  Else
    dx = field + 1
  End If
  
  If dx < 0 Then dx = -dx
  
  While dx < field
    dy = rob(robnumber).y - y
    If dy < 0 Then dy = -dy
        
    If dy < realfield Then
      dis = dy * dy + dx * dx
      If dis < dissquared Then target n, robnumber, dis
    End If
    
    counter = counter + 1
    robnumber = Roborder(counter)
    If robnumber = -1 Then
      dx = field + 1
    Else
      dx = rob(robnumber).x - x
    End If
    If dx < 0 Then dx = -dx
  Wend
End Sub

Private Sub CheckBoth

Private Sub CheckBoth(field As Long, n As Integer, realfield As Long)
  Dim counter As Integer
  Dim robnumber As Integer
  Dim dx As Long
  Dim dy As Long
  Dim dissquared As Long
  
  Dim x As Long
  Dim y As Long
  Dim dis As Long
  
  With rob(n)
  x = rob(n).x
  y = rob(n).y
  End With
  
  dissquared = realfield * realfield
  'check out all the robots to the right
  
  counter = 0 ' rob(n).order + 1
  robnumber = Roborder(counter)
  If robnumber <> -1 Then
    dx = rob(robnumber).x - x
    If dx < 0 Then dx = -dx
  Else
    dx = field + 1
  End If
  
  While robnumber <> -1
  'While dx < field
    dy = rob(robnumber).y - y
    If dy < 0 Then dy = -dy
        
    If dy < realfield Then
      dis = dy * dy + dx * dx
      If dis < dissquared Then target n, robnumber, dis
    End If
    
    counter = counter + 1
    robnumber = Roborder(counter)
    If robnumber = -1 Then
      dx = field + 1
    Else
      dx = x - rob(robnumber).x
      If dx < 0 Then dx = -dx
    End If
  Wend
End Sub

Public Sub proximity

' start of the viewing process
' takes robots far at most "field" from nd (a pointer to a
' robot in the linked list) and passes them
' to the viewing procedure
Public Sub proximity(ByRef nd As node, field As Long) 'byref for speed
'current largest field size is 12 * Robsize, which is = 1440
  Dim n As Integer
  Dim x As Long
  Dim y As Long
  Dim t As Integer
  Dim dis As Long
  Dim counter As Integer
  Dim robnumber As Integer
  Dim leftfield As Long
  Dim rightfield As Long
  Dim anglestuff As Single
  Dim tempcos As Single
  Dim tempsin As Single
  
  Dim dx As Long
  Dim dy As Long
  Dim aim As Single
    
  n = nd.robn
  
  With rob(n)
    For t = EyeStart To EyeEnd
      .mem(t) = 0
    Next t
    x = .x
    y = .y
    aim = .aim
  End With
  
  If aim >= 5.498 Or aim <= 0.785 Then
    Checkright field, n, field
    Exit Sub
  End If
  
  If aim >= 2.356 And aim <= 3.927 Then
    Checkleft field, n, field
    Exit Sub
  End If
  
  'check both,
  'but only for dx is within (leftfield, rightfield)
    
  'figure out what x distances we need to test
  tempcos = rob(n).aimx
  tempsin = rob(n).aimy
  
  If field = 1440 Then
    rightfield = 1018
  Else
    rightfield = field * 0.707107
  End If
  anglestuff = tempcos - tempsin
  leftfield = rightfield * anglestuff
  anglestuff = tempcos + tempsin
  rightfield = rightfield * anglestuff

  If aim > 0.785398 And aim < 2.356195 Then
    Checkleft -leftfield, n, field
    Checkright rightfield, n, field
    Exit Sub
  End If
  
  If aim > 3.926991 And aim < 5.497787 Then
    Checkleft -rightfield, n, field
    Checkright leftfield, n, field
    Exit Sub
  End If
End Sub

Public Sub target

' calculates projection of robot t in n's eye
' then calls cells to actually
' write it in the eye cells
Public Sub target(n As Integer, t As Integer, dis As Long)
  Dim dx As Long
  Dim dy As Long
  Dim an As Single
  Dim m As Integer
  Dim dan As Long
  Dim aim As Single
  Dim answer As Long
  m = -20
  dan = 0
  aim = rob(n).aim
    
  If rob(t).Exist And dis > 1 Then
    dx = rob(t).x - rob(n).x
    dy = -(rob(t).y - rob(n).y)
    If dx = 0 Then
      an = pi / 2 * Sgn(dy)
    Else
      an = Atn(dy / dx)
    End If
      
    If dx < 0 Then
      an = an + pi
    Else
      If an < 0 Then an = 2 * pi + an
    End If
     
    If (an > (3 * pi) / 4 And aim < pi / 2) Then
      an = -(2 * pi - an)
    End If
    
    If (aim > (3 * pi) / 4 And an < pi / 2) Then
      aim = -(2 * pi - aim)
    End If
    
    'finds square root
    answer = 320 + dis / 1280
    answer = 0.5 * (answer + dis / answer)
    dis = 0.5 * (answer + dis / answer)
    
    If Abs(an - aim) < (0.5 + RobSize / dis) Then
      dan = 300 / dis
      m = -(an - aim) * 5         'originally *10. changing to 5 gives a wider field of vision 45 degrees each way instead of 26 degrees
      cells n, t, m, dan, dis
    End If
  End If
End Sub

Public Sub cells

' writes down projections (taking care of not deleting
' nearer objects)
Public Sub cells(nr As Integer, opp As Integer, n As Integer, l As Long, dis As Long)
  Dim jj As Integer
  Dim kk As Integer
  Dim t As Integer
  If n > -20 Then
    If l > 5 Then l = 5
    kk = (RobSize / dis) * 100
    For t = -l To l
      If Abs(n + t) < 5 Then
        jj = n + t + EyeStart + 5
        If rob(nr).mem(jj) < kk Then
          rob(nr).mem(jj) = kk
          If jj = EyeStart + 5 Then
            rob(nr).lastopp = opp
          End If
        End If
      End If
    Next t
  End If
End Sub

Public Sub lookoccurr

' copies the occurr array of a viewed robot
' in the ref* vars of the viewing one
Public Sub lookoccurr(n As Integer, o As Integer)
  If rob(n).Corpse Then Exit Sub
  Dim t As Byte
  'If rob(n).lastviewed <> rob(o).AbsNum Then
    For t = 1 To 8
      rob(n).mem(occurrstart + t) = rob(o).occurr(t)
    Next t
    rob(n).lastviewed = rob(o).AbsNum
  'End If
  If rob(o).nrg < 32001 Then
    rob(n).mem(occurrstart + 9) = rob(o).nrg
  Else
    rob(n).mem(occurrstart + 9) = 32000
  End If
  rob(n).mem(occurrstart + 10) = rob(o).age '.refage
  rob(n).mem(in1) = rob(o).mem(out1)
  rob(n).mem(in2) = rob(o).mem(out2)
  rob(n).mem(711) = rob(o).mem(18)      'refaim
  rob(n).mem(712) = rob(o).occurr(9)    'reftie
  rob(n).mem(refshell) = rob(o).Shell
  rob(n).mem(refbody) = rob(o).body
  rob(n).mem(refypos) = rob(o).mem(217)
  rob(n).mem(refxpos) = rob(o).mem(219)
  'give reference variables from the bots frame of reference
  rob(n).mem(refvelup) = (rob(o).vx * Cos(rob(n).aim) + rob(o).vy * Sin(rob(n).aim) * -1) - rob(n).mem(velup)
  rob(n).mem(refveldn) = rob(n).mem(refvelup) * -1

Overflow in rob(o).vx

In this first line rob(n).vx out of range:

rob(n).mem(refveldx) = (rob(o).vy * Cos(rob(n).aim) + rob(o).vx * Sin(rob(n).aim)) - rob(n).mem(veldx)
rob(n).mem(refvelsx) = rob(n).mem(refvelsx) * -1

The fix??? Unresolved. See Bug Reports

Overflow in rob(n).mem(refvelup)

The following line gives runtime error 6, Overflow often.

The problem being the ^2 produces a value greater than 32000 for those variables.

 rob(n).mem(refvelscalar) = Sqr(rob(n).mem(refvelup) ^ 2 + rob(n).mem(refveldx) ^ 2) 
 ' how fast is    this robot moving compared to me?

Puroposed fix uses Long integers for rob(n).mem(refvelup) and rob(n).mem(refveldx :

rob(n).mem(refvelscalar) = CInt((CLng(rob(n).mem(refvelup)) ^ 2 + CLng(rob(n).mem(refveldx)) ^2 )^0.5)

See Bug Reports for more info.

  rob(n).mem(713) = rob(o).mem(827)     'refpoison. current value of poison. not poison commands
  rob(n).mem(714) = rob(o).mem(825)     'refvenom (as with poison)
  rob(n).mem(715) = rob(o).kills        'refkills
   If rob(o).Multibot = True Then
    rob(n).mem(refmulti) = 1
  Else
    rob(n).mem(refmulti) = 0
  End If
  If rob(n).mem(474) > 0 And rob(n).mem(474) <= 1000 Then 'readmem and memloc couple used to read a specified memory location of the target robot
    rob(n).mem(473) = rob(o).mem(rob(n).mem(474))
    'rob(n).mem(474) = 0
  End If
  If rob(o).Fixed Then                  'reffixed. Tells if a viewed robot is fixed by .fixpos.
    rob(n).mem(477) = 1
  Else
    rob(n).mem(477) = 0
  End If
  rob(n).mem(825) = rob(n).venom
  rob(n).mem(827) = rob(n).poison
    
End Sub

Private Function Sqr_Binary_Search

'no longer used, but I put enough effort into these that I don't want to lose them.
Private Function Sqr_Binary_Search(csquare As Long) As Long
'searches for the closest whole number square root (always rounds down)
'of csquare using a binary search of a lookup table
'worst case scenario: 11 iterations.  That's fast!
  Dim low As Integer
  Dim high As Integer
  Dim mid As Integer

  If csquare > 4194304 Then 'it's not going to be in our array
    Sqr_Binary_Search = Sqr(csquare)
    Exit Function
  End If

  If csquare < 2 Then
   Sqr_Binary_Search = csquare
   Exit Function
  End If

  If Perfsquares(2) <> 4 Then Setup_Perfsquares

  low = 1
  high = 2048

  While low <= high
   mid = (low + high) / 2
   If csquare < Perfsquares(mid) Then
     high = mid - 1
   ElseIf csquare > Perfsquares(mid) Then
     low = mid + 1
   Else
     Sqr_Binary_Search = mid
     Exit Function
   End If
  Wend
  Sqr_Binary_Search = high
End Function

Private Sub Setup_Perfsquares

Private Sub Setup_Perfsquares()
  Dim x As Long
  For x = 1 To 2048
   Perfsquares(x) = x * x
  Next x
End Sub
(/pre>