The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

package App::Asciio ;

$|++ ;

use strict;
use warnings;

use File::Slurp ;
use Compress::Bzip2 qw(:all :utilities :gzip);
use Sereal qw(
    get_sereal_decoder
    get_sereal_encoder
    clear_sereal_object_cache
 
    encode_sereal
    decode_sereal
) ;

#-----------------------------------------------------------------------------

sub pop_undo_buffer
{
my ($self, $number_of_steps) = @_;

pop @{$self->{DO_STACK}} for(1 .. $number_of_steps) ;
}

#-----------------------------------------------------------------------------

sub redo
{
my ($self, $number_of_steps) = @_;

$self->{DO_STACK_POINTER} += $number_of_steps ;

if($self->{DO_STACK_POINTER} >= @{$self->{DO_STACK}})
	{
	$self->{DO_STACK_POINTER} = @{$self->{DO_STACK}} - 1 ;
	}

$self->do($self->{DO_STACK_POINTER}) ;
}

#-----------------------------------------------------------------------------

sub undo
{
my ($self, $number_of_steps) = @_;

(my $new_stack_pointer = $self->{DO_STACK_POINTER}) -= $number_of_steps ;

$new_stack_pointer = 0 if $new_stack_pointer < 0 ;

$self->{DO_STACK} //= [] ;

if($self->{DO_STACK_POINTER} == @{$self->{DO_STACK}})
	{
	$self->create_undo_snapshot() ;
	}

$self->{DO_STACK_POINTER} = $new_stack_pointer ;

$self->do($new_stack_pointer) ;
}

#-----------------------------------------------------------------------------

sub do
{
my ($self, $stack_pointer) = @_;

my $new_self = $self->{DO_STACK}[$stack_pointer] ;

if(defined $new_self)
	{
	my ($do_stack_pointer, $do_stack) = ($self->{DO_STACK_POINTER}, $self->{DO_STACK}) ;
	
	$self->{CACHE}{DECODER} = my $decoder = $self->{CACHE}{DECODER} // get_sereal_decoder() ;
	
	my $saved_self = $decoder->decode($new_self) ;
	
	if($@)
		{
		write_file('undo_error.pl', {binmode => ':utf8'}, $saved_self) ;
		die "Can't undo! $@\n" ;
		}
	else
		{
		$self->load_self($saved_self) ;
		($self->{DO_STACK_POINTER}, $self->{DO_STACK}) = ($do_stack_pointer, $do_stack) ;
		$self->set_modified_state(1) ;
		
		$self->update_display() ;
		}
	}
else
	{
	$self->set_modified_state(0) ;
	}
}

#-----------------------------------------------------------------------------

sub create_undo_snapshot
{
my ($self) = @_;
my $serialized_self ;

{
	local $self->{DO_STACK} = undef ;
	$serialized_self = $self->serialize_self()  ;
}

splice(@{$self->{DO_STACK}}, min($self->{DO_STACK_POINTER}, scalar(@{$self->{DO_STACK}}))) ; # new do branch

push @{$self->{DO_STACK}}, $serialized_self ;
$self->{DO_STACK_POINTER} = @{$self->{DO_STACK}} ;
}

#-----------------------------------------------------------------------------

1 ;