Text::Orientation - Text Rotator

  use Text::Orientation;

  # OO

  $rot = Text::Orientation->new( TEXT => "Rotate me!" );
  print $rot->mirror('horizontal');
  print $rot->rotate(+1);




  # PerlIO layer

  use Text::Orientation method => 'mirror', param => 'horizontal', charset=> 'Big5';
  binmode(STDOUT, ":via(Text::Orientation)") or die;

  print BLAH BLAH BLAH ...

 $rot = Text::Orientation->new( TEXT => text or text's ref, CHARSET => blah);

package Text::Orientation;
use 5.006;
use String::Multibyte;
use Text::Orientation::StringOperation;
our $VERSION = '0.04';

#
# O_O;;
#

sub new{
    my $pkg = shift;;
    my %arg = @_;
    bless {
	_TEXTREF => ref($arg{TEXT}) eq "ARRAY" ? $arg{TEXT} : [ split("\n", $arg{TEXT}) ],
	_CHARSET => $arg{CHARSET},
    }, $pkg;
}

sub text { $_[0]->{_TEXTREF} = ref($_[1]) eq "ARRAY" ? $_[1] : [ split("\n", $_[1])] }
sub charset { $_[0]->{_CHARSET} = $_[1] }

sub maxlen {
    my $maxlen = 0;
    if($_[1]){
	my $mb = Text::Orientation::StringOperation->new($_[1]);
	for my $t (@{$_[0]}){ $maxlen = $mb->length($t) if $mb->length($t) > $maxlen }
    }
    else{
	for my $t (@{$_[0]}){ $maxlen = length($t) if length($t) > $maxlen }
    }
    $maxlen;
}


sub transpose      { $_[0]->manip('transpose') }
sub anti_transpose { $_[0]->manip('anti_transpose') }
sub mirror         { $_[0]->manip('mirror', $_[1]) }
sub rotate         { $_[0]->manip('rotate', $_[1]) }

sub manip {
    my ($pkg, $method, $options) = @_;
    {
	transpose      => \&_transpose,
	anti_transpose => \&_transpose,
	rotate         => \&_rotate,
	mirror         => \&_mirror,
    }->{$method}->(
		   $pkg->{_TEXTREF},
		   $pkg->{_CHARSET},
		   {
		       transpose => 1,
		       anti_transpose => 2,
		   }->{$method} || $options
		   );
}

sub _transpose{
    my ($textref, $charset, $options) = @_;
    my $mb = Text::Orientation::StringOperation->new($charset);
    my ($core, $text, $ml);
    my ($row, $col);
    $ml = maxlen($textref, $charset);
    for my $i (0..$#{$textref}){
	for my $k (0..$mb->length($textref->[$i])-1){
	    ($row, $col) = $options == 2?
		($mb->length($textref->[$i])-1- $k, $#{$textref}-$i) : ($k, $i);
	    $core->[$row]->[$col] = $mb->substr($textref->[$i], $k, 1);
	}
    }
    for my $i (0..$#{$core}){
	$text .= join('', @{$core->[$i]}).($i!=$#{$core}?"\n":'');
    }
    $text;
}    

sub _mirror {
    my ($textref, $charset, $options) = @_;
    my $mb = Text::Orientation::StringOperation->new($charset);
    my $text;
    if($options =~ /vertical/io){
	$text = join( "\n", reverse @{$textref}), "\n";
    }
    elsif($options =~ /horizontal/io){
	my $ml = maxlen($textref, '');
	$text = join( "\n", map { ' 'x($ml-length$_).$mb->reverse($_) } @{$textref});
    }
    $text;
}

sub _rotate {
    my ($textref, $charset, $dir) = @_;
    $dir %= 4;
    my $mb = Text::Orientation::StringOperation->new($charset);
    my ($core, $text, $ml);
    $ml = maxlen($textref, $charset);
    if($dir == 1){
	for my $i (0..$#{$textref}){
	    for my $k (0..$mb->length($textref->[$i])-1){
		$core->[$k]->[$#{$textref} - $i] =
		    $mb->substr($textref->[$i], $k, 1);
	    }
	    for my $k ($mb->length($textref->[$i])..$ml-1){
		$core->[$k]->[$#{$textref} - $i] = ' ';
	    }
	}
    }
    elsif($dir == 2){
	return _mirror(
		       [ split "\n",_mirror($textref, $charset, 'horizontal') ],
		       $charset, 'vertical'
		       );
    }
    elsif($dir == 3){
	for my $i (0..$#{$textref}){
	    for my $k (0..$mb->length($textref->[$i])-1){
		$core->[$mb->length($textref->[$i])-1 - $k]->[$i] =
		    $mb->substr($textref->[$i], $k, 1);
	    }
	}
    }
    for my $i (0..$#{$core}){
	$text .= join('', @{$core->[$i]}).($i!=$#{$core}?"\n":'');
    }
    $text;
}


#
# PerlIO layer
#

our $method;
our $param;
our $charset;

sub import {
    shift;
    my %arg = @_;
    $method = lc $arg{method};
    $param = $method ? lc $arg{param} : undef;
    $charset = $method ? $arg{charset} : undef;
}

sub PUSHED {
    die "Lacking method\n" unless $method;
    $_[0]->new( TEXT => undef, CHARSET => $charset );
}
sub FILL { my $line = <$_[1]>; $line ? $line : "\n" }
sub WRITE {
    $_[0]->{_TEXT} .= $_[1];
    return length($_[1]);
}
sub FLUSH {
    my ($obj,$fh) = @_;
    $obj->text($obj->{_TEXT});
    print $fh $obj->manip($method, $param) or return -1;
    $obj->{_TEXT} = '';
    return 0;
}


1;
__END__
# Below is stub documentation for your module. You better edit it!