Aller à la recherche

Traceur de courbes

Ci-dessous le code source d'une fonction de traceur de courbe issue de l'atelier de géométrie qui se trouve être désormais en licence libre. Cette fonction a été développée sous TPW15 mais peut être facilement adaptée pour être utilisée en pascal voire en C. On verra par exemple la procédure fonction qui est la fonction principale de cette unité ainsi que son algorithme de départ. Ce genre d'unité peut être modifiée et recompilée avec la plateforme delphi. Il faut considérer que le langage pascal n'est pas du tout un langage récursif à la base et cependant a été utilisé dans la programmation des tous premiers robots domestiques .

Le développement réel d'une application demande deux choses très précises : 

1* Un algorithme très précis 

2* l'assemblage d'unités pour la réalisation du programme final

D'autres éléments de programations sur le site des ordinateurs ...

Cet assemblage est important et il faut que les unités soient parfaitement bien définies au départ pour pouvoir s'assembler comme des petites briques de légo quoi ! On dit que les entrées et les sorties sont parfaitement respectées pour l’emboîtement final.

Quand à l'algorithme de base il peut être fait d'un seul bloc mais aussi de petites unités comme le programme lui-même. Un des algorithmes les plus complexes et les plus aboutis du moment est certainement celui qu'utilise google pour classer les sites. En fait celui qui va valoriser ou pénaliser le référencement de votre site. On peut imaginer qu'un tel algorithme doit être constitué d'un ensemble de modules assez complexes et assez impressionnants. Avec un module qui va évaluer le contenu de votre site et son autorité, un autre qui va évaluer les liens organiques vers votre site etc. Un bel algorithme et sans doute un modèle du genre.

Ci-dessous l'unité du fonctions de ce programme. Les variables, comme toujours en pascal sont déclarées en début d'unité et permettent donc un emboîtement plus facile à réaliser.

Unit fonctions;

(*$DEFINE VERSION_FR*)

interface uses Strings,WinTypes, WinDos, WinProcs, WObjects,

           StdDlgs,V_courbe,outils2,TypKonst,outils1,server;

type

 PHWindow = ^THWindow;
 THWindow = object(TWindow)
   premier : BOOLEAN;
   constructor Init(AParent: PWindowsObject; ATitle: PChar;X0,Y0:INTEGER);
   Destructor  Done; Virtual;
   procedure Horloge(var Msg: TMessage); virtual wm_First + wm_Timer;
   procedure ToucheUp(VAR Msg:Tmessage);virtual Wm_first+Wm_KeyUp;
   procedure SetUpWindow; Virtual;

END;

type

 POWindow = ^TOWindow; {pour faire une fenêtre d'outils}
 TOWindow = object(TWindow)
   constructor Init(AParent: PWindowsObject; ATitle: PChar;X0,Y0:INTEGER);
   Destructor  Done; Virtual;
   procedure WMLButtonDown(var Msg: TMessage); virtual wm_First + wm_LButtonDown;
   procedure SetUpWindow; Virtual;

END;

VAR magneto,comptor,memo_comptor,n_fois,Xoutil,Youtil: INTEGER;

   flag_trace,flag_bouge,flag_deplace,flag_lettres,flag_XOR:BOOLEAN;

procedure Kase_Fonc(Marquable:BOOLEAN;DC:HDC); procedure Trace_Sauve_Pt(DC:HDC;x,y:REAL;Teta,E,Fnc:INTEGER;C:TcolorRef;Mark,Mk:INTEGER); procedure Sauve_Figure(P1,P2,P3,Teta,G,Mk:INTEGER;Mass:REAL); procedure Sauve_Vector(P1,P2,Teta,G:INTEGER;Mass:REAL;Epaisseur:INTEGER); procedure cherche(Pt,A:BYTE); function Segment_Marque:INTEGER; function Cherche_Segment(No,Ni:REAL):INTEGER; function Cherche_Aire(Index:REAL):BOOLEAN; function Aumoins_Unlieu(VAR Depuis:INTEGER):BOOLEAN; function Collage(x,y:INTEGER):BOOLEAN; procedure faire_le_script; procedure Recale_OLE(No:INTEGER); procedure Change_Couleur(DC:HDC); Procedure Vire_Bloc(DC:HDC); function corrige_quadri(VAR n:INTEGER;Force:BOOLEAN):BOOLEAN; function Objet_lie(N:INTEGER):INTEGER; function nombre_dobjets:INTEGER; procedure Reqtangle(Dc:HDC;X1,Y1,X2,Y2,Gr,P,E:INTEGER;pt1:REAL); Function eclaire_bloc(Num:INTEGER):BOOLEAN; procedure transforme(VAR Stn : STRING; r1 : REAL); {--}

    implementation

{--} uses geom_app,globales; {--}

procedure transforme(VAR Stn : STRING; r1 : REAL); VAR pg : PDgraph;

   st0,st1 : STRING;
   k0,k,compt,err : INTEGER;
   Tk : ARRAY1..5 OF INTEGER;
   rx,ry,rk : REAL;
   r2 : longint;

BEGIN {pour modifier l'equation d'une courbe par translation}

  r2:=round(r1);
  k := r2 DIV 1000;
  Pg :=points^.at(k); Stn:=Pg^.nm;
  k:=  r2 MOD 1000;
  k0:=pos('#',Stn); Pg:=Points^.at(k);
  IF (V_collect) THEN ry:=-pg^.No_2^.v_y/uniteY ELSE ry:=-pg^.No_2^.y/uniteY;
  str(ry:4:2,St0);IF St01<>'-' THEN St0:='+'+St0;
  INSERT(St0,StN,k0);
  IF (V_collect) THEN rx:=-pg^.No_2^.v_X/uniteX ELSE rx:=-pg^.No_2^.X/uniteX;
  str(rx:4:2,St0);IF St01<>'-' THEN St0:='+'+St0;
  st0:='(x'+st0+')';
  k:=length(Stn);
  While k>0 do
    BEGIN
     IF Stnk='x' THEN
      BEGIN
       delete(Stn,k,1);
       INSERT(St0,Stn,k);
      END;
     DEC(k);
    END;
 k:=length(Stn)-1;compt:=0;
  While k>0 do
    BEGIN
     IF Stnk='#' THEN
     BEGIN
     INC(compt);tkcompt:=k; 
     IF (compt=2) OR (compt=3) THEN
      BEGIN
       St0:=Copy(Stn,k+1,tkcompt-1-k-1);
       rk:=VALEUR(St0);
       rk:=rk-rx;
       Str(rk:4:2,St0);
       delete(Stn,k+1,tkcompt-1-k-1);
       INSERT(St0,Stn,k+1);
      END;
     END;
     DEC(k);
    END;

END;

Function Suis_je_descendant(fils,pere:INTEGER):BOOLEAN; BEGIN

 pg:=Nil;
 ptequa:=Nil;
 ptequa:=points^.at(pere);
 pg    :=points^.at(fils);
 Whilepg^.pt1<>-1DOBEGINfils:=fils-1;pg:=points^.at(fils); END;
 fils:=fils+1;{début de bloc +1}
 pg:=points^.at(fils);
 While (pg^.pt1<>pere) AND (pg^.pt2<>pere) AND (pg^.pt1<>-1)
                       AND (fils<points^.count-1) DO
 BEGIN fils:=fils+1; pg:=points^.at(fils); END;
 IF (pg^.pt1=-1) OR (fils=points^.count-1) THEN suis_je_descendant:=FALSE
        ELSE suis_je_descendant:=TRUE;

END;

procedure Met_objet_jaune(Num:INTEGER); BEGIN

pg:=Nil;pg:=points^.at(num);
 Whilepg^.pt1<>-1DOBEGINnum:=num-1;pg:=points^.at(num); END;
num:=num+1;pg:=Points^.at(Num);
 While (pg^.pt1<>-1) AND (num<points^.count) DO
   BEGIN
     pg:=points^.at(num);
     IF pg^.mark<100 THEN pg^.mark:=pg^.mark+100;
     IF Pg^.pos>=100 THEN Pg^.pos:=Pg^.pos-50;
     num:=num+1;
   END;

END;

function eclaire_blok(Num:INTEGER):BYTE; VAR N:INTEGER;

   combien:BYTE;

BEGIN

pg:=Nil;combien:=0;
 Met_objet_Jaune(Num); 
 FOR N:=num TO points^.count-1 DO
  BEGIN
    pg:=points^.at(N);
    IF (pg^.pt1>0)  THEN
      IF suis_je_descendant(N,Num) THEN BEGIN Met_objet_Jaune(N);INC(combien) END;
  END;
  eclaire_blok:=Combien;

END;

function eclaire_blok0:BOOLEAN; VAR N :INTEGER;

  pg0,pg1,pg2:PDpoint;<br>BEGIN<BR> eclaire_blok0:=FALSE;<BR> pg0:=Nil;pg1:=Nil;pg2:=Nil;
 FOR N:=7 TO points^.count-1 DO
  BEGIN
   pg0:=points^.at(N);
   IF )
                   AND (pg0^.pt1<>-1) AND (pg0^.mark<100) THEN
     BEGIN
      pg1:=points^.at(Round(pg0^.pt1));
      IF pg1^.mark>=100 THEN BEGIN Met_objet_jaune(N);Eclaire_Blok0:=TRUE END;
      pg1:=points^.at(Round(pg0^.pt2));
      IF pg1^.mark>=100 THEN BEGIN Met_objet_jaune(N);Eclaire_Blok0:=TRUE END;
     END;
  END;
  FOR N:=7 TO points^.count-1 DO {points liés aux objets jaunes}
      BEGIN
         pg0:=Points^.At(N);
    IF (pg0^.Gr=Point_M)  AND (pg0^.mark<100)
     THEN
              BEGIN
 pg1:=Points^.at(Round(pg0^.pt1)); {sur quelle droite est le point}
 IF pg1^.mark>=100 THEN BEGIN Met_objet_jaune(N);Eclaire_Blok0:=TRUE END;
 IF Pg0^.P=3 THEN  {ou sur quellessss droitesss}
                 BEGIN
     pg1:=Points^.at(Round(pg0^.pt2));
     IF pg1^.mark>=100 THEN BEGIN Met_objet_jaune(N);Eclaire_Blok0:=TRUE END;
   END;
      END;
     IF (pg0^.gr=Barycentre) AND (pg0^.mark<100) THEN
       BEGIN
  pg1:=points^.at(Round(pg0^.pt1));{premier vecteur du barycentre}
  pg2:=points^.at(Round(pg1^.pt1));
  IF pg2^.mark>=100 THEN BEGIN Met_objet_Jaune(N);Eclaire_Blok0:=TRUE END;  
  pg2:=points^.at(Round(pg1^.pt2));
  IF pg2^.mark>=100 THEN BEGIN Met_objet_Jaune(N);Eclaire_Blok0:=TRUE END;  
  pg2:=points^.at(Round(pg1^.pt3));
  IF pg2^.mark>=100 THEN BEGIN Met_objet_Jaune(N);Eclaire_Blok0:=TRUE END;
   pg1:=points^.at(Round(pg0^.pt2));{second vecteur du barycentre}
  pg2:=points^.at(Round(pg1^.pt1));
  IF pg2^.mark>=100 THEN BEGIN Met_objet_Jaune(N);Eclaire_Blok0:=TRUE END;  
  pg2:=points^.at(Round(pg1^.pt2));
  IF pg2^.mark>=100 THEN BEGIN Met_objet_Jaune(N);Eclaire_Blok0:=TRUE END;  
       END;
      END;

