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
| uses wincrt;
procedure attente;
{Attente d'un événement utilisateur: appui sur une touche}
var TouchePressee : boolean;
begin
writeln('Taper une touche pour la suite');
while not (TouchePressee) do TouchePressee:=Keypressed ;
end;
procedure Afficher;
{affichage du menu}
begin
clrscr;
WriteLn(' - Menu -'); WriteLn('');
WriteLn(' 1 - Jeu sans limitation de tentatives.');
WriteLn(' 2 - Jeu avec choix du nombre de tentatives.');
WriteLn(' 3 - Demonstration.');
WriteLn(' 4 - Quitter.'); WriteLn('');
Write ('Choix :');
end;
function saisie:integer;
{renvoie un entier entre 0 et 1000}
var retour :integer;
begin
write('Choix du nombre [0..1000] : ');
readln(retour);
while (retour<0) or (retour>1000) do
begin
write('Choix du nombre [0..1000] : ');
readln(retour);
end;
saisie:=retour;
end; {fin fct saisie}
{---------------------------- Jeu1 -------------------------}
procedure Jeu1;
var nb1, rep, essais :integer;
begin
clrscr;
nb1:=random(1000);
essais:=1;
rep:=saisie;
while rep<>nb1 do
begin
if rep>nb1
then writeln(' Trop haut, essai n°:',essais)
else writeln(' Trop bas, essai n°:',essais);
essais:=essais+1;
rep:=saisie;
end;
writeln('Vous avez trouvé en ',essais,' essais');
attente;
end; {fin jeu1}
{---------------------------- Jeu2 -------------------------}
procedure Jeu2;
var nb1, rep, essais, nb_essais :integer;
begin
clrscr;
nb1:=random(1000);
essais:=1;
write('Saisir le nombre d''essais désirés :');
readln(nb_essais);
rep:=saisie;
while (rep<>nb1) and (essais<>nb_essais) do
begin
if rep>nb1
then writeln(' Trop haut ! Il te reste : ',nb_essais-essais,' essais')
else writeln(' Trop bas ! Il te reste : ',nb_essais-essais,' essais');
essais:=essais+1;
rep:=saisie;
end;
if essais=nb_essais
then writeln (' Tu as perdu ; le nombre était : ',nb1)
else writeln(' Tu as gagné en ',essais,' coups.');
attente;
end; {fin jeu2}
{---------------------------- Jeu3 -------------------------}
procedure Jeu3;
var nb1, haut, bas, rep, essais :integer;
begin
clrscr;
nb1:=random(1000);
essais:=1; bas:=1; haut:=1000;
rep:=(bas+haut) div 2;
while (rep<>nb1) do
begin
writeln('Le programme propose : ',rep);
if rep>nb1
then
begin
writeln(' Trop haut, essai n°:',essais);
haut:=rep;
end
else
begin
writeln(' Trop bas, essai n°:',essais);
bas:=rep;
end;
essais:=essais+1;
rep:=(bas+haut) div 2;
end;
writeln(' Le programme a trouvé en ',essais,' essais.');
writeln('');
writeln(' La réponse était : ',rep); writeln('');
attente;
end;
{ DEBUT DU PROGRAMME PRINCIPAL }
var
choix :integer;
fin :boolean;
begin
randomize;
fin:=false;
repeat
afficher;
readln(choix);
case choix of
1: jeu1;
2: jeu2;
3: jeu3;
4: fin:=true;
else
begin
writeln ('Erreur de saisie.');
attente;
end;
end;
until fin;
writeln(' Au revoir et à bientôt.');
end. |
Partager