#! /usr/local/bin/perl
use strict;
use warnings;

#  $i: italic
#  $s: shadowed
#  $w: wide spacing
#  $n: narrow spacing
#  $m: normal setting
#  $g: default color
#  $t: changes the text to capitals
#  $z: reset all
#  $$: to write a "$"

my %classes = (
    i => 'italics',
    s => 'shadowed',
    w => 'wide',
    n => 'narrow',
    m => 'normal',
);

my %testcases = (
    '$iMy$z$w$f00Nickname' =>
'<span class="italics">My</span><span class="wide"><font color="#ff0000">Nickname</font></span>',

    '$s$5aaD$ddfia$5aaD$ddfe$5cc§' =>
'<span class="shadowed"><font color="#55aaaa">D</font><font color="#ddddff">ia</font><font color="#55aaaa">D</font><font color="#ddddff">e</font><font color="#55cccc">§</font></span>',

    '$iT$sh$wi$ns is $m$444silly$z $tsmall stuff$z and BIG STUFF' =>
'<span class="italics">T<span class="shadowed">h<span class="wide">i</span><span class="narrow">s is </span><font color="#444444">silly</font></span></span> SMALL STUFF and BIG STUFF',

    '$wWIDE$nNARROW$mnormal' =>
      '<span class="wide">WIDE</span><span class="narrow">NARROW</span>normal',

    '$ta$$zas$zdf' => 'A$ZASdf',

    '$tasdf' => 'ASDF',

    '$s$02fCamster $0bfb$018s$0bfc' =>
'<span class="shadowed"><font color="#0022ff">Camster </font><font color="#00bbff">b</font><font color="#001188">s</font><font color="#00bbff">c</font></span>',

    '$00fS$fffa$00fo$fffr$00fs$fffa  $00fB$fffs$00fc' =>
'<font color="#0000ff">S</font><font color="#ffffff">a</font><font color="#0000ff">o</font><font color="#ffffff">r</font><font color="#0000ff">s</font><font color="#ffffff">a  </font><font color="#0000ff">B</font><font color="#ffffff">s</font><font color="#0000ff">c</font>',

    '$i$s$f06Jasmine' =>
'<span class="italics"><span class="shadowed"><font color="#ff0066">Jasmine</font></span></span>',

    '$i$s$f90Ario$06fñ$f90e  $s$ff0 $s$fob' =>
'<span class="italics"><span class="shadowed"><font color="#ff9900">Ario</font><font color="#0066ff">ñ</font><font color="#ff9900">e  </font><font color="#ffff00"> ob',

    '$s$i$00aM$0afarcus  b$00as$0afc' =>
'<span class="shadowed"><span class="italics"><font color="#0000aa">M</font><font color="#00aaff">arcus  b</font><font color="#0000aa">s</font><font color="#00aaff">c</font></span></span>',

    '$i$fffArthur $s$00fBSC $f00N$fffE$00fD ' =>
'<span class="italics"><font color="#ffffff">Arthur </font><span class="shadowed"><font color="#0000ff">BSC </font><font color="#ff0000">N</font><font color="#ffffff">E</font><font color="#0000ff">D </font></span></span>',

    '$w$s$fffSalt$i$m$00fheart' =>
'<span class="wide"><span class="shadowed"><font color="#ffffff">Salt</font></span></span><span class="shadowed"><span class="italics"><font color="#0000ff">heart</font></span></span>',

    'sonny $s$36FBSC' =>
      'sonny <span class="shadowed"><font color="#3366ff">BSC</font></span>',

    '$s$5aaD$ddfia$5aaD$ddfe$5cc§' =>
'<span class="shadowed"><font color="#55aaaa">D</font><font color="#ddddff">ia</font><font color="#55aaaa">D</font><font color="#ddddff">e</font><font color="#55cccc">§</font></span>',

    '$ff0hula' => '<font color="#ffff00">hula</font>',

    '$s$i$f00Ma$fffnta $00fGB  ' =>
'<span class="shadowed"><span class="italics"><font color="#ff0000">Ma</font><font color="#ffffff">nta </font><font color="#0000ff">GB  </font></span></span>',

    '$i$s$t $fffPolar Bear' =>
'<span class="italics"><span class="shadowed"> <font color="#ffffff">POLAR BEAR</font></span></span>',

    '$w$325TULEBA$500(bsc)' =>
'<span class="wide"><font color="#332255">TULEBA</font><font color="#550000">(bsc)</font></span>',

    '$s$i$fffAdoo$015nis  $i$0BFb$018s$0BFc' =>
'<span class="shadowed"><span class="italics"><font color="#ffffff">Adoo</font><font color="#001155">nis  </font><font color="#00bbff">b</font><font color="#001188">s</font><font color="#00bbff">c</font></span></span>',

);

