Source : geometriesyr12.mp

%%===============================================
%% GEOMETRIESYR.MP
%% christophe.poulain@melusine.eu.org
%% Création : 19 Février 2003
%% Dernière modification : 04 Mars 2004
%%===============================================
%------------------------------------------------
% Appel fichier
%------------------------------------------------
input constantes;
input papiers1;
%------------------------------------------------
% La figure (début et fin) JMS/CP
%------------------------------------------------
path feuillet;
numeric _tfig,_nfig;
pair coinbg,coinbd,coinhd,coinhg;
_nfig:=0;
def feuille(expr xa,ya,xb,yb) =
  feuillet := (xa,ya)--(xa,yb)--(xb,yb)--(xb,ya)--cycle;
  coinbg := (xa,ya);
  coinbd := (xb,ya);
  coinhd := (xb,yb);
  coinhg := (xa,yb);
  z.so=coinbg;
  z.ne=coinhd;
  extra_endfig := "clip currentpicture to feuillet;" & extra_endfig;
enddef;
def figure(expr xa,ya,xb,yb) =
  _nfig:=_nfig+1;
    beginfig(_nfig);
    feuille(xa,ya,xb,yb);
    _tfig:= if (xb-xa)>(yb-ya): xb-xa else: yb-ya fi;
enddef;
def fin =
    endfig;
enddef;
%%-----------------------------------------------
%% Les marques (JMS)
%%-----------------------------------------------
string marque_p;
marque_p := "non";
marque_r := 20;
marque_a := 20;
%------------------------------------------------
% Les tables
%------------------------------------------------
numeric _tn;
_tn:=0;
pair _t[];
%%-----------------------------------------------
%% Procédures d'affichage
%%-----------------------------------------------
def MarquePoint(expr p)=
  %JMS
  if marque_p = "plein":
    fill fullcircle scaled (marque_r/5) shifted p;
  elseif marque_p = "creux":
    fill fullcircle scaled (marque_r/5) shifted p withcolor white;
    draw fullcircle scaled (marque_r/5) shifted p;
  %fin JMS
  elseif marque_p = "croix":
    draw (p shifted (-u/10,u/10))--(p shifted (u/10,-u/10));
    draw (p shifted (-u/10,-u/10))--(p shifted (u/10,u/10));
  fi
enddef;
%JMS
vardef pointe(text t) =
  for p_ = t: if pair p_: MarquePoint(p_); fi endfor;
enddef;
vardef nomme@#(suffix p)=
  MarquePoint(p);
  label.@#(str p,p);
enddef;
def trace expr o =
    if path o: draw o else: draw o fi
enddef;
def remplis expr o =
    if path o: fill o else: fill o fi
enddef;
vardef triangle(expr aa,bb,cc)=aa--bb--cc--cycle
enddef;
%fin JMS
vardef bary(expr a,b,c,d)=
  save $;
  pair $;
  numeric t[];
  t1=uniformdeviate(1);
  t2=uniformdeviate(1);
  t3=uniformdeviate(1);
  t4=uniformdeviate(1);
  $=(1/(t1+t2+t3+t4))*(t1*a+t2*b+t3*c+t4*d);
  $
enddef;
vardef triangleqcq(text t)=
  save $;
  path $;
  pair pointchoisi[];
  pointchoisi1:=bary(coinbg,1/4[coinbg,coinbd],iso(coinbg,iso(coinhg,coinhd)),iso(coinhg,coinbg));
  pointchoisi2:=bary(coinbd,3/4[coinbg,coinbd],iso(coinbd,iso(coinhg,coinhd)),iso(coinhd,coinbd));
  test:=uniformdeviate(1);
  choix:=43+uniformdeviate(4);
  ecart:=abs(45-choix);
  relation:=60-(ecart/2)+uniformdeviate(ecart);
  if test<0.5 :
    pointchoisi3:=droite(pointchoisi1,rotation(pointchoisi2,pointchoisi1,choix)) intersectionpoint droite(pointchoisi2,rotation(pointchoisi1,pointchoisi2,-relation));
  else :
    pointchoisi3:=droite(pointchoisi2,rotation(pointchoisi1,pointchoisi2,-choix)) intersectionpoint droite(pointchoisi1,rotation(pointchoisi2,pointchoisi1,relation));
  fi
  j:=1;
  for p_=t:
    p_=pointchoisi[j];
    j:=j+1;
  endfor;
  $=pointchoisi1--pointchoisi2--pointchoisi3--cycle;
  $
