package LDraw::Parser;

use strict;
use warnings;

sub new {
    my ($class, $args) = @_;
    die "file required" unless $args->{file};
    return bless({
        file => $args->{file},
        ldraw_path => $args->{ldraw_path} // '/usr/share/ldraw',
        scale => $args->{scale} // 1,
        mm_per_ldu => $args->{mm_per_ldu} // 0.4,
        invert => $args->{invert} // 0,
        debug => $args->{debug} // 0,
        d_indent => $args->{d_indent} // 0,
    }, $class);
}

sub _getter_setter {
    my ($self, $key, $value) = @_;
    if ($value) {
        $self->{$key} = $value;
    }
    return $self->{$key};
}

# The file to parse
sub file { return shift->_getter_setter('file', @_); }

# Where to find ldraw files
sub ldraw_path { return shift->_getter_setter('ldraw_path', @_); }

# Scale the model
sub scale { return shift->_getter_setter('scale', @_); }

# Number of mm per LDU (LDraw Unit)
sub mm_per_ldu { return shift->_getter_setter('mm_per_ldu', @_); }

# Invert this part
sub invert { return shift->_getter_setter('invert', @_); }

# Print debugging messages to stderr
sub debug { return shift->_getter_setter('debug', @_); }

# Indentation for debug messages (for subfiles)
sub d_indent { return shift->_getter_setter('d_indent', @_); }

use constant X => 0;
use constant Y => 1;
use constant Z => 2;

sub DEBUG {
    my ( $self, $message, @args) = @_;
    return if !$self->debug;
    my $indent = " " x $self->d_indent;
    if ( @args ) {
        $message = sprintf($message, @args);
    }
    print STDERR sprintf("%s%s\n", $indent, $message);
}

sub parse {
    my ( $self ) = @_;
    return $self->parse_file( $self->file );
}

sub parse_file {
    my ( $self, $file ) = @_;
    open( my $fh, '<', $file ) || die "$file: $!";
    $self->parse_handle( $fh );
    close $fh;
}

sub parse_handle {
    my ( $self, $handle ) = @_;
    while ( my $line = <$handle> ) {
        chomp $line;
        $self->parse_line( $line );
    }
}

sub parse_line {
    my ( $self, $line ) = @_;

    $line =~ s/^\s+//;

    if ( $line =~ /^([0-9]+)\s+(.+)$/ ) {
        my ( $line_type, $rest ) = ( $1, $2 );
        if ( $line_type == 0 ) {
            $self->parse_comment_or_meta( $rest );
        }
        elsif ( $line_type == 1 ) {
            $self->parse_sub_file_reference( $rest );
            $self->invert( 0 );
        }
        elsif ( $line_type == 2 ) {
            $self->parse_line_command( $rest );
        }
        elsif ( $line_type == 3 ) {
            $self->parse_triange_command( $rest );
        }
        elsif ( $line_type == 4 ) {
            $self->parse_quadrilateral_command( $rest );
        }
        elsif ( $line_type == 5 ) {
            $self->parse_optional( $rest );
        }
        else {
            warn "unhandled line type: $line_type";
        }
    }
}

sub parse_comment_or_meta {
    my ( $self, $rest ) = @_;
    my @items = split( /\s+/, $rest );
    my $first = shift @items;

    if ( $first && $first eq 'BFC' ) {
        $self->handle_bfc_command( @items );
    }
}

sub handle_bfc_command {
    my ( $self, @items ) = @_;

    my $first = shift @items;

    if ( $first && $first eq 'INVERTNEXT' ) {
        $self->invert( 1 );
        $self->DEBUG('handle_bfc_command(): inverted model');
    }
}

