Program ep96_411;

{
     Ecole Polytechnique  ...........................   95.411

On considŠre dans le plan Rύ la transformation T qui a tout point m de
coordonn‚es (x, y) associe un autre point M=T(m) de coordonn‚es (u,v)
d‚finies de la fa‡on suivante :

u=(x*y-x)/(x*y-1)
v=(x*y-y)/(x*y-1)


L'image de m existe-t-elle pour tout M ?
Quelle est la transformation inverse T-1?

1/ Ecrire un programme Pascal capable de tracer l'image F' d'une figure F
par la transformation T

Appliquer ce programme pour montrer quelle est l'image d'une droite,
d'un cercle, d'une famille de droites parallŠles ou concourantes,
ou d'un famille de cercles concentriques.



2/ Quelles sont les figures qui sont globalement conserv‚es
par la transformation T ?



:--------------------------------------------------------------:
:    Imprimer tous les r‚sultats                               :
:     en indiquant chaque fois … quoi ils correspondent        :
:--------------------------------------------------------------:
                            -=-=-=-
 }

uses
    crt, modubase;

type
    Myreal=real;


var
   ch:char;
   times:integer;
   a1,a0,b1,b0,c1,c0:MyReal;
   x,x1,x2,m:MyReal;
   Car         : Char ;
   Question    : Char;
   pas : MyReal;
   xini : MyReal;
   xinipas : MyReal;
   choisir: Boolean;

   sizeY:MyReal;

type Points=record
       x,y:Real;
       end;
Const
     size=10;
     eps=1e-6;
     Escape=#27;


Type
    Claviers = record
     Touche     : Char;
     Enter      : Boolean;
     Escape     : Boolean;
     BackSpace  : Boolean;
     SpaceBar   : Boolean;    
     Up         : Boolean;
     Down       : Boolean;
     Left       : Boolean;
     Right      : Boolean;
     Home       : Boolean;
     Fin        : Boolean;
     PageUp     : Boolean;
     PageDown   : Boolean;
     Insert     : Boolean;
     Suppr      : Boolean;
     Ctrl_Left  : Boolean;
     Ctrl_Right : Boolean;
    end;


var
   Clavier:Claviers;

Procedure Lire_Clavier;
Const
     Clavier_vide:Claviers=(Touche    :#00;
                            Enter     : False;
                            Escape    : False;
                            BackSpace : False;
                            SpaceBar  : False;
                            Up        : False;
                            Down      : False;
                            Left      : False;
                            Right     : False;
                            Home      : False;
                            Fin       : False;
                            PageUp    : False;
                            PageDown  : False;
                            Insert    : False;
                            Suppr     : False;
                            Ctrl_Left : False;
                            Ctrl_Right: False);
begin
  Clavier:=Clavier_vide;
  With Clavier do
   begin
     repeat
     until Keypressed;
     Touche := Readkey;
    If Touche=#00 then
        begin
             Touche  :=ReadKey;
             Up           :=Touche=#72;
             Down         :=Touche=#80;
             Left         :=Touche=#75;
             Right        :=Touche=#77;
             Home         :=Touche=#71;
             Fin          :=Touche=#79;
             PageUp       :=Touche=#73;
             PageDown     :=Touche=#81;
             Insert       :=Touche=#82;
             Suppr        :=Touche=#83;
             Ctrl_Left    :=Touche=#115;
             Ctrl_Right   :=Touche=#116;
             Touche:=#00;
        end
    else
        begin
             Enter    := Touche= #13;
             Escape   := Touche= #27;
             BackSpace:= Touche= #08;
             SpaceBar := Touche= ' ';
             Touche:=Upcase(Touche);
        end;
   end;   {  With Clavier }
end;

Procedure Move(var M:Points);
Var
   SavetextAttr:Byte;
begin
  With M do
     With clavier do
      begin
         SavetextAttr:=TextAttr;
         Croix(x,y);
         repeat
           repeat
{                   Deplace(-10,SizeY*0.70);
                   Ecris('x0=');Ecrisreel(x);
                   Ecris('  y0=');Ecrisreel(y);

 }

            Delay(10);
            Croix(x,y);
            Delay(10);
            Croix(x,y);
           until Keypressed;
           Lire_clavier;
           if left  then x:=x-pas;
           if right then x:=x+pas;
           if Up    then y:=y+pas;
           If Down  then y:=y-pas;
           case Touche of
                '+'  : pas:=pas*2;
                '-'  : pas:=pas/2;
           end; { case }
         until Enter or left or right or up or down;
         TextAttr:=SaveTextAttr;
    end ;  { with }
