VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form Form1 
   Appearance      =   0  'Flat
   AutoRedraw      =   -1  'True
   BackColor       =   &H00511206&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   8520
   ClientLeft      =   30
   ClientTop       =   90
   ClientWidth     =   11880
   FillColor       =   &H00511206&
   FillStyle       =   0  'Solid
   Icon            =   "main.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   8520
   ScaleWidth      =   11880
   ShowInTaskbar   =   0   'False
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   1000
      Left            =   2640
      ScaleHeight     =   945
      ScaleWidth      =   945
      TabIndex        =   1
      Top             =   120
      Visible         =   0   'False
      Width           =   1000
   End
   Begin VB.Timer SecTimer 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   2040
      Top             =   120
   End
   Begin InetCtlsObjects.Inet Inet1 
      Left            =   720
      Top             =   120
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      Protocol        =   2
      RemoteHost      =   "192.168.0.3"
      RemotePort      =   21
      URL             =   "ftp://192.168.0.3"
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   120
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Timer Timer2 
      Interval        =   60001
      Left            =   1440
      Top             =   120
   End
   Begin VB.Image EnvMap 
      Height          =   1005
      Left            =   3840
      Top             =   120
      Visible         =   0   'False
      Width           =   1005
   End
   Begin VB.Image Grata 
      Height          =   3180
      Left            =   3720
      Picture         =   "main.frx":08CA
      Top             =   3840
      Visible         =   0   'False
      Width           =   3180
   End
   Begin VB.Image Arrows 
      Height          =   3180
      Left            =   480
      Picture         =   "main.frx":217BC
      Top             =   3840
      Visible         =   0   'False
      Width           =   3180
   End
   Begin VB.Image Vortice 
      Height          =   3180
      Left            =   6960
      Picture         =   "main.frx":426AE
      Top             =   3840
      Visible         =   0   'False
      Width           =   3180
   End
   Begin VB.Label Label1 
      BackColor       =   &H80000007&
      BackStyle       =   0  'Transparent
      Caption         =   "Output video interrotto... premi sul pulsante nella barra in alto per ripristinarlo."
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   24
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   1335
      Left            =   480
      TabIndex        =   0
      Tag             =   "30000"
      Top             =   2640
      Visible         =   0   'False
      Width           =   10665
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' DarwinBots - copyright 2003 Carlo Comis
' Revisions
' V2.11, V2.12, V2.13, V2.14, V2.15 pondmode, V2.2, V2.3, V2.31, V2.32, V2.33, V2.34 by PurpleYouko
' V2.35, 2.36.X, 2.37.X by PurpleYouko and Numsgil

' please read the copyright notice in the source's folder

Option Explicit

Public WithEvents t As TrayIcon
Attribute t.VB_VarHelpID = -1
Public BackPic As String

Dim edat(10) As Single

' for graphs
Private Type Graph
  opened As Boolean
  graf As grafico
End Type

Dim MouseClickX As Long     ' mouse pos when clicked
Dim MouseClickY As Long
Dim MouseClicked As Boolean

Public cyc As Integer          ' cycles/second
Dim minutescount As Integer
Public dispskin As Boolean  ' skin drawing enabled?
Public Smileys As Boolean   ' silly routine to make smily faces
Public Active As Boolean    ' sim running?
Public visiblew As Long     ' field visible portion (for zoom)
Public visibleh As Long

Private robminutescount As Integer  ' minutes counter for next robot auto save
Private AutoRobNum As Integer       ' last autosaved rob index
Private AutoSimNum As Integer       ' last autosaved sim index
Public DNAMaxConds As Integer   ' max conditions per gene allowed by mutation
Dim Charts(10) As Graph        ' array of graph pointers

Public MutCyc As Long     ' for oscillating mutation rates
Private GridRef As Integer
Public PiccyMode As Boolean   'display that piccy or not?
Public Newpic As Boolean      'IIs it a new picture?
Public Flickermode As Boolean 'Speed up graphics at the cost of some flicker

Private Sub Form_Load()
  strings Me
  Set Consoleform.evnt = New cevent
  
  LoadSysVars
  LoadLists
  If BackPic <> "" Then
    Form1.Picture = LoadPicture(BackPic)
  Else
    Form1.Picture = Nothing
  End If
  MDIForm1.Caption = "DarwinBots 2.37"
  Form1.top = 0
  Form1.Left = 0
  Form1.width = MDIForm1.ScaleWidth
  Form1.Height = MDIForm1.ScaleHeight
  SimOpts.FieldWidth = Form1.ScaleWidth
  SimOpts.FieldHeight = Form1.ScaleHeight
  visiblew = SimOpts.FieldWidth
  visibleh = SimOpts.FieldHeight
  MDIForm1.visualize = True
  Active = True
  MaxMem = 1000
  maxfieldsize = SimOpts.FieldWidth * 2
  TotalRobots = 0
  robfocus = 0
  maxshots = 0
  AbsNum = 0
  dispskin = True
  Form1.Active = True
  IntOpts.RUpload = RobSize * 4
  IntOpts.XUpload = 0
  IntOpts.YUpload = Me.ScaleHeight / 2 - IntOpts.RUpload / 2
  IntOpts.XSpawn = Me.ScaleWidth - IntOpts.RUpload
  IntOpts.YSpawn = IntOpts.YUpload
  IntOpts.WaitForUpload = 10000
  IntOpts.LastUploadCycle = 1
  MDIForm1.daypic.Visible = True
  MDIForm1.nightpic.Visible = False
  MDIForm1.F1Piccy.Visible = False
  ContestMode = False
End Sub

'
'              D R A W I N G
'

' redraws screen
Public Sub Redraw()
  Dim count As Long
  count = SimOpts.TotRunCycle / 10
  
  If count = SimOpts.TotRunCycle / 10 Then                  'gridref = layer of grid to refresh
    Cls
    GridRef = GridRef + 1: If GridRef > 9 Then GridRef = 1
    'envir.RefreshGrid GridRef
  End If
  
  If PiccyMode Then
    If Newpic Then
      Me.AutoRedraw = True
      Form1.Picture = LoadPicture(BackPic)
      Newpic = False
    End If
  End If
  Cls
  If Flickermode Then Me.AutoRedraw = False
  
  DrawAllTies
  DrawAllRobs
  DrawShots
  Me.AutoRedraw = True
