FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» StratégoV8 et V9
par Minibug Aujourd'hui à 1:10

» Rotation d'une image d'un angle quelconque
par JL35 Hier à 23:02

» GRID_LOAD
par Jean Claude Hier à 21:04

» HVIEWER
par Yannick Hier à 20:31

» KGF_dll - nouvelles versions
par Klaus Mar 16 Jan 2018 - 21:28

» Déformation d'image en trapèze
par mindstorm Mar 16 Jan 2018 - 21:06

» Mah-Jong américain
par Jean Claude Lun 15 Jan 2018 - 19:37

» Problème avec Deepl
par Klaus Lun 15 Jan 2018 - 0:34

» Quelques nouvelles ...
par Jean Claude Ven 12 Jan 2018 - 22:40

» Renommer les instructions ITEM_... ?
par Jicehel Ven 12 Jan 2018 - 18:56

» Ludothèque Panoramic
par jjn4 Ven 12 Jan 2018 - 18:11

» sous-programmes et fonctions
par Jack Ven 12 Jan 2018 - 17:51

» Mah-Jong français
par Jean Claude Jeu 11 Jan 2018 - 22:15

» panoramic 0.9.28
par gigi75 Ven 5 Jan 2018 - 14:06

» Un jeu qui va vous énerver!
par Jean Claude Jeu 4 Jan 2018 - 22:05

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Janvier 2018
LunMarMerJeuVenSamDim
1234567
891011121314
15161718192021
22232425262728
293031    
CalendrierCalendrier

Partagez | 
 

 Le jeu de la vie

Voir le sujet précédent Voir le sujet suivant Aller en bas 
AuteurMessage
Klaus

avatar

Nombre de messages : 10413
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Le jeu de la vie   Mer 9 Nov 2016 - 0:41

J'ai fait un petit jeu en 100 % Panoramiv, sans DLL.

Le jeu de la vie n'est en fait pas un vrai jeu. C'est juste un petit plaisir visuel de voir évoluer une population croissante (ou décroissante...) selon des règles fixées au départ, et des contraintes comme des obstacles infranchissables.

Cela se passe dans un terrain de jeu qui est toujours affiché en plein écran. Il est divisé en N cases de M colonnes. Chaque case peut, soit être vide (couleur neutre), soit contenir un individu (couleur jaune) soit un obstacle (couleur noire). Chaque individu peut avoir de zéro à huit voisins (cellules immédiatement en contact). Et la vie de l'individu évolue en fonction du nombre de ses voisins. Le tout se déroule par cycles dont la durée, tout comme les autres paramètres, sont configurées dans une fenêtre de paramétrage par le menu Jeu/Nouveau. Le nombre de lignes est limitée à 100, et le nombre de colonnes à 150.

Les règles sont les suivantes:
- en-dessous d'un minimum de voisins, le sujet meurt de solitude.
- au-dessus d'un maximum de voisins, le sujet meurt d'étouffement.
- au-dessus d'un minimum de voisins, le sujet se reproduit et crée un autre sujet "rejeton".
- si le sujet doit se reproduire et ne trouve pas de case vide immédiatement en contact, le sujet meurt en couches.
- si un sujet se reproduit et trouve plusieurs cases vides directement en contact, la case recevant le rejeton est tiré au hasard.

Petite cerise sur le gateau: le jeu peut être mis en pause, relancé, et même modifié pendant qu'il est en pause (ajout/retraits de sujets, ajout/retrait d'obstacles), et même enregistré pour être rechargé ultérieurement.

Voici le code:
Code:
' Evolution_de_populations.bas

labels()
constantes()
variables()
menus()
GUI()
invisibles()
initialisations()

end

sub labels()
  label sortir, clic, tick
  label nouveau, close_form_nouveau, validernouveau
  label demarrer, pauser, continuer
  label peupler, effacerpopulation, obstacles, effacerobstacles, finedition
  label enregistrer, enregistrersous, charger
  label aide, apropos
end_sub

sub constantes()
  dim no_timer%            : no_timer%        =  90       : ' timer gérant la vitesse du jeu
  dim no_terrain%          : no_terrain%      = 100       : ' terrain de jeu
  dim no_form_nouveau%     : no_form_nouveau% = 200       : ' fenêtre de configuration d'un nouveau jeu
  dim no_open%             : no_open%         =  81       : ' dialogue d'ouverture
  dim no_save%             : no_save%         =  82       : ' dialogue dd sauvegarde
  dim no_form_aide%        : no_form_aide%    = 300       : ' fenêtre d'aide
end_sub

sub variables()
  dim EnCours%