END;

function eclaire_bloc(Num:INTEGER):BOOLEAN; Var N:BYTE;

  VAR pg1,pg0:PDpoint;

BEGIN

 pg1:=Nil;pg0:=Nil;
  pg1:=points^.at(num);
  N:=eclaire_blok(num); {ressort avec 0 si un seul objet éclairé}
  While eclaire_blok0 DO INC(N);
  {si N=0 on a un seul objet éclairé et on peut donc détruire sans confirmation}
  IF N=0 THEN eclaire_bloc:=FALSE
         ELSE eclaire_bloc:=TRUE;

END; {procédure remodelée JL le 10/7/94} procedure Reqtangle(Dc:HDC;X1,Y1,X2,Y2,Gr,P,E:INTEGER;pt1:REAL); VAR Mp30:PDpoint;

   Old_option:BYTE;
   K,N:INTEGER;

BEGIN

old_option:=option_point;
IF lieu THEN option_point:=2; {modif JL 6/7/94 }
IF Imprime_TOUT THEN
 BEGIN
   K:=Raound(Rasto/2);
   IF (Gr=Point_M) THEN
    BEGIN
      Mp30:=Points^.at(Round(pt1));
      IF Mp30^.gr=Quadrill THEN option_point:=2
    END;
   IF (Option_point<>2)
     AND (((Gr>8) AND (Gr<21) OR (Gr=Point_X_Y) OR (gr=Inters) )
                OR ) OR (option_point=3))  THEN
    BEGIN
     lyne(DC,X1-2*k,ROUND((Y1+Y2)/2),X2+2*k,ROUND((Y1+Y2)/2),FALSE);
     lyne(DC,ROUND((X1+X2)/2),Y1-2*k,ROUND((X1+X2)/2),Y2+2*k,FALSE);
     Setpixel(DC,X1-2*k-1,ROUND((Y1+Y2)/2),BLANC);
     Setpixel(DC,X2+2*k+1,ROUND((Y1+Y2)/2),BLANC);
     Setpixel(DC,ROUND((x1+x2)/2),Y1-2*k-1,BLANC);
     Setpixel(DC,ROUND((x1+x2)/2),Y2+2*k+1,BLANC);
    END
   ELSE IF (Gr<>Point_M) OR (liberation) OR (option_point=2) THEN
    BEGIN
     N:=-k;
     While (X1+N)<(X2-N) DO
      BEGIN
 Rectangle(DC,X1+N,Y1+N,X2-N,Y2-N);
 INC(N);
      END;
    END
   ELSE Rektangle(DC,X1-k,Y1-k,X2+k,Y2+k);
  END
ELSE
BEGIN
 IF (Gr=Point_M) THEN
    BEGIN
      Mp30:=Points^.at(Round(pt1));
      IF (Mp30^.gr=Quadrill) and (option_point<>3) THEN option_point:=2
    END;
 IF (Efface) AND  THEN
          BEGIN
     Rektangle(DC,X1,Y1,X2,Y2);
     Rektangle(DC,X1+1,Y1+1,X2-1,Y2-1);
     Rektangle(DC,X1-1,Y1-1,X2+1,Y2+1);
     Rektangle(DC,X1-2,Y1-2,X2+2,Y2+2);
   END;
 IF (Option_point<>2)
     AND (((Gr>8) AND (Gr<21) OR (Gr=Point_X_Y) OR (gr=Inters) )
      OR ) OR (option_point=3))  THEN
   BEGIN
    lyne(DC,X1-2,ROUND((Y1+Y2)/2),X2+2,ROUND((Y1+Y2)/2),FALSE);
    lyne(DC,ROUND((X1+X2)/2),Y1-2,ROUND((X1+X2)/2),Y2+2,FALSE);
    Setpixel(DC,X1-3,ROUND((Y1+Y2)/2),BLANC);
    Setpixel(DC,X2+3,ROUND((Y1+Y2)/2),BLANC);
    Setpixel(DC,ROUND((x1+x2)/2),Y1-3,BLANC);
    Setpixel(DC,ROUND((x1+x2)/2),Y2+3,BLANC);
   END
 ELSE IF (Gr<>Point_M) OR (liberation) OR (option_point=2) THEN
   BEGIN
     IF (E=2) AND (NOT(Lieu)) AND (Gr<>Pinceau) THEN  Rectangle(DC,X1,Y1,X2,Y2);
     IF (NOT(lieu)) THEN Rectangle(DC,X1+1,Y1+1,X2,Y2);
     Rectangle(DC,X1+1,Y1+1,X2-1,Y2-1);
   END
 ELSE Rektangle(DC,X1-(E-1),Y1-(E-1),X2-(2-E),Y2-(2-E));
END;
option_point:=Old_option;
lieu:=FALSE

