Carré magique

Program C_Magic ;

{uses wincrt;}
uses crt;

Var
Tab : array [1..19,1..19]  of integer;
d,i,j,n : integer ;
m ,s: integer;
ok : boolean;

Begin

clrscr;

Writeln('Programme de construction d''un Carr‚ Magique');
writeln;
ok:=false;
repeat
  begin
  Write('Dimension du Carr‚ : nombre impair entre 3 et 19 -> ');
  readln(d);
    if ((d>=3) and (d<=19)) then
      begin
        if ((d mod 2)=1) then ok:=true; 
    end;
  end;
until ok ;


for i:=1 to d do
begin
for j:=1 to d do tab[i,j]:=0;
end;
n:=1;
{position de d‚part}
i:=1 ; j:=d div 2 +1;
tab [i,j]:=n;
{
d‚placement
- une ligne vers le haut, une colonne vers la droite
- si une case est occup‚e, une colonne vers la gauche
  et deux lignes vers le bas
- si on sort par le haut et par la droite : comme case occup‚e
- si on sort du tableau par le haut on entre par le bas
- si on sort du tableau par le bas on entre par le haut
- si on sort du tableau par la droite on entre par la gauche
- si on sort du tableau par la gauche on entre par la droite
}
While (n<(d*d)) do
  begin
  i:=i-1; j:=j+1;
  {si on sort par le haut et par la droite}
  if ((i=0) and (j>d)) then
   begin
   i:=i+2;j:=j-1;
   end;
  {si on sort par le bas }
  if i>d then i:=1;
  {si on sort par le haut }
  if i=0 then i:=d;
  {si on sort par la droite }
  if j>d then j:=1;
  {si on sort par la gauche }
  if j=0 then j:=d;
  if tab[i,j]>0 then
   begin
   i:=i+2;j:=j-1;
   end;
  n:=n+1;
  tab [i,j]:=n;
 { write(i, '   ' ,j , '   ' , n);
  readln;  }
  end;

writeln;
Writeln('  Carr‚ Magique ', d,'x',d);
m := d*(d*d+1) div 2;
writeln('  Nombre Magique = ',m);
writeln;

for i:=1 to d  do
begin
s:=0;
writeln;
for j:=1 to d  do
 begin
   write(tab[i,j]:3 , ' ');
 end;
writeln;
writeln;
end;
readln;
end.

Program Magic2 ;

{uses wincrt;}
uses crt;

Var
  Tab : array [1..19,1..19]  of integer;
  d,i,j,n : integer ;
  m ,t,err: integer;
  ok : boolean;
  a:string;
  startX , startY , mrg: integer;

procedure grille(d:integer);
var
  i,j:integer;
  marge:string;
  const hg=201;hd=187;bd=188;bg=200;dt=205;dh=209;db=207;
  const dg=199;st=196;sx=197;dd=182;dv=186;sv=179;bb=32;
begin
  mrg:=(80-(d*4)) div 2;
  marge:='';
  for i:=0 to mrg-4 do
      marge:=marge+' ';
  writeln;
  textbackground(0);
  textcolor(3);
{ligne du haut}
  startX:=whereX; startY:=whereY;
  write(marge,chr(hg),chr(dt),chr(dt),chr(dt));
  for i:=1 to d-1 do
    write(chr(dh),chr(dt),chr(dt),chr(dt));
  writeln(chr(hd));
{lignes intermediaires}
  for j:=1 to d-1 do
   begin
     write(marge,chr(dv),chr(bb),chr(bb),chr(bb));
     for i:=1 to d-1 do
        write(chr(sv),chr(bb),chr(bb),chr(bb));
     writeln(chr(dv));
     write(marge,chr(dg),chr(st),chr(st),chr(st));
     for i:=1 to d-1 do
        write(chr(sx),chr(st),chr(st),chr(st));
     writeln(chr(dd));
  end;
   write(marge,chr(dv),chr(bb),chr(bb),chr(bb));
   for i:=1 to d-1 do
      write(chr(sv),chr(bb),chr(bb),chr(bb));
   writeln(chr(dv));
{ligne du bas}
  write(marge,chr(bg),chr(dt),chr(dt),chr(dt));
  for i:=1 to d-1 do
      write(chr(db),chr(dt),chr(dt),chr(dt));
  writeln(chr(bd));
