Elevage de nurmites

Commenter

Contenu du snippet

Ben oui... Il vient un jour ou l'on se fait plus jeune, on a alors des passes temps pour amuser nos journées, par exemple l'élevage de nurmites! Pout les incultes, les nurmites sont des petits êtres aussi intelligents que le croisement entre une amibes et un américain de base, ils naissent, ils vont manger au Mc Do et ils crèvent... c'est pas plus compliqué que ça!

Nécessite une Form avec une PictureBox ET un Timer!

Source / Exemple : 


' Une bandes de nurmites rien que pour vous...
' ATTENTION, l'élevage de nurmites et réglementé!
' Copyright'Mémère[2001] - Release 1.02

Const xCols = 30
Const xRows = 20
Const xCount = 3
Const NURM_FREEDOM = 1
Const NURM_TARGETED = 2

Dim Matrix(xCols, xRows) As Integer
Dim XNurm(xCount), YNurm(xCount), xState(xCount) As Integer
Dim XDest(xCount), YDest(xCount) As Integer
Dim iFaim(xCount) As Integer
Dim MapState$

Sub InitControles()
 Picture1.Width = xCols * 10 * 15: Picture1.Height = xRows * 10 * 15
 Picture1.Appearance = 0: Picture1.AutoRedraw = True
 Picture1.Top = 0: Picture1.Left = 0
 Me.Width = Picture1.Width + 115: Me.Height = Picture1.Height + 410
 Picture1.Top = 0
 Picture1.Left = 0
 Me.Caption = "[Initialising]"
 Call InitMatrix
 Call DrawLandsLair
 Timer1.Interval = 10
End Sub

Sub DrawLandsLair()
 Picture1.Cls
 For i = 0 To Picture1.Width Step Picture1.Width / xCols
  Picture1.Line (i, 0)-(i, Picture1.Height), RGB(0, 0, 0)
 Next i
 For i = 0 To Picture1.Height Step Picture1.Height / xRows
  Picture1.Line (0, i)-(Picture1.Width, i), RGB(0, 0, 0)
 Next i
 For i = 0 To xRows
  For j = 0 To xCols
   If Matrix(j, i) = 1 Then Picture1.Line (j * 10 * 15 + 15, i * 10 * 15 _
   + 15)-((j + 1) * 10 * 15 - 15, (i + 1) * 10 * 15 - 15), RGB(0, 0, 127), BF
  Next j
 Next i
 MapState$ = " - Great food!"
End Sub

Sub InitMatrix()
 For i = 0 To xRows
  For j = 0 To xCols
   Hazard = Int(Rnd * 10)
   Select Case Hazard
    Case 1
     Matrix(j, i) = 1
    Case Else
     Matrix(j, i) = 0
   End Select
  Next j
 Next i
 For Nurm = 0 To xCount
  XNurm(Nurm) = Int(Rnd * xCols): YNurm(Nurm) = Int(Rnd * xRows)
  xState(Nurm) = NURM_FREEDOM: iFaim(Nurm) = 60
 Next Nurm
End Sub