End Sub

' calculates the pixel/twip ratio, since some graphic methods
' need pixel values
Function GetTwipWidth() As Single
  Dim scw As Long, sch As Long, scm As Integer
  Dim sct As Long, scl As Long
  scm = Form1.ScaleMode
  scw = Form1.ScaleWidth
  sch = Form1.ScaleHeight
  sct = Form1.ScaleTop
  scl = Form1.ScaleLeft
  Form1.ScaleMode = vbPixels
  GetTwipWidth = Form1.ScaleWidth / scw
  Form1.ScaleMode = scm
  Form1.ScaleWidth = scw
  Form1.ScaleHeight = sch
  Form1.ScaleTop = sct
  Form1.ScaleLeft = scl
End Function

' draws rob perimeter - circle or square, if wall
Private Sub DrawRobPer(n As Integer)
  Dim Sides As Integer
  Dim t As Single
  Dim Sdlen As Single
  Dim CentreX As Long
  Dim CentreY As Long
  Dim radius As Single
  
  Sides = rob(n).Shape
  If Sides > 0 Then Sdlen = 6.28 / Sides
  CentreX = rob(n).pos.x
  CentreY = rob(n).pos.y
  radius = rob(n).radius
   
  If rob(n).highlight Then Circle (CentreX, CentreY), radius * 1.2, vbYellow
  If n = robfocus Then Circle (CentreX, CentreY), radius * 1.2, vbWhite

  If Not Smileys Then
    If Not rob(n).Wall Then
      Circle (CentreX, CentreY), rob(n).radius, rob(n).color 'new line
    Else
      Line (CentreX, CentreY)-Step(RobSize, RobSize), vbWhite, BF
    End If
    
  Else
    For t = 0 To 6.28 Step Sdlen
      Line (CentreX + Cos(rob(n).aim + t) * radius, CentreY - Sin(rob(n).aim + t) * radius)-(CentreX + Cos(rob(n).aim + t + Sdlen) * radius, CentreY - Sin(rob(n).aim + t + Sdlen) * radius), rob(n).color
    Next t
  End If
End Sub

' draws rob perimeter if in distance
Private Sub DrawRobDistPer(n As Integer)
  Dim CentreX As Long, CentreY As Long
  
  CentreX = rob(n).pos.x
  CentreY = rob(n).pos.y
  
  If rob(n).highlight Then Circle (CentreX, CentreY), RobSize * 2, vbYellow 'new line
  If n = robfocus Then Circle (CentreX, CentreY), RobSize * 2, vbWhite
  If n = robfocus Then
      'draw some lines for the eye cells
  End If
  
  Form1.FillColor = rob(n).color
  If Not rob(n).Wall Then
    Circle (CentreX, CentreY), rob(n).radius, rob(n).color
  Else
    Line (rob(n).pos.x, rob(n).pos.y)-Step(RobSize, RobSize), vbWhite, BF
  End If
End Sub

' draws rob aim
Private Sub DrawRobAim(n As Integer)
  Dim x As Long, y As Long
  Dim pos As vector
  With rob(n)
  
  'We have to remember that the upper left corner is (0,0)
  pos.x = .aimvector.x
  pos.y = -.aimvector.y
  
  pos = VectorAdd(.pos, VectorScalar(pos, .radius))
  If Not rob(n).Wall And Not rob(n).Corpse Then PSet (pos.x, pos.y), vbWhite
  End With
End Sub

' draws skin
Private Sub DrawRobSkin(n As Integer)
  Dim x1 As Integer
  Dim x2 As Integer
  Dim y1 As Integer
  Dim y2 As Integer
  
  'If rob(n).Corpse Then Exit Sub
  
  'If Smileys Then
  '  With rob(n)
  '    'Circle (rob(n).x + Half, rob(n).Y + Half), Half + rob(n).body / factor, rob(n).color 'new line
  '    Circle (rob(n).x + (Half - 20), rob(n).Y + (Half - 20)), 20, rob(n).color
  '    Circle (rob(n).x + (Half + 20), rob(n).Y + (Half - 20)), 20, rob(n).color
  '    x1 = rob(n).x + Half - 30
  '    y1 = rob(n).Y + Half + 20
  '    x2 = rob(n).x + Half
  '    y2 = rob(n).Y + Half + 45
  '    Line (x1, y1)-(x2, y2), rob(n).color
  '    x1 = x2
  '    y1 = y2
  '    x2 = rob(n).x + Half + 30
  '    y2 = rob(n).Y + Half + 20
  '    Line (x1, y1)-(x2, y2), rob(n).color
      
      'Line (rob(n).x + (Half - 25), rob(n).Y + (Half + 20))-(rob(n).x + (Half - 10), rob(n).Y + (Half + 25))
  '  End With
  If Not Smileys Then
    If rob(n).oaim <> rob(n).aim Then
      Dim t As Integer
      With rob(n)
        .OSkin(0) = Cos(.Skin(1) / 100 - .aim) * .Skin(0)
        .OSkin(1) = Sin(.Skin(1) / 100 - .aim) * .Skin(0)
        PSet (.OSkin(0) + .pos.x, .OSkin(1) + .pos.y)
        For t = 2 To 6 Step 2
          .OSkin(t) = Cos(.Skin(t + 1) / 100 - .aim) * .Skin(t)
          .OSkin(t + 1) = Sin(.Skin(t + 1) / 100 - .aim) * .Skin(t)
          Line -(.OSkin(t) + .pos.x, .OSkin(t + 1) + .pos.y), .color
        Next t
        .oaim = .aim
      End With
    Else
      With rob(n)
        PSet (.OSkin(0) + .pos.x, .OSkin(1) + .pos.y)
        For t = 2 To 6 Step 2
          Line -(.OSkin(t) + .pos.x, .OSkin(t + 1) + .pos.y), .color
        Next t
      End With
    End If
  End If
