#!/usr/bin/perl

use strict;
use warnings;

use Devel::MAT;
use String::Tagged 0.15;  # sprintf
use String::Tagged::Terminal;

# Some tools might want to draw pretty graphs with line drawing / similar
STDOUT->binmode( ":encoding(UTF-8)" );
STDOUT->autoflush(1);

my $file = shift @ARGV or die "Need dumpfile\n";

my $progress = ( -t STDOUT ?
   sub { print "\r\e[K" . ( shift // "" ); } :
   undef
);

my $pmat = Devel::MAT->load( $file,
   progress => $progress,
);

$progress->() if $progress;

my $df = $pmat->dumpfile;

print "Perl memory dumpfile from perl ", $df->perlversion, "\n";
print "Heap contains ", scalar $df->heap, " objects\n";

sub Devel::MAT::Cmd::printf
{
   shift;
   my ( $fmt, @args ) = @_;

   my $str = String::Tagged::Terminal->from_sprintf( $fmt, @args );

   print $str->build_terminal;

   return length $str;
}

my @FG = (
   3, # yellow
   6, # cyan
   5, # magenta
);

sub Devel::MAT::Cmd::format_note
{
   shift;
   my ( $str, $idx ) = @_;
   $idx //= 0;

   return String::Tagged->new_tagged( $str,
      bold    => 1,
      fgindex => $FG[$idx % 3],
   );
}

sub Devel::MAT::Cmd::_format_sv
{
   shift;
   my ( $ret, $sv ) = @_;

   return String::Tagged->new_tagged( $ret, bold => 1, italic => 1 );
}

sub Devel::MAT::Cmd::_format_value
{
   shift;
   return String::Tagged->new_tagged( $_[0], fgindex => 5+8 );
}

sub Devel::MAT::Cmd::format_symbol
{
   shift;
   my ( $name ) = @_;

   return String::Tagged->new_tagged( $name,
      fgindex => 2,
   );
}

if( @ARGV ) {
   my $cmd = shift @ARGV;

   $pmat->load_tool_for_command( $cmd,
      progress => $progress,
   )->run_cmd( @ARGV );
   exit
}

require Term::ReadLine;
require Text::ParseWords;

my $rl = Term::ReadLine->new( 'pmat' );
while( defined( my $line = $rl->readline( 'pmat> ') ) ) {
   my ( $cmd, @args ) = Text::ParseWords::shellwords( $line );
   next unless defined $cmd; # blank line

   last if $cmd eq "exit";

   eval {
      # We just have to hope nobody catches this one.
      # It would be nice to  next COMMAND  but awkward perl internals reasons
      # mean we can't do that from a signal handler
      local $SIG{INT} = sub { die "\nAborted\n"; };

      $pmat->load_tool_for_command( $cmd,
         progress => $progress,
      )->run_cmd( @args );
      1;
   } or
      print STDERR "$@";

   print "\n";
}

print "\n";