'  dim terrain%(10,10)  : ' sera créé dynamiquement par le menu "Nouveau"
'     Une cellule de ce tableau est:  0=vide  1=population  2=obstacle
'     Cellules spéciales:
'       (0,1) = Lignes%
'       (0,2) = Colonnes%
'       (Ligne%+1,1) = MiniSurvie%
'       (Ligne%+1,2) = MiniReproduction%
'       (Ligne%+2,1) = MaxiSurvie%
'       (Ligne%+3,1) = Cycle%
'       (Ligne%+3,2) = TimerInterval%
  dim no_hauteur_terrain%, no_largeur_terrain%
  dim no_mini_survie%, no_mini_reproduction%, no_maxi_survie%, no_interval%
  dim ParametresValides%
  dim PhaseEdition%
  dim Lignes%, Colonnes%, cw%, ch%, Cycle%, TimerInterval%
  dim MiniSurvie%, MiniReproduction%, MaxiSurvie%
  dim fichier$
end_sub

sub menus()
  main_menu 1
    sub_menu 2 : parent 2,1 : caption 2,"Jeu"
      sub_menu 3 : parent 3,2 : caption 3,"Nouveau"                : on_click 3,nouveau
      sub_menu 4 : parent 4,2 : caption 4,"Démarrer"               : on_click 4,demarrer
      sub_menu 5 : parent 5,2 : caption 5,"Pause"                  : on_click 5,pauser
      sub_menu 6 : parent 6,2 : caption 6,"Continuer"              : on_click 6,continuer
      sub_menu 7 : parent 7,2 : caption 7,"-"
      sub_menu 8 : parent 8,2 : caption 8,"Enregistrer"            : on_click 8,enregistrer
      sub_menu 9 : parent 9,2 : caption 9,"Enregistrer sous..."    : on_click 9,enregistrersous
      sub_menu 10 : parent 10,2 : caption 10,"Charger..."          : on_click 10,charger
      sub_menu 11 : parent 11,2 : caption 11,"-"
      sub_menu 12 : parent 12,2 : caption 12,"Sortir"              : on_click 12,sortir
    sub_menu 30 : parent 30,1    : caption 30,"Edition"
      sub_menu 31 : parent 31,30 : caption 31,"Peupler"            : on_click 31,peupler
      sub_menu 32 : parent 32,30 : caption 32,"Effacer population" : on_click 32,effacerpopulation
      sub_menu 33 : parent 33,30 : caption 33,"Obstacles"          : on_click 33,obstacles
      sub_menu 34 : parent 34,30 : caption 34,"Effacer Obstacles"  : on_click 34,effacerobstacles
      sub_menu 35 : parent 35,30 : caption 35,"-"
      sub_menu 36 : parent 36,30 : caption 36,"Fin phase Edition"  : on_click 36,finedition
    sub_menu 20 : parent 20,1 : caption 20,"Aide"
      sub_menu 21 : parent 21,20 : caption 21,"Aide"               : on_click 21,aide
      sub_menu 22 : parent 22,20 : caption 22,"Apropos"            : on_click 22,apropos
end_sub

sub GUI()
  full_space 0
  caption 0,"Evolution de populations"
end_sub

sub invisibles()
  timer no_timer% : timer_off no_timer% : on_timer no_timer%, tick
  open_dialog no_open%
  save_dialog no_save%
end_sub

sub initialisations()
  EnCours%           = 0    : ' pas de partie en cours
  ParametresValides% = 0    : ' pas de paramètres valides
  PhaseEdition%      = 0    : ' pas en phase d'édition
  TimerInterval%     = 1000 : ' intervalle entre deux itérations
  Lignes%            = 10   : ' nombre de lignes du terrain
  Colonnes%          = 15   : ' nombre de colonnes du terrain
  MiniSurvie%        = 1    : ' nombre mini de voisins nécessaires à la survie
  MiniReproduction%  = 2    : ' nombre mini de voisins nécessaires à la reproduction
  MaxiSurvie%        = 4    : ' nombre maxi de voisins nécessaires pour la survie
  timer_interval no_timer%,TimerInterval%
  fichier$ = ""
end_sub

sortir:
  terminate
  
nouveau:
  nouveau()
  return
  
close_form_nouveau:
  close_form_nouveau()
  return
  
validernouveau:
  close_form_nouveau()
  return

  
