#!/usr/bin/perl

use constant epsilon => 1e-14;

# przecinanie_prostych( $x0, $y0, $x1, $y1, $x2, $y2, $x3, $y3 )
#    Procedura zwraca prawde, jesli dwie linie proste zdefiniowane 
#    przez podane punkty przecinaja sie.
#    W przypadkach granicznych o wyniku decyduje wartosc epsilon.

sub przecinanie_prostych {

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

    my @prostokat_a = prostopadloscian_ograniczajacy( 2, $x0, $y0, $x1, $y1 );
    my @prostokat_b = prostopadloscian_ograniczajacy( 2, $x2, $y2, $x3, $y3 );

    # Jesli nawet prostopadlosciany ograniczajace nie przecinaja sie, to mozna
    # natychmiast przerwac prace procedury.

    return 0 unless prostopadloscian_ograniczajacy_przeciecie( 2, @prostokat_a, @prostokat_b );

    # Jesli znaki obu wyznacznikow (wartosci absolutnych lub dlugosci
    # iloczynow wektorowych) roznia sie, to proste przecinaja sie.

    my $dx10 = $x1 - $x0;
    my $dy10 = $y1 - $y0;

    my $wyzn_a = wyznacznik( $x2 - $x0, $y2 - $y0, $dx10, $dy10 );
    my $wyzn_b = wyznacznik( $x3 - $x0, $y3 - $y0, $dx10, $dy10 );

    return 1 if $wyzn_a < 0 and $wyzn_b > 0 or
                $wyzn_a > 0 and $wyzn_b < 0;

    if ( abs( $wyzn_a ) < epsilon ) {
        if ( abs( $wyzn_b ) < epsilon ) {
            # Oba iloczyny wektorowe sa zerowe.
            return 1;
        } elsif ( abs( $x3 - $x2 ) < epsilon and
                  abs( $y3 - $y2 ) < epsilon ) {
            # Jeden z iloczynow wektorowych ma wartosc zerowa,
            # a drugi wektor (od (x2,y2) do (x3,y3))
            # jest rowniez zerowy.
            return 1;
        }
    } elsif ( abs( $wyzn_b < epsilon ) ) {
        # Jeden z iloczynow wektorowych ma wartosc zerowa,
        # a drugi wektor jest rowniez zerowy.
        return 1 if abs( $dx10 ) < epsilon and abs( $dy10 ) < epsilon;
    }

    return 0; # Domyslny wynik to brak przeciecia.
}

print "Przeciecie\n"
    if     przecinanie_linii( 3, 0,  3, 6,  1, 1,  6, 6 );
print "Brak przeciecia\n"
    unless przecinanie_linii( 1, 1,  6, 6,  4, 2,  7, 5 );

# 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;
}

# wyznacznik( $x0, $y0, $x1, $y1 )
# Procedura oblicza wyznacznik dla czterech elementow macierzy
# podanych jako argumenty.
#
sub wyznacznik { $_[0] * $_[3] - $_[1] * $_[2] }



