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
| Program TIPE;
Uses CRT;
Const
N=4;
Type
parcours=array[0..2*N,1..2] of integer;
grille=array[1..N,1..N] of integer;
Var
tout:grille;
jeu:parcours;
i:integer;
function choix_case_depart:integer;
begin
choix_case_depart:=random(N)+1;
end;
{*** Convention directions
1:gauche
2:gauche/bas
3:bas
***}
function choix_direction(i,j:integer):integer;
begin
if j=1 then choix_direction:=3
else
if i=N then choix_direction:=1
else
choix_direction:=random(3)+1;
end;
function min(i,j:integer):integer;
begin
if i>j then min:=j
else min:=i;
end;
function choix_progression(i,j,dir:integer):integer;
begin
if dir=1 then
choix_progression:=random(j-1)+1
else
if dir=3 then
choix_progression:=random(i-1)+1
else
choix_progression:=random(min(i,j)-1)+1;
end;
procedure raz_parcours(var jeu:parcours);
var
i:integer;
begin
for i:=0 to 2*N do
begin
jeu[i,1]:=0;
jeu[i,2]:=0;
end;
end;
procedure partie(var jeu:parcours);
var
i,j,k,dir,prog:integer;
begin
i:=1;
j:=choix_case_depart;
k:=1;
jeu[k,1]:=i;
jeu[k,2]:=j;
while ((i<>N) or (j<>1)) do
begin
dir:=choix_direction(i,j);
prog:=choix_progression(i,j,dir);
if dir=1 then
j:=j-prog
else
if dir=3 then
i:=i+prog
else
begin
i:=i+prog;
j:=j-prog;
end;
k:=k+1;
jeu[k,1]:=i;
jeu[k,2]:=j;
end;
jeu[0,1]:=k;
end;
procedure stats(var tout:grille);
var
jeu:parcours;
i,a,b,k,indice,theta:integer;
begin
for indice:=1 to 3 do
begin
raz_parcours(jeu);
partie(jeu);
k:=jeu[0,1];
theta:=0;
for i:=k downto 1 do
begin
a:=jeu[i,1];
b:=jeu[i,2];
if (theta mod 2 = 0) then
tout[a,b]:=tout[a,b]+1
else
tout[a,b]:=tout[a,b]-1;
theta:=theta+1;
end;
end;
end;
procedure affiche_grille(tout:grille);
var
i,j:integer;
begin
for i:=1 to N do
begin
for j:=1 to N do
write(tout[i,j]:4,' ');
writeln;
end;
end;
Begin
clrscr;
Randomize;
{partie(jeu);
for i:=1 to jeu[0,1] do
writeln(i,' : ',jeu[i,1],' ',jeu[i,2]);
writeln(jeu[0,1]);}
stats(tout);
affiche_grille(tout);
readln;
End. |
Partager