enddef;
%------------------------------------------------
% Procédures de codage
%------------------------------------------------
%Codage de l'angle droit de sommet B
vardef codeperp(expr aa,bb,cc,m)=%normalement m=5
  (bb+m*unitvector(aa-bb))--(bb+m*unitvector(aa-bb)+m*unitvector(cc-bb))--(bb+m*unitvector(cc-bb))
enddef;
 
%Codage d'un milieu
vardef codemil(expr AA,BB, n) =%extrêmités-angle de codage
  save $,a,b,c,d;
  path $;
  pair a,b,c,d;
  a=1/2[AA,BB];
  b=(a+2*unitvector(BB-AA))-(a-2*unitvector(BB-AA));
  c=b rotated n shifted a;
  d=2[c,a];
  $=c--d;
  $
enddef;
%Codage de deux segments égaux
vardef codesegments(expr AA,BB,CC,DD,n)=%extrémités des segments(4)-type de codage
  save $,v,w;
  picture $;
  $=image(
    if n=5 :
      draw fullcircle scaled 0.1cm shifted (1/2[AA,BB]);
      draw fullcircle scaled 0.1cm shifted (1/2[CC,DD]);
    elseif n=4 :
      pair v,w;
      v=1/2[AA,BB];
      w=1/2[CC,DD];
      draw codemil(AA,BB,60);
      draw codemil(AA,BB,120);
      draw codemil(CC,DD,60);
      draw codemil(CC,DD,120);
    elseif n=3 :
      draw codemil(AA,BB,60);
      draw codemil(AA,BB,60) shifted (2*unitvector(AA-BB));
      draw codemil(AA,BB,60) shifted (2*unitvector(BB-AA));
      draw codemil(CC,DD,60);
      draw codemil(CC,DD,60) shifted (2*unitvector(CC-DD));
      draw codemil(CC,DD,60) shifted (2*unitvector(DD-CC));
    elseif n=2 :
      draw codemil(AA,BB,60) shifted unitvector(AA-BB);
      draw codemil(AA,BB,60) shifted unitvector(BB-AA);
      draw codemil(CC,DD,60) shifted unitvector(CC-DD);
      draw codemil(CC,DD,60) shifted unitvector(DD-CC);
    elseif n=1 :
      draw codemil(AA,BB,60);
      draw codemil(CC,DD,60);
    fi;
    );
    $
enddef;
%Codage de l'angle abc non orienté (mais donné dans le sens direct) n fois avec des mesures différentes
vardef codeangle@#(expr aa,bb,cc,nb,ecart,nom)=
  save s,p,$;
  path p;
  picture $;
  $=image(
    pickup pencircle scaled 0.25bp;
    for j=0 upto (nb-1) :
      draw arccercle(((ecart+j*mm)*unitvector(aa-bb) shifted bb),((ecart+j*mm)*unitvector(cc-bb) shifted bb),bb);
    endfor;
    label.@#(nom,iso((ecart+nb*mm)*unitvector(aa-bb) shifted bb,(ecart+nb*mm)*unitvector(cc-bb) shifted bb));
    );
  $
enddef;
 
vardef marqueangle(expr aa,bb,cc,mark)=%codage d'un angle de sommet bb dans le sens direct par la marque mark.
  save $;
  picture $;
  path rr;
  pair w;
  pair tangent;
  numeric t;
  rr=arccercle(bb+marque_a*unitvector(aa-bb),bb+marque_a*unitvector(cc-bb),bb);
  w=rr intersectionpoint droite(bb,CentreCercleI(aa,bb,cc));
  t=length rr/2;
  tangent=unitvector(direction t of rr);
  $=image(
    trace rr;
    if mark=1:
      trace rotation((w shifted(5*tangent))--(w shifted(-5*tangent)),w,90);
    elseif mark=2:
      trace rotation((w shifted(5*tangent))--(w shifted(-5*tangent)),w,90) shifted tangent;
      trace rotation((w shifted(5*tangent))--(w shifted(-5*tangent)),w,90) shifted(-tangent);
    elseif mark=3:
      trace rotation((w shifted(5*tangent))--(w shifted(-5*tangent)),w,90);
      trace rotation((w shifted(5*tangent))--(w shifted(-5*tangent)),w,90) shifted(1.5*tangent);
      trace rotation((w shifted(5*tangent))--(w shifted(-5*tangent)),w,90) shifted(-1.5*tangent);
    elseif mark=4:
      trace rotation((w shifted(5*tangent))--(w shifted(-5*tangent)),w,45);
      trace rotation((w shifted(5*tangent))--(w shifted(-5*tangent)),w,-45);
    fi;
    );
  $