end;


Procedure DefinirPoint(var P:Points;x,y:Real);
begin
     P.x:=x;
     P.y:=y;
end;


function Distance(P,Q:points):real;
begin
     Distance:=sqrt(sqr(P.x-Q.x)+sqr(P.y-Q.y));
end;

procedure Transforme(P:points;VAR T:points);
var
   i:integer;
begin
     with P do
     for i:=1 to times do
     begin
     if x*y<>1 then
          begin
               T.x:=(x*y-x)/(x*y-1);


               T.y:=(x*y-y)/(x*y-1);
          end
     else
         DEfinirPoint(T,0,0);
     P:=T;
     end;


end;

procedure Transforme1(P:points;VAR T:points);
var
   i:integer;
begin
     with P do
     for i:=1 to times do
          begin

               T.x:=x/(1-y);
               T.y:=y/(1-x);
               P:=T;
          end;
end;

Procedure Segment(P,Q:Points);
begin
     if distance(P,Q)<1 then
       begin
            With P do deplace(x,y);
            With Q do   trace(x,y);
       end;
end;

Procedure  ImageSegment(P1,P2:points);
var
   T,TT,P,PP:points;
   lambda,dl:real;

   begin
        dl:=0.001;
        lambda:=0;
        Transforme(P1,TT);
        PP:=P1;
        repeat
              P.x:=P1.x+lambda*(P2.x-P1.x);
              P.y:=P1.y+lambda*(P2.y-P1.y);
              Transforme(P,T);
              lambda:=lambda+dl;
              Couleur(Vert);
              Segment(PP,P);
              PP:=P;
              Couleur(-Brillant);
              SEgment(TT,T);
              TT:=T;
        until lambda>1;
   end;

Procedure  Image2Segment(P1,P2:points);
var
   T,TT,P,PP,U,UU:points;
   lambda,dl:real;

   begin
        dl:=0.001;
        lambda:=0;
        Transforme(P1,TT);
        Transforme(TT,UU);
        PP:=P1;
        repeat
              P.x:=P1.x+lambda*(P2.x-P1.x);
              P.y:=P1.y+lambda*(P2.y-P1.y);
              Transforme(P,T);
              Transforme(T,U);
              lambda:=lambda+dl;
              Couleur(Vert);
              Segment(PP,P);
              PP:=P;
              Couleur(-Jaune);
              SEgment(TT,T);
              TT:=T;
              Couleur(-Brillant);
              SEgment(UU,U);
              UU:=U;
              Delay(500);
        until lambda>1;
   end;

Procedure  ImageCercle(P1:points;r:real);
var
   T,TT,P,PP:points;
   lambda,dl,theta,dt:real;

   begin
        dt:=0.01;
        P:=P1;
        P.x:=P1.x+r;
        Transforme(P,TT);
        PP:=P;
        theta:=2*pi;
        repeat
              P.x:=P1.x+r*cos(theta);
              P.y:=P1.y+r*sin(theta);
              Transforme(P,T);
              Couleur(vert);
              Segment(PP,P);
              PP:=P;
              Couleur(-Brillant);
                            SEgment(TT,T);
              TT:=T;
              theta:=theta-dt;
        until theta<0;
   end;


procedure Presentation;
begin;
      Randomize;
      Efface;
      WriteLN(' ====== EP96.411 Transpormation AP BQ =====');
      WriteLN('                                  ');
      WriteLN('                                                  ');
      WriteLN(' (1)      Cercle                                 ');
      WriteLN(' (2)      Droites concourantes                                          ');
      WriteLN(' (3)      Cercles concentriques                                         ');
      WriteLN(' (4)      It‚ration                                                     ');
      WriteLN(' (5)      Semis                                                    ');
      WriteLN(' (6)      Tύ                                                   ');
      WriteLN(' (7)      Invariants                                                  ');
      WriteLN('                              ');
      Write('   Tapez votre Choix  :  ');
end;


procedure Question1;
var
   r,theta,dt:MyReal;
   P,P1,P2,T,U,PP,UU:POints;
   ta:array[0..10] of Points;
   i:integer;
const
     xmin=-10;
     xmax= 10;
     ymin=-5;
var
   x,y:Real;