sub parse_sub_file_reference {
    my ( $self, $rest ) = @_;
    # 16 0 -10 0 9 0 0 0 1 0 0 0 -9 2-4edge.dat
    my @items = split( /\s+/, $rest );
    my $color = shift @items;
    my $x = shift @items;
    my $y = shift @items;
    my $z = shift @items;
    my $a = shift @items;
    my $b = shift @items;
    my $c = shift @items;
    my $d = shift @items;
    my $e = shift @items;
    my $f = shift @items;
    my $g = shift @items;
    my $h = shift @items;
    my $i = shift @items;

#    / a d g 0 \   / a b c x \
#    | b e h 0 |   | d e f y |
#    | c f i 0 |   | g h i z |
#    \ x y z 1 /   \ 0 0 0 1 /

    my $mat = [
        $a, $b, $c, $x,
        $d, $e, $f, $y,
        $g, $h, $i, $z,
        0, 0, 0, 1,
    ];

    if ( scalar( @items ) != 1 ) {
        warn "um, filename is made up of multiple parts (or none)";
    }

    my $filename = lc( $items[0] );
    $filename =~ s/\\/\//g;

    my $p_filename = join( '/', $self->ldraw_path, 'p', $filename );
    my $hires_filename = join( '/', $self->ldraw_path, 'p/48', $filename );
    my $parts_filename = join( '/', $self->ldraw_path, 'parts', $filename );
    my $models_filename = join( '/', $self->ldraw_path, 'models', $filename );

    my $subpart_filename;
    if ( -e $hires_filename ) {
        $subpart_filename = $hires_filename;
    }
    elsif ( -e $p_filename ) {
        $subpart_filename = $p_filename;
    }
    elsif (-e $parts_filename ) {
        $subpart_filename = $parts_filename;
    }
    elsif ( -e $models_filename ) {
        $subpart_filename = $models_filename;
    }
    else {
        warn "unable to find file: $filename in normal paths";
        return;
    }

    $self->DEBUG('parse_sub_file_reference(): parsing subfile "%s" with inverted: %d', $subpart_filename, $self->invert);
    my $subparser = __PACKAGE__->new( {
        file       => $subpart_filename,
        ldraw_path => $self->ldraw_path,
        invert     => $self->invert,
        debug      => $self->debug,
        d_indent   => $self->d_indent + 2,
    } );
    $subparser->parse;

    for my $triangle ( @{ $subparser->{triangles} } ) {
        for my $vec ( @{ $triangle } ) {
            my @new_vec = max4xv3( $mat, $vec );
            $vec->[0] = $new_vec[0];
            $vec->[1] = $new_vec[1];
            $vec->[2] = $new_vec[2];
        }
        push @{ $self->{triangles} }, $triangle;
    }
}

sub parse_line_command {
    my ( $self, $rest ) = @_;
}

sub parse_triange_command {
    my ( $self, $rest ) = @_;
    # 16 8.9 -10 58.73 6.36 -10 53.64 9 -10 55.5
    my @items = split( /\s+/, $rest );
    my $color = shift @items;
    my $p1 = [ $items[0], $items[1], $items[2] ];
    my $p2 = [ $items[3], $items[4], $items[5] ];
    my $p3 = [ $items[6], $items[7], $items[8] ];
    my $n = [ $self->calc_surface_normal( $p1, $p2, $p3 ) ];
    push @{ $self->{triangles} }, [ $p1, $p2, $p3, $n ];
}

sub parse_quadrilateral_command {
    my ( $self, $rest ) = @_;
    # 16 1.27 10 68.9 -6.363 10 66.363 10.6 10 79.2 7.1 10 73.27
    my @items = split( /\s+/, $rest );
    my $color = shift @items;
    my $x1 = shift @items;
    my $y1 = shift @items;
    my $z1 = shift @items;
    my $x2 = shift @items;
    my $y2 = shift @items;
    my $z2 = shift @items;
    my $x3 = shift @items;
    my $y3 = shift @items;
    my $z3 = shift @items;
    my $x4 = shift @items;
    my $y4 = shift @items;
    my $z4 = shift @items;
    my $na = [ $self->calc_surface_normal( [ $x1, $y1, $z1 ], [ $x2, $y2, $z2 ], [ $x3, $y3, $z3 ] ) ];
    my $nb = [ $self->calc_surface_normal( [ $x3, $y3, $z3 ], [ $x4, $y4, $z4 ], [ $x1, $y1, $z1 ] ) ];
    push @{ $self->{triangles} }, [
        [ $x1, $y1, $z1 ],
        [ $x2, $y2, $z2 ],
        [ $x3, $y3, $z3 ],
        $na,
    ];
    push @{ $self->{triangles} }, [
        [ $x3, $y3, $z3 ],
        [ $x4, $y4, $z4 ],
        [ $x1, $y1, $z1 ],
        $nb,
    ];
}