sub nouveau()
  dim_local no%
  if EnCours%=1
    if message_confirmation_yes_no("Un jeu est en cours. Avorter ?")<>1 then exit_sub
    ' tout arrêter et supprimer
    EnCours% = 0
  end_if
  fichier$ = ""
  caption 0,"Evolution de populations - Configuration"
  PhaseEdition% = 0
  if object_exists(no_form_nouveau%)=0
    no% = no_form_nouveau%
    form no% : hide no% : caption no%,"Configuration du jeu"
      width no%,600 : height no%,500
      top no%,(screen_y-height(no%))/2 : left no%,(screen_x-width(no%))/2
      on_close no%,close_form_nouveau
    no% = no% + 1 : alpha no% : parent no%,no_form_nouveau%
      top no%,10 : left no%,10 : caption no%,"Taille du terrain:"
    no% = no% + 1 : alpha no% : parent no%,no_form_nouveau%
      top no%,30 : left no%,60 : caption no%,"Lignes:"
    no% = no% + 1 : spin no% : parent no%,no_form_nouveau% : no_hauteur_terrain% = no%
      top no%,30 : left no%,120 : width no%,60 : position no%,Lignes%
    no% = no% + 1 : alpha no% : parent no%,no_form_nouveau%
      top no%,50 : left no%,60 : caption no%,"Colonnes:"
    no% = no% + 1 : spin no% : parent no%,no_form_nouveau% : no_largeur_terrain% = no%
      top no%,50 : left no%,120 : width no%,60 : position no%,Colonnes%
      
    no% = no% + 1 : alpha no% : parent no%,no_form_nouveau%
      top no%,80 : left no%,10 : caption no%,"Règles de vie:"
    no% = no% + 1 : alpha no% : parent no%,no_form_nouveau%
      top no%,100 : left no%,60 : caption no%,"Voisins mini pour survie:"
    no% = no% + 1 : spin no% : parent no%,no_form_nouveau% : no_mini_survie% = no%
      top no%,100 : left no%,220 : width no%,60 : position no%,MiniSurvie%
      min no%,0 : max no%,8
    no% = no% + 1 : alpha no% : parent no%,no_form_nouveau%
      top no%,120 : left no%,60 : caption no%,"Voisins mini pour reproduction:"
    no% = no% + 1 : spin no% : parent no%,no_form_nouveau% : no_mini_reproduction% = no%
      top no%,120 : left no%,220 : width no%,60 : position no%,MiniReproduction%
      min no%,0 : max no%,8
    no% = no% + 1 : alpha no% : parent no%,no_form_nouveau%
      top no%,140 : left no%,60 : caption no%,"Voisins maxi pour survie:"
    no% = no% + 1 : spin no% : parent no%,no_form_nouveau% : no_maxi_survie% = no%
      top no%,140 : left no%,220 : width no%,60 : position no%,MaxiSurvie%
      min no%,0 : max no%,8
    no% = no% + 1 : alpha no% : parent no%,no_form_nouveau%
      top no%,160 : left no%,60 : caption no%,"Délai entre deux cycles:"
    no% = no% + 1 : spin no% : parent no%,no_form_nouveau% : no_interval% = no%
      top no%,160 : left no%,220 : width no%,60 : position no%,TimerInterval%
      min no%,50
      
    no% = no% + 1 : button no% : parent no%,no_form_nouveau%
      top no%,400 : left no%,450 : caption no%,"Valider" : on_click no%,validernouveau

  end_if
  show no_form_nouveau%
  inactive 0
end_sub

sub close_form_nouveau()
  ' contrôle des paramètres
  ParametresValides% = 1
  if position(no_hauteur_terrain%)<3 then ParametresValides% = 0
  if position(no_hauteur_terrain%)>100 then ParametresValides% = 0
  if position(no_largeur_terrain%)<3 then ParametresValides% = 0
  if position(no_largeur_terrain%)>150 then ParametresValides% = 0
  if position(no_mini_survie%)>position(no_mini_reproduction%) then ParametresValides% = 0
  if position(no_mini_survie%)>position(no_maxi_survie%) then ParametresValides% = 0
  if position(no_mini_reproduction%)>position(no_maxi_survie%) then ParametresValides% = 0
  if ParametresValides%=0
    message "Les paramètres ne sont pas valides"
    active 0 : to_foreground 0
    exit_sub
  end_if
  Lignes%             = position(no_hauteur_terrain%)
  Colonnes%           = position(no_largeur_terrain%)
  MiniSurvie%         = position(no_mini_survie%)
  MiniReproduction%   = position(no_mini_reproduction%)
  MaxiSurvie%         = position(no_maxi_survie%)
  TimerInterval%      = position(no_interval%)
  timer_interval no_timer%,TimerInterval%
  ' création du jeu
  if object_exists(no_terrain%)=1
    2d_target_is 0
    delete no_terrain%
    free terrain%
  end_if

  picture no_terrain% : full_space no_terrain% : on_click no_terrain%,clic
  dim terrain%(Lignes%+3,Colonnes%)
  terrain%(0,1) = Lignes%
  terrain%(0,2) = Colonnes%
  terrain%(Lignes%+1,1) = MiniSurvie%
  terrain%(Lignes%+1,2) = MiniReproduction%
  terrain%(Lignes%+2,1) = MaxiSurvie%
  terrain%(Lignes%+3,1) = Cycle%
  terrain%(Lignes%+3,2) = TimerInterval%
  AfficherTerrain()
  end_sub
  