begin
     Efface;
     Writeln('ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Question nψ1 ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»');
     Writeln('Ί                                                                   Ί');
     Writeln('Ί      Cercle                                                      Ί');
     Writeln('Ί                                                                   Ί');
     Writeln('ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ');
     ModeGraphique;
     ISoFenetre(xmin,xmax,ymin);
      X_axe(0,0,1);
      Y_axe(0,0,1);
      pas:=0.1;
      Times:=1;
      theta:=2*pi;
      dt:=0.01;
      r:=exp(theta);
      DefinirPoint(P,cos(theta),sin(theta));
      Transforme(P,U);
      Repeat
            r:=theta;
            PP:=P;
            DefinirPoint(P,cos(theta),sin(theta));
            Couleur(-Vert);
            Segment(PP,P);
            UU:=U;
            Transforme(P,U);
            Couleur(-Brillant);
            Segment(UU,U);


            theta:=theta-dt;
      until theta<0;
      Pause;
end;

procedure Question2;
var
   r,theta,dt:MyReal;
   P,P1,P2:POints;
const
     xmin=-2;
     xmax= 2;
     ymin=-2;
     ymax= 2;
var
   x,y:Real;
begin
     Efface;
     Writeln('ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Question nψ2 ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»');
     Writeln('Ί                                                                   Ί');
     Writeln('Ί      Droites concourantes                                         Ί');
     Writeln('Ί                                                                   Ί');
     Writeln('ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ');
     ModeGraphique;
     Fenetre(xmin,xmax,ymin,ymax);
      X_axe(0,0,1);
      Y_axe(0,0,1);
      Couleur(Rouge);
      Croix(1,1);
      r:=20;
      theta:=2*pi;
      dt:=0.2;
      DefinirPoint(P,random,random);
      DefinirPoint(P,0.4,0.3);
      Transforme(P,P1);
      Point(1,0);
      Trace(1,1);
      Trace(0,1);
      Trace(P1.x,P1.y);
      Trace(1,0);
      repeat
            DEfinirPoint(P1,P.x-r*cos(theta),P.y-r*sin(theta));
            DEfinirPoint(P2,P.x+r*cos(theta),P.y+r*sin(theta));
            ImageSegment(P1,P2);
            PAuse;
            ImageSegment(P1,P2);
            theta:=theta-dt;
            
      until false;
      PAuse;
end;


procedure Question3;
var
   r,dr,delta:MyReal;
   P,P1,P2:POints;
const
     xmin=-2;
     xmax= 2;
     ymin=-1;
     ymax=  2;
var
   x,y:Real;
begin
     Efface;
     Writeln('ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Question nψ3 ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»');
     Writeln('Ί                                                                   Ί');
     Writeln('Ί      Cercles concentriques                                        Ί');
     Writeln('Ί                                                                   Ί');
     Writeln('ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ');
     times:=1;
     ModeGraphique;
     Fenetre(xmin,xmax,ymin,ymax);
      X_axe(0,0,1);
      Y_axe(0,0,1);
      r:=0;
      dr:=0.1;
      DefinirPoint(P,1,1);
      DefinirPoint(P,random,random);
    

      repeat
            Croix(P.x,P.y);

            ImageCercle(P,r);
            Deplace(-1,1.2);
            Ecris('x=');EcrisReel(P.x);
            Ecris(' y=');EcrisReel(P.y);
            Ecris(' r=');EcrisReel(r);
            ImageCercle(P,r);
               r:=r+dr;
      until false;

end;

procedure Question4;
var
   P,PP:POints;
   Q,QQ:POints;
const
     xmin=-20;
     xmax= 20;
     ymin=-10;
     ymax=  20;
var
   x,y:Real;
begin
     Efface;
     Writeln('ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Question nψ4 ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»');
     Writeln('Ί                                                                   Ί');
     Writeln('Ί      It‚ration                                                    Ί');
     Writeln('Ί                                                                   Ί');
     Writeln('ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ');
     ModeGraphique;
     Fenetre(xmin,xmax,ymin,ymax);
     Times:=1;
      repeat
            Efface;
            X_axe(0,0,1);
            Y_axe(0,0,1);
            Couleur(Rouge);
            Croix(1,1);
            DefinirPoint(P,10*random-5,10*random-5);
            Q:=P;
{            P.y:=2-P.x;  }
            Couleur(-jaune);
            Croix(P.x,P.y);
            repeat
                  Point(P.x,P.y);
                  PP:=P;
                  QQ:=Q;
                  Transforme(P,P);
                  Transforme1(Q,Q);
                  Segment(P,PP);
                  Segment(Q,QQ);
            until (distance(P,PP)<0.001) or (distance(P,PP)>1000) or (Keypressed);
            if KeyPressed then
               ch:=ReadKEy;
            Couleur(Brillant);
            Croix(P.x,P.y);
            Cercle(P.x,P.y,0.5);








            PAuse;
      until false;
