home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 7_2009-2012.ISO / data / zips / EVOLVING_C220927892011.psc / cls / clsCreature.cls next >
Text File  |  2011-07-06  |  15KB  |  532 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsCreature"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Public NP          As Long
  17. Public InvNP       As Single
  18.  
  19. Private P()        As tPoint
  20.  
  21. Public NL          As Long
  22. Private L()        As tLink
  23.  
  24. Public LinkLeft    As Long
  25. Public LinkRight   As Long
  26.  
  27.  
  28. Public CurrCenX    As Single
  29. Public CurrCenY    As Single
  30. Public CurrVX      As Single
  31. Public CurrVY      As Single
  32. Public CurrDX      As Single
  33. Public CurrDY      As Single
  34. Public CurrHeightfromGround As Single
  35.  
  36. Public InvSIZE     As Single
  37.  
  38. Private Const BrainedLinkMAXExcursion As Single = 0.8    '.6  '1=from 50% to 150%
  39.  
  40. Public TaskWalk    As Single
  41. Public TaskAVGheight As Single
  42. Public TaskMAXHeight As Single
  43. Public TaskDontJUMP As Single
  44. Public TaskVerticality As Single
  45. Public TaskHorizontality As Single
  46.  
  47. Private Const Walk_Mult As Single = 0.01
  48. Private Const AVGH_Mult As Single = 0.14
  49. Private Const MaxH_Mult As Single = 0.05
  50. Private Const DontJump_Mult As Single = 1
  51. Private Const Orient_Mult As Single = 20
  52.  
  53. Public DrawOffset As Long
  54. Public CurrANG As Single
  55. Public OLDAng As Single
  56. Public RotVEL As Single
  57.  
  58. Public Property Get getpointX(wP As Long) As Single
  59.     getpointX = P(wP).X
  60. End Property
  61. Public Property Get getpointY(wP As Long) As Single
  62.     getpointY = P(wP).Y
  63. End Property
  64.  
  65. Public Property Let AdjAddedBrainLenToReach(wL As Long, Value As Single)
  66.     'Value Must be between -0.5 and 0.5
  67.     L(wL).AddedBrainLenToReach = L(wL).MainLen * Value * BrainedLinkMAXExcursion
  68.  
  69. End Property
  70. Public Property Get GetLinkP1(wL As Long) As Single
  71.     GetLinkP1 = L(wL).P1
  72. End Property
  73. Public Property Get GetLinkP2(wL As Long) As Single
  74.     GetLinkP2 = L(wL).P2
  75. End Property
  76. Public Property Get GetLinkTension(wL As Long) As Single
  77.     GetLinkTension = L(wL).TENSION
  78. End Property
  79. Public Property Get GetLinkMainL(wL As Long) As Single
  80.     GetLinkMainL = L(wL).MainLen
  81. End Property
  82. Public Property Get GetCurrAddedBrainLen(wL As Long) As Single
  83. GetCurrAddedBrainLen = L(wL).CurrAddedBrainLen
  84. End Property
  85. Public Property Get GetTouchGround(wP As Long) As Single
  86.     GetTouchGround = P(wP).IsOnGround
  87. End Property
  88.  
  89. Public Property Get IsLinkDynamic(wL As Long) As Boolean
  90.     IsLinkDynamic = L(wL).Dynamic
  91. End Property
  92.  
  93. Public Property Let IsLinkDynamic(wL As Long, V As Boolean)
  94.     L(wL).Dynamic = V
  95. End Property
  96.  
  97. 'Public Property Get GetDX() As Single
  98. '    'GetDX = (P(NP).X - P(1).X)
  99. '    GetDX = 0.5 * (P(L(NL).P1).X + P(L(NL).P2).X - P(L(1).P1).X - P(L(1).P2).X)
  100. 'End Property
  101. 'Public Property Get GetDY() As Single
  102. '    'Getdy = (P(NP).y - P(1).y)
  103. '    GetDY = 0.5 * (P(L(NL).P1).Y + P(L(NL).P2).Y - P(L(1).P1).Y - P(L(1).P2).Y)
  104. 'End Property
  105. 'Public Property Get GetPOS() As Single
  106. '    GetPOS = (P(1).X + P(NP).X) * 0.5
  107. 'End Property
  108. 'Public Property Get GetHeightAVG() As Single
  109. '    Dim I          As Long
  110. '    For I = 1 To NP Step 1        '3
  111. '        GetHeightAVG = GetHeightAVG + P(I).Y
  112. '    Next
  113. '    GetHeightAVG = GetHeightAVG / (NP)
  114. 'End Property
  115. 'Public Property Get GetHeightfromGround() As Single
  116. '    Dim I          As Long
  117. '    Dim Max        As Single
  118. '    Max = 0
  119. '    For I = 1 To NP
  120. '        If (MaxY - P(I).Y) > Max Then Max = MaxY - P(I).Y
  121. '        GetHeightfromGround = Max
  122. '    Next
  123. 'End Property
  124. 'Public Property Get GetVY() As Single
  125. '    Dim I          As Long
  126. '    For I = 1 To NP
  127. '        GetVY = GetVY + P(I).vY
  128. '    Next
  129. '    GetVY = GetVY / NP
  130. 'End Property
  131. Public Sub ADDpoint(X As Single, Y As Single)
  132.     NP = NP + 1
  133.     ReDim Preserve P(NP)
  134.     With P(NP)
  135.         .X = X
  136.         .Y = Y
  137.         .vX = 0
  138.         .vY = 0
  139.         .IsOnGround = 0
  140.         .IvX = 0
  141.         .IvY = 0
  142.     End With
  143.     InvNP = 1 / NP
  144. End Sub
  145.  
  146. Public Sub AddLink(P1 As Long, P2 As Long, ByVal Stren As Single, Optional IsDynamic As Boolean = False)
  147.     Dim Xmax       As Single
  148.     Dim Xmin       As Single
  149.     Dim Ymax       As Single
  150.     Dim Ymin       As Single
  151.  
  152.     Dim X          As Single
  153.     Dim Y          As Single
  154.     Dim I          As Long
  155.     Dim V          As Single
  156.     Dim lTOP       As Long
  157.     Dim lBOTTOM    As Long
  158.  
  159.     'If IsDynamic Then Stren = Stren * 0.75
  160.  
  161.  
  162.     NL = NL + 1
  163.     ReDim Preserve L(NL)
  164.     With L(NL)
  165.         .P1 = P1
  166.         .P2 = P2
  167.         .Dynamic = IsDynamic
  168.         .MainLen = PointDist(P(P1), P(P2))
  169.         .InvMainLen = 1 / .MainLen
  170.         .Stren = Stren
  171.  
  172.         .AddedBrainLenToReach = 0
  173.         .CurrAddedBrainLen = 0
  174.         
  175.         .TENSION = 0
  176.        
  177.         
  178.     End With
  179.  
  180.     Xmax = -999999999
  181.     Xmin = 99999999999#
  182.     Ymax = -999999999
  183.     Ymin = 99999999999#
  184.  
  185.  
  186.     For I = 1 To NL
  187.         X = (P(L(I).P1).X + P(L(I).P2).X) * 0.5
  188.         If X > Xmax Then Xmax = X: LinkRight = I
  189.         If X < Xmin Then Xmin = X: LinkLeft = I
  190.         Y = (P(L(I).P1).Y + P(L(I).P2).Y) * 0.5
  191.         If Y > Ymax Then Ymax = Y: lBOTTOM = I
  192.         If Y < Ymin Then Ymin = Y: lTOP = I
  193.     Next
  194.  
  195.  
  196.     If Xmax - Xmin > Ymax - Ymin Then
  197.         V = (P(L(LinkRight).P1).X + P(L(LinkRight).P2).X) * 0.5 - _
  198.             (P(L(LinkLeft).P1).X + P(L(LinkLeft).P2).X) * 0.5
  199.     Else
  200.         V = (P(L(lBOTTOM).P1).Y + P(L(lBOTTOM).P2).Y) * 0.5 - _
  201.             (P(L(lTOP).P1).Y + P(L(lTOP).P2).Y) * 0.5
  202.     End If
  203.  
  204.     If V <> 0 Then InvSIZE = 1 / V
  205.  
  206. End Sub
  207.  
  208. Public Sub ClearAll()
  209.     NP = 0
  210.     NL = 0
  211.     CurrCenX = 0
  212.     CurrCenY = 0
  213.     CurrVX = 0
  214.     CurrVY = 0
  215.     CurrDX = 0
  216.     CurrDY = 0
  217.     CurrHeightfromGround = 0
  218.     
  219.     CurrANG = 0
  220.     OLDAng = 0
  221.     RotVEL = 0
  222.     
  223.     ResetTaskValues
  224.  
  225. End Sub
  226. Public Sub ResetTaskValues()
  227.     TaskWalk = 30
  228.     TaskAVGheight = 0
  229.     TaskMAXHeight = 1E+17
  230.     TaskDontJUMP = 0
  231.     TaskVerticality = 0
  232.     TaskHorizontality = 0
  233. End Sub
  234. Public Sub DRAW(hdc As Long, ByVal drPANX As Long, Optional DrawPts As Boolean = False, Optional Antialias As Boolean = False)
  235.     Dim x1         As Long
  236.     Dim y1         As Long
  237.     Dim X2         As Long
  238.     Dim Y2         As Long
  239.  
  240.     Dim I          As Long
  241.  
  242.     Dim C          As Long
  243.     Dim C1         As Long
  244.     Dim C2         As Long
  245.  
  246.     Dim V          As Single
  247.  
  248.     For I = 1 To NL
  249.         With L(I)
  250.             x1 = P(.P1).X - drPANX + DrawOffset
  251.             y1 = P(.P1).Y
  252.             X2 = P(.P2).X - drPANX + DrawOffset
  253.             Y2 = P(.P2).Y
  254.  
  255.             C1 = .TENSION * 255
  256.             If Abs(C1) > 255 Then C1 = Sgn(C1) * 255
  257.  
  258.             If Antialias Then
  259.                 If .Dynamic Then
  260.                     C = GradDynamic2.GetGrad(C1)
  261.                 Else
  262.                     C = GradStatic2.GetGrad(C1)
  263.                 End If
  264.                 AAA.LineDIB x1, y1, X2, Y2, C
  265.             Else
  266.                 If .Dynamic Then
  267.                     C = GradDynamic1.GetGrad(C1)
  268.                 Else
  269.                     C = GradStatic1.GetGrad(C1)
  270.                 End If
  271.                 FastLine hdc, x1, y1, X2, Y2, 2, C
  272.             End If
  273.         End With
  274.  
  275.  
  276.         'Y1 = CurrCenY \ 1
  277.         'X1 = CurrCenX \ 1
  278.         'Y2 = Y1 + CurrVY * 100
  279.         'X2 = X1 + CurrVX * 100
  280.         'FastLine HDC, X1, Y1, X2, Y2, 2, vbRed
  281.         '
  282.         'X2 = X1 + (CurrDX * 0.5) \ 1
  283.         'Y2 = Y1 + (CurrDY * 0.5) \ 1
  284.         'FastLine HDC, X1, Y1, X2, Y2, 2, vbGreen
  285.     Next
  286.  
  287.     If DrawPts Then
  288.         For I = 1 To NP
  289.             C = P(I).IsOnGround * 510 - 255
  290.             If Antialias Then
  291.                 C = GradGround2.GetGrad(C)
  292.                 AAA.CircleDIB P(I).X \ 1 - drPANX + DrawOffset, P(I).Y \ 1, 1, 1, C
  293.                 AAA.CircleDIB P(I).X \ 1 - drPANX + DrawOffset, P(I).Y \ 1, 2, 2, C
  294.             Else
  295.                 C = GradGround1.GetGrad(C)
  296.                 MyCircle hdc, P(I).X \ 1 - drPANX + DrawOffset, P(I).Y \ 1, 3, 2, C
  297.             End If
  298.         Next
  299.     End If
  300.  
  301.  
  302.  
  303. End Sub
  304.  
  305. Public Sub DoPhysics2(ByVal MyIDX As Long)
  306.     Dim dx         As Single
  307.     Dim dy         As Single
  308.     Dim ndx        As Single
  309.     Dim ndy        As Single
  310.     Dim D          As Single
  311.     Dim I          As Long
  312.     Dim resF       As Single
  313.     Dim vX         As Single
  314.     Dim vY         As Single
  315.     Dim CX         As Single
  316.     Dim CY         As Single
  317.     Dim DDD        As Single
  318.  
  319.     Dim A          As Single
  320.     Dim vx1        As Single
  321.     Dim vy1        As Single
  322.     Dim vx2        As Single
  323.     Dim vy2        As Single
  324.     Dim MAG        As Single
  325.  
  326.  
  327.     For I = 1 To NL
  328.         With L(I)
  329.  
  330.             dx = P(.P2).X - P(.P1).X
  331.             dy = P(.P2).Y - P(.P1).Y
  332.             dx = dx + (P(.P2).vX - P(.P1).vX) * 10
  333.             dy = dy + (P(.P2).vY - P(.P1).vY) * 10
  334.  
  335.             D = Sqr(dx * dx + dy * dy)
  336.             If D <> 0 Then
  337.                 ndx = dx / D
  338.                 ndy = dy / D
  339.             End If
  340.  
  341.             'Update3:
  342.             .CurrAddedBrainLen = .CurrAddedBrainLen * 0.98 + .AddedBrainLenToReach * 0.02
  343.             'smooth
  344.  
  345.             If .Dynamic Then
  346.                 resF = (.MainLen - D + .CurrAddedBrainLen)
  347.                 .TENSION = 3 * resF / (.MainLen + .CurrAddedBrainLen)
  348.                 resF = resF * .Stren
  349.             Else
  350.                 resF = (.MainLen - D)
  351.                 .TENSION = 3 * resF * .InvMainLen
  352.                 resF = resF * .Stren
  353.             End If
  354.             resF = resF * 0.01    '0.01   ' 0.012
  355.  
  356.             dx = ndx * resF
  357.             dy = ndy * resF
  358.  
  359.             If Abs(.TENSION) > 1 Then .TENSION = Sgn(.TENSION)
  360.  
  361.             P(.P1).IvX = P(.P1).IvX - dx
  362.             P(.P1).IvY = P(.P1).IvY - dy
  363.             P(.P2).IvX = P(.P2).IvX + dx
  364.             P(.P2).IvY = P(.P2).IvY + dy
  365.         End With
  366.     Next
  367.  
  368.  
  369.     CurrHeightfromGround = 9999999
  370.     For I = 1 To NP
  371.         With P(I)
  372.             .IsOnGround = .IsOnGround * 0.985
  373.  
  374.             .vX = .vX + .IvX: .IvX = 0
  375.             .vY = .vY + .IvY: .IvY = 0
  376.  
  377.             .vY = .vY + GravityY
  378.             .vX = .vX * AirResistence
  379.  
  380.             .X = .X + .vX
  381.             .Y = .Y + .vY
  382.  
  383.             If .Y > MaxY Then
  384.                 ' Update2: smoothed touch ground sensor (Sort of Pressure) ---------------
  385.                 .IsOnGround = .IsOnGround + .vY * 15    ' 100 * Sqr(.vY * .vY + .vX * .vX)
  386.                 If .IsOnGround > 1 Then .IsOnGround = 1
  387.                 '----------------------------------------
  388.  
  389.                 If MyIDX = CurBEST Then
  390.  
  391.                     A = Atan2(.vX, -.vY)
  392.                     MAG = Sqr(.vX * .vX + .vY * .vY) * 1.1
  393.                     If MAG > 0.02 Then
  394.                         vx1 = Cos(A + 0.25) * MAG
  395.                         vy1 = Sin(A + 0.25) * MAG
  396.                         vx2 = Cos(A - 0.25) * MAG
  397.                         vy2 = Sin(A - 0.25) * MAG
  398.                         AddParticle .X + DrawOffset, .Y - 1, .vX * 1.2, -.vY * 1.2 - 0.01
  399.                         AddParticle .X + DrawOffset, .Y - 1, vx1, vy1 - 0.01
  400.                         AddParticle .X + DrawOffset, .Y - 1, vx2, vy2 - 0.01
  401.                     End If
  402.  
  403.                 End If
  404.  
  405.                 .Y = MaxY
  406.                 .vY = -.vY * Bounce
  407.                 .vX = .vX * Friction
  408.  
  409.             End If
  410.  
  411.             CX = CX + .X
  412.             CY = CY + .Y
  413.             vX = vX + .vX
  414.             vY = vY + .vY
  415.             If (MaxY - .Y) < CurrHeightfromGround Then CurrHeightfromGround = MaxY - .Y
  416.         End With
  417.     Next
  418.  
  419.     CurrCenX = CX * InvNP
  420.     CurrCenY = CY * InvNP
  421.     CurrVY = vY * InvNP
  422.     CurrVX = vX * InvNP
  423.     CurrDX = (P(L(LinkRight).P1).X + P(L(LinkRight).P2).X - P(L(LinkLeft).P1).X - P(L(LinkLeft).P2).X)    '*.5
  424.     CurrDY = (P(L(LinkRight).P1).Y + P(L(LinkRight).P2).Y - P(L(LinkLeft).P1).Y - P(L(LinkLeft).P2).Y)    '*.5
  425.  
  426.     OLDAng = CurrANG
  427.     CurrANG = Atan2(CurrDX, CurrDY)
  428.     RotVEL = 100 * AngleDIFF(OLDAng, CurrANG)
  429.     If RotVEL > 1 Then
  430.         RotVEL = 1
  431.     ElseIf RotVEL < -1 Then RotVEL = -1
  432.     End If
  433.  
  434.     DDD = Sqr(CurrDX * CurrDX + CurrDY * CurrDY)
  435.     If DDD <> 0 Then CurrDX = CurrDX / DDD: CurrDY = CurrDY / DDD
  436.  
  437.     TaskWalk = TaskWalk - (CurrVX) * Walk_Mult
  438.     TaskAVGheight = TaskAVGheight + CurrCenY * AVGH_Mult
  439.     If CurrCenY < TaskMAXHeight Then TaskMAXHeight = CurrCenY * MaxH_Mult
  440.     TaskDontJUMP = TaskDontJUMP + CurrHeightfromGround * DontJump_Mult
  441.     TaskVerticality = TaskVerticality + Abs(CurrDX) * Orient_Mult
  442.     TaskHorizontality = TaskHorizontality + Abs(CurrDY) * Orient_Mult
  443.  
  444.  
  445.  
  446.  
  447.  
  448.  
  449. End Sub
  450. Public Sub SaveMe(ByVal filename As String)
  451.     Dim MinX       As Long
  452.     Dim MinY       As Long
  453.     Dim MaxX       As Long
  454.     Dim MaxY       As Long
  455.     Dim I          As Long
  456.  
  457.     If Right$(filename, 4) <> ".cre" Then filename = filename & ".cre"
  458.     filename = App.Path & "\" & filename
  459.  
  460.  
  461.     MaxX = -1
  462.     MaxY = -1
  463.     MinX = 9999999
  464.     MinY = 9999999
  465.  
  466.     For I = 1 To NP
  467.         If P(I).X > MaxX Then MaxX = P(I).X
  468.         If P(I).Y > MaxY Then MaxY = P(I).Y
  469.         If P(I).X < MinX Then MinX = P(I).X
  470.         If P(I).Y < MinY Then MinY = P(I).Y
  471.     Next
  472.  
  473.  
  474.     Open filename For Output As 1
  475.     Print #1, "Points:"
  476.     Print #1, NP
  477.     For I = 1 To NP
  478.         Print #1, P(I).X - MinX
  479.         Print #1, P(I).Y - MaxY
  480.     Next
  481.     Print #1, "Links:"
  482.     Print #1, NL
  483.     For I = 1 To NL
  484.         Print #1, L(I).P1
  485.         Print #1, L(I).P2
  486.         Print #1, Replace(L(I).Stren, ",", ".")
  487.         Print #1, CLng(L(I).Dynamic)
  488.     Next
  489.  
  490.     Close 1
  491.  
  492. End Sub
  493.  
  494. Public Sub LoadMe(ByVal filename As String, Left As Long, Bottom As Long)
  495.  
  496.     Dim I          As Long
  497.     Dim S          As String
  498.     Dim V1         As Long
  499.     Dim V2         As Long
  500.     Dim Stre       As Single
  501.     Dim v4         As Long
  502.     Dim N          As Long
  503.  
  504.     If Right$(filename, 4) <> ".cre" Then filename = filename & ".cre"
  505.     filename = App.Path & "\" & filename
  506.  
  507.  
  508.     ClearAll
  509.  
  510.     Open filename For Input As 1
  511.     Input #1, S                   '"Points:"
  512.     Input #1, N
  513.     For I = 1 To N
  514.         Input #1, V1
  515.         Input #1, V2
  516.         ADDpoint V1 + Left, V2 + Bottom
  517.     Next
  518.     Input #1, S                   ' "Links:"
  519.     Input #1, N
  520.     For I = 1 To N
  521.         Input #1, V1
  522.         Input #1, V2
  523.         Input #1, Stre
  524.         Input #1, v4
  525.         AddLink V1, V2, Stre, CBool(v4)
  526.     Next
  527.  
  528.     Close 1
  529.  
  530.  
  531. End Sub
  532.