The following is my final revision of the skin generator code.
The original code is 100% based on the randomizer.
My code is 50% based on the dna, 47% based on file name, and 3% based on the randomizer.
It also adds that special DNA length tag I need for my experiments.
Private Sub AssignSkin(k As Integer, path As String) 'need to pass full path of robot
Randomize 0
Dim robname As String
robname = Replace(TmpOpts.Specie(k).Name, ".txt", "")
Dim newR As Double
Dim nextR As Double
Dim nameR As Double
Dim x As Long
Dim dbls() As Double
ReDim dbls(Len(robname) - 1)
For x = 1 To Len(robname)
dbls(x - 1) = Rnd(-Asc(Mid(robname, x, 1)))
Next 'pre seeds
For x = 1 To Len(robname)
newR = dbls(x - 1)
nextR = Rnd(-(Fast_angle(nextR - 0.5, newR - 0.5)))
Next 'randomize by name
nameR = nextR
newR = 0
nextR = 0
Dim holdtext As String
Dim e7 As Integer 'make sure path contains dna length
Open path For Input As #21
Line Input #21, holdtext
Close #21
e7 = val(Replace(holdtext, "'", ""))
ReDim rob(0)
If LoadDNA(path, 0) Then
If e7 = 0 Then 'write dna length to file if not found
Dim grablength As Integer
Dim alldnatext As String
grablength = DnaLen(rob(0).DNA)
Open path For Input As #33 ' Open file.
Do While Not EOF(33) ' Loop until end of file.
alldnatext = alldnatext & Input(1, #33)
Loop
Close #33 ' Close file.
Open path For Output As #33
Print #33, "'" & grablength & Chr(13) & Chr(10) & alldnatext
Close #33
End If
Randomize 0
ReDim dbls(UBound(rob(0).DNA))
For x = 0 To UBound(rob(0).DNA)
dbls(x) = Rnd(-(Fast_angle(Rnd(-rob(0).DNA(x).value) - 0.5, Rnd(-rob(0).DNA(x).tipo) - 0.5)))
Next 'pre seeds
For x = 0 To UBound(rob(0).DNA)
newR = dbls(x)
nextR = Rnd(-(Fast_angle(nextR - 0.5, newR - 0.5)))
Next 'randomize by dna
ReDim rob(0)
End If
Randomize nextR * 1000
Dim i As Integer
If k > -1 Then
For i = 0 To 7 Step 2
TmpOpts.Specie(k).Skin(i) = Random(0, half)
TmpOpts.Specie(k).Skin(i + 1) = Random(0, 628)
If i = 2 Then Randomize nameR * 1000
Next i
Randomize
TmpOpts.Specie(k).Skin(6) = (TmpOpts.Specie(k).Skin(6) + Random(0, half) * 2) / 3
End If
End Sub
Private Function Fast_angle(ByVal dx As Single, ByVal dy As Single) As Single
Dim an As Single
If dx = 0 Then
'an = 0
an = PI / 2
If dy < 0 Then an = PI / 2 * 3
Else
an = Atn(dy / dx)
If dx < 0 Then
an = an + PI
End If
End If
Fast_angle = an / PI
End Function
Comments???