foreach ( keys %testcases ) {
    my $string = $_;
    my @stack;    # a stack of open tags
    my $italics  = 0;      # text is italics
    my $shadowed = 0;      # text is shadowed
    my $width    = 'm';    # text is wide (w) or narrow (n) or normal (m)
    my $color    = 0;      # text is colored ($rgb)
    my $capitals = 0;      # text is capitalized
    while ( $string =~ m/(\$[iswnmgtz\$]|\$[0-9a-f]{3,3})([^\$]*)/ig ) {
        my $tag         = $1;
        my $text        = $2;
        my $len         = length($tag) + length($text);
        my $pos         = pos($string);
        my $replacement = "";

        my $c = lc( substr( $1, 1, 1 ) );
        if ( $c eq 'i' ) {    # following text is italicized
            unless ($italics) {
                $italics = 1;
                my $open_tag = '<span class="italics">';
                push( @stack, $open_tag );
                $replacement = $open_tag;
            }
        } elsif ( $c eq 's' ) {    # following text is shadowed
            unless ($shadowed) {
                my $open_tag = '<span class="shadowed">';
                $replacement = $open_tag;
                push( @stack, $open_tag );
                $shadowed = 1;
            }
        } elsif ( $c eq 'w' ) {    # following text is wide
            unless ( $width eq 'w' ) {
                my $open_tag = '<span class="wide">';
                $replacement = clear_width( \@stack ) if ( $width ne 'm' );
                $replacement .= $open_tag;
                push( @stack, $open_tag );
                $width = 'w';
            }
        } elsif ( $c eq 'n' ) {    # following text is narrow
            unless ( $width eq 'n' ) {
                my $open_tag = '<span class="narrow">';
                $replacement = clear_width( \@stack ) if ( $width ne 'm' );
                $replacement .= $open_tag;
                push( @stack, $open_tag );
                $width = 'n';
            }
        } elsif ( $c eq 'm' ) {    # following text is normal width
            unless ( $width eq 'm' ) {
                $replacement = clear_width( \@stack );
                $width       = 'm';
            }
        } elsif ( $c eq 'g' ) {    # following text is default color
            if ($color) {
                $replacement = clear_color( \@stack );
                $color       = '';
            }
        } elsif ( $c eq 't' ) {    # following text is capitalized
            $capitals = 1;
        } elsif ( $c eq 'z' ) {    # following text is without any applied style
            $replacement = clear_all( \@stack );
            $italics     = 0;
            $shadowed    = 0;
            $width       = 'm';
            $color       = '';
            $capitals    = 0;
        } elsif ( $c eq '$' ) {    # a '$'
            $replacement = '$';
        } elsif ( $tag =~ m/\$[0-9a-f]{3,3}/i ) {    # following text is colored
            unless ( $color eq $tag ) {
                my ( $x, $r, $g, $b ) = split( //, $tag );
                my $open_tag = lc("<font color=\"#$r$r$g$g$b$b\">");
                $replacement = clear_color( \@stack );
                $replacement .= $open_tag;
                push( @stack, $open_tag );
                $color = $tag;
            }
        } else {    # If we don't recognize it leave it unchanged
            warn "unknown tag $tag";
            $replacement = substr( $tag, 0, 2 );
        }

        $replacement .= $capitals ? uc($text) : $text;

        substr( $string, $pos - $len, $len, $replacement );

        pos($string) = $pos - $len + length($replacement);
    }

    $string .= clear_all( \@stack );
    $string = tidy($string);

    if ( $string eq $testcases{$_} ) {
        print "\n\nOk '$_' =>\n '$string'\n";
    } else {
        print "\n\nNot Ok '$_' =>\n '$string'  expecting:\n '$testcases{$_}'\n";
    }
}

exit(0);

# clear the stack, closing all tags
sub clear_all {
    my $stack = shift;

    my $text;

    while ( my $tag = pop( @{$stack} ) ) {
        if ( $tag =~ m/^<(\S+)/ ) {
            $text .= "</$1>";
        } else {
            die "$tag: invalid tag format";
        }
    }
    return ($text);
}

# clear prior color
# do nothing if there is no color tag open
# close all tags nested within current color tag
# close color tag
# re-open all nested tags
sub clear_color {
    my $stack = shift;

    return ("") unless ( grep { $_ =~ m/^<font/ } @{$stack} );

    my $text;
    my @reopen;

    while ( my $tag = pop( @{$stack} ) ) {
        if ( $tag =~ m/^<font/ ) {
            $text .= '</font>';
            last;    # we can only have one font tag in the stack
        } elsif ( $tag =~ m/^<(\S+)/ ) {
            push( @reopen, $tag );
            $text .= "</$1>";
        } else {
            die "$tag: invalid tag format";
        }
    }
    while ( my $tag = pop(@reopen) ) {
        push( @{$stack}, $tag );
        $text .= $tag;
    }

    return ($text);
}

# clear prior width
# do nothing if there is no width tag open
# close all tags nested within current width tag
# close width tag
# re-open all nested tags
sub clear_width {
    my $stack = shift;

    return ("")
      unless ( grep { $_ =~ m/^<span class="(wide|narrow)">/ } @{$stack} );

    my $text;
    my @reopen;

    while ( my $tag = pop( @{$stack} ) ) {
        if ( $tag eq '<span class="wide">' or $tag eq '<span class="narrow">' )
        {
            $text .= '</span>';
            last;    # we can only have one width tag in the stack
        } elsif ( $tag =~ m/^<(\S+)/ ) {
            push( @reopen, $tag );
            $text .= "</$1>";
        } else {
            die "$tag: invalid tag format";
        }
    }
    while ( my $tag = pop(@reopen) ) {
        push( @{$stack}, $tag );
        $text .= $tag;
    }

    return ($text);
}

# Remove all tag pairs without content: <tag></tag>
sub tidy {
    my $string = shift;

    while ( $string =~ s!<(\S+)[^>]*></\1>!! ) { }

    return ($string);
}