program Seg;
begin;
pref IIUWGRAPH block;

unit Welcome : Ansi procedure ;
const X = 100 ,
      Y = 80 ,
      Height = 150 ,
      Width  = 80 ,
      Room   = 20;

var P : point ,
    i : integer ;
          
  unit DrawO : procedure( P : Point );
  begin
    call Move( P.X,P.Y );
    call Draw( P.X + Width , P.Y );
    call Draw( P.X + Width , P.Y + Height );
    call Draw( P.X , P.Y + Height );
    call Draw( P.X , P.Y );
  end;
  
  unit DrawD : procedure( P : Point );
  begin
    call DrawO( P );
    call Move( P.X + 2,P.Y );
    call Draw( P.X + 2 ,P.Y + Height );
  end;
  
  unit DrawC : procedure( P : point );
  begin
    call Move( P.X + Width ,P.Y );
    call Draw( P.X, P.Y );
    call Draw( P.X , P.Y + Height );
    call Draw( P.X + Width  , P.Y + Height );       
  end;
  
  unit  DrawI : procedure( P : point );
  begin
    call Move( P.X,P.Y );
    call Draw( P.X + 2, P.Y );
    call Draw( P.X + 2, P.Y + Height  );
    call Draw( P.X,P.Y + Height );
    call Draw( P.X, P.Y );
  end;
  
  unit  DrawN : procedure( P : point );
  begin 
    call Move( P.X , P.Y + Height );
    call Draw( P.X , P.Y );
    call Draw( P.X + Width , P.Y + Height );
    call Draw( P.X + Width , P.Y );
  end DrawN ;
  
  unit DrawK : procedure( P : point );
  begin
    call Move( P.X , P.Y );
    call Draw( P.X, P.Y + Height );
    call Move( P.X + Width , P.Y  );
    call Draw( P.X , P.Y  + Height div 2 );
    call Draw( P.X + Width , P.Y + Height );
  end;

  begin
    call Gron( 1 );
    P := new point ( X,Y );      
    call DrawO( P );    
    P.X := P.X + Width + Room;
    call DrawD( P );
    P.X := P.X + Width + Room ;
    call DrawC( P );
    P.X := P.X + Width + Room ;
    call DrawI( P );
    P.X := P.X + Room;
    call DrawN( P );
    P.X := P.X + Width + Room ;
    call DrawK( P );
    P.X := P.X + Width + Room ;
    call DrawI( P );
    P.Y := 300 ;
    P.X := 20;
    call MyWrite( P, "Copyright by Anna Wosinska " );
    i := inchar ;
    if i = Hlp then call Help ; fi ;
    call Groff;
  end Welcome;
    
    
      
      
unit Point : class ( X, Y : integer);
end Point;

unit Interval : class( x1, x2 : integer );
  
  unit Assign : procedure( y1,y2 : integer );

  begin
    if y1 > y2 then call Swap( y1,y2 ); fi; 
    x1 := y1;
    x2 := y2;
  end Assign;    

begin
    if x1 > x2 then call Swap ( x1,x2 ); fi;      
end Interval;    

unit Swap : procedure( inout y1,y2 : integer );
  var x : integer;
begin
  x := y1;
  y1 := y2;
  y2 := x;
end Swap;  

  unit Elem : class( Info : integer );
  var   next : Elem;
  end Elem ;
  
unit IncidList : class( Key : integer );
  var   Head : Elem;
    
  unit Into : procedure( i : integer );
  var Aux : Elem;
  
  begin
    if Head = none then
      Head := new Elem( i );
    else  
      Aux := new Elem( i );
      Aux.next := Head.next ;
      Head.next := Aux;
    fi;  
  end Into;
    
  unit KillList : procedure ;
  
    unit KL : procedure( inout u : Elem );
    begin
      if u <> none then
        if u.next = none then
          kill ( u );
        else 
         call KL( u.next );    
        fi;  
      fi;  
    end KL;
    
  begin  
    call KL( Head );
  end KillList ;
  
end IncidList;

