#!/usr/bin/perl -w

use constant epsilon => 1e-14;

# prostopadloscian_ograniczajacy($d, @p [,@b])
#   Procedura zwraca prostopadloscian ograniczajacy dla punktow @p w $d wymiarach.
#   @b to opcjonalny, wstepny prostopadloscian ograniczajacy, ktory moze byc uzyty
#   do utworzenia zbiorczego prostopadloscianu ograniczajacego zawierajacego
#   prostopadlosciany odnalezione przez wczesniejsze wywolania tej procedury
#   (ta funkcja jest wykorzystywana przez procedure 
#   prostopadloscian_ograniczajacy_punkty()).
#
#   Prostopadloscian ograniczajacy jest zwracany w postaci listy. Pierwsze
#   $d elementow to minimalne wspolrzedne, a ostatnie $d elementow to wspolrzedne
#   maksymalne.

sub prostopadloscian_ograniczajacy {
    my ( $d, @bb ) = @_; # $d to liczba wymiarow.
    # Usuniecie punktow i pozostawienie prostopadloscianu ograniczajacego.
    my @p = splice( @bb, 0, @bb - 2 * $d );

    @bb = ( @p, @p ) unless @bb;

    # Przeszukanie wszystkich wspolrzednych i zapamietanie ekstremow.
    for ( my $i = 0; $i < $d; $i++ ) {
        for ( my $j = 0; $j < @p; $j += $d ) {
            my $ij = $i + $j;
            # Minima.
            $bb[ $i      ] = $p[ $ij ] if $p[ $ij ] < $bb[ $i      ];
            # Maksima.
            $bb[ $i + $d ] = $p[ $ij ] if $p[ $ij ] > $bb[ $i + $d ];
        }
    }

    return @bb;
}

# prostopadloscian_ograniczajacy_przeciecie($d, @a, @b)
#   Procedura zwraca prawde, jesli podane prostopadlosciany @a i @b przecinaja
#   sie w $d wymiarach. Podprocedura wykorzystana przez funkcje 
#   przeciecie_prostych().

sub prostopadloscian_ograniczajacy_przeciecie {
    my ( $d, @bb ) = @_; # Liczba wymiarow i wspolrzedne prostopadloscianow.
    my @aa = splice( @bb, 0, 2 * $d ); # Pierwszy prostopadloscian.
    # (@bb to drugi prostopadloscian.)

    # Prostopadlosciany musza przecinac sie we wszystkich wymiarach.
    for ( my $i_min = 0; $i_min < $d; $i_min++ ) {
        my $i_max = $i_min + $d; # Indeks dla maksimum.
        return 0 if ( $aa[ $i_max ] + epsilon ) < $bb[ $i_min ];
        return 0 if ( $bb[ $i_max ] + epsilon ) < $aa[ $i_min ];
    }

    return 1;
}