sub AfficherTerrain()
  dim_local l%, c%
  cw% = int(width(no_terrain%)/Colonnes%)
  ch% = int(height(no_terrain%)/Lignes%)
  2d_target_is no_terrain% : 2d_fill_color 255,0,255
  2d_rectangle 0,0,Colonnes%*cw%,Lignes%*ch%
  for l%=1 to Lignes%-1
    2d_line 0,ch%*l%,Colonnes%*cw%,ch%*l%
  next l%
  for c%=1 to Colonnes%-1
    2d_line cw%*c%,0,cw%*c%,Lignes%*ch%
  next c%
  if object_exists(no_form_nouveau%)=1 then hide no_form_nouveau%
  active 0 : to_foreground 0
  caption 0,"Evolution de populations"
  for l%=1 to Lignes%
    for c%=1 to Colonnes%
      if terrain%(l%,c%)>0 then AfficherCellule(l%,c%)
    next c%
  next l%
end_sub


clic:
  clic()
  return
  
sub clic()
  dim_local l%, c%, x%, y%
  if PhaseEdition%=0 then exit_sub
  x% = mouse_x_left_down(no_terrain%)
  y% = mouse_y_left_down(no_terrain%)
  l% = int((y%+ch%-1)/ch%)
  c% = int((x%+cw%-1)/cw%)
  InverserCellule(PhaseEdition%,l%,c%)
end_sub

tick:
  tick()
  return
  
