Elevage de nurmites

Soyez le premier à donner votre avis sur cette source.

Snippet vu 3 764 fois - Téléchargée 62 fois

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...

A voir également

Ajouter un commentaire

Commentaires

cs_olid
Messages postés
296
Date d'inscription
lundi 2 septembre 2002
Statut
Membre
Dernière intervention
28 janvier 2008
-
Heu...J'adore :ox

Par contre, tu pourrais dire quels parametres il foudrait pour que sa tourne indéfiniment.....paske voir la civilization nurmite mourrir en kelkes secondes, za me fend le coeur :o((
cs_Mémère
Messages postés
223
Date d'inscription
samedi 24 mars 2001
Statut
Modérateur
Dernière intervention
24 juin 2007
-
Et bien c'est peut être une forme refoulée de jalousie devant ton niveau de médiocrité? A méditer je pense!
GarnetDiAlexandros
Messages postés
55
Date d'inscription
mercredi 31 juillet 2002
Statut
Membre
Dernière intervention
19 novembre 2004
-
Si vraiment tu t'ennuies, fais comme moi
tu mets que des 1 à la personne que tu aimes le moins sur le site
moi, c'est toi que je peux pas voir ...
Trop l'délire.
une amélioration : La reproduction de nurmites !!!
ca serait marrant ;-) lol
Oh? tu es frustré?

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.