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
» Demande pour Jack concernant PanExpress
par Jack Aujourd'hui à 7:48

» Calculatrice
par papydall Hier à 22:54

» EPP_V01 éditeur pour Panoramic
par Minibug Mer 19 Sep 2018 - 21:03

» [RESOLU] Quelle ligne est sélectionnée dans SYNEDIT ?
par Jean Claude Mer 19 Sep 2018 - 21:02

» PanExpress : l'éditeur Panoramic avec création d'objet
par Minibug Mer 19 Sep 2018 - 15:58

» Planétarium virtuel.
par Pedro Alvarez Mer 19 Sep 2018 - 9:28

» Petit coucou en passant !
par Minibug Dim 16 Sep 2018 - 15:03

» bug SEVERE fnc+sub : variables globales corrompus
par silverman Dim 16 Sep 2018 - 13:38

» Verrouiller un form en avant plan
par silverman Dim 16 Sep 2018 - 12:50

» Fin de l'aventure.
par Pedro Alvarez Sam 15 Sep 2018 - 18:16

» Demande d'explications Sur File_Write & File_writeln
par Jack Sam 15 Sep 2018 - 17:26

» MEMO avec des possibilités de commande
par Oscaribout Mer 12 Sep 2018 - 1:06

» La théorie du chaos
par jean_debord Mar 11 Sep 2018 - 9:30

» Orbites de l’ensemble de Mandelbrot
par Jean Claude Lun 10 Sep 2018 - 21:08

» Version instantanée V 0.9.29i2 du 4/09/2018
par silverman Mer 5 Sep 2018 - 10:15

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Septembre 2018
LunMarMerJeuVenSamDim
     12
3456789
10111213141516
17181920212223
24252627282930
CalendrierCalendrier

Partagez | 
 

 Démineur

Aller en bas 
AuteurMessage
Klaus

avatar

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

MessageSujet: Démineur   Dim 13 Nov 2016 - 23:54

Une première version paramétrable, mais sans prétention graphique, du célèbre jeu Démineur.
Code:
' demineur.bas

' Ce programme implémente une version du jeu Demineur.
' Il s'agit de désactiver des mines placées aléatoirement dans le terrain de jeu.
' Au départ, toutes les cases sont cachées.
' Un clic sur une case découvre ce qu'elle contient.
' Si la case cliquée est vide, elle affiche le nombre de bombes qu'elle touche.
' Si la case contient une bombe, celle-ci explose et le jeu est perdu.
' La partie est gagnée si toutes les cases sans bombe ont été découvertes.
'


labels()
constantes()
variables()
menu()
GUI()

end

sub labels()
  label quitter, nouveau, clic, aide, apropos
end_sub

sub constantes()

end_sub

sub variables()
  dim bombes%, dl%, dc%
end_sub

sub menu()
  main_menu 1
    sub_menu 11 : parent 11,1 : caption 11,"Jeu"
      sub_menu 12 : parent 12,11 : caption 12,"Nouveau" : on_click 12,nouveau
      sub_menu 13 : parent 13,11 : caption 13,"-"
      sub_menu 19 : parent 19,11 : caption 19,"Quitter" : on_click 19,quitter
    sub_menu 21 : parent 21,1 : caption 21,"Aide"
      sub_menu 22 : parent 22,21 : caption 22,"Aide"    : on_click 22,aide
      sub_menu 23 : parent 23,21 : caption 23,"Apropos" : on_click 23,apropos


end_sub

sub GUI()
  full_space 0 : caption 0,"Démineur"
  alpha 101 : top 101,10 : left 101,10 : caption 101,"Cases par ligne/colonne:"
  spin 102 : top 102,10 : left 102,140 : width 102,50 : min 102,10 : max 102,30 : position 102,20
  alpha 103 : top 103,10 : left 103,220 : caption 103,"Nombre de bombes:"
  spin 104 : top 104,10 : left 104,320 : width 104,50 : min 104,30 : max 104,70 : position 104,50
  alpha 105 : top 105,10 : left 105,400 : caption 105,"Nombre de cases restant à découvrir:"
  edit 106 : top 106,10 : left 106,590 : width 106,50 : inactive 106
  
  panel 1000 : full_space 1000 : height 1000,height(1000) - 40 : top 1000,40
  picture 1001 : parent 1001,1000 : full_space 1001 : color 1001,255,200,255
end_sub

quitter:
  terminate
  
nouveau:
  nouveau()
  return
  
clic:
  clic()
  return
  
aide:
  aide()
  return
  
apropos:
  apropos()
  return
  
sub nouveau()
  dim_local i%, l%, c%, l1%, c1%, nc%, nb%
  inactive 0
  nc% = position(102)
  nb% = position(104)
  text 106,nc%*nc%
  2d_target_is 0
  if object_exists(1001)=1
    off_click 1001
    2d_target_is 0
    print_target_is 0
    delete 1001
  end_if
  picture 1001 : parent 1001,1000 : full_space 1001 : color 1001,255,200,255
  dl% = int(height(1001)/nc%)
  dc% = int(dl%*1.5)
  2d_target_is 1001
  print_target_is 1001
  font_bold 1001
  font_size 1001,12
  2d_fill_color 255,200,255
  2d_rectangle 0,0,dc%*nc%,dl%*nc%
  l1% = 0
  c1% = 0
  for i%=1 to nc%-1
    l1% = l1% + dl%
    c1% = c1% + dc%
    2d_line 0,l1%,dc%*nc%,l1%
    2d_line c1%,0,c1%,dl%*nc%
  next i%
  if variable("terrain%")=1 then free terrain%
  dim terrain%(nc%+1,nc%+1)
  for l%=1 to nc%
    for c%=1 to nc%
      terrain%(l%,c%) = 0
    next c%
  next l%
  for i%=1 to nb%
    l% = int(rnd(nc%)) + 1
    c% = int(rnd(nc%)) + 1
    while terrain%(l%,c%)<0
      l% = int(rnd(nc%)) + 1
      c% = int(rnd(nc%)) + 1
    end_while
    terrain%(l%,c%) = -1
  next i%
  bombes% = nb%
  for l%=1 to nc%
    for c%=1 to nc%
      if terrain%(l%,c%)=0
        i% = 0
        if terrain%(l%-1,c%-1)<0 then i% = i% + 1
        if terrain%(l%-1,c%)  <0 then i% = i% + 1
        if terrain%(l%-1,c%+1)<0 then i% = i% + 1
        if terrain%(l%,c%-1)  <0 then i% = i% + 1
        if terrain%(l%,c%+1)  <0 then i% = i% + 1
        if terrain%(l%+1,c%-1)<0 then i% = i% + 1
        if terrain%(l%+1,c%)  <0 then i% = i% + 1
        if terrain%(l%+1,c%+1)<0 then i% = i% + 1
        terrain%(l%,c%) = i%
      end_if
    next c%
  next l%
  on_click 1001,clic
  active 0
end_sub

