[Free Pascal] Logiciel Mastermind concours infirmier

Logiciel Mastermind concours infirmier

voila un logiciel entièrement de ma création, c'est un Mastermind tel qu'ils sont dans les concours infirmiers , c'est a peu près le plus difficile que je sache faire :mouarf:
je l'ai fait testé, ils sont tous résolvables, et j'aimerais avoir votre avis et savoir ce qui peut être améliorée au niveau du code et de la presentation,

www.megaupload.com/?d=NXV25M4K

Salut,

J'ai téléchargé l’exécutable : lors du premier choix, "r" affiche bien les règles, mais "j" et "q" provoquent la fermeture de la fenêtre (erreur non gérée ou fin du programme ?). Impossible donc de jouer.
Je ne sais pas sous quoi tu as compilé ton code, moi je suis sous Windows XP 32.

Salut

PS : serait il possible d'avoir le code plutôt que l'exécutable ?

c'est bizarre chez moi ca marche, je suis sur windows vista et j'utilise free pascal I.D.E 2.4.2
voici le code
www.megaupload.com/?d=RXKTDNZH

et un nouvel upload de l'executable
www.megaupload.com/?d=RSX08TQQ

edit:
j'ai telecharger l'ancien lien et il s'arrêtait bien aussi quand je faisais "jouer", j'ai donc essayé ce nouveau lien et la ca marche,
j'avais du changer quelque chose, ce que je ne comprend pas c'est que entre les 2 fichiers je n'ai rien fait pour corriger ce bug et le 2 eme marche... enfin bon le principal c'est que ca marche

Bonjour,

N'oubliez pas qu'une application de téléchargement vous permet de proposer vos contributions à toute la communauté :
http://pascal.developpez.com/telecha...80/Free-Pascal

;)

Salut,

Bon l'exécutable fonctionne apparemment bien. J'ai téléchargé le code, je l'ai regardé vite fait (sans trop entrer dans la logique du jeux), mais voila quelques conseils pour en améliorer la lisibilité :

- Utiliser des procédures pour regrouper une série d'instructions indépendantes du programme lui même. Par exemple toute la partie "jouer" pourrait être rassemblée dans une procédure. Cela permet de simplifier le corps du programme, et d’effectuer plus facilement d'éventuelles modifications.

- La structure
Code:

1 2 3 4 if choix = 'j' then {...} else if choix = 'r' then {...} else if choix = 'q' then {...} else {...}
peut être remplacée par quelque chose de la forme :
Code:

1 2 3 4 5 6 Case choix of 'j' : begin {...} end; 'r' : begin {...} end; 'q' : begin {...} end; else begin {...} end; end;
- De même, les boucles de la forme
Code:

1 2 3 4 5 i := 1; repeat {...} i := i + 1; until i = 4;
peuvent êtres remplacées par
Code:

1 2 3 4 For i:=1 to 3 do begin {...} end;
- enfin l'indentation du code peut être améliorée (elle n'est pas facile à mettre en place ici à cause de la longueur du programme, mais ce problème va s'arranger si tu le découpes en procédures ou fonctions).

Voila, c'est tout ce que j'ai vu pour l'instant.

merci des conseil, je re-posterais la nouvelle version dès que j'aurais fais les modifications

voila j'ai changé la structure
ainsi que les boucles
il me reste plus qu'a améliorer l'indentation et les procédures, mais je vois pas ce que sont les procédures

executable:
www.megaupload.com/?d=RSX08TQQ

code:
www.megaupload.com/?d=RXKTDNZH

Bon pour faire court, une procédure est un ensemble d'instructions implantée hors du programme (entre la déclaration des variables et le premier begin), et qui peut être appellée par le programme. Une fonction est une procédure qui renvoie un résultat au programme qui l'appel.

Cependant, je te conseil vivemet de consulter les diffrents tutoriels Pascal (ou autres langages, le principe est le même) qui sont à ta disposition ici pour en savoir plus (comme comment les implanter, les utiliser...)
Les procédures constituent des notions élémentaires qui sont généralement abordées dans les tutoriels pour débutants.

Bon courage.

merci, mais j'ai toujours eu du mal avec les cours théoriques, je trouve qu'un exercice en apprend bien plus qu'une dissert'
enfin je vais me pencher quand même sur la lecture de "cours et tutoriels" histoire de pas rester inculte malgré ma quasi certitude d'en ressortir bredouille :roll:
en tout cas merci ;)
et si tu as d'autres remarques sur le code je prend toujours

