Bac 2010 10H30

Program bac201010h30;
Uses Wincrt;
Type
  tab = Array ['A'..'J','X'..'Y'] Of Integer;
  mat = Array ['A'..'J','A'..'J'] Of Real;
Var
  m: mat;
  t: tab;
  n: Integer;

Procedure remplir_T (Var t:tab;Var n:Integer);
Var
  i,c: Char;
Begin
  Repeat
    Write ('Saisir N: ');
    Readln (n);
  Until (3<=n) And (n<=10);
  c := Chr(64+n);
  For i:='A' To c Do
    Begin
      Write ('Saisir X ',i,': ');
      Readln (t[i,'X']);
      Write ('Saisir Y ',i,': ');
      Readln (t[i,'Y']);
    End;
  For i:='A' To c Do
    Begin
      Writeln ('X: ',t[i,'X']);
      Writeln ('Y: ',t[i,'Y']);
    End;
  Clrscr;
End;

Procedure remplir_M (Var m:mat;t:tab;n:Integer);
Var
  i,j,c: Char;
Begin
  c := Chr(64+n);
  For i:='A' To c Do
    For j:='A' To c Do
      m[i,j] := Sqrt(Sqr(t[j,'X']-t[i,'X'])+Sqr(t[j,'Y']-t[i,'Y']));
End;

Procedure affiche (m:mat;n:Integer);
Var
  i,j,c,p,pm: Char;
  min: Real;
Begin
  c := Chr(64+n);
  For i:='A' To c Do
    Begin
      Writeln;
      For j:='A' To c Do
        Write (m[i,j]:0:2, ' | ');
    End;
  Writeln;
  Repeat
    Writeln ('Saisir un point: ');
    Readln (p);
    p := Upcase(p);
  Until (p In ['A'..c]);
  If p='A' Then
    Begin
      min := m[p,'B'];
      pm := 'B';
    End
  Else
    Begin
      min := m[p,'A'];
      pm := 'A';
    End;
  For j:='A' To c Do
    If (min>m[p,j]) And (m[p,j]<>0) Then
      Begin
        min := m[p,j];
        pm := j;
      End;
  Writeln ('Le point le plus proche de ',p,' est : ',pm);
End;
Begin
  remplir_T (t,n);
  remplir_M (m,t,n);
  affiche (m,n);
End.