enddef;
 
vardef coloreangle(expr aa,bb,cc)=arccercle(bb+marque_a*unitvector(aa-bb),bb+marque_a*unitvector(cc-bb),bb)--bb--cycle
enddef;
 
vardef marque_para(expr dd,ee,pa)=
  save im;
  picture im;
  pair kk,ll,mn,mo;
  kk=point(pa*length dd) of dd;
  ll=projection(kk,point(0.25*length ee) of ee,point(0.5*length ee) of ee);
  mn=iso(kk,ll);
  mo=(mn--kk) intersectionpoint cercles(mn,3mm);
  im=image(
    drawarrow mo--kk;
    drawarrow symetrie(mo,mn)--ll;
    label(btex $//$ etex,mn);
    );
  im
enddef;
 
%------------------------------------------------
% Points
%------------------------------------------------
%JMS
vardef iso(text t) =
    save s,n; numeric n; pair s; s := (0,0) ; n := 0;
    for p_ = t: s := s + p_; n := n + 1 ; endfor;
    if n>0: (1/n)*s fi
enddef;
% -- projection de m sur (a,b)
vardef projection(expr m,a,b) =
    save h; pair h;
    h - m = whatever * (b-a) rotated 90;
    h = whatever [a,b];
    h
enddef;
% -- centre du cercle circonscrit
vardef CentreCercleC(expr a, b ,c) =
    save o; pair o;
    o - .5[a,b] = whatever * (b-a) rotated 90;
    o - .5[b,c] = whatever * (c-b) rotated 90;
    o
enddef;
% -- orthocentre
vardef Orthocentre(expr a, b, c) =
  save h; pair h;
  h - a = whatever * (c-b) rotated 90;
  h - b = whatever * (a-c) rotated 90;
  h
enddef;
%fin JMS
vardef CentreCercleI(expr aa,bb,cc)=
  save $,a,c;
  pair $;
  numeric a,c;
  a=(angle(aa-cc)-angle(bb-cc))/2;
  c=(angle(cc-bb)-angle(aa-bb))/2;
  ($-cc) rotated a shifted cc=whatever[aa,cc];
  ($-bb) rotated c shifted bb=whatever[bb,cc];
  $
enddef;
%------------------------------------------------
% Cercles
%------------------------------------------------
%Cercle connaissant le centre A et le rayon q
vardef cercle(expr aa, q)=fullcircle scaled (2*q) shifted aa
enddef;
%Cercle de centre A et passant par B
vardef cerclepoint(expr aa,bb)=fullcircle scaled (2*abs(aa-bb)) shifted aa
enddef;
%Cercle connaissant le diamètre [AB]
vardef cercledia(expr aa,bb)=
  fullcircle scaled (2*abs(1/2[aa,bb]-bb)) shifted (1/2[aa,bb])
enddef;
%Cercles complets
vardef cercles(text t)=
  save $;
  path $;
  save n;
  n:=0;
  for p_=t:
    if pair p_:
      n:=n+1;
      _t[n]:=p_;
    fi
    if numeric p_:
      rayon:=p_;
    fi;
  endfor;
  if n=1 : $=fullcircle scaled (2*rayon) shifted _t[1];
  elseif n=2 : $=fullcircle scaled (2*abs(_t[1]-_t[2])) shifted _t[1];
  elseif n=3 : $=cercles(CentreCercleC(_t[1],_t[2],_t[3]),_t[1]);
  fi
  $
  enddef;
%Point particulier sur le cercle
vardef pointarc(expr cercla,angle)=
  point(arctime((angle/360)*arclength cercla) of cercla) of cercla
enddef;
%Arc de cercle AB de centre 0(dans le sens direct) : les points A et B doivent être sur le cercle.
vardef arccercle(expr aa,bb,oo)=
  path tempo;
  path arc;
  tempo=cercle(oo,abs(aa-oo));
  if (angle(aa-oo)=0) or (angle(aa-oo)>0) :
    if (angle(bb-oo)=0) or (angle(bb-oo)>0):
      if (angle(aa-oo)<=angle(bb-oo)):
	arc=subpath(angle(aa-oo)*(length tempo)/360,angle(bb-oo)*(length tempo)/360) of tempo;
      else:
	arc=subpath(angle(aa-oo)*(length tempo)/360,(length tempo)+angle(bb-oo)*(length tempo)/360) of tempo;
      fi;
    else :
      if (angle(aa-oo)=angle(bb-oo)) or (angle(aa-oo)>angle(bb-oo)):
	arc=subpath(angle(aa-oo)*(length tempo)/360,(length tempo)+angle(bb-oo)*(length tempo)/360) of tempo;
      fi;
    fi;
  else:
    if (angle(bb-oo)<0):
      if (angle(aa-oo)<=angle(bb-oo)):
	arc=subpath((length tempo)+angle(aa-oo)*(length tempo)/360,(length tempo)+angle(bb-oo)*(length tempo)/360) of tempo;
      else:
	arc=subpath((length tempo)+angle(aa-oo)*(length tempo)/360,2*(length tempo)+angle(bb-oo)*(length tempo)/360) of tempo;
      fi;
    else :
      if (angle(aa-oo)=angle(bb-oo)) or (angle(aa-oo)<angle(bb-oo)):
	arc=subpath((length tempo)+angle(aa-oo)*(length tempo)/360,(length tempo)+angle(bb-oo)*(length tempo)/360) of tempo;
      fi;
    fi;
  fi
  arc
enddef;
%------------------------------------------------
% Droites
%------------------------------------------------
vardef droite(expr AA,BB)=(_tfig/abs(AA-BB))[BB,AA]--(_tfig/abs(AA-BB))[AA,BB]
enddef;
vardef demidroite(expr AA,BB)=AA--(_tfig/abs(AA-BB))[AA,BB]
enddef;
vardef mediatrice(expr AA,BB)=droite(iso(AA,BB),rotation(BB,iso(AA,BB),90))
enddef;
vardef perpendiculaire(expr AA,BB,II)=droite(iso(AA,BB),rotation(BB,iso(AA,BB),90)) shifted (II-iso(AA,BB))
enddef;
vardef parallele(expr AA,BB,II)=droite(AA,BB) shifted (II-(projection(II,AA,BB)))
enddef;
%------------------------------------------------
% Transformations
%------------------------------------------------
vardef rotation(expr p,c,a)=
  p rotatedaround(c,a)
enddef;
vardef symetrie(expr x)(text t)=
  save n;
  n:=0;
  for p_=t:
    n:=n+1;
    _t[n]:=p_;
  endfor;
  if n=1:
    rotation(x,_t[1],180)
  elseif n=2:
    x reflectedabout(_t[1],_t[2])
  fi
enddef;
%------------------------------------------------
%Sucres
%------------------------------------------------
vardef hachurage(expr chemin, angle, ecart, trace)=
  save $;
  picture $;
  path support;
  support=((u*(-37,0))--(u*(37,0))) rotated angle;
  if trace=1:
    drawoptions(dashed evenly);
  elseif trace=2:
    drawoptions(dashed dashpattern(on12bp off6bp on3bp off6bp));
  fi;
  $ = image(
    for j=-200 upto 200:
      if ((support shifted (ecart*j*(u,0))) intersectiontimes chemin)<>(-1,-1):
	draw support shifted (ecart*j*(u,0));
      fi
    endfor;
    );
  clip $ to chemin;
  drawoptions();
  $
enddef;
%flèche pour coter un segment [AB] (Jacques Marot)
vardef cotation(expr aa,bb,ecart,decalage,cote)=
  pair m[] ;
  save $;
  picture $;
  m3=unitvector(bb-aa) rotated 90;
  m1=aa+ecart*m3;
  m2=bb+ecart*m3;
  $=image(
    pickup pencircle scaled 0.2bp;
    drawdblarrow m1--m2 ;
    draw aa--m1 dashed evenly;
    draw bb--m2 dashed evenly;
    label(cote rotated angle(m2-m1),(m1+m2)/2+decalage*m3);
    );
  $
enddef;
 
vardef appelation(expr aa,bb,decalage,cote)=
  save $;
  picture $;
  pair m[];
  m3=unitvector(bb-aa) rotated 90;
  $=image(
    label(cote rotated angle(bb-aa),(bb+aa)/2+decalage*m3);
    );
  $
enddef;
 
vardef cotationmil(expr aa,bb,ecart,decalage,cote)= %Christophe
  pair m[] ;
  save $;
  picture $;
  m3=unitvector(bb-aa) rotated 90;
  m1=aa+ecart*m3;
  m2=bb+ecart*m3;
  $=image(
    pickup pencircle scaled 0.2bp;
    drawarrow (1/2[m1,m2]+decalage*unitvector(m1-m2))--m1;
    drawarrow (1/2[m1,m2]-decalage*unitvector(m1-m2))--m2;
    draw aa--m1 dashed evenly;
    draw bb--m2 dashed evenly;
    label(cote rotated angle(m2-m1),(m1+m2)/2);
    );
  $
enddef;
 
endinput