sub clic()
  dim_local x%, y%, l%, c%
  x% = mouse_x_left_down(1001)
  y% = mouse_y_left_down(1001)
  l% = int((y%+dl%-1)/dl%)
  c% = int((x%+dc%-1)/dc%)
  if terrain%(l%,c%)<0
    message "Boum ! Vous avez explosé une bombe ! Dommage..."
    off_click 1001
    exit_sub
  end_if
  print_locate (c%-1)*dc%+dc%/2,(l%-1)*dl%+5
  print str$(terrain%(l%,c%))
  text 106,str$(val(text$(106))-1)
  if val(text$(106))=bombes%
    message "BRAVO ! Vous avez gagné !"
    off_click 1001
    exit_sub
  end_if
end_sub

sub aide()
  dim_local s$
  s$ = "Mode d'emploi"+chr$(13)+chr$(10)+chr$(13)+chr$(10)
  s$ = s$ + "Choisissez la configuration."+chr$(13)+chr$(10)
  s$ = s$ + "Lancez le jeu par le menu Jeu/Nouveau"+chr$(13)+chr$(10)
  s$ = s$ + "Un clic sur une case vide montre le nombre de bombes que la case touche."+chr$(13)+chr$(10)
  s$ = s$ + "Un clic sur une bombe fait perdre le jeu."+chr$(13)+chr$(10)
  s$ = s$ + "Lorsque seules les cases avec bombes restent cachées, le jeu est gagné."
  message s$
end_sub

sub apropos()
  message "Démineur V1.0"+chr$(13)+chr$(10)+"Auteur: Klaus"+chr$(13)+chr$(10)+"créé le: 13/11/2016"
end_sub



Dernière édition par Klaus le Lun 14 Nov 2016 - 13:58, édité 2 fois
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Yannick

avatar

Nombre de messages : 8083
Age : 47
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: re   Lun 14 Nov 2016 - 9:36

Bon début Klaus...
...même si avec ma veine je saute sur la première. Rolling Eyes
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

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

MessageSujet: Re: Démineur   Lun 14 Nov 2016 - 18:14

Petite amélioration: ajout d'un menu "Solution" - montrer l'emplacement de toutes les bombes !
Code:
' demineur.bas

' Ce programme implémente une version du jeu Demineur.
' Il s'agit de désactiver des mines placées aléatoirement dans le terrain de jeu.
' Au départ, toutes les cases sont cachées.
' Un clic sur une case découvre ce qu'elle contient.
' Si la case cliquée est vide, elle affiche le nombre de bombes qu'elle touche.
' Si la case contient une bombe, celle-ci explose et le jeu est perdu.
' La partie est gagnée si toutes les cases sans bombe ont été découvertes.
'
' Historique des modifications:
' Version   Date         Objet
' V1.0      13/11/2016   version initiale
' V1.1      14/11/2016   ajout menu "Solution"
'


labels()
constantes()
variables()
menu()
GUI()

end

sub labels()
  label quitter, nouveau, solution, clic, aide, apropos
end_sub

sub constantes()

end_sub

sub variables()
  dim bombes%, dl%, dc%, xboum%, yboum%
end_sub

sub menu()
  main_menu 1
    sub_menu 11 : parent 11,1 : caption 11,"Jeu"
      sub_menu 12 : parent 12,11 : caption 12,"Nouveau"  : on_click 12,nouveau
      sub_menu 13 : parent 13,11 : caption 13,"Solution" : on_click 13,solution
      sub_menu 14 : parent 14,11 : caption 14,"-"
      sub_menu 19 : parent 19,11 : caption 19,"Quitter"  : on_click 19,quitter
    sub_menu 21 : parent 21,1 : caption 21,"Aide"
      sub_menu 22 : parent 22,21 : caption 22,"Aide"     : on_click 22,aide
      sub_menu 23 : parent 23,21 : caption 23,"Apropos"  : on_click 23,apropos


end_sub

sub GUI()
  full_space 0 : caption 0,"Démineur"
  alpha 101 : top 101,10 : left 101,10 : caption 101,"Cases par ligne/colonne:"
  spin 102 : top 102,10 : left 102,140 : width 102,50 : min 102,10 : max 102,30 : position 102,20
  alpha 103 : top 103,10 : left 103,220 : caption 103,"Nombre de bombes:"
  spin 104 : top 104,10 : left 104,320 : width 104,50 : min 104,30 : max 104,70 : position 104,50
  alpha 105 : top 105,10 : left 105,400 : caption 105,"Nombre de cases restant à découvrir:"
  edit 106 : top 106,10 : left 106,590 : width 106,50 : inactive 106
  
  panel 1000 : full_space 1000 : height 1000,height(1000) - 40 : top 1000,40
  picture 1001 : parent 1001,1000 : full_space 1001 : color 1001,255,200,255
end_sub

quitter:
  terminate
  
nouveau:
  nouveau()
  return
  
solution:
  solution()
  return
  
clic:
  clic()
  return
  
aide:
  aide()
  return
  
apropos:
  apropos()
  return
  
sub nouveau()
  dim_local i%, l%, c%, l1%, c1%, nc%, nb%
  inactive 0
  xboum% = 0
  yboum% = 0
  nc% = position(102)
  nb% = position(104)
  text 106,nc%*nc%
  2d_target_is 0
  if object_exists(1001)=1
    off_click 1001
    2d_target_is 0
    print_target_is 0
    delete 1001
  end_if
  picture 1001 : parent 1001,1000 : full_space 1001 : color 1001,255,200,255
  dl% = int(height(1001)/nc%)
  dc% = int(dl%*1.5)
  2d_target_is 1001
  print_target_is 1001
  font_bold 1001
  font_size 1001,12
  2d_fill_color 255,200,255
  2d_rectangle 0,0,dc%*nc%,dl%*nc%
  l1% = 0
  c1% = 0
  for i%=1 to nc%-1
    l1% = l1% + dl%
    c1% = c1% + dc%
    2d_line 0,l1%,dc%*nc%,l1%
    2d_line c1%,0,c1%,dl%*nc%
  next i%
  if variable("terrain%")=1 then free terrain%
  dim terrain%(nc%+1,nc%+1)
  for l%=1 to nc%
    for c%=1 to nc%
      terrain%(l%,c%) = 0
    next c%
  next l%
  for i%=1 to nb%
    l% = int(rnd(nc%)) + 1
    c% = int(rnd(nc%)) + 1
    while terrain%(l%,c%)<0
      l% = int(rnd(nc%)) + 1
      c% = int(rnd(nc%)) + 1
    end_while
    terrain%(l%,c%) = -1
  next i%
  bombes% = nb%
  for l%=1 to nc%
    for c%=1 to nc%
      if terrain%(l%,c%)=0
        i% = 0
        if terrain%(l%-1,c%-1)<0 then i% = i% + 1
        if terrain%(l%-1,c%)  <0 then i% = i% + 1
        if terrain%(l%-1,c%+1)<0 then i% = i% + 1
        if terrain%(l%,c%-1)  <0 then i% = i% + 1
        if terrain%(l%,c%+1)  <0 then i% = i% + 1
        if terrain%(l%+1,c%-1)<0 then i% = i% + 1
        if terrain%(l%+1,c%)  <0 then i% = i% + 1
        if terrain%(l%+1,c%+1)<0 then i% = i% + 1
        terrain%(l%,c%) = i%
      end_if
    next c%
  next l%
  on_click 1001,clic
  active 0