end;

procedure Question5;
var
   P,PP:POints;
   i,j,n:integer;
                 r:real;
const
     xmin=-20;
     xmax= 20;
     ymin=-10;
     ymax=  20;
var
   x,y:Real;
begin
     Efface;
     Writeln('ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Question nψ5 ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»');
     Writeln('Ί                                                                   Ί');
     Writeln('Ί      Semis                                                        Ί');
     Writeln('Ί                                                                   Ί');
     Writeln('ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ');
     ModeGraphique;
     Fenetre(xmin,xmax,ymin,ymax);
      X_axe(0,0,1);
      Y_axe(0,0,1);

      r:=0.4;

      for i:=1 to 10 do
          for j:=1 to 10 do
              begin
                   Couleur(i);
                   DefinirPoint(P,i-5,j-5);
                   Croix(P.x,P.y);
                   ImageCercle(P,r);

              end;
              Pause;
end;

procedure Question6;
var
   r,theta,dt:MyReal;
   P,PP:POints;

   function f(x:real):real;
   begin
        x:=cos(theta)+sin(theta)+x*cos(theta)*sin(theta);
        if x=0 then
           f:=0
        else
            f:=-1/x;
   end;
const
     xmin=-10;
     xmax= 10;
     ymin=-10;
     ymax= 10;
var
   x,y,dx:Real;
begin
     Efface;
     Writeln('ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Question nψ6 ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»');
     Writeln('Ί                                                                   Ί');
     Writeln('Ί      Invariants Tύ                                                           Ί');
     Writeln('Ί                                                                   Ί');
     Writeln('ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ');
     ModeGraphique;
     Theta:=0;
     dt:=0.1;
     Fenetre(xmin,xmax,ymin,ymax);
      repeat
      Efface;
      X_axe(0,0,1);
      Y_axe(0,0,1);
      Couleur(Rouge);
      Croix(2,2);
      Couleur(Brillant);
      Ecris('theta=');EcrisReel(theta);
      theta:=theta+dt;
      dx:=0.1;
      Couleur(Jaune);
      DefinirPoint(PP,xmin,xmin);
      DefinirPoint(P,xmax,xmax);
      Segment(PP,P);
         x:=xmin;
      Couleur(Jaune);
            DefinirPoint(PP,x,f(x));
      repeat
            DefinirPoint(P,x,f(x));
            Segment(PP,P);
            PP:=P;
            x:=x+dx;
      until x>xmax;
         x:=xmin;
      Couleur(Brillant);
            DefinirPoint(PP,x,f(f(x)));
      repeat
            DefinirPoint(P,x,f(f(x)));
            Segment(PP,P);
            PP:=P;
            x:=x+dx;
      until x>xmax;
      PAuse;
      until false;
end;

procedure Question7;
var
   r,theta,dt:MyReal;
   P,PP:POints;
const
     xmin=-10;
     xmax= 10;
     ymin=-10;
     ymax= 10;
var
   x,y:Real;
begin
     Efface;
     Writeln('ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Question nψ7 ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»');
     Writeln('Ί                                                                   Ί');
     Writeln('Ί      Invariants                                                           Ί');
     Writeln('Ί                                                                   Ί');
     Writeln('ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ');

      ModeGraphique;
     Fenetre(xmin,xmax,ymin,ymax);
     Times:=1;
      repeat
            Efface;
            X_axe(0,0,1);
            Y_axe(0,0,1);
            Couleur(Rouge);
            Croix(1,1);
            DefinirPoint(P,10*random-5,10*random-5);
            P.y:=2-P.x;
            Couleur(-jaune);
            Croix(P.x,P.y);
            repeat
                  Point(P.x,P.y);
                  PP:=P;
                  Transforme(P,P);
                  Couleur(-brillant);
                  CRoix(P.x,P.y);
            until (distance(P,PP)<0.001) or (distance(P,PP)>1000) or KEyPressed;
            if KeyPressed then
               ch:=ReadKEy;
            Couleur(Brillant);
            Croix(P.x,P.y);
            Cercle(P.x,P.y,0.5);
            PAuse;
      until false;
end;


begin
  Initgraphique;
  Randomize;
  while true do
  begin
     Modetexte;
     Presentation;

     times:=1;
     write('Question choisie ? ');
     readln(question);
     case question of
          '1':  Question1;
          '2':  Question2;
          '3':  Question3;
          '4':  Question4;
          '5':  Question5;
          '6':  Question6;
          '7':  Question7;
     end;
     Pause;
  end;
end.