Leagues
From WikiManual
Code/Debugging/Fixes/Changes for Leagues
see also: DeBugging and Bug_Reports
this is a Work In Progress
- Holy crap!!!
- League code is all over the place!
- Will just keep stashing it here as i find it.
Contents
General Declarations
General Declarations Public Type datispecie Skin(13) As Integer path As String Name As String Stnrg As Integer Veg As Boolean Fixed As Boolean color As Long Colind As Integer Postp As Single Poslf As Single Posdn As Single Posrg As Single qty As Integer Comment As String Leaguefilecomment As String Mutables As mutationprobs CantSee As Boolean ' Flag indicating eyes should be turned off for this species DisableDNA As Boolean ' Flag indicating DNA should not execute for this species DisableMovementSysvars As Boolean ' Flag indicating movement sysvars should be disabled for this species CantReproduce As Boolean ' Flag indicating whether reproduction has been disabled for this species. End Type
General Declarations 'For League mode: (runs a series of F1 contests, 1 on 1) Public LeagueMode As Boolean Public Leaguename As String Public Leaguererun As Boolean Public LeagueEntrants(30) As datispecie 'all those already in the league Public numLeagueEntrants As Integer Public LeagueChallengers(31) As datispecie 'all those challenging (31 instead of 30 for some loop functions) Public Defender As Integer 'couple used to determine which bots are facing which in League mode Public Attacker As Integer Private eye11 As Integer 'for eye fudging. Search 'fudge' to see what I mean
General Startsim
General
Startsim
If LeagueMode Then
LeagueForm.Show
SimOpts.TotRunCycle = -1
End If
General StartSimul
General
StartSimul
'Restart
'Leaguemode handles restarts differently so only restart here if not in
leaguemode
If totnvegs = 0 And RestartMode And Not LeagueMode Then
' totnvegs = 1
' Contests = Contests + 1
ReStarts = ReStarts + 1
' Form1.StartSimul
StartAnotherRound = True
End If
End Sub
General FindSpecies
General
FindSpecies
If TotSpecies = 1 Then
' If Not LeagueMode Then
ContestMode = False
MDIForm1.F1Piccy.Visible = False
Contest_Form.Visible = False
t = MsgBox("You have only selected one species for combat. Formula 1
mode disabled", vbOKOnly)
Exit Sub
' End If
End If
MDIForm
MDIForm1 (Code) Private Sub Leagues_Click() optionsform.SSTab1.Tab = 4 NetEvent.Timer1.Enabled = False NetEvent.Hide optionsform.Show vbModal End Sub
RerunCheck
RerunCheck Private Sub RerunCheck_Click() Leaguererun = CBool(RerunCheck.value) End Sub
LeagueCheck
LeagueCheck
Private Sub LeagueCheck_Click()
If LeagueCheck.value = 1 Then
If F1Check.value <> 1 Then
F1Check.value = 1
F1check_Click
End If
LeagueMode = True
TmpOpts.League = True
If Leaguetype(0).value = False Then
Leaguetype(0).value = True
End If
Else
TmpOpts.League = False
LeagueMode = False
'Leaguetype(0).value = False
End If
End Sub
Private Sub LeagueAutoCheck()
If LeagueCheck.value <> 1 Then
LeagueCheck.value = 1
LeagueCheck_Click
End If
End Sub
Private Sub LeagueF1Option_Click()
Leaguename.text = "F1"
LeagueAutoCheck
End Sub
Private Sub LeagueF2Option_Click()
Leaguename.text = "F2"
LeagueAutoCheck
End Sub
Private Sub LeageSBOption_Click()
Leaguename.text = "Shortbot"
LeagueAutoCheck
End Sub
Private Sub LeagueMBOption_Click()
Leaguename.text = "Multibot"
LeagueAutoCheck
End Sub
Private Sub Leaguetype_Click(Index As Integer)
'If Leaguetype(Index).value = False Then
'' Leaguetype(Index).value = True
'End If
End Sub
Private Sub LightText_lostfocus()
Dim a As Single
a = val(LightText.text)
If a < LightUpDn.Min Then a = LightUpDn.Min
If a > LightUpDn.Max Then a = LightUpDn.Max
LightUpDn.value = a
TmpOpts.LightIntensity = a
End Sub
StartNew
StartNew
If LeagueMode = True Then LeagueForm.Visible = True ' EricL 3/20/2006 Have
to bring up league form after Options dialog goes away
'Form1.Active = True
'this just tricks the program into thinking we have enough
'species for F1 mode.
'If TmpOpts.League = True And TmpOpts.SpeciesNum = 2 Then
' additem TmpOpts.Specie(1).Name
' TmpOpts.SpeciesNum = TmpOpts.SpeciesNum + 1
'End If
SimOpts = TmpOpts
If SimOpts.League = True Then
LeagueMode = True 'should be anyway, but sometimes when
'restarting a league it screws up
LeagueInputChallengers
SetupLeague_Options
' SimOpts.F1 = True
LeagueForm.F1ChallengeOption_Click
End If
If Form1.Active Then Form1.SecTimer.Enabled = True
StartAnotherRound = True ' Set true for first simulation. Will get set true if
running leagues or using auto-restart mode
While StartAnotherRound
StartAnotherRound = False
Form1.StartSimul
Wend
End Sub
F1 Override code as of 2.42.n
(not sure in what modual this is in. Griztalk)
- Eric: I will add max cycles / Max rounds to my list of future work items.
- These will be post 2.43 however.
If TmpOpts.F1 = True Then 'Zero out all Costs For t = 1 To 70 TmpOpts.Costs(t) = 0 Next t 'Now set the ones that matter TmpOpts.Costs(SHOTCOST) = 2 TmpOpts.Costs(COSTSTORE) = 0.04 TmpOpts.Costs(CONDCOST) = 0.004 TmpOpts.Costs(MOVECOST) = 0.05 TmpOpts.Costs(TIECOST) = 2 TmpOpts.Costs(SHOTCOST) = 2 TmpOpts.Costs(VENOMCOST) = 1 TmpOpts.Costs(POISONCOST) = 1 TmpOpts.Costs(SLIMECOST) = 1 TmpOpts.Costs(SHELLCOST) = 1 TmpOpts.Costs(COSTMULTIPLIER) = 1 TmpOpts.DynamicCosts = False TmpOpts.CorpseEnabled = False ' No Corpses TmpOpts.DayNight = False ' Sun never sets TmpOpts.FieldWidth = 9237 TmpOpts.FieldHeight = 6928 TmpOpts.FieldSize = 1 TmpOpts.MaxEnergy = 40 ' Veggy nrg per cycle TmpOpts.MaxPopulation = 25 ' Veggy max population TmpOpts.MinVegs = 10 TmpOpts.Pondmode = False TmpOpts.PhysBrown = 0 ' Animal Motion TmpOpts.Toroidal = True TmpOpts.BadWastelevel = 10000 ' Pretty high Waste Threshold For t = 0 To TmpOpts.SpeciesNum - 1 TmpOpts.Specie(t).Fixed = False 'Nobody is fixed TmpOpts.Specie(t).Mutables.Mutations = False 'Nobody can mutate TmpOpts.Specie(t).CantSee = False TmpOpts.Specie(t).DisableDNA = False TmpOpts.Specie(t).CantReproduce = False TmpOpts.Specie(t).DisableMovementSysvars = False Next t TmpOpts.Specie(0).Veg = True 'Force the first entry to be a veggy TmpOpts.Specie(0).qty = 10 ' Do this so that eye fudge works TmpOpts.FixedBotRadii = False TmpOpts.NoShotDecay = False TmpOpts.DisableTies = False TmpOpts.RepopAmount = 10 TmpOpts.RepopCooldown = 1 TmpOpts.MaxVelocity = 180 TmpOpts.VegFeedingMethod = 0 ' Straight nrg /cycle feeding method TmpOpts.VegFeedingToBody = 0.5 ' 50/50 nrg/body veggy feeding ratio TmpOpts.SunUp = False ' Turn off bringing the sun up due to a threshold TmpOpts.SunDown = False ' Turn off setting the sun due to a threshold TmpOpts.CoefficientElasticity = 0 ' Collisions are soft. TmpOpts.Ygravity = 0 ' Surface Friction - Metal Option TmpOpts.Zgravity = 2 TmpOpts.CoefficientStatic = 0.6 TmpOpts.CoefficientKinetic = 0.4 'No Fluid Resistance TmpOpts.Viscosity = 0# TmpOpts.Density = 0# 'Shot Energy Physics TmpOpts.EnergyProp = 1 ' 100% normal shot nrg TmpOpts.EnergyExType = True ' Use Proportional shot nrg exchange method DispSettings End If
F1 Mode
- well ... was hoping to find a way to make Max Rounds actually
- be max rounds but i can't make any sense of this.
- maybe somebody can point me to that?
- or add more comments to the below so i can might
- be able to get a grip on the flow here.
- that would be appreciated. Griztalk 18:33, 25 Dec 2006 (MST)
F1Mode modual
Option Explicit
Public Type pop
SpName As String
Population As Integer
Wins As Integer
exist As Integer
End Type
'For F1 Contests:
Public PopArray(20) As pop
Public F1count As Single
Public ContestMode As Boolean
Public Contests As Integer
Public TotSpecies As Integer
Public Maxrounds As Integer
Public RestartMode As Boolean
Public ReStarts As Long
Public FirstCycle As Boolean
Public SampFreq As Integer
Public Over As Boolean
Public MaxRoundsToDraw As Integer
Public MaxCycles As Long
'For League mode: (runs a series of F1 contests, 1 on 1)
Public LeagueMode As Boolean
Public Leaguename As String
Public Leaguererun As Boolean
Public LeagueEntrants(30) As datispecie 'all those already in the league
Public numLeagueEntrants As Integer
Public LeagueChallengers(31) As datispecie 'all those challenging (31 instead of 30 for some loop functions)
Public Defender As Integer 'couple used to determine which bots are facing which in League mode
Public Attacker As Integer
Private eye11 As Integer 'for eye fudging. Search 'fudge' to see what I mean
Public StartAnotherRound As Boolean
Public Sub ResetContest()
Dim t As Integer
Contests = 0
Contest_Form.Winner.Caption = ""
Contest_Form.Winner1.Caption = ""
For t = 1 To 5
PopArray(t).SpName = ""
PopArray(t).Population = 0
PopArray(t).Wins = 0
Next t
End Sub
Public Sub FindSpecies()
'counts species of robots at beginning of simulation
Dim SpeciePointer As Integer
Dim t As Integer
Dim nd As node
Dim robcol(10) As Long
Dim realname As String
TotSpecies = 0
If Contests = 0 Then ResetContest
For t = 1 To 20
PopArray(t).SpName = ""
PopArray(t).Population = 0
'If Contests = 0 Then PopArray(t).Wins = 0
Next t
Contest_Form.Show
Contest_Form.Contests.Caption = Str(Contests)
For t = 1 To MaxRobs
With rob(t)
'If Not .Veg And Not .Corpse And Not .wall And .exist Then
If Not .Veg And Not .Corpse And .exist Then
For SpeciePointer = 1 To 20
realname = Left(.FName, Len(.FName) - 4)
If realname = PopArray(SpeciePointer).SpName Then
PopArray(SpeciePointer).Population = PopArray(SpeciePointer).Population + 1
Exit For
End If
If PopArray(SpeciePointer).SpName = "" Then
TotSpecies = TotSpecies + 1
PopArray(SpeciePointer).SpName = realname
PopArray(SpeciePointer).Population = PopArray(SpeciePointer).Population + 1
robcol(SpeciePointer) = .color
Exit For
End If
Next SpeciePointer
End If
End With
Next t
If TotSpecies = 1 Then
' If Not LeagueMode Then
ContestMode = False
MDIForm1.F1Piccy.Visible = False
Contest_Form.Visible = False
t = MsgBox("You have only selected one species for combat. Formula 1 mode disabled", vbOKOnly)
Exit Sub
' End If
End If
If PopArray(1).SpName <> "" Then
Contest_Form.Robname1.Caption = PopArray(1).SpName
Contest_Form.wins1.Caption = Str(PopArray(1).Wins)
Contest_Form.Pop1.Caption = Str(PopArray(1).Population)
Contest_Form.Robname1.ForeColor = robcol(1)
Contest_Form.Option1(1).Visible = True
Else
Contest_Form.Robname1.Caption = ""
Contest_Form.wins1.Caption = ""
Contest_Form.Pop1.Caption = ""
Contest_Form.Option1(1).Visible = False
End If
If PopArray(2).SpName <> "" Then
Contest_Form.Robname2.Caption = PopArray(2).SpName
Contest_Form.Wins2.Caption = Str(PopArray(2).Wins)
Contest_Form.Pop2.Caption = Str(PopArray(2).Population)
Contest_Form.Robname2.ForeColor = robcol(2)
Contest_Form.Option1(2).Visible = True
Else
Contest_Form.Robname2.Caption = ""
Contest_Form.Wins2.Caption = ""
Contest_Form.Pop2.Caption = ""
Contest_Form.Option1(2).Visible = False
End If
If PopArray(3).SpName <> "" Then
Contest_Form.Robname3.Caption = PopArray(3).SpName
Contest_Form.Wins3.Caption = Str(PopArray(3).Wins)
Contest_Form.Pop3.Caption = Str(PopArray(3).Population)
Contest_Form.Robname3.ForeColor = robcol(3)
Contest_Form.Option1(3).Visible = True
Else
Contest_Form.Robname3.Caption = ""
Contest_Form.Wins3.Caption = ""
Contest_Form.Pop3.Caption = ""
Contest_Form.Option1(3).Visible = False
End If
If PopArray(4).SpName <> "" Then
Contest_Form.Robname4.Caption = PopArray(4).SpName
Contest_Form.Wins4.Caption = Str(PopArray(4).Wins)
Contest_Form.Pop4.Caption = Str(PopArray(4).Population)
Contest_Form.Robname4.ForeColor = robcol(4)
Contest_Form.Option1(4).Visible = True
Else
Contest_Form.Robname4.Caption = ""
Contest_Form.Wins4.Caption = ""
Contest_Form.Pop4.Caption = ""
Contest_Form.Option1(4).Visible = False
End If
If PopArray(5).SpName <> "" Then
Contest_Form.Robname5.Caption = PopArray(5).SpName
Contest_Form.Wins5.Caption = Str(PopArray(5).Wins)
Contest_Form.Pop5.Caption = Str(PopArray(5).Population)
Contest_Form.Robname5.ForeColor = robcol(5)
Contest_Form.Option1(5).Visible = True
Else
Contest_Form.Robname5.Caption = ""
Contest_Form.Wins5.Caption = ""
Contest_Form.Pop5.Caption = ""
Contest_Form.Option1(5).Visible = False
End If
If ContestMode Then
Contest_Form.Visible = True
'Contests = 0
End If
End Sub
Public Sub Countpop()
'counts population of robots at regular intervals
'for auto-combat mode and for automatic reset of starting conditions
Dim SpeciePointer As Integer
Dim SpeciesLeft As Integer
Dim t As Integer
Dim p As Integer
Dim nd As node
Dim Winner As String
Dim Wins As Single
Dim realname As String
For t = 1 To 20
PopArray(t).Population = 0
PopArray(t).exist = 0
Next t
For t = 1 To MaxRobs
With rob(t)
'If Not .Veg And Not .Corpse And Not .wall And .exist Then
If Not .Veg And Not .Corpse And .exist Then
For SpeciePointer = 1 To TotSpecies
realname = Left(.FName, Len(.FName) - 4)
If realname = PopArray(SpeciePointer).SpName Then
PopArray(SpeciePointer).Population = PopArray(SpeciePointer).Population + 1
PopArray(SpeciePointer).exist = 1
Exit For
End If
Next SpeciePointer
End If
End With
Next t
If Contests < Maxrounds Then
Contest_Form.Contests.Caption = Contests + 1
End If
Contest_Form.Maxrounds.Caption = Maxrounds
Contest_Form.Refresh
SpeciesLeft = 0
For p = 1 To TotSpecies
SpeciesLeft = SpeciesLeft + PopArray(p).exist
Next p
If SpeciesLeft = 1 And Contests + 1 <= Maxrounds And Over = False Then
For t = 1 To TotSpecies
If PopArray(t).Population <> 0 Then
PopArray(t).Wins = PopArray(t).Wins + 1
End If
Next t
End If
Contest_Form.Visible = True
If PopArray(1).SpName <> "" Then
Contest_Form.Robname1.Caption = PopArray(1).SpName
Contest_Form.wins1.Caption = Str(PopArray(1).Wins)
Contest_Form.Pop1.Caption = Str(PopArray(1).Population)
Else
Contest_Form.Robname1.Caption = ""
Contest_Form.wins1.Caption = ""
Contest_Form.Pop1.Caption = ""
End If
If PopArray(2).SpName <> "" Then
Contest_Form.Robname2.Caption = PopArray(2).SpName
Contest_Form.Wins2.Caption = Str(PopArray(2).Wins)
Contest_Form.Pop2.Caption = Str(PopArray(2).Population)
Else
Contest_Form.Robname2.Caption = ""
Contest_Form.Wins2.Caption = ""
Contest_Form.Pop2.Caption = ""
End If
If PopArray(3).SpName <> "" Then
Contest_Form.Robname3.Caption = PopArray(3).SpName
Contest_Form.Wins3.Caption = Str(PopArray(3).Wins)
Contest_Form.Pop3.Caption = Str(PopArray(3).Population)
Else
Contest_Form.Robname3.Caption = ""
Contest_Form.Wins3.Caption = ""
Contest_Form.Pop3.Caption = ""
End If
If PopArray(4).SpName <> "" Then
Contest_Form.Robname4.Caption = PopArray(4).SpName
Contest_Form.Wins4.Caption = Str(PopArray(4).Wins)
Contest_Form.Pop4.Caption = Str(PopArray(4).Population)
Else
Contest_Form.Robname4.Caption = ""
Contest_Form.Wins4.Caption = ""
Contest_Form.Pop4.Caption = ""
End If
If PopArray(5).SpName <> "" Then
Contest_Form.Robname5.Caption = PopArray(5).SpName
Contest_Form.Wins5.Caption = Str(PopArray(5).Wins)
Contest_Form.Pop5.Caption = Str(PopArray(5).Population)
Else
Contest_Form.Robname5.Caption = ""
Contest_Form.Wins5.Caption = ""
Contest_Form.Pop5.Caption = ""
End If
Contest_Form.Refresh
F1count = 0
Wins = Sqr(Maxrounds) + (Maxrounds / 2)
If SpeciesLeft = 1 And Contests + 1 <= Maxrounds Then
If Contests + 1 = Maxrounds And Over = False Then 'contest is over now
For t = 1 To TotSpecies
If PopArray(t).Wins > Wins Then
Winner = PopArray(t).SpName
Over = True
'set up next league round
If LeagueMode Then
If Winner + ".txt" = LeagueEntrants(Defender).Name Then
'attacker lost, move to next challenger
Attacker = -1
Defender = 29
LeagueEnd
ElseIf Attacker < 0 Then
'attacker won. He was in the challenge array, move him to the
'league array and the bot he defeated to the challenge array
'This defeated bot will have another chance to get back into the
'league later.
If Winner + ".txt" = LeagueChallengers(-Attacker - 1).Name Then
Dim temp As datispecie
temp = LeagueChallengers(-Attacker - 1)
If LeagueEntrants(Defender).Name <> "EMPTY.TXT" And LeagueEntrants(Defender).Name <> "" Then
LeagueChallengers(-Attacker - 1) = LeagueEntrants(Defender)
LeagueEntrants(Defender) = temp
End If
Attacker = Defender
Defender = Defender - 1
End If
ElseIf Attacker > 0 Then
If Winner + ".txt" = LeagueEntrants(Attacker).Name Then
'attacker won, he was in the league already, swap with defender
Dim tempa As datispecie
tempa = LeagueEntrants(Attacker)
LeagueEntrants(Attacker) = LeagueEntrants(Defender)
LeagueEntrants(Defender) = tempa
Attacker = Defender
Defender = Defender - 1
End If
Else
MsgBox "Unknown Winner. Poor programmer to blame.", vbOKOnly, "Get a Real Job"
End If
If Defender = -1 Then
'that's it, we've hit the top. Congrats, start the next round
Attacker = -1
Defender = 29
If LeagueChallengers(0).Name = "" Then LeagueEnd
End If
Contests = 0
ReStarts = 0
ResetContest
Maxrounds = 5
LeagueForm.Erase_League_Highlights
If Form1.Active = True Then SetupLeagueRound
'update on screen list
If LeagueForm.F1ChallengeOption.value = True Then
LeagueForm.F1ChallengeOption_Click
Else
LeagueForm.ChallengersOption_Click
End If
If Form1.Active = True Then 'Form1.StartSimul
StartAnotherRound = True
Else
StartAnotherRound = False
End If
End If
Contest_Form.Refresh
Exit Sub
Else
Winner = "Statistical Draw. Extending contest."
End If
Next t
Contest_Form.Winner.Caption = Winner
If Winner <> "Statistical Draw. Extending contest." Then
Contest_Form.Winner1.Caption = "Winner"
Else
Maxrounds = Maxrounds + 1
If MaxRoundsToDraw <> 0 And Maxrounds >= 10 And Maxrounds > MaxRoundsToDraw Then
Contest_Form.Winner1.Caption = "Win By Draw"
Winner = "Maximum Rounds Reached."
Contest_Form.Refresh
Over = True
'Declare Defender to have won
Attacker = -1
Defender = 29
LeagueEnd
Contests = 0
ReStarts = 0
ResetContest
Maxrounds = 5
LeagueForm.Erase_League_Highlights
If Form1.Active = True Then SetupLeagueRound
'update on screen list
If LeagueForm.F1ChallengeOption.value = True Then
LeagueForm.F1ChallengeOption_Click
Else
LeagueForm.ChallengersOption_Click
End If
If Form1.Active = True Then 'Form1.StartSimul
StartAnotherRound = True
Else
StartAnotherRound = False
End If
Contest_Form.Refresh
Exit Sub
Else
Contest_Form.Winner1.Caption = "No Winner"
Over = False
End If
End If
End If
Contest_Form.Refresh
If Contests + 1 <= Maxrounds And Over = False Then
Contests = Contests + 1
StartAnotherRound = True
'Form1.StartSimul
Else
StartAnotherRound = False
End If
End If
End Sub
Public Sub SetupLeague_Options()
If optionsform.Leaguename.text <> "" And LeagueMode Then
Dim LeagueError As Integer
F1Mode.Leaguename = optionsform.Leaguename.text
LeagueError = Load_League_File(F1Mode.Leaguename)
If LeagueError = -1 Then
If MsgBox("League file does not exist. Make a new one?", vbYesNo, "League Undetected") = vbNo Then
Exit Sub
Else
'make a new league file and directory.
'does this automatically when user hits save after
'league runs.
End If
ElseIf LeagueError > 0 Then
If MsgBox("A robot listed doesn't exist. Delete from league table?", vbYesNo, "League Robot Not Found") = vbNo Then
Exit Sub
Else
'delete robot leaguerror from league table
End If
End If
LeagueForm.F1ChallengeOption.Caption = optionsform.Leaguename.text + " Challenge League"
'LeagueForm.Visible = True ' EricL 3/20/2006 Moved this to StartNew_Click in the Options Form
ElseIf optionsform.Leaguename.text = "" And LeagueMode Then
MsgBox "No league name. League must have a name.", vbOKOnly, "League Name Needed"
Exit Sub
ElseIf LeagueMode = False Then
LeagueForm.Visible = False
End If
Attacker = -1
Defender = 29
If Leaguererun = True Then
Dim Index As Integer
Dim numLeagueEntrants As Integer
numLeagueEntrants = 0
For Index = 0 To 29
If LeagueEntrants(Index).Name <> "" And LeagueEntrants(Index).Name <> "EMPTY" Then
numLeagueEntrants = numLeagueEntrants + 1
End If
Next Index
If numLeagueEntrants <= 1 Then
MsgBox "Can't rerun league. Not enough league entrants."
Leaguererun = False
optionsform.RerunCheck.value = 0
Else
For Index = 0 To 29
LeagueChallengers(Index) = LeagueEntrants(Index)
LeagueEntrants(Index).Name = ""
Next Index
End If
End If
SetupLeagueRound
End Sub
Public Sub LeagueInputChallengers()
Dim Index As Integer
Dim offset As Integer
Dim blank As datispecie
For Index = 0 To SimOpts.SpeciesNum - 1
If SimOpts.Specie(Index).Veg = True Then
offset = offset + 1
Else
LeagueChallengers(Index - offset) = SimOpts.Specie(Index)
If Index > 2 Then SimOpts.Specie(Index) = blank
LeagueChallengers(Index - offset).Mutables.Mutations = False
End If
If Index - offset > 29 Then
MsgBox "Not enough challenger slots to accomodate so many. Only running the first 30 bots.", vbOKOnly, "Too Many Challengers"
Exit Sub
End If
Next Index
End Sub
Public Sub SetupLeagueRound()
Dim attackerfound As Boolean
Dim defenderfound As Boolean
Dim loopdone As Boolean
SimOpts.SpeciesNum = 3
'SimOpts.Specie(0) = veg spot
While Not loopdone
DoEvents
If Attacker < 0 And Not attackerfound Then
SimOpts.Specie(1) = LeagueChallengers(-Attacker - 1)
ElseIf Attacker > 0 And Not attackerfound Then
SimOpts.Specie(1) = LeagueEntrants(Attacker)
End If
If Not defenderfound Then
SimOpts.Specie(2) = LeagueEntrants(Defender)
SimOpts.Specie(2).Posrg = SimOpts.Specie(1).Posrg
SimOpts.Specie(2).Posdn = SimOpts.Specie(1).Posdn
End If
'check to see if attacker and defender are the same
'if so, then prompt the user for action
If SimOpts.Specie(1).Name = "" Then
SimOpts.Specie(1).Name = "EMPTY.TXT"
TmpOpts.Specie(1).Name = "EMPTY.TXT"
End If
If SimOpts.Specie(2).Name = "" Then
SimOpts.Specie(2).Name = "EMPTY.TXT"
TmpOpts.Specie(2).Name = "EMPTY.TXT"
End If
If Left(SimOpts.Specie(1).Name, Len(SimOpts.Specie(1).Name) - 4) = "EMPTY" Then
attackerfound = False
If Attacker < 0 Then
Attacker = Attacker + 1
If Attacker = 0 Then Attacker = 29
Else
Attacker = Attacker - 1
End If
Else
attackerfound = True
End If
If Left(SimOpts.Specie(2).Name, Len(SimOpts.Specie(2).Name) - 4) = "EMPTY" Then
defenderfound = False
Defender = Defender - 1
If Defender < 0 Then
Defender = 0
defenderfound = True
End If
Else
defenderfound = True
End If
If attackerfound And defenderfound And SimOpts.Specie(2).Name = SimOpts.Specie(1).Name Then
If MsgBox("Challenger and Defender are the same bot. Continue with this Challenger?", vbYesNo, "Identical Bots") = vbYes Then
'run these two bots against each other.
Else
'bot has lost, move on to next challenger
End If
End If
If attackerfound And defenderfound Then loopdone = True
Wend
'now check to see if we need to move challenger up slots
'for an empty league
If LeagueEntrants(0).Name = "" Or Left(LeagueEntrants(0).Name, 5) = "EMPTY" Then
'empty league file
LeagueEntrants(0) = LeagueChallengers(-Attacker - 1)
LeagueEnd
SetupLeagueRound
ElseIf Defender <> 29 And Attacker < 0 Then
LeagueEntrants(Defender + 1) = LeagueChallengers(-Attacker - 1)
LeagueChallengers(-Attacker - 1).Name = ""
Attacker = Defender + 1
'empty league
End If
' If SimOpts.Specie(1).color = vbBlue And SimOpts.Specie(2).color = vbBlue Then
SimOpts.Specie(0).color = vbGreen
TmpOpts.Specie(0).color = vbGreen
SimOpts.Specie(1).color = vbRed
TmpOpts.Specie(1).color = vbRed
SimOpts.Specie(2).color = vbBlue
TmpOpts.Specie(2).color = vbBlue
' End If
End Sub
Public Function League_Eyefudge(robotnumber As Integer, t As Long)
'tests to see if two bots have the same number of refeye statements.
'if so, it adds the following gene at teh end of the DNA
'This is definately a fudge, both in practice and implementation.
'A better system will be needed if anything is done to break this
'(such as a bot not using refeyes for conspec identification)
'or bots that are so close that this gives a virus bot an undue edge
'Later: add a prompt for action and a small timer. If timer runs out then
'we use the default action below
If eye11 = rob(robotnumber).occurr(8) Then
'If SimOpts.TotRunCycle < 3 And eye11 = rob(robotnumber).occurr(8) Then
ReDim Preserve rob(robotnumber).DNA(UBound(rob(robotnumber).DNA) + 6)
'cond
rob(robotnumber).DNA(t).tipo = 4
rob(robotnumber).DNA(t).value = 1
t = t + 1
'*.eye5
rob(robotnumber).DNA(t).tipo = 1
rob(robotnumber).DNA(t).value = 505
t = t + 1
'dup
rob(robotnumber).DNA(t).tipo = 2
rob(robotnumber).DNA(t).value = 23
t = t + 1
'!=
rob(robotnumber).DNA(t).tipo = 3
rob(robotnumber).DNA(t).value = 4
t = t + 1
'start
rob(robotnumber).DNA(t).tipo = 4
rob(robotnumber).DNA(t).value = 2
t = t + 1
'stop
rob(robotnumber).DNA(t).tipo = 4
rob(robotnumber).DNA(t).value = 3
t = t + 1
'end
rob(robotnumber).DNA(t).tipo = 10 ' EricL - Changed tipo from 4 to 10, March 15, 2006
rob(robotnumber).DNA(t).value = 1 ' EricL - Changed value from 4 to 1, March 15, 2006
rob(robotnumber).occurr(8) = rob(robotnumber).occurr(8) + 1
End If
End Function
Public Sub Record_11eyes(eyes As Integer)
eye11 = eyes
End Sub
Private Sub LeagueEnd()
Dim i As Integer
If LeagueChallengers(-Attacker).Name = "EMPTY" Or LeagueChallengers(-Attacker).Name = "" Then
LeagueMode = False
ContestMode = False
' SimOpts.F1 = False
'pause simulation.
Form1.Active = False
Form1.SecTimer.Enabled = False
If MsgBox("The league has finished running. Simulation paused. Save league file?", vbYesNo, "League Finished.") = vbYes Then
'save results into file
Save_League_File Leaguename
End If
LeagueForm.Hide
Contest_Form.Hide
Else
Dim Index As Integer
For Index = 0 To 29
LeagueChallengers(Index) = LeagueChallengers(Index + 1)
Next Index
LeagueChallengers(29).Name = ""
End If
Attacker = -1
Defender = 29
'Puts things back the way they were before the league began so that the species list looks okay.
TmpOpts = SimOpts
'Let the sim play again so that it's not paused for the user
' Form1.Active = True
' Form1.SecTimer.Enabled = True
End Sub
Private Sub stuff()
'move up all challengers
Dim Index As Integer
For Index = 1 To 29
LeagueChallengers(Index - 1) = LeagueChallengers(Index)
Next Index
Dim empty0 As datispecie
LeagueChallengers(29) = empty0
End Sub