end_sub

sub solution()
  dim_local l%, c%, r%, nc%
  nc% = position(102)
  off_click 1001
  r% = int(dl%*0.4)
  2d_fill_color 255,0,0
  for l%=1 to nc%
    for c%=1 to nc%
      if terrain%(l%,c%)<0
        if (xboum%=c%) and (yboum%=l%)
          2d_fill_color 255,255,0
          2d_circle (c%-1)*dc%+dc%/2,(l%-1)*dl%+dl%/2,r%
          2d_fill_color 255,0,0
        else
          2d_circle (c%-1)*dc%+dc%/2,(l%-1)*dl%+dl%/2,r%
        end_if
      end_if
    next c%
  next l%
  2d_fill_color 255,200,255
end_sub

sub clic()
  dim_local x%, y%, l%, c%
  x% = mouse_x_left_down(1001)
  y% = mouse_y_left_down(1001)
  l% = int((y%+dl%-1)/dl%)
  c% = int((x%+dc%-1)/dc%)
  if terrain%(l%,c%)<0
    message "Boum ! Vous avez explosé une bombe ! Dommage..."
    off_click 1001
    xboum% = c%
    yboum% = l%
    exit_sub
  end_if
  print_locate (c%-1)*dc%+dc%/2,(l%-1)*dl%+5
  print str$(terrain%(l%,c%))
  text 106,str$(val(text$(106))-1)
  if val(text$(106))=bombes%
    message "BRAVO ! Vous avez gagné !"
    off_click 1001
    exit_sub
  end_if
end_sub

sub aide()
  dim_local s$
  s$ = "Mode d'emploi"+chr$(13)+chr$(10)+chr$(13)+chr$(10)
  s$ = s$ + "Choisissez la configuration."+chr$(13)+chr$(10)
  s$ = s$ + "Lancez le jeu par le menu Jeu/Nouveau"+chr$(13)+chr$(10)
  s$ = s$ + "Un clic sur une case vide montre le nombre de bombes que la case touche."+chr$(13)+chr$(10)
  s$ = s$ + "Un clic sur une bombe fait perdre le jeu."+chr$(13)+chr$(10)
  s$ = s$ + "Lorsque seules les cases avec bombes restent cachées, le jeu est gagné."
  message s$
end_sub

sub apropos()
  message "Démineur V1.1"+chr$(13)+chr$(10)+"Auteur: Klaus"+chr$(13)+chr$(10)+"créé le: 13/11/2016"
end_sub


En affichant la solution après l'explosion d'une bombe, on voit non seulement toutes les bombes en rouge, mais également la bombe explosée en jaune !
Exemple:
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

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

MessageSujet: Re: Démineur   Mar 15 Nov 2016 - 1:23

On peut même gagner la partie:

Et voici la solution affichée de cette partie:
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
papydall

avatar

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

MessageSujet: Re: Démineur   Mar 15 Nov 2016 - 1:32

Quand on s’appelle Klaus, rien n’est impossible ! Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Klaus

avatar

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

MessageSujet: Re: Démineur   Mar 15 Nov 2016 - 1:46

Bon, allez - voici une version pour se faire la main...

Lorsqu'on a perdu, on peut frapper la touche "Suppr" et on peut continuer dans le jeu. C'est tricher, mais ça permet d'éviter certaines frustrations... Mais en cas de victoire, le nombre de tricheries est affiché ! D'ailleurs, en cas de victoire, la solution s'affiche maintenant automatiquement.
Code:
' demineur.bas

' Ce programme implémente une version du jeu Demineur.
' Il s'agit de désactiver des mines placées aléatoirement dans le terrain de jeu.
' Au départ, toutes les cases sont cachées.
' Un clic sur une case découvre ce qu'elle contient.
' Si la case cliquée est vide, elle affiche le nombre de bombes qu'elle touche.
' Si la case contient une bombe, celle-ci explose et le jeu est perdu.
' La partie est gagnée si toutes les cases sans bombe ont été découvertes.
'
' Historique des modifications:
' Version   Date         Objet
' V1.0      13/11/2016   version initiale
' V1.1      14/11/2016   ajout menu "Solution"
' V1.2      15/11/2016   ajout touche "Suppr" en cad d'échec pour tricher
'


labels()
constantes()
variables()
menu()
GUI()

on_key_down 0,key

end

sub labels()
  label quitter, nouveau, solution, clic, key, aide, apropos
end_sub

sub constantes()

end_sub

sub variables()
  dim bombes%, dl%, dc%, xboum%, yboum%
  dim coup_l%, coup_c%
  dim jeu_perdu%
  dim triche%
end_sub

sub menu()
  main_menu 1
    sub_menu 11 : parent 11,1 : caption 11,"Jeu"
      sub_menu 12 : parent 12,11 : caption 12,"Nouveau"  : on_click 12,nouveau
      sub_menu 13 : parent 13,11 : caption 13,"Solution" : on_click 13,solution
      sub_menu 14 : parent 14,11 : caption 14,"-"
      sub_menu 19 : parent 19,11 : caption 19,"Quitter"  : on_click 19,quitter
    sub_menu 21 : parent 21,1 : caption 21,"Aide"
      sub_menu 22 : parent 22,21 : caption 22,"Aide"     : on_click 22,aide
      sub_menu 23 : parent 23,21 : caption 23,"Apropos"  : on_click 23,apropos


end_sub

sub GUI()
  full_space 0 : caption 0,"Démineur"
  alpha 101 : top 101,10 : left 101,10 : caption 101,"Cases par ligne/colonne:"
  spin 102 : top 102,10 : left 102,140 : width 102,50 : min 102,10 : max 102,30 : position 102,20
  alpha 103 : top 103,10 : left 103,220 : caption 103,"Nombre de bombes:"
  spin 104 : top 104,10 : left 104,320 : width 104,50 : min 104,30 : max 104,70 : position 104,50
  alpha 105 : top 105,10 : left 105,400 : caption 105,"Nombre de cases restant à découvrir:"
  edit 106 : top 106,10 : left 106,590 : width 106,50 : inactive 106
  
  panel 1000 : full_space 1000 : height 1000,height(1000) - 40 : top 1000,40
  picture 1001 : parent 1001,1000 : full_space 1001 : color 1001,255,200,255
end_sub

quitter:
  terminate
  
nouveau:
  nouveau()
  return
  
solution:
  solution()
  return
  
clic:
  clic()
  return
  
key:
  key()
  return
  
aide:
  aide()
  return
  
apropos:
  apropos()
  return
  