unit Node : class( Key, Info : integer );
var l, r : node ;
end Node ;

unit BST : class ;
close Delete, Insert ;

  var root : node;

(* Nodes in this BST are sorted according to their Key value( k ) *)

  unit Insert : procedure( k,i : integer );
      
    unit Ins : procedure( inout u : node );
    begin
      if u <> none then
        if k <= u.Key then call Ins( u.l );
        else call Ins( u.r );
        fi;
      else
        u := new node( k, i );
      fi;
    end Ins;
    
  begin (* Insert *)
    call Ins( root );
  end Insert;
  
  unit Build : procedure(  P : integer);
  var i : integer;
  
  begin
    for i := 1 to Act do
      if Tree( P,i ) = 0  then exit ; 
      else
        if not Lines( Tree( P,i) ).Vertical then
          call Insert( Lines( Tree( P,i )).Pe.X , Tree( P,i ));
          call Insert( Lines( Tree( P,i )).Pb.X , Tree( P,i ));
        
        else
          (* Lines( Tree( P,i )).Vertical *)
          if Min( Lines( Tree( P,i )).Pb.Y , Lines( Tree( P,i )).Pe.Y ) = P 
          then
            call Insert( Lines( Tree( P,i )).Pb.X , Tree( P,i ));
          fi;  
        fi;  
      fi;
    od;
  end Build;
  

  unit Update : procedure( P : integer ) ;
  var i : integer ;
    
  begin
    for i := 1 to Act do
      if Tree( P,i ) = 0 then exit ; fi;
      
      if Lines( Tree( P,i )).Vertical then
        if Max( Lines( Tree( P,i )).Pb.Y , Lines( Tree( P,i )).Pe.Y ) = P 
        then
          call Delete( Lines( Tree( P,i )).Pb.X , Tree( P,i ) ) ;
        fi;
        
      else 
        call Delete( Lines( Tree( P,i )).Pb.X , Tree( P,i ) );
        call Delete( Lines( Tree( P,i )).Pe.X , Tree( P,i ) );    
     fi;
   od;
 end Update ;         
      
  
 unit Delete : procedure( k,i : integer );
  
   unit Del : procedure( inout u : node );
   var Q : node ;
      
     unit DelMax : procedure( inout v : node );
     begin
       if v.r <> none then call DelMax( v.r );
       else
         (* v.r = none *)
         Q.Key := v.Key;
         Q.Info := v.Info ;
         Q := v ;
         v := v.l ;
       fi;
     end;     
      
   begin
     if u <> none then
       if k < u.key then call Del ( u.l );
       else
         if k > u.key then call Del( u.r );
         else
           if i <> u.info then call Del( u.l );
           else
           (* k = u.key  *)
           (* i = u.info *)      
             Q := u;
             if u.r = none then u := u.l ;
             else
             (* u.r <> none *)
               if u.l = none then u := u.r ;
               else
               (* u.r <> none *)
               (* u.l <> none *)
                 call DelMax( Q.l );
                 kill(Q);
               (* Q = maximal in left subtree of u *)
               fi;
             fi;
           fi;       
         fi;
       fi;    
     fi;
   end Del;
        
    begin
      call Del ( root );
    end Delete ;      

  unit Range : procedure ( x1, x2, Index : integer );
  
    unit Ran : procedure( v : node );
      var tx1, tx2 : boolean;
      
    begin
      if v <> none then
        if x1 > x2 then call Swap( x1,x2 ); fi ;
        tx1 := v.Key >= x1;
        tx2 := v.Key <= x2;
        
(*         x1 < v.key < x2 *)
        if v.info = 0 then
          call Groff;
          writeln("v.info = 0 ");
          call Endrun  ;
        fi;
           
        if tx2 and tx1 then call Information( Index ).Into( v.info ) ;fi;
        
        if tx2 then call Ran( v.r ); fi;
      fi;  
    end Ran;
    
  begin (* Range *);
    call Ran( root );
  end Range;


           
end BST;