EDIT
ah oui j'oubliais, il arrive que parmi les propositions se trouve la reponse, c'est a dire qu'en face d'une des lignes se trouve :" 3 bien placés" ce qui est inutile puisqu'il n'y a plus a se creuser la tête
j'ai cherché un moyen de lui faire recommencer depuis le tout debut avant même d'écrire quoi que ce soit si une des lignes est identique a la solution,
j'avais pensé a un "repeat until solution[1] solution[2] et solution[3] differents des f[1] f[2] f[3] mais aussi g[1] g[2].... et h[1]... mais j'avais pas réussi,
il n'y aurai pas un moyen simple de lui faire comprendre ca?

Amusant comme programme.

Alors, pour l'indentation voilà par exemple comment il faudrait faire :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
program mastermind;
 
var
  i, faux, bienplace, malplace, reponse1, reponse2, reponse3: integer;
  {faux etant le nombre de fois que l'utilisateur se trompe}
  solution, f, g, h: array[1..3] of integer;
  choix: char;
begin
  writeln;
  writeln('                *************MASTERMIND**************');
  writeln('                **    Bienvenue dans Mastermind    **');
  writeln('                **     pour concours infirmier     **');
  writeln('                **      developpe par Loupsio      **');
  writeln('                **            Avril 2011           **');
  writeln('                *************MASTERMIND**************');
 
  i := 1;
  repeat
    writeln('choisissez');
    writeln('j: jouer');
    writeln('r: lire les regles');
    writeln('q: quitter');
    readln(choix);
    choix := lowercase(choix);
    writeln;
    writeln;
    case choix of
      'j':
      begin
        randomize;
        begin
          for i := 1 to 3 do
          begin
            solution[i] := random(5) + 1;
            if solution[i] = solution[i - 1] then
              solution[i] := solution[i] + 1;
            if solution[i] = solution[i - 2] then
              solution[i] := solution[i] + 1;
            if solution[i] = solution[i - 1] then
              solution[i] := solution[i] + 1;
          end;
          for i := 1 to 3 do
          begin
            f[i] := random(5) + 1;
            if f[i] = f[i - 1] then
              f[i] := f[i] + 1;
            if f[i] = f[i - 2] then
              f[i] := f[i] + 1;
            if f[i] = f[i - 1] then
              f[i] := f[i] + 1;
          end;
          for i := 1 to 3 do
          begin
            g[i] := random(5) + 1;
            if g[i] = g[i - 1] then
              g[i] := g[i] + 1;
            if g[i] = g[i - 2] then
              g[i] := g[i] + 1;
            if g[i] = g[i - 1] then
              g[i] := g[i] + 1;
          end;
 
          for i := 1 to 3 do
          begin
            h[i] := random(5) + 1;
            if h[i] = h[i - 1] then
              h[i] := h[i] + 1;
            if h[i] = h[i - 2] then
              h[i] := h[i] + 1;
            if h[i] = h[i - 1] then
              h[i] := h[i] + 1;
          end;
        end;
 
        begin
          bienplace := 0;
          malplace := 0;
          {PREMIERE LIGNE}
          if solution[1] = f[1] then
            bienplace := bienplace + 1;
          if solution[2] = f[2] then
            bienplace := bienplace + 1;
          if solution[3] = f[3] then
            bienplace := bienplace + 1;
          writeln('les possibilites sont:');
          writeln;
          for i := 1 to 3 do
          begin
            Write(f[i]);
          end;
          if bienplace <> 0 then
            Write('   ', bienplace, ' bien places ;');
 
          if solution[1] = f[2] then
            malplace := malplace + 1;
          if solution[1] = f[3] then
            malplace := malplace + 1;
          if solution[2] = f[1] then
            malplace := malplace + 1;
          if solution[2] = f[3] then
            malplace := malplace + 1;
          if solution[3] = f[1] then
            malplace := malplace + 1;
          if solution[3] = f[2] then
            malplace := malplace + 1;
 
          if malplace <> 0 then
            writeln('   ', malplace, ' mal places')
          else
            writeln;
 
          {DEUXIEME LIGNE}
          bienplace := 0;
          malplace := 0;
          if solution[1] = g[1] then
            bienplace := bienplace + 1;
          if solution[2] = g[2] then
            bienplace := bienplace + 1;
          if solution[3] = g[3] then
            bienplace := bienplace + 1;
 
          for i := 1 to 3 do
          begin
            Write(g[i]);
          end;
          if bienplace <> 0 then
            Write('   ', bienplace, ' bien places ;');
 
          if solution[1] = g[2] then
            malplace := malplace + 1;
          if solution[1] = g[3] then
            malplace := malplace + 1;
          if solution[2] = g[1] then
            malplace := malplace + 1;
          if solution[2] = g[3] then
            malplace := malplace + 1;
          if solution[3] = g[1] then
            malplace := malplace + 1;
          if solution[3] = g[2] then
            malplace := malplace + 1;
          if malplace <> 0 then
            writeln('   ', malplace, ' mal places')
          else
            writeln;
 
          {TROSIEME LIGNE}
          bienplace := 0;
          malplace := 0;
          if solution[1] = h[1] then
            bienplace := bienplace + 1;
          if solution[2] = h[2] then
            bienplace := bienplace + 1;
          if solution[3] = h[3] then
            bienplace := bienplace + 1;
          i := 1;
          for i := 1 to 3 do
          begin
            Write(h[i]);
          end;
          if bienplace <> 0 then
            Write('   ', bienplace, ' bien places ;');
 
          if solution[1] = h[2] then
            malplace := malplace + 1;
          if solution[1] = h[3] then
            malplace := malplace + 1;
          if solution[2] = h[1] then
            malplace := malplace + 1;
          if solution[2] = h[3] then
            malplace := malplace + 1;
          if solution[3] = h[1] then
            malplace := malplace + 1;
          if solution[3] = h[2] then
            malplace := malplace + 1;
          if malplace <> 0 then
            writeln('   ', malplace, ' mal places')
          else
            writeln;
 
        end;
        faux := 0;
        writeln('entre ta solution (chaques chiffres separes par des espaces)');
        repeat
          if faux <= 2 then {2 autorise 3 erreur avant don de solution}
          begin
            readln(reponse1, reponse2, reponse3);
            if (reponse1 = solution[1]) and (reponse2 = solution[2]) and
              (reponse3 = solution[3]) then
            begin
              writeln('CORRECT');
              writeln;
              writeln;
            end
            else
            begin
              writeln('FAUX');
              faux := faux + 1;
            end;
          end
          else
          begin
            faux := 5; {5 est impossible donc c est qu il a rate  son dernier coup et affiche la reponse}
            reponse1 := solution[1];
            reponse2 := solution[2];
            reponse3 := solution[3];
          end;
        until (reponse1 = solution[1]) and (reponse2 = solution[2]) and (reponse3 = solution[3]);
        if faux = 5 then
          writeln('la solution est: ', solution[1], solution[2], solution[3]);
        writeln;
        writeln;
      end;
      'r':
      begin
        writeln('************************************************************');
        writeln('************************************************************');
        writeln('**', '**': 58);
        writeln('** pour jouer tu dois trouver les 3 chiffre de la reponse **');
        writeln('**    les indices en bout de lignes t indiquent si ces    **');
        writeln('**         chiffres sont presents dans la reponse         **');
        writeln('**                         EXEMPLE                        **');
        writeln('**             342   2 mal places 1 bien place            **');
        writeln('**      signifie que le 2 le 3 et le 4 sont presents      **');
        writeln('**          mais que un seul est a la bonne place         **');
        writeln('**   aides toi des trois lignes pour trouver la solution  **');
        writeln('**                      BONNE CHANCE                      **');
        writeln('**', '**': 58);
        writeln('************************************************************');
        writeln('************************************************************');
      end;
      'q':
        writeln
      else
        writeln('tu dois choisir entre j,r et q, tu as appuye sur ', choix);
    end;
  until choix = 'q';
end.

Voilà ton programme réécrit avec des procédures :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
program mastermind;
 
procedure AfficheAide;
begin
  writeln('************************************************************');
  writeln('************************************************************');
  writeln('**', '**': 58);
  writeln('** pour jouer tu dois trouver les 3 chiffre de la reponse **');
  writeln('**    les indices en bout de lignes t indiquent si ces    **');
  writeln('**         chiffres sont presents dans la reponse         **');
  writeln('**                         EXEMPLE                        **');
  writeln('**             342   2 mal places 1 bien place            **');
  writeln('**      signifie que le 2 le 3 et le 4 sont presents      **');
  writeln('**          mais que un seul est a la bonne place         **');
  writeln('**   aides toi des trois lignes pour trouver la solution  **');
  writeln('**                      BONNE CHANCE                      **');
  writeln('**', '**': 58);
  writeln('************************************************************');
  writeln('************************************************************');
end;
 
//type et variable utiles pour AfficheLigneAvecEvaluation
type
  TLigne= array[1..3] of integer;
 
var
  solution: TLigne;
 
procedure AfficheLigneAvecEvaluation(ligne: TLigne);
var bienplace, malplace,i: integer;
begin
  bienplace := 0;
  malplace := 0;
 
  if solution[1] = ligne[1] then
    bienplace := bienplace + 1;
  if solution[2] = ligne[2] then
    bienplace := bienplace + 1;
  if solution[3] = ligne[3] then
    bienplace := bienplace + 1;
 
  for i := 1 to 3 do
  begin
    Write(ligne[i]);
  end;
  if bienplace <> 0 then
    Write('   ', bienplace, ' bien places ;');
 
  if solution[1] = ligne[2] then
    malplace := malplace + 1;
  if solution[1] = ligne[3] then
    malplace := malplace + 1;
  if solution[2] = ligne[1] then
    malplace := malplace + 1;
  if solution[2] = ligne[3] then
    malplace := malplace + 1;
  if solution[3] = ligne[1] then
    malplace := malplace + 1;
  if solution[3] = ligne[2] then
    malplace := malplace + 1;
 
  if malplace <> 0 then
    writeln('   ', malplace, ' mal places')
  else
    writeln;
end;
 
function PrepareLigne: TLigne;
var
  i: Integer;
begin
  for i := 1 to 3 do
  begin
    result[i] := random(5) + 1;
    if result[i] = result[i - 1] then
      result[i] := result[i] + 1;
    if result[i] = result[i - 2] then
      result[i] := result[i] + 1;
    if result[i] = result[i - 1] then
      result[i] := result[i] + 1;
  end;
end;
 
var
  faux, reponse1, reponse2, reponse3: integer;
  {faux etant le nombre de fois que l'utilisateur se trompe}
  f, g, h: TLigne;
  choix: char;
 
begin
  writeln;
  writeln('                *************MASTERMIND**************');
  writeln('                **    Bienvenue dans Mastermind    **');
  writeln('                **     pour concours infirmier     **');
  writeln('                **      developpe par Loupsio      **');
  writeln('                **            Avril 2011           **');
  writeln('                *************MASTERMIND**************');
 
  repeat
    writeln('choisissez');
    writeln('j: jouer');
    writeln('r: lire les regles');
    writeln('q: quitter');
    readln(choix);
    choix := lowercase(choix);
    writeln;
    writeln;
    case choix of
      'j':
      begin
        randomize;
        begin
          solution := PrepareLigne;
          f := PrepareLigne;
          g := PrepareLigne;
          h := PrepareLigne;
        end;
 
        writeln('devinez a partir de ces exemples :');
        writeln;
 
        AfficheLigneAvecEvaluation(f);
        AfficheLigneAvecEvaluation(g);
        AfficheLigneAvecEvaluation(h);
 
        faux := 0;
        writeln('entre ta solution (chaques chiffres separes par des espaces)');
        repeat
          if faux <= 2 then {2 autorise 3 erreur avant don de solution}
          begin
            readln(reponse1, reponse2, reponse3);
            if (reponse1 = solution[1]) and (reponse2 = solution[2]) and
              (reponse3 = solution[3]) then
            begin
              writeln('CORRECT');
              writeln;
              writeln;
            end
            else
            begin
              writeln('FAUX');
              faux := faux + 1;
            end;
          end
          else
          begin
            faux := 5; {5 est impossible donc c est qu il a rate  son dernier coup et affiche la reponse}
            reponse1 := solution[1];
            reponse2 := solution[2];
            reponse3 := solution[3];
          end;
        until (reponse1 = solution[1]) and (reponse2 = solution[2]) and (reponse3 = solution[3]);
        if faux = 5 then
          writeln('la solution est: ', solution[1], solution[2], solution[3]);
        writeln;
        writeln;
      end;
      'r': AfficheAide;
      'q':
        writeln
      else
        writeln('tu dois choisir entre j,r et q, tu as appuye sur ', choix);
    end;
  until choix = 'q';
end.

Il fait 72 lignes de moins et est plus lisible.

On peut encore un peu l'améliorer avec des variables plus appropriées, une fonction EstSolution, et une façon plus logique de sortir de la boucle si l'utilisateur ne trouve pas la réponse attendue :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
program mastermind;
 
procedure AfficheAide;
begin
  writeln('************************************************************');
  writeln('************************************************************');
  writeln('**', '**': 58);
  writeln('** pour jouer tu dois trouver les 3 chiffre de la reponse **');
  writeln('**    les indices en bout de lignes t indiquent si ces    **');
  writeln('**         chiffres sont presents dans la reponse         **');
  writeln('**                         EXEMPLE                        **');
  writeln('**             342   2 mal places 1 bien place            **');
  writeln('**      signifie que le 2 le 3 et le 4 sont presents      **');
  writeln('**          mais que un seul est a la bonne place         **');
  writeln('**   aides toi des trois lignes pour trouver la solution  **');
  writeln('**                      BONNE CHANCE                      **');
  writeln('**', '**': 58);
  writeln('************************************************************');
  writeln('************************************************************');
end;
 
//type et variable utiles pour AfficheLigneAvecEvaluation
type
  TLigne= array[1..3] of integer;
 
var
  solution: TLigne;
 
function EstSolution(ligne: TLigne): boolean;
begin
  result := (ligne[1] = solution[1]) and (ligne[2] = solution[2]) and (ligne[3] = solution[3]);
end;
 
procedure AfficheLigneAvecEvaluation(ligne: TLigne);
var bienplace, malplace,i: integer;
begin
  bienplace := 0;
  malplace := 0;
 
  if solution[1] = ligne[1] then
    bienplace := bienplace + 1;
  if solution[2] = ligne[2] then
    bienplace := bienplace + 1;
  if solution[3] = ligne[3] then
    bienplace := bienplace + 1;
 
  for i := 1 to 3 do
  begin
    Write(ligne[i]);
  end;
  if bienplace <> 0 then
    Write('   ', bienplace, ' bien places ;');
 
  if solution[1] = ligne[2] then
    malplace := malplace + 1;
  if solution[1] = ligne[3] then
    malplace := malplace + 1;
  if solution[2] = ligne[1] then
    malplace := malplace + 1;
  if solution[2] = ligne[3] then
    malplace := malplace + 1;
  if solution[3] = ligne[1] then
    malplace := malplace + 1;
  if solution[3] = ligne[2] then
    malplace := malplace + 1;
 
  if malplace <> 0 then
    writeln('   ', malplace, ' mal places')
  else
    writeln;
end;
 
function PrepareLigne: TLigne;
var
  i: Integer;
begin
  for i := 1 to 3 do
  begin
    result[i] := random(5) + 1;
    if result[i] = result[i - 1] then
      result[i] := result[i] + 1;
    if result[i] = result[i - 2] then
      result[i] := result[i] + 1;
    if result[i] = result[i - 1] then
      result[i] := result[i] + 1;
  end;
end;
 
var
  f, g, h: TLigne; {exemples}
  reponse: TLigne;
  nbFaux: integer; {nombre de fois que l'utilisateur se trompe}
  choix: char;
 
begin
  writeln;
  writeln('                *************MASTERMIND**************');
  writeln('                **    Bienvenue dans Mastermind    **');
  writeln('                **     pour concours infirmier     **');
  writeln('                **      developpe par Loupsio      **');
  writeln('                **            Avril 2011           **');
  writeln('                *************MASTERMIND**************');
 
  repeat
    writeln('choisissez');
    writeln('j: jouer');
    writeln('r: lire les regles');
    writeln('q: quitter');
    readln(choix);
    choix := lowercase(choix);
    writeln;
    writeln;
    case choix of
      'j':
      begin
        randomize;
        solution := PrepareLigne;
        f := PrepareLigne;
        g := PrepareLigne;
        h := PrepareLigne;
 
        writeln('devinez a partir de ces exemples :');
        writeln;
 
        AfficheLigneAvecEvaluation(f);
        AfficheLigneAvecEvaluation(g);
        AfficheLigneAvecEvaluation(h);
 
        nbFaux := 0;
        writeln('entre ta solution (chaques chiffres separes par des espaces)');
        repeat
          if nbFaux <= 2 then {2 autorise 3 erreur avant don de solution}
          begin
            readln(reponse[1], reponse[2], reponse[3]);
            if EstSolution(reponse) then
            begin
              writeln('CORRECT');
              writeln;
              writeln;
            end
            else
            begin
              writeln('FAUX');
              nbFaux := nbFaux + 1;
            end;
          end
          else
          begin
            writeln('la solution est: ', solution[1], solution[2], solution[3]);
            reponse := solution;
          end;
        until EstSolution(reponse);
        writeln;
        writeln;
      end;
      'r': AfficheAide;
      'q':
        writeln
      else
        writeln('tu dois choisir entre j,r et q, tu as appuye sur ', choix);
    end;
  until choix = 'q';
end.

Maintenant, pour éviter que la solution soit proposée, il suffit d'initialiser le jeu comme cela :

Code:

1
2
3
4
5
6
7
8
9
10
        solution := PrepareLigne;
        repeat
          f := PrepareLigne;
        until not EstSolution(f);
        repeat
          g := PrepareLigne;
        until not EstSolution(g);
        repeat
          h := PrepareLigne;
        until not EstSolution(h);

Finalement, voilà un résultat presque parfait avec quelques procédures en plus :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
program mastermind;
 
procedure AfficheAide;
begin
  writeln('************************************************************');
  writeln('************************************************************');
  writeln('**', '**': 58);
  writeln('** pour jouer tu dois trouver les 3 chiffre de la reponse **');
  writeln('**    les indices en bout de lignes t indiquent si ces    **');
  writeln('**         chiffres sont presents dans la reponse         **');
  writeln('**                         EXEMPLE                        **');
  writeln('**             342   2 mal places 1 bien place            **');
  writeln('**      signifie que le 2 le 3 et le 4 sont presents      **');
  writeln('**          mais que un seul est a la bonne place         **');
  writeln('**   aides toi des trois lignes pour trouver la solution  **');
  writeln('**                      BONNE CHANCE                      **');
  writeln('**', '**': 58);
  writeln('************************************************************');
  writeln('************************************************************');
end;
 
{type TLigne avec la fonction pour tester l'egalite}
type
  TLigne= array[1..3] of integer;
 
function LigneEgale(ligne1,ligne2: TLigne): boolean;
begin
  result := (ligne1[1] = ligne2[1]) and (ligne1[2] = ligne2[2]) and (ligne1[3] = ligne2[3]);
end;
 
var
  solution: TLigne;
 
function EstSolution(ligne: TLigne): boolean;
begin
  result := LigneEgale(ligne,solution);
end;
 
procedure AfficheLigneAvecEvaluation(ligne: TLigne);
var bienplace, malplace,i,j: integer;
begin
  bienplace := 0;
  malplace := 0;
 
  for i := 1 to 3 do
  begin
    Write(ligne[i],' ');
  end;
 
  for i := 1 to 3 do
    if solution[i] = ligne[i] then
      inc(bienplace);
  if bienplace <> 0 then
    Write('   ', bienplace, ' bien places ;');
 
  for i := 1 to 3 do
    for j := 1 to 3 do
      if (i<>j) and (solution[i]=ligne[j]) then
        inc(malplace);
  if malplace <> 0 then
    write('   ', malplace, ' mal places');
 
  writeln;
end;
 
function PrepareLigne: TLigne;
var
  i,j: Integer;
  valide : boolean;
begin
  for i := 1 to 3 do
  begin
    repeat
      result[i] := random(5) + 1;
      valide := true;
      for j := 1 to i-1 do
        if result[i]=result[j] then
          valide := false;
    until valide;
  end;
end;
 
procedure AfficheExemples;
var
  exemple: array[1..3] of TLigne;
  valide : boolean;
  i,j: Integer;
begin
  writeln('devinez a partir de ces exemples :');
  writeln;
  for i := 1 to 3 do
  begin
    repeat
      exemple[i] := PrepareLigne;
      valide := true;
      for j := 1 to i-1 do {on ne donne pas deux fois le même exemple}
        if LigneEgale(exemple[i],exemple[j]) then
          valide := false;
      if EstSolution(exemple[i]) then {ni la solution}
        valide := false;
    until valide;
 
    AfficheLigneAvecEvaluation(exemple[i]);
  end;
end;
 
procedure Jeu;
var
  reponse: TLigne;
  nbFaux: integer; {nombre de fois que l'utilisateur se trompe}
begin
  randomize;
  solution := PrepareLigne;
  AfficheExemples;
 
  nbFaux := 0;
  writeln('entre ta solution (chaques chiffres separes par des espaces)');
  repeat
    if nbFaux <= 2 then {2 autorise 3 erreur avant don de solution}
    begin
      readln(reponse[1], reponse[2], reponse[3]);
      if EstSolution(reponse) then
      begin
        writeln('CORRECT');
        writeln;
        writeln;
      end
      else
      begin
        writeln('FAUX');
        nbFaux := nbFaux + 1;
      end;
    end
    else
    begin
      writeln('la solution est: ', solution[1],' ', solution[2],' ', solution[3]);
      reponse := solution;
    end;
  until EstSolution(reponse);
  writeln;
  writeln;
end;
 
var
  choix: char;
 
begin
  writeln;
  writeln('                *************MASTERMIND**************');
  writeln('                **    Bienvenue dans Mastermind    **');
  writeln('                **     pour concours infirmier     **');
  writeln('                **      developpe par Loupsio      **');
  writeln('                **            Avril 2011           **');
  writeln('                *************MASTERMIND**************');
 
  repeat
    writeln('choisissez');
    writeln(' j: jouer');
    writeln(' r: lire les regles');
    writeln(' q: quitter');
    readln(choix);
    choix := lowercase(choix);
    writeln;
    writeln;
    case choix of
      'j': Jeu;
      'r': AfficheAide;
      'q': writeln;
      else
        writeln('tu dois choisir entre j, r et q, tu as appuye sur ', choix);
    end;
  until choix = 'q';
end.

Prochaine étape, ajouter des constantes pour le nombre d'essais possibles, sur le nombre chiffres différents possibles, sur le nombre de chiffres par ligne et sur la possibilité d'avoir des doublons ou pas dans une même ligne.

Citation:

Prochaine étape, ajouter des constantes pour le nombre d'essais possibles, sur le nombre chiffres différents possibles, sur le nombre de chiffres par ligne et sur la possibilité d'avoir des doublons ou pas dans une même ligne.

mdr déja je viens de tout ré-indenter et je me penche sérieusement sur les procédures, alors on va attendre un petit peu avant de rajouter des niveaux de difficultés au jeu tel que le nombre de chiffres par ligne et le nombre de chiffres possibles ^^

d'ailleurs j'ai fait un copier coller de toute la partie re-écrite avec des procédures pour voir ce que ca changeait de rajouter ou retirer certaines lignes mais j'ai pas eu le temps de tester car il trouve des erreur a la compilation entre la ligne 74 et 80,
d'abords il trouvait pas l'identifier "result", je l'ai rajouté a coté du "i" en tant qu'integer, ensuite sur les mêmes tranche de ligne il mettait "illegal qualifier" au niveau du "i" de "result[i]

Peut-être que le compilateur que tu utilises ne connais pas le mot "result", signifiant le résultat de la fonction. Tu peux résoudre cela en mettant le nom de la fonction à la place, en l'occurrence PrepareLigne.

Ou bien tu peux rajouter une variable, mais avec le bon type, en l'occurrence TLigne, ce qui donne :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 function PrepareLigne: TLigne; var i: Integer; ligne: TLigne; begin for i := 1 to 3 do begin ligne[i] := random(5) + 1; if ligne[i] = ligne[i - 1] then ligne[i] := ligne[i] + 1; if ligne[i] = ligne[i - 2] then ligne[i] := ligne[i] + 1; if ligne[i] = ligne[i - 1] then ligne[i] := ligne[i] + 1; end; PrepareLigne := ligne; end;

ok merci de l'aide

Pas de problème.

1 pièce(s) jointe(s)

Oh un mastermind! ça me fait penser à un vieux code que j'avais fait en 2006, dont voici le moteur et le jeux compilé si tu veux t'en inspiré :

:ccool:

Dr Who, cela ne marche pas, il dit qu'il trouve pas GFXPack.rpk

désolé j'avais pas vu le message,
chez moi non plus ca ne marche pas