sub nouveau()
  dim_local i%, l%, c%, l1%, c1%, nc%, nb%
  inactive 0
  jeu_perdu% = 0
  triche% = 0
  xboum% = 0
  yboum% = 0
  nc% = position(102)
  nb% = position(104)
  coup_l% = 0
  coup_c% = 0
  text 106,nc%*nc%
  2d_target_is 0
  if object_exists(1001)=1
    off_click 1001
    2d_target_is 0
    print_target_is 0
    delete 1001
  end_if
  picture 1001 : parent 1001,1000 : full_space 1001 : color 1001,255,200,255
  dl% = int(height(1001)/nc%)
  dc% = int(dl%*1.5)
  2d_target_is 1001
  print_target_is 1001
  font_bold 1001
  font_size 1001,12
  2d_fill_color 255,200,255
  2d_rectangle 0,0,dc%*nc%,dl%*nc%
  l1% = 0
  c1% = 0
  for i%=1 to nc%-1
    l1% = l1% + dl%
    c1% = c1% + dc%
    2d_line 0,l1%,dc%*nc%,l1%
    2d_line c1%,0,c1%,dl%*nc%
  next i%
  if variable("terrain%")=1 then free terrain%
  dim terrain%(nc%+1,nc%+1)
  for l%=1 to nc%
    for c%=1 to nc%
      terrain%(l%,c%) = 0
    next c%
  next l%
  for i%=1 to nb%
    l% = int(rnd(nc%)) + 1
    c% = int(rnd(nc%)) + 1
    while terrain%(l%,c%)<0
      l% = int(rnd(nc%)) + 1
      c% = int(rnd(nc%)) + 1
    end_while
    terrain%(l%,c%) = -1
  next i%
  bombes% = nb%
  for l%=1 to nc%
    for c%=1 to nc%
      if terrain%(l%,c%)=0
        i% = 0
        if terrain%(l%-1,c%-1)<0 then i% = i% + 1
        if terrain%(l%-1,c%)  <0 then i% = i% + 1
        if terrain%(l%-1,c%+1)<0 then i% = i% + 1
        if terrain%(l%,c%-1)  <0 then i% = i% + 1
        if terrain%(l%,c%+1)  <0 then i% = i% + 1
        if terrain%(l%+1,c%-1)<0 then i% = i% + 1
        if terrain%(l%+1,c%)  <0 then i% = i% + 1
        if terrain%(l%+1,c%+1)<0 then i% = i% + 1
        terrain%(l%,c%) = i%
      end_if
    next c%
  next l%
  on_click 1001,clic
  active 0
end_sub

sub solution()
  dim_local l%, c%, r%, nc%
  nc% = position(102)
  off_click 1001
  r% = int(dl%*0.4)
  2d_fill_color 255,0,0
  for l%=1 to nc%
    for c%=1 to nc%
      if terrain%(l%,c%)<0
        if (xboum%=c%) and (yboum%=l%)
          2d_fill_color 255,255,0
          2d_circle (c%-1)*dc%+dc%/2,(l%-1)*dl%+dl%/2,r%
          2d_fill_color 255,0,0
        else
          2d_circle (c%-1)*dc%+dc%/2,(l%-1)*dl%+dl%/2,r%
        end_if
      end_if
    next c%
  next l%
  2d_fill_color 255,200,255
end_sub

sub clic()
  dim_local x%, y%, l%, c%
  x% = mouse_x_left_down(1001)
  y% = mouse_y_left_down(1001)
  l% = int((y%+dl%-1)/dl%)
  c% = int((x%+dc%-1)/dc%)
  coup_l% = l%
  coup_c% = c%
  if terrain%(l%,c%)<0
    message "Boum ! Vous avez explosé une bombe ! Dommage..."
    set_focus 0
    off_click 1001
    jeu_perdu% = 1
    xboum% = c%
    yboum% = l%
    exit_sub
  end_if
  print_locate (c%-1)*dc%+dc%/2,(l%-1)*dl%+5
  print str$(terrain%(l%,c%))
  text 106,str$(val(text$(106))-1)
  if val(text$(106))=bombes%
    solution()
    if triche%=0
      message "BRAVO ! Vous avez gagné !"
    else
      message "BRAVO ! Vous avez gagné, mais en trichant "+str$(triche%)+" fois !"
    end_if
    off_click 1001
    exit_sub
  end_if
end_sub

sub key()
  if jeu_perdu%=1
    if scancode=46
      message "Tricheur... Vous avez une autre chance !"
      on_click 1001,clic
      xboum% = 0
      yboum% = 0
      jeu_perdu% = 0
      triche% = triche% + 1
      exit_sub
    end_if
  end_if
end_sub

sub aide()
  dim_local s$
  s$ = "Mode d'emploi"+chr$(13)+chr$(10)+chr$(13)+chr$(10)
  s$ = s$ + "Choisissez la configuration."+chr$(13)+chr$(10)
  s$ = s$ + "Lancez le jeu par le menu Jeu/Nouveau"+chr$(13)+chr$(10)
  s$ = s$ + "Un clic sur une case vide montre le nombre de bombes que la case touche."+chr$(13)+chr$(10)
  s$ = s$ + "Un clic sur une bombe fait perdre le jeu."+chr$(13)+chr$(10)
  s$ = s$ + "Lorsque seules les cases avec bombes restent cachées, le jeu est gagné."
  message s$
end_sub

sub apropos()
  message "Démineur V1.2"+chr$(13)+chr$(10)+"Auteur: Klaus"+chr$(13)+chr$(10)+"créé le: 15/11/2016"
end_sub

Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Jicehel

avatar

Nombre de messages : 5929
Age : 46
Localisation : 77500
Date d'inscription : 18/04/2011

MessageSujet: Re: Démineur   Mar 15 Nov 2016 - 9:31

Encore un bon petit jeu à se mettre sous la dent.
Bon à part le graphisme qui peut être améliorer par quelqu'un s'il le souhaite mais qui n'est pas primordial pour le jeu, je pense que la fonction qui manque maintenant c'est une option pour vider automatiquement toutes les cases autour d'un 0 (fonction chainée pour nettoyer toute une zone vide). C'est pratique, ça évite des clics.
Après, il pourrait être bien aussi d'offrir l'option 'chronomètre' pour mesurer le temps de résolution si on le souhaite.
En tout cas un joli petit jeu de plus dans la collection des jeux Panoramic.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

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

MessageSujet: Re: Démineur   Mar 15 Nov 2016 - 10:44

Citation :
option pour vider automatiquement toutes les cases autour d'un 0 (fonction chainée pour nettoyer toute une zone vide)
C'est en cours de réalisation. Ce sera assez bluffant - lorsque ça marchera. Il manque un petit détail...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

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

MessageSujet: Re: Démineur   Mar 15 Nov 2016 - 11:28

Nouvelle version V1.3 du 15/11/2016.
Nouveauté: ajout d'un menu "Options" permettant de gérer les automatismes.