sub tick()
  dim_local l%, c%, voisins%, cell%,
  dim_local rl%(8), rc%(8), nr%  : ' liste des places potentielles pour rejetons et leur nombre
  timer_off no_timer%         : ' désactiver le timer le temps du traitement du cycle
  Cycle% = Cycle% + 1         : ' compter le cycle
  caption 0,"Evolution de populations - Cycle "+str$(Cycle%)
  for l%=1 to Lignes%         : ' boucle sur toutes les lignes
    for c%=1 to Colonnes%     : ' boucle sur toutes les colonnes
      if terrain%(l%,c%)=1    : ' individu ?
        ' analyser la situation d'un individu
        voisins% = 0
        nr% = 0               : ' raz nombre de places possibles pour rejetons

        ' analyser la ligne précédente si possible
        if l%>1               : ' pas ligne 1 ? Alors regarder les 3 cases de la ligne précédente
          if c%>1             : ' pas colonne 1 ? Alors regarder la colonne précédente
            cell% = terrain%(l%-1,c%-1)
            if (cell%=1) or (cell%=3) then voisins% = voisins% + 1             : ' cellule occupée par un individu ? Alors compter le voisin
            if cell%=0 then nr% = nr% + 1 : rl%(nr%) = l%-1 : rc%(nr%) = c%-1  : ' cellule vide ? Alors mémoriser la place pour un rejeton
          end_if              : ' fin if c%>1
                              : ' regarder la même colonne
          cell% = terrain%(l%-1,c%)
          if (cell%=1) or (cell%=3) then voisins% = voisins% + 1               : ' cellule occupée par un individu ? Alors compter le voisin
          if cell%=0 then nr% = nr% + 1 : rl%(nr%) = l%-1 : rc%(nr%) = c%      : ' cellule vide ? Alors mémoriser la place pour un rejeton
          if c%<Colonnes%     : ' pas dernière colonne ? Alors regarder la colonne suivante
            cell% = terrain%(l%-1,c%+1)
            if (cell%=1) or (cell%=3) then voisins% = voisins% + 1
            if cell%=0 then nr% = nr% + 1 : rl%(nr%) = l%-1 : rc%(nr%) = c%+1
          end_if              : ' fin if c%<Colonnes%
        end_if                : ' l%>1

        ' analyser la ligne actuelle
        if c%>1               : ' pas première colonne ? Alors regarder la colonne précédente
          cell% = terrain%(l%,c%-1)
          if (cell%=1) or (cell%=3) then voisins% = voisins% + 1               : ' cellule occupée par un individu ? Alors compter le voisin
          if cell%=0 then nr% = nr% + 1 : rl%(nr%) = l% : rc%(nr%) = c%-1      : ' cellule vide ? Alors mémoriser la place pour un rejeton
        end_if                : ' fin if c%>1
        if c%<Colonnes%       : ' pas dernière colonne ? Alors regarder la colonne suivante
          cell% = terrain%(l%,c%+1)
          if (cell%=1) or (cell%=3) then voisins% = voisins% + 1               : ' cellule occupée par un individu ? Alors compter le voisin
          if cell%=0 then nr% = nr% + 1 : rl%(nr%) = l% : rc%(nr%) = c%+1      : ' cellule vide ? Alors mémoriser la place pour un rejeton
        end_if                : ' fin c%<Colonnes%
        
        ' analyser la ligne suivante si possible
        if l%<Lignes%         : ' pas dernière ligne ? Alors regarder la ligne suivante
          if c%>1             : ' pas première colonne ? Alors regarder la colonne précédente
            cell% = terrain%(l%+1,c%-1)
            if (cell%=1) or (cell%=3) then voisins% = voisins% + 1             : ' cellule occupée par un individu ? Alors compter le voisin
            if cell%=0 then nr% = nr% + 1 : rl%(nr%) = l%+1 : rc%(nr%) = c%-1  : ' cellule vide ? Alors mémoriser la place pour un rejeton
          end_if              : ' fin c%>1
          cell% = terrain%(l%+1,c%)
          if (cell%=1) or (cell%=3) then voisins% = voisins% + 1               : ' cellule occupée par un individu ? Alors compter le voisin
          if cell%=0 then nr% = nr% + 1 : rl%(nr%) = l%+1 : rc%(nr%) = c%      : ' cellule vide ? Alors mémoriser la place pour un rejeton
          if c%<Colonnes%     : ' pas dernière colonne ? Alors regarder la colonne suivante
            cell% = terrain%(l%+1,c%+1)
            if (cell%=1) or (cell%=3) then voisins% = voisins% + 1             : ' cellule occupée par un individu ? Alors compter le voisin
            if cell%=0 then nr% = nr% + 1 : rl%(nr%) = l%+1 : rc%(nr%) = c%+1  : ' cellule vide ? Alors mémoriser la place pour un rejeton
          end_if              : ' fin c%<Colonnes%
        end_if                : ' l%<Lignes%
        
        ' analyser les conditions de vie
        if voisins%<MiniSurvie%       : ' trop seul ? Tu meurs...
          InverserCellule(4,l%,c%)
        else                          : ' pas trop seul ? Alors tu as une chance...
          if voisins%>MaxiSurvie%     : ' trop étouffé ? Tu meurs...
            InverserCellule(4,l%,c%)
          else                        : ' pas trop étouffé ? Alors, tu as une chance...
            if voisins%>MiniReproduction%   : ' reproduction possible ?
              if nr%>0                : ' on a trouvé une place pour le rejeton ? Alors, reproduire !
                nr% = int(rnd(nr%+1)) : ' ici, choisir la place du rejeton au hasard dans la liste des places disponibles
                InverserCellule(3,rl%(nr%),rc%(nr%))
              else                    : ' pas de place pour le rejetion ? Alors, tu meurs en couches !
                InverserCellule(4,l%,c%)
              end_if                  : ' fin nr%>0
            end_if                    : ' fin voisins%>MiniReproduction%
          end_if                      : ' fin if voisins%>MaxiSurvie%
        end_if                        : ' fin voisins%<MiniSurvie%
      end_if                          : ' fin if terrain%(l%,c%)=1
    next c%                           : ' fin boucle sur les colonnes
  next l%                             : ' fin boucle sur les lignes
  
  ' traiter les rejetons (valeur 3) et les décès (valeur 4)
  for l%=1 to Lignes%
    for c%=1 to Colonnes%
      if terrain%(l%,c%)=3 then terrain%(l%,c%) = 1    : ' un rejeton devient un individu normal
      if terrain%(l%,c%)=4 then terrain%(l%,c%) = 0    : ' un maccabé disparaît
    next c%
  next l%
  display
  timer_on no_timer%                                   : ' relancer le timer pour le cycle suivant
end_sub

peupler:
  peupler()
  return

effacerpopulation:
  effacerpopulation()
  return

obstacles:
  obstacles()
  return

effacerobstacles:
  effacerobstacles()
  return

finedition:
  finedition()
  return
  
sub peupler()
  caption 0,"Evolution de populations - gestion de la population"
  PhaseEdition% = 1
end_sub

sub obstacles()
  caption 0,"Evolution de populations - gestion des obstacles"
  PhaseEdition% = 2
end_sub

sub effacerpopulation()
  dim_local l%,c%
  caption 0,"Evolution de populations"
  PhaseEdition% = 0
  for l%=1 to Lignes%
    for c%=1 to Colonnes%
      if terrain%(l%,c%)=1
        InverserCellule(0,l%,c%)
      end_if
    next c%
  next l%
end_sub

