Robots
From WikiManual
Note: this was version 2.34
will update to 2.37.6 and 2.4.A asap (if needed)
version 2.4.A Robots.bas temp stashed here,
under the discussion tab above, until i can format it to
show the changes made as was done below in ver 2.34.
Griztalk 13:13, 19 Mar 2006 (MST)
Listing of the Robots Modual by routines.
Bugs and hopefully, the fixes ... will be added as discoverd.
Please don't report bugs here ...
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
Contents
- 1 Robot constants
- 2 Private Type robot
- 3 Robot Management
- 4 Public Function RobX
- 5 Public Function absx
- 6 Public Function absy
- 7 Private Sub updvars3
- 8 Private Sub updvars2
- 9 Private Sub updvars
- 10 Private Sub makeshell
- 11 Private Sub makeslime
- 12 Private Sub altzheimers
- 13 Public Sub updatepos
- 14 Private Sub ZeroMomentum
- 15 Private Sub storebody
- 16 Private Sub feedbody
- 17 Private Sub robshoot
- 18 Public Sub shareslime
- 19 Public Sub sharewaste
- 20 Public Sub shareshell
- 21 Public Sub sharenrg
- 22 Public Sub storevenom
- 23 Public Sub storepoison
- 24 Public Sub Reproduce
- 25 Public Sub SexReproduce
- 26 Public Function simplecoll
- 27 Public Function posto
- 28 Public Sub KillRobot
Robot constants
Option Explicit ' ' robot system locations constants ' Public Const dirup As Integer = 1 Public Const dirdn As Integer = 2 Public Const dirdx As Integer = 3 Public Const dirsx As Integer = 4 Public Const aimdx As Integer = 5 Public Const aimsx As Integer = 6 Public Const shoot As Integer = 7 Public Const shootval As Integer = 8 Public Const robage As Integer = 9 Public Const masssys As Integer = 10 Public Const maxvelsys As Integer = 11 Public Const setaim As Integer = 19 Public Const bodgain As Integer = 194 Public Const bodloss As Integer = 195 Public Const velscalar As Integer = 196 Public Const velsx As Integer = 197 Public Const veldx As Integer = 198 Public Const veldn As Integer = 199 Public Const velup As Integer = 200 Public Const vel As Integer = 200 Public Const hit As Integer = 201 Public Const shflav As Integer = 202 Public Const pain As Integer = 203 Public Const pleas As Integer = 204 Public Const hitup As Integer = 205 Public Const hitdn As Integer = 206 Public Const hitdx As Integer = 207 Public Const hitsx As Integer = 208 Public Const shup As Integer = 210 Public Const shdn As Integer = 211 Public Const shdx As Integer = 212 Public Const shsx As Integer = 213 Public Const kills As Integer = 220 Public Const repro As Integer = 300 Public Const mrepro As Integer = 301 Public Const sexrepro As Integer = 302 Public Const energy As Integer = 310 Public Const body As Integer = 311 Public Const fbody As Integer = 312 Public Const strbody As Integer = 313 Public Const mtie As Integer = 330 Public Const stifftie As Integer = 331 Public Const thisgene As Integer = 341 Public Const LandM As Integer = 400 Public Const trefbody As Integer = 437 Public Const trefxpos As Integer = 438 Public Const trefypos As Integer = 439 Public Const trefvelmysx As Integer = 440 Public Const trefvelmydx As Integer = 441 Public Const trefvelmydn As Integer = 442 Public Const trefvelmyup As Integer = 443 Public Const trefvelscalar As Integer = 444 Public Const trefvelyoursx As Integer = 445 Public Const trefvelyourdx As Integer = 446 Public Const trefvelyourdn As Integer = 447 Public Const trefvelyourup As Integer = 448 Public Const trefshell As Integer = 449 Public Const tieport1 As Integer = 450 Public Const tieloc As Integer = 452 Public Const tieval As Integer = 453 Public Const tienum As Integer = 455 Public Const trefnrg As Integer = 456 Public Const EyeStart As Integer = 500 Public Const EyeEnd As Integer = 510 Public Const refmulti = 686 Public Const refshell = 687 Public Const refbody = 688 Public Const refxpos = 689 Public Const refypos = 690 Public Const refvelscalar As Integer = 695 Public Const refvelsx As Integer = 696 Public Const refveldx As Integer = 697 Public Const refveldn As Integer = 698 Public Const refvelup As Integer = 699 Public Const occurrstart As Integer = 700 Public Const out1 As Integer = 800 Public Const out2 As Integer = 801 Public Const in1 As Integer = 810 Public Const in2 As Integer = 811 Public Const poison As Integer = 827 Public Const backshot As Integer = 900 Public Const aimshoot As Integer = 901 ' stack structure, used for robots' stack Private Type Stack val(stacklim) As Integer pos As Integer End Type
Private Type robot
' robot structure
Private Type robot
Exist As Boolean ' the robot exists?
Radius As Single
Shape As Integer ' shape of the robot, how many sides
'Made obsolete by energy types
Veg As Boolean ' is it a vegetable?
Wall As Boolean ' is it a wall?
Corpse As Boolean
Fixed As Boolean ' is it blocked?
' physics
x As Long ' x position
Y As Long ' y position
ox As Long ' old x,y positions
oy As Long
vx As Single ' x,y speed
vy As Single
ax As Single ' x,y acceleration
ay As Single
aim As Single ' aim angle
aimx As Single ' these two are the unit vector
aimy As Single '
oaim As Single ' old aim angle
envx As Byte ' x,y actual environment grid cell
envy As Byte
ma As Single ' angular momentum
mt As Single ' torch
absvel As Long ' absolute speed
Ties(10) As tie ' array of ties
order As Integer 'order in the roborder array
occurr(20) As Integer ' array with the ref* values
nrg As Single ' energy
onrg As Long ' old energy
body As Single ' Body points. A corpse still has a body after all
obody As Single ' old body points, for use with pain pleas versions for body
vbody As Single ' Virtual Body used to calculate body functions oof MBs
mass As Single ' mass of robot to be used in acceleration calculations
Shell As Single ' Hard shell. protection from shots 1-100 reduces each cycle
Slime As Single ' slime layer. protection from ties 1-100 reduces each cycle
Waste As Single ' waste buildup in a robot. Too much and he dies. some can be removed by various methods
Pwaste As Single ' Permanent waste. cannot be removed. Builds up as waste is removed.
poison As Single ' How poisonous is robot
venom As Single ' How venomous is robot
Paralyzed As Boolean ' true when robot is paralyzed
Paracount As Single ' countdown until paralyzed robot is free to move again
Numties As Single ' the number of ties attached to a robot
Multibot As Boolean ' Is robot part of a multi-bot
Poisoned As Boolean ' Is robot poisoned and confused
Poisoncount As Single ' Countdown till poison is out of his system
Bouyancy As Single ' Does robot float or sink
DecayTimer As Integer ' controls decay cycle
kills As Long ' How many other robots has it killed? Might not work properly
Dead As Boolean ' Allows program to define a robot as dead after a certain operation
Ploc As Integer ' Location for custom poison to strike
Vloc As Integer ' Location for custom venom to strike
Vval As Integer ' Value to insert into venom location
Vtimer As Integer ' Count down timer to produce a virus
vars(50) As var '|
vnum As Integer '| about private variables
maxusedvars As Integer '|
usedvars(1000) As Integer '| used memory cells
' virtual machine
pntr As Integer ' instruction pointer
st As Stack ' stack
mem(1000) As Integer ' memory array
DNA() As block ' program array
condlist(1000) As Integer ' conditions pointer
lastopp As Integer ' last robot in eye5
lastviewed As Long
view As Boolean ' robot has ever used eyes? (to save computation time)
AbsNum As Long ' absolute robot number
mutarray(20) As Long ' mutation rates array
Mutation As Boolean ' Enables or Disables mutations
condnum As Integer ' number of conditions (used for cost calculations)
console As Consoleform ' console object associated to the robot
' informative
SonNumber As Integer ' number of sons
Mutations As Integer ' total mutations
LastMut As Integer ' last mutations
Parent As Long ' parent absolute number
age As Long ' age in cycles
BirthCycle As Long ' birth cycle
genenum As Integer ' genes number
generation As Integer ' generation
LastOwner As String ' last internet owner's name
fname As String ' species name
DnaLen As Integer ' dna length
LastMutDetail As String ' description of last mutations
' aspetto
Skin(13) As Integer ' skin definition
OSkin(13) As Integer ' Old skin definition
color As Long ' colour
highlight As Boolean ' is it highlighted?
End Type
Public Badwastelevel As Integer Public Const RobSize As Integer = 120 ' rob diameter Public Const Half As Integer = 60 ' and so on... Public Const Halfsize As Integer = 60 Public Const ShotsLastTime As Integer = 2000 ' default lasting time for shots Public Const factor As Integer = 800 'conversion factor from .body to size of robot. Smaller number makes bigger bot Public Const invfactor As Single = 0.00125 'same as above but inversed, for speed. Public RobSizePublic As Integer Public Const RobArrayMax As Integer = 5000 Public rob(RobArrayMax) As robot ' array of robots Public rep(RobArrayMax) As Integer ' array for pointing to robots attempting reproduction Public kil(RobArrayMax) As Integer ' array of robots to kill Public rlist As New list ' a pointers list to maintain robots ordered along x axis Public MaxRobs As Integer ' max used robots array index Public robfocus As Integer ' the robot which has the focus (selected) Public totalrobots As Integer ' total robots in the sim Public Maxspeed As Single Public AbsNum As Long ' robots born (used to assign unique code) Public moving As Integer ' points the robot being dragged Public MaxMem As Integer Const SlimeCost As Integer = 1 'cost per unit of shell Const ShellCost As Integer = 1 'cost per unit of slime
Robot Management
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' R O B O T S M A N A G E M E N T ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function RobX
' returns a robot's x position (used by external ' classes) Public Function RobX(n As Integer) As Long RobX = rob(n).x End Function ' same as above Public Function RobY(n As Integer) As Long RobY = rob(n).Y End Function
Public Function absx
' returns an absolute acceleration, given up-down, ' left-right values and aim Public Function absx(aim As Single, ByVal up As Integer, ByVal dn As Integer, ByVal sx As Integer, ByVal dx As Integer) As Integer On Error Resume Next up = up - dn sx = sx - dx absx = Cos(aim) * up + Sin(aim) * sx End Function
Public Function absy
Public Function absy(aim As Single, ByVal up As Integer, ByVal dn As Integer, ByVal sx As Integer, ByVal dx As Integer) As Integer On Error Resume Next up = up - dn sx = sx - dx absy = -Sin(aim) * up + Cos(aim) * sx End Function
Private Sub updvars3
Private Sub updvars3(n As Integer)
'calculates accelerations of a robot that is part of an MB
'and applies a fraction of the acceleration to any other robot
'joined to it by a tie
Dim pt As Integer
Dim j As Integer
Dim l As Long
Dim k As Integer
Dim tvel As Single
Dim ivel As Single
Dim cost As Single
Dim Absaccel As Single
Dim Newaccelx As Single
Dim Newaccely As Single
Dim Reduce As Single
Dim up As Integer, dn As Integer, dx As Integer, sx As Integer
With rob(n)
.mass = 1 + (.body / 10000) + (.Shell / 200) 'set value for mass
Maxspeed = 30 / (.mass / 2) 'Set maximum speed. Absolute max = 60
Absaccel = 0 'reset acceleration
.absvel = Cos(.aim) * .vx * -1 + Sin(.aim) * .vy 'formula changed to give velocity in the direction robot is facing rather than always a positive number. Make *.vel work properly.
'.mem(vel) = .absvel * -1
up = .mem(dirup)
dn = .mem(dirdn)
dx = .mem(dirdx)
sx = .mem(dirsx)
If n <> moving Then
Newaccelx = absx(.aim, up, dn, sx, dx) * SimOpts.PhysMoving
.ax = .ax + Newaccelx
Newaccely = absy(.aim, up, dn, sx, dx) * SimOpts.PhysMoving
.ay = .ay + Newaccely
Absaccel = Sqr(.ax ^ 2 + .ay ^ 2)
.ax = .ax / .mass 'having large mass doesn't cost more. You just lose acceleration
.ay = .ay / .mass
ivel = .absvel
tvel = .absvel + Sqr(.ax ^ 2 + .ay ^ 2)
If tvel > Maxspeed Then 'limits speed to maxspeed
Reduce = tvel / Maxspeed
.ax = .ax / Reduce
.ay = .ay / Reduce
tvel = Maxspeed
End If
'transfer acceleration to other parts of the MB
k = 1
While .Ties(k).pnt <> 0
rob(.Ties(k).pnt).ax = rob(.Ties(k).pnt).ax + Newaccelx
rob(.Ties(k).pnt).ay = rob(.Ties(k).pnt).ay + Newaccely
k = k + 1
Wend
End If
End With
End Sub
Private Sub updvars2
Private Sub updvars2(n As Integer)
' calculates new acceleration and energy values from robot's
' .up/.dn/.sx/.dx vars
' modified procedure to deal better with mass
Dim pt As Integer
Dim j As Integer
Dim l As Long
Dim k As Integer
Dim tvel As Single
Dim ivel As Single
Dim cost As Single
Dim Absaccel As Single
Dim Newaccelx As Single
Dim Newaccely As Single
Dim Reduce As Single
Dim up As Integer, dn As Integer, dx As Integer, sx As Integer
Dim setaim As Integer
setaim = 19
With rob(n)
.mass = 1 + (.body / 10000) + (.Shell / 200) 'set value for mass
Maxspeed = 30 / (.mass / 2) 'Set maximum speed. Absolute max = 60
Absaccel = 0 'reset acceleration
If Abs(.vx) > 32000 Then .vx = 32000 * Sgn(.vx)
If Abs(.vy) > 32000 Then .vy = 32000 * Sgn(.vy)
.absvel = Cos(.aim) * .vx * -1 + Sin(.aim) * .vy 'formula changed to give velocity in the direction robot is facing rather than always a positive number. Make *.vel work properly.
'.mem(vel) = .absvel * -1
up = .mem(dirup)
.mem(dirup) = 0
dn = .mem(dirdn)
.mem(dirdn) = 0
dx = .mem(dirdx)
.mem(dirdx) = 0
sx = .mem(dirsx)
.mem(dirsx) = 0
j = 1
If .Paralyzed Then
.Paracount = .Paracount - 1
.mem(837) = .Paracount
If .Paracount < 1 Then .Paralyzed = False: .Vloc = 0: .Vval = 0
End If
If .Poisoned Then
.Poisoncount = .Poisoncount - 1
.mem(838) = .Poisoncount
If .Poisoncount < 1 Then .Poisoned = False: .Ploc = 0: .Poisoncount = 0
End If
Abs(.mem(aimsx)) error
- bug ... Abs brackets incorrect.
- change:
If Abs(.mem(aimsx) > 1256) Then .mem(aimsx) = 1256 * Sgn(.mem(aimsx)) 'new crash fix? If Abs(.mem(aimdx) > 1256) Then .mem(aimdx) = 1256 * Sgn(.mem(aimdx))
- to
If Abs(.mem(aimsx)) > 1256 Then .mem(aimsx) = 1256 * Sgn(.mem(aimsx)) 'new crash fix? If Abs(.mem(aimdx)) > 1256 Then .mem(aimdx) = 1256 * Sgn(.mem(aimdx))
see Bug Reports for additional data/discussion.
If .mem(setaim) <> 32000 Then
While .mem(setaim) > 1256
.mem(setaim) = .mem(setaim) - 1256
Wend
While .mem(setaim) < 0
.mem(setaim) = .mem(setaim) + 1256
Wend
.aim = .mem(setaim) / 200
.mem(setaim) = 32000
End If
.aim = .aim + (.mem(aimsx) - .mem(aimdx)) / 200
If .aim > 2 * pi Then .aim = .aim - 2 * pi
If .aim < 0 Then .aim = 2 * pi + .aim
.aimx = Cos(.aim)
.aimy = Sin(.aim)
'.mem(18) = .aim * 200
If n <> moving Then
Newaccelx = absx(.aim, up, dn, sx, dx) * SimOpts.PhysMoving
.ax = .ax + Newaccelx
Newaccely = absy(.aim, up, dn, sx, dx) * SimOpts.PhysMoving
.ay = .ay + Newaccely
.mem(masssys) = .mass
.mem(maxvelsys) = Maxspeed
.ax = .ax / .mass 'having large mass doesn't cost more. You just lose acceleration
.ay = .ay / .mass
Absaccel = Sqr(.ax ^ 2 + .ay ^ 2)
ivel = .absvel
tvel = .absvel + Absaccel
If tvel > Maxspeed Then 'limits speed to maxspeed
Reduce = tvel / Maxspeed
.ax = .ax / Reduce
'Newaccelx = Newaccelx / Reduce
.ay = .ay / Reduce
'Newaccely = Newaccely / Reduce
tvel = Maxspeed
End If
If SimOpts.KineticEnergy Then 'modified by Numsgil
cost = Abs(((.mass / 2) * (tvel * Abs(tvel)) - ((.mass / 2) * (ivel * Abs(ivel)))) / 4)
Else
'cost = Abs(up) + Abs(dn) + Abs(dx) + Abs(sx)
'isn't fair to charge a bot for how fast it wants to go if it can't go that fast
'also isn't fair to charge for up + down 5 up and 5 down result in zero acceleration,
'so should be zero cost. Therefore, above line was changed to:
'cost = Sqr(.ax ^ 2 + .ay ^ 2)
'Also unfair as this charges for ALL accelerations, including gravity, collisions etc.
cost = Sqr((Newaccelx / .mass) ^ 2 + (Newaccely / .mass) ^ 2)
'this way we only charge for accelerations applied by the DNA
End If
If .Multibot Then cost = cost / (.Numties + 1)
.nrg = .nrg - (cost * SimOpts.MoveCost)
End If
.mem(aimsx) = 0
.mem(aimdx) = 0
.lastopp = 0
End With
End Sub
Private Sub updvars
' calculates new acceleration and energy values from robot's
' .up/.dn/.sx/.dx vars
Private Sub updvars(n As Integer)
Dim pt As Integer
Dim j As Integer
Dim l As Long
Dim tvel As Single
Dim ivel As Single
Dim cost As Single
Dim Absaccel As Single
Dim Maxspeed As Single
Dim up As Integer, dn As Integer, dx As Integer, sx As Integer
With rob(n)
Maxspeed = 40
Absaccel = 0
.mass = 0.5 + (.body / 10000) + (.Shell / 200)
If Abs(.mem(dirup)) > 1000 Then .mem(dirup) = 1000 * Sgn(.mem(dirup))
up = .mem(dirup) / .mass
.mem(dirup) = 0
If Abs(.mem(dirdn)) > 1000 Then .mem(dirdn) = 1000 * Sgn(.mem(dirdn))
dn = .mem(dirdn) / .mass
.mem(dirdn) = 0
If Abs(.mem(dirdx)) > 1000 Then .mem(dirdx) = 1000 * Sgn(.mem(dirdx))
dx = .mem(dirdx) / .mass
.mem(dirdx) = 0
If Abs(.mem(dirsx)) > 1000 Then .mem(dirsx) = 1000 * Sgn(.mem(dirsx))
sx = .mem(dirsx) / .mass
.mem(dirsx) = 0
j = 1
'If .Paralyzed Then up = 0: dn = 0: dx = 0: sx = 0: .mem(aimsx) = 0: .mem(aimdx) = 0
'If .Poisoned Then up = up * -1: dn = dn * -1: dx = dx * -1: sx = sx * -1: .mem(aimsx) = .mem(aimsx) * -1: .mem(aimdx) = .mem(aimdx) * -1
If Abs(.mem(aimsx) > 1256) Then .mem(aimsx) = 1256 * Sgn(.mem(aimsx)) 'new crash fix?
If Abs(.mem(aimdx) > 1256) Then .mem(aimdx) = 1256 * Sgn(.mem(aimdx))
.aim = .aim + (.mem(aimsx) - .mem(aimdx)) / 200
If .aim > 2 * pi Then .aim = .aim - 2 * pi
If .aim < 0 Then .aim = 2 * pi + .aim
.aimx = Cos(.aim)
.aimy = Sin(.aim)
If n <> moving Then
.ax = .ax + absx(.aim, up, dn, sx, dx) * SimOpts.PhysMoving
.ay = .ay + absy(.aim, up, dn, sx, dx) * SimOpts.PhysMoving
Absaccel = .ax + .ay
If Absaccel > 100 Or Absaccel < -100 Then
Absaccel = 100 * Sgn(Absaccel)
End If
End If
' set a maximum for energy consumed by movement, to prevent
' behaviours like that induced by the first greenpeace
' (Turneria Preservans) which used to kill opponents forcing
' them to move thousands of steps away
.mem(10) = .mass
.mem(11) = up
If Abs(up) + Abs(dn) < 100 And Abs(dx) + Abs(sx) < 100 Then
If SimOpts.KineticEnergy Then
ivel = .absvel
tvel = .absvel + up - dn
cost = Abs(((.mass / 2) * (tvel * Abs(tvel)) - ((.mass / 2) * (ivel * Abs(ivel)))) / 4) / (.Numties + 1)
.nrg = .nrg - cost
.mem(955) = 1
Else
.mem(955) = 25
If .Multibot Then
'cheaper for multi-bots. This formula is designed to
.nrg = .nrg - ((Abs(up) + Abs(dn) + Abs(dx) + Abs(sx)) / (.Numties + 1)) 'old line
Else
.nrg = .nrg - (Abs(up) + Abs(dn) + Abs(dx) + Abs(sx))
End If
End If
Else
' let's normalize induced acceleration and energy consumption
If SimOpts.KineticEnergy = False Then
If .Multibot Then 'again less max cost for MB
.nrg = .nrg - 50
Else
.nrg = .nrg - 100
End If
Else
ivel = .absvel
tvel = .absvel + 100
If tvel > Maxspeed Or tvel < Maxspeed * -1 Then tvel = Maxspeed * Sgn(tvel)
cost = Abs(((.mass / 2) * (tvel * Abs(tvel)) - ((.mass / 2) * (ivel * Abs(ivel)))) / 4) / (.Numties + 1)
.nrg = .nrg - cost
End If
l = Sqr(.ax ^ 2 + .ay ^ 2)
If l > 100 Then
.ax = (.ax / l) * 100
.ay = (.ay / l) * 100
End If
End If
.mem(aimsx) = 0
.mem(aimdx) = 0
.lastopp = 0
End With
End Sub
Private Sub makeshell
Private Sub makeshell(n)
Dim oldshell As Integer
Dim cost As Single
With rob(n)
oldshell = .Shell
.Shell = .Shell + .mem(822)
If .Shell > 32000 Then .Shell = 32000
If .Shell < 1 Then .Shell = 1
cost = (.Shell - oldshell) * ShellCost
If cost < 0 Then cost = 0
.nrg = .nrg - cost / (.Numties + 1)
.Waste = .Waste + cost / 10
.mem(822) = 0
End With
End Sub
Private Sub makeslime
Private Sub makeslime(n)
Dim oldslime As Integer
Dim cost As Single
With rob(n)
oldslime = .Slime
.Slime = .Slime + .mem(820)
If .Slime > 32000 Then .Slime = 32000
If .Slime < 0 Then .Slime = 0
cost = (.Slime - oldslime) * SlimeCost
If cost < 0 Then cost = 0
.nrg = .nrg - cost / (.Numties + 1) 'lower cost for multibot
.Waste = .Waste + cost / 10
.mem(820) = 0
End With
End Sub
Private Sub altzheimers
Private Sub altzheimer(n As Integer) 'makes robots with high waste act in a bizarre fashion. Also a small chance of random death
Dim loc As Integer
Dim val As Integer
Dim loops As Integer
Dim Waste As Long
Dim t As Integer
'Dim Randnum As Long
Waste = rob(n).Pwaste + rob(n).Waste
loops = Waste / 1000
For t = 1 To loops
With rob(n)
loc = Int(Rnd * 1000) + 1
val = Int(Rnd * 1000)
.mem(loc) = val
End With
Next t
End Sub
Public Sub updatepos
' one of the main recalculation routines
' basically the root for all physics computation,
' senses I/O, shooting, energy, ties. etc etc
' in this order, calls:
'
' calc. accelerations
' calc. positions
' shooting
' reproducing
' sexual reproduction (hot!)
' signal passing through ties
' dying
' input from senses (expecially view)
' tieing
'
'
' reproducing and dying are actually queued and performed
' only at the end of the procedure, to avoid changing the
' robots' arrays and lists while cycling through them
Public Sub updatepos()
Dim t As Integer
Dim k As Integer
Dim c As Integer
Dim z As Integer
Dim q As Integer
Dim rp As Integer
Dim kl As Integer
Dim nd As node
Dim ti As Single
Dim x As Integer
rp = 1
kl = 1
kil(1) = 0
rep(1) = 0
If SimOpts.ZeroMomentum = True Then ZeroMomentum
Newaccel
linklen
Momenti
LinkForce
If ContestMode Then
F1count = F1count + 1
If F1count = SampFreq And Contests <= Maxrounds Then
Countpop
End If
End If
Set nd = rlist.firstnode
While Not nd Is rlist.last
t = nd.robn
With rob(t)
.mem(336) = .DnaLen
If .Paralyzed Then
.mem(.Vloc) = .Vval
End If
If .Poisoned Then
.mem(.Ploc) = 0
End If
If .mem(455) <> 0 And Not .Corpse And .Numties > 0 And .mem(tieloc) > 0 Then
'This routine deals with information transfer only. Added in to fix a major bug
'in which older robots could transfer information to younger bots OK but
'young bots could not transfer information to older bots in time for the information
'to do any good
tieportcom t
End If
If .mem(471) <> 0 And .Numties > 0 Then
'reads all of the tref variables from a given tie number
readtie t
Else
If .mem(472) <> 0 Then 'resets all trefvars to zero if no readtie statement is used
For t = 456 To 465
.mem(t) = 0
Next t
.mem(472) = 0 'Trefbody
.mem(475) = 0 'tmemval
.mem(476) = 0 'tmemloc
.mem(478) = 0 'treffixed
For t = 0 To 10 'For trefvelX functions. New from Numsgil
.mem(trefxpos + t) = 0
Next t
End If
End If
If .Multibot Then 'attempt to help MBs to move
If .mem(dirup) <> 0 Or .mem(dirdn) <> 0 Or .mem(dirsx) <> 0 Or .mem(dirdx) <> 0 Then
'calculates accelerations of a robot that is part of an MB
'and applies a fraction of the acceleration to any other robot
'joined to it by a tie
MB_Transfer_Accelerations t
End If
End If
Set nd = rlist.nextnode(nd)
End With
DoEvents
Wend
TotalEnergy = 0
totwalls = 0
totcorpse = 0
totalrobots = 0
totnvegs = 0
totvegs = 0
Set nd = rlist.firstnode
While Not nd Is rlist.last
t = nd.robn
With rob(t)
totalrobots = totalrobots + 1
If .Veg Then
totvegs = totvegs + 1: TotalEnergy = TotalEnergy + .nrg 'now only count veg energy
ElseIf .Corpse Then
totcorpse = totcorpse + 1
Decay t
ElseIf .Wall Then
Else
totnvegs = totnvegs + 1
End If
If .mem(335) > 0 And .Vtimer = 0 Then
.Vtimer = genelength(t, .mem(335)) * 2
End If
If .Vtimer > 1 Then
.Vtimer = .Vtimer - 1
End If
.mem(337) = .Vtimer
.mem(336) = .DnaLen
.mem(339) = CountGenes(.DNA)
If .mem(340) > 0 Then
delgene t, .mem(340)
.mem(340) = 0
End If
Update_Ties t ' Carries out all tie routines
If Not .Corpse Then updvars2 t
.nrg = .nrg - (SimOpts.CostExecCond * .condnum) / (.Numties + 1) 'cheaper costs for multibots
updpos nd
rlist.stay nd, rob(t).x
.obody = .mem(body) 'replaces routine above
If .body > 32000 Then .body = 32000
.Radius = .body / factor
.mem(body) = .body
If Not .Corpse And Not .Wall Then
If .mem(822) <> 0 Then makeshell t
If .mem(820) <> 0 Then makeslime t
.Slime = .Slime - .Slime / 50
If .Waste > 0 And .Veg Then feedveg2 t
If .mass < 0.6 Then .mass = 0.6
If Badwastelevel = 0 Then Badwastelevel = 400
If Badwastelevel <> -1 Then
If .Pwaste + .Waste > Badwastelevel Then altzheimer t
End If
If .Shell < 0 Then .Shell = 0
If .Slime < 0 Then .Slime = 0
.age = .age + 1: If .age > 32000 Then .age = 32000
.mem(9) = .age 'line added to copy robots age into a memory location
If .mem(shoot) Then 'And Not .Paralyzed Then
robshoot t
.mem(shoot) = 0
End If
If .mem(338) > 0 And .Vtimer = 1 Then
Vshoot t
.mem(338) = 0
.mem(337) = 0
.mem(335) = 0
.Vtimer = 0
End If
If .aim > 6.28 Then .aim = 6.28
If .aim < 0 Then .aim = 0
.aimx = Cos(.aim)
.aimy = Sin(.aim)
.mem(18) = .aim * 200
If .mem(314) > 2000 Or .mem(314) < -2000 Then
.mem(314) = 2000 * Sgn(.mem(314))
End If
If SimOpts.Bouyancy Then
.Bouyancy = .mem(314) / 1000
Else
.Bouyancy = 0
End If
.mem(315) = .Bouyancy * 1000
If .mem(313) > 0 Then storebody t
If .mem(824) <> 0 Then storevenom t
If .mem(826) <> 0 Then storepoison t
If .mem(312) > 0 Then feedbody t
Velocity/Acceleration error
see Bug Reports for bug details Replace:
If .mem(216) <> 0 Then
.Fixed = True
.vx = 0
.vy = 0
Else
.Fixed = False
End If
With:
If .mem(216) <> 0 Then
.Fixed = True
Else
.Fixed = False
End If
if .Fixed then
.vx = 0
.vy = 0
.ax = 0
.ay = 0
End If
If .Waste > 32000 Then defacate t
If .Waste < 0 Then .Waste = 0
.mem(828) = .Waste
If .Pwaste > 32000 Then .Pwaste = 32000
.mem(829) = .Pwaste
.mem(821) = .Slime
.mem(823) = .Shell
If .mem(repro) > 0 Or .mem(mrepro) > 0 Then
rep(rp) = t
rp = rp + 1
End If
'shock code:
'later make the shock threshold based on body and age
If Not .Veg And .nrg > 3000 Then
Dim temp As Long
temp = .onrg - .nrg
If temp > (.onrg / 2) Then
.nrg = 0
.body = .body + (.nrg / 10)
.Radius = Half + .body / factor
If .body > 32000 Then .body = 32000
End If
End If
End If
If .nrg = 0 And NoDeaths Then
.nrg = 2000 'Still don't know why some robots come back from a saved sim with zero energy but this line stops them dying.
End If
If .nrg < 1 And Not NoDeaths And Not SimOpts.CorpseEnabled Then
.Dead = True
End If
If SimOpts.CorpseEnabled Then
If Not .Corpse Then
If .nrg < 1 And .age > 1 Then
.Corpse = True
.view = False
.fname = "Corpse"
delallties t
.color = vbWhite
.Veg = False
.Fixed = False
Erase .mem
Erase .DNA
ReDim .DNA(100)
.DNA(0).tipo = 4
.DNA(0).value = 4
.DNA(1).tipo = 4
.DNA(1).value = 4
If SimOpts.Bouyancy Then .Bouyancy = -3
End If
End If
If .Corpse = True Then
.nrg = 0
End If
Else
If .nrg < 1 Then
.Dead = True
End If
End If
If .Wall Then .body = 1
.Radius = .body / factor
If .body < 1 Then
.Dead = True
End If
If NoDeaths = False Then
If .Dead Then
kil(kl) = t
kl = kl + 1
End If
End If
Set nd = rlist.nextnode(nd)
End With
Wend
NoDeaths = False
'calculate the faster array of robot positions
Sort_Robots_Roborder
Set nd = rlist.firstrob
While Not nd Is rlist.last
t = nd.robn
With rob(t)
If .Corpse Or .Wall Then GoTo bypass 'maybe save some time not processing corpses
WriteSenses nd
If .mem(mtie) > 0 Then
If Not .view Then
proximity nd, RobSize * 5
End If
If .lastopp > 0 And Not SimOpts.DisableTies Then
deltie t, rob(t).lastopp
'change this to distance between robots instead
'Here lies the infamous tie bug
'Gave me Hell, till I gave it Hell
'Drove me mad, till I drove it mad
'Killed me, so I killed it
'3-31-2005 at 1:58 AM
'Dim dist As Long
'dist = Sqr((rob(t).x - rob(rob(t).lastopp).x) ^ 2 + (rob(t).Y - rob(rob(t).lastopp).Y) ^ 2)
'maketie t, rob(t).lastopp, dist, -20, rob(t).mem(mtie)
maketie t, rob(t).lastopp, RobSize * 2, -20, rob(t).mem(mtie)
End If
.mem(mtie) = 0
End If
If .mem(sexrepro) > 0 Then
If Not .view Then proximity nd, RobSize * 4
If .lastopp > 0 And rob(.lastopp).mem(sexrepro) > 0 Then
rep(rp) = -t
rep(rp + 1) = -.lastopp
rp = rp + 2
End If
.mem(mtie) = 0
End If
bypass:
Set nd = rlist.nextnode(nd)
End With
DoEvents
Wend
'''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''
t = 1
While t < rp
If rep(t) > 0 Then
Reproduce rep(t), rob(rep(t)).mem(repro) + rob(rep(t)).mem(mrepro)
rob(rep(t)).mem(repro) = 0
rob(rep(t)).mem(mrepro) = 0
ElseIf rep(t) < 0 Then
SexReproduce -rep(t), -rep(t + 1)
rob(-rep(t)).mem(sexrepro) = 0
rob(-rep(t + 1)).mem(sexrepro) = 0
t = t + 1
End If
t = t + 1
Wend
t = 1
While t < kl
KillRobot kil(t)
t = t + 1
Wend
If totnvegs = 0 Then 'restart the sim when no robots left
If RestartMode And FirstCycle = False Then
totnvegs = 1
Contests = Contests + 1
ReStarts = ReStarts + 1
Form1.StartSimul
End If
End If
FirstCycle = False
End Sub
Private Sub ZeroMomentum
Private Sub ZeroMomentum()
Dim nd As node
Dim t As Integer
Set nd = rlist.firstnode
While Not nd Is rlist.last
t = nd.robn
With rob(t)
.vx = 0
.vy = 0
Set nd = rlist.nextnode(nd)
End With
Wend
End Sub
Private Sub storebody
Private Sub storebody(t As Integer) If rob(t).mem(313) > 100 Then rob(t).mem(313) = 100 rob(t).nrg = rob(t).nrg - rob(t).mem(313) rob(t).body = rob(t).body + rob(t).mem(313) / 10 If rob(t).body > 32000 Then rob(t).body = 32000 rob(t).Radius = rob(t).body / factor rob(t).mem(313) = 0 End Sub
Private Sub feedbody
Private Sub feedbody(t As Integer) If rob(t).mem(fbody) > 100 Then rob(t).mem(fbody) = 100 rob(t).nrg = rob(t).nrg + rob(t).mem(fbody) rob(t).body = rob(t).body - rob(t).mem(fbody) / 10 If rob(t).nrg > 32000 Then rob(t).nrg = 32000 rob(t).Radius = rob(t).body / factor rob(t).mem(fbody) = 0 End Sub
Private Sub robshoot
' here we catch the attempt of a robot to shoot,
' and actually build the shot
Private Sub robshoot(n As Integer)
Dim sh As Integer
Dim va As Long
Dim multiplier As Single
Dim cost As Long
Dim rngmultiplier As Single
Dim valmode As Boolean
sh = rob(n).mem(shoot)
va = rob(n).mem(shootval)
If va < 0 Then
multiplier = 1
rngmultiplier = -va
ElseIf va > 0 Then
multiplier = va
rngmultiplier = 1
valmode = True
Else
multiplier = 1
rngmultiplier = 1
End If
If rngmultiplier > 4 Then
cost = rngmultiplier
rngmultiplier = Log(cost / 2) / Log(2)
ElseIf valmode = False Then
rngmultiplier = 1
cost = (SimOpts.CostChem / (rob(n).Numties + 1))
End If
If multiplier > 4 Then
cost = multiplier
multiplier = Log(cost / 2) / Log(2)
ElseIf valmode = True Then
multiplier = 1
cost = (SimOpts.CostChem / (rob(n).Numties + 1))
End If
If cost > rob(n).nrg And cost > 2 And rob(n).nrg > 2 And valmode Then
cost = rob(n).nrg
multiplier = Log(cost) / Log(2)
End If
If cost > rob(n).nrg And cost > 2 And rob(n).nrg > 2 And Not valmode Then
cost = rob(n).nrg
rngmultiplier = Log(cost) / Log(2)
End If
''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''
If sh > -2 Then
If sh > MaxMem Then sh = sh Mod MaxMem
If sh = -1 Then
If rob(n).Multibot Then
va = 20 + (rob(n).body / 5) * (rob(n).Numties + 1)
Else
va = 20 + (rob(n).body / 5)
End If
va = va * multiplier
rob(n).nrg = rob(n).nrg - cost
Else
rngmultiplier = 1
End If
newshot n, sh, va, rngmultiplier
Else
If sh = -2 Then
va = Abs(va)
If rob(n).nrg < va Then va = rob(n).nrg
If va = 0 Then va = rob(n).nrg / 100 'default energy shot. Very small.
rob(n).nrg = rob(n).nrg - va - SimOpts.CostChem / (rob(n).Numties + 1)
newshot n, sh, va, 1
ElseIf sh = -3 Then 'shoot venom
va = Abs(va)
If va > rob(n).venom Then va = rob(n).venom
If va = 0 Then va = rob(n).venom / 20 'default venom shot. Not too small.
rob(n).venom = rob(n).venom - va
rob(n).mem(825) = rob(n).venom
rob(n).nrg = rob(n).nrg - SimOpts.CostChem / (rob(n).Numties + 1)
newshot n, sh, va, 1
ElseIf sh = -4 Then 'shoot waste
va = Abs(va)
If va > rob(n).Waste Then va = rob(n).Waste
rob(n).Waste = rob(n).Waste - va
If va < 0 Then va = rob(n).Waste / 10 'default waste shot.
rob(n).Pwaste = rob(n).Pwaste + va / 100
rob(n).nrg = rob(n).nrg - SimOpts.CostChem / (rob(n).Numties + 1)
newshot n, sh, va, 1
' no -5 shot here as poison can only be shot in response to an attack
ElseIf sh = -6 Then 'shoot body
If rob(n).Multibot Then
va = 10 + (rob(n).body / 2) * (rob(n).Numties + 1)
Else
va = 10 + Abs(rob(n).body) / 2
End If
rob(n).nrg = rob(n).nrg - cost
va = va * multiplier
newshot n, sh, va, rngmultiplier
End If
End If
rob(n).mem(shoot) = 0
rob(n).mem(shootval) = 0
End Sub
Public Sub shareslime(t As Integer, k As Integer) 'robot shares slime with others in the same multibot structure
Dim totslime As Integer
With rob(t)
If .mem(833) > 99 Then .mem(833) = 99
If .mem(833) < 0 Then .mem(833) = 0
totslime = .Slime + rob(.Ties(k).pnt).Slime
If totslime * (.mem(833) / 100) < 32000 Then
.Slime = totslime * (.mem(833) / 100)
Else
.Slime = 32000
End If
If totslime * ((100 - .mem(833)) / 100) < 32000 Then
rob(.Ties(k).pnt).Slime = totslime * ((100 - .mem(833)) / 100)
Else
rob(.Ties(k).pnt).Slime = 32000
End If
End With
End Sub
Public Sub sharewaste(t As Integer, k As Integer)
Dim totwaste As Long
With rob(t)
If .mem(831) > 99 Then .mem(831) = 99
If .mem(831) < 0 Then .mem(831) = 0
totwaste = .Waste + rob(.Ties(k).pnt).Waste
If totwaste * (.mem(831) / 100) < 32000 Then
.Waste = totwaste * (.mem(831) / 100)
Else
.Waste = 32000
End If
If totwaste * ((100 - .mem(831)) / 100) < 32000 Then
rob(.Ties(k).pnt).Waste = totwaste * ((100 - .mem(831)) / 100)
Else
rob(.Ties(k).pnt).Waste = 32000
End If
End With
End Sub
Public Sub shareshell(t As Integer, k As Integer)
Dim totshell As Long
With rob(t)
If .mem(832) > 99 Then .mem(832) = 99
If .mem(832) < 0 Then .mem(832) = 0
'totshell = .Shell + rob(.Ties(k).pnt).Shell
totshell = .Shell + rob(.Ties(k).pnt).Shell
If totshell * ((100 - .mem(832)) / 100) < 32000 Then
rob(.Ties(k).pnt).Shell = totshell * ((100 - .mem(832)) / 100)
Else
rob(.Ties(k).pnt).Shell = 32000
End If
If totshell * (.mem(832) / 100) < 32000 Then
.Shell = totshell * (.mem(832) / 100)
Else
.Shell = 32000
End If
End With
End Sub
Public Sub sharenrg(t As Integer, k As Integer)
Dim totnrg As Long
With rob(t)
If .mem(830) > 99 Then .mem(830) = 99
If .mem(830) < 0 Then .mem(830) = 0
totnrg = .nrg + rob(.Ties(k).pnt).nrg
If totnrg * ((100 - .mem(830)) / 100) < 32000 Then
rob(.Ties(k).pnt).nrg = totnrg * ((100 - .mem(830)) / 100)
Else
rob(.Ties(k).pnt).nrg = 32000
End If
If totnrg * (.mem(830) / 100) < 32000 Then
.nrg = totnrg * (.mem(830) / 100)
Else
.nrg = 32000
End If
End With
End Sub
Public Sub storevenom
'Robot n converts some of his energy to venom
Public Sub storevenom(n As Integer)
With rob(n)
If .mem(824) > .nrg Then .mem(824) = .nrg / 2
.venom = .venom + .mem(824)
If .mem(824) > 0 Then
.nrg = .nrg - .mem(824)
.Waste = .Waste + .mem(824) / 100
If .venom > 32000 Then .venom = 32000
Else
.Waste = .Waste - .mem(824) / 100
If .venom < 0 Then .venom = 0
End If
.mem(825) = .venom
.mem(824) = 0
End With
End Sub
Public Sub storepoison
' Robot n converts some of his energy to poison
Public Sub storepoison(n As Integer)
With rob(n)
If .mem(826) > .nrg Then .mem(826) = .nrg / 2
.poison = .poison + .mem(826)
If .mem(826) > 0 Then
.nrg = .nrg - .mem(826)
.Waste = .Waste + .mem(826) / 100
If .poison > 32000 Then .poison = 32000
Else
.Waste = .Waste - .mem(826) / 100
If .poison < 0 Then .poison = 0
End If
.mem(827) = .poison
.mem(826) = 0
End With
End Sub
Public Sub Reproduce
' Reproduction
' makes some tests regarding the available space for
' spawning a new robot, the position (not off the field, nor
' on the internet d/l gate), the energy of the parent,
' then finally copies the dna and most of the two data
' structures (with some modif. - for example generation),
' sends the newborn rob to the mutation division,
' reanalizes the resulting dna (usedvars, condlist, and so on)
' ties parent and son, and the miracle of birth is accomplished
Public Sub Reproduce(n As Integer, per As Integer)
Dim sondist As Long
Dim nuovo As Integer
Dim nnrg As Long, nwaste As Long, npwaste As Long
Dim nbody As Integer
Dim nx As Long
Dim ny As Long
Dim t As Integer
Dim tests As Boolean
tests = False
sondist = RobSize * 1.3
If rob(n).Veg = True And totvegs > SimOpts.MaxPopulation Then Exit Sub 'attempt to stop veg overpopulation but will it work?
If n = -1 Then n = robfocus
If per < 1 Then per = 1
If per > 99 Then per = 99
nnrg = (rob(n).nrg / 100) * per
nbody = (rob(n).body / 100) * per
'rob(n).nrg = rob(n).nrg - DNALength(n) * 3
If rob(n).nrg > 0 Then
nx = rob(n).x + absx(rob(n).aim, sondist, 0, 0, 0)
ny = rob(n).Y + absy(rob(n).aim, sondist, 0, 0, 0)
tests = tests Or simplecoll(nx, ny, n)
tests = tests Or (rob(n).Fixed And IsInSpawnArea(nx, ny))
If Not tests Then
nuovo = posto()
SimOpts.TotBorn = SimOpts.TotBorn + 1
ReDim rob(nuovo).DNA(UBound(rob(n).DNA))
For t = 1 To UBound(rob(nuovo).DNA)
rob(nuovo).DNA(t) = rob(n).DNA(t)
Next t
For t = 1 To rob(n).maxusedvars
rob(nuovo).usedvars(t) = rob(n).usedvars(t)
Next t
For t = 0 To 14
rob(nuovo).mutarray(t) = rob(n).mutarray(t)
Next t
rob(nuovo).Mutation = rob(n).Mutation
rob(nuovo).Mutations = rob(n).Mutations
rob(nuovo).LastMut = rob(n).LastMut
rob(nuovo).LastMutDetail = rob(n).LastMutDetail
For t = 0 To 12
rob(nuovo).Skin(t) = rob(n).Skin(t)
Next t
rob(nuovo).maxusedvars = rob(n).maxusedvars
Erase rob(nuovo).mem
Erase rob(nuovo).Ties
rob(nuovo).x = rob(n).x + absx(rob(n).aim, sondist, 0, 0, 0)
rob(nuovo).Y = rob(n).Y + absy(rob(n).aim, sondist, 0, 0, 0)
rob(nuovo).vx = rob(n).vx
rob(nuovo).vy = rob(n).vy
rob(nuovo).color = rob(n).color
rob(nuovo).ox = rob(nuovo).x
rob(nuovo).oy = rob(nuovo).Y
rob(nuovo).aim = rob(n).aim + 3.14
If rob(nuovo).aim > 6.28 Then rob(nuovo).aim = rob(nuovo).aim - 6.28
rob(nuovo).aimx = Cos(rob(nuovo).aim)
rob(nuovo).aimy = Sin(rob(nuovo).aim)
rob(nuovo).mem(setaim) = 32000
rob(nuovo).mem(468) = 32000
rob(nuovo).mem(480) = 32000
rob(nuovo).mem(481) = 32000
rob(nuovo).mem(482) = 32000
rob(nuovo).mem(483) = 32000
rob(nuovo).Exist = True
rob(nuovo).Corpse = False
rob(nuovo).Dead = False
rob(nuovo).generation = rob(n).generation + 1
rob(nuovo).BirthCycle = SimOpts.TotRunCycle
rlist.addrobot nuovo, rob(nuovo).x
rob(nuovo).vnum = 1
rob(nuovo).pntr = 1
rob(nuovo).st.pos = 1
rob(nuovo).view = False
nnrg = (rob(n).nrg / 100) * per
nwaste = rob(n).Waste / 100 * per
npwaste = rob(n).Pwaste / 100 * per
rob(n).nrg = rob(n).nrg - nnrg
rob(n).Waste = rob(n).Waste - nwaste
rob(n).Pwaste = rob(n).Pwaste - npwaste
rob(n).body = rob(n).body - nbody
rob(n).Radius = rob(n).body / factor
rob(nuovo).body = nbody
rob(nuovo).Radius = nbody / factor
rob(nuovo).mass = 1 + nbody / 10000
rob(nuovo).Waste = nwaste
rob(nuovo).Pwaste = npwaste
rob(n).mem(energy) = rob(n).nrg
rob(n).mem(311) = rob(n).body
rob(n).SonNumber = rob(n).SonNumber + 1
rob(nuovo).nrg = nnrg
rob(nuovo).onrg = nnrg
rob(nuovo).mem(energy) = nnrg
rob(nuovo).Poisoned = False
rob(nuovo).Parent = rob(n).AbsNum
rob(nuovo).fname = rob(n).fname
rob(nuovo).LastOwner = rob(n).LastOwner
rob(nuovo).Veg = rob(n).Veg
rob(nuovo).Fixed = rob(n).Fixed
If rob(nuovo).Fixed Then rob(nuovo).mem(216) = 1
rob(nuovo).AbsNum = AbsNum
rob(nuovo).Shape = rob(n).Shape
target n, nuovo, sondist
target nuovo, n, sondist
If rob(n).mem(mrepro) > 0 Then
For t = 0 To 14
rob(nuovo).mutarray(t) = rob(nuovo).mutarray(t) / 10
Next t
mutate nuovo
For t = 0 To 14
If rob(nuovo).mutarray(t) * 10# <= 32000 Then
rob(nuovo).mutarray(t) = rob(nuovo).mutarray(t) * 10
If rob(nuovo).mutarray(t) = 0 Then 'if mrepro then will mutate even if muations are disabled
rob(nuovo).mutarray(t) = 1000
End If
Else
rob(nuovo).mutarray(t) = 32000
End If
Next t
Else
mutate nuovo
End If
If Not CheckIntegrity(rob(nuovo).DNA) Then
'bots are not supposed to die from mutations directly, so don't penalize the parent
rob(n).nrg = rob(n).nrg + rob(nuovo).nrg
rob(n).body = rob(n).body + rob(nuovo).body
rob(nuovo).nrg = 0
End If
makecondlist nuovo
makeoccurrlist nuovo
countconditions nuovo
rob(nuovo).DnaLen = DNALength(nuovo)
maketie n, nuovo, RobSize * 1.3, 100, 0
rob(n).onrg = rob(n).nrg 'saves parent from dying from shock after giving birth
End If
End If
End Sub
Public Sub SexReproduce
' hot hot: sex reproduction
' same as above, but: dna comes from two parents, is crossed-over,
' and the resulting dna is then mutated.
Public Sub SexReproduce(robA As Integer, robB As Integer)
Dim perA As Integer, perB As Integer
Dim nrgA As Long, nrgB As Long
Dim bodyA As Long, bodyB As Long
Dim sondist As Long
Dim nuovo As Integer
Dim nnrg As Long
Dim nbody As Long
Dim nx As Long
Dim ny As Long
Dim t As Integer
Dim tests As Boolean
tests = False
sondist = RobSize * 1.3
If Sqr((rob(robA).x - rob(robB).x) ^ 2 + (rob(robA).Y - rob(robB).Y) ^ 2) <= RobSize * 2 Then Exit Sub
perA = rob(robA).mem(sexrepro)
perB = rob(robB).mem(sexrepro)
If perA < 1 Then perA = 1
If perA > 99 Then perA = 99
If perB < 1 Then perB = 1
If perB > 99 Then perB = 99
nrgA = (rob(robA).nrg / 100) * perA
nrgB = (rob(robB).nrg / 100) * perB
nnrg = nrgA + nrgB
If nnrg > 32000 Then
nnrg = 32000
nrgA = 32000 * (perA / 100)
nrgB = 32000 * (perB / 100)
End If
bodyA = (rob(robA).body / 100) * perA
bodyB = (rob(robB).body / 100) * perB
nbody = bodyA + bodyB
If nbody > 32000 Then
nbody = 32000
bodyA = 32000 * (perA / 100)
bodyB = 32000 * (perB / 100)
End If
rob(perA).nrg = rob(perA).nrg - rob(robA).DnaLen * 1.5
rob(perB).nrg = rob(perB).nrg - rob(robB).DnaLen * 1.5
If rob(perA).nrg > 0 And rob(perB).nrg > 0 Then
nx = rob(perA).x + absx(rob(perA).aim, sondist, 0, 0, 0)
ny = rob(perA).Y + absy(rob(perA).aim, sondist, 0, 0, 0)
'tests = tests Or simplecoll(nx, ny, n)
tests = tests Or (rob(robA).Fixed And IsInSpawnArea(nx, ny))
If Not tests Then
nuovo = posto()
SimOpts.TotBorn = SimOpts.TotBorn + 1
ReDim rob(nuovo).DNA(100)
'DNA is redimed inside a sub function of CrossingOver
CrossingOver rob(robA).DNA, rob(robB).DNA, rob(nuovo).DNA
ScanUsedVars nuovo
For t = 0 To 14
rob(nuovo).mutarray(t) = (rob(robA).mutarray(t) + rob(robB).mutarray(t)) / 2
Next t
If rob(robA).Mutation Or rob(robB).Mutation Then
rob(nuovo).Mutation = True
Else
rob(nuovo).Mutation = False
End If
rob(nuovo).Mutations = rob(robA).Mutations / 2 + rob(robB).Mutations / 2
For t = 0 To 12
rob(nuovo).Skin(t) = (rob(robA).Skin(t) + rob(robB).Skin(t)) / 2
Next t
'rob(nuovo).maxusedvars = rob(n).maxusedvars
Erase rob(nuovo).mem
Erase rob(nuovo).Ties
rob(nuovo).x = rob(robA).x + absx(rob(robA).aim, sondist, 0, 0, 0)
rob(nuovo).Y = rob(robA).Y + absy(rob(robA).aim, sondist, 0, 0, 0)
rob(nuovo).vx = rob(robA).vx
rob(nuovo).vy = rob(robA).vy
rob(nuovo).color = rob(robA).color
rob(nuovo).ox = rob(nuovo).x
rob(nuovo).oy = rob(nuovo).Y
rob(nuovo).aim = rob(robA).aim + 3.14
If rob(nuovo).aim > 6.28 Then rob(nuovo).aim = rob(nuovo).aim - 6.28
rob(nuovo).aimx = Cos(rob(nuovo).aim)
rob(nuovo).aimy = Sin(rob(nuovo).aim)
rob(nuovo).mem(setaim) = 32000
rob(nuovo).mem(468) = 32000
rob(nuovo).mem(480) = 32000
rob(nuovo).mem(481) = 32000
rob(nuovo).mem(482) = 32000
rob(nuovo).mem(483) = 32000
rob(nuovo).Exist = True
rob(nuovo).Dead = False
rob(nuovo).generation = rob(robA).generation + 1
rob(nuovo).BirthCycle = SimOpts.TotRunCycle
rlist.addrobot nuovo, rob(nuovo).x
rob(nuovo).vnum = 1
rob(nuovo).pntr = 1
rob(nuovo).st.pos = 1
rob(nuovo).view = False
'nnrg = (rob(n).nrg / 100) * per
rob(robA).nrg = rob(robA).nrg - nrgA
rob(robB).nrg = rob(robB).nrg - nrgB
rob(robA).mem(energy) = rob(robA).nrg
rob(robB).mem(energy) = rob(robB).nrg
rob(robA).body = rob(robA).body - bodyA
rob(robA).Radius = rob(robA).body / factor
rob(robB).body = rob(robB).body - bodyB
rob(robB).Radius = rob(robB).body / factor
rob(robA).mem(315) = rob(robA).body
rob(robB).mem(315) = rob(robB).body
rob(robA).SonNumber = rob(robA).SonNumber + 1
rob(robB).SonNumber = rob(robB).SonNumber + 1
rob(nuovo).nrg = nnrg
rob(nuovo).body = nbody
rob(nuovo).Radius = rob(nuovo).body / factor
rob(nuovo).Poisoned = False
rob(nuovo).mass = 1 + nbody / 10000
rob(nuovo).Parent = rob(robA).AbsNum
rob(nuovo).fname = rob(robA).fname
rob(nuovo).LastOwner = rob(robA).LastOwner
rob(nuovo).Veg = rob(robA).Veg
rob(nuovo).Fixed = rob(robA).Fixed
If rob(nuovo).Fixed Then rob(nuovo).mem(216) = 1
rob(nuovo).Corpse = False
rob(nuovo).AbsNum = AbsNum
rob(nuovo).Shape = rob(robA).Shape
target robB, nuovo, sondist
target robA, nuovo, sondist
target nuovo, robA, sondist
target nuovo, robB, sondist
mutate nuovo
If Not CheckIntegrity(rob(nuovo).DNA) Then
'parents aren't suposed to be penalized,
'so they need to get their nrg and body back
'NOT YET IMPLEMENTED!
rob(nuovo).nrg = 0
End If
makecondlist nuovo
makeoccurrlist nuovo
countconditions nuovo
rob(nuovo).DnaLen = DNALength(nuovo)
maketie robA, nuovo, RobSize * 1.3, 90, 0
maketie robB, nuovo, RobSize * 1.3, 90, 0
'maincaption
rob(robA).onrg = rob(robA).nrg
rob(robB).onrg = rob(robB).nrg
End If
End If
End Sub
Public Function simplecoll
' verifies rapidly if a field position is already occupied
Public Function simplecoll(x As Long, Y As Long, k As Integer) As Boolean
Dim t As Integer
Dim Radius As Long
simplecoll = False
For t = 1 To MaxRobs
If rob(t).Exist Then
If Abs(rob(t).x - x) < RobSize And Abs(rob(t).Y - Y) < RobSize Then
If k <> t Then simplecoll = True
End If
End If
Next t
If SimOpts.Dxsxconnected = True Then
If x < 0 Or x + RobSize > SimOpts.FieldWidth Then simplecoll = True
End If
If SimOpts.Updnconnected = True Then
If Y < 0 Or Y + RobSize > SimOpts.FieldHeight Then simplecoll = True
End If
End Function
Public Function posto
' searches a free slot in the robots array, to store a new rob
' you may have noticed that the system is hybrid, there's
' a (quadruple) linked list and the array
Public Function posto() As Integer
Dim t As Integer
t = 1
While rob(t).Exist And t <= MaxRobs And t < UBound(rob())
t = t + 1
Wend
If t > MaxRobs Then
rob(t + 1).x = maxfieldsize
MaxRobs = t
End If
If t = UBound(rob()) Then
MaxRobs = MaxRobs - 1
t = t - 1
End If
posto = t
rob(0).x = -4000
AbsNum = AbsNum + 1
rob(posto).AbsNum = AbsNum
'So there's no chance of inheritance from older bots who left this position open
rob(posto).absvel = 0
rob(posto).age = 0
rob(posto).aim = 0
rob(posto).aimx = 1
rob(posto).aimy = 0
rob(posto).ax = 0
rob(posto).ay = 0
rob(posto).BirthCycle = 0 'or the current cycle, whichever
rob(posto).body = 0
rob(posto).Bouyancy = 0
rob(posto).color = 0
Erase rob(posto).condlist()
rob(posto).condnum = 0
rob(posto).Corpse = False
rob(posto).Dead = False
rob(posto).DecayTimer = 0
ReDim rob(posto).DNA(1)
rob(posto).DNA(1).tipo = 4: rob(posto).DNA(1).value = 4
rob(posto).DnaLen = 1
rob(posto).envx = 0
rob(posto).envy = 0
rob(posto).Exist = False
rob(posto).Fixed = False
rob(posto).fname = ""
rob(posto).genenum = 0
rob(posto).generation = 0
rob(posto).highlight = False
rob(posto).kills = 0
rob(posto).LastMut = 0
rob(posto).LastMutDetail = ""
rob(posto).lastopp = 0
rob(posto).LastOwner = ""
rob(posto).lastviewed = 0
rob(posto).ma = 0
rob(posto).mass = 0
rob(posto).maxusedvars = 0
Erase rob(posto).mem()
rob(posto).mt = 0
rob(posto).Multibot = False
Erase rob(posto).mutarray()
rob(posto).Mutation = False
rob(posto).Mutations = 0
rob(posto).nrg = 0
rob(posto).Numties = 0
rob(posto).oaim = 0
rob(posto).obody = 0
Erase rob(posto).occurr()
rob(posto).onrg = 0
rob(posto).order = 0
Erase rob(posto).OSkin()
rob(posto).ox = 0
rob(posto).oy = 0
rob(posto).Paracount = 0
rob(posto).Paralyzed = False
rob(posto).Parent = 0
rob(posto).Ploc = 0
rob(posto).pntr = 0
rob(posto).poison = 0
rob(posto).Poisoncount = 0
rob(posto).Poisoned = False
rob(posto).Pwaste = 0
rob(posto).Radius = 0
rob(posto).Shape = 0
rob(posto).Shell = 0
Erase rob(posto).Skin()
rob(posto).Slime = 0
rob(posto).SonNumber = 0
'rob(posto).st
Erase rob(posto).Ties()
Erase rob(posto).usedvars()
Erase rob(posto).vars()
rob(posto).vbody = 0
rob(posto).Veg = False
rob(posto).venom = 0
rob(posto).view = False
rob(posto).Vloc = 0
rob(posto).vnum = 0
rob(posto).Vtimer = 0
rob(posto).Vval = 0
rob(posto).vx = 0
rob(posto).vy = 0
rob(posto).Wall = False
rob(posto).Waste = 0
rob(posto).x = 0
rob(posto).Y = 0
End Function
Public Sub KillRobot
' Kill Bill
Public Sub KillRobot(n As Integer)
If n = -1 Then n = robfocus
If SimOpts.DBEnable Then
If rob(n).Veg And SimOpts.DBExcludeVegs Then
Else
AddRecord n
End If
End If
'If n = MaxRobs Then MaxRobs = MaxRobs - 1
rob(n).Exist = False
rob(n).Wall = False
rob(n).Fixed = False
rob(n).Veg = False
rob(n).LastOwner = ""
rob(n).SonNumber = 0
rob(n).age = 0
rlist.delrobot rlist.searchrob(n)
delallties n
If Not MDIForm1.nopoff Then makepoff n
End Sub