Nouvelle version V1.4 du 15/11/2016
Nouveauté: changement de couleur des cases découvertes, ne pas afficher les "0"

Code:
' demineur.bas

' Ce programme implémente une version du jeu Demineur.
' Il s'agit de désactiver des mines placées aléatoirement dans le terrain de jeu.
' Au départ, toutes les cases sont cachées.
' Un clic sur une case découvre ce qu'elle contient.
' Si la case cliquée est vide, elle affiche le nombre de bombes qu'elle touche.
' Si la case contient une bombe, celle-ci explose et le jeu est perdu.
' La partie est gagnée si toutes les cases sans bombe ont été découvertes.
'
' Historique des modifications:
' Version   Date         Objet
' V1.0      13/11/2016   version initiale
' V1.1      14/11/2016   ajout menu "Solution"
' V1.2      15/11/2016   ajout touche "Suppr" en cad d'échec pour tricher
' V1.3      15/11/2016   ajout menu "Options"
' V1.4      15/11/2016   changement de couleur des cases découvertes
'


labels()
constantes()
variables()
menu()
GUI()

on_key_down 0,key

end

sub labels()
  label quitter, nouveau, solution, clic, key, aide, apropos, premier, toujours
end_sub

sub constantes()

end_sub

sub variables()
  dim bombes%, dl%, dc%, xboum%, yboum%
  dim coup_l%, coup_c%, premier%, toujours%
  dim jeu_perdu%, triche%, first%, xl%, xc%, nc%
end_sub

sub menu()
  main_menu 1
    sub_menu 11 : parent 11,1 : caption 11,"Jeu"
      sub_menu 12 : parent 12,11 : caption 12,"Nouveau"  : on_click 12,nouveau
      sub_menu 13 : parent 13,11 : caption 13,"Solution" : on_click 13,solution
      sub_menu 14 : parent 14,11 : caption 14,"-"
      sub_menu 19 : parent 19,11 : caption 19,"Quitter"  : on_click 19,quitter
    sub_menu 21 : parent 21,1 : caption 21,"Options"
      sub_menu 22 : parent 22,21 : caption 22,"Découvrir au premier clic"  : on_click 22,premier
      sub_menu 23 : parent 23,21 : caption 23,"Toujours découvrir"         : on_click 23,toujours
    sub_menu 31 : parent 31,1 : caption 31,"Aide"
      sub_menu 32 : parent 32,31 : caption 32,"Aide"     : on_click 32,aide
      sub_menu 33 : parent 33,31 : caption 33,"Apropos"  : on_click 33,apropos


end_sub

sub GUI()
  full_space 0 : caption 0,"Démineur"
  alpha 101 : top 101,10 : left 101,10 : caption 101,"Cases par ligne/colonne:"
  spin 102 : top 102,10 : left 102,140 : width 102,50 : min 102,10 : max 102,30 : position 102,20
  alpha 103 : top 103,10 : left 103,220 : caption 103,"Nombre de bombes:"
  spin 104 : top 104,10 : left 104,320 : width 104,50 : min 104,30 : max 104,70 : position 104,50
  alpha 105 : top 105,10 : left 105,400 : caption 105,"Nombre de cases restant à découvrir:"
  edit 106 : top 106,10 : left 106,590 : width 106,50 : inactive 106
  
  panel 1000 : full_space 1000 : height 1000,height(1000) - 40 : top 1000,40
  picture 1001 : parent 1001,1000 : full_space 1001 : color 1001,255,200,255

  dlist 2
end_sub

quitter:
  terminate
  
nouveau:
  nouveau()
  return
  
solution:
  solution()
  return
  
clic:
  clic()
  return
  
key:
  key()
  return
  
premier:
  premier()
  return
  
toujours:
  toujours()
  return
  
aide:
  aide()
  return
  
apropos:
  apropos()
  return
  
sub nouveau()
  dim_local i%, l%, c%, l1%, c1%, nb%
  inactive 0
  jeu_perdu% = 0
  triche% = 0
  first% = 1
  xboum% = 0
  yboum% = 0
  clear 2
  nc% = position(102)
  nb% = position(104)
  coup_l% = 0
  coup_c% = 0
  text 106,nc%*nc%
  2d_target_is 0
  if object_exists(1001)=1
    off_click 1001
    2d_target_is 0
    print_target_is 0
    delete 1001
  end_if
  picture 1001 : parent 1001,1000 : full_space 1001 : color 1001,255,200,255
  dl% = int(height(1001)/nc%)
  dc% = int(dl%*1.5)
  2d_target_is 1001
  print_target_is 1001
  font_bold 1001
  font_size 1001,12
  2d_fill_color 255,200,255
  2d_rectangle 0,0,dc%*nc%,dl%*nc%
  l1% = 0
  c1% = 0
  for i%=1 to nc%-1
    l1% = l1% + dl%
    c1% = c1% + dc%
    2d_line 0,l1%,dc%*nc%,l1%
    2d_line c1%,0,c1%,dl%*nc%
  next i%
  if variable("terrain%")=1 then free terrain%
  dim terrain%(nc%+1,nc%+1)
  if variable("decouvert%")=1 then free decouvert%
  dim decouvert%(nc%+1,nc%+1)
  for l%=0 to nc%+1
    for c%=1 to nc%
      if (l%>0) and (l%<=nc%) and (c%>0) and (c%<=nc%)
        terrain%(l%,c%) = 0
        decouvert%(l%,c%) = 0
      else
        terrain%(l%,c%) = -2
        decouvert%(l%,c%) = 1
      end_if
    next c%
  next l%
  for i%=1 to nb%
    l% = int(rnd(nc%)) + 1
    c% = int(rnd(nc%)) + 1
    while terrain%(l%,c%)<0
      l% = int(rnd(nc%)) + 1
      c% = int(rnd(nc%)) + 1
    end_while
    terrain%(l%,c%) = -1
  next i%
  bombes% = nb%
  for l%=1 to nc%
    for c%=1 to nc%
      if terrain%(l%,c%)=0
        i% = 0
        if terrain%(l%-1,c%-1)=-1 then i% = i% + 1
        if terrain%(l%-1,c%)  =-1 then i% = i% + 1
        if terrain%(l%-1,c%+1)=-1 then i% = i% + 1
        if terrain%(l%,c%-1)  =-1 then i% = i% + 1
        if terrain%(l%,c%+1)  =-1 then i% = i% + 1
        if terrain%(l%+1,c%-1)=-1 then i% = i% + 1
        if terrain%(l%+1,c%)  =-1 then i% = i% + 1
        if terrain%(l%+1,c%+1)=-1 then i% = i% + 1
        terrain%(l%,c%) = i%
      end_if
    next c%
  next l%
  on_click 1001,clic
  active 0
end_sub