# przeciecie_prostych( $x0, $y0, $x1, $y1, $x2, $y2, $x3, $y3 )
#
#    Procedura oblicza punkt przeciecia odcinkow
#    (x0,y0)-(x1,y1) i (x2,y2)-(x3,y3).
#
#    Mozliwe jest takze podanie czterech argumentow decydujacych 
#    o nachyleniu obu prostych oraz punktach przeciecia z osia y. Innymi slowy,
#    jesli obie proste zostana przedstawione jako y = ax+b, to nalezy podac
#    dwie wartosci 'a' i dwie wartosci 'b'.
#
#    Procedura przeciecie_prostych() zwraca trzy wartosci ($x, $y, $s) dla punktu
#    przeciecia, gdzie $x i $y to wspolrzedne tego punktu, a $s jest prawda, 
#    jesli odcinki przecinaja sie, lub falsz, jesli odcinki nie maja punktu
#    przeciecia (ale ekstrapolowane proste przecinalyby sie).
#
#    W innych przypadkach zwracany jest ciag opisujacy przyczyne, dla ktorej
#    odcinki nie przecinaja sie:
#      "poza prostopadloscianem ograniczajacym"
#      "rownolegle"
#      "rownolegle wspolliniowe"
#      "rownolegle poziome"
#      "rownolegle pionowe"
#    Ze wzgledu na kontrole prostopadloscianow ograniczajacych przypadki
#    "rownolegle poziome" i "rownolegle pionowe" nigdy nie wystepuja.
#    (Prostopadlosciany ograniczajace zostana omowione w dalszej czesci rozdzialu.)
#
sub przeciecie_prostych {
 my ( $x0, $y0, $x1, $y1, $x2, $y2, $x3, $y3 );

 if ( @_ == 8 ) {
     ( $x0, $y0, $x1, $y1, $x2, $y2, $x3, $y3 ) = @_;

     # Prostopadlosciany ograniczajace dziela proste na odcinki.
     # Procedura prostopadloscian_ograniczajacy() zostanie zdefiniowana
     # w dalszej czesci rozdzialu.
     my @prostokat_a = prostopadloscian_ograniczajacy( 2, $x0, $y0, $x1, $y1 );
     my @prostokat_b = prostopadloscian_ograniczajacy( 2, $x2, $y2, $x3, $y3 );

     # Po usunieciu tego testu odcinki stalyby sie nieskonczonymi prostymi.
     # Procedura prostopadloscian_ograniczajacy_przeciecie() zostanie zdefiniowana
     # w dalszej czesci rozdzialu.
     return "poza prostopadloscianem ograniczajacym"
         unless prostopadloscian_ograniczajacy_przeciecie( 2, @prostokat_a, @prostokat_b );
 } elsif ( @_ == 4 ) { # Forma parametryczna.
     $x0 = $x2 = 0;
     ( $y0, $y2 ) = @_[ 1, 3 ];
     # Nalezy pomnozyc przez 'mnoznik', aby uzyskac wystarczajaca wielkosc.
     my $abs_y0 = abs $y0;
     my $abs_y2 = abs $y2;
     my $mnoznik = 10 * ( $abs_y0 > $abs_y2 ? $abs_y0 : $abs_y2 );
     $x1 = $x3 = $mnoznik;
     $y1 = $_[0] * $x1 + $y0;
     $y3 = $_[2] * $x2 + $y2;
 }

 my ($x, $y);  # Jeszcze nieustalony punkt przeciecia.

 my $dy10 = $y1 - $y0; # dyPQ, dxPQ to roznice wspolrzednych
 my $dx10 = $x1 - $x0; # miedzy punktami P i Q.
 my $dy32 = $y3 - $y2;
 my $dx32 = $x3 - $x2;

 my $dy10z = abs( $dy10 ) < epsilon; # Czy roznica $dy10 jest zerowa?
 my $dx10z = abs( $dx10 ) < epsilon;
 my $dy32z = abs( $dy32 ) < epsilon;
 my $dx32z = abs( $dx32 ) < epsilon;

 my $dyx10;                            # Nachylenie.
 my $dyx32;

 $dyx10 = $dy10 / $dx10 unless $dx10z;
 $dyx32 = $dy32 / $dx32 unless $dx32z;

 # Po uzyskaniu wszystkich roznic i nachylen mozna wykonac rozpoznanie
 # specjalnych przypadkow z poziomymi i pionowymi prostymi.
 # Nachylenie rowne zero oznacza pozioma prosta.

 unless ( defined $dyx10 or defined $dyx32 ) {
     return "rownolegle pionowe";
 } elsif ( $dy10z and not $dy32z ) { # Pierwsza prosta pozioma.
     $y = $y0;
     $x = $x2 + ( $y - $y2 ) * $dx32 / $dy32;
 } elsif ( not $dy10z and $dy32z ) { # Druga prosta pozioma.
     $y = $y2;
     $x = $x0 + ( $y - $y0 ) * $dx10 / $dy10;
 } elsif ( $dx10z and not $dx32z ) { # Pierwsza prosta pionowa.
     $x = $x0;
     $y = $y2 + $dyx32 * ( $x - $x2 );
 } elsif ( not $dx10z and $dx32z ) { # Druga prosta pionowa.
     $x = $x2;
     $y = $y0 + $dyx10 * ( $x - $x0 );
 } elsif ( abs( $dyx10 - $dyx32 ) < epsilon ) {
     # Obie wartosci nachylenia sa zaskakujaco zblizone.
     # Prawdopodobnie jest to przypadek rownoleglych prostych wspolliniowych 
     # lub zwykle proste rownolegle.

     # Kontrola prostokatow ograniczajacych spowodowala juz odrzucenie
     # przypadkow "rownolegle poziome" i "rownolegle pionowe".

     my $ya = $y0 - $dyx10 * $x0;
     my $yb = $y2 - $dyx32 * $x2;

     return "rownolegle wspolliniowe" if abs( $ya - $yb ) < epsilon;
     return "rownolegle";
 } else {
     # Nie wystapil zaden specjalny przypadek.
     # Obie proste rzeczywiscie sie przecinaja.

     $x = ($y2 - $y0 + $dyx10*$x0 - $dyx32*$x2)/($dyx10 - $dyx32);
     $y = $y0 + $dyx10 * ($x - $x0);
 }

 my $h10 = $dx10 ? ($x - $x0) / $dx10 : ($dy10 ? ($y - $y0) / $dy10 : 1);
 my $h32 = $dx32 ? ($x - $x2) / $dx32 : ($dy32 ? ($y - $y2) / $dy32 : 1);

 return ($x, $y, $h10 >= 0 && $h10 <= 1 && $h32 >= 0 && $h32 <= 1);
} 

print "@{[przeciecie_prostych( 1, 1,  5, 5,  1, 4,  4, 1 )]}\n";
print "@{[przeciecie_prostych( 1, 1,  5, 5,  2, 4,  7, 4 )]}\n";
print "@{[przeciecie_prostych( 1, 1,  5, 5,  3, 0,  3, 6 )]}\n";
print "@{[przeciecie_prostych( 1, 1,  5, 5,  5, 2,  7, 2 )]}\n";
print     przeciecie_prostych( 1, 1,  5, 5,  4, 2,  7, 5 ), "\n";
print     przeciecie_prostych( 1, 1,  5, 5,  3, 3,  6, 6 ), "\n";

