Difference between revisions of "Leagues"

From WikiManual
Jump to: navigation, search
m
m (F1Mode code added)
Line 326: Line 326:
 
DispSettings
 
DispSettings
 
End If
 
End If
 +
</pre>
 +
 +
== F1 Mode ==
 +
 +
F1Mode modual
 +
 +
<pre>
 +
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
 +
 
</pre>
 
</pre>

Revision as of 20:22, 25 December 2006

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.

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

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
Retrieved from "http://wiki.darwinbots.com/index.php?title=Leagues&oldid=2332"