end;

procedure deplace(x:integer; y:integer; nb:integer;
                  tc:integer; tb:integer);
var
  posX,posY:integer;
begin
  textcolor(tc); textbackground(tb);
  posX:=startX+mrg-1+((x-1)*4);
  posY:=startY+1+((y-1)*2);
  gotoXY(posX-1,PosY); write(nb:3);
  gotoXY(PosX,PosY);
  delay(t);
end;

BEGIN
textcolor(7);textbackground(0);
clrscr;
Writeln('Programme de construction d''un Carr‚ Magique');
writeln;
ok:=false;
repeat
  begin
  gotoXY(1,3); clreol;
  gotoXY(1,3);
  Write('Dimension du Carr‚ : nombre impair entre 3 et 19 -> ');
  readln(a);
  d:=0;
  val(a,d,err);
      if ((d>=3) and (d<=19)) then
      begin
        if ((d mod 2)=1) then ok:=true;
    end;
  end;
until ok ;
writeln;
Writeln('                            Carr‚ Magique ', d,'x',d);
m := d*(d*d+1) div 2;
writeln('                            Nombre Magique = ',m);
writeln;
grille(d);

textcolor(7);textbackground(0);
ok:=false;
repeat
  begin
  gotoXY(1,47); clreol;
  gotoXY(1,47);write('Vitesse de remplissage entre 50 et 300 : ');
  readln(a);
  val(a,t,err);
    if ((t>=50) and (t<=300)) then ok:=true;
  end;
until ok ;
gotoXY(1,47); clreol;
for i:=1 to d do
begin
for j:=1 to d do tab[i,j]:=0;
end;
{position de d‚part}
n:=1;
i:=1 ; j:=d div 2 +1;
tab [i,j]:=n;
deplace(j,i,n,14,0);

While (n<(d*d)) do
  begin
  i:=i-1; j:=j+1;
  {si on sort par le haut et par la droite}
  if ((i=0) and (j>d)) then
   begin
   deplace(j,i,0,4,4);
   deplace(j,i,0,0,0);
   i:=i+2;j:=j-1;
   end;
  {si on sort par le bas }
  if i>d then
  begin
   deplace(j,i,0,4,4);
   deplace(j,i,0,0,0);
   i:=1;
  end;
  {si on sort par le haut }
  if i=0 then
  begin
   deplace(j,i,0,4,4);
   deplace(j,i,0,0,0);
   i:=d;
  end;
  {si on sort par la droite }
  if j>d then
  begin
   deplace(j,i,0,4,4);
   deplace(j,i,0,0,0);
   j:=1;
  end;
  {si on sort par la gauche }
  if j=0 then
  begin
   deplace(j,i,0,4,4);
   deplace(j,i,0,0,0);
   j:=d;
  end;
  if tab[i,j]>0 then
   begin
   deplace(j,i,tab[i,j],14,4);
   deplace(j,i,tab[i,j],14,0);
   i:=i+2;j:=j-1;
   end;
  n:=n+1;
  tab [i,j]:=n;
  deplace(j,i,0,2,2);
  deplace(j,i,n,14,0);
 { write(i, '   ' ,j , '   ' , n);
  readln;  }
  end;
gotoXY(1,47);write('Termin‚');
readln;
END.
{
d‚placement
- une ligne vers le haut, une colonne vers la droite
- si une case est occup‚e, une colonne vers la gauche
  et deux lignes vers le bas
- si on sort par le haut et par la droite : comme case occup‚e
- si on sort du tableau par le haut on entre par le bas
- si on sort du tableau par le bas on entre par le haut
- si on sort du tableau par la droite on entre par la gauche
- si on sort du tableau par la gauche on entre par la droite
}