END; function Objet_lie(N:INTEGER):INTEGER; VAR I,Colle:INTEGER; BEGIN

  colle:=0;
  Mpt3:=Points^.At(N);  {objet à détruire}
  IF Mpt3^.gr<>Quadrill THEN
  BEGIN 
   While Mpt3^.pt1<>-1 DO                  {jusqu'au dernier}
    BEGIN
     IF (Mpt3^.pt3<>-2) THEN {n'examine que seg droite cercle}
       FOR I:=0 TO N-1 DO
         BEGIN
    Mpt4:=Points^.At(I);
       IF (Mpt4^.Gr=Point_M)  {point lié}
      AND 
    OR (Mpt4^.pt1=N))
         THEN Colle:=17;
  END;
     N:=N-1;             {et les autres}
     IF (Mpt3^.pos>=100) AND (Mpt3^.gr<>Mark_seg)
    AND (Mpt3^.gr<>Nul_Angle) AND (Mpt3^.Gr<>Aire)
                                                   AND (mpt3^.Gr<>AireQ) THEN colle:=77;
     Mpt3:=Points^.At(N);
    END;
  END ELSE Colle:=222;
  Objet_lie:=Colle;
{la fonction renvoie le code d'erreur ou zéro}

END; function corrige_quadri(VAR n:INTEGER;Force:BOOLEAN):BOOLEAN; VAR mp30: PDpoint;

   k:Integer;
   i:BYTE;

BEGIN Corrige_quadri:=FALSE; {etat_objet pour l'historique d'un objet}

IF (n<>-1) AND ( ( (NOT(enfonce)) AND )
                or (force))  THEN
  BEGIN
   Mp30:=Points^.at(n);
   IF (Mp30^.gr=segment) AND (Quadrisort_fonc(Mp30^.masse)) THEN
   BEGIN
    Corrige_quadri:=TRUE;
   k:=Sort_No(Mp30^.masse);n:=k;{se placer en haut : k}
    i:=0;
    Repeat
     k:=k+1;inc(i);
     Mp30:=points^.at(k);
    until (Mp30^.gr=segment) AND (quadrisort_fonc(Mp30^.masse));
   Q1:=i;i:=0;
    Repeat
     k:=k+1;inc(i);
     Mp30:=points^.at(k);
    until (Mp30^.gr=segment) AND quadrisort_fonc(Mp30^.masse);
   Q2:=Q1+i;i:=0;
    IF Triangsort_fonc(mp30^.masse) THEN Q3:=Q2
    ELSE
     BEGIN 
      Repeat
       k:=k+1;inc(i);
       Mp30:=points^.at(k);
      until (Mp30^.gr=segment) AND quadrisort_fonc(Mp30^.masse);
      Q3:=Q2+i;
     END;
   END;
   {le No du premier objet du quadri est contenu dans masse}
  END;

END; Procedure Vire_Bloc(DC:HDC); VAR un_objet:BOOLEAN; BEGIN

   IF mpt1^.E=888 THEN
    BEGIN
     dess_gomme(DC);
     mpt1^.draw(DC);
     detruire_ole(No);Recale_OLE(No);
     dess_norm(DC);
    END
   ELSE
   IF (No<>-1) AND (No>6) THEN
     BEGIN
  Un_objet:=NOT(Eclaire_bloc(No));
  courbe_modif:=TRUE;
  active_la(DC);
  TRaceTout(DC,FALSE);
  IF (Un_objet) OR (Supprime_Ton) THEN
    BEGIN
            Emplir_ete_trace(1);
     TRaceTout(DC,TRUE);
     Detruire_Bloc;
    Vno:=-1;Vni:=-1;
            {active_la ne doit pas repasser sur des objets qui n'existent plus Vno et Vni}
    END
  ELSE Enleve_Jaune(DC);
  TRaceTout(DC,FALSE);
  courbe_modif:=FALSE;
     END;
   No_collect:=points^.count;

END; procedure Change_Couleur(DC:HDC); VAR pg :PDpoint;

   N :INTEGER;
   Viel_Aff:BOOLEAN;

BEGIN

    IF No<>-1 THEN
         BEGIN
           N:=No;
           pg:=points^.at(N);
           IF N<7 THEN pg^.C:=Color {éléments du quadrillage}
                  ELSE
             BEGIN
               While (pg^.pt1<>-1) AND (N<points^.Count-1) DO
                                                   BEGINN:=N+1;pg:=points^.at(N) END;
                       {d'abord se placer sur le vector -1 du bloc suivant ou fin de coll}
               IF N<points^.count-1 THEN N:=N-1;{si non fin de coll remonter de 1}
               pg:=points^.at(N); 
               While (pg^.pt1<>-1) DO {c'est le pointeur de début de bloc}
               BEGIN {on change la couleur de tout le bloc}
                 Pg^.C:=Color;
                 N:=N-1;
                 Pg:=points^.at(N);
               END;
             END;
       Viel_Aff:=Courbe_modif;Courbe_modif:=TRUE;
 En_jaune:=TRUE;{permet de remémoriser les anciennes pos}
        Mpt1^.Draw(DC);En_jaune:=FALSE;
Dessin_change:=TRUE;Courbe_modif:=Viel_Aff;
        TraceTout(DC,FALSE);
END;
    On_Arete:=TRUE;
    BoutonDown:=FALSE;

END;

procedure FaisBarre; var

 MemDC,DC: HDC;

begin

   Dc:=GEtDC(WindO);
   MemDC := CreateCompatibleDC(DC);
   SelectObject(MemDC,Barre4);
   BitBlt(DC,1 ,1,219,42, MemDC, 0, 0,SrcCopy);
   ReleaseDC(WindO,DC);
   DeleteDC(MemDC);
   comptor:=0;

end;

procedure on_inverse(Rect:Trect); VAR DC: HDC; BEGIN

  DC:=GetDC(WindO);
  InvertREct(DC,Rect);
  ReleaseDC(WindO,DC);

END;

procedure active_donc(Xi:INTEGER); VAr Rect : Trect;

    {DC:HDC;}

BEGIN {quelle case de la barre magneto active-t-on ?}

 Rect.top:=2;Rect.bottom:=2+40;
  IF magneto=3 THEN magneto:=1; {pour désactiver la bonne case}
  Rect.left:=(magneto-1)*52+10 ;Rect.right:=Rect.left+42;
  IF (magneto<>0) THEN On_inverse(rect);
  IF (xi<52) AND (Xi>10) THEN BEGIN Rect.Left:=10; Magneto:=1; END;
  IF (xi<104) AND(Xi>62)THENBEGINRect.Left:=62;Magneto:=2 END;
  IF (xi<156) AND(Xi>114)THENBEGINRect.Left:=10;Magneto:=3;faisbarre END;
  IF (xi<208) AND (Xi>166) THEN  magneto:=4;
  Rect.right:=Rect.left+42;
  KillTimer(WindA,0);
  On_inverse(Rect);
  IF magneto=1 THEN setTimer(WindA,0,10,nil);
  IF magneto=2 THEN killTimer(WindA,0);
  IF magneto=3 THEN BEGIN setTimer(WindA,0,10,nil);comptor:=0 END;
  IF magneto=4 THEN setTimer(WindA,0,10,nil);

END;

procedure deplace_sur_objet(Nm:String;X,Y:INTEGER); VAR n:INTEGER;

  St:STRING;

BEGIN

for n:=0 TO points^.count-1 DO
 BEGIN
  ptequa:=points^.at(n);
  st:=ptequa^.nm;
  vire_mu(st);
  vide_blanc(st);
  IF (ptequa^.pt3=-2) AND (ptequa^.gr=point_M) AND (pos(Nm,st)>0) THEN
    BEGIN
     ptequa^.pt2:=ptequa^.pt2+Y/100;
    END;
 END;

END;

procedure deplace(Nm:String;X,Y:INTEGER); VAR n:INTEGER;

  St:STRING;

BEGIN

for n:=0 TO points^.count-1 DO
 BEGIN
  ptequa:=points^.at(n);
  st:=ptequa^.nm;
  vire_mu(st);
  vide_blanc(st);
  IF (ptequa^.pt3=-2) AND (pos(Nm,st)>0) AND (Length(St)=Length(Nm)) THEN
    BEGIN
     ptequa^.pt1:=ptequa^.pt1+X;
     ptequa^.pt2:=ptequa^.pt2+Y;
    END;
 END;

END; procedure deplaceTexte(st:String;X,Y:INTEGER); VAR n,k,x1:INTEGER; BEGIN {on veut déplacer le x1ième texte de x et Y}

Val(St,x1,k); {récupérons dabord dans x1 le numéro d'ordre du texte à déplacer}
k:=0;
for n:=7 TO points^.count-1 DO
 BEGIN
  ptequa:=points^.at(n);
  st:=ptequa^.nm;
  IF (pos(St,'~@|')>0) THEN inc(k);
  IF (x1-1)*2+1=k THEN {on est sur le x1ième texte de la figure et on déplace}
    BEGIN
     ptequa^.pt1:=ptequa^.pt1+X;
     ptequa^.pt2:=ptequa^.pt2+Y;
    END;
 END;

END;

procedure valeurs(St:String;VAR X,Y:INTEGER); VAR n,err:INTEGER;

   Sto:STRING;

BEGIN

n:=pos(',',St);
sto:=copy(St,1,n-1);
IF n=0 THEN X:=mil ELSE Val(Sto,X,err);
sto:=copy(St,n+1,length(St)-n);
Val(Sto,Y,err);

END;

function fonction(VAR st:string;VAR X,Y:INTEGER):BYTE; VAR err:WORD;

   Sti:String;

BEGIN

X:=0;
fonction:=0; {si reste à 0 alors erreur de syntaxe}
if pos('*',St)>0 THEN {c'est une ligne pour la barre de titre}
  BEGIN delete(St,pos('*',st),1);fonction:=6;exit END;
vide_blanc(St);
majuscules(St);
if pos('CHARGER',St)>0 THEN
  BEGIN delete(St,1,7);StrPcopy(filename,st);fonction:=1 END;
if pos('FENETRE',St)>0 THEN fonction:=111; {inutile mais ne provoque pas d'avert}
if pos('SECONDES',St)>0 THEN
  BEGIN delete(St,1,8);VAL(St,X,err);fonction:=2 END;
if pos('PRECISION',St)>0 THEN
  BEGIN delete(St,1,9);VAL(St,X,err);fonction:=12 END;
if pos('PAUSE',St)>0 THEN
  BEGIN delete(St,1,5);fonction:=7 END;
if pos('TRACEACTIVE',St)>0 THEN fonction:=9;
if pos('TRACENONACTIVE',St)>0 THEN fonction:=10;
if pos('AVECLETTRE',St)>0 THEN fonction:=13;
if pos('SANSLETTRE',St)>0 THEN fonction:=14;
if (pos('RAFFRAICHI',St)>0) OR (pos('RAFRAICHI',St)>0) THEN fonction:=18;
if (pos('NETTOYER',St)>0) OR (pos('NETOYER',St)>0) THEN fonction:=19;
if pos('TRANSPARENT',St)>0 THEN fonction:=15;
if pos('OPAQUE',St)>0  THEN fonction:=16;
if pos('COULEUR',St)>0 THEN
  BEGIN
  delete(st,1,7);Sti:=St;fonction:=11;
  END; {fin de touche}
if pos('TOUCHE',St)>0 THEN
  BEGIN
   delete(st,1,6);
   IF st='F2' THEN fonction:=3;
   IF st='F3' THEN fonction:=4;
  END; {fin de touche}
if pos('REPETER',St)>0 THEN
  BEGIN
   memo_comptor:=comptor;   {mémorisons la position pour faire remonter le pointeur...}
   Delete(St,1,7);
   VAL(st,n_fois,err);
   fonction:=111; {éviter le message avert}
  END;
if pos('FIN',St)>0 THEN     {...dès que l'on rencontre le mot fin}
  BEGIN
   DEC(n_fois);
   IF n_fois>=0 THEN comptor:=memo_comptor;
   fonction:=111; {éviter le message avert}
  END;
if pos('DEPLACER',st)>0 THEN
  BEGIN
  if pos('DEPLACERTEXTE',St)>0 THEN
    BEGIN
     delete(St,1,13);
     sti:='';
     {récupérons dabord le numéro de texte dans sti} 
     While (pos(':',St)<>1) AND (St<>'') DO BEGIN Sti:=Sti+St1;Delete(St,1,1) END;
     Delete(St,1,1); {et virons le point-virgule}
     VALEURS(St,X,Y); {pour récupérer le déplacement}
     IF st='' THEN fonction:=0 {une erreur il manque les : }
              ELSE fonction:=17;
    END
  else
    BEGIN
     delete(St,1,8);
     Sti:=St1;
     delete(St,1,1);
     VALEURS(St,X,Y);
     IF X=mil THEN fonction:=8 {on se déplace sur un objet}
              ELSE fonction:=5;
    END;
  END;
 St:=Sti;

END;

function la_couleur(St:STRING):TcolorRef; BEGIN

IF St='ROUGE' THEN   la_couleur:=ROUGE;
IF St='BLEU'  THEN   la_couleur:=BLEU;
IF St='VERT'  THEN   la_couleur:=VERT;
IF St='VIOLET'THEN   la_couleur:=VIOLET;
IF St='GRIS'  THEN   la_couleur:=GRIS;
IF St='NOIR'  THEN   la_couleur:=NOIR;

END;

procedure THwindow.Horloge(Var Msg:Tmessage); VAR n :INTEGER;

  X,Y:INTEGER;
  DC:HDC;
  St:STRING;
  Name: array0..212 of Char;
  Txt : ChaineC;

BEGIN {suivant les événements cet procédure est branchée à l'aide de setTimer}

IF magneto=4 THEN BEGIN killTimer(WindA,0);Done;exit END;
{KillTimer(WindA,0);}  {vire les timer de la pile}
IF comptor<textes_ciel^.count then setTimer(WindA,0,1,nil); {on rebranche}
{total détermine le nombre de passage et vient le la procédure quelle_longueur}
 IF comptor<textes_ciel^.count THEN
 BEGIN 
  DC:=GetDC(WindA);
 ptequa:=textes_ciel^.at(comptor);St:=ptequa^.nm;
  case fonction(St,X,Y) of
   0: BEGIN {erreur de syntaxe}
         INC(comptor);{permet de tomber sur le bon numéro de ligne}
         Str(comptor,St);St:=' à la ligne '+St;
         StrPcopy(Txt,'ERREUR DE SYNTAXE'+#13#10+St);
         ReleaseDC(WindA,DC);
         {ReleaseCapture;}
         killTimer(WindA,0);
         My_messageBox(Txt,1);
         {MessageBox(Hwindow,name,
         'ERREUR DE SYNTAXE', mb_OK or mb_Iconquestion);}
         comptor:=Textes_ciel^.count;
         done;
         exit;
      END;
   1: BEGIN
        {invalidateRect(WindA,Nil,TRUE);
        updateWindow(WindA);}
        SendMessage(WindA,Wm_first+Wm_EraseBkgnd,DC,0);
        killTimer(WindA,0); {indispensable en cas de plantage au chargment}
        IF PG_wind^.loadFile THEN
          BEGIN
           avec_lettre:=flag_lettres;
           Trace_Une_Fois(DC);{car tracetout n'itialise pas les V_x la première fois}
           {faisOrdre(DC,FALSE);}
           setTimer(WindA,0,2,nil);
          END;
      END;
   2: SetTimer(windA,0,X*100,nil);
   3: montre_le_suivant(DC);
   4: cache_le_suivant(DC);
  17: BEGIN
       DeplaceTexte(st,X,Y);
       faisordre(DC,FALSE); {permet d'effacer les objets déplacés}
       IF NOT(flag_Xor) THEN traceTout(DC,FALSE); {et de les retracer}
      END;
   5: BEGIN
       Deplace(St,X,Y);
       faisordre(DC,FALSE); {permet d'effacer les objets déplacés}
       IF NOT(flag_Xor) THEN traceTout(DC,FALSE); {et de les retracer}
      END;
   8: BEGIN {on est sur un objet}
       Deplace_sur_objet(St,X,Y);
       faisordre(DC,FALSE); {permet d'effacer les objets déplacés}
       IF NOT(flag_Xor) THEN traceTout(DC,FALSE); {et de les retracer}
      END;
    6:BEGIN {barre de titre}
       StrPcopy(Name,St);
       setcaption(Name);
      END;
    7: Active_donc(70); {se met en pause}
    18: TraceTout(DC,FALSE); {raffraichir}
    19: BEGIN {Nettoyer}
         SendMessage(WindA,Wm_first+Wm_EraseBkgnd,DC,0);
         emplir_ete_trace(1);
         tracetout(DC,TRUE);
         emplir_ete_trace(1);
         TraceTout(DC,FALSE);
         TracePoint(DC,FALSE);
        END;
    9: BEGIN
         Trace_Active:=TRUE;
         Je_bouge:=TRUE;
         deplace_xor:=TRUE;
       END;
    10:BEGIN
        Trace_Active:=FALSE;
        Je_bouge:=flag_bouge;
        deplace_xor:=flag_deplace;
       END;
    11:Color:=la_couleur(St);
    12: IF (X>0) AND (X<4) THEN mesure_precis:=X;
    13: flag_lettres:=TRUE;
    14: flag_lettres:=FALSE;
    15: flag_XOR:=TRUE;
    16: flag_XOR:=FALSE;
  END; {of case}
  ReleaseDC(WindA,DC);
 END {fin de if compteur<textes_ciel^.count}
 ELSE BEGIN faisbarre;KillTimer(WindA,0);magneto:=0; END; {désactive la lecture}
 
 inc(comptor);

END;

procedure TOWindow.WMLButtonDown(var Msg: TMessage); VAR Xi,Yi: INTEGER;

       {DC:HDC;}
       point:Tpoint;

begin

{DC:=GetDC(Hwindow);}
Xi:=RAOUND(Msg.LparamLO);point.X:=Xi;
Yi:=RAOUND(Msg.LparamHI);point.Y:=Yi;
ClientToScreen(Hwindow,Point);
IF (WindowFromPoint(Point)=HWindow) THEN active_donc(xi);
{ReleaseDC(Hwindow,DC);}

end;

Procedure THWindow.ToucheUp(VAR Msg:Tmessage); {VAR DC:HDC;} begin

  {DC:=GetDC(Hwindow);}
     if Msg.WParam = vk_F1 then active_donc(20);
     if Msg.WParam = vk_F2 then active_donc(70);
     if Msg.WParam = vk_F3 then active_donc(120);
     if Msg.WParam = vk_F4 then active_donc(170);
     DefWndProc(Msg);
  {releaseDC(Hwindow,DC);}

END;

constructor TOWindow.Init(AParent: PWindowsObject; ATitle: PChar;X0,Y0:INTEGER);

BEGIN
 {Par:=Aparent;}
 TWindow.Init(Aparent,Atitle);
 Attr.X:=Round(Xoutil+1);
 Attr.Y:=Round(Youtil);
 Attr.W:=Round(219);
 Attr.H:=Round(41);
 Attr.Style := Ws_visible or Ws_popup;
 magneto:=0;

end;

DEstructor TOwindow.Done; BEGIN

 Tobject.Done;
 TWindow.Done;

END;

{procedure TOWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); BEGIN

  faisBarre;

END;}

constructor THWindow.Init(AParent: PWindowsObject; ATitle: PChar;X0,Y0:INTEGER); VAR St:STRING;

   Sx,Sy:INTEGER;
BEGIN
 Sx:=GetSystemMetrics(Sm_CXScreen);{largeur de l'écran }
 Sy:=GetSystemMetrics(Sm_CYScreen);{hauteur de l'écran }
 V_par:=Par; 
 Par:=Aparent;
 TWindow.Init(Aparent,Atitle);
 Ptequa:=textes_ciel^.at(0);
 St:=Ptequa^.Nm;
 Majuscules(St);
 Vide_blanc(St);
 if pos('FENETRE',St)=1 THEN
  BEGIN {recalcule les coordonnées fenêtre}
    delete(St,1,7);
    valeurs(St,X0,Y0);
    Xoutil:=Round((Sx-X0)/2);{centrer dans l'écran en X}
    Youtil:=Round((Sy-Y0)/2);{ et en Y}
  END
ELSEBEGINXoutil:=0;Youtil:=0; END;{ou fenêtre maxi_écran}
 Attr.X:=Xoutil; {Xo et yo sont utilisées pour caler le magnéto en haut à gauche de l'écran}
 Attr.Y:=Youtil;
 Attr.W:=Round(X0);
 Attr.H:=Round(Y0);
 Attr.Style := Ws_caption or Ws_Visible or Ws_Border;
 IF Xoutil=0 THEN Attr.Style:=Attr.Style or Ws_maximize;
 Youtil:=Youtil+Round(Y0)-41;

end;

procedure THWindow.SetUpWindow; VAR Gwnd :Pwindow; BEGIN

Twindow.SetUpWindow;
premier:=TRUE;
WindA:=Hwindow;
Old_wind:=Wind;
Wind:=WindA;
flag_trace:=Trace_Active;
flag_bouge:=Je_bouge;
flag_deplace:=Deplace_Xor;
flag_lettres:=FALSE;
flag_Xor:=FALSE;
Strcopy(FileScript,Filename); {pour restituer l'ancien}
   GetWindowsDirectory(FileNameCiel,79);
  {on sauvegarde la figure actuelle avant de récupérer le fichier }
   StrCat(FileNameciel,'\geom.sav');
   StrCopy(Filename,FilenameCiel);
  PG_wind^.saveFile;
  PG_wind^.faisName(FileScript); {récupère le nom de fichier actif}
  GWnd := New(POWindow, Init(@Self,'',0,0));
  Application^.MakeWindow(GWnd);
{Dans_cadre:=FALSE;}
  faisBarre;
  SetFocus(Hwindow);

END;

procedure TOWindow.SetUpWindow; BEGIN

  Twindow.SetUpWindow;
  Windo:=Hwindow;
  setCapture(Hwindow);

END;

procedure Recharger; BEGIN

 SendMessage(Wind,Wm_first+Wm_paint,0,0); {juste pour redessiner la fenêtre de Wind}
 on_scripte:=FALSE;
 StrCopy(Filename,Filenameciel);{récupère le fichier actif}
 PG_wind^.loadFile;
 FilenameCiel0:=#0;
 StrCopy(Filename,Filescript);{récupère le fichier actif}
 PG_wind^.faisName(Filename); {récupère le nom de fichier actif}

END;

DEstructor THwindow.Done; BEGIN

 par:=V_par;
 IF GetCapture=WindO THEN releaseCapture;
 KillTimer(windA,0);
 Tobject.Done;
 TWindow.Done;
 WindA:=0;
 Wind:=Old_Wind;
 Trace_Active:=flag_trace;
 Je_bouge:=flag_bouge;
 Deplace_Xor:=flag_deplace;
 Dispose(Textes_ciel,done);
 recharger;
 {remet_points;}

END;

procedure faire_le_script; VAR stchar:array0..212 of Char;

   st : String;
   GWnd: PWindow;
BEGIN
 Ptequa:=textes_ciel^.at(0);
 St:=Ptequa^.Nm;Majuscules(St);
 IF pos('FENETRE',St)>0 THEN comptor:=1
                        ELSE comptor:=0;
 ptequa:=textes_ciel^.at(comptor);
 st:=Ptequa^.Nm;                        
 if pos('*',St)>0 THEN delete(St,1,1) ELSE St:='IMAGICIEL';
 StrPcopy(StChar,St);
 GWnd := New(PHWindow, Init(Nil,Stchar,0,0));
 Application^.MakeWindow(GWnd);
END;

function Collage(X,Y:INTEGER):BOOLEAN; BEGIN

coller_ole(X-scroll_X,Y-Scroll_Y);
collage:=TRUE;

end;

function Est_ce_Image(DC:HDC;n,c,Teta,fonc,mk:INTEGER):INTEGER; VAR j:INTEGER; BEGIN

J:=Image_De(n,c,Teta,fonc);
IF j=-1 THEN BEGIN Trace_Sauve_Pt(DC,n,c,Teta,Epaiss,fonc,color,0,mk);
                   Est_ce_IMAGE:=points^.count-1; END
  ELSE Est_ce_Image:=j;

END;

Function Fais_Delta_Bissect(N,Xo,Yo,Xoo,Yoo:INTEGER):INTEGER; VAR K0,K1,L0,L1,X,Y :REAL;

   Mpt30 : PDpoint;

BEGIN {plus facile d'enregistrer 2 et 0 que 1 et -1}

 Mpt30:=Points^.At(N);
 X:=Mpt30^.X;
 Y:=Mpt30^.Y;
 IF (Xo-X)>0  THEN K0:=2
   ELSE K0:=0;
 IF (Yo-Y)>0  THEN K1:=2
                 ELSE K1:=0;
 IF (Xoo-X)>0 THEN L0:=2
   ELSE L0:=0;
 IF (Yoo-Y)>0 THEN L1:=2
   ELSE L1:=0;
 Fais_Delta_Bissect:=RAOUND(k0*1000+K1*100+L0*10+L1);

END;

procedure Sauve_Figure(P1,P2,P3,Teta,G,Mk:INTEGER;Mass:REAL); VAR St : STRING2;

   fn,No,Pt_till : INTEGER;
   N     : LongInt;

BEGIN

 pt_till:=pointill;
 IF Def_TExte THEN
  BEGIN
    St:='TA';
    Textes^.Insert(New(PDtexte,Init(TexteA,0)));
    P3:=Textes^.count-1;
                  {sortie_menu=0 ou 2 récupéré dans editor dans V_courbes}
                  pt_till:=sortie_menu;
  END
       ELSE IF (Def_rect) THEN St:='RE' ELSE St:='FI';
 IF (Fonc=Rectang)   AND (G=Droite) THEN St:='NO';{pour cacher la droite support du rectangle}
 IF (Fonc=TriangleR) AND (G=Droite) THEN St:='NO';{pour cacher la droite support du rectangle}
 IF (Fonc=losange)   AND (G=Cercle) THEN St:='NO';{pour cacher le cercle support du losange}
 IF (Fonc=TriangleI) AND (G=Cercle) THEN St:='NO';{pour cacher le cercle support du losange}
 fig.init(P1,P2,P3,Teta,Epaiss,pt_till,color,St,0,G,Mk,Mass);
 Points^.Insert(New(PDFigures,Init(P1,P2,P3,Teta,epaiss,pt_till,color,St,0,G,Mk,Mass)));
 No_Collect:=Points^.count;

END;

procedure Sauve_Vector(P1,P2,Teta,G:INTEGER;Mass:REAL;Epaisseur:INTEGER); VAR R4:INTEGER; BEGIN

 {Epaisseur sert à pointer sur l'objet antécédent dans une transformation}
 IF Fonc=Sym_Axiale THEN Mass:=-Mass;
 IF G=Mark_angle THEN R4:=R0 ELSE R4:=0;
 Vect.init(P1,P2,R4,Teta,Epaisseur,pointill,color,'N1',0,G,0,Mass);
 Points^.Insert(New(PDVector ,
     Init(P1,P2,R4,Teta,epaisseur,pointill,color,'N1',0,G,0,Mass)));
 No_Collect:=Points^.count;

END;

function Segment_Marque:INTEGER;

VAR N,Num: INTEGER;
    Mpt:PDpoint;
    Sortie:BOOLEAN;

{pour vecteur et cercle de rayon ou norme constante} BEGIN

 Num:=0;
 mpt:=Nil;
 FOR N:=0 TO points^.count-1 DO
  BEGIN
   Sortie:=FALSE;
   Mpt:=Points^.At(N);
   IF (Mpt^.mark=1) AND (Mpt^.Gr=Vecteur) THEN Sortie:=TRUE;
   IF (Mpt^.mark=1) AND (Mpt^.Gr=Segment) AND (fonc=cercle) THEN Sortie:=TRUE;
   IF (Sortie) THEN IF (Num>0) THEN Num:=Points^.count
                               ELSE Num:=N;
  END;
 IF Num=0 THEN Num:=Points^.count;
 Segment_Marque:=Num;
 {Si on sort avec points^.count -> on n'a rien trouvé }

end;

function nombre_dobjets:INTEGER; VAR n,compteur: INTEGER;

   Mp:PDpoint;

BEGIN

compteur:=0;
For n:=7 TO points^.count-1 DO
  BEGIN
   Mp:=Points^.at(n);
   IF mp^.pt1=-1 THEN INC(Compteur)
  END;
nombre_dobjets:=Compteur;

END;

Function Fais_Nom_plan:Nom; VAR Mp : PDpoint;

   n,i:INTEGER;
   St: String3;

BEGIN

  n:=1;
  For i:=1 TO points^.count-1 DO
    BEGIN
     Mp:=points^.at(i);
     IF Mp^.gr=pinceau THEN n:=n+1;
    END; {combien de demi_plans ? }
  Str(n,St);
  Fais_nom_plan:='µ(P'+St+')';

END;

Function Fais_Nom(N:INTEGER):Nom; VAR Ch:CHAR;

   Mpt:PDpoint;
   Erreur: BOOLEAN;
   I,J:INTEGER;
 Procedure Suivant;
  BEGIN
   IF nm01='µ' THEN Ch:=nm03 ELSE Ch:=nm02;
   IF ORD(Ch)<121 THEN Ch:=CHR(Ord(Ch)+1) ELSE Ch:='+';
   IF Ch=':' THEN Ch:='a';
   IF Ch='#' THEN Ch:='0';
   IF Ch='(' THEN Ch:='"';
   IF Ch='!' THEN Ch:=;
   IF Nm01='µ' THEN Nm0:=Nm01+Nm02+Ch
                 ELSE Nm0:=Nm01+Ch;
 END;
 function Caract_Table(N:INTEGER):CHAR;
 VAR Nn:INTEGER;
 BEGIN
     Erreur:=FALSE;
     Nn:=N +64;
     IF Nn>90 THEN Nn:=Nn+6;
     IF Nn>122 THEN Erreur:=TRUE;
     IF erreur THEN Caract_Table:='*'
 ELSE Caract_Table:=CHr(Nn);
 END;
 function Existe_T_il(P:PDgraph):BOOLEAN; far;
  BEGIN
   IF Nm01='µ' THEN j:=2 ELSE j:=1;
   IF P^.nM1='µ' THEN i:=2 ELSE i:=1;
   IF (P^.nMi=Nm0j)
      AND (P^.nMi+1=Nm0j+1) THEN Existe_t_il:=TRUE
    ELSE Existe_t_il:=FALSE;
  END;

BEGIN

IF TransForm Fonc THEN
 BEGIN
   Mpt:=Points^.At(N);
   nm0:=Mpt^.Nm;
  IF nm0<>'' THEN {vide pour pt virtuel mediat ou bissect}
  REPEAT
   Suivant;
   Pg:=Points^.FirstThat(@Existe_T_il);
  UNTIL (Pg=Nil) OR (Nm02='+');
   Mpt:=Nil;
 END
ELSE
BEGIN
 Compt_Nom:=0;
 REPEAT
  Inc(Compt_Nom);
  nm0:=Caract_Table(Compt_Nom)+' ';
  Pg:=Points^.FirstThat(@Existe_t_il);
 UNTIL (Pg=Nil) OR (Erreur);
END;
  IF (avec_lettre) AND (Nm01<>'µ') THEN Nm0:='µ'+Nm0;
  IF Ch_clav='~' THEN Fais_Nom:=nm0
   ELSE BEGIN Fais_Nom:='µ'+Ch_clav+' ';Ch_clav:='~' END;

END;

procedure Trace_Sauve_Pt(DC:HDC;x,y:REAL;Teta,E,Fnc:INTEGER;C:TcolorRef;Mark,Mk:INTEGER); VAR pose:INTEGER;

   Nvect:INTEGER;
   Masse,Masse0:REal;

BEGIN

 pose:=12;pg:=Nil;
  dessin_change:=true;
  IF fonc<>Pinceau THEN nm0:=Fais_Nom(ROUND(x))
                   ELSE nm0:=Fais_Nom_plan;
  IF (fnc=mark_seg) THEN {Mzg permet de ne pas afficher le nom du point}
        BEGIN
        Teta:=Long_Seg;pose:=12;
         If NOT(Avec_degres) THEN Teta:=-Teta;
         Mark:=Pointill;
         nm0:='Mzg';
        END;
  IF fnc=Point_X_Y THEN nm0:=nm0+'£'+chf1;
  IF (fnc=aire) OR (fonc= aireQ)THENBEGINpose:=12;nm0:='Mzg';END;
  IF Def_Texte THEN
 IF (BoutonDown) THEN BEGIN nm0:='~@|'; END
   ELSE BEGIN nm0:='~@';  END;
  IF (fonc= Bissectrice)THENBEGINnm0:='';Fnc:=Point_M END;
  IF (fonc=Mediatrice)  OR (Def_Rect) THEN nm0:='';
  IF (fonc= Pinceau) AND(BoutonDown)THENBEGINnm0:='';Mark:=Pointill END;
  IF (Fnc=primitive) THEN nm0:=Xprimit;
  IF (avec_masse) OR (E=888) THEN masse0:=1 ELSE masse0:=2001;
 {nom='' permet de fabriquer un point non visible}
   Pt.init(x,y,-2,Teta,E,Mark,C,nm0,pose,fnc,Mk,masse0);
   Points^.Insert(New(PDpoint, Init(x,y,-2,Teta,E,Mark,C,nm0,pose,fnc,Mk,masse0)));
  {toutes les masses par defaut seront à 2000}
  Pt.DRAW(DC);
  {un vecteur ou un cercle de norme donnée}
  IF  AND (BoutonDown) THEN
    BEGIN
      Nvect:=segment_marque;
      IF Nvect<points^.count THEN
BEGIN
 {on fabrique un point translaté avec le vecteur Nvect}
        IF fonc=cercle THEN masse:=ratio ELSE masse:=1;
 nm0:=Fais_Nom(Points^.count-1);
 Points^.Insert(New(PDpoint,
      Init(Points^.count-1,Nvect,-2,Teta,E,Mark,C,nm0,pose,translat,Mk,2001)));
 pg:=Points^.at(points^.count-1);Pg^.DRAW(DC);
 Pg:=Points^.at(Nvect);{points sur objet marqué pour récupérer son vect dans pt2}
 Sauve_Figure(points^.count-2,ROUND(Pg^.pt2),points^.count-1,0,fonc,0,masse);
 On_Arete:=TRUE;
END;
    END;
    No_Collect:=Points^.count;

END;

function passe_par_le_point(k:INTEGER;VAR ni:INTEGER):BOOLEAN; VAR n,Xo_V,Yo_V,V_Ni:INTEGER;

   Mpt7,Mpt8:Pdpoint;

BEGIN

Xo_V:=Xo;Yo_V:=Yo;V_Ni:=ni;
Mpt8:=points^.at(k); {pointe sur la parallèle que l'on vient de faire}
For n:=7 TO points^.count-1 DO
 BEGIN
   Mpt7:=points^.at(n);
   IF (Mpt7^.pt3=-2) THEN {ne passe en revue que les points}
    BEGIN
    Xo:=ROUND(MPt7^.X);Yo:=ROUND(Mpt7^.Y); {Xo et Yo pour la méthode est_ce_moi}
     IF (mpt7^.pos<100) AND (Mpt8^.est_ce_moi(0)) AND (n<>V_ni) THEN ni:=n;
    END;
 END;
 IF ni<>V_ni THEN passe_par_le_point:=TRUE ELSE passe_par_le_point:=FALSE;
Xo:=Xo_V;Yo:=Yo_V;

END;

function Cherche_pt_commun(No,Ni:INTEGER;DC:HDC):INTEGER; VAR N:REAL; BEGIN {utile pour la bissectrice}

 Mpt2:=Points^.At(Ni);
 Mpt3:=Points^.At(No);
 N:=-1;
 IF No<>Ni THEN
 BEGIN
  IF (Mpt2^.pt1=Mpt3^.pt1) OR (Mpt2^.pt1=Mpt3^.pt3) THEN N:=Mpt2^.pt1;
  IF (Mpt2^.pt3=Mpt3^.pt1) OR (Mpt2^.pt3=Mpt3^.pt3) THEN N:=Mpt2^.pt3;
  IF (N=-1) OR (N=0) THEN
   BEGIN
    {on cherche si l'intersection existe}
    Pt.init(No,Ni,-2,0,Epaiss,3,Color,'',12,Point_M,0,2001);
    IF Pt.X=Mil THEN N:=-1 {elle n'existe pas}
    ELSE
     BEGIN
      {fabrique un point d'intersection fictif}
      Trace_Sauve_Pt(DC,No,Ni,0,Epaiss,fonc,Color,3,0);
      N:=Points^.count-1;
    END;
   END;
 END;
 Cherche_pt_commun:=ROUND(N);

END;

function Aumoins_Unlieu(VAR Depuis:INTEGER):BOOLEAN;

function OnTrouve0(P: PDgraph):BOOLEAN; far;
   BEGIN
     OnTrouve0:=FALSE;
     IF (P^.Gr=LIEU_POINT) THEN OnTrouve0:=TRUE
   END;

BEGIN

While (Depuis<points^.count) AND NOT (Ontrouve0(points^.at(Depuis))) do inc(Depuis);
IF Depuis<points^.count THEN Mpt4:=points^.at(Depuis) ELSE Mpt4:=Nil;
IF Mpt4=Nil THEN Aumoins_Unlieu:=FALSE ELSE Aumoins_Unlieu:=TRUE;
inc(Depuis);

END;

function trois_equi(X,Y,Z,A,B,C:INTEGER):BOOLEAN; BEGIN

IF  OR 
 or OR 
 or OR  THEN trois_equi:=TRUE
                                                              ELSE trois_equi:=FALSE;

END; function Cherche_Aire(Index:REAL):BOOLEAN;

function OnTrouve0(P: PDgraph):BOOLEAN; far;
   BEGIN
     OnTrouve0:=FALSE;
     IF (P^.Gr=AIRE) AND (P^.pt1=Index) THEN OnTrouve0:=TRUE
   END;

BEGIN

Mpt4:=Points^.FirstThat(@Ontrouve0);
IF Mpt4<>Nil THEN Cherche_Aire:=TRUE ELSE Cherche_Aire:=FALSE;

END;

function quatre_equi(X,Y,Z,T,A,B,C,D:INTEGER):BOOLEAN; BEGIN

IF  AND
    AND
    AND
     THEN quatre_equi:=TRUE
                                       ELSE quatre_equi:=FALSE;

END;

function Cherche_AireQ(No,Ni:INTEGER):BOOLEAN; VAR A,B,C,D:INTEGER;

function OnTrouve1(P: PDgraph):BOOLEAN; far;
   BEGIN
     OnTrouve1:=FALSE;
     IF (P^.gr=AIREQ) THEN
      BEGIN
          ptequa:=points^.at(Round(P^.pt1)); {un côté}
          pg:=points^.at(Round(P^.pt2));     {et l'autre}
        IF quatre_equi(Round(Ptequa^.pt1),Round(Ptequa^.pt3),ROUND(Pg^.pt1),Round(Pg^.pt3),A,B,C,D)
                                             THEN OnTrouve1:=TRUE;
      END;
   END;

BEGIN

ptequa:=points^.at(Ni); {un côté}
pg:=points^.at(No); {et l'autre}
A:=ROUND(ptequa^.pt1);B:=ROUND(ptequa^.pt3);    {et les bouts}
C:=ROUND(pg^.pt1);    D:=ROUND(pg^.pt3);    {et les bouts}
Mpt4:=Points^.FirstThat(@Ontrouve1);
IF Mpt4<>Nil THEN Cherche_AireQ:=TRUE ELSE Cherche_AireQ:=FALSE;

END;

function Cherche_AireT(No,Ni:INTEGER):BOOLEAN; VAR A,B,C:INTEGER;

function OnTrouve1(P: PDgraph):BOOLEAN; far;
   BEGIN
     OnTrouve1:=FALSE;
     IF (P^.gr=AIRE) THEN
      BEGIN
          ptequa:=points^.at(Round(P^.pt2)); {la base}
          {ptequa:=points^.at(Round(Ptequa^.pt2));}
        IF Trois_equi(Round(Ptequa^.pt1),Round(Ptequa^.pt3),ROUND(P^.pt1),A,B,C)
                                             THEN OnTrouve1:=TRUE;
      END;
   END;

BEGIN

ptequa:=points^.at(Ni); {Ni pointe sur la  base et No sur le sommet}
{ptequa:=points^.at(Round(Ptequa^.pt2)); vecteur de la base}
B:=ROUND(ptequa^.pt1);C:=ROUND(ptequa^.pt3);A:=No;    {et les bouts}
Mpt4:=Points^.FirstThat(@Ontrouve1);
IF Mpt4<>Nil THEN Cherche_AireT:=TRUE ELSE Cherche_AireT:=FALSE;

END;

function Cherche_Segment(No,Ni:REAL):INTEGER;

function OnTrouve0(P: PDgraph):BOOLEAN; far;
   BEGIN
     OnTrouve0:=FALSE;
     IF (P^.Gr=Mark_seg) OR (P^.Gr=Nul_Angle) THEN
 IF        
 OR  THEN OnTrouve0:=TRUE
   END;

BEGIN

Mpt4:=Points^.FirstThat(@Ontrouve0);
Cherche_Segment:=Points^.Indexof(Mpt4);

END;

procedure Recale_OLE(No:INTEGER); VAR n : INTEGER; BEGIN

FOR n:=7 TO points^.count-1 DO
 BEGIN
  Mpt4:=Points^.At(n);
  IF (Mpt4^.E=888) AND (n>No) THEN Mpt4^.mark:=Mpt4^.mark-1;
 END;

END;

function Cherche_Angle(No,Ni,R:INTEGER):INTEGER;

function OnTrouve0(P: PDgraph):BOOLEAN; far;
   BEGIN
     OnTrouve0:=FALSE;
     IF (P^.Gr=Mark_angle) OR (P^.Gr=Nul_Angle) THEN
 IFTHEN OnTrouve0:=TRUE;
   END;

BEGIN

Mpt4:=Points^.FirstThat(@Ontrouve0);
Cherche_Angle:=Points^.Indexof(Mpt4);

END;

procedure cherche(Pt, A:BYTE); {mioussov} VAR mp30:PDpoint;

   pg0 :PDgraph;  
   n,n0:INTEGER;
   Sortie:BOOLEAN;

function Oncherche:INTEGER;

  BEGIN
            SORTIE:=FALSE;
            WHILE (NOT(SORTIE)) AND (n<points^.count) DO
               BEGIN
                  mp30:=Points^.At(n);
                  {point_actif est le No du point déplacé avec la main ou bouge_vecteur sinon -1}
                  IF (n<>point_Actif) AND (Mp30^.Est_ce_moi(pt)) THEN SORTIE:=TRUE;
                  INC(n);
               END;
            IF SORTIE THEN Oncherche:=n-1 ELSE Oncherche:=-1;
  END;

BEGIN

   {kont est incréménté par appui sur la touche control}
   {on arrive avec A=7 de la procedure change_etat_point pour libérer ou lier un point}
    NNo:=-1;NNi:=-1;
      IF (point_actif<>-1) AND (A<>7) THEN
         BEGIN {les points déplacés sur un objet n'allument rien. A=7 dans change_etat_point}
           mp30:=points^.at(point_actif);
           IF (mp30^.gr=point_M) OR (mp30^.nm='~@|') THEN exit;
         END;
     IF (Delta2=Mil+10) AND (Kont=6) THEN Kont:=1;
     n:=Kont+1;{on commence ainsi à kont dans la collection}
     pt:=1; {les points en priorité}
    NNo:=OnCherche;Delta1:=delta; {n n'est par réinitialisé}
     pt:=3; {pour obliger à chercher des figures à partir d'ici}
     n:=Kont+1;
     IF (NNo=-1)  THEN {ou les figures si pas de points }
       BEGINNNo:=OnCherche;Delta1:=Delta; END;
     n0:=n;
     IF(NNo<>-1)THENBEGINNNi:=OnCherche;Delta2:=Delta;END;{figures toujours}
     IF(NNo<>-1)AND(NNi=-1)THENBEGINpt:=1;n:=n0;NNi:=OnCherche END;{ou points}
     IF (NNo<6) AND (NNi=6) AND (Kont=-1) THEN {pb avec axes et quadrillage}
       BEGINNNo:=NNi;Delta1:=Delta2;Mch1:=Mch2;Delta2:=Mil+10;NNi:=-1 END;
     IF (NNo<6) AND (NNi=6) AND (Kont=1) THEN NNi:=-1;{même pb d'ou le Delta2=mil}
   {if faut d'abord voir si on n'est pas sur un quadrilatère et récupérer q1,q2,q3}
   {qui contiennent les décalages propres pour se placer sur les côtés du quadri}
   IF NNo<>-1 THEN BEGIN corrige_quadri(NNo,FALSE);Mch1:=points^.at(NNo) END;
   IF NNi<>-1 THEN BEGIN corrige_quadri(NNi,FALSE);Mch2:=points^.at(NNi) END;
   IF (NNo<>-1) AND (NNi<>-1) AND (NNo<>NNi) THEN
     BEGIN {donne la priorité au quadrillage}
 IF (Mch1^.Gr=Quadrill) AND (NNo<>0) THEN NNi:=-1;
        IF  AND (Ratio<>1) THEN NNi:=-1;
     END;
   IF (Fonc=Select) AND (point_actif=-1) AND (NNo=6) THEN NNo:=-1; {ne select pas le quadrill}
        {ne pas activer un objet si un de ses bouts est le point_actif}
   IF (A<>17) AND (NNo<>-1) AND (Mch1^.pt3<>-2)
              AND ( (Mch1^.pt1=point_actif) OR (Mch1^.pt3=point_actif) ) THEN NNo:=-1;
   IF (A<>17) AND (NNi<>-1) AND (Mch2^.pt3<>-2)
              AND ( (Mch2^.pt1=point_actif) OR (Mch2^.pt3=point_actif) ) THEN NNi:=-1;
 {ne pas afficher ensemble deux objets suraffichés sauf avec le quadrill NNo=6
  sauf cercle et segment qui envoie pg^.X=mil mais gr1-gr2>2}
        {A=17 pour contextuels qui doivent sortir le suivant même si suraffichés}
   IF (A<>17) AND (NNo<>-1) AND (NNi<>-1) AND (NNo<>NNi)  THEN
   BEGIN
  IF (Mch1^.pt3<>-2) AND (Mch2^.pt3<>-2) THEN
          pg0:=New(PDpoint,INIT(NNo,NNI,-2,0,Epaiss,3,color,'',12,point_M,0,2001))
      ELSE pg0:=Nil;
  IF (pg0<>Nil) AND (pg0^.X=MIL) THEN NNi:=-1;{intersection non définie}
  IF (Mch2^.pt3=-2) OR (Mch1^.pt3=-2) or (fonc=gomme) THEN NNi:=-1; {ajout JL 10/7/94}
  IF (pg0<>Nil) THEN dispose(pg0,done);
   END;
    IF NNo=-1 THEN Mch1:=Nil;
    IF NNi=-1 THEN Mch2:=Nil;

END;

procedure Annule_entree(n:INTEGER); BEGIN

points^.AtFree(points^.count-1); {libere debut de bloc inutile}
No_collect:=Points^.count;
AVERT(n);

END;

procedure Kase_Fonc(Marquable:BOOLEAN;DC:HDC); VAR n1,n2,nk,Mkr,Gr0,

   Teta0,Teta1,poly,index,eta: INTEGER;
  Mass,x,y : REAL;
      MPt7 : Pdpoint;
       Vieux_flag:BOOLEAN;

procedure Aire_de_base; BEGIN

  Dess_Gomme(DC); Mpt4^.Draw(DC);Dess_norm(DC);
  index:=points^.indexof(Mpt4);
  vire_element(index);  {deviennent inutilisables : l'aire}
  vire_element(index-1); {et le début de bloc}
  points^.AtFree(points^.count-1); {libere debut de bloc inutile}
  No_collect:=points^.count;

END;

procedure segment_de_base; BEGIN

 Sauve_Vector(Ni,No,0,fonc,0,No);
 mass:=Points^.count*100+fonc;{permet de mémoriser dans la masse
        de chaque segment le premier segment  de la forme complexe
        et dans Ang la fonction quadri: parallelo ou carre ect.}  
 Sauve_Figure(Ni,points^.count-1,No,0,segment,0,mass);{segment de base du quadri}
 Fig.Trace(DC,-1,0,segment);{effacer avant de réafficher}
 Dess_Norm(DC);Fig.Draw(DC); {pour réafficher le bon!}

END; procedure translation_finale(k:BYTE); BEGIN {k=2 pour parallelo et carré qui contiennent deux objets de moins que les autres}

 Sauve_Vector(Points^.Count-1,Ni,0,fonc,0,No);
 Sauve_Figure(points^.count-2,points^.count-1,Ni,0,segment,0,mass);
 Fig.Draw(DC);
        {on translate du vecteur points^.count-4 d'origine points^.count-4}
 Trace_Sauve_Pt(DC,points^.count-3,points^.count-6+k,0,Epaiss,Translat,color,0,0);
 Sauve_Vector(Points^.Count-4,Points^.Count-1,0,fonc,0,No);
 Sauve_Figure(points^.count-5,points^.count-1,Points^.count-2,0,segment,0,mass);
 Fig.Draw(DC);
 Sauve_Vector(No,points^.count-3,0,fonc,0,No);
 Sauve_Figure(No,points^.count-1,points^.count-4,0,segment,0,mass);
        {Fig.Draw(DC);}
 emplir_Ete_Trace(1);
END;
procedure finale_triangle;
BEGIN
  Sauve_Vector(Ni,points^.count-1,0,fonc,0,No);
  Sauve_Figure(Ni,points^.count-1,points^.count-2,0,segment,0,mass);
  fig.draw(DC);
  Sauve_Vector(No,points^.count-3,0,fonc,0,No);
  Sauve_Figure(No,points^.count-1,points^.count-4,0,segment,0,mass);
END;

BEGIN

    CASE fonc OF
     Bissectrice:
      BEGIN
       Nj:=Cherche_pt_commun(No,Ni,DC);
IF Nj=-1 THEN BEGIN Annule_entree(46); Exit END;
Teta1:=0;
       {on commence par forcer Ni à être plus grand que No}
IFNo>NiTHENBEGINTeta1:=No;No:=Ni;Ni:=Teta1; END;
IF Teta1=0 THEN Teta :=Fais_Delta_Bissect(Nj,Xoo,Yoo,Xo,Yo)
           ELSE Teta :=Fais_Delta_Bissect(Nj,Xo,Yo,Xoo,Yoo);
Teta0:=Teta;
IF M_Angle THEN
BEGIN  { pour mettre une marque ou la retirer -}
        {vect.init pour récupérer le R0 dans fais_XA}
 Vect.init(No,Ni,0,Teta,Epaiss,pointill,color,'a',0,mark_angle,0,0);
 Nk:=Cherche_Angle(No,Ni,R0);
 IF Nk<>-1 THEN
        BEGIN
  Emplir_ete_Trace(1);
  TRACEtout(Dc,TRUE);
         IF Mpt4^.Gr=Mark_Angle THEN n1:=Nul_Angle
    ELSE n1:=Mark_Angle;
         Mpt4^.Gr:=n1; 
  Mpt3:=Points^.At(Nk+1);
  Mpt3^.Gr:=n1;      Mpt3^.c:=Color;
  Mpt3^.p:=Pointill; Mpt3^.E:=Epaiss;
  IF Avec_Degres THEN Mpt3^.masse:= Ray_ang
   ELSE Mpt3^.masse:=-Ray_ang;
  points^.AtFree(points^.count-1); {libere debut de bloc inutile}
         No_collect:=points^.count;
  Exit;
 END;
 n1:= MarK_Angle;n2:=n1;Mass:=Ray_Ang;
 IF NOT(Avec_degres) THEN Mass:=-Mass;
END
ELSE BEGIN n1:= bissectrice;n2:=droite;Mass:=1; END;
 Vect.init(No,Ni,0,Teta0,Epaiss,pointill,color,'a',0,n1,0,0);
 Sauve_Vector(No,Ni,Teta,n1,0,No);
 Sauve_figure(Nj,Points^.count-1,Nj,0,n2,0,Mass);
      END;
   Pinceau: 
      BEGIN
        Trace_Sauve_Pt(Dc,Xo,Yo,Points^.count-1,Epaiss,pinceau,color,0,0);
       force_Xor:=TRUE;Deplace_Xor:=FALSE;
      END;
    TriangleE:
      BEGIN
        segment_de_base;
 Trace_Sauve_Pt(DC,No,Ni,-600,Epaiss,rotat,color,0,0);
        finale_triangle;
      END;
    TriangleI:
      BEGIN
        segment_de_base;
  Sauve_Vector(Ni,No,0,cercle,360,Ni);  {vecteur pour le rayon du cercle}
 Sauve_Figure(Ni,points^.count-1,No,0,cercle,0,1); {cercle de centre Ni par No}
        Trace_Sauve_Pt(DC,Points^.count-1,500,0,Epaiss,Point_M,Color,0,0);
        finale_triangle;
      END;
    TriangleR:
      BEGIN
        segment_de_base;
 Sauve_Vector(points^.count-1,Ni,0,perpend,0,Ni);
 Sauve_Figure(Ni,points^.count-1,Ni,0,droite,0,0); {droite perpendiculaire par Ni}
        Trace_Sauve_Pt(DC,Points^.count-1,-1.5,0,Epaiss,Point_M,Color,0,0);
        finale_triangle;
      END;
    losange:
      BEGIN
        segment_de_base;
 Sauve_Vector(Ni,No,0,cercle,360,Ni);  {vecteur pour le rayon du cercle}
 Sauve_Figure(Ni,points^.count-1,No,0,cercle,0,1); {cercle de centre Ni par No}
        Trace_Sauve_Pt(DC,Points^.count-1,600,0,Epaiss,Point_M,Color,0,0);
        {puis on place le point sur le cercle}
        Translation_finale(0);
    END;
    rectang:
      BEGIN
        segment_de_base;
 Sauve_Vector(points^.count-1,Ni,0,perpend,0,Ni);
 Sauve_Figure(Ni,points^.count-1,Ni,0,droite,0,0); {droite perpendiculaire par Ni}
        Trace_Sauve_Pt(DC,Points^.count-1,-1.5,0,Epaiss,Point_M,Color,0,0);
        {puis on place le point sur la droite}
        Translation_finale(0);
     END;
    carre:
      BEGIN
        Segment_de_base;
        {Sauve_vector(0,0,0,0,0,0);Sauve_vector(0,0,0,0,0,0);
        on fabrique deux objets inutiles pour s'aligner sur les autres quadri}
 Trace_Sauve_Pt(DC,No,Ni,-900,Epaiss,rotat,color,0,0);
        {on fait l'image dans la rotation d'angle 90 centre No de Ni}
        Translation_finale(2);
     END;
    parallelo:
      BEGIN
        segment_de_base;
       x:=xo;y:=yo;
        TOURNE_R(x,y,Dist(Xo-xoo,Yo-yoo),Angle(xo-xoo,yo-yoo)+600,1);
        {on fait tourner de 120° et on multiplie ensuite par 1.6, donc}
        {on évite le rectangle et le losange}
 Trace_Sauve_Pt(DC,xo+1.6*(x-xo),yo+1.6*(y-yo),0,Epaiss,0,color,0,0);
        Translation_finale(2);
     END;
    Sigma_Vect:
      BEGIN
 Trace_Sauve_Pt(DC,xo,yo,0,Epaiss,0,color,0,0);
        Sauve_Vector(No,Ni,0,fonc,0,No);
 Trace_Sauve_Pt(DC,Points^.Count-2,Points^.Count-1,
                                           0,Epaiss,fonc,color,0,0);
 Sauve_figure(Points^.Count-3,Points^.count-2,
                               Points^.count-1,0,Vecteur,0,1);
        Bouge_Vecteur:=TRUE;
  No:=Points^.Count-4; Mpt1:=Points^.At(No);
        Ni:=No;point_actif:=No;
 emplir_Ete_Trace(0);
     END;
     Prod_Vect:
      BEGIN
 Trace_Sauve_Pt(DC,xo,yo,0,Epaiss,0,color,0,0);
 Sauve_Vector(No,No,0,fonc,coeff_vect,No);
 Trace_Sauve_Pt(DC,Points^.Count-2,Points^.Count-1,
        0,Epaiss,fonc,color,0,0);
 Sauve_figure(Points^.Count-3,Points^.count-2,
   Points^.count-1,0,Vecteur,0,1);
 Bouge_Vecteur:=TRUE;
   No:=Points^.Count-4; Mpt1:=Points^.At(No);
  Ni:=No;point_actif:=No;
 emplir_Ete_Trace(0);
     END;
     Sym_Centrale,Sym_Axiale,Translat,Rotat,projection,Homotetie:
      BEGIN
       Index:= Points^.IndexOf(Mpt1);mass:=Mpt1^.masse;
       IF corrige_quadri(Index,TRUE) THEN poly:=8 ELSE poly:=1;
       {Poly=8 indique un quadrilatère}
       While poly>0 DO
       BEGIN
            IF poly=8 THEN Mpt1:=points^.at(Index);
            IF poly=6 THEN Mpt1:=points^.at(Index+Q1);
            IF poly=4 THEN Mpt1:=points^.at(Index+Q2);
            IF poly=2 THEN Mpt1:=points^.at(Index+Q3);
             IF mpt1^.mark=1 THEN mpt1^.mark:=0;{ici pour les objets quadri}
            {on refabrique la masse des segment pour pouvoir récupérer le premier du quadri}
     IF (fonc=Projection) AND (Mpt1^.Gr=Cercle)
    THEN BEGIN Gr0:=Nul_Angle; annule_entree(18) END
    ELSE Gr0:=Mpt1^.GR;
     IF marquable THEN mkr:=1 ELSE Mkr:=0;  {on est en construction enchainées}
     IF Fonc=Rotat THEN Teta:=Rot_Ang ELSE Teta:=0;
     IF Fonc=Homotetie THEN Teta:=ROUND(Delta_homot*100);
     IF Fonc=Projection THEN Teta:=N_proj;
            IF (Mpt1^.gr=courbe_aff) THEN IF (fonc<>translat) THEN Avert(114) ELSE
             BEGIN
              IF (Mpt1<>Nil) AND (Mpt2<>Nil) AND (Mpt2^.gr=vecteur) THEN eta:=Mpt1^.ang ELSE eta:=0;
              IF eta=1 THEN {tranlaté d'une courbe dans pt3 on met No, la courbe et Ni, le vecteur}
               BEGIN
         fig.init(0,5,No*1000+Ni,eta,Epaiss,pointill,color,Mpt1^.nm,0,courbe_aff,0,1);
         Points^.Insert(New(PDFigures,Init(0,5,No*1000+Ni,eta,epaiss,pointill,color,Mpt1^.nm,0,courbe_aff,0,1)));
                courbe_modif:=TRUE;
                Tracetout(DC,FALSE);
                No_collect:=Points^.count;
                courbe_modif:=FALSE;
                Exit;
               END;
             END
            ELSE
     IF (Mpt1^.pt3=-2)  THEN N2:=est_Ce_Image(DC,No,Ni,Teta,fonc,mkr)
          ELSE
         BEGIN
                 {la fonction est_ce_image permet d'envisager deux cas:}
                 {si ce point existe déjà on en récupère l'indice en sortie}
                 {sinon on créé un nouveau point et on renvoie son indice}
          N2:=est_Ce_Image(DC,Points^.IndexOf(Mpt1^.No_1),Ni,Teta,fonc,0);
          N1:=est_Ce_Image(DC,Points^.IndexOf(Mpt1^.No_3),Ni,Teta,Fonc,0);
           Sauve_Vector(Points^.IndexOf(Mpt1^.No_2),Ni,Teta,fonc,Mpt1^.No_2^.Masse,No);
                 IF (poly=8) AND (Mpt1^.gr=segment) AND (QuadriSort_fonc(Mpt1^.masse)) THEN
                       mass:=points^.count*100+sort_fonc(Mpt1^.masse);
                 {la première fois on mémorise le premier segment du bloc quadri}
                 {poly=8 n'impliquant que les quadris bien sur!!!}
           Sauve_figure(N2,Points^.count-1,N1,Teta,Gr0,mkr,mass);
                END;
       poly:=poly-2;
       IF (poly=2) AND (Q2=Q3) THEN poly:=0; {on saute poly=2 pour les triangles si q2=q3}
       END;
IF NOT(Marquable) THEN TRaceTout(Dc,FALSE);
      END;
     gof:
      BEGIN
       IF (No=-1) OR (Ni=-1) OR (Mpt1^.gr<>Courbe_aff) OR (Mpt2^.gr<>Courbe_Aff) THEN Annule_Entree(108)
       ELSE
        BEGIN
         {c'est en fait une courbe dont le nom (no+ni) est fait dans fais_xa}
         {-18 sur pt3 pour repérer que c'est un gof quand nécessaire}
  fig.init(No,Ni,-18,1,Epaiss,pointill,color,'rien',0,courbe_aff,0,1);
  Points^.Insert(New(PDFigures,
       Init(No,Ni,-18,1,
   epaiss,pointill,color,'rien',0,courbe_aff,0,1)));
        Vieux_flag:=Courbe_modif;courbe_modif:=TRUE;
         Fig.Draw(DC);
         Courbe_modif:=Vieux_flag;
         No_collect:=points^.count;
        END;
      END;
     Lieu_point:
      BEGIN
       IF (No=-1) OR (Ni=-1) OR (Mpt1^.pt3<>-2) OR (Mpt2^.pt3<>-2)
           OR (Mpt2^.gr<>point_M) OR (Mpt2^.P=3)  THEN  Annule_entree(97)
                         ELSE Trace_sauve_pt(DC,No,Ni,0,Epaiss,Lieu_point,color,0,0);
      END;
     Inters:
      BEGIN
       IF (No=-1) OR (Ni=-1) OR (Mpt1^.gr<>Courbe_Aff) OR (Mpt2^.gr<>courbe_Aff)
                         THEN  annule_entree(108)
                         ELSE
        BEGIN
           { Points^.Insert(New(PDVector ,Init(No,Ni,0,0,0,0,0,'N1',0,Inters,0,0)));}
     Sauve_Vector(No,Ni,0,Inters,0,No); {fais_xa est bloqué dans init}
          FOR n1:=1 TO  10 DO  {fabrique 10 cases pour recevoir les inters éventuelles}
             Points^.Insert(New(PDpoint,Init(0,0,-2,0,Epaiss,1,color,'',12,inters,0,2001)));
          No_collect:=Points^.count;
        END;
      END;
    { AireQ:
       BEGIN
        IF cherche_aireQ(No,Ni) 
         THEN  Aire_de_base
         ELSE Trace_Sauve_Pt(DC,No,Ni,0,Epaiss,fonc,color,0,0);
       END;}
     Aire,AireQ:  {pour quadri et triangles}
      BEGIN
       index:=sort_No(Mpt1^.masse);
       IF (Mpt1^.pt3<>-2) AND (corrige_quadri(index,TRUE)) THEN
         BEGIN
           IF cherche_aire(index) {récupère aussi le pointeur Mpt4}
              THEN aire_de_base
              ELSE Trace_Sauve_Pt(DC,index,index+q2,0,Epaiss,Aire,color,0,0);
                  {index pour récupérer A et index+q1 pour récupérer C}
         END
       ELSE
        IF fonc=AireQ THEN
         BEGIN
            IF cherche_aireQ(No,Ni)
               THEN  Aire_de_base
               ELSE Trace_Sauve_Pt(DC,No,Ni,0,Epaiss,fonc,color,0,0);
         END
        ELSE
         BEGIN
            IF cherche_aireT(No,Ni) {récupère aussi le pointeur Mpt4}
             THEN Aire_de_base
             ELSE Trace_Sauve_Pt(DC,No,Ni,0,Epaiss,fonc,color,0,0);
         END;
      END;
     Milieu:
      BEGIN
IF L_segment THEN
BEGIN
 IF (Mpt1^.Gr=Segment) OR (Mpt1^.gr=Vecteur)
                            THEN Nj:=Cherche_Segment(Mpt1^.pt1,Mpt1^.pt3)
                     ELSE Nj:=Cherche_Segment(No,Ni);
        IF Nj<>-1 THEN
  BEGIN
   Emplir_Ete_Trace(1);
   TRACEtout(Dc,TRUE);
   IF Mpt4^.Gr=Mark_Seg  THEN n1:=Nul_Angle
                                ELSE n1:=Mark_Seg;
   Mpt4^.Gr:=n1; Mpt4^.C:=Color;
  Mpt4^.P:=Pointill;Mpt4^.E:=Epaiss;
   IF Avec_Degres THEN Mpt4^.Ang:=Long_Seg
          ELSE Mpt4^.Ang:=-Long_Seg;
   TRACEtout(Dc,FALSE);
   points^.AtFree(points^.count-1); {libere debut de bloc inutile}
          No_collect:=Points^.count;
   Exit;
         END;
       END;
IF L_Segment THEN BEGIN n1:=Mark_Seg ; n2:=Pointill END
      ELSE BEGIN n1:=Milieu   ; n2:=0        END;
IF (Mpt1^.Gr=Segment) OR (Mpt1^.gr=Vecteur) AND (L_Segment) THEN
   BEGIN
     No:=ROUND(Mpt1^.pt1);
            Ni:=Mpt1^.pt3;
   END;
IF (No<>Ni) OR (Mpt1^.gr=Segment) or (Mpt1^.gr=vecteur)
                 THEN Trace_Sauve_Pt(DC,No,Ni,0,Epaiss,n1,color,0,0)
   ELSE points^.AtFree(points^.count-1); {libere debut de bloc inutile}
       No_collect:=points^.count;
      END;
     Perpend,parall:
      BEGIN
       {Nj pointe sur le point invisible posé sur la courbe}
       IF (No<>-1) AND (Mpt1^.gr=Courbe_Aff) THEN Sauve_Vector(No,Nj,0,fonc,0,No)
                                      ELSE Sauve_Vector(No,Ni,0,fonc,0,No);
       Sauve_Figure(Ni,points^.count-1,Ni,0,droite,0,1);
       Fig.Trace(DC,-1,0,fonc);{effacer avant de réafficher}
        {(Ni=points^.count-3) lorsque l'on vient de créer un point libre}
      IF (Ni=points^.count-3) AND (passe_par_le_point(points^.count-1,Ni))  THEN
        BEGIN
   points^.AtFree(points^.count-1); {libere debut de bloc inutile}
          points^.AtFree(points^.count-1); {libere la figure}
          Mpt2:=points^.at(Points^.count-1);{se placer sur le point libre créé}
          Dess_gomme(DC);Mpt2^.Draw(DC);Dess_norm(DC);{pour l'effacer} 
          points^.AtFree(points^.count-1); {et le détruire}
   Sauve_Vector(No,Ni,0,fonc,0,No);
          Sauve_Figure(Ni,points^.count-1,Ni,0,droite,0,1);
        END;
      END;
     ELSE  {cercle,segment et droites}
 BEGIN
   IF fonc=Cercle THEN Mass:=Angle_Arc ELSE mass:=0;
          {grosse modif ici : fonc en lieu de 0}
          Sauve_Vector(No,Ni,0,fonc,mass,No);
          If Fonc=Cercle THEN Mass:=Ratio ELSE Mass:=0;
   Sauve_Figure(No,points^.count-1,Ni,0,fonc,0,mass);
          IF NOT(Def_REct) THEN Fig.Trace(DC,-1,0,fonc);
        END
     END;

END; END.

Ajouter un commentaire

Le code HTML est affiché comme du texte et les adresses web sont automatiquement transformées.

La discussion continue ailleurs

URL de rétrolien : http://lepinejean.livehost.fr/index.php?trackback/5

Fil des commentaires de ce billet

Page top