unit Murderer : procedure( T : BST );

  unit Killer : procedure( u : Node ); 
  begin
    if u <> none then
      if u.l <> none then
        call Killer( u.l );fi;
      if u.r <> none then 
        call Killer( u.r ); fi;
      kill( u );
    fi;
  end Killer;       
      
  begin
    if T <> none then 
      call Killer( T.Root );
    fi; 
end Murderer;

unit BuildTree : procedure;

  var j,i : integer; 
                  
begin
  array Tree dim ( MinY : MaxY );
  for i := MinY to MaxY do
    array Tree( i ) dim ( 1 : Act + 1 );
  od   ;
  
  for i := 1 to  Act do
    j := 1;
    while Tree( Lines( i ).Pb.Y,j ) <> 0 do j := j + 1 ; od;
    
    Tree( Lines( i ).Pb.Y, j ) := i ;
    
    if Lines( i ).Vertical  then 
      j := 1;
      while Tree( Lines( i ).Pe.Y,j ) <> 0 do j := j + 1; od;
      Tree( Lines( i ).Pe.Y, j ) := i ;
    fi;
  od;
end BuildTree ;       

unit Scan : procedure ;
var XTree : BST,
      Aux : Elem,
      k,l : integer ;
begin
  Xtree := new BST ;
  for k := MinY to  MaxY do
    if Tree( k,1 ) <> 0 then  
      call BegScanLine( k )    ;
      call XTree.Build( k ); 
      for l := 1 to Act do
        if Tree( k,l ) = 0 then exit ; fi;
        call XTree.Range( Lines( Tree( k,l)).Pb.X, Lines( Tree( k,l)).Pe.X ,
                          Tree( k,l ) );

        Aux := Information( Tree( k,l )).Head;
       block
      
handlers
  when conerror : call groff ;
                  writeln("k = ", k) ;
                  writeln("l = ", l) ;
                  if k < lower(Tree) orif k > upper(Tree)
                  orif l < lower(Tree(k)) orif l > upper(Tree(k)) then
                    writeln(" Excessed bounds of Tree    ") ;
                  else
                    writeln("Tree(k,l) = ", Tree(k,l));
                    writeln("Aux.Info = ", Aux.Info) ;
                    if Tree(k,l) < lower(Lines) 
                    orif Tree(k,l) > upper(Lines) 
                    orif Aux.Info < lower(Lines)
                    orif Aux.Info > upper(Lines) then
                      writeln("Excessed bounds of Lines, which are (", 
                              lower(Lines), ":", upper(Lines), ")") ;
                    fi ;
                  fi ;
                  call endrun ;
  end handlers ;                  
  begin        
        while Aux <> none  do
          call CrossPoint( Lines( Tree( k,l )),Lines( Aux.Info ));
          Aux := Aux.next;
        od;                            
   end ;
      od;

      call Xtree.Update( k );
(*      call kill ( Tree( k )); *)
      call EndScanLine( k ) ;
    fi;
  od;
  call Murderer( XTree );
end Scan ;    

unit ANSI : class;
 
 
  unit Inchar : IIUWgraph function : integer ;
      (*podaj nr znaku przeslanego z klawiatury *)
    var i : integer;
  begin
    do
      i := inkey;
      if i <> 0 then exit fi;
    od;
    result := i;
  end inchar;
 

end Ansi;

unit MyWrite : procedure( Pos : Point, Word : string );
var i : integer,
    A : arrayof char;
 
begin;
  A := unpack( Word );
  call Move( Pos.X, Pos.Y );
  for i := lower( A ) to upper( A ) do
    call HASCII( 0 );
    call HASCII( ord( A( i )));
  od;
  kill ( A ); 
end MyWrite;

unit Erase : procedure( Line : integer );
var Aux : Point;

begin
  Aux := new Point( Left + M, Line );
  call Mywrite(Aux,
     "                                                                    ");
  kill ( Aux );
end Erase;                                                      

