Griz at 15:45, 28 October 2005

2005-10-28T15:45:30Z

Griz at 11:13, 27 October 2005

2005-10-27T11:13:17Z

New page

Original code for 2.37.4 prior to our Debugging attempts. Just in case. ;)

<pre>
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(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

' 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

' 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

' 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

' 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(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(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(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

' 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

' 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

' 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

' 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
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
rob(n).mem(refvelscalar) = Sqr(rob(n).mem(refvelup) ^ 2 + rob(n).mem(refveldx) ^ 2) ' how fast is this robot moving compared to me?
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

'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()
Dim x As Long
For x = 1 To 2048
Perfsquares(x) = x * x
Next x
End Sub
</pre>

← Older revision		Revision as of 15:45, 28 October 2005
Line 1:		Line 1:
−	Original code for 2.37.4 prior to our Debugging attempts. Just in case. ;)	+	ask, discuss, here:
		+	----
		+
		+
		+
		+
		+
		+
		+
		+
		+
		+
		+
		+
		+
		+
		+
		+
		+
		+	----
		+
		+	Backup of Original code for 2.37.4 prior to our Debugging attempts. Just in case. ;)

Talk:Senses - Revision history

Griz at 15:45, 28 October 2005

Griz at 11:13, 27 October 2005