sub effacerobstacles()
  dim_local l%,c%
  caption 0,"Evolution de populations"
  PhaseEdition% = 0
  for l%=1 to Lignes%
    for c%=1 to Colonnes%
      if terrain%(l%,c%)=2
        InverserCellule(0,l%,c%)
      end_if
    next c%
  next l%
end_sub

sub finedition()
  caption 0,"Evolution de populations"
  PhaseEdition% = 0
end_sub

sub InverserCellule(v%,l%,c%)
  select v%
    case 0: ' case vide
       terrain%(l%,c%) = 0
       2d_fill_color 255,0,255
       2d_rectangle (c%-1)*cw%,(l%-1)*ch%,c%*cw%+1,l%*ch%+1
    case 1: ' population
      if terrain%(l%,c%)<2         : ' actuellement pas un obstacle ?
        if terrain%(l%,c%)=1       : ' actuellement population ?
         terrain%(l%,c%) = 0
         2d_fill_color 255,0,255
         2d_rectangle (c%-1)*cw%,(l%-1)*ch%,c%*cw%+1,l%*ch%+1
         2d_fill_color 255,0,255
        else                       : ' actuellement vide !
         terrain%(l%,c%) = 1
         2d_fill_color 255,255,0
         2d_rectangle (c%-1)*cw%,(l%-1)*ch%,c%*cw%+1,l%*ch%+1
         2d_fill_color 255,0,255
        end_if
      end_if
    case 2: ' obstacle
      if terrain%(l%,c%)<>1        : ' actuellement pas population ?
        if terrain%(l%,c%)=2       : ' actuellement obstacle ?
         terrain%(l%,c%) = 0
         2d_fill_color 255,0,255
         2d_rectangle (c%-1)*cw%,(l%-1)*ch%,c%*cw%+1,l%*ch%+1
         2d_fill_color 255,0,255
        else                       : ' actuellement vide !
         terrain%(l%,c%) = 2
         2d_fill_color 0,0,0
         2d_rectangle (c%-1)*cw%,(l%-1)*ch%,c%*cw%+1,l%*ch%+1
         2d_fill_color 255,0,255
        end_if
      end_if
    case 3: ' population nouvelle génération
         terrain%(l%,c%) = 3
         2d_fill_color 255,255,0
         2d_rectangle (c%-1)*cw%,(l%-1)*ch%,c%*cw%+1,l%*ch%+1
         2d_fill_color 255,0,255
    case 4: ' population décédée
         terrain%(l%,c%) = 4
         2d_fill_color 255,0,255
         2d_rectangle (c%-1)*cw%,(l%-1)*ch%,c%*cw%+1,l%*ch%+1
         2d_fill_color 255,0,255
  end_select
end_sub

sub AfficherCellule(l%,c%)
  select terrain%(l%,c%)
    case 0: ' case vide
       2d_fill_color 255,0,255
       2d_rectangle (c%-1)*cw%,(l%-1)*ch%,c%*cw%+1,l%*ch%+1
    case 1: ' population
       2d_fill_color 255,255,0
       2d_rectangle (c%-1)*cw%,(l%-1)*ch%,c%*cw%+1,l%*ch%+1
       2d_fill_color 255,0,255
    case 2: ' obstacle
       2d_fill_color 0,0,0
       2d_rectangle (c%-1)*cw%,(l%-1)*ch%,c%*cw%+1,l%*ch%+1
       2d_fill_color 255,0,255
  end_select
end_sub

demarrer:
  demarrer()
  return
  
pauser:
  pauser()
  return

continuer:
  continuer()
  return

sub demarrer()
  if (EnCours%=0) and (ParametresValides%=1)
    Cycle% = 0
    EnCours% = 1
    timer_on no_timer%
  end_if
end_sub

sub pauser()
  if EnCours%=1
    caption 0,"Evolution de populations - en Pause"
    timer_off no_timer%
  end_if
end_sub

sub continuer()
  if EnCours%=1
    caption 0,"Evolution de populations - Cycle "+str$(Cycle%)
    timer_on no_timer%
  end_if
end_sub

enregistrer:
  enregistrer()
  return
  
enregistrersous:
  enregistrersous()
  return
  
charger:
  charger()
  return

sub enregistrer()
  dim_local f$
  if EnCours%=1 then timer_off no_timer%
  if fichier$<>""
    if file_exists(fichier$)=1 then file_delete fichier$
    save()
  end_if
  if EnCours%=1 then timer_on no_timer%
end_sub