End Sub

' draws ties
Private Sub DrawRobTies(t As Integer, w As Integer, ByVal s As Integer)
  Dim k As Byte
  Dim rp As Integer
  Dim drawsmall As Integer
  Dim CentreX As Single
  Dim CentreY As Single
  Dim CentreX1 As Single
  Dim CentreY1 As Single
  
  drawsmall = w / 4
  If drawsmall = 0 Then drawsmall = 1
  
  k = 1
  With rob(t)
  CentreX = .pos.x
  CentreY = .pos.y
  While .Ties(k).pnt > 0
    If Not .Ties(k).back Then
      rp = .Ties(k).pnt
      CentreX1 = rob(rp).pos.x
      CentreY1 = rob(rp).pos.y
      DrawWidth = drawsmall
      If .Ties(k).last > 0 Then
        If w > 2 Then
          DrawWidth = w
        Else
          DrawWidth = 2
        End If
        Line (CentreX, CentreY)-(CentreX1, CentreY1), .color
      End If
    End If
    k = k + 1
  Wend
  End With
End Sub

' draws ties if ties colouring used
Private Sub DrawRobTiesCol(t As Integer, w As Integer, ByVal s As Integer)
  Dim k As Byte
  Dim col As Long
  Dim rp As Integer
  Dim drawsmall As Integer
  Dim CentreX As Single
  Dim CentreY As Single
  Dim CentreX1 As Single
  Dim CentreY1 As Single
  
  drawsmall = w / 4
  If drawsmall = 0 Then drawsmall = 1
  k = 1
  With rob(t)
  CentreX = .pos.x
  CentreY = .pos.y
  While .Ties(k).pnt > 0
    If Not .Ties(k).back Then
      rp = .Ties(k).pnt
      CentreX1 = rob(rp).pos.x
      CentreY1 = rob(rp).pos.y
      DrawWidth = drawsmall
      col = .color
      If w < 2 Then w = 2
      If .Ties(k).last > 0 Then DrawWidth = w / 2 'size of birth ties
      If .Ties(k).infused Then
        col = vbWhite
        .Ties(k).infused = False
      End If
      If .Ties(k).nrgused Then
        col = vbRed
        .Ties(k).nrgused = False
      End If
      If .Ties(k).sharing Then
        col = vbYellow
        .Ties(k).sharing = False
      End If
      Line (CentreX, CentreY)-(CentreX1, CentreY1), col
      'Line (.x + s, .Y + s)-(rob(rp).x + s, rob(rp).Y + s), col
    End If
    k = k + 1
  Wend
  End With
End Sub

' shots...
Public Sub DrawShots()
  DrawWidth = Int(50 / (ScaleWidth / RobSize) + 1)
  If DrawWidth > 2 Then DrawWidth = 2
  Dim t As Integer
  For t = 1 To maxshots
    If Shots(t).Exist Then
      PSet (Shots(t).x, Shots(t).y), Shots(t).color
    End If
  Next t
End Sub

' internet gates...
Private Sub DrawInternetBoxes()
  FillStyle = 1
  If IntOpts.LastUploadCycle = 0 Then
    PaintPicture Vortice.Picture, IntOpts.XUpload, IntOpts.YUpload, IntOpts.RUpload, IntOpts.RUpload
  Else
    PaintPicture Grata.Picture, IntOpts.XUpload, IntOpts.YUpload, IntOpts.RUpload, IntOpts.RUpload
  End If
  PaintPicture Arrows.Picture, IntOpts.XSpawn, IntOpts.YSpawn, IntOpts.RUpload, IntOpts.RUpload
  FillStyle = 0
End Sub

' main drawing procedure
Public Sub DrawAllRobs()
  Dim w As Integer
  Dim nd As node
  Dim t As Integer
  Dim s As Integer
  Dim noeyeskin As Boolean
  Dim PixelsPerTwip As Single
  Dim PixRobSize As Integer
  Dim PixBorderSize As Integer
  
  PixelsPerTwip = GetTwipWidth
  PixRobSize = PixelsPerTwip * RobSize
  PixBorderSize = PixRobSize / 10
  If PixBorderSize < 1 Then PixBorderSize = 1
  noeyeskin = False
  w = Int(30 / (Form1.visiblew / RobSize) + 1)
  If (Form1.visiblew / RobSize) > 200 Then noeyeskin = True
  DrawMode = 13
  DrawStyle = 0
  DrawWidth = w
  If IntOpts.Active Then DrawInternetBoxes
  
  If robfocus > 0 Then
    Dim low As Single
    Dim highest As Single
    Dim hi As Single
    Dim length As Single
    Dim a As Integer
  
    length = RobSize * 12
    highest = rob(robfocus).aim + PI / 4
         
    For a = 0 To 8
      Dim offset As Single
      
      hi = highest - (PI / 18) * a
      low = hi - PI / 18
      
      If hi > PI * 2 Then hi = hi - PI * 2
      If low > PI * 2 Then low = low - PI * 2
      If low < 0 Then low = low + PI * 2
      If hi < 0 Then hi = hi + PI * 2
      
      'a + 1 = eye
      If rob(robfocus).mem(EyeStart + a + 1) > 0 Then
        DrawMode = vbNotMergePen
      Else
        DrawMode = vbCopyPen
      End If
      
      Circle (rob(robfocus).pos.x, rob(robfocus).pos.y), length, vbCyan, -low, -hi
    Next a
    
    'Line (rob(robfocus).pos.x, rob(robfocus).pos.y)- _
    '  (rob(robfocus).pos.x + Cos(-rob(robfocus).aim) * length, _
    '  rob(robfocus).pos.y + Sin(-rob(robfocus).aim) * length)
  End If
  
  DrawMode = vbCopyPen
  'DrawWidth = PixBorderSize
  DrawStyle = 0
  
  If noeyeskin Then
    For a = 1 To MaxRobs
      If rob(a).Exist Then DrawRobDistPer a
    Next a
    
  Else
    FillColor = BackColor
    
    For a = 1 To MaxRobs
      If rob(a).Exist Then DrawRobPer a
    Next a
  End If
  
  DrawStyle = 0
  If dispskin And Not noeyeskin Then
    For a = 1 To MaxRobs
      If rob(a).Exist Then DrawRobSkin a
    Next a
  End If
  
  DrawWidth = w * 2
  
  If Not noeyeskin Then
    For a = 1 To MaxRobs
      If rob(a).Exist Then DrawRobAim a
    Next a
  End If