unit Frame : procedure( P1, P2 : point );
begin
  call Move ( P1.X, P1.Y );
  call Draw ( P1.X, P2.Y );
  call Draw ( P2.X, P2.Y );
  call Draw ( P2.X, P1.Y );
  call Draw ( P1.X, P1.Y );
end Frame;

unit SysDraw : procedure;

  unit GradVert : procedure( P : Point, Number : integer  );
  var i,j : integer;
  
  begin
    call Move( P.X - M, P.Y );
    call Draw( P.X + M, P.Y );
     if Number < 10 then 
      call Move( P.X - 2 * M - LetDim  , P.Y - LetDim div 2 );
      call HASCII( 0 );
      call HASCII( Number + 48 );
    else 
      i := Number div 10; 
      j := Number - i * 10; 
      call Move( P.X - 2 * M - 2 * LetDim  , P.Y - LetDim div 2 );  
      call HASCII( 0 ); 
      call Hascii( i + 48 ); 
      call Move( P.X - 2 * M - LetDim  , P.Y - LetDim div 2 );   
      call Hascii( 0 ); 
      call Hascii( j + 48 ); 
    fi;
  end GradVert;
  
  unit GradHor : procedure( P : Point , Number : integer );
  var i,j : integer;
  
  begin
    call Move( P.X, P.Y - M );
    call Draw( P.X, P.Y + M );
    if Number < 10 then
      call Move( P.X - LetDim div 2, P.Y + 4 * M );
      call HASCII( 0 );
      call HASCII( Number + 48 );
    else
      i := Number div 10;
      j := Number - i * 10;
      call Move( P.X - LetDim div 2  , P.Y + 4 * M  );  
      call HASCII( 0 );
      call Hascii( i + 48 );
      call Hascii( 0 );
      call Hascii( j + 48 );
    fi;               
  end GradHor;

  unit ArVert : procedure( X, Y : integer);
  begin
    call Move( X - 2 * M, Y + 2 * M );
    call Draw( X, Y );
    call Draw( X + 2 * M, Y + 2 * M );
  end ArVert;
  
  unit ArHor : procedure( X,Y : integer );
  begin
    call Move( X - 2 * M, Y - 2 * M );
    call Draw( X, Y );
    call Draw( X - 2 * M, Y + 2 * M );
  end ArHor;
  
var i : integer,
    P : Point;    
             
begin
  call Move( LeftMargin,UpMargin );
  call Draw( LeftMargin, DimY - DownMargin );
  call Draw( DimX - RightMargin, DimY - DownMargin );
  call ArVert( LeftMargin, UpMargin );
  call ArHor( DimX - RightMargin, DimY - DownMargin ); 
  
call Move( LeftMargin - 2 * M - 2 * LetDim, DimY - DownMargin - LetDim div 2);
  call Hascii( 0 );
  call Hascii( 48 );
  call Hascii( 48 );
  
  P := new Point( LeftMargin, DimY - DownMargin );
  for i := MinX + 1 to MaxX  do
    P.X := P.X + Sc;
    call GradHor( P , i );     
  od;
  kill ( P );  
  
  P := new Point ( LeftMargin, DimY - DownMargin ); 
  for i := MinY + 1 to MaxY  do
    P.Y := P.Y - Sc;
    call GradVert( P , i );
  od;  
  kill ( P );
end SysDraw;

unit Segment : class( pb , pe : Point, Vert : boolean );
hidden Vert;

  unit Vertical : function : boolean;
  begin
    result := Vert ;
  end Vertical;

     
end Segment;

unit SegKill : procedure( inout S : Segment );
begin
  kill ( S.Pb );
  kill ( S.Pe );
  kill ( S );
end SegKill   ;

unit GenSeg : function : Segment ;

var   X1, Y1, X2, Y2  : integer;  
          