sub WTF_parse_quadrilateral_command {
    my ( $self, $rest ) = @_;
    # 16 1.27 10 68.9 -6.363 10 66.363 10.6 10 79.2 7.1 10 73.27
    my @items = split( /\s+/, $rest );
    my $color = shift @items;
    my $p1 = [ $items[0], $items[1], $items[2] ];
    my $p2 = [ $items[3], $items[4], $items[5] ];
    my $p3 = [ $items[6], $items[7], $items[8] ];
    my $p4 = [ $items[9], $items[10], $items[11] ];
    my $na = [ $self->calc_surface_normal( $p1, $p2, $p3 ) ];
    my $nb = [ $self->calc_surface_normal( $p3, $p4, $p1 ) ];
    push @{ $self->{triangles} }, [ $p1, $p2, $p3, $na ];
    push @{ $self->{triangles} }, [ $p3, $p4, $p1, $nb ];
}

sub parse_optional {
    my ( $self, $rest ) = @_;
}

sub calc_surface_normal {
    my ( $self, $ip1, $ip2, $ip3 ) = @_;

    my ( $p1, $p2, $p3 ) = ( $ip1, $ip2, $ip3 );
    if ( $self->invert ) {
        ( $p1, $p2, $p3 ) = ( $ip1, $ip3, $ip2 );
    }

    my ( $N, $U, $V ) = ( [], [], [] );

    $U->[X] = $p2->[X] - $p1->[X];
    $U->[Y] = $p2->[Y] - $p1->[Y];
    $U->[Z] = $p2->[Z] - $p1->[Z];

    $V->[X] = $p3->[X] - $p1->[X];
    $V->[Y] = $p3->[Y] - $p1->[Y];
    $V->[Z] = $p3->[Z] - $p1->[Z];

    $N->[X] = $U->[Y] * $V->[Z] - $U->[Z] * $V->[Y];
    $N->[Y] = $U->[Z] * $V->[X] - $U->[X] * $V->[Z];
    $N->[Z] = $U->[X] * $V->[Y] - $U->[Y] * $V->[X];

    return ( $N->[X], $N->[Y], $N->[Z] );
}

sub max4xv3 {
    my ( $mat, $vec ) = @_;

    my ( $a1, $a2, $a3, $a4,
         $b1, $b2, $b3, $b4,
         $c1, $c2, $c3, $c4 ) = @{ $mat };

    my ( $x_old, $y_old, $z_old ) = @{ $vec };

    my $x_new = $a1 * $x_old + $a2 * $y_old + $a3 * $z_old + $a4;
    my $y_new = $b1 * $x_old + $b2 * $y_old + $b3 * $z_old + $b4;
    my $z_new = $c1 * $x_old + $c2 * $y_old + $c3 * $z_old + $c4;

    return ( $x_new, $y_new, $z_new );
}

sub to_stl {
    my ( $self ) = @_;

    my $scale = $self->scale || 1;
    my $mm_per_ldu = $self->mm_per_ldu;

    my $stl = "";
    $stl .= "solid GiantLegoRocks\n";

    for my $triangle ( @{ $self->{triangles} } ) {
        my ( $p1, $p2, $p3, $n ) = @{ $triangle };
        $stl .= "facet normal " . join( ' ', map { sprintf( '%0.4f', $_ ) } @{ $n } ) . "\n";
        $stl .= "    outer loop\n";
        for my $vec ( ( $p1, $p2, $p3 ) ) {
            my @transvec = map { sprintf( '%0.4f', $_ ) } map { $_ * $mm_per_ldu * $scale } @{ $vec };
            $stl .= "        vertex " . join( ' ', @transvec ) . "\n";
        }
        $stl .= "    endloop\n";
        $stl .= "endfacet\n";
    }

    $stl .= "endsolid GiantLegoRocks\n";

    return $stl;
}

1;