End Sub

Public Sub DrawAllTies()
  Dim nd As node, t As Integer
  
  Dim PixelsPerTwip As Single
  Dim PixRobSize As Integer
  
  PixelsPerTwip = GetTwipWidth
  PixRobSize = PixelsPerTwip * RobSize
  
  For t = 1 To MaxRobs
    If rob(t).Exist Then DrawRobTiesCol t, PixelsPerTwip * rob(t).radius * 2, rob(t).radius
  Next t
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''
'
'   S Y S T E M
'
'''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''

' changes robot colour
Sub changerobcol()
  ColorForm.setcolor rob(robfocus).color
  rob(robfocus).color = ColorForm.color
End Sub

' counts minutes for autosaves
Private Sub Timer2_Timer()
  If SimOpts.AutoSimTime > 0 Then
    minutescount = minutescount + 1
    If minutescount = SimOpts.AutoSimTime Then
      minutescount = 0
      AutoSimNum = AutoSimNum + 1
      SaveSimulation MDIForm1.MainDir + "/autosave/" + SimOpts.AutoSimPath + CStr(AutoSimNum) + ".sim"
    End If
  End If
  If SimOpts.AutoRobTime > 0 Then
    robminutescount = robminutescount + 1
    If robminutescount = SimOpts.AutoRobTime Then
      robminutescount = 0
      AutoRobNum = AutoRobNum + 1
      SaveOrganism MDIForm1.MainDir + "/autosave/" + SimOpts.AutoRobPath + CStr(AutoRobNum) + ".dbo", fittest()
    End If
  End If
End Sub

' initializes a simulation.
Sub StartSimul()
  Rnd -1 'sets up the randomizer to be seeded
  If SimOpts.UserSeedToggle = True Then
    Randomize SimOpts.UserSeedNumber
  Else
    Randomize Timer
  End If
  
  Over = False
  Init_Buckets
  LoadSysVars
  LoadLists
  
  If BackPic <> "" Then
    Form1.Picture = LoadPicture(BackPic)
  Else
    Form1.Picture = Nothing
  End If
  
  Form1.Show
  Form1.ScaleWidth = SimOpts.FieldWidth
  Form1.ScaleHeight = SimOpts.FieldHeight
  Form1.visiblew = SimOpts.FieldWidth
  Form1.visibleh = SimOpts.FieldHeight
  SimOpts.MutCurrMult = 1
  SimOpts.TotRunCycle = -1
  SimOpts.TotBorn = 0
  grafico.ResetGraph
  Active = True
  MaxMem = 1000
  maxfieldsize = SimOpts.FieldWidth * 2
  robfocus = 0
  nlink = RobSize
  klink = 0.01
  plink = 0.1
  mlink = RobSize * 1.5
  MaxRobs = 1
  maxshots = 0
  AbsNum = 0
  loadrobs
  Timer2.Enabled = True
  SecTimer.Enabled = True
  SimOpts.TotRunTime = 0
  setfeed
  DrawAllRobs
  MDIForm1.enablesim
  If SimOpts.DBEnable Then
    CreateArchive SimOpts.DBName
    OpenDB SimOpts.DBName
  End If
  
  IntOpts.RUpload = RobSize * 4
  IntOpts.XUpload = 0
  IntOpts.YUpload = 0
  IntOpts.XSpawn = Me.ScaleWidth - IntOpts.XUpload - IntOpts.RUpload
  IntOpts.YSpawn = Me.ScaleHeight - IntOpts.YUpload - IntOpts.RUpload
  IntOpts.ErrorNumber = 0
  
  If ContestMode Then
     FindSpecies
     F1count = 0
  End If
  
  If LeagueMode Then
    LeagueForm.Show
  End If
  main
End Sub

' same, but for a loaded sim
Sub startloaded()
  Rnd -1
  If SimOpts.UserSeedToggle = True Then
    Randomize SimOpts.UserSeedNumber
  Else
    Randomize Timer
  End If
  
  Init_Buckets
  
  If BackPic <> "" Then
    Form1.Picture = LoadPicture(BackPic)
  Else
    Form1.Picture = Nothing
  End If
  Form1.ScaleWidth = SimOpts.FieldWidth
  Form1.ScaleHeight = SimOpts.FieldHeight
  MDIForm1.visualize = True
  Active = True
  MaxMem = 1000
  maxfieldsize = SimOpts.FieldWidth * 2
  robfocus = 0
  SimOpts.MutCurrMult = 1
  nlink = RobSize
  klink = 0.01
  plink = 0.1
  mlink = RobSize * 1.5
  Timer2.Enabled = True
  SecTimer.Enabled = True
  setfeed
  DrawAllRobs
  MDIForm1.enablesim
  Me.Visible = True
  IntOpts.RUpload = RobSize * 4
  IntOpts.XUpload = 0
  IntOpts.YUpload = 0
  IntOpts.XSpawn = SimOpts.FieldWidth - IntOpts.RUpload
  IntOpts.YSpawn = SimOpts.FieldHeight - IntOpts.RUpload
  IntOpts.WaitForUpload = 10000
  IntOpts.LastUploadCycle = 1
  NoDeaths = True
  
  Vegs.cooldown = 0
  main
End Sub

' loads robot DNA at the beginning of a simulation
Private Sub loadrobs()
  Dim k As Integer
  Dim a As Integer
  Dim i As Integer
  Dim cc As Integer, t As Integer
  k = 0
  For cc = 1 To SimOpts.SpeciesNum
    For t = 1 To SimOpts.Specie(k).qty
      a = robscriptload(respath(SimOpts.Specie(k).path) + "\" + SimOpts.Specie(k).Name)
      rob(a).Veg = SimOpts.Specie(k).Veg
      rob(a).Fixed = SimOpts.Specie(k).Fixed
      If rob(a).Fixed Then rob(a).mem(216) = 1
      rob(a).pos.x = Random(SimOpts.Specie(k).Poslf, SimOpts.Specie(k).Posrg)
      rob(a).pos.y = Random(SimOpts.Specie(k).Postp, SimOpts.Specie(k).Posdn)
      UpdateBotBucket a
      rob(a).nrg = SimOpts.Specie(k).Stnrg
      rob(a).body = 1000
      rob(a).radius = FindRadius(rob(a).body)
      rob(a).mem(468) = 32000
      rob(a).mem(SetAim) = 32000
      rob(a).mem(480) = 32000
      rob(a).mem(481) = 32000
      rob(a).mem(482) = 32000
      rob(a).mem(483) = 32000
      rob(a).Dead = False
      If rob(a).Shape = 0 Then
        rob(a).Shape = Int(Rnd * 3) + 3
      End If
            
      For i = 0 To 20
        rob(a).mutarray(i) = SimOpts.Specie(k).mutarray(i)
      Next i
      
      rob(a).Mutation = SimOpts.Specie(k).Mutations
      For i = 1 To 13
        rob(a).Skin(i) = SimOpts.Specie(k).Skin(i)
      Next i
      
      rob(a).color = SimOpts.Specie(k).color
      UpdateBotBucket a
      'robocount = robocount + 1
    Next t
    k = k + 1
  Next cc
End Sub

' calls main form status bar update
Public Sub cyccaption(ByVal num As Single)
  MDIForm1.infos num, TotalRobots, totnvegs, totvegs, SimOpts.TotBorn, SimOpts.TotRunCycle, SimOpts.TotRunTime
End Sub

' calculates the total number of robots
Private Function totrobs() As Integer
  totrobs = 0
  Dim t As Integer
  For t = 1 To MaxRobs
    If rob(t).Exist Then
      totrobs = totrobs + 1
    End If
  Next t
End Function

' transfers focus to the parent robot
Sub parentfocus()
  Dim t As Integer
  For t = 1 To MaxRobs
    If rob(robfocus).Parent = rob(t).AbsNum And rob(t).Exist = True Then robfocus = t
  Next t
End Sub

' which rob has been clicked?
Private Function whichrob(x As Single, y As Single) As Integer
  Dim dist As Double, pist As Double
  Dim t As Integer
  whichrob = 0
  dist = 10000
  Dim nd As node
  For t = 1 To MaxRobs
    If rob(t).Exist Then
      pist = Abs(rob(t).pos.x - x) ^ 2 + Abs(rob(t).pos.y - y) ^ 2
      If Abs(rob(t).pos.x - x) < rob(t).radius And Abs(rob(t).pos.y - y) < rob(t).radius And pist < dist And rob(t).Exist Then
        whichrob = t
        dist = pist
      End If
    End If
  Next t
End Function

' stuff for clicking, dragging, etc
' move+click: drags robot if one selected, else drags screen
Private Sub Form_MouseMove(button As Integer, Shift As Integer, x As Single, y As Single)
  Dim st As Long
  Dim sl As Long
  Dim vsv As Long
  Dim hsv As Long
  Dim t As Byte
  Dim vel As vector
  
  visibleh = Int(Form1.ScaleHeight)
  If button = 0 Then
    MouseClickX = x
    MouseClickY = y
  End If
  
  If button = 1 And Not MDIForm1.insrob Then
    If MouseClicked Then
      st = ScaleTop + MouseClickY - y
      sl = ScaleLeft + MouseClickX - x
      If st < 0 Then
        st = 0
        MouseClickY = y
      End If
      If sl < 0 Then
        sl = 0
        MouseClickX = x
      End If
      If st > SimOpts.FieldHeight - visibleh Then
        st = SimOpts.FieldHeight - visibleh
      End If
      If sl > SimOpts.FieldWidth - visiblew Then
        sl = SimOpts.FieldWidth - visiblew
      End If
      Form1.ScaleTop = st
      Form1.ScaleLeft = sl
      Form1.Refresh
      Redraw
      Form1.Refresh
    End If
  End If
  If button = 1 And robfocus > 0 Then
    
    vel = VectorSub(rob(robfocus).pos, VectorSet(x, y))
    rob(robfocus).pos = VectorSet(x, y)
    rob(robfocus).vel = VectorSet(0, 0)
    If Not Active Then Redraw
  End If
  If GetInputState() <> 0 Then DoEvents
End Sub

' it seems that there's no simple way to know the mouse status
' outside of a Form event. So I've used the event to switch
' on and off some global vars
Private Sub Form_MouseUp(button As Integer, Shift As Integer, x As Single, y As Single)
  MouseClicked = False
  MousePointer = 0
End Sub

Private Sub Form_Resize()
  If Form1.WindowState = 2 Then
    SimOpts.FieldWidth = Form1.ScaleWidth
    SimOpts.FieldHeight = Form1.ScaleHeight
    maxfieldsize = SimOpts.FieldWidth * 2
  End If
End Sub

' double clicking on a rob pops up the info window
' elsewhere closes it
' there's also the case we're drawing a wall path
Private Sub Form_DblClick()
  Dim n As Integer
  n = whichrob(CSng(MouseClickX), CSng(MouseClickY))
  If n > 0 And MuriForm.stat = 0 Then
    robfocus = n
    If Not rob(n).highlight Then deletemark
    datirob.Visible = True
    datirob.RefreshDna
    datirob.ZOrder
    datirob.infoupdate rob(n).AbsNum, rob(n).nrg, rob(n).Parent, rob(n).Mutations, rob(n).age, rob(n).SonNumber, 1, rob(n).fname, rob(n).genenum, rob(n).LastMut, rob(n).generation, rob(n).DnaLen, rob(n).LastOwner, rob(n).Waste
  Else
    datirob.Form_Unload 0
    robfocus = 0
    If ActivForm.Visible Then ActivForm.NoFocus
    If MuriForm.stat = 1 Then MuriForm.storepoints CSng(MouseClickX), CSng(MouseClickY)
  End If
End Sub

' clicking outside robots closes info window
' mind the walls tool
Private Sub Form_Click()
  Dim n As Integer
  LogForm.Visible = False
  n = whichrob(CSng(MouseClickX), CSng(MouseClickY))
  If n = 0 And MuriForm.stat = 0 Then
    datirob.Form_Unload 0
    robfocus = 0
    If ActivForm.Visible Then ActivForm.NoFocus
    If MuriForm.stat = 1 Then MuriForm.storepoints CSng(MouseClickX), CSng(MouseClickY)
  End If
End Sub

' clicking (well, half-clicking) on a robot selects it
' clicking outside can add a robot if we're in robot insertion
' mode.
Private Sub Form_MouseDown(button As Integer, Shift As Integer, x As Single, y As Single)
  Dim n As Integer
  Dim k As Integer
  n = whichrob(x, y)
  
  If button = 2 Then
    robfocus = n
    If n > 0 Then MDIForm1.PopupMenu MDIForm1.popup
  End If
  
  If n > 0 And MuriForm.stat = 0 Then
    robfocus = n
    If Not rob(n).highlight Then deletemark
  ElseIf MuriForm.stat = 1 Then
    MuriForm.storepoints CSng(x), CSng(y)
  End If
  
  If n = 0 And button = 1 And MDIForm1.insrob Then
    k = 0
    While SimOpts.Specie(k).Name <> "" And SimOpts.Specie(k).Name <> MDIForm1.Combo1.text
      k = k + 1
    Wend
    aggiungirob k, x, y
  End If
  
  If button = 1 And Not MDIForm1.insrob And n = 0 Then
    MouseClicked = True
  End If
  
  If Not MuriForm.stat = 1 Then
    Redraw
  End If
End Sub

' deletes the yellow highlight mark around robots
Private Sub deletemark()
  Dim t As Integer
  For t = 1 To MaxRobs
    rob(t).highlight = False
  Next t
End Sub

Sub Form_Unload(Cancel As Integer)
  Dim t As Byte
  If SimOpts.TotRunTime <> 0 Then
    Debug.Print SimOpts.TotRunCycle, SimOpts.TotRunTime, SimOpts.TotRunCycle / SimOpts.TotRunTime
  End If
End Sub

' seconds timer, used to periodically check _cycles_ counters
' expecially for internet transfers
' tricky!
Private Sub SecTimer_Timer()
  Static LastCycle As Long
  Static SecondLastCycle As Long
  Static LastDownload As Long
  Static LastMut As Long
  Static MutPhase As Integer
  Static LastShuffle As Long
  Dim TitLog As String
  Dim t As Integer
  
  SimOpts.TotRunTime = SimOpts.TotRunTime + 1

  ' reset counters if simulation restarted
  If SimOpts.TotRunTime = 1 Then
    LastCycle = SimOpts.TotRunCycle
    ' let's have immediately the first download
    LastDownload = -(IntOpts.Cycles + 1)
    ' reset the counter for horiz/vertical shuffle
    LastShuffle = 0
    ' let's start conting for the next upload
    IntOpts.LastUploadCycle = 1
  End If
  
  ' same as above, but checking totruncycle<lastcycle instead
  If SimOpts.TotRunCycle < LastCycle Then
    LastCycle = SimOpts.TotRunCycle
    ' facciamo avvenire subito il primo download
    LastDownload = -(IntOpts.Cycles + 1)
    LastShuffle = 0
    IntOpts.LastUploadCycle = 0
  End If
  
  ' if we've had 30000 cycles in a second, probably we've
  ' loaded a saved sim. So we need to reset some counters
  If SimOpts.TotRunCycle - LastCycle > 30000 Then
    LastCycle = SimOpts.TotRunCycle
    ' facciamo avvenire subito il primo download
    LastDownload = -(IntOpts.Cycles + 1)
    ' facciamo avvenire uno shuffle fra 50000 cicli
    LastShuffle = SimOpts.TotRunCycle - 50000
    ' facciamo avvenire l'upload quando gli spetta
    IntOpts.LastUploadCycle = SimOpts.TotRunCycle
  End If
  
  ' switch on the internet upload if at least WaitForUpload cycles
  ' have passed from last upload. LastUploadCycle=0 is used as a flag
  ' to indicate upload enabled
  If SimOpts.TotRunCycle - IntOpts.LastUploadCycle > IntOpts.WaitForUpload Then
    IntOpts.LastUploadCycle = 0
  End If
  
  ' update status bar in MDI form
  cyccaption (SimOpts.TotRunCycle - LastCycle + LastCycle - SecondLastCycle) / 2
  SecondLastCycle = LastCycle
  SimOpts.CycSec = SimOpts.TotRunCycle - LastCycle
  LastCycle = SimOpts.TotRunCycle
  
  ' show cycles to next u/l d/l in title of internet log win (bugged!)
  If LogForm.Visible Then
    TitLog = "Log window  ---  "
    TitLog = TitLog + "Cycles to: next d/l: " + CStr(IntOpts.Cycles - SimOpts.TotRunCycle + LastDownload)
    TitLog = TitLog + "  next u/l: " + CStr(50000 - SimOpts.TotRunCycle + LastDownload)
    LogForm.Caption = TitLog
  End If
  
  ' when all robots are dead, stop everything or, if possible,
  ' download one frome internet
  ' Modified to allow for auto restart of Simulations
  If totnvegs = 0 Then
    If Not IntOpts.Active Then
      'Form1.Active = False
      'MsgBox (MBrobotsdead)
      'SecTimer.Enabled = False
    Else
      If LoadRandomOrg(CSng(IntOpts.XSpawn + IntOpts.RUpload / 4), CSng(IntOpts.YSpawn + IntOpts.RUpload / 4)) Then
        LastDownload = SimOpts.TotRunCycle
      Else
        LastDownload = SimOpts.TotRunCycle - IntOpts.Cycles + 5000
      End If
    End If
  End If

  ' download organism from server every IntOpts.Cycles
  If IntOpts.Active And (SimOpts.TotRunCycle - LastDownload) > IntOpts.Cycles Then
    LoadRandomOrg CSng(IntOpts.XSpawn + IntOpts.RUpload / 4), CSng(IntOpts.YSpawn + IntOpts.RUpload / 4)
    LastDownload = SimOpts.TotRunCycle
  End If
  
  ' provides the mutation rates oscillation
  If SimOpts.MutOscill Then
    If MutPhase = 0 And MutCyc > SimOpts.MutCycMax Then
      MutCyc = 0
      MutPhase = 1
      SimOpts.MutCurrMult = 1 / 16
    End If
    If MutPhase = 1 And MutCyc > SimOpts.MutCycMin Then
      MutCyc = 0
      MutPhase = 0
      SimOpts.MutCurrMult = 16
    End If
  End If
End Sub


' main procedure. Oh yes!
Private Sub main()
  'On Error GoTo fine
  Do
    If Active Then
      Form1.SecTimer.Enabled = True
           
      UpdateSim
      
      ' redraws all:
      If MDIForm1.visualize Then
        Form1.Label1.Visible = False
        If Not MDIForm1.oneonten Then
          Redraw
        Else
          If SimOpts.TotRunCycle Mod 10 = 0 Then Redraw
        End If
      End If
      
      If datirob.Visible Then
        With rob(robfocus)
          datirob.infoupdate .AbsNum, .nrg, .Parent, .Mutations, .age, .SonNumber, 1, .fname, .genenum, .LastMut, .generation, .DnaLen, .LastOwner, .Waste
        End With
      End If
      
      ' feeds graphs with data:
      If SimOpts.TotRunCycle Mod 200 = 0 Then FeedGraph
    End If
    DoEvents
  Loop
fine:
  MsgBox "Error. " + Err.Description + ".  Saving sim"
  SaveSimulation MDIForm1.MainDir + "\saves\error.sim"
End Sub


'
' M A N A G E M E N T   A N D   R E P R O D U C T I O N
'

'should remove highlight on a robot whenever the simulation is restarted after a pause
Public Sub unfocus()
  Dim t As Integer
  For t = 1 To UBound(rob())
    rob(t).highlight = False
  Next t
End Sub

'
'   W A L L S
'

' creates a single wall block in pos x,y
Sub CreaMuro(x As Long, y As Long)
  Dim n As Integer, t As Integer
  n = posto
  rob(n).fname = "Wall"
  rob(n).Exist = True
  rob(n).Wall = True
  rob(n).Fixed = True
  rob(n).pos.x = x
  rob(n).pos.y = y
  UpdateBotBucket n
  rob(n).nrg = 1
  rob(n).color = vbWhite
  rob(n).condnum = 0
  Erase rob(n).mem
  ReDim rob(n).DNA(10)
  For t = 1 To 10
    rob(n).DNA(t).tipo = 4
    rob(n).DNA(t).value = 4
  Next t
  For t = 0 To 10
    rob(n).occurr(t) = 0
  Next t
  For t = 0 To 12
    rob(n).Skin(t) = 0
  Next t
End Sub

'
'   S E R V I C E S
'

' initializes a new graph
Public Sub NewGraph(n As Integer, YLab As String)
  If (Charts(n).graf Is Nothing) Then
    Dim k As New grafico
    Set Charts(n).graf = k
    Charts(n).graf.ResetGraph
    Charts(n).graf.SetYLabel YLab
  End If
  Charts(n).graf.SetYLabel YLab
  Charts(n).graf.Show
End Sub

' resets all graphs
Public Sub ResetGraphs()
  Dim k As Integer
  For k = 1 To 10
    If Not (Charts(k).graf Is Nothing) Then
      Charts(k).graf.ResetGraph
    End If
  Next k
End Sub

' feeds graphs with new data
Private Sub FeedGraph()
  Dim nomi(30) As String
  Dim dati(30, 10) As Single
  Dim t As Integer, k As Integer, p As Integer
  CalcStats nomi, dati
  t = Flex.last(nomi)
  For k = 1 To 10
    For p = 1 To t
      If Not (Charts(k).graf Is Nothing) Then
        Charts(k).graf.SetValues nomi(p), dati(p, k)
      End If
    Next p
  Next k
  For k = 1 To 10
    If Not (Charts(k).graf Is Nothing) Then
      Charts(k).graf.NewPoints
      If Charts(k).graf.Visible Then
        Charts(k).graf.RedrawGraph
      End If
    End If
  Next k
End Sub

' calculates data for the different graph types
Private Sub CalcStats(ByRef nomi, ByRef dati)
  Dim p As Integer, t As Integer
  Dim n As node
  
  For t = 1 To MaxRobs
    With rob(t)
    If Not .Wall And .Exist Then
      p = Flex.Position(rob(t).fname, nomi)
      dati(p, 1) = dati(p, 1) + 1
      dati(p, 2) = dati(p, 2) + .LastMut + .Mutations
      dati(p, 3) = dati(p, 3) + .age
      dati(p, 4) = dati(p, 4) + .SonNumber
      dati(p, 5) = dati(p, 5) + .nrg
      dati(p, 6) = dati(p, 6) + .DnaLen
      dati(p, 7) = dati(p, 7) + .condnum
      dati(p, 8) = dati(p, 8) + (.LastMut + .Mutations) / .DnaLen
    End If
    End With
  Next t
  
  t = Flex.last(nomi)
  For p = 1 To t
    dati(p, 2) = dati(p, 2) / dati(p, 1)
    dati(p, 3) = dati(p, 3) / dati(p, 1)
    dati(p, 4) = dati(p, 4) / dati(p, 1)
    dati(p, 5) = dati(p, 5) / dati(p, 1)
    dati(p, 6) = dati(p, 6) / dati(p, 1)
    dati(p, 7) = dati(p, 7) / dati(p, 1)
    dati(p, 8) = dati(p, 8) / dati(p, 1)
  Next p
End Sub

' recursively calculates the number of alive descendants of a rob
Public Function discendenti(t As Integer, disce As Integer) As Integer
  Dim k As Integer
  Dim n As Integer
  Dim rid As Long
  rid = rob(t).AbsNum
  If disce < 1000 Then
    For n = 1 To MaxRobs
      If rob(n).Exist Then
        If rob(n).Parent = rid Then
          discendenti = discendenti + 1
          disce = disce + 1
          discendenti = discendenti + discendenti(n, disce)
        End If
      End If
    Next n
  End If
End Function

' sets the energy token for vegs feeding
Private Sub setfeed()
  'Dim t As Integer
  'For t = 1 To MaxRobs
  '  If rob(t).Veg = True Then rob(t).Feed = 8
  'Next t
End Sub

' selects a robot to kill for population control
Public Sub popcontrol()
  Dim a As Integer
  Dim totrob As Integer
  totrob = TotalRobots
  While totrob > SimOpts.MaxPopulation
    If SimOpts.PopLimMethod = 1 Then a = randrob
    If SimOpts.PopLimMethod = 2 Then a = eldest
    KillRobot a
    totrob = totrob - 1
  Wend
End Sub

' returns a random robot (for population control)
Private Function randrob() As Integer
  Dim a As Integer
  a = Random(1, MaxRobs)
  While rob(a).Exist = False
    a = Random(1, MaxRobs)
  Wend
End Function

' returns the eldest robot (for pop control)
Private Function eldest() As Integer
  Dim t As Integer
  Dim mxa As Integer
  Dim mxr As Integer
  mxa = 0
  For t = 1 To MaxRobs
    If rob(t).Exist And rob(t).age > mxa Then
      mxa = rob(t).age
      mxr = t
    End If
  Next t
  eldest = mxr
End Function

' returns the fittest robot (selected through the score function)
' altered from the bot with the most generations
' to the bot with the most invested energy in itself and children
Function fittest() As Integer
  Dim t As Integer
  Dim s As Double
  Dim Mx As Double
  Mx = 0
  For t = 1 To MaxRobs
    If rob(t).Exist And Not rob(t).Veg Then
      s = score(t, 1, 2, 0)
      If s >= Mx Then
        Mx = s
        fittest = t
      End If
    End If
  Next t
End Function

' does various things: with
' tipo=0 returns the number of descendants for maxrec generations
' tipo=1 highlights the descendants
' tipo=2 searches up the tree for eldest ancestor, then down again
' tipo=3 draws the lines showing kinship relations
Function score(ByVal r As Integer, ByVal reclev As Integer, maxrec As Integer, tipo As Integer) As Double
  Dim al As Integer
  Dim dx As Single
  Dim dy As Single
  Dim cr As Long
  Dim ct As Long
  Dim t As Integer
  If tipo = 2 Then plines (r)
  score = 0
  For t = 1 To MaxRobs
    If rob(t).Exist Then
      If rob(t).Parent = rob(r).AbsNum Then
        If reclev < maxrec Then score = score + score(t, reclev + 1, maxrec, tipo)
        score = score + InvestedEnergy(t)
        If tipo = 1 Then rob(t).highlight = True
        If tipo = 3 Then
          dx = (rob(r).pos.x - rob(t).pos.x) / 2
          dy = (rob(r).pos.y - rob(t).pos.y) / 2
          cr = RGB(128, 128, 128)
          ct = vbWhite
          If rob(r).AbsNum > rob(t).AbsNum Then
            cr = vbWhite
            ct = RGB(128, 128, 128)
          End If
          Line (rob(t).pos.x, rob(t).pos.y)-Step(dx, dy), ct
          Line -(rob(r).pos.x, rob(r).pos.y), cr
        End If
      End If
    End If
  Next t
  If tipo = 1 Then
    Form1.Cls
    DrawAllRobs
  End If
End Function
Function InvestedEnergy(t As Integer) As Double
'returns the amount of invested energy this bot has
'later will change to incorporate advanced energy types
  'InvestedEnergy = rob(t).nrg + rob(t).body * 10
  InvestedEnergy = 1
End Function

' goes up the tree searching for eldest ancestor
Private Sub plines(ByVal t As Integer)
  Dim p As Integer
  p = Parent(t)
  While p > 0
    t = p
    p = Parent(t)
  Wend
  If p = 0 Then p = t
  t = score(p, 1, 1000, 3)
End Sub

' returns the robot's parent
Function Parent(r As Integer) As Integer
  Dim t As Integer
  Parent = 0
  For t = 1 To MaxRobs
    If rob(t).AbsNum = rob(r).Parent And rob(t).Exist Then Parent = t
  Next t
End Function

'
'   MISC STUFF
'

' experimental initialization of the environment grid
' look class EnvGrid to know how to use it
Sub initenv()
  'Dim adat(10) As Single
  'Dim tdat(10) As Single
  'Dim mdat(10) As Single
  ' level 0: is wall
  ' level 1: O2
  ' level 2: CO2
  ' level 3: nutrient (waste)
  
  'adat(1) = 1
  'tdat(3) = 40
  'mdat(0) = 1
  'envir.CreateMaterial "water", &H550000, 10
  'envir.CreateMaterial "friction", &H333333, tdat
  'envir.CreateMaterial "wall", &HAAAAAA, mdat
  'envir.TraceSquare "friction", 0, 0, 120, 90
  'envir.TraceSquare "water", 30, 30, 70, 70
  'envir.TraceSquare "wall", 29, 29, 29, 71
  'envir.TraceSquare "wall", 29, 29, 71, 29
  'envir.TraceSquare "wall", 29, 71, 71, 71
  'envir.TraceSquare "wall", 71, 29, 71, 71
  'envir.TraceSquare "water", 48, 10, 52, 29
  'envir.TraceSquare "water", 48, 71, 52, 90
  'envir.TraceSquare "water", 10, 10, 48, 18
  'envir.DrawGrid Picture1
  'envir.DrawGrid False
  
  'Set EnvMap.Picture = Picture1.Image
  envgridpres = True
End Sub

''''''''''''''''''''''''''''''''''''''''''
Public Sub t_MouseDown(ByVal button As Integer)
  If MDIForm1.stealthmode Then
    MDIForm1.Show
    t.Remove
    MDIForm1.stealthmode = False
  End If
End Sub