begin
  if Random < 0.5 then 
  (* Generates horizontal segment *)
    do
      X1 := Random * MaxX ;
      Y1 := Random * MaxY ;
      X2 := Random * MaxX ;
      Y2 := Y1;
      if X1 <> X2 and Y2 > MinX  then exit ; fi;
    od;
    result := new Segment( new Point( X1 ,Y1 ), new Point( X2,Y2 ),false);  
  else
    (* Generates vertical segment *)  
    do
      X1 := Random * MaxX ;
      Y1 := Random * MaxY ;
      X2 := X1;
      Y2 := Random * MaxY ;
      if Y1 <> Y2 and X2 > MinX then exit; fi;
    od; 
    result := new Segment( new Point( X1 ,Y1 ), new Point( X2,Y2 ),true);
  fi;

end GenSeg;

unit SegDraw : procedure( S : Segment );

begin;
  if S.Vertical then
    call Move( LeftMargin + Sc*S.Pb.X + M, DimY - ( Sc*S.Pb.Y + DownMargin));
    call Draw( LeftMargin + Sc*S.Pb.X - M, DimY - ( Sc*S.Pb.Y + DownMargin));  
    call Move( LeftMargin + Sc*S.Pb.X, DimY - ( Sc*S.Pb.Y + DownMargin));
    call Draw( LeftMargin + Sc*S.Pe.X, DimY - ( Sc*S.Pe.Y + DownMargin));
    call Move( LeftMargin + Sc*S.Pe.X + M, DimY - ( Sc*S.Pe.Y + DownMargin));    
    call Draw( LeftMargin + Sc*S.Pe.X - M, DimY - ( Sc*S.Pe.Y + DownMargin));
  else
    call Move( LeftMargin + Sc*S.Pb.X , DimY - ( Sc*S.Pb.Y + DownMargin) + M );
    call Draw( LeftMargin + Sc*S.Pb.X , DimY - ( Sc*S.Pb.Y + DownMargin) - M);  
    call Move( LeftMargin + Sc*S.Pb.X, DimY - ( Sc*S.Pb.Y + DownMargin));
    call Draw( LeftMargin + Sc*S.Pe.X, DimY - ( Sc*S.Pe.Y + DownMargin));
    call Move( LeftMargin + Sc*S.Pe.X , DimY - ( Sc*S.Pe.Y + DownMargin) + M);
    call Draw( LeftMargin + Sc*S.Pe.X , DimY - ( Sc*S.Pe.Y + DownMargin) - M);    
  fi;
end SegDraw;

unit KeyServer : Ansi procedure;
var PrevChar , i : integer;

begin
  while not  Over  do
    i := inchar;
      case i  
        when Esc    : call Escape;
        when NSys   : Over := true;
        when Hlp    : call Help;      
        when NewSeg  : if PrevChar <> NewSeg then call ClearWindow; fi;
                        Act := Act + 1;
                        Lines( Act ) := GenSeg;
                        call SegEdit( Act );
                        call SegDraw( Lines( Act ));                
                    
        when Termin : exit;
      
        when Enter :  call ClearWindow; 
                      call SegRead;
                    
        otherwise;
      esac;
      PrevChar := i;
  od;  
  call ClearWindow ;
end KeyServer ;

unit Pause : procedure( T : integer );
var i : integer;
begin
  for i := 1 to T do; od;
end Pause ;  
   

unit Help : Ansi procedure;
var   i : integer ,
    Aux : Point ;
begin;
  Aux := new Point( LeftMargin + Distance, DimY - Window + 2 * M )  ;
  call Clearwindow ;
call MyWrite
  ( Aux," Esc - terminates program,      Del - new system of coordinates ");
  Aux.Y := Aux.Y + LetDim + M ;
call Mywrite( Aux," Enter - generates new segment, End  - scanning             ");
  Aux.Y := Aux.Y + LetDim + M ;
call MyWrite( Aux," Space - you enter new segment                           ");
  kill ( Aux ) ;
  i := inchar ;
  call ClearWindow ;
end Help;

unit SegRead : procedure;


  unit ReadInteger : ANSI function : integer;

  
  var  X,Y,i, OrdN, j : integer,
               Number : arrayof integer;
(* i - liczba wprowadzonych znakow  *)
  begin
    array Number dim( 1 : NumbLenght );
    i:= 0 ;
    X := InXPos;
    Y := InYPos;
    do
      OrdN:=inchar;
      if i = NumbLenght or (OrdN < 48 and OrdN > 57) then exit fi;

      case OrdN
        when 48    :i:=i+1;
                    Number(i):=0;
        when 49    :i:=i+1;
                    Number(i):=1;
        when 50    :i:=i+1;
                    Number(i):=2;
        when 51    :i:=i+1;
                    Number(i):=3;
        when 52    :i:=i+1;
                    Number(i):=4;
        when 53    :i:=i+1;
                    Number(i):=5;
        when 54    :i:=i+1;
                    Number(i):=6;
        when 55    :i:=i+1;
                    Number(i):=7;
        when 56    :i:=i+1;
                    Number(i):=8;
        when 57    :i:=i+1;
                    Number(i):=9;
        when  8    :if i>0 then
                      Number( i ) := 0;
                      i := i - 1;
                    fi;
        when 13    :if i > 0 then exit fi ;

      esac;
       
      if Number( 1 ) <> 0 then
        call Move( X,Y );
        call hascii( 0 );
        call hascii(48+Number( 1 ));
        call hascii( 0 );

      fi;
      
      if i = 2 then
        call Move( X + LetDim, Y  ); 
        call hascii( 0 );
        call hascii( 48 + Number( 2 ));   
        call hascii( 0 );
      fi;  
   od;
   
   if Number( 1 ) = 0 and Number( 2 ) = 0 then
     call Move( X,Y );
     call hascii( 0 );
     call hascii( 48 );
     call hascii( 0 );          
   fi;  
   
   if i = 1 then result := Number( 1 );
   else
     result := 10 * Number( 1 ) + Number ( 2 );
   fi;
   kill( Number );
  end ReadInteger;
  
const StrLenght = 26;
   
var            Aux : Point,
    X1, X2, Y1, Y2 : integer;
    
begin
  Aux := new Point( LeftMargin + Distance, DimY - Window + 2 * M )  ;
  call MyWrite( Aux," ENTER NEW SEGMENT : X1 = " );
  X1 := ReadInteger;
  Aux.X := Aux.X + StrLenght * LetDim + NumbLenght * LetDim; 
  call MyWrite( Aux ," Y1 = " );
  Y1 := ReadInteger;
  
  Aux.X := Aux.X - (NumbLenght + 6) * LetDim;
  Aux.Y := Aux.Y + M + LetDim;
  call MyWrite( Aux, " X2 = " );
  X2 := ReadInteger;      
  Aux.X := Aux.X + (NumbLenght + 6 ) * LetDim ;
  call Mywrite( Aux, " Y2 = " );
  Y2 := ReadInteger;
  Aux.X := Aux.X - StrLenght * LetDim - NumbLenght * LetDim; 
  Aux.Y := Aux.Y + M + LetDim;
  if ( X1 <> X2 ) and ( Y1 <> Y2 ) then 
    call MyWrite( Aux," THIS SEGMENT IS NEITHER HORIZONTAL NOR VERTICAL ! ");
  else
    if X1 < MaxX and X2 < MaxX and Y1 < MaxY and Y2 < MaxY then
      Act := Act + 1;
      if X1 = X2 then
        Lines( Act ) := new Segment( new Point( X1,Y1 ),
                                     new Point( X2,Y2 ), true );
      else
        Lines( Act ) := new Segment( new Point( X1,Y1 ),
                                     new Point( X2,Y2 ), false );
      fi;
      call SegDraw( Lines( Act ));
    else
      call MyWrite( Aux," THE SEGMENT IS TOO BIG ! " );
    fi;
  fi;
  kill ( Aux );
end SegRead;

unit WriteInteger : procedure( Number : integer );
begin
  if Number < 10 then
    call HASCII( 0 );
    call HASCII( Number + 48 );
    call Hascii( 0 );
  else
    i := Number div 10;
    j := Number - i * 10;
    call HASCII( 0 );
    call Hascii( i + 48 );
    call Hascii( 0 );
    call Hascii( j + 48 );
  fi;               
end WriteInteger;
  
unit SegEdit : procedure( Cur : integer );


const StrLenght = 24;

var  Aux : Point;

begin;
  Aux := new Point( LeftMargin + Distance, DimY - Window + 2 * M );  
  call MyWrite( Aux," CURRENT SEGMENT :  ");
  call WriteInteger( Act );
    
  Aux.Y := Aux.Y + M + LetDim ;
  call Mywrite( Aux,"           BEGIN : X1 = ");
  call WriteInteger( Lines( Cur ).Pb.X );
  Aux.X := Aux.X + StrLenght * LetDim + NumbLenght * LetDim ;
  call MyWrite( Aux," Y1 = ");
  call WriteInteger( Lines( Cur ).Pb.Y );
  
  Aux.X := Aux.X - StrLenght * LetDim - NumbLenght * LetDim ;
  Aux.Y := Aux.Y + M + LetDim ;   
  call Mywrite( Aux,"             END : X2 = ");
  call WriteInteger( Lines( Cur ).Pe.X );
  Aux.X := Aux.X + StrLenght * LetDim + NumbLenght * LetDim ;
  call MyWrite( Aux," Y2 = ");
  call WriteInteger( Lines( Cur ).Pe.Y );
  kill ( Aux );
end SegEdit;

unit ClearWindow : procedure ;
var 
      Line, i : integer;
      
begin
  for i := 0 to (( Window - Down ) div LetDim) - 1 do
    call Erase( DimY - Window + i * LetDim + M );
  od;
end ClearWindow ;    

unit Escape : procedure;
begin;
  Over := true;
  Continue := false;
end Escape;



unit CrossPoint : procedure ( S1, S2 : segment ) ;
var X1,X2,X3,X4,Y1,Y2,Y3,Y4 : integer ;

begin
  if S1.Vertical then
    if not S2.Vertical then
     (* S1 is vertical and S2 is horizontal *)
      call Mark( S1.pe.X, S2.pe.Y); 
    else
      (* both S1 and S2 are vertical *)
      Y1 := min( S1.pb.Y, S1.pe.Y );
      Y2 := max( S1.pb.Y, S1.pe.Y );
      Y3 := min( S2.pb.Y, S2.pe.Y );
      Y4 := max( S2.pb.Y, S2.pe.Y );
      if not( Y1 = Y3 and Y2 = Y4 ) then 
        if Y2 > Y4 then
          if Y1 > Y3 then
            call Mark( S1.pb.X, Y4 );
            call Mark( S1.pb.X, Y1 );
          else
            call Mark( S1.pb.X, Y4 );
            call Mark( S1.pb.X, Y3 );  
          fi;  
        else
          if Y1 > Y3 then
            call Mark( S1.pb.X, Y2 );
            call Mark( S1.pb.X, Y1);
          else
            call Mark( S1.pb.X, Y2 );  
            call Mark( S1.pb.X, Y3);
          fi;  
        fi;    
      fi;
    fi;  
  else
      if S2.Vertical then
      (* S1 is horizontal and S2 is vertical *)
        call Mark( S2.Pb.X, S1.Pb.Y);
      else
        (* both are horizontal *) 
        X1 := min( S1.pb.X, S1.pe.X );
        X2 := max( S1.pb.X, S1.pe.X );
        X3 := min( S2.pb.X, S2.pe.X );
        X4 := max( S2.pb.X, S2.pe.X );
        if not( X1 = X3 and X2 = X4 ) then
          if X2 > X4 then
            if X3 > X1 then
              call Mark( X4, S1.pb.Y);
              call Mark( X3, S1.pb.Y);        
            else
              call Mark( X1, S1.pb.Y);
              call Mark( X4, S1.pb.Y);
            fi;  
          else
            if X3 > X1 then
              call Mark( X3, S1.pb.Y);
              call Mark( X2, S1.pb.Y);        
            else
              call Mark( X1, S1.pb.Y);  
              call Mark( X2, S1.pb.Y);
            fi;  
         fi;   
      fi;        
    fi;
  fi;
