package PCI::Telnet::GUI::Canvas;

# Note: You might get away with subing PCI::Telnet::Lib with Term::ANS
+IScreen.
use PCI::Telnet::Lib;
use Data::Dumper;

use Clone qw(clone);

use Time::HiRes qw/time sleep/;

use strict;

# Store the Attribute fields as constants in an arrayref rather than a
+s a hashref because
# this seems to shave a measurable amount of time off of canvas operat
+ions. One benchmark
# on print_demo1 shaved .04sec off - from .20~.19 to .16~.15 on avg (a
+t mark1)
use constant AS_BG    => 0;
use constant AS_FG    => 1;
use constant AS_U     => 2;
use constant AS_BLINK => 3;
use constant AS_BOLD  => 4;

use constant CUR_ROW    => 0;
use constant CUR_COL    => 1;

sub new
{
    my $class = shift;
    my $self = bless {}, $class;
    
    my $h = shift || 40;
    my $w = shift || 10;
    
    $self->{width}  = $w;
    $self->{height} = $h;
    
    #$self->{A}        = {bg=>undef,fg=>undef,u=>-1,blink=>-1,bold=>-1
+};
    #$self->{A_all_off} = {bg=>undef,fg=>undef,u=>-1,blink=>-1,bold=>-
+1};
    $self->{A}        = [undef,undef,-1,-1,-1];
    $self->{A_all_off}    = [undef,undef,-1,-1,-1];
    
    $self->{data} = [];
    $self->{attr} = [];
    
    $self->locate(0,0);
    
    return $self;
}

sub width  { shift->{width}  }
sub height { shift->{height} } 

sub clear { my $x=shift; $x->{data}=[]; $x->{attr}=[] }