sub enregistrersous()
  dim_local f$, l%, c%
  if ParametresValides%=0
    message "Les paramètres sont invalides."
    exit_sub
  end_if
  if EnCours%=1 then timer_off no_timer%
  caption 0,"Evolution de populations - enregistrement en cours..."
  filter no_save%,"Sauvegarde (*.jdv)|*.jdv"
  f$ = file_name$(no_save%)
  if f$="_" then exit_sub
  if file_exists(f$)=1
    if message_confirmation_yes_no("Ce fichier existe déjà. Remplacer ?")<>1 then exit_sub
    file_delete f$
  end_if
  fichier$ = f$
  save()
  if EnCours%=1
    timer_on no_timer%
    caption 0,"Evolution de populations - Cycle "+str$(Cycle%)
  else
    caption 0,"Evolution de populations"
  end_if
  end_sub
  
sub save()
  dim_local l%, c%
  caption 0,"Evolution de populations - enregistrement en cours..."
  file_open_write 1,fichier$
  for l%=0 to Lignes%+3
    for c%=1 to Colonnes%
      file_writeln 1,str$(terrain%(l%,c%))
    next c%
  next l%
  file_close 1
  caption 0,"Evolution de populations"
end_sub

sub charger()
  dim_local f$, s$, l%, c%, ll%, cc%
  filter no_open%,"Sauvegarde (*.jdv)|*.jdv"
  f$ = file_name$(no_open%)
  if f$="_" then exit_sub
  if file_exists(f$)=0
    message "Ce fichier n'existe pas."
    exit_sub
  end_if
  if EnCours%=1 then timer_off no_timer%
  fichier$ = s$
  EnCours% = 0
  caption 0,"Evolution de populations - chargement en cours..."
  file_open_read 1,f$
  file_readln 1,s$
  ll% = val(s$)
  file_readln 1,s$
  cc% = val(s$)
  file_close 1
  if variable("terrain%")=1 then free terrain%
  dim terrain%(ll%+3,cc%)
  file_open_read 1,f$
  for l%=0 to ll%+3
    for c%=1 to cc%
      file_readln 1,s$
' message str$(l%)+","+str$(c%)+": "+s$
      terrain%(l%,c%) = val(s$)
    next c%
  next l%
  file_close 1
  Lignes%            = terrain%(0,1)
  Colonnes%          = terrain%(0,2)
  MiniSurvie%        = terrain%(Lignes%+1,1)
  MiniReproduction%  = terrain%(Lignes%+1,2)
  MaxiSurvie%        = terrain%(Lignes%+2,1)
  Cycle%             = terrain%(Lignes%+3,1)
  TimerInterval%     = terrain%(Lignes%+3,2)
  ParametresValides% = 1
  if object_exists(no_form_nouveau%)=1
    position no_hauteur_terrain%,Lignes%
    position no_largeur_terrain%,Colonnes%
    position no_mini_survie%,MiniSurvie%
    position no_mini_reproduction%,MiniReproduction%
    position no_maxi_survie%,MaxiSurvie%
    position no_interval%,TimerInterval%
  end_if
  if object_exists(no_terrain%)=0
    picture no_terrain% : full_space no_terrain% : on_click no_terrain%,clic
  end_if
  AfficherTerrain()
  caption 0,"Evolution de populations"
end_sub

aide:
  aide()
  return
  
apropos:
  apropos()
  return

sub aide()
  dim_local no%
  if object_exists(no_form_aide%)=0
    no% = no_form_aide%
    form no% : hide no% : width no%,600 : height no%,600
    top no%,(screen_y-height(no%))/2 : left no%,(screen_x-width(no%))/2
    no% = no% + 1 : picture no% : parent no%,no_form_aide% : full_space no%
      font_size no%,12 : print_target_is no%
    print "  Jeu de la Vie"
    print
    print "  Pour créer un jeu, on utilise le menu Jeu/Nouveau."
    print
    print "  Dans la enêtre sui s'ouvre, on configure certaines"
    print
    print "  options de configuration pour le jeu."
    print
    print "  On utilise le menu Edition pour créer la configuration initiale."
    print
    print "  On peur placer des individus et des obstacles, selon le mode
    print
    print "  Choisi dans le menu. Un clic dans une cellule place l'élément,"
    print
    print "  un autre clic dans la cellule le supprime."
    print
    print "  En fonction des règles de vie, la population initiale évolue"
    print
    print "  par cycles. On peut pauser et reprendre le jeu, et même"
    print
    print "  intervenir sur la disposition entre deux cycles."
    print
    print "  On peut sauvegarder une situation et la recharger."
    print
    print
    print "  Un individu évolue automatiquement en fonction de son voisinage:"
    print
    print "    Il doit avoir un nombre minimum de voisins direct, sinon il meurt."
    print
    print "    Il ne doit pas avoir plus d'un certain nombre de voisins, sinon il meurt."
    print
    print "    Il doit avoir un certin minimum de voisins pour se reproduire."
    print
    print "    La reproduction peut produire un rejeton par individu et par cycle."
    print
    print "    S'il n'y a pas la place pour caser le rejeton, l'individu meurt."
  end_if
  show no_form_aide% : to_foreground no_form_aide%