sub solution()
  dim_local l%, c%, r%, nc%
  if object_exists(1001)=0 then exit_sub
  if variable("terrain%")=0 then exit_sub
  nc% = position(102)
  off_click 1001
  r% = int(dl%*0.4)
  2d_fill_color 255,0,0
  for l%=1 to nc%
    for c%=1 to nc%
      if terrain%(l%,c%)<0
        if (xboum%=c%) and (yboum%=l%)
          2d_fill_color 255,255,0
          2d_circle (c%-1)*dc%+dc%/2,(l%-1)*dl%+dl%/2,r%
          2d_fill_color 255,0,0
        else
          2d_circle (c%-1)*dc%+dc%/2,(l%-1)*dl%+dl%/2,r%
        end_if
      end_if
    next c%
  next l%
  2d_fill_color 255,200,255
end_sub

sub clic()
  dim_local x%, y%, l%, c%
  x% = mouse_x_left_down(1001)
  y% = mouse_y_left_down(1001)
  l% = int((y%+dl%-1)/dl%)
  c% = int((x%+dc%-1)/dc%)
  if decouvert%(l%,c%)=1 then exit_sub
  coup_l% = l%
  coup_c% = c%
  if terrain%(l%,c%)<0
    message "Boum ! Vous avez explosé une bombe ! Dommage..."
    set_focus 0
    off_click 1001
    jeu_perdu% = 1
    xboum% = c%
    yboum% = l%
    exit_sub
  end_if
  2d_fill_color 200,150,200
  2d_rectangle (c%-1)*dc%,(l%-1)*dl%,(c%-1)*dc%+dc%+1,(l%-1)*dl%+dl%+1
  if terrain%(l%,c%)<>0
    print_locate (c%-1)*dc%+dc%/2,(l%-1)*dl%+5
    print str$(terrain%(l%,c%))
  end_if
  text 106,str$(val(text$(106))-1)
  2d_fill_color 255,200,255
  decouvert%(l%,c%) = 1
  if (toujours%=1) or ((first%+premier%)=2)
        montrer(l%-1,c%-1)
        montrer(l%-1,c%)
        montrer(l%-1,c%+1)
        montrer(l%,c%-1)
        montrer(l%,c%+1)
        montrer(l%+1,c%-1)
        montrer(l%+1,c%)
        montrer(l%+1,c%+1)
  end_if
  if val(text$(106))=bombes%
    solution()
    if triche%=0
      message "BRAVO ! Vous avez gagné !"
    else
      message "BRAVO ! Vous avez gagné, mais en trichant "+str$(triche%)+" fois !"
    end_if
    off_click 1001
    exit_sub
  end_if
  first% = 0
end_sub

sub montrer(yl%,yc%)
  if (yl%<1) or (yl%>nc%) then exit_sub
  if (yc%<1) or (yc%>nc%) then exit_sub
  if decouvert%(yl%,yc%)=1 then exit_sub
  if terrain%(yl%,yc%)<0 then exit_sub
  item_add 2,str$(xl%)
  item_add 2,str$(xc%)
  xl% = yl%
  xc% = yc%
  2d_fill_color 200,150,200
  2d_rectangle (xc%-1)*dc%,(xl%-1)*dl%,(xc%-1)*dc%+dc%+1,(xl%-1)*dl%+dl%+1
  if terrain%(xl%,xc%)<>0
    print_locate (xc%-1)*dc%+dc%/2,(xl%-1)*dl%+5
    print str$(terrain%(xl%,xc%))
  end_if
  2d_fill_color 255,200,255
  text 106,str$(val(text$(106))-1)
  decouvert%(xl%,xc%) = 1
  if terrain%(xl%,xc%)=0
        montrer(xl%-1,xc%-1)
        montrer(xl%-1,xc%)
        montrer(xl%-1,xc%+1)
        montrer(xl%,xc%-1)
        montrer(xl%,xc%+1)
        montrer(xl%+1,xc%-1)
        montrer(xl%+1,xc%)
        montrer(xl%+1,xc%+1)
  end_if
  xc% = val(item_read$(2,count(2)))
  item_delete 2,count(2)
  xl% = val(item_read$(2,count(2)))
  item_delete 2,count(2)
end_sub

sub key()
  if jeu_perdu%=1
    if scancode=46
      message "Tricheur... Vous avez une autre chance !"
      on_click 1001,clic
      xboum% = 0
      yboum% = 0
      jeu_perdu% = 0
      triche% = triche% + 1
      exit_sub
    end_if
  end_if
end_sub

sub premier()
  if toujours%=0
    if premier%=0
      mark_on 22
      premier% = 1
    else
      premier% = 0
      mark_off 22
    end_if
  end_if
end_sub

sub toujours()
  if toujours%=0
    toujours% = 1
    premier% = 1
    mark_on 22
    mark_on 23
  else
    toujours% = 0
    mark_off 23
  end_if
end_sub

sub aide()
  dim_local s$
  s$ = "Mode d'emploi"+chr$(13)+chr$(10)+chr$(13)+chr$(10)
  s$ = s$ + "Choisissez la configuration."+chr$(13)+chr$(10)
  s$ = s$ + "Lancez le jeu par le menu Jeu/Nouveau"+chr$(13)+chr$(10)
  s$ = s$ + "Un clic sur une case vide montre le nombre de bombes que la case touche."+chr$(13)+chr$(10)
  s$ = s$ + "Un clic sur une bombe fait perdre le jeu."+chr$(13)+chr$(10)
  s$ = s$ + "Lorsque seules les cases avec bombes restent cachées, le jeu est gagné."+chr$(13)+chr$(10)
  s$ = s$ + "Le menu Options permet de gérer les automatismes."+chr$(13)+chr$(10)
  s$ = s$ + "Après avoir explosé une bombe, on peut utiliser la touche <Suppr> pour continuer."
  message s$
end_sub

sub apropos()
  message "Démineur V1.4"+chr$(13)+chr$(10)+"Auteur: Klaus"+chr$(13)+chr$(10)+"créé le: 15/11/2016"
end_sub


En regardant le source, vous verrez que la fonction de découverte automatique de cases "montrables" est faite par une SUB récursive !

Voici l'aspect actuel, lorsqu'on a gagné la partie:
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Jean Claude

avatar

Nombre de messages : 5643
Age : 64
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Démineur   Mar 15 Nov 2016 - 18:32

J'ai testé, pas facile.

Une suggestion: un petit bouton ou option, pour visualiser la position des bombes pendant 5 secondes, serait bienvenue. Qu'en penses-tu ?

A+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

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

MessageSujet: Re: Démineur   Mar 15 Nov 2016 - 18:33

Bonne idée - allez, c'est parti !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

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

MessageSujet: Re: Démineur   Mar 15 Nov 2016 - 18:47

Nouvelle version: V1.5 du 15/11/2016

Nouveauté: ajout option "Coup d'oeil" dans le menu "Jeu"

Cette option affiche la position de toutes les bombes, pendant 1 seconde. Pendant ce temps-là, les clics dans le terrain de jeu sont désactivés.

Code:
' demineur.bas

