view release on metacpan or  search on metacpan

lib/App/optex/pingu/Picture.pm  view on Meta::CPAN

    "01"   => Q__xx , # â–„
    "11"   => Qxxxx , # â–ˆ
    "0000" => Q____ , #  
    "0001" => Q___x , # â–—
    "0010" => Q__x_ , # â––
    "0011" => Q__xx , # â–„
    "0100" => Q_x__ , # ▝
    "0101" => Q_x_x , # ▐
    "0110" => Q_xx_ , # â–ž
    "0111" => Q_xxx , # â–Ÿ
    "1000" => Qx___ , # â–˜
    "1001" => Qx__x , # â–š
    "1010" => Qx_x_ , # â–„
    "1011" => Qx_xx , # â–™
    "1100" => Qxx__ , # â–€
    "1101" => Qxx_x , # ▜
    "1110" => Qxxx_ , # â–›
    "1111" => Qxxxx , # â–ˆ
);

sub stringify {
    my $vec = shift;
    my $n = pop @$vec;
    my $spec = join '', @$vec;
    my $c1 = ($spec =~ /($color_re)/)[0] // '';
    my $c2 = ($spec =~ /((?!$c1)$color_re)/)[0] // '';
    my $ch = (state $cache = {})->{$spec} //= do {
	if ($c1) {
	    my $bit = $spec =~ s/(.)/int($1 eq $c1)/ger;
	    $element{$bit} // die "$spec -> $bit";
	} else {
	    substr $spec, 0, 1;
	}
    };
    my $s = $ch x $n || 1;
    $c1 ? ansi_color("$c1/$c2", $s) : $s;
}

sub read_asc {
    my $opt = ref $_[0] eq 'HASH' ? shift : {};
    my $x = $opt->{x} // 1;
    my $y = $opt->{y} // 1;
    my $data = shift;
    my @data = $data =~ /.+/g;
    @data % $y                  and die "data format error.";
    any { (length) % $x } @data and die "data format error.";
    my @image;
    while (my @y = splice @data, 0, $y) {
	my @sequence = squash zip map [ /\X{$x}/g ], @y;
	my $line = join '', map stringify($_), @sequence;
	push @image, $line;
    }
    wantarray ? @image : join('', map "$_\n", @image);
}

######################################################################

sub read_asc_1 {
    local $_ = shift;
    s/^#.*\n//mg;
    s{ (?<str>(?<col>$color_re)\g{col}*) }{
	ansi_color($+{col}, FB x length($+{str}))
    }xge;
    my @image = /.+/g;
    wantarray ? @image : join('', map "$_\n", @image);
}

my $use_FB  = 0; # use FULL BLOCK when upper/lower are same
my $use_BHB = 0; # use LOWER HALF BLOCK to show lower part

sub stringify_2 {
    my($hi, $lo, $c) = @{+shift};
    $c //= 1;
    if ($hi =~ $color_re) {
	my $color = $hi;
	if ($use_FB and $lo eq $hi) {
	    ansi_color($color, FB x $c);
	} else {
	    $color .= "/$lo" if $lo =~ $color_re;
	    ansi_color($color, THB x $c);
	}
    }
    elsif ($lo =~ $color_re) {
	if ($use_BHB) {
	    ansi_color($lo, BHB x $c);
	} else {
	    ansi_color("S$lo", THB x $c);
	}
    }
    else {
	$hi x $c;
    }
}

sub read_asc_2 {
    my $data = shift;
    my @data = grep !/^\s*#/, $data =~ /.+/g;
    @data % 2 and die "Data format error.\n";
    my @image;
    for (pairs @data) {
	my($hi, $lo) = @$_;
	my @data = squash zip [ $hi =~ /\X/g ], [ $lo =~ /\X/g ];
	my $line = join '', map stringify_2($_), @data;
	push @image, $line;
    }
    wantarray ? @image : join('', map "$_\n", @image);
}

######################################################################

if (__FILE__ eq $0) {
    use open IO => ':utf8', ':std';
    local $/;
    while (<>) {
	my $suffix = ($ARGV =~ /\.(\w+)$/)[0] // 'default';
	print scalar load_data($_, format => $suffix);
    }
}

1;