end_sub

sub apropos()
  dim_local s$
  s$ = "Jeu de la Vie"+chr$(13)+chr$(10)+chr$(13)+chr$(10)
  s$ = s$ + "Auteur: Klaus"+chr$(13)+chr$(10)
  s$ = s$ + "Créé le 8/11/2016"
  message s$
end_sub


A vous d'imaginer vos configurations et jouer avec les 3 limites de nombre de voisins...


Dernière édition par Klaus le Mer 9 Nov 2016 - 18:58, édité 1 fois
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
jean_debord

avatar

Nombre de messages : 771
Age : 63
Localisation : Limoges
Date d'inscription : 21/09/2008

MessageSujet: Re: Le jeu de la vie   Mer 9 Nov 2016 - 12:22

Merci Klaus Smile

Apparemment c'est une variante du jeu original de J. H. Conway avec l'ajout des 2 dernières règles.

As-tu une référence sur cette variante ou bien est-ce une invention de ta part ?

Je n'ai pas réussi à lancer le programme : j'obtiens une erreur "(6) More IF than END_IF" dont je n'ai pas pu trouver la cause ! Je vais essayer avec FBPano.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://www.unilim.fr/pages_perso/jean.debord/index.htm
Klaus

avatar

Nombre de messages : 10413
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Le jeu de la vie   Mer 9 Nov 2016 - 19:02

L'erreur était dans la sub TICK(), dans la ligne
Code:
          end_if              ; ' fin if c%>1
assez au début (ligne 277). Il fallait bien sûr
Code:
          end_if              : ' fin if c%>1
J'avais ajouté des commentaires pour documenter le moteur du système, et j'ai fait une faute de freappe.? C'est corrigé dans le post initial.

Eh oui, toutes ces règles sortent de ma propre imagination. Je n'ai rien copié, quelqu'en soit l'origine. JE vais d'ailleurs pousser plus loin pour prendre en compte, non plus uniquement des 8 cellules du voisinage imémdiat, mais également les x cellules du voiisinage de distance 2, 3 etc, distance étant paramétrable. Le résultat sera sûrement intéressant.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
jean_debord

avatar

Nombre de messages : 771
Age : 63
Localisation : Limoges
Date d'inscription : 21/09/2008

MessageSujet: Re: Le jeu de la vie   Jeu 10 Nov 2016 - 11:18

Merci. Le nouveau programme fonctionne bien.

Cette variante est assez différente du jeu original. Par exemple la configuration suivante, qui donne des images intéressantes dans le jeu initial, n'évolue pas dans cette variante :

Code:

***
     *
***

En revanche, la configuration suivante évolue :

Code:

******
******
**  **
**  **
******
******

Donc il faut des assemblages assez compacts au départ... Tout au moins avec les réglages par défaut (je n'ai pas essayé d'autres réglages).
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://www.unilim.fr/pages_perso/jean.debord/index.htm
papydall

avatar

Nombre de messages : 5623
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: Le jeu de la vie   Jeu 10 Nov 2016 - 12:10

Citation :
L'erreur était dans la sub TICK(), dans la ligne

Code:

         end_if              ; ' fin if c%>1
assez au début (ligne 277). Il fallait bien sûr

Code:

         end_if              : ' fin if c%>1

C’est gênant ça !
Le message d’erreur n’aurait pas du être More IF than END_IF, mais plutôt Not correct string expression : Sequence error, bad character.
D’ailleurs, si ce malheureux point-virgule se trouvait sur une autre ligne, c’est ce dernier type d’erreur qu’on obtiendrait.

Code:

if 2+3 = 5
   message "bravo !" ; : ' ERREUR : Not correct string expression : Sequence error, bad character
else
   message " OH, No !"
end_if ; ' ERREUR à cause du point-virgule: More IF than END_IF

Il fallait peut-être le signaler dans les "Mini bug" Razz
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Klaus

avatar

Nombre de messages : 10413
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Le jeu de la vie   Jeu 10 Nov 2016 - 12:14

Avec un terrain de 100 lignes sur 150 colonnes (le maxi), j'ai fait cet exemple:

Au bout d'une quinzaine de cycles, voici le résultat:

avec les paramètres par défaut.

Bon, c'est juste un exercice de style, un essai de programmation. Je n'avais pas comme projet de réimplémenter quelque chose de connu, juste de m'amuser un peu, histoire de délaisser un peu KGF.dll...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Contenu sponsorisé




MessageSujet: Re: Le jeu de la vie   

Revenir en haut Aller en bas
 
Le jeu de la vie
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Les jeux faits avec Panoramic-
Sauter vers: