Programme du jeu snake en turbo pascal

program InterpolationLagrange; {$R+}

const nmax=100;
const epsilon=1e-6;
type tableau=array[0..nmax-1] of real;

procedure Demander(var a,b:tableau;var n:integer);
var i:integer;
begin
write('Degre n-1 du polynome P = '); readln(n);
writeln;
writeln('Pour tout i, P(Ai)=Bi, tous les Ai doivent etres deux a deux distincts');
writeln;
for i:=0 to n-1 do
    begin
    write('Pour A',i+1,' = '); readln(a[i]);
    write('On a B',i+1,' = '); readln(b[i]);
    writeln;
    end;
end;

function Apparait(v:real;var t:tableau;a,b:integer):boolean;
var k:integer;
begin
     for k:=a to b do
         if t[k]=v then exit(true);
result:=false;
end;

function Injectif(var t:tableau;n:integer):boolean;
var k:integer;
begin
     for k:=0 to n-2 do
         if Apparait(t[k],t,k+1,n-1) then exit(false);
result:=true;
end;

procedure InitConstant(var P:tableau;n:integer;c:real);
var k:integer;
begin
P[0]:=c;
for k:=1 to n-1 do P[k]:=0;
end;

procedure MulParBin(var P:tableau;n:integer;c0,c1:real);
var k:integer;
begin
for k:=n-1 downto 1 do P[k]:=c0*P[k]+c1*P[k-1];
P[0]:=c0*P[0];
end;

procedure Ajouter(var P,Q:tableau;n:integer);
var k:integer;
begin
for k:=0 to n-1 do P[k]:=P[k]+Q[k];
end;

procedure Lagrange(var P,a,b:tableau; n:integer);
var i,j:integer;
var Q:tableau;
begin
InitConstant(P,n,0);
for i:=0 to n-1 do
    begin
    InitConstant(Q,n,b[i]);
    for j:=0 to n-1 do
        if i<>j then MulParBin(Q,n,-a[j]/(a[i]-a[j]),1/(a[i]-a[j]));
    Ajouter(P,Q,n);
    end;
end;

procedure Afficher(var P:tableau;n:integer);
var k:integer;
begin
write(P[0]:0:5);
for k:=1 to n-1 do write(' + ',P[k]:0:5,'.X^',k);
writeln; writeln;
end;

function Valeur(var P:tableau;n:integer;x:real):real;
var k:integer;
begin
result:=P[n-1];
for k:=n-2 downto 0 do
    result:=x*result+P[k];
end;

procedure Verifier(var P,a,b:tableau;n:integer);
var k:integer;
var result:boolean;
begin
writeln;
result:=true;
for k:=0 to n-1 do
    if abs(Valeur(P,n,a[k])-b[k])>epsilon then begin result:=false; break end;
if result then writeln('Le polynome a ete calcule correctement')
          else writeln('Une erreur s''est produite, le polynome calcule est incorrect');
writeln('(verification effectue a ',epsilon,' près)');
writeln;
end;

var a,b,P:tableau;
var n:integer;
begin
while true do
      begin
      Demander(a,b,n);
      if Injectif(a,n) then break;
      writeln('Attention les Ai ne sont pas tous distincts !');
      end;
writeln;
Lagrange(P,a,b,n);
Afficher(P,n);
Verifier(P,a,b,n);
writeln; write('Fin du programme. Appuyer sur Entree'); readln;
end.

const n=10;

type Tab=array[1..n] of real;

function Calcul(x0:real; i:integer; x:Tab):real;
var k:integer;
begin
result:=1;
for k:=1 to n do
    result:=result*(x0-x[k])/(x[i]-x[k]);
end;