' Ce programme implémente une version du jeu Demineur.
' Il s'agit de désactiver des mines placées aléatoirement dans le terrain de jeu.
' Au départ, toutes les cases sont cachées.
' Un clic sur une case découvre ce qu'elle contient.
' Si la case cliquée est vide, elle affiche le nombre de bombes qu'elle touche.
' Si la case contient une bombe, celle-ci explose et le jeu est perdu.
' La partie est gagnée si toutes les cases sans bombe ont été découvertes.
'
' Historique des modifications:
' Version   Date         Objet
' V1.0      13/11/2016   version initiale
' V1.1      14/11/2016   ajout menu "Solution"
' V1.2      15/11/2016   ajout touche "Suppr" en cad d'échec pour tricher
' V1.3      15/11/2016   ajout menu "Options"
' V1.4      15/11/2016   changement de couleur des cases découvertes
' V1.5      15/11/2016   ajout fonction "Coup d'oeil" dans menu "Jeu"


labels()
constantes()
variables()
menu()
GUI()

on_key_down 0,key

end

sub labels()
  label quitter, nouveau, solution, clic, key, soutien
  label aide, apropos, premier, toujours, tick
end_sub

sub constantes()

end_sub

sub variables()
  dim bombes%, dl%, dc%, xboum%, yboum%
  dim coup_l%, coup_c%, premier%, toujours%
  dim jeu_perdu%, triche%, first%, xl%, xc%, nc%
end_sub

sub menu()
  main_menu 1
    sub_menu 11 : parent 11,1 : caption 11,"Jeu"
      sub_menu 12 : parent 12,11 : caption 12,"Nouveau"  : on_click 12,nouveau
      sub_menu 13 : parent 13,11 : caption 13,"Solution" : on_click 13,solution
      sub_menu 14 : parent 14,11 : caption 14,"Coup d'oeil" : on_click 14,soutien
      sub_menu 15 : parent 15,11 : caption 15,"-"
      sub_menu 19 : parent 19,11 : caption 19,"Quitter"  : on_click 19,quitter
    sub_menu 21 : parent 21,1 : caption 21,"Options"
      sub_menu 22 : parent 22,21 : caption 22,"Découvrir au premier clic"  : on_click 22,premier
      sub_menu 23 : parent 23,21 : caption 23,"Toujours découvrir"         : on_click 23,toujours
    sub_menu 31 : parent 31,1 : caption 31,"Aide"
      sub_menu 32 : parent 32,31 : caption 32,"Aide"     : on_click 32,aide
      sub_menu 33 : parent 33,31 : caption 33,"Apropos"  : on_click 33,apropos


end_sub

sub GUI()
  full_space 0 : caption 0,"Démineur"
  alpha 101 : top 101,10 : left 101,10 : caption 101,"Cases par ligne/colonne:"
  spin 102 : top 102,10 : left 102,140 : width 102,50 : min 102,10 : max 102,30 : position 102,20
  alpha 103 : top 103,10 : left 103,220 : caption 103,"Nombre de bombes:"
  spin 104 : top 104,10 : left 104,320 : width 104,50 : min 104,30 : max 104,70 : position 104,50
  alpha 105 : top 105,10 : left 105,400 : caption 105,"Nombre de cases restant à découvrir:"
  edit 106 : top 106,10 : left 106,590 : width 106,50 : inactive 106
  
  panel 1000 : full_space 1000 : height 1000,height(1000) - 40 : top 1000,40
  picture 1001 : parent 1001,1000 : full_space 1001 : color 1001,255,200,255

  dlist 2
  timer 3 : timer_off 3 : timer_interval 3,1000 : on_timer 3,tick
end_sub

quitter:
  terminate
  
nouveau:
  nouveau()
  return
  
solution:
  solution(1)
  return
  
clic:
  clic()
  return
  
key:
  key()
  return
  
premier:
  premier()
  return
  
toujours:
  toujours()
  return
  
soutien:
  soutien()
  return
  
tick:
  tick()
  return
  
aide:
  aide()
  return
  
apropos:
  apropos()
  return
  
sub nouveau()
  dim_local i%, l%, c%, l1%, c1%, nb%
  inactive 0
  jeu_perdu% = 0
  triche% = 0
  first% = 1
  xboum% = 0
  yboum% = 0
  clear 2
  nc% = position(102)
  nb% = position(104)
  coup_l% = 0
  coup_c% = 0
  text 106,nc%*nc%
  2d_target_is 0
  if object_exists(1001)=1
    off_click 1001
    2d_target_is 0
    print_target_is 0
    delete 1001
  end_if
  picture 1001 : parent 1001,1000 : full_space 1001 : color 1001,255,200,255
  dl% = int(height(1001)/nc%)
  dc% = int(dl%*1.5)
  2d_target_is 1001
  print_target_is 1001
  font_bold 1001
  font_size 1001,12
  2d_fill_color 255,200,255
  2d_rectangle 0,0,dc%*nc%,dl%*nc%
  l1% = 0
  c1% = 0
  for i%=1 to nc%-1
    l1% = l1% + dl%
    c1% = c1% + dc%
    2d_line 0,l1%,dc%*nc%,l1%
    2d_line c1%,0,c1%,dl%*nc%
  next i%
  if variable("terrain%")=1 then free terrain%
  dim terrain%(nc%+1,nc%+1)
  if variable("decouvert%")=1 then free decouvert%
  dim decouvert%(nc%+1,nc%+1)
  for l%=0 to nc%+1
    for c%=1 to nc%
      if (l%>0) and (l%<=nc%) and (c%>0) and (c%<=nc%)
        terrain%(l%,c%) = 0
        decouvert%(l%,c%) = 0
      else
        terrain%(l%,c%) = -2
        decouvert%(l%,c%) = 1
      end_if
    next c%
  next l%
  for i%=1 to nb%
    l% = int(rnd(nc%)) + 1
    c% = int(rnd(nc%)) + 1
    while terrain%(l%,c%)<0
      l% = int(rnd(nc%)) + 1
      c% = int(rnd(nc%)) + 1
    end_while
    terrain%(l%,c%) = -1
  next i%
  bombes% = nb%
  for l%=1 to nc%
    for c%=1 to nc%
      if terrain%(l%,c%)=0
        i% = 0
        if terrain%(l%-1,c%-1)=-1 then i% = i% + 1
        if terrain%(l%-1,c%)  =-1 then i% = i% + 1
        if terrain%(l%-1,c%+1)=-1 then i% = i% + 1
        if terrain%(l%,c%-1)  =-1 then i% = i% + 1
        if terrain%(l%,c%+1)  =-1 then i% = i% + 1
        if terrain%(l%+1,c%-1)=-1 then i% = i% + 1
        if terrain%(l%+1,c%)  =-1 then i% = i% + 1
        if terrain%(l%+1,c%+1)=-1 then i% = i% + 1
        terrain%(l%,c%) = i%
      end_if
    next c%
  next l%
  on_click 1001,clic
  active 0
end_sub

