program projet;
var i,j:integer,
     h,v:char;
     (* Les variables h et v sont utilis‚es pour comparer le sens des segments*)
begin

(************************************************************)
h:='h';(* Initialisation des variables h et v *)
v:='v';
pref iiuwgraph block
var t,tab:arrayof segment;(* Le tableau tab contient les segments saisis soit 
au clavier, soit … l'aide de la souris ou soit cr‚er al‚atoirement, et le 
tableau t est le r‚sultat du tri de tab suivant les ordonn‚es (et les abscisses
si les ordonn‚es sont ‚gales *)

(************************************************************)
(* Les fonctions de convertion des abscisses et des ordonn‚es
en entier(pixel) (xconv_en_entier,yconx_en_entier) ou en r‚el
(yconv_en_reel,xconv_en_reel) *)

unit xconv_en_entier:function(x:real):integer;
begin
   result:=entier(40+20*x);
end xconv_en_entier;

unit yconv_en_entier:function(y:real):integer;
begin
   result:=entier(210-20*y);
end yconv_en_entier;

unit xconv_en_reel:function(x:integer):real;
begin
   result:=(x-40)/20;
end xconv_en_reel;

unit yconv_en_reel:function(y:integer):real;
begin
   result:=(210-y)/20;
end yconv_en_reel;

(************************************************************)
(* La structure de la classe segment, la procedure saisie utile pour
la procedure clavier *)

unit segment:class;
  var sens:char,
      x1,x2,y1,y2:real;
  (* La procedure saisie n'est utilis‚e que si les segments sont saisis
     au clavier *)
  unit saisie:procedure(input sens:char;inout x1,y1,x2,y2:real);
  var i,k:integer,j:real,
      b:boolean;
  begin
     if sens=h then
	call move(40,290);
	call outstring("entrer la valeur de l'ordonn‚e :   Y= ");
	i:=inkey;j:=1.0;k:=0;y1:=0.0;b:=false;
	while i<>13
	do
	   call hascii(i);
	   call move(350+7*k,290);
	   if i<>46 then
		y1:=10*y1+i-48;
	   fi;
	   k:=k+1;
	   if b then j:=j/10.0 fi;
	   if i=46 then b:=true fi;
	   i:=inkey;
	od;
	y1:=y1*j;if y1>10.0 then y1:=10.0 fi;
	call move(40,310);
	call outstring("entrer la valeur de l'abscisse1 : X1= ");
	i:=inkey;j:=1.0;k:=0;x1:=0.0;b:=false;
	while i<>13
	do
	   call hascii(i);
	   call move(350+7*k,310);
	   if i<>46 then
		x1:=10*x1+i-48;
	   fi;
	   k:=k+1;
	   if b then j:=j/10.0 fi;
	   if i=46 then b:=true fi;
	   i:=inkey;
	od;
	x1:=x1*j;
	call move(40,330);
	call outstring("entrer la valeur de l'abscisse2 : X2= ");
	i:=inkey;j:=1.0;k:=0;x2:=0.0;b:=false;
	while i<>13
	do
	   call hascii(i);
	   call move(350+7*k,330);
	   if i<>46 then
		x2:=10*x2+i-48;
	   fi;
	   k:=k+1;
	   if b then j:=j/10.0 fi;
	   if i=46 then b:=true fi;
	   i:=inkey;
	od;
	x2:=x2*j;
	if x1>x2 then
		y2:=x1;x1:=x2;x2:=y2;
	fi;
	y2:=y1;if x2>28.0 then x2:=28.0 fi;if x1>28.0 then x1:=28 fi;
	call move(xconv_en_entier(x1),yconv_en_entier(y1));
	call draw(xconv_en_entier(x2),yconv_en_entier(y2));
     else
	if sens=v then
	call move(40,290);
	call outstring("entrer la valeur de l'abscisse :   X= ");
	i:=inkey;j:=1.0;k:=0;x1:=0.0;b:=false;
	while i<>13
	do
	   call hascii(i);
	   call move(350+7*k,290);
	   if i<>46 then
		x1:=10*x1+i-48;
	   fi;
	   k:=k+1;
	   if b then j:=j/10.0 fi;
	   if i=46 then b:=true fi;
	   i:=inkey;
	od;
	x1:=x1*j;if x1>28 then x1:=28 fi;
	call move(40,310);
	call outstring("entrer la valeur de l'ordonn‚e1 : Y1= ");
	i:=inkey;j:=1.0;k:=0;y1:=0.0;b:=false;
	while i<>13
	do
	   call hascii(i);
	   call move(350+7*k,310);
	   if i<>46 then
		y1:=10*y1+i-48;
	   fi;
	   k:=k+1;
	   if b then j:=j/10.0 fi;
	   if i=46 then b:=true fi;
	   i:=inkey;
	od;
	y1:=y1*j;
	call move(40,330);
	call outstring("entrer la valeur de l'ordonn‚e2 : Y2= ");
	i:=inkey;j:=1.0;k:=0;y2:=0.0;b:=false;
	while i<>13
	do
	   call hascii(i);
	   call move(350+7*k,330);
	   if i<>46 then
		y2:=10*y2+i-48;
	   fi;
	   k:=k+1;
	   if b then j:=j/10.0 fi;
	   if i=46 then b:=true fi;
	   i:=inkey;
	od;
	y2:=y2*j;
	if y1>y2 then
		x2:=y1;y1:=y2;y2:=x2;
	fi;
	x2:=x1;if y2>10 then y2:=10 fi;if y1>10 then y1:=10 fi;
	call move(xconv_en_entier(x1),yconv_en_entier(y1));
	call draw(xconv_en_entier(x2),yconv_en_entier(y2));
	fi;
     fi;
     call move(40,275);
     call outstring("                                                  ");
     call move(40,290);
     call outstring("                                                  ");
     call move(40,310);
     call outstring("                                                  ");
     call move(40,330);
     call outstring("                                                  ");
  end saisie;
end segment;

(*************************************************************)
(* La procedure tri, comme son nom l'indique, trie le tableau contenant
tous les segments(tab) et met le r‚sultat dans un autre tableau(t) *)

unit tri:procedure(tb:arrayof segment;output ta:arrayof segment);
  var i,j,k,n:integer,t:arrayof integer;
  begin
    n:=upper(tb);
    array t dim(1:n);
    array ta dim(1:n);
    for i:=1 to n do t(i):=i od;
    for i:=1 to n-1 
    do 
       for j:=i+1 to n
       do 
	  if tb(i).y1>tb(j).y1 then
			k:=t(i);       
			t(i):=t(j);
			t(j):=k;
	  fi;
	  if tb(i).y1=tb(j).y1 then
			if tb(i).x1>tb(j).x1 then
					k:=t(i);
					t(i):=t(j);
					t(j):=k;
	  fi;           fi;
	od;
    od;
    for i:=1 to n
    do
	ta(i):=new segment;
	ta(i):=tb(t(i));
    od;
    call move(60,295);call color(9);
    call outstring("Fin du tri.");
    call move(60,310);call color(5);
    call outstring("Appuyer sur une touche pour voir ");call color(14);
    call outstring("les intersections ‚ventuelles. ");
    call move(60,325);call color(15);
    call outstring("Pour revenir au menu pr‚c‚dent, taper sur une nouvelle touche");
    j:=inkey;
end tri;
(*************************************************************)
(* Cette procedure est appel‚‚e par la procedure intersection, si les conditions
pour une intersection sont r‚alis‚es, pour tracer l'intersection *)

unit trace:procedure(c:char,x,y,z:real);
begin
	if c='p' then
		  call point(xconv_en_entier(x),yconv_en_entier(y));
	fi;
	if c=h then
		call move(xconv_en_entier(x),yconv_en_entier(y));
		call draw(xconv_en_entier(z),yconv_en_entier(y));
	fi;
	if c=v then
		call move(xconv_en_entier(x),yconv_en_entier(y));
		call draw(xconv_en_entier(x),yconv_en_entier(z));
	fi;
end trace;

(*************************************************************)
(* La procedure parcours a pour but de traiter le tableau tri‚ et si n‚cessaire
faire appel … une de ses procedures(traitement, intersection) ou classe(arb) pour 
trouver toutes les intersections existantes *)

unit parcours:procedure(tab:arrayof segment);
  (* La classe arb va servir … traiter uniquement les segments verticaux *)
  unit arb:class;
	var nb:integer,tv:arrayof segment;

	unit insertion:procedure(tab:arrayof segment,nb:integer;inout tv:arrayof segment);
	var i,j:integer;
	begin
		array tv dim(1:nb);j:=0;
		for i:=1 to upper(tab)
		do;
		   if tab(i).sens=v then
			j:=j+1;
			tv(j):=new segment;tv(j).sens:=v;
			tv(j).x1:=tab(i).x1;tv(j).y1:=tab(i).y1;
			tv(j).x2:=tab(i).x2;tv(j).y2:=tab(i).y2;
		   fi;
		od;
	end insertion;

	unit Arb_parcours:procedure(vertical:arrayof segment);
	begin
		for i:=1 to upper(vertical)
		do
		   for j:=i+1 to upper(vertical)
		   do
			 call intersection(vertical(i),vertical(j));
		od;od;
	end Arb_parcours;

  end arb;

(* La procedure intersection permet de v‚rifier si les conditions d'intersection
entre deux segments sont r‚alis‚es *)

  unit intersection:procedure(s1,s2:segment);
  begin
  call color(14);
  if s1.sens=s2.sens then
	if s1.sens=h then
	   if s1.y1=s2.y1 then
		if s2.x2<=s1.x2 then
			call trace(h,s2.x1,s1.y1,s2.x2);
		else
			call trace(h,s2.x1,s1.y1,s1.x2);
	   fi;  fi;  
	else
	   if s1.x1=s2.x1 then     
		if s2.y1<=s1.y2 then
			if s2.y2<=s1.y2 then
			 call trace(v,s2.x1,s2.y1,s2.y2);
			else
			 call trace(v,s2.x1,s2.y1,s1.y2);
	fi; fi; fi;     fi;
  else
    if s1.y1>=s2.y1 and s1.y2<=s2.y2 then
		   call trace('p',s2.x1,s1.y1,0);
    fi;                 
  fi;
  end intersection;

(* La procedure traitement parcours le tableau tri‚ et r‚alise un traitement  
diff‚rent selon s'il s'agit d'un segment horizontal ou d'un segment vertical *)
  unit traitement: procedure(tab:arrayof segment);
  var i,j:integer,b:boolean;
  var bst:arb;
  begin
     bst:=new arb;b:=false;bst.nb:=0;
     for i:=1 to upper(tab)
     do
       if tab(i).sens=h then
	  for j:=1 to upper(tab)
	  do 
	    if j<>i then 
	       if tab(i).x1<=tab(j).x1 then
		     if tab(i).x2>=tab(j).x2 or tab(i).x2>=tab(j).x1 then
			     call intersection(tab(i),tab(j));
		     fi;
	    fi;fi;
	   od;
       else
	   bst.nb:=bst.nb+1;b:=true;
       fi;
     od;
     call bst.insertion(tab,bst.nb,bst.tv);
     if b then call bst.Arb_parcours(bst.tv) fi;
  end traitement;
begin
	call traitement(tab);
	i:=inkey;
end;
(*************************************************************)
(* Cette procedure r‚alise le cadre dans lequel les segments,les intersections 
de segments et le dialogue avec l'utilisateur sont ‚cris *)
unit graphisme:procedure;
	begin
	   call cls;
	   call color(10);call move(0,0);
	   call hfill(640);call draw(0,250);
	   call hfill(640);call move(639,0);
	   call draw(639,349);call draw(0,349);
	   call draw(0,250);call color(15);
	   call move(40,10);call draw(40,210);
	   call hfill(599);
	   for i:=1 to 10
	   do 
		call move(38,210-20*i);
		call draw(42,210-20*i);
		call move(28,210-i*20);
		if (i/10)<1 then
			call hascii(48+i);
		else
			call move(20,210-i*20);
			call hascii(48+i/10);
			call move(28,210-i*20);
			call hascii(i-entier(i/10)*10+48);
		fi;
	   od;
	   call move(10,8);call outstring("Y");
	   call move(26,215);call outstring("0");
	   for i:= 1 to 28
	   do 
		call move(40+i*20,212);
		call draw(40+i*20,208);
		call move(33+i*20,218);
		if (i/10)<1 then
			call hascii(48+i);
		else
			call hascii(48+i/10);
			call move(40+i*20,218);
			call hascii(i-entier(i/10)*10+48);
		fi;
	   od;
	   call move(620,210);call outstring("X");
end;

(*************************************************************)
(* La procedure souris permet la saisie des segments … l'aide de la souris *)
unit souris:procedure(output tab:arrayof segment);
var i,j,n,h1,h2,v1,v2:integer,
    b:boolean;
begin
      call graphisme;
      call move(40,260);call color(15);
      call outstring("Appuyer sur le bouton de gauche pour la premiŠre coordonn‚es");
      call move(40,280);
      call outstring("puis sur le bouton de droite pour la seconde coordonn‚es.");
      call move (40,300);
      call outstring("Appuyer sur entr‚e pour continuer.");
      i:=inkey;
      call move(40,260);call color(15);
      call outstring("                                                            ");
      call move(40,280);
      call outstring("                                                         ");
      call move (40,300);
      call outstring("                                    ");
      pref MOUSE BLOCK
	      unit click:procedure (output x,y,z,t:integer);
		var p:integer,l,r,c:boolean;
	      begin
		call status(x,y,l,r,c);
		do
			call getpress(0,x,y,p,l,r,c);
			if l then
			  call move(x,y);x:=inxpos;y:=inypos;call point(x,y);
			fi;
			if r then exit fi;
		od;
		call status(z,t,l,r,c);
		do
			call getpress(1,z,t,p,l,r,c);
			if r then
			  call move(z,t);z:=inxpos;t:=inypos;call point(z,t);
			  exit;
			fi;
			if l then exit fi;
		od;
	      end click;
      begin
      b:=init(i);
      if b then 
      call showcursor;call setwindow(40,600,10,210);
      call defcursor(1,12,13);call move(40,260);
      call outstring("Entrer le nombre de segments(12 au maximum) : ");
      i:=inkey;call hascii(i);n:=i-48;
      if i<>13 then 
	   i:=inkey;
	   if i<>13 then
		call hascii(i);
		n:=10*n+i-48;
      fi;  fi;
      array tab dim(1:n);
      for i:=1 to n
      do
	tab(i):=new segment;
	call move(40,280);call color(i);
	call outstring("Entrer le sens du segment (h/v) : ");
	j:=inkey;tab(i).sens:=chr(j);call hascii(0);
	if tab(i).sens=h then
		call hascii(72);
		call click(tab(i).x1,tab(i).y1,tab(i).x2,tab(i).y2);
		tab(i).x1:=xconv_en_reel(tab(i).x1);
		tab(i).x2:=xconv_en_reel(tab(i).x2);
		tab(i).y1:=yconv_en_reel(tab(i).y1);
		tab(i).y2:=yconv_en_reel(tab(i).y2);
		tab(i).y2:=tab(i).y1;
		if tab(i).x1>tab(i).x2 then
			j:=tab(i).x1;
			tab(i).x1:=tab(i).x2;
			tab(i).x2:=j;
		fi;
		call move(xconv_en_entier(tab(i).x1),yconv_en_entier(tab(i).y1));
		call draw(xconv_en_entier(tab(i).x2),yconv_en_entier(tab(i).y2));
	else 
		call hascii(86);
		call click(tab(i).x1,tab(i).y1,tab(i).x2,tab(i).y2);
		tab(i).x1:=xconv_en_reel(tab(i).x1);
		tab(i).x2:=xconv_en_reel(tab(i).x2);
		tab(i).y1:=yconv_en_reel(tab(i).y1);
		tab(i).y2:=yconv_en_reel(tab(i).y2);
		tab(i).x2:=tab(i).x1;
		if tab(i).y1>tab(i).y2 then
			j:=tab(i).y1;
			tab(i).y1:=tab(i).y2;
			tab(i).y2:=j;
		fi;
		call move(xconv_en_entier(tab(i).x1),yconv_en_entier(tab(i).y1));
		call draw(xconv_en_entier(tab(i).x2),yconv_en_entier(tab(i).y2));
	fi;
      od;
      else
	call move(100,200);call outstring(" NO M O U S E "); 
      fi;
      end;
end souris;

(*************************************************************)
(* La procedure clavier est appel‚e si le choix "saisie au clavier" est s‚lectionner". *) 

unit clavier:procedure(output tab:arrayof segment);
var i,j,n:integer;
begin
      call graphisme;call move(40,260);
      call outstring("Entrer le nombre de segments(12 au maximum) : ");
      n:=inkey;call hascii(n);n:=n-48;
      j:=inkey;if j<>13 then 
		  n:=10*n+j-48;
		  call hascii(j);
	       fi;
      array tab dim(1:n);
      for i:=1 to n
      do
	tab(i):=new segment;
	call move(40,275);call color(i);
	call outstring("Entrer le sens du segment (h/v) : ");
	j:=inkey;tab(i).sens:=chr(j);call hascii(0);
	if tab(i).sens=h then
		call hascii(72);
		call tab(i).saisie(tab(i).sens,tab(i).x1,tab(i).y1,tab(i).x2,tab(i).y2);
	else 
		call hascii(86);
		call tab(i).saisie(tab(i).sens,tab(i).x1,tab(i).y1,tab(i).x2,tab(i).y2);
	fi;
      od;
end clavier;

(*************************************************************)
(* Menu principal *)
unit menu:procedure;
    var choix:integer;
    (* Sous-menu du choix num‚ro 2 du menu principal *)
    unit menu2:procedure;
    var choix:integer;
    begin
	call graphisme;
	call move(40,260);call outstring(" Choix du mode de saisie :");
	call move(80,275);call outstring("1- au clavier.");
	call move(80,290);call outstring("2- avec la souris.");
	call move(80,305);call outstring("3- retour au menu principal");
	call move(40,325);call outstring("Votre choix : ");
	choix:=inkey;call hascii(choix);choix:=choix-48;
	case choix
		when 1 :do
			  call clavier(tab);
			  call tri(tab,t);
			  call parcours(t);
			  call menu2;
			  exit;
			od;
		when 2 : do
			   call souris(tab);
			   call tri(tab,t);
			   call parcours(t);
			   call menu2;
			   exit;
			od;
		when 3 : do
			   call move(150,325);
			   call outstring("retour au menu principal");
			   i:=inkey;
			   exit;
			od;
		otherwise call menu2;
	esac;
    end menu2;
    
    unit choix_alea : procedure(output tab:arrayof segment);
	var nb_seg,nb_segh,nb_segv,i,j,k:integer,x1,x2,y1,y2:real;
	begin
	  j:=0;
	  call ranset(1);
	  nb_seg:=2+entier(10*random);
	  array tab dim (1:nb_seg);
	  k:=0;
	  nb_segh:=entier(nb_seg*random);
	  (* nombre de segments horizontaux *)
	  for i:=1 to nb_segh
	  do
		y1:=10*random;y2:=y1;j:=j+1;call color(j);
		x1:=28*random;x2:=28*random;
		tab(j):=new segment;tab(j).sens:=h;
		tab(j).x1:=x1;tab(j).x2:=x2;
		tab(j).y1:=y1;tab(j).y2:=y2;
		if tab(i).x1>tab(i).x2 then 
			k:=tab(i).x1;tab(i).x1:=tab(i).x2;tab(i).x2:=k;
		fi;
		if tab(i).y1>tab(i).y2 then 
			k:=tab(i).y1;tab(i).y1:=tab(i).y2;tab(i).y2:=k;
		fi;
		call point(xconv_en_entier(tab(i).x1),yconv_en_entier(tab(i).y1));
		call draw(xconv_en_entier(tab(i).x2),yconv_en_entier(tab(i).y1));
	  od;
	  nb_segv:=nb_seg-nb_segh;
	  for i:=1 to nb_segv
	  do
		x1:=28*random;x2:=x1;j:=j+1;call color(j);
		y1:=10*random;y2:=10*random;
		tab(j):=new segment;tab(j).sens:=v;
		tab(j).x1:=x1;tab(j).x2:=x2;
		tab(j).y1:=y1;tab(j).y2:=y2;
		if tab(j).x1>tab(j).x2 then 
			k:=tab(j).x1;tab(j).x1:=tab(j).x2;tab(j).x2:=k;
		fi;
		if tab(j).y1>tab(j).y2 then 
			k:=tab(j).y1;tab(j).y1:=tab(j).y2;tab(j).y2:=k;
		fi;
		call point(xconv_en_entier(tab(j).x1),yconv_en_entier(tab(j).y1));
		call draw(xconv_en_entier(tab(j).x1),yconv_en_entier(tab(j).y2));
	  od;
    end choix_alea;
begin
	  call cls;
	  call move(300,0);call color(10);call outstring("MENU");
	  call move(60,60);call color(15);
	  call outstring("1- choix al‚atoire de segments.");
	  call move(60,100);
	  call outstring("2- choix des segments par l'utilisateur.");
	  call move(60,140);call outstring("3- fin du programme.");
	  call move(60,220);call outstring("Votre choix :");
	  choix:=inkey;call hascii(choix);choix:=choix-48;
	  case choix
	when 1:do 
		call graphisme;
		call choix_alea(tab);
		call tri(tab,t);
		call parcours(t);
		call menu;
		exit;
	       od;
	when 2:do
		call menu2;
		call menu;exit;
	       od;
	when 3:do
		 call cls;
		 call move(250,50);
		 call outstring("FIN DU PROGRAMME");
		 exit;
	       od;
	otherwise call menu;
	  esac;
end menu;

(*************************************************************)
(* Programme principal *)
begin
call gron(nocard);
call menu;
i:=inkey;
call groff;
end;
end projet;