Sub Animate()
 NbAlive = 0
 For Nurm = 0 To xCount
  If XNurm(Nurm) <> -1 Then
   NbAlive = NbAlive + 1
   Picture1.Line (XNurm(Nurm) * 10 * 15 + 15, YNurm(Nurm) * 10 * 15 + 15)- _
               ((XNurm(Nurm) + 1) * 10 * 15 - 15, (YNurm(Nurm) + 1) * 10 * _
               15 - 15), RGB(255, 255, 255), BF
   If Int(Rnd * 1) = 0 Then iFaim(Nurm) = iFaim(Nurm) - 1
   If iFaim(Nurm) = 0 Then
    Matrix(XNurm(Nurm), YNurm(Nurm)) = 1
    Picture1.Line (XNurm(Nurm) * 10 * 15 + 15, YNurm(Nurm) * 10 * 15 + 15)- _
                ((XNurm(Nurm) + 1) * 10 * 15 - 15, (YNurm(Nurm) + 1) * 10 * _
                15 - 15), RGB(0, 0, 127), BF
    XNurm(Nurm) = -1
    Exit Sub
   End If
   If iFaim(Nurm) < 50 Then
    xState(Nurm) = NURM_TARGETED
    Call FindAMcDo(XNurm(Nurm), YNurm(Nurm), Nurm)
   End If
   If xState(Nurm) = NURM_TARGETED Then
    If XDest(Nurm) < XNurm(Nurm) Then XNurm(Nurm) = XNurm(Nurm) - 1
    If XDest(Nurm) > XNurm(Nurm) Then XNurm(Nurm) = XNurm(Nurm) + 1
    If YDest(Nurm) < YNurm(Nurm) Then YNurm(Nurm) = YNurm(Nurm) - 1
    If YDest(Nurm) > YNurm(Nurm) Then YNurm(Nurm) = YNurm(Nurm) + 1
   End If
   If xState(Nurm) = NURM_FREEDOM Then
    Hazard = Int(Rnd * 3)
    Select Case Hazard
     Case 0: XNurm(Nurm) = XNurm(Nurm) - 1
     Case 1: XNurm(Nurm) = XNurm(Nurm) + 1
     Case 2: YNurm(Nurm) = YNurm(Nurm) - 1
     Case 3: YNurm(Nurm) = YNurm(Nurm) + 1
    End Select
   End If
   If XNurm(Nurm) < 0 Then XNurm(Nurm) = xCols
   If YNurm(Nurm) < 0 Then YNurm(Nurm) = xRows
   If XNurm(Nurm) > xCols Then XNurm(Nurm) = 0
   If YNurm(Nurm) > xRows Then YNurm(Nurm) = 0
   If Matrix(XNurm(Nurm), YNurm(Nurm)) = 1 Then
    Matrix(XNurm(Nurm), YNurm(Nurm)) = 0
    iFaim(Nurm) = iFaim(Nurm) + 10
    xState(Nurm) = NURM_FREEDOM
   End If
   iColor = RGB(0, 127, 0)
   If xState(Nurm) = NURM_FREEDOM Then iColor = RGB(255, 0, 0)
   Picture1.Line (XNurm(Nurm) * 10 * 15 + 15, YNurm(Nurm) * 10 * 15 + 15)- _
                ((XNurm(Nurm) + 1) * 10 * 15 - 15, (YNurm(Nurm) + 1) * 10 _


                    
  •  15 - 15), iColor, BF

  End If
 Next Nurm
 If NbAlive - 1 > 0 Then
  Me.Caption = "Life wanna play [" + Str$(NbAlive) + " Nurms ]" + MapState$
 Else
  Me.Caption = "Life wanna play [" + Str$(NbAlive) + " Nurm ]" + MapState$
 End If
End Sub

Sub FindAMcDo(X, Y, ID)
 Shortest = 1000
 For i = 0 To xRows
  For j = 0 To xCols
   If Matrix(j, i) = 1 Then
    Distance = Sqr((Abs(j - X)) ^ 2 + (Abs(i - Y)) ^ 2)
    If Distance < Shortest Then
     Shortest = Distance
     XDest(ID) = j: YDest(ID) = i
    End If
   End If
  Next j
 Next i
 If Shortest = 1000 Then xState(ID) = NURM_FREEDOM: MapState$ = " - Plus de Mc Do..."
End Sub

Private Sub Form_Load()
 Call InitControles
 Call Animate
End Sub

Private Sub Timer1_Timer()
 Call Animate
End Sub

Conclusion :


<CENTER><IMG SRC='http://manipulator.free.fr/captures/nurms.jpg' WIDTH=343 HEIGHT=264></CENTER>

C'est y pas beau de les regarder crever? Remarquez que vous pouvez changer les paramètres pour leur donner des plus gros BigMac ou pour agrandir le terrain de chasse. Mettez en plein! Faites un élevage planétaire!!Aaaahhhhhh!!!

Remarquez qu'un Nurmite mort devient à son tour un Big Mac! Les nurmites sont canibales...
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Mémère)