end CrossPoint ;      

unit Mark : procedure( input X,Y : integer );

begin
  if X >= 0 and Y >= 0 then
    x := X * Sc + LeftMargin ;
    y := DimY - ( DownMargin + Y * Sc ) ; 
    call cirb( x,y,R,1,1,1,0,1,1 );
  fi;  
end Mark;  

unit Min : function( x,y : integer ): integer ;
begin
  if x < y then result := x ;
  else result := y; fi;
end Min ;  

unit Max: function( x,y : integer ) : integer ;
begin
  if x < y then result := y ;
  else result := x; fi;
end Max ;

var         Aux : Point,   
      LongHLine : arrayof integer ;
      
unit  BegScanLine : procedure( y : integer );

begin
  call Move( LeftMargin , DimY - DownMargin - y * Sc );
  LongHLine:= GetMap( DimX - RightMargin, DimY - DownMargin - y * Sc) ;
  call Move( LeftMargin, DimY - DownMargin - y * Sc);
  call Draw(  DimX - RightMargin, DimY - DownMargin - y * Sc) ;
  Aux := new Point( LeftMargin + Distance, DimY - Window + 2 * M )  ;
  call MyWrite( Aux," SCANNING ... : ");
  call WriteInteger( y );
end BegScanLine ;   


unit  EndScanLine : procedure( y : integer );

begin
  call Move( LeftMargin, DimY - DownMargin - y * Sc);
  call PutMap( LongHLine );
  kill ( LongHLine );
  call Erase( Aux.Y );
  kill ( Aux );
end EndScanLine;
  


           
const
           NumbLenght = 2,
                DimX  = 619,
                DimY  = 348,
                   M  = 2,  
                   R  = 3,
              LetDim  = 8,
            Distance  = 20,     
              Window  = 40,
                Left  = 0,
               Right  = 0, 
                  Up  = 0,
                Down  = 2,    
          LeftMargin  = 25,
          RightMargin = 10,
          UpMargin    = 10,
          DownMargin  = 60,
          Sc          = 20,
          MaxX        = 29,
          MinX        = 0,
          MaxY        = 14,
          MinY        = 0,
          Esc         = 27, (* Escape *)
          Hlp         = - 59,  (* F1     *)
          NSys        = - 83,(* Del      *)
          Enter       = 13, (* enter  *)
          Termin      = - 79,(* End      *)
          NewSeg      = 32, (* space bar *)
          Numb        = 100;          


var        Tree   : arrayof arrayof integer ,
        Act, j, i : integer,
    Continue,Over : boolean,
      Information : arrayof IncidList,
            Lines : arrayof segment;
            
begin (* Seg *);
  call Welcome ;
  Continue := true;
  while Continue do
    Act := 0;
    Over := false;
    call Gron( 1 );
    call Frame( new Point( Left, Up ),
                new Point( DimX - Right, DimY - Window - M ));
    call Frame( new Point( Left, DimY - Window ),
                new Point( DimX - Right, DimY - Down )); 
    call SysDraw;
    array Lines dim( 1 : Numb );
    call KeyServer;
    if not Over and Act > 0 then
      call BuildTree;
      array Information dim ( 1 :  Act );
      for i := 1 to Act do
        Information( i ) := new IncidList( i );
      od;   
      call Scan;
      write( chr( 7 ));
      do
        i := inkey;
        if i <> 0 then exit; fi;
      od;  
      call Groff;
      if i = Esc then exit ; fi ;
    
      for i := 1 to  Act  do
        if Information( i ) <> none then
          call Information( i ). KillList;
        fi;  
      od;
      kill ( Information );
      for i:=1 to Act do
        call SegKill( Lines( i ));   
      od;
      kill ( Lines );  
      for i := MinY to MaxY do kill ( Tree( i )); od;
      kill ( Tree );
    fi;  
  od;    
  call Groff ;  
end  ;
end;