sub ansi_attrib_split
{
    my $str = shift;
    
    my @list = ($str=~/(
               (?:\x1B\[\d{1,2}m)*        # optional: line drawing chr
+ can have number of colors before it...
            \x1B\(0[qxlkjmtuwvn]\x1B\(B    # line drawing character (1
++)
             (?:\x1B\[\d{1,2}m)*(?:$)?    # optionally followed by a c
+olor at the end of the string
            |
            .(?:\x1B\[\d{1,2}m)+$        # match anything followed by 
+any number of colors at the end of the string
            |
             (?:\x1B\[\d{1,2}m)*.(?:\x1B\[\d{1,2}m)*(?:$)?        # ma
+tch any number of colors followed by anything
            |
            .                # match anything not matched above
        )/gx);
    
    #if(wantarray) { print called_from().": String:[$str]\n";print "[$
+_]\n" foreach @list;print "\n-------\n"; }
    return wantarray ? @list : $#list+1;
}


sub ansi_split
{
    local $_ = shift;
    
    @_ = /(\x1B\(0.\x1B\(B|.)/g;
    
    #if(wantarray) { print called_from().": String:[$str]\n";print "[$
+_]\n" foreach @list;print "\n-------\n"; }
    return wantarray ? @_ : $#_+1;
}


sub ansi_strip
{
    local $_= shift;
    s/(\x1B\[\d{1,2}m|\x1B\(0[qxlkjmtuwvn]\x1B\(B)//g;
    $_;
}

sub ansi_attrib_strip
{
    local $_ = shift;
    s/\x1B\[\d{1,2}m//g;
    $_;
}


sub string
{
    my $self = shift;
    my $row  = shift;
    my $col  = shift;
    my $str  = shift;
    
    $row = int($row);
    $col = int($col);
    $row = 0 if $row<0;
    $col = 0 if $col<0;
    
    my @tmp;
    if($str=~/<[^\>]+>/)
    {
        my $a;
        #my @line = split /(<[^\>]+>|.*)/, $str;
        my @line = $str=~/(<[^\>]+>|.)/g;    
        $self->locate($row,$col);
        #print Dumper \@line;
        foreach(@line)
        {
            #print "\$_=[$_]\n";
            if(/<(.*)>/)
            {
                #next;
                $a = lc $1;
                #print "a=[$a] <>\n";
                
                if($a eq 'f' || $a eq 'off' || $a eq 'clear')
                {
                    #print "   --clear--\n";
                    $self->attroff();
                }
                else
                {
                    $self->attron(
                        $a eq 'k' || $a eq 'black'    ? BLACK    :
                        $a eq 'r' || $a eq 'red'    ? RED    :
                        $a eq 'g' || $a eq 'green'    ? GREEN    :
                        $a eq 'y' || $a eq 'yellow'    ? YELLOW :
                        $a eq 'b' || $a eq 'blue'    ? BLUE    :
                        $a eq 'm' || $a eq 'magenta'    ? MAGENTA :
                        $a eq 'p' || $a eq 'purple'    ? MAGENTA :
                        $a eq 'c' || $a eq 'cyan'    ? CYAN    : 
                        $a eq 'w' || $a eq 'white'    ? WHITE :
                        
                        $a eq 'ok' || $a eq 'onblack'    || $a eq 'bgb
+lack'    ? ON_BLACK    :
                        $a eq 'or' || $a eq 'onred'    || $a eq 'bgred
+'    ? ON_RED    :
                        $a eq 'og' || $a eq 'ongreen'    || $a eq 'bgg
+reen'    ? ON_GREEN    :
                        $a eq 'oy' || $a eq 'onyellow'    || $a eq 'bg
+yellow'    ? ON_YELLOW     :
                        $a eq 'ob' || $a eq 'onblue'    || $a eq 'bgbl
+ue'    ? ON_BLUE    :
                        $a eq 'om' || $a eq 'onmagenta'    || $a eq 'b
+gmagenta'    ? ON_MAGENTA     :
                        $a eq 'op' || $a eq 'onpurple'    || $a eq 'bg
+purple'    ? ON_MAGENTA     :
                        $a eq 'oc' || $a eq 'oncyan'    || $a eq 'bgcy
+an'    ? ON_CYAN    : 
                        $a eq 'ow' || $a eq 'onwhite'    || $a eq 'bgw
+hite'    ? ON_WHITE     :
                        
                        $a eq 'u' || $a eq 'underline'    ? UNDERLINE 
+   :
                        $a eq 'l' || $a eq 'bold'    ? BOLD        :
                        $a eq 'd' || $a eq 'dim'    ? DIM        :
                        $a eq 'i' || $a eq 'blink'    ? BLINK        :
                        
                        ''
                    );
                }
            }
            else
            {
                #print "_=[$_]\n";
                $self->print($_);
            }
        }
        
        $self->attroff();
        return;
    }
    
    
    #my (@chr,@attrs) = ansi_parse $str;
    #print called_from().": string=[$str]\n";
    my @chr = ansi_split ansi_attrib_strip $str; #fsplit//, ansi_strip
+ $str;
    
    return if $row > $self->{height};
    
    my $width = $self->{width};
    
    $self->{data}->[$row]||= [];
    $self->{attr}->[$row]||= [];
    
    my $r = $self->{data}->[$row];
    my $a = $self->{attr}->[$row];
    my $s = $self->{A};
    my ($x,$z,@tmp);
    foreach $x (0..$#chr)
    {
        $z = $x+$col;
        last if $z > $width;
        
        # This lovely little oneliner strips any attribute codes out o
+f the string (replacing them with ''),
        # and stores them in @tmp. Since 'if' will evaluate @tmp to th
+e scalar number of elements, if @tmp has > 0
        # elements, it executes the call to attron, which 'turns on' e
+ach ansi code in @tmp, returning the 
        # resutling hashref {A} to $s.
        # ... 
        # And if no ansi codes are found in the string, @tmp will be 0
+ length, and $s will use the original {A}
        # hashref from the start of the loop
        #$s = $self->attron(@tmp) if @tmp = ($str=~s/(\x1B\[\d+m)//g);
        
        $r->[$z] = $chr[$x];
        $a->[$z] = _atlayer($a->[$z],$s);
    }
    
}

sub _atlayer
{
    #my $_[0] = shift;
    local $_ = clone($_[1]);
    #$_->{$_} = $_[1]->{$_} foreach keys %{$_[1]};
    $_->[AS_BG]    = $_[0]->[AS_BG]    if !$_->[AS_BG];
    $_->[AS_FG]    = $_[0]->[AS_FG]    if !$_->[AS_FG];
    $_->[AS_U]    = $_[0]->[AS_U]        if  $_->[AS_U] < 0;
    $_->[AS_BOLD]    = $_[0]->[AS_BOLD]    if  $_->[AS_BOLD] < 0;
    $_->[AS_BLINK]    = $_[0]->[AS_BLINK]    if  $_->[AS_BLINK] < 0;
    return $_;
}

sub _ateq
{
    my $a = shift;
    my $b = shift;
    #print "\t_ateq([$a],[$b])\n";
    return    $a->[AS_BG]    eq $b->[AS_BG] &&
        $a->[AS_FG]    eq $b->[AS_FG] &&
        $a->[AS_U]    == $b->[AS_U]  &&
        $a->[AS_BOLD]    == $b->[AS_BOLD] &&
        $a->[AS_BLINK]    == $b->[AS_BLINK]
        ?1:0;
}

sub _atdiffstr
{
    my $a = shift;
    my $b = shift;
    @_ = ();
    # Underline and blink have no reset codes, therefore compose entir
+e attr block with clear at start
    return _attr($b) if $a->[AS_U] != $b->[AS_U] || $a->[AS_BLINK] != 
+$b->[AS_BLINK];
    
    push @_ , $b->[AS_BG] if $a->[AS_BG] ne $b->[AS_BG];
    push @_ , $b->[AS_FG] if $a->[AS_FG] ne $b->[AS_FG];
    push @_ , $b->[AS_BOLD] ? BOLD : DIM if $a->[AS_BOLD] != $b->[AS_B
+OLD];
    
    return join '' , @_;

}

sub dump
{
    print shift->to_string(undef,undef,'.');
}


sub x{join '',@_}


sub iloop($$$$$)
{
    my ($line,$arow,$sw,$lat,$blank) = @_;
    my ($atr,$chr,$col);
    my @a = ();
    for $col (0..$sw)
    {
        $chr = $line->[$col];
        $atr = $arow->[$col];
        
        push @a, _attr($atr) if #!_ateq($lat,$atr);
                $lat->[AS_BG]        ne $atr->[AS_BG] ||
                $lat->[AS_FG]        ne $atr->[AS_FG] ||
                $lat->[AS_U]        != $atr->[AS_U]  ||
                $lat->[AS_BOLD]        != $atr->[AS_BOLD] ||
                $lat->[AS_BLINK]    != $atr->[AS_BLINK];

        push @a, defined $chr ? $chr : $blank;

        $lat = $atr;

    }
    return join '', @a;
}


sub to_string
{
    my $self = shift;
    
    my $dr = shift;
    my $dc = shift;
    
    my $blank = shift || ' ';
    
    my $data = $self->{data};
    my $attr = $self->{attr};
    
    #print '+', '-' x $self->{width}, '+', "\n";
    my $a = time;
    
    my ($row,$line,$col,$chr,$arow,$atr,$lat);
    
    #$lat = $self->{A_all_off};
    #print "Test:\n";
    #print "[". Dumper(\@attr)."]\n";
    
    @_=();
    
    push @_, CLEAR;
    
    my $sh = $self->{height} - 1;
    my $sw = $self->{width}  - 1;
    my $off = $self->{A_all_off};;
    
    foreach $row (0..$sh-1)
    {
        push @_, "\x1B[".($dr+$row).";${dc}H" if defined $dc;
        
        #$line  = $data->[$row] || [];
        #$arow  = $attr->[$row] || [];
        #print '|';
        #$lat = $off;
        
        push @_, iloop($data->[$row] || [],$attr->[$row] || [],$sw,$of
+f,$blank);
        
        push @_, CLEAR . (defined $dc ? '' : "\n\r");
    }
    my $b = time;
    
    #my $c = $self->{height} * $self->{width};
    #my $r = $self->{height};
    
    my $d = $b - $a;
    
    #print '+', '-' x ($self->{width}), '+', "\n";
    
    #print "d=$d, c=$c,r=$r, avg per chr=",($d/$c),", avg per line=",(
+$d/$r),"\n";
    
    return x(@_);
    
    
    #my $tmp = join '', @_;    
    #$tmp =~s/((?:\x1B\(0[qxlkjmtuwvn]\x1B\(B)+)/_compress_lines($1)/s
+eg;
    #$tmp =~s/((?:\x1B\[\d{1,2}m)+)/_compress_attribs($1)/seg;
    #$tmp;
}


sub _compress_lines($)
{
    local $_= shift;
    
    #print STDERR "----> _compress_lines: in=[$x]\n";
    s/\x1B\([B0]//g;
    #print STDERR "----> _compress_lines: out=[$x]\n";
    "\x1B(0$_\x1B(B"
}

sub _compress_attribs($)
{
    local $_= shift;
    
    #print STDERR "----> _compress_lines: in=[$x]\n";
    @_ = /\x1B\[(\d{1,2})m/g;
    #print STDERR "----> _compress_lines: out=[$x]\n";
    "\x1B[".join(';',@_).'m';
}


sub locate
{
    my $self = shift;
#    print called_from."\n";
#    shift->{cursor} = [shift,shift];
    $self->{cursor} = [shift,shift];
}

sub cursor { @{shift->{cursor}||[]} }

sub print
{
    my $self = shift;
    my $str = shift;
    my $len = ansi_split $str;
    
    @_ = split/\n/, $str;
    
    my $a = $self->{cursor}->[CUR_COL];
    for(0..$#_)
    {
        $self->string($self->{cursor}->[CUR_ROW],$self->{cursor}->[CUR
+_COL],$_[$_]);
        if($_ < $#_)
        {
            $self->{cursor}->[CUR_ROW]++;
            $self->{cursor}->[CUR_COL]=$a;
        }
    }
    
    $self->{cursor}->[CUR_COL] += $len;
}

sub chrat
{
    shift->{data}->[shift]->[shift];
}

sub attrat
{
    my $self = shift;
    my $row = shift;
    my $col = shift;
    return $self->{attr}->[$row]->[$col] || $self->{A_all_off};
}

sub attron
{
    my $self = shift;
    
    my ($d,$r,$k,$v);
    while(my $attr = shift)
    {
        if(ref $attr eq 'ARRAY')
        {
            $self->attron(@$attr);
            next;
        }
        
        
        $d = $attr;
        $d =~s/[^\d]//g;
        
        
            # Modifiers
        $k =    $d == 1 ? AS_BOLD :    # bold
            $d == 2 ? AS_BOLD :    # bold
            $d == 4 ? AS_U :    # u
            $d == 5 ? AS_BLINK :    # blink
            
            # Colors
            $d >= 30 && $d <= 37 ? AS_FG :
            $d >= 40 && $d <= 47 ? AS_BG :
            
            # Unknown
            undef;
            
            # Flags for Modifiers
        $v =    $d == 1 ? 1 :
            $d == 2 ? 0 :
            $d == 4 ? 1 :
            $d == 5 ? 1 :
            
            $attr;

        #print STDERR "  attron:$d, k=$k, v=[${v}#".CLEAR."]\n";
        
        $self->{A}->[$k] = $v if defined $k;
    }
    
    return $self->{A};
}

sub attroff
{
    my $self = shift;
    
    if(@_ == 0)
    {
        $self->{A} = $self->{A_all_off};
        return $self->attr;
    }
    
    my ($d,$r,$k,$v);
    while(my $attr = shift)
    {
        if(ref $attr eq 'ARRAY')
        {
            $self->attroff(@$attr);
            next;
        }
        
        
        $d = $attr;
        $d =~s/[^\d]//g;
        
            # Modifiers
        $k =    $d == 1 ? AS_BOLD :
            $d == 2 ? AS_BOLD :
            $d == 4 ? AS_U :
            $d == 5 ? AS_BLINK :
            
            # Colors
            $d >= 30 && $d <= 37 ? AS_FG :
            $d >= 40 && $d <= 47 ? AS_BG :
            
            # Unknown
            undef;
            
            # Flags for Modifiers
        $v =    $d == 1 ? 0 :
            $d == 2 ? 1 :
            $d == 4 ? 0 :
            $d == 5 ? 0 :
            
            # Color
            '';

        
        $self->{A}->[$k] = $v;
    }
    
    return $self->{A};
}

sub  attr { _attr(shift->{A}) }
sub _attr { my $x = shift ; @_=(CLEAR,$x->[AS_BG],$x->[AS_FG],($x->[AS
+_BOLD]>0?BOLD:''),($x->[AS_U]>0?UNDERLINE:''),($x->[AS_BLINK]>0?BLINK
+:''));join'',@_ }


sub fill 
{
    my $self = shift;
    my $color = shift;
    
    my $row1 = shift || 0;
    my $col1 = shift || 0;
    
    my $row2 = shift || $self->{height};
    my $col2 = shift || $self->{width};
    
    my $chr = shift; 
    $chr = ' ' if !defined $chr; #|| ' ';
    
    if($color=~/^\x1B/)
    {
        $self->attron($color);
    }
    elsif(ref $color eq 'ARRAY')
    {
        $self->attron(@$color);
    }
    
    #print STDERR "fill: row1=$row1,col1=$col1 - row2=$row2,col2=$col2
+\n";
    
    my $at = $self->{A};
    
    my ($rd,$ra);
    for $a ($row1..$row2)
    {
        $self->{data}->[$a]||=[];
        $self->{attr}->[$a]||=[];
        
        $rd = $self->{data}->[$a];
        $ra = $self->{attr}->[$a];
        
        for $b ($col1..$col2)
        {
            $rd->[$b] = ($chr == -1 ? $self->chrat($a,$b)||undef : $ch
+r);
            $ra->[$b] = _atlayer($ra->[$b],$at);
        }
    }
    $self->attroff();
}


sub box #($$$$$)
{
    my $self = shift;
    
    my ($row1, $col1, $row2, $col2, $bg, $border, $shadow, $title, $tb
+g, $txt)  = @_;
    
    
    $row1||=0;
    $col1||=0;
    $row2||=$row1+$self->{height}-1;
    $col2||=$col1+$self->{width}-1;
    
    $border ||= BLACK;
    $bg     ||= ON_WHITE;
    
    $tbg     ||= $bg;
    $txt     ||= $border;
    #$
    
    #print STDERR "$row1,$col1 - $row2,$col2\n";
    
    my $BoxWidth = $col2 - $col1 + 1;
    
    #$self->fill([ON_BLACK,DIM],$row1+1,$col1+1,$row2+1,$col2+1,-1) if
+ $shadow;
    if($shadow)
    {
        $self->fill([ON_BLACK,DIM],$row1+1,$col2+1,$row2+1,$col2+1,-1)
+;
        $self->fill([ON_BLACK,DIM],$row2+1,$col1+1,$row2+1,$col2+1,-1)
+;
    }
    
    $self->locate($row1,$col1);
    $self->attron($border,$bg);
    $self->print(ULC);

    if($title)
    {
        my $str = $title;
        #$str = "The IT Department's Tools and Tric...";
        my $len = ansi_split($str);
        #print STDERR "len=$len, this->width=".($this->width-4)."\n";
        my $space = 6 + ($shadow?1:0);
        if($len > $BoxWidth - $space)
        {
            $str = substr($str,0,$BoxWidth - ($space+3)).'...';
            $len = length($str);
        }


        $len += 4;
        my $bw = $BoxWidth- (2); # ($shadow?1:0));
        my $x = ($bw / 2 ) - ( $len / 2 ) ;
        #print STDERR "box title (str=$str, len=$len, bw=$bw) x=$x\n";
        $x = int(sprintf("%.0f",$x));
        my $y = $row1;
        
        
        my $sa = 0;
        my $sc = 0;
        my $a = ($x - $sa);
        my $b = $x + $len;
        my $c = ($bw - $b - $sc);
        
        $self->print((HOR() x $a) . RTE);
        
        $self->attron($tbg,$txt);
        $self->print(" $str ");
        $self->attroff($tbg,$txt);
        
        $self->attron($border,$bg);
        $self->print(LTE.(HOR() x $c));
            
    }
    else
    {
        $self->print(HOR() x ( $BoxWidth - 2 ) );
    }


    $self->print(URC);
    #$self->attron($border,$bg);
    
    
    for(my $a = $row1 + 1;$a<=$row2 - 1; $a++)
    {
        $self->string($a,$col1,VER);
        $self->string($a,$col1+1,(' ' x ($BoxWidth-2)));
        #$self->fill($bg,$a,$col1+1,1,$BoxWidth-2);
        $self->string($a,$col1+$BoxWidth-1,VER);
    }
    
    $self->locate($row2, $col1);
    $self->print(LLC);
    $self->print(HOR() x ($BoxWidth - 2));
    $self->print(LRC);
    
    $self->attroff();
    
}

sub print_demo1
{
    
    use Benchmark;
        my $t0 = new Benchmark;
    
    my $can = __PACKAGE__->new(24,80);
    
    #$can->string(0,2,"<r>H<y>e<g>l<b>l<c>o<m>, <r>W<y>o<g>r<b>l<c>d<m
+>!");
    #$can->attroff;
    #$can->fill('blue'); #,0,0,$can->height,$can->width,-1);
    
    my $text = <<'EOT';
Fourscore and seven years ago our fathers brought forth on this
continent a new nation, conceived in liberty and dedicated to the
proposition that all men are created equal.

Now we are engaged in a great civil war,   testing whether that nation
or any nation so conceived and so dedicated can long endure. We are
met on a great battlefield of that war. We have come to dedicate a
portion of that field as a final resting-place for those who here gave
their lives that that nation might live. It is altogether fitting and
proper that we should do this.

But in a larger sense, we cannot dedicate, we cannot consecrate, we
cannot hallow this ground.  The brave men, living and dead who
struggled here have consecrated it far above our poor power to add or
detract. The world will little note nor long remember what we say
here, but it can never forget what they did here. It is for us the
living rather to be dedicated here to the unfinished work which they
who fought here have thus far so nobly advanced. It is rather for us
to be here dedicated to the great task remaining before us--that from
these honored dead we take increased devotion to that cause for which
they gave the last full measure of devotion--that we here highly
resolve that these dead shall not have died in vain, that this nation
under God shall have a new birth of freedom, and that government of
the people, by the people, for the people shall not perish from the
earth.
EOT
    
    # Merge it all into one line per paragraph:
    $text =~ s/\n(?=\S)/ /g;
    $text =~ s/\n /\n\n/g;
    
    use Text::Wrapper;
    my $wrapper = Text::Wrapper->new(columns=>$can->width);
    my @lines = split/\n/, $wrapper->wrap($text);
    
    #print $text,"\n\n";
    
    my $t1 = new Benchmark;
    my $td = timediff($t1, $t0);
        #print "mark1:",timestr($td),"\n";
    
    $can->fill(ON_BLUE); #,0,0,$can->height-5,$can->width-10,-1);
    
    $can->attron(BOLD);
    for(0..$#lines)
    {
        $can->string($_,0,$lines[$_]);
    }
    $can->attroff(BOLD);
    
    $can->fill([ON_GREEN,BOLD],2,2,$can->height-5,$can->width-7,-1);
    
    $can->box(0,4,$can->height-3,$can->width-11,ON_WHITE,BLACK,1,"What
+ is This?",ON_WHITE,[RED]);
    
    $can->attroff;
    
    $can->locate(1,5);
    $can->print("This has been a demo of\nPCI::Telnet::GUI::Canvas\n\n
+Thank you for watching.\nEmail:\njdb\@josiahbryan.com");
    
    my $t2 = new Benchmark;
    $td = timediff($t2, $t1);
    #print "mark2:",timestr($td),"\n";

    
    $can->dump;
    
    my $t3 = new Benchmark;
    $td = timediff($t3, $t2);
    #print "mark3:",timestr($td),"\n";


    print "\n\nSection of canvas above from (7,4)-(10,10):\n";
    my $c2 = $can->copy_canvas(7,4,10,10);
    $c2->dump;
    print "\n\n";
    
    my $t4 = new Benchmark;
    $td = timediff($t4, $t3);
    #print "mark4:",timestr($td),"\n";

}

sub render_canvas 
{
    my $self = shift;
    
    my $row = shift || 0;
    my $col = shift || 0;
    
    my $c2   = shift;
    
    my $h = $c2->height-1;
    my $w = $c2->width-1;
    
    #my $at = $self->{A};
    
    my ($rd,$ra,$cd,$ca,$dy,$dx,$chr);
    for $a (0..$h)
    {
        $dy = $a+$row;
        
        $self->{data}->[$dy]||=[];
        $self->{attr}->[$dy]||=[];
        
        $rd = $self->{data}->[$dy];
        $ra = $self->{attr}->[$dy];
        
        $cd = $c2->{data}->[$a];
        $ca = $c2->{attr}->[$a];
        
        for $b (0..$w)
        {
            $dx = $b+$col;
            
            $chr = $cd->[$b];
            #print "c2($a,$b)>($dy,$dx): chr=[$chr]\n";
            
            $rd->[$dx] = (!defined $chr ? $self->chrat($dy,$dx)||undef
+ : $chr);
            $ra->[$dx] = _atlayer($ra->[$dx],$ca->[$b]);
        }
    }
    $self->attroff();
}

sub copy_canvas
{
    my $self = shift;
    
    my $row1 = shift || 0;
    my $col1 = shift || 0;
    
    my $row2 = shift || $self->{height};
    my $col2 = shift || $self->{width};
    
    
    my $w = $col2 - $col1;
    my $h = $row2 - $row1;
    
    my $dest = __PACKAGE__->new($h,$w);
    
    my ($rd,$ra,$sy,$sx,$sd,$sa);
    for $a (0..$h)
    {
        $sy = $a + $row1;
        
        $dest->{data}->[$a]||=[];
        $dest->{attr}->[$a]||=[];
        
        $rd = $dest->{data}->[$a];
        $ra = $dest->{attr}->[$a];
        
        $sd = $self->{data}->[$sy];
        $sa = $self->{attr}->[$sy];
        
        for $b (0..$w)
        {
            $sx = $b + $col1;
            $rd->[$b] = $sd->[$sx];
            $ra->[$b] = clone($sa->[$sx]);
        }
    }
    
    return $dest;
}



sub print_demo2
{
    
    my $can = __PACKAGE__->new(10,40);
    
    #$can->string(0,2,"<r>H<y>e<g>l<b>l<c>o<m>, <r>W<y>o<g>r<b>l<c>d<m
+>!");
    #$can->attroff;
    #$can->fill('blue'); #,0,0,$can->height,$can->width,-1);
    
    my $a = time;
    
    my $c = 1;
    
    for(0..$c-1)
    {
        
        $can->fill([ON_YELLOW,BOLD,WHITE],0,0,$can->height,$can->width
+,HOR);
        
        #$can->fill([ON_GREEN,DIM],2,2,$can->height-5,$can->width-7,-1
+);
        
        print "Background:\n";
        $can->dump;
        
        my $c2 = __PACKAGE__->new(5,10);
        #$c2->print("12345\n54321");
        #$c2->fill([ON_GREEN,BOLD],0,0,$c2->height,$c2->width,-1);
        $c2->box(0,0,$c2->height-2,$c2->width-2,ON_WHITE,BLACK,1);
        
        print "Secondary Canvas:\n";
        $c2->dump();
        
        $can->render_canvas(2,2,$c2);
        
        print "Secondary Canvas on Background:\n";
        
        
        print $can->to_string(20,10), "\n\n";
    }
    
    my $b = time;
    my $d = $b-$a;
    my $v = $d/$c;
    #print "d=$d, v=$v\n";
    
    
}

#print_demo2();
#print_demo1();

sub sign { shift() <0?-1:1 }

sub line
{
    my $self = shift;
    my $attrs = shift;
    my $from_y = shift;
    my $from_x = shift;
    my $y2 = shift;
    my $x2 = shift;
    my $ch = shift || '#';
    
    my ($dx, $dy, $ax, $ay, $sx, $sy, $x, $y,$d);


    $self->attron(ref $attrs ? @$attrs : $attrs);

    $dx = $x2 - $from_x;
    $dy = $y2 - $from_y;

    $ax = abs($dx * 2);
    $ay = abs($dy * 2);

    $sx = sign($dx);
    $sy = sign($dy);

    $x = $from_x;
    $y = $from_y;

    if ($ax > $ay) 
    {
        $d = $ay - ($ax / 2);

        while (1) 
        {
            $self->string($y, $x, $ch);
            return if $x >= $x2;

            if ($d >= 0) 
            {
                $y += $sy;
                $d -= $ax;
            }
            $x += $sx;
            $d += $ay;
        }
    } 
    else 
    {
        $d = $ax - ($ay / 2);

        while (1) 
        {
            $self->string($y, $x, $ch);
            return if $y >= $y2;

            if ($d >= 0) 
            {
                $x += $sx;
                $d -= $ay;
            }
            $y += $sy;
            $d += $ax;
         }
    }
    
    $self->attroff;
}


sub print_demo3
{
    
    my $can = __PACKAGE__->new(45,125);

    

    my $x =0;
    my $y =0;
    my $ox = 3;
    my $oy = 3;
        
        
    my $dy = 1;
    my $dx = 2;
    
    my $count =0;
    
    my $a = time;
    while(++$count<35)
    {
        
        $can->clear;
        $can->line([ON_BLUE,RED],$y,$x,$y+($oy*sign($dy)),$x+($ox*sign
+($dx)),' ');
        $x+=$dx;
        $y+=$dy;
        
        #$x=$y=0 if $x > $can->width-1 || $y > $can->height-1;
        $dx = -2 if($x>$can->width-1);
        $dy = -2 if($y>$can->height-1);
        $dx = 2 if $x<0;
        $dy = 2 if $y < 0;
        
        print CURSOR_OFF . $can->to_string(0,0,'.') . CURSOR_ON;
        print "\n$y,$x  ($dx,$dy) (".$can->height.",".$can->width.") [
+frame $count]\n";
        
        
        #sleep .01;
    }
    
    my $b = time;
    my $d = $b-$a;
    my $fps = $count/$d;
    
    print "d=$d, fps=$fps\n";

}


print_demo2();
[download]