sub solution(act%)
  dim_local l%, c%, r%, nc%
  if object_exists(1001)=0 then exit_sub
  if variable("terrain%")=0 then exit_sub
  nc% = position(102)
  off_click 1001
  r% = int(dl%*0.4)
  if act%=1
    2d_fill_color 255,0,0
    for l%=1 to nc%
      for c%=1 to nc%
        if terrain%(l%,c%)<0
          if (xboum%=c%) and (yboum%=l%)
            2d_fill_color 255,255,0
            2d_circle (c%-1)*dc%+dc%/2,(l%-1)*dl%+dl%/2,r%
            2d_fill_color 255,0,0
          else
            2d_circle (c%-1)*dc%+dc%/2,(l%-1)*dl%+dl%/2,r%
          end_if
        end_if
      next c%
    next l%
    2d_fill_color 255,200,255
  else
    2d_pen_color 255,200,255
    for l%=1 to nc%
      for c%=1 to nc%
        if terrain%(l%,c%)<0
            2d_circle (c%-1)*dc%+dc%/2,(l%-1)*dl%+dl%/2,r%
        end_if
      next c%
    next l%
    2d_pen_color 0,0,0
    on_click 1001,clic
  end_if
end_sub

sub clic()
  dim_local x%, y%, l%, c%
  x% = mouse_x_left_down(1001)
  y% = mouse_y_left_down(1001)
  l% = int((y%+dl%-1)/dl%)
  c% = int((x%+dc%-1)/dc%)
  if decouvert%(l%,c%)=1 then exit_sub
  coup_l% = l%
  coup_c% = c%
  if terrain%(l%,c%)<0
    message "Boum ! Vous avez explosé une bombe ! Dommage..."
    set_focus 0
    off_click 1001
    jeu_perdu% = 1
    xboum% = c%
    yboum% = l%
    exit_sub
  end_if
  2d_fill_color 200,150,200
  2d_rectangle (c%-1)*dc%,(l%-1)*dl%,(c%-1)*dc%+dc%+1,(l%-1)*dl%+dl%+1
  if terrain%(l%,c%)<>0
    print_locate (c%-1)*dc%+dc%/2,(l%-1)*dl%+5
    print str$(terrain%(l%,c%))
  end_if
  text 106,str$(val(text$(106))-1)
  2d_fill_color 255,200,255
  decouvert%(l%,c%) = 1
  if (toujours%=1) or ((first%+premier%)=2)
        montrer(l%-1,c%-1)
        montrer(l%-1,c%)
        montrer(l%-1,c%+1)
        montrer(l%,c%-1)
        montrer(l%,c%+1)
        montrer(l%+1,c%-1)
        montrer(l%+1,c%)
        montrer(l%+1,c%+1)
  end_if
  if val(text$(106))=bombes%
    solution(1)
    if triche%=0
      message "BRAVO ! Vous avez gagné !"
    else
      message "BRAVO ! Vous avez gagné, mais en trichant "+str$(triche%)+" fois !"
    end_if
    off_click 1001
    exit_sub
  end_if
  first% = 0
end_sub

sub montrer(yl%,yc%)
  if (yl%<1) or (yl%>nc%) then exit_sub
  if (yc%<1) or (yc%>nc%) then exit_sub
  if decouvert%(yl%,yc%)=1 then exit_sub
  if terrain%(yl%,yc%)<0 then exit_sub
  item_add 2,str$(xl%)
  item_add 2,str$(xc%)
  xl% = yl%
  xc% = yc%
  2d_fill_color 200,150,200
  2d_rectangle (xc%-1)*dc%,(xl%-1)*dl%,(xc%-1)*dc%+dc%+1,(xl%-1)*dl%+dl%+1
  if terrain%(xl%,xc%)<>0
    print_locate (xc%-1)*dc%+dc%/2,(xl%-1)*dl%+5
    print str$(terrain%(xl%,xc%))
  end_if
  2d_fill_color 255,200,255
  text 106,str$(val(text$(106))-1)
  decouvert%(xl%,xc%) = 1
  if terrain%(xl%,xc%)=0
        montrer(xl%-1,xc%-1)
        montrer(xl%-1,xc%)
        montrer(xl%-1,xc%+1)
        montrer(xl%,xc%-1)
        montrer(xl%,xc%+1)
        montrer(xl%+1,xc%-1)
        montrer(xl%+1,xc%)
        montrer(xl%+1,xc%+1)
  end_if
  xc% = val(item_read$(2,count(2)))
  item_delete 2,count(2)
  xl% = val(item_read$(2,count(2)))
  item_delete 2,count(2)
end_sub

sub key()
  if jeu_perdu%=1
    if scancode=46
      message "Tricheur... Vous avez une autre chance !"
      on_click 1001,clic
      xboum% = 0
      yboum% = 0
      jeu_perdu% = 0
      triche% = triche% + 1
      exit_sub
    end_if
  end_if
end_sub

sub premier()
  if toujours%=0
    if premier%=0
      mark_on 22
      premier% = 1
    else
      premier% = 0
      mark_off 22
    end_if
  end_if
end_sub

sub toujours()
  if toujours%=0
    toujours% = 1
    premier% = 1
    mark_on 22
    mark_on 23
  else
    toujours% = 0
    mark_off 23
  end_if
end_sub

sub aide()
  dim_local s$
  s$ = "Mode d'emploi"+chr$(13)+chr$(10)+chr$(13)+chr$(10)
  s$ = s$ + "Choisissez la configuration."+chr$(13)+chr$(10)
  s$ = s$ + "Lancez le jeu par le menu Jeu/Nouveau"+chr$(13)+chr$(10)
  s$ = s$ + "Un clic sur une case vide montre le nombre de bombes que la case touche."+chr$(13)+chr$(10)
  s$ = s$ + "Un clic sur une bombe fait perdre le jeu."+chr$(13)+chr$(10)
  s$ = s$ + "Lorsque seules les cases avec bombes restent cachées, le jeu est gagné."+chr$(13)+chr$(10)
  s$ = s$ + "Le menu Options permet de gérer les automatismes."+chr$(13)+chr$(10)
  s$ = s$ + "Après avoir explosé une bombe, on peut utiliser la touche <Suppr> pour continuer."
  message s$
end_sub

sub apropos()
  message "Démineur V1.5"+chr$(13)+chr$(10)+"Auteur: Klaus"+chr$(13)+chr$(10)+"créé le: 15/11/2016"
end_sub

sub soutien()
  inactive 0
  triche% = triche% + 1
  solution(1)
  timer_on 3
end_sub

sub tick()
  timer_off 3
  solution(0)
  active 0
end_sub

Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Contenu sponsorisé




MessageSujet: Re: Démineur   

Revenir en haut Aller en bas
 
Démineur
Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» profile view_ body et profile_add_body petit soucis mineur pour faire une petite modification
» BARRY LYNDON (B.O.) - Sarabande (G. F. Haendel), fin du film
» EDVARD GRIEG - La Chanson de Solveig (Judith Blegen)
» les dieux (olympiens & dieux mineurs).

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: