#!/usr/bin/perl -w
use strict;
use Getopt::Long;
use Time::HiRes qw(sleep);

my $inplace = 0;
my $use_delay = 0;
my $use_anim = 0;
my $delay_time = 1.5;
my $anim_time = 0.1;
unless(GetOptions("inplace!" => \$inplace,
                  "delay!" => \$use_delay,
                  "delay-time=f" => \$delay_time,
                  "animate!" => \$use_anim,
                  "animation-time=f" => \$anim_time)){
    print("Warning: Failed to successfully parse options.\n");
}

#Initialize the lookup table

my $leftside   = "',.pyaoeui;qjkx\x{22}<>PYAOEUI:QJKX";
my $rightside  = "fgcrldhtnsbmwvz\x{46}GCRLDHTNSBMWVZ";

sub max {
    my ($a, $b) = @_;
    $a >= $b ? $a : $b;
}
   
my %transform = ();

foreach my $idx (0 .. (max(length($leftside), length($rightside)) - 1)
+){
    my $leftchar = substr($leftside, $idx, 1);
    my $rightchar = substr($rightside, $idx, 1);
    $transform{$leftchar} = $rightchar;
    $transform{$rightchar} = $leftchar;
}


print( "Welcome to the perl LR practice interactive shell.\n" . 
       "Use --inplace to insert terminal escape codes.\n" .
       "Use quit or exit to exit\n\n" );

if($use_delay && $inplace){
    printf("Replace delay set to %.2f seconds.\n", $delay_time);
}

if($use_anim && $inplace){
    printf("Char animation frame delay set to %.3f seconds.\n", $anim_
+time);
}

#main loop.
while(1){
    my $prompt = "LR practice> ";
    my $ps2 =    " LR result > "; # both prompts should be the same le
+ngth,
                                  # so that stuff lines up vertically.
    syswrite(STDOUT, $prompt);
    my $line = <STDIN>;
    chomp($line);

    my $post_LR = perl_LR($line);
    
    if($line =~ /^(quit|exit)$/i){
        syswrite(STDOUT, "Exiting.\n");
        last;
    }

    if($inplace){        
        if($use_delay){
            sleep($delay_time);
        }

        #use terminal escape codes to move up a line.
        #Apparently, the magic sequence is esc[1A
        syswrite(STDOUT, "\033[1A");

        unless( $use_anim ){ #normal case
            syswrite(STDOUT, $ps2 . $post_LR . "\n");
        }else{ 
            my $str = $ps2 . $post_LR;
            $str .= " " x (length($str) >= 26 ? 1 : 27 - length($str))
+;
            #a little whitespace at the end makes the animation smooth
+er,
            #particularly for very short strings.
            for my $idx (0 .. (length($str) - 1 )){
                if($idx == 0){                    
                }else{
                    #back up one char
                    syswrite(STDOUT, "\033[1D");
                }
                my $cur_char;

                if($idx == length($str) - 1){
                    $cur_char = substr($str, $idx, 1);
                }else{
                    $cur_char = substr($str, $idx, 1) . "#";
                }
                syswrite(STDOUT, $cur_char);
                sleep($anim_time);
            }
            syswrite(STDOUT, "\n");
        }
    }else{
        syswrite(STDOUT, $ps2 . $post_LR . "\n");
    }

    if($post_LR =~ /^(quit|exit)$/i){
        syswrite(STDOUT, "Exiting.\n");
        last;
    }
}
exit(0);

sub perl_LR {
    my $outstr = "";
    my $instr = shift();

    foreach my $idx (0 ..  (length($instr) - 1)){
        my $char = substr($instr, $idx, 1);
        my $newchar = "";
        if(defined($transform{$char})){
            $newchar = $transform{$char};
        }else{
            $newchar = $char;
        }
        $outstr .= $newchar;
    }
    return $outstr;
}
[download]