# This package loads all the non-GUI Slic3r perl packages.
# In addition, it implements utility functions for file handling and threading.

package Slic3r;

# Copyright holder: Alessandro Ranellucci
# This application is licensed under the GNU Affero General Public License, version 3

use strict;
use warnings;
use Config;
require v5.10;

our $VERSION = VERSION();
our $BUILD = BUILD();
our $FORK_NAME = FORK_NAME();

our $debug = 0;
sub debugf {
    printf @_ if $debug;
}

our $loglevel = 0;

# load threads before Moo as required by it
our $have_threads;
BEGIN {
    # Test, whether the perl was compiled with ithreads support and ithreads actually work.
    use Config;
    $have_threads = $Config{useithreads} && eval "use threads; use threads::shared; use Thread::Queue; 1";
    warn "threads.pm >= 1.96 is required, please update\n" if $have_threads && $threads::VERSION < 1.96;
    
    ### temporarily disable threads if using the broken Moo version
    use Moo;
    $have_threads = 0 if $Moo::VERSION == 1.003000;

    # Disable multi threading completely by an environment value.
    # This is useful for debugging as the Perl debugger does not work
    # in multi-threaded context at all.
    # A good interactive perl debugger is the ActiveState Komodo IDE
    # or the EPIC http://www.epic-ide.org/
    $have_threads = 0 if (defined($ENV{'SLIC3R_SINGLETHREADED'}) && $ENV{'SLIC3R_SINGLETHREADED'} == 1);
    print "Threading disabled\n" if !$have_threads;

    $debug = 1 if (defined($ENV{'SLIC3R_DEBUGOUT'}) && $ENV{'SLIC3R_DEBUGOUT'} == 1);
    print "Debugging output enabled\n" if $debug;
}

warn "Running Slic3r under Perl 5.16 is neither supported nor recommended\n"
    if $^V == v5.16;

use FindBin;
# Path to the images.
our $var = sub { decode_path($FindBin::Bin) . "/var/" . $_[0] };

use Moo 1.003001;

use Slic3r::XS;   # import all symbols (constants etc.) before they get parsed
use Slic3r::Config;
use Slic3r::ExPolygon;
use Slic3r::ExtrusionLoop;
use Slic3r::ExtrusionPath;
use Slic3r::Flow;
use Slic3r::GCode::Reader;
use Slic3r::Geometry qw(PI);
use Slic3r::Geometry::Clipper;
use Slic3r::Layer;
use Slic3r::Line;
use Slic3r::Model;
use Slic3r::Point;
use Slic3r::Polygon;
use Slic3r::Polyline;
use Slic3r::Print;
use Slic3r::Print::Object;
use Slic3r::Print::Simple;
use Slic3r::Surface;
our $build = eval "use Slic3r::Build; 1";
use Thread::Semaphore;
use Encode::Locale 1.05;
use Encode;
use Unicode::Normalize;

# Scaling between the float and integer coordinates.
# Floats are in mm.
use constant SCALING_FACTOR         => 0.000001;
use constant LOOP_CLIPPING_LENGTH_OVER_NOZZLE_DIAMETER => 0.15;

# Following constants are used by the infill algorithms and integration tests.
# Resolution to simplify perimeters to. These constants are now used in C++ code only. Better to publish them to Perl from the C++ code.
# use constant RESOLUTION             => 0.0125;
# use constant SCALED_RESOLUTION      => RESOLUTION / SCALING_FACTOR;
use constant INFILL_OVERLAP_OVER_SPACING  => 0.3;

# Keep track of threads we created. Each thread keeps its own list of threads it spwaned.
my @my_threads = ();
my @threads : shared = ();
my $pause_sema = Thread::Semaphore->new;
my $parallel_sema;
my $paused = 0;

# Set the logging level at the Slic3r XS module.
$Slic3r::loglevel = (defined($ENV{'SLIC3R_LOGLEVEL'}) && $ENV{'SLIC3R_LOGLEVEL'} =~ /^[1-9]/) ? $ENV{'SLIC3R_LOGLEVEL'} : 0;
set_logging_level($Slic3r::loglevel);

sub spawn_thread {
    my ($cb) = @_;
    
    my $parent_tid = threads->tid;
    lock @threads;
    
    @_ = ();
    my $thread = threads->create(sub {
        @my_threads = ();
        
        Slic3r::debugf "Starting thread %d (parent: %d)...\n", threads->tid, $parent_tid;
        local $SIG{'KILL'} = sub {
            Slic3r::debugf "Exiting thread %d...\n", threads->tid;
            $parallel_sema->up if $parallel_sema;
            kill_all_threads();
            Slic3r::thread_cleanup();
            threads->exit();
        };
        local $SIG{'STOP'} = sub {
            $pause_sema->down;
            $pause_sema->up;
        };
        $cb->();
    });
    push @my_threads, $thread->tid;
    push @threads, $thread->tid;
    return $thread;
}

# call this at the very end of each thread (except the main one)
# so that it does not try to free existing objects.
# at that stage, existing objects are only those that we 
# inherited at the thread creation (thus shared) and those 
# that we are returning: destruction will be handled by the
# main thread in both cases.
# reminder: do not destroy inherited objects in other threads,
# as the main thread will still try to destroy them when they
# go out of scope; in other words, if you're undef()'ing an 
# object in a thread, make sure the main thread still holds a
# reference so that it won't be destroyed in thread.
sub thread_cleanup {
    return if !$Slic3r::have_threads;
    
    if (threads->tid == 0) {
        warn "Calling thread_cleanup() from main thread\n";
        return;
    }

    # prevent destruction of shared objects
    no warnings 'redefine';
    *Slic3r::BridgeDetector::DESTROY        = sub {};
    *Slic3r::Config::DESTROY                = sub {};
    *Slic3r::Config::Full::DESTROY          = sub {};
    *Slic3r::Config::GCode::DESTROY         = sub {};
    *Slic3r::Config::Print::DESTROY         = sub {};
    *Slic3r::Config::PrintObject::DESTROY   = sub {};
    *Slic3r::Config::PrintRegion::DESTROY   = sub {};
    *Slic3r::Config::Static::DESTROY        = sub {};
    *Slic3r::ExPolygon::DESTROY             = sub {};
    *Slic3r::ExPolygon::Collection::DESTROY = sub {};
    *Slic3r::Extruder::DESTROY              = sub {};
    *Slic3r::ExtrusionLoop::DESTROY         = sub {};
    *Slic3r::ExtrusionMultiPath::DESTROY    = sub {};
    *Slic3r::ExtrusionPath::DESTROY         = sub {};
    *Slic3r::ExtrusionPath::Collection::DESTROY = sub {};
    *Slic3r::ExtrusionSimulator::DESTROY    = sub {};
    *Slic3r::Flow::DESTROY                  = sub {};
# Fillers are only being allocated in worker threads, which are not going to be forked.
# Therefore the Filler instances shall be released at the end of the thread.
#    *Slic3r::Filler::DESTROY                = sub {};
    *Slic3r::GCode::DESTROY                 = sub {};
    *Slic3r::GCode::PlaceholderParser::DESTROY = sub {};
    *Slic3r::GCode::Sender::DESTROY         = sub {};
    *Slic3r::GCode::Writer::DESTROY         = sub {};
    *Slic3r::Geometry::BoundingBox::DESTROY = sub {};
    *Slic3r::Geometry::BoundingBoxf::DESTROY = sub {};
    *Slic3r::Geometry::BoundingBoxf3::DESTROY = sub {};
    *Slic3r::Layer::PerimeterGenerator::DESTROY = sub {};
    *Slic3r::Line::DESTROY                  = sub {};
    *Slic3r::Linef3::DESTROY                = sub {};
    *Slic3r::Model::DESTROY                 = sub {};
    *Slic3r::Model::Object::DESTROY         = sub {};
    *Slic3r::Point::DESTROY                 = sub {};
    *Slic3r::Pointf::DESTROY                = sub {};
    *Slic3r::Pointf3::DESTROY               = sub {};
    *Slic3r::Polygon::DESTROY               = sub {};
    *Slic3r::Polyline::DESTROY              = sub {};
    *Slic3r::Polyline::Collection::DESTROY  = sub {};
    *Slic3r::Print::DESTROY                 = sub {};
    *Slic3r::Print::Object::DESTROY         = sub {};
    *Slic3r::Print::Region::DESTROY         = sub {};
    *Slic3r::Surface::DESTROY               = sub {};
    *Slic3r::Surface::Collection::DESTROY   = sub {};
    *Slic3r::Print::SupportMaterial2::DESTROY = sub {};
    *Slic3r::TriangleMesh::DESTROY          = sub {};
    return undef;  # this prevents a "Scalars leaked" warning
}

sub get_running_threads {
    return grep defined($_), map threads->object($_), @_;
}

sub kill_all_threads {
    # if we're the main thread, we send SIGKILL to all the running threads
    if (threads->tid == 0) {
        lock @threads;
        foreach my $thread (get_running_threads(@threads)) {
            Slic3r::debugf "Thread %d killing %d...\n", threads->tid, $thread->tid;
            $thread->kill('KILL');
        }
        
        # unlock semaphore before we block on wait
        # otherwise we'd get a deadlock if threads were paused
        resume_all_threads();
    }
    
    # in any thread we wait for our children
    foreach my $thread (get_running_threads(@my_threads)) {
        Slic3r::debugf "  Thread %d waiting for %d...\n", threads->tid, $thread->tid;
        $thread->join;  # block until threads are killed
        Slic3r::debugf "    Thread %d finished waiting for %d...\n", threads->tid, $thread->tid;
    }
    @my_threads = ();
}

sub pause_all_threads {
    return if $paused;
    lock @threads;
    $paused = 1;
    $pause_sema->down;
    $_->kill('STOP') for get_running_threads(@threads);
}

sub resume_all_threads {
    return unless $paused;
    lock @threads;
    $paused = 0;
    $pause_sema->up;
}

# Convert a Unicode path to a file system locale.
# The encoding is (from Encode::Locale POD):
# Alias       | Windows | Mac OS X     | POSIX
# locale_fs   | ANSI    | UTF-8        | nl_langinfo
# where nl_langinfo is en-US.UTF-8 on a modern Linux as well.
# So this conversion seems to make the most sense on Windows.
sub encode_path {
    my ($path) = @_;

    # UTF8 encoding is not unique. Normalize the UTF8 string to make the file names unique.
    # Unicode::Normalize::NFC() returns the Normalization Form C (formed by canonical decomposition followed by canonical composition).
    $path = Unicode::Normalize::NFC($path);
    $path = Encode::encode(locale_fs => $path);
    
    return $path;
}

# Convert a path coded by a file system locale to Unicode.
sub decode_path {
    my ($path) = @_;
    
    $path = Encode::decode(locale_fs => $path)
        unless utf8::is_utf8($path);
    
    # The filesystem might force a normalization form (like HFS+ does) so 
    # if we rely on the filename being comparable after the open() + readdir()
    # roundtrip (like when creating and then selecting a preset), we need to 
    # restore our normalization form.
    $path = Unicode::Normalize::NFC($path);
    
    return $path;
}

# Open a file by converting $filename to local file system locales.
sub open {
    my ($fh, $mode, $filename) = @_;
    return CORE::open $$fh, $mode, encode_path($filename);
}

sub tags {
    my ($format) = @_;
    $format //= '';
    my %tags;
    # End of line
    $tags{eol}     = ($format eq 'html') ? '<br>'   : "\n";
    # Heading
    $tags{h2start} = ($format eq 'html') ? '<b>'   : '';
    $tags{h2end}   = ($format eq 'html') ? '</b>'  : '';
    # Bold font
    $tags{bstart}  = ($format eq 'html') ? '<b>'    : '';
    $tags{bend}    = ($format eq 'html') ? '</b>'   : '';
    # Verbatim
    $tags{vstart}  = ($format eq 'html') ? '<pre>'  : '';
    $tags{vend}    = ($format eq 'html') ? '</pre>' : '';
    return %tags;
}

sub slic3r_info
{
    my (%params) = @_;
    my %tag = Slic3r::tags($params{format});
    my $out = '';
    $out .= "$tag{bstart}$Slic3r::FORK_NAME$tag{bend}$tag{eol}";
    $out .= "$tag{bstart}Version: $tag{bend}$Slic3r::VERSION$tag{eol}";
    $out .= "$tag{bstart}Build:   $tag{bend}$Slic3r::BUILD$tag{eol}";
    return $out;
}

sub copyright_info
{
    my (%params) = @_;
    my %tag = Slic3r::tags($params{format});
    my $out =
        'Copyright &copy; 2016 Vojtech Bubnik, Prusa Research. <br />' .
        'Copyright &copy; 2011-2016 Alessandro Ranellucci. <br />' .
        '<a href="http://slic3r.org/">Slic3r</a> is licensed under the ' .
        '<a href="http://www.gnu.org/licenses/agpl-3.0.html">GNU Affero General Public License, version 3</a>.' .
        '<br /><br /><br />' .
        'Contributions by Henrik Brix Andersen, Nicolas Dandrimont, Mark Hindess, Petr Ledvina, Y. Sapir, Mike Sheldrake and numerous others. ' .
        'Manual by Gary Hodgson. Inspired by the RepRap community. <br />' .
        'Slic3r logo designed by Corey Daniels, <a href="http://www.famfamfam.com/lab/icons/silk/">Silk Icon Set</a> designed by Mark James. ';
    return $out;
}

sub system_info
{
    my (%params) = @_;
    my %tag = Slic3r::tags($params{format});

    my $out = '';
    $out .= "$tag{bstart}Operating System:    $tag{bend}$Config{osname}$tag{eol}";
    $out .= "$tag{bstart}System Architecture: $tag{bend}$Config{archname}$tag{eol}";        
    if ($^O eq 'MSWin32') {
        $out .= "$tag{bstart}Windows Version: $tag{bend}" . `ver` . $tag{eol};
    } else {
        # Hopefully some kind of unix / linux.
        $out .= "$tag{bstart}System Version: $tag{bend}" . `uname -a` . $tag{eol};
    }
    $out .= $tag{vstart} . Config::myconfig . $tag{vend};
    $out .= "  $tag{bstart}\@INC:$tag{bend}$tag{eol}$tag{vstart}";
    foreach my $i (@INC) {
        $out .= "    $i\n";
    }
    $out .= "$tag{vend}";
    return $out;
}

# this package declaration prevents an ugly fatal warning to be emitted when
# spawning a new thread
package GLUquadricObjPtr;

1;