#############################################################################
# Render Nodes/Edges/Cells as ASCII/Unicode box drawing art
#
# (c) by Tels 2004-2007. Part of Graph::Easy
#############################################################################
package Graph::Easy::As_ascii;
$VERSION = '0.76';
use utf8;
#############################################################################
#############################################################################
package Graph::Easy::Edge::Cell;
use strict;
use warnings;
my $edge_styles = [
{
# style hor, ver, cross, corner (SE, SW, NE, NW)
'solid' => [ '--', "|", '+', '+','+','+','+' ], # simple line
'double' => [ '==', "H", "#", '#','#','#','#' ], # double line
'double-dash' => [ '= ', '"', "#", '#','#','#','#' ], # double dashed line
'dotted' => [ '..', ":", ':', '.','.','.','.' ], # dotted
'dashed' => [ '- ', "'", '+', '+','+','+','+' ], # dashed
'dot-dash' => [ '.-', "!", '+', '+','+','+','+' ], # dot-dash
'dot-dot-dash' => [ '..-', "!", '+', '+','+','+','+' ], # dot-dot-dash
'wave' => [ '~~', "}", '+', '*','*','*','*' ], # wave
'bold' => [ '##', "#", '#', '#','#','#','#' ], # bold
'bold-dash' => [ '# ', "#", '#', '#','#','#','#' ], # bold-dash
'wide' => [ '##', "#", '#', '#','#','#','#' ], # wide
'broad' => [ '##', "#", '#', '#','#','#','#' ], # broad
},
{
# style hor, ver, cross, corner (SE, SW, NE, NW)
'solid' => [ '─', '│', '┼', '┌', '┐', '└', '┘' ],
'double' => [ '═', '║', '╬', '╔', '╗', '╚', '╝' ],
'double-dash' => [ '═'.' ', '∥', '╬', '╔', '╗', '╚', '╝' ], # double dashed
'dotted' => [ '·', ':', '┼', '┌', '┐', '└', '┘' ], # dotted
'dashed' => [ '╴', '╵', '┘', '┌', '┐', '╵', '┘' ], # dashed
'dot-dash' => [ '·'.'-', "!", '┼', '┌', '┐', '└', '┘' ], # dot-dash
'dot-dot-dash' => [ ('·' x 2).'-', "!", '┼', '┌', '┐', '└', '┘' ], # dot-dot-dash
'wave' => [ '∼', '≀', '┼', '┌', '┐', '└', '┘' ], # wave
'bold' => [ '━', '┃', '╋', '┏', '┓', '┗', '┛' ], # bold
'bold-dash' => [ '━'.' ', '╻', '╋', '┏', '┓', '┗', '┛' ], # bold-dash
'broad' => [ '▬', '▮', '█', '█', '█', '█', '█' ], # wide
'wide' => [ '█', '█', '█', '█', '█', '█', '█' ], # broad
# these two make it nec. to support multi-line styles for the vertical edge pieces
# 'broad-dash' => [ '◼', '◼', '◼', '◼', '◼', '◼', '◼' ], # broad-dash
# 'wide-dash' => [ ('█'x 2) .' ', '█', '█', '█', '█', '█', '█' ], # wide-dash
},
];
sub _edge_style
{
my ($self, $st) = @_;
my $g = $self->{graph}->{_ascii_style} || 0;
$st = $self->{style} unless defined $st;
$edge_styles->[$g]->{ $st };
}
# | | | | : } |
# ===+=== ###+### ....!.... ~~~+~~~ ----+--- ...+... .-.+.-.-
# | | | | : { |
my $cross_styles = [
# normal cross
[
{
'boldsolid' => '┿',
'solidbold' => '╂',
'doublesolid' => '╪',
'soliddouble' => '╫',
'dashedsolid' => '┤',
'soliddashed' => '┴',
'doubledashed' => '╧',
'dasheddouble' => '╢',
},
{
'boldsolid' => '+',
'dashedsolid' => '+',
'dottedsolid' => '!',
'dottedwave' => '+',
'doublesolid' => '+',
'dot-dashsolid' => '+',
'dot-dot-dashsolid' => '+',
'soliddotted' => '+',
'solidwave' => '+',
'soliddashed' => '+',
'soliddouble' => 'H',
'wavesolid' => '+',
},
],
undef, # HOR, cannot happen
undef, # VER, cannot happen
undef,
undef,
undef,
undef,
# S_E_W -+-
# |
[
{
'solidsolid' => '┬',
'boldbold' => '┳',
'doubledouble' => '╦',
'dasheddashed' => '╴',
'dotteddotted' => '·',
},
],
# N_E_W |
# -+-
[
{
'solidsolid' => '┴',
'boldbold' => '┻',
'doubledouble' => '╩',
'dotteddotted' => '·',
},
],
# E_N_S |
# +-
# |
[
{
'solidsolid' => '├',
'boldbold' => '┣',
'doubledouble' => '╠',
'dotteddotted' => ':',
},
],
# W_N_S |
# -+
# |
[
{
'solidsolid' => '┤',
'boldbold' => '┫',
'doubledouble' => '╣',
'dotteddotted' => ':',
},
] ];
sub _arrow_style
{
my $self = shift;
my $edge = $self->{edge};
my $as = $edge->attribute('arrowstyle');
$as = 'none' if $edge->{undirected};
$as;
}
sub _arrow_shape
{
my $self = shift;
my $edge = $self->{edge};
my $as = $edge->attribute('arrowshape');
$as;
}
sub _cross_style
{
my ($self, $st, $corner_type) = @_;
my $g = $self->{graph}->{_ascii_style} || 0;
# 0 => 1, 1 => 0
$g = 1 - $g;
# for ASCII, one style fist all (e.g a joint has still "+" as corner)
$corner_type = 0 unless defined $corner_type;
$corner_type = 0 if $g == 1;
$cross_styles->[$corner_type]->[$g]->{ $st };
}
sub _insert_label
{
my ($self, $fb, $xs, $ys, $ws, $hs, $align_ver) = @_;
my $align = $self->{edge}->attribute('align');
my ($lines,$aligns) = $self->_aligned_label($align);
$ys = $self->{h} - scalar @$lines + $ys if $ys < 0;
$ws ||= 0; $hs ||= 0;
my $w = $self->{w} - $ws - $xs;
my $h = $self->{h} - $hs - $ys;
$self->_printfb_aligned ($fb, $xs, $ys, $w, $h, $lines, $aligns, $align_ver);
}
sub _draw_hor
{
# draw a HOR edge piece
my ($self, $fb) = @_;
my $style = $self->_edge_style();
my $w = $self->{w};
# '-' => '-----', '.-' => '.-.-.-'
# "(2 + ... )" to get space for the offset
my $len = length($style->[0]);
my $line = $style->[0] x (2 + $w / $len);
# '.-.-.-' => '-.-.-' if $x % $ofs == 1 (e.g. on odd positions)
my $ofs = $self->{rx} % $len;
my $type = ($self->{type} & (~EDGE_MISC_MASK));
substr($line,0,$ofs) = '' if $ofs != 0
&& ($type != EDGE_SHORT_E && $type != EDGE_SHORT_W);
$line = substr($line, 0, $w) if length($line) > $w;
# handle start/end point
my $flags = $self->{type} & EDGE_FLAG_MASK;
my $as = $self->_arrow_style();
my $ashape; $ashape = $self->_arrow_shape() if $as ne 'none';
my $x = 0; # offset for the edge line
my $xs = 1; # offset for the edge label
my $xr = 0; # right offset for label
if (($flags & EDGE_START_W) != 0)
{
$x++; chop($line); # ' ---'
$xs++;
}
if (($flags & EDGE_START_E) != 0)
{
chop($line); # '--- '
}
if (($flags & EDGE_END_E) != 0)
{
# '--> '
chop($line);
substr($line,-1,1) = $self->_arrow($as, ARROW_RIGHT, $ashape) if $as ne 'none';
$xr++;
}
if (($flags & EDGE_END_W) != 0)
{
# ' <--'
substr($line,0,1) = ' ' if $as eq 'none';
substr($line,0,2) = ' ' . $self->_arrow($as, ARROW_LEFT, $ashape) if $as ne 'none';
$xs++;
}
$self->_printfb_line ($fb, $x, $self->{h} - 2, $line);
$self->_insert_label($fb, $xs, 0, $xs+$xr, 2, 'bottom' )
if ($self->{type} & EDGE_LABEL_CELL);
}
sub _draw_ver
{
# draw a VER edge piece
my ($self, $fb) = @_;
my $style = $self->_edge_style();
my $h = $self->{h};
# '|' => '|||||', '{}' => '{}{}{}'
my $line = $style->[1] x (1 + $h / length($style->[1]));
$line = substr($line, 0, $h) if length($line) > $h;
my $flags = $self->{type} & EDGE_FLAG_MASK;
# XXX TODO: handle here start points
# we get away with not handling them because in VER edges
# starting points are currently invisible.
my $as = $self->_arrow_style();
if ($as ne 'none')
{
my $ashape = $self->_arrow_shape();
substr($line,0,1) = $self->_arrow($as,ARROW_UP, $ashape)
if (($flags & EDGE_END_N) != 0);
substr($line,-1,1) = $self->_arrow($as,ARROW_DOWN, $ashape)
if (($flags & EDGE_END_S) != 0);
}
$self->_printfb_ver ($fb, 2, 0, $line);
$self->_insert_label($fb, 4, 1, 4, 2, 'middle')
if ($self->{type} & EDGE_LABEL_CELL);
}
sub _draw_cross
{
# draw a CROSS sections, or a joint (which is a 3/4 cross)
my ($self, $fb) = @_;
# vertical piece
my $style = $self->_edge_style( $self->{style_ver} );
my $invisible = 0;
my $line;
my $flags = $self->{type} & EDGE_FLAG_MASK;
my $type = $self->{type} & EDGE_TYPE_MASK;
my $as = $self->_arrow_style();
my $y = $self->{h} - 2;
print STDERR "# drawing cross at $self->{x},$self->{y} with flags $flags\n" if $self->{debug};
if ($self->{style_ver} ne 'invisible')
{
my $h = $self->{h};
# '|' => '|||||', '{}' => '{}{}{}'
$line = $style->[1] x (2 + $h / length($style->[1]));
$line = substr($line, 0, $h) if length($line) > $h;
if ($as ne 'none')
{
my $ashape = $self->_arrow_shape();
substr($line,0,1) = $self->_arrow($as,ARROW_UP, $ashape)
if (($flags & EDGE_END_N) != 0);
substr($line,-1,1) = $self->_arrow($as,ARROW_DOWN, $ashape)
if (($flags & EDGE_END_S) != 0);
}
# create joints
substr($line,0,$y) = ' ' x $y if $type == EDGE_S_E_W;
substr($line,$y,2) = ' ' if $type == EDGE_N_E_W;
$self->_printfb_ver ($fb, 2, 0, $line);
}
else { $invisible++; }
# horizontal piece
$style = $self->_edge_style();
my $ashape; $ashape = $self->_arrow_style() if $as ne 'none';
if ($self->{style} ne 'invisible')
{
my $w = $self->{w};
# '-' => '-----', '.-' => '.-.-.-'
my $len = length($style->[0]);
$line = $style->[0] x (2 + $w / $len);
# '.-.-.-' => '-.-.-' if $x % $ofs == 1 (e.g. on odd positions)
my $ofs = $self->{rx} % $len;
substr($line,0,$ofs) = '' if $ofs != 0;
$line = substr($line, 0, $w) if length($line) > $w;
my $x = 0;
if (($flags & EDGE_START_W) != 0)
{
$x++; chop($line); # ' ---'
}
if (($flags & EDGE_START_E) != 0)
{
chop($line); # '--- '
}
if (($flags & EDGE_END_E) != 0)
{
# '--> '
chop($line);
substr($line,-1,1) = $self->_arrow($as, ARROW_RIGHT, $ashape)
if $as ne 'none';
}
if (($flags & EDGE_END_W) != 0)
{
# ' <--'
substr($line,0,1) = ' ' if $as eq 'none';
substr($line,0,2) = ' ' . $self->_arrow($as, ARROW_LEFT, $ashape)
if $as ne 'none';
}
substr($line,0,2) = ' ' if $type == EDGE_E_N_S;
substr($line,2,$self->{w}-2) = ' ' x ($self->{w}-2) if $type == EDGE_W_N_S;
$self->_printfb_line ($fb, $x, $y, $line);
}
else { $invisible++; }
if (!$invisible)
{
# draw the crossing character only if both lines are visible
my $cross = $style->[2];
my $s = $self->{style} . $self->{style_ver};
$cross = ($self->_cross_style($s,$type) || $cross); # if $self->{style_ver} ne $self->{style};
$self->_printfb ($fb, 2, $y, $cross);
}
# done
}
sub _draw_corner
{
# draw a corner (N_E, S_E etc)
my ($self, $fb) = @_;
my $type = $self->{type} & EDGE_TYPE_MASK;
my $flags = $self->{type} & EDGE_FLAG_MASK;
############
# ........
# 0 : :
# 1 : : label would appear here
# 2 : +---: (w-3) = 3 chars wide
# 3 : | : always 1 char high
# .......:
# 012345
# draw the vertical piece
# get the style
my $style = $self->_edge_style();
my $h = 1; my $y = $self->{h} -1;
if ($type == EDGE_N_E || $type == EDGE_N_W)
{
$h = $self->{h} - 2; $y = 0;
}
# '|' => '|||||', '{}' => '{}{}{}'
my $line = $style->[1] x (1 + $h / length($style->[1]));
$line = substr($line, 0, $h) if length($line) > $h;
my $as = $self->_arrow_style();
my $ashape;
if ($as ne 'none')
{
$ashape = $self->_arrow_shape();
substr($line,0,1) = $self->_arrow($as, ARROW_UP, $ashape)
if (($flags & EDGE_END_N) != 0);
substr($line,-1,1) = $self->_arrow($as, ARROW_DOWN, $ashape)
if (($flags & EDGE_END_S) != 0);
}
$self->_printfb_ver ($fb, 2, $y, $line);
# horizontal piece
my $w = $self->{w} - 3; $y = $self->{h} - 2; my $x = 3;
if ($type == EDGE_N_W || $type == EDGE_S_W)
{
$w = 2; $x = 0;
}
# '-' => '-----', '.-' => '.-.-.-'
my $len = length($style->[0]);
$line = $style->[0] x (2 + $w / $len);
# '.-.-.-' => '-.-.-' if $x % $ofs == 1 (e.g. on odd positions)
my $ofs = ($x + $self->{rx}) % $len;
substr($line,0,$ofs) = '' if $ofs != 0;
$line = substr($line, 0, $w) if length($line) > $w;
substr($line,-1,1) = ' ' if ($flags & EDGE_START_E) != 0;
substr($line,0,1) = ' ' if ($flags & EDGE_START_W) != 0;
if (($flags & EDGE_END_E) != 0)
{
substr($line,-1,1) = ' ' if $as eq 'none';
substr($line,-2,2) = $self->_arrow($as, ARROW_RIGHT, $ashape) . ' ' if $as ne 'none';
}
if (($flags & EDGE_END_W) != 0)
{
substr($line,0,1) = ' ' if $as eq 'none';
substr($line,0,2) = ' ' . $self->_arrow($as, ARROW_LEFT, $ashape) if $as ne 'none';
}
$self->_printfb_line ($fb, $x, $y, $line);
my $idx = 3; # corner (SE, SW, NE, NW)
$idx = 4 if $type == EDGE_S_W;
$idx = 5 if $type == EDGE_N_E;
$idx = 6 if $type == EDGE_N_W;
# insert the corner character
$self->_printfb ($fb, 2, $y, $style->[$idx]);
}
sub _draw_loop_hor
{
my ($self, $fb) = @_;
my $type = $self->{type} & EDGE_TYPE_MASK;
my $flags = $self->{type} & EDGE_FLAG_MASK;
############
# ..........
# 0 : :
# 1 : : label would appear here
# 2 : +--+ : (w-6) = 2 chars wide
# 3 : | v : 1 char high
# .........:
# 01234567
############
# ..........
# 0 : | ^ : ver is h-2 chars high
# 1 : | | : label would appear here
# 2 : +--+ : (w-6) = 2 chars wide
# 3 : :
# .........:
# 01234567
# draw the vertical pieces
# get the style
my $style = $self->_edge_style();
my $h = 1; my $y = $self->{h} - 1;
if ($type == EDGE_S_W_N)
{
$h = $self->{h} - 2; $y = 0;
}
# '|' => '|||||', '{}' => '{}{}{}'
my $line = $style->[1] x (1 + $h / length($style->[1]));
$line = substr($line, 0, $h) if length($line) > $h;
my $as = $self->_arrow_style();
my $ashape; $ashape = $self->_arrow_shape() if $as ne 'none';
if ($self->{edge}->{bidirectional} && $as ne 'none')
{
substr($line,0,1) = $self->_arrow($as, ARROW_UP, $ashape) if (($flags & EDGE_END_N) != 0);
substr($line,-1,1) = $self->_arrow($as, ARROW_DOWN, $ashape) if (($flags & EDGE_END_S) != 0);
}
$self->_printfb_ver ($fb, $self->{w}-3, $y, $line);
if ($as ne 'none')
{
substr($line,0,1) = $self->_arrow($as, ARROW_UP, $ashape) if (($flags & EDGE_END_N) != 0);
substr($line,-1,1) = $self->_arrow($as, ARROW_DOWN, $ashape) if (($flags & EDGE_END_S) != 0);
}
$self->_printfb_ver ($fb, 2, $y, $line);
# horizontal piece
my $w = $self->{w} - 6; $y = $self->{h} - 2; my $x = 3;
# '-' => '-----', '.-' => '.-.-.-'
my $len = length($style->[0]);
$line = $style->[0] x (2 + $w / $len);
# '.-.-.-' => '-.-.-' if $x % $ofs == 1 (e.g. on odd positions)
my $ofs = ($x + $self->{rx}) % $len;
substr($line,0,$ofs) = '' if $ofs != 0;
$line = substr($line, 0, $w) if length($line) > $w;
$self->_printfb_line ($fb, $x, $y, $line);
my $corner_idx = 3; $corner_idx = 5 if $type == EDGE_S_W_N;
# insert the corner characters
$self->_printfb ($fb, 2, $y, $style->[$corner_idx]);
$self->_printfb ($fb, $self->{w}-3, $y, $style->[$corner_idx+1]);
my $align = 'bottom'; $align = 'top' if $type == EDGE_S_W_N;
$self->_insert_label($fb, 4, 0, 4, 2, $align)
if ($self->{type} & EDGE_LABEL_CELL);
# done
}
sub _draw_loop_ver
{
my ($self, $fb) = @_;
my $type = $self->{type} & EDGE_TYPE_MASK;
my $flags = $self->{type} & EDGE_FLAG_MASK;
############
# ........
# 0 : : label would appear here
# 1 : +-- :
# 2 : | :
# 3 : +-> :
# .......:
# 012345
# ........
# 0 : : label would appear here
# 1 : --+ :
# 2 : | :
# 3 : <-+ :
# .......:
# 012345
###########################################################################
# draw the vertical piece
# get the style
my $style = $self->_edge_style();
my $h = 1; my $y = $self->{h} - 3;
# '|' => '|||||', '{}' => '{}{}{}'
my $line = $style->[1] x (1 + $h / length($style->[1]));
$line = substr($line, 0, $h) if length($line) > $h;
my $x = 2; $x = $self->{w}-3 if ($type == EDGE_E_S_W);
$self->_printfb_ver ($fb, $x, $y, $line);
###########################################################################
# horizontal pieces
my $w = $self->{w} - 3; $y = $self->{h} - 4;
$x = 2; $x = 1 if ($type == EDGE_E_S_W);
# '-' => '-----', '.-' => '.-.-.-'
my $len = length($style->[0]);
$line = $style->[0] x (2 + $w / $len);
# '.-.-.-' => '-.-.-' if $x % $ofs == 1 (e.g. on odd positions)
my $ofs = ($x + $self->{rx}) % $len;
substr($line,0,$ofs) = '' if $ofs != 0;
$line = substr($line, 0, $w) if length($line) > $w;
my $as = $self->_arrow_style();
my $ashape; $ashape = $self->_arrow_shape() if $as ne 'none';
if ($self->{edge}->{bidirectional} && $as ne 'none')
{
substr($line,0,1) = $self->_arrow($as, ARROW_LEFT, $ashape) if (($flags & EDGE_END_W) != 0);
substr($line,-1,1) = $self->_arrow($as, ARROW_RIGHT, $ashape) if (($flags & EDGE_END_E) != 0);
}
$self->_printfb_line ($fb, $x, $y, $line);
if ($as ne 'none')
{
substr($line,0,1) = $self->_arrow($as, ARROW_LEFT, $ashape) if (($flags & EDGE_END_W) != 0);
substr($line,-1,1) = $self->_arrow($as, ARROW_RIGHT, $ashape) if (($flags & EDGE_END_E) != 0);
}
$self->_printfb_line ($fb, $x, $self->{h} - 2, $line);
$x = 2; $x = $self->{w}-3 if ($type == EDGE_E_S_W);
my $corner_idx = 3; $corner_idx = 4 if $type == EDGE_E_S_W;
# insert the corner characters
$self->_printfb ($fb, $x, $y, $style->[$corner_idx]);
$self->_printfb ($fb, $x, $self->{h}-2, $style->[$corner_idx+2]);
$x = 4; $x = 3 if ($type == EDGE_E_S_W);
$self->_insert_label($fb, $x, 0, $x, 4, 'bottom')
if ($self->{type} & EDGE_LABEL_CELL);
# done
}
# which method to call for which edge type
my $draw_dispatch =
{
EDGE_HOR() => '_draw_hor',
EDGE_VER() => '_draw_ver',
EDGE_S_E() => '_draw_corner',
EDGE_S_W() => '_draw_corner',
EDGE_N_E() => '_draw_corner',
EDGE_N_W() => '_draw_corner',
EDGE_CROSS() => '_draw_cross',
EDGE_W_N_S() => '_draw_cross',
EDGE_E_N_S() => '_draw_cross',
EDGE_N_E_W() => '_draw_cross',
EDGE_S_E_W() => '_draw_cross',
EDGE_N_W_S() => '_draw_loop_hor',
EDGE_S_W_N() => '_draw_loop_hor',
EDGE_E_S_W() => '_draw_loop_ver',
EDGE_W_S_E() => '_draw_loop_ver',
};
sub _draw_label
{
# This routine is cunningly named _draw_label, because it actually
# draws the edge line(s). The label text will be drawn by the individual
# routines called below.
my ($self, $fb, $x, $y) = @_;
my $type = $self->{type} & EDGE_TYPE_MASK;
# for cross sections, we maybe need to draw one of the parts:
return if $self->attribute('style') eq 'invisible' && $type ne EDGE_CROSS;
my $m = $draw_dispatch->{$type};
$self->_croak("Unknown edge type $type") unless defined $m;
# store the coordinates of our upper-left corner (for seamless rendering)
$self->{rx} = $x || 0; $self->{ry} = $y || 0;
$self->$m($fb);
delete $self->{rx}; delete $self->{ry}; # no longer needed
}
#############################################################################
#############################################################################
package Graph::Easy::Node;
use strict;
sub _framebuffer
{
# generate an actual framebuffer consisting of spaces
my ($self, $w, $h) = @_;
print STDERR "# trying to generate framebuffer of undefined width for $self->{name}\n",
join (": ", caller(),"\n") if !defined $w;
my @fb;
my $line = ' ' x $w;
for my $y (1..$h)
{
push @fb, $line;
}
\@fb;
}
sub _printfb_aligned
{
my ($self,$fb, $x1,$y1, $w,$h, $lines, $aligns, $align_ver) = @_;
$align_ver = 'middle' unless $align_ver;
# $align_ver eq 'middle':
my $y = $y1 + ($h / 2) - (scalar @$lines / 2);
if ($align_ver eq 'top')
{
$y = $y1;
$y1 = 0;
}
if ($align_ver eq 'bottom')
{
$y = $h - scalar @$lines; $y1 = 0;
}
my $xc = ($w / 2);
my $i = 0;
while ($i < @$lines)
{
# get the line and her alignment
my ($l,$al) = ($lines->[$i],$aligns->[$i]);
my $x = 0; # left is default
$x = $xc - length($l) / 2 if $al eq 'c';
$x = $w - length($l) if $al eq 'r';
# now print the line (inlined print_fb_line for speed)
substr ($fb->[int($y+$i+$y1)], int($x+$x1), length($l)) = $l;
$i++;
}
}
sub _printfb_line
{
# Print one textline into a framebuffer
# Caller MUST ensure proper size of FB, for speed reasons,
# we do not check whether text fits!
my ($self, $fb, $x, $y, $l) = @_;
# [0] = '0123456789...'
substr ($fb->[$y], $x, length($l)) = $l;
}
sub _printfb
{
# Print (potential a multiline) text into a framebuffer
# Caller MUST ensure proper size of FB, for speed reasons,
# we do not check whether the text fits!
my ($self, $fb, $x, $y, @lines) = @_;
# [0] = '0123456789...'
# [1] = '0123456789...' etc
for my $l (@lines)
{
# # XXX DEBUG:
# if ( $x + length($l) > length($fb->[$y]))
# {
# require Carp;
# Carp::confess("substr outside framebuffer");
# }
substr ($fb->[$y], $x, length($l)) = $l; $y++;
}
}
sub _printfb_ver
{
# Print a string vertical into a framebuffer.
# Caller MUST ensure proper size of FB, for speed reasons,
# we do not check whether text fits!
my ($self, $fb, $x, $y, $line) = @_;
# this more than twice as fast as:
# "@pieces = split//,$line; _printfb(...)"
my $y1 = $y + length($line);
substr ($fb->[$y1], $x, 1) = chop($line) while ($y1-- > $y);
}
# for ASCII and box drawing:
# the array contains for each style:
# upper left edge
# upper right edge
# lower right edge
# lower left edge
# hor style (top edge)
# hor style (bottom side)
# ver style (right side) (multiple characters possible)
# ver style (left side) (multiple characters possible)
# T crossing (see drawing below)
# T to right
# T to left
# T to top
# T shape (to bottom)
#
# +-----4-----4------+
# | | | |
# | | | |
# | | | |
# 1-----0-----3------2 1 = T to right, 2 = T to left, 3 T to top
# | | 0 = cross, 4 = T shape
# | |
# | |
# +-----+
my $border_styles =
[
{
solid => [ '+', '+', '+', '+', '-', '-', [ '|' ], [ '|' ], '+', '+', '+', '+', '+' ],
dotted => [ '.', '.', ':', ':', '.', '.', [ ':' ], [ ':' ], '.', '.', '.', '.', '.' ],
dashed => [ '+', '+', '+', '+', '- ', '- ', [ "'" ], [ "'" ], '+', '+', '+', '+', '+' ],
'dot-dash' => [ '+', '+', '+', '+', '.-', '.-', [ '!' ], [ '!' ], '+', '+', '+', '+', '+' ],
'dot-dot-dash' => [ '+', '+', '+', '+', '..-', '..-', [ '|', ':' ], [ '|',':' ], '+', '+', '+', '+', '+' ],
bold => [ '#', '#', '#', '#', '#', '#', [ '#' ], [ '#' ], '#', '#', '#', '#', '#' ],
'bold-dash' => [ '#', '#', '#', '#', '# ', '# ', ['#',' ' ], [ '#',' ' ], '#', '#', '#', '#', '#' ],
double => [ '#', '#', '#', '#', '=', '=', [ 'H' ], [ 'H' ], '#', '#', '#', '#', '#' ],
'double-dash' => [ '#', '#', '#', '#', '= ', '= ', [ '"' ], [ '"' ], '#', '#', '#', '#', '#' ],
wave => [ '+', '+', '+', '+', '~', '~', [ '{', '}' ], [ '{','}' ], '+', '+', '+', '+', '+' ],
broad => [ '#', '#', '#', '#', '#', '#', [ '#' ], [ '#' ], '#', '#', '#', '#', '#' ],
wide => [ '#', '#', '#', '#', '#', '#', [ '#' ], [ '#' ], '#', '#', '#', '#', '#' ],
none => [ ' ', ' ', ' ', ' ', ' ', ' ', [ ' ' ], [ ' ' ], ' ', ' ', ' ', ' ', ' ' ],
},
{
solid => [ '┌', '┐', '┘', '└', '─', '─', [ '│' ], [ '│' ], '┼', '├', '┤', '┴', '┬' ],
double => [ '╔', '╗', '╝', '╚', '═', '═', [ '║' ], [ '║' ], '┼', '├', '┤', '┴', '┬' ],
dotted => [ '┌', '┐', '┘', '└', '⋯', '⋯', [ '⋮' ], [ '⋮' ], '┼', '├', '┤', '┴', '┬' ],
dashed => [ '┌', '┐', '┘', '└', '−', '−', [ '╎' ], [ '╎' ], '┼', '├', '┤', '┴', '┬' ],
'dot-dash' => [ '┌', '┐', '┘', '└', '·'.'-', '·'.'-', ['!'], ['!'], '┼', '├', '┤', '┴', '┬' ],
'dot-dot-dash' => [ '┌', '┐', '┘', '└', ('·' x 2) .'-', ('·' x 2) .'-', [ '│', ':' ], [ '│', ':' ], '┼', '├', '┤', '┴', '┬' ],
bold => [ '┏', '┓', '┛', '┗', '━', '━', [ '┃' ], [ '┃' ], '┼', '├', '┤', '┴', '┬' ],
'bold-dash' => [ '┏', '┓', '┛', '┗', '━'.' ', '━'.' ', [ '╻' ], [ '╻' ], '┼', '├', '┤', '┴', '┬' ],
'double-dash' => [ '╔', '╗', '╝', '╚', '═'.' ', '═'.' ', [ '∥' ], [ '∥' ], '┼', '├', '┤', '┴', '┬' ],
wave => [ '┌', '┐', '┘', '└', '∼', '∼', [ '≀' ], [ '≀' ], '┼', '├', '┤', '┴', '┬' ],
broad => [ '▛', '▜', '▟', '▙', '▀', '▄', [ '▌' ], [ '▐' ], '▄', '├', '┤', '┴', '┬' ],
wide => [ '█', '█', '█', '█', '█', '█', [ '█' ], [ '█' ], '█', '█', '█', '█', '█' ],
none => [ ' ', ' ', ' ', ' ', ' ', ' ', [ ' ' ], [ ' ' ], ' ', ' ', ' ', ' ', ' ', ],
},
];
# for boxart and rounded corners on node-borders:
# upper left edge
# upper right edge
# lower right edge
# lower left edge
my $rounded_edges = [ '╭', '╮', '╯', '╰', ];
# for ASCII/boxart drawing slopes/slants
# lower-left to upper right (repeated twice)
# lower-right to upper left (repeated twice)
my $slants = [
# ascii
{
solid => [ '/' , '\\' ],
dotted => [ '.' , '.' ],
dashed => [ '/ ', '\\ ' ],
'dot-dash' => [ './', '.\\' ],
'dot-dot-dash' => [ '../', '..\\' ],
bold => [ '#' , '#' ],
'bold-dash' => [ '# ' , '# ' ],
'double' => [ '/' , '\\' ],
'double-dash' => [ '/ ' , '\\ ' ],
wave => [ '/ ' , '\\ ' ],
broad => [ '#' , '#' ],
wide => [ '#' , '#' ],
},
# boxart
{
solid => [ '╱' , '╲' ],
dotted => [ '⋰' , '⋱' ],
dashed => [ '╱ ', '╲ ' ],
'dot-dash' => [ '.╱', '.╲' ],
'dot-dot-dash' => [ '⋰╱', '⋱╲' ],
bold => [ '#' , '#' ],
'bold-dash' => [ '# ' , '# ' ],
'double' => [ '╱' , '╲' ],
'double-dash' => [ '╱ ' , '╲ ' ],
wave => [ '╱ ' , '╲ ' ],
broad => [ '#' , '#' ],
wide => [ '#' , '#' ],
},
];
# ASCII and box art: the different point shapes and styles
my $point_shapes =
[ {
filled =>
{
'star' => '*',
'square' => '#',
'dot' => '.',
'circle' => 'o', # unfortunately, there is no filled o in ASCII
'cross' => '+',
'diamond' => '<>',
'x' => 'X',
},
closed =>
{
'star' => '*',
'square' => '#',
'dot' => '.',
'circle' => 'o',
'cross' => '+',
'diamond' => '<>',
'x' => 'X',
},
},
{
filled =>
{
'star' => '★',
'square' => '■',
'dot' => '·',
'circle' => '●',
'cross' => '+',
'diamond' => '◆',
'x' => '╳',
},
closed =>
{
'star' => '☆',
'square' => '□',
'dot' => '·',
'circle' => '○',
'cross' => '+',
'diamond' => '◇',
'x' => '╳',
},
}
];
sub _point_style
{
my ($self, $shape, $style) = @_;
return '' if $shape eq 'invisible';
if ($style =~ /^(star|square|dot|circle|cross|diamond)\z/)
{
# support the old "pointstyle: diamond" notion:
$shape = $style; $style = 'filled';
}
$style = 'filled' unless defined $style;
my $g = $self->{graph}->{_ascii_style} || 0;
$point_shapes->[$g]->{$style}->{$shape};
}
sub _border_style
{
my ($self, $style, $type) = @_;
# make a copy so that we can modify it
my $g = $self->{graph}->{_ascii_style} || 0;
my $s = [ @{ $border_styles->[ $g ]->{$style} } ];
die ("Unknown $type border style '$style'") if @$s == 0;
my $shape = 'rect';
$shape = $self->attribute('shape') unless $self->isa_cell();
return $s unless $shape eq 'rounded';
# if shape: rounded, overlay the rounded edge pieces
splice (@$s, 0, 4, @$rounded_edges)
if $style =~ /^(solid|dotted|dashed|dot-dash|dot-dot-dash)\z/;
# '####' => ' ### '
splice (@$s, 0, 4, (' ', ' ', ' ', ' '))
if $g == 0 || $style =~ /^(bold|wide|broad|double|double-dash|bold-dash)\z/;
$s;
}
#############################################################################
# different arrow styles and shapes in ASCII and boxart
my $arrow_form =
{
normal => 0,
sleek => 1, # slightly squashed
};
my $arrow_shapes =
{
triangle => 0,
diamond => 1,
box => 2,
dot => 3,
inv => 4, # an inverted triangle
line => 5,
cross => 6,
x => 7,
};
# todo: ≪ ≫
my $arrow_styles =
[
[
# triangle
{
open => [ '>', '<', '^', 'v' ],
closed => [ '>', '<', '^', 'v' ],
filled => [ '>', '<', '^', 'v' ],
},
{
open => [ '>', '<', '∧', '∨' ],
closed => [ '▷', '◁', '△', '▽' ],
filled => [ '▶', '◀', '▲', '▼' ],
}
], [
# diamond
{
open => [ '>', '<', '^', 'v' ],
closed => [ '>', '<', '^', 'v' ],
filled => [ '>', '<', '^', 'v' ],
},
{
open => [ '>', '<', '∧', '∨' ],
closed => [ '◇', '◇', '◇', '◇' ],
filled => [ '◆', '◆', '◆', '◆' ],
}
], [
# box
{
open => [ ']', '[', '°', 'u' ],
closed => [ 'D', 'D', 'D', 'D' ],
filled => [ '#', '#', '#', '#' ],
},
{
open => [ '⊐', '⊐', '⊓', '⊔' ],
closed => [ '◻', '◻', '◻', '◻' ],
filled => [ '◼', '◼', '◼', '◼' ],
}
], [
# dot
{
open => [ ')', '(', '^', 'u' ],
closed => [ 'o', 'o', 'o', 'o' ],
filled => [ '*', '*', '*', '*' ],
},
{
open => [ ')', '(', '◠', '◡' ],
closed => [ '○', '○', '○', '○' ],
filled => [ '●', '●', '●', '●' ],
}
], [
# inv
{
open => [ '<', '>', 'v', '^' ],
closed => [ '<', '>', 'v', '^' ],
filled => [ '<', '>', 'v', '^' ],
},
{
open => [ '<', '>', '∨', '∧' ],
closed => [ '◁', '▷', '▽', '△' ],
filled => [ '◀', '▶', '▼', '▲' ],
}
], [
# line
{
open => [ '|', '|', '_', '-' ],
closed => [ '|', '|', '_', '-' ],
filled => [ '|', '|', '_', '-' ],
},
{
open => [ '⎥', '⎢', '_', '¯' ],
closed => [ '⎥', '⎢', '_', '¯' ],
filled => [ '⎥', '⎢', '_', '¯' ],
}
], [
# cross
{
open => [ '+', '+', '+', '+' ],
closed => [ '+', '+', '+', '+' ],
filled => [ '+', '+', '+', '+' ],
},
{
open => [ '┼', '┼', '┼', '┼' ],
closed => [ '┼', '┼', '┼', '┼' ],
filled => [ '┼', '┼', '┼', '┼' ],
}
], [
# x
{
open => [ 'x', 'x', 'x', 'x' ],
closed => [ 'x', 'x', 'x', 'x' ],
filled => [ 'x', 'x', 'x', 'x' ],
},
{
open => [ 'x', 'x', 'x', 'x' ],
closed => [ 'x', 'x', 'x', 'x' ],
filled => [ '⧓', '⧓', 'x', 'x' ],
}
]
];
sub _arrow
{
# return an arror, depending on style and direction
my ($self, $style, $dir, $shape) = @_;
$shape = '' unless defined $shape;
$shape = $arrow_shapes->{$shape} || 0;
my $g = $self->{graph}->{_ascii_style} || 0;
$arrow_styles->[$shape]->[$g]->{$style}->[$dir];
}
# To convert an HTML arrow to Unicode:
my $arrow_dir = {
'>' => 0,
'<' => 1,
'^' => 2,
'v' => 3,
};
sub _unicode_arrow
{
# return an arror in unicode, depending on style and direction
my ($self, $shape, $style, $arrow_text) = @_;
$shape = '' unless defined $shape;
$shape = $arrow_shapes->{$shape} || 0;
my $dir = $arrow_dir->{$arrow_text} || 0;
$arrow_styles->[$shape]->[1]->{$style}->[$dir];
}
#############################################################################
#
# +---4---4---4---+
# | | | | |
# | | | | |
# | | | | |
# 1---0---3---0---2 1 = T to right, 2 = T to left, 3 T to top
# | | | | 0 = cross, 4 = T shape
# | | | |
# | | | |
# +---+ +---+
sub _draw_border
{
# draws a border into the framebuffer
my ($self, $fb, $do_right, $do_bottom, $do_left, $do_top, $x, $y) = @_;
return if $do_right.$do_left.$do_bottom.$do_top eq 'nonenonenonenone';
my $g = $self->{graph};
my $w = $self->{w};
if ($do_top ne 'none')
{
my $style = $self->_border_style($do_top, 'top');
# top-left corner piece is only there if we have a left border
my $tl = $style->[0]; $tl = '' if $do_left eq 'none';
# generate the top border
my $top = $style->[4] x (($self->{w}) / length($style->[4]) + 1);
my $len = length($style->[4]);
# for seamless rendering
if (defined $x)
{
my $ofs = $x % $len;
substr($top,0,$ofs) = '' if $ofs != 0;
}
# insert left upper corner (if it is there)
substr($top,0,1) = $tl if $tl ne '';
$top = substr($top,0,$w) if length($top) > $w;
# top-right corner piece is only there if we have a right border
substr($top,-1,1) = $style->[1] if $do_right ne 'none';
# if the border must be collapsed, modify top-right edge piece:
if ($self->{border_collapse_right})
{
# place "4" (see drawing above)
substr($top,-1,1) = $style->[10];
}
# insert top row into FB
$self->_printfb( $fb, 0,0, $top);
}
if ($do_bottom ne 'none')
{
my $style = $self->_border_style($do_bottom, 'bottom');
# bottom-left corner piece is only there if we have a left border
my $bl = $style->[3]; $bl = '' if $do_left eq 'none';
# the bottom row '+--------+' etc
my $bottom = $style->[5] x (($self->{w}) / length($style->[5]) + 1);
my $len = length($style->[5]);
# for seamless rendering
if (defined $x)
{
my $ofs = $x % $len;
substr($bottom,0,$ofs) = '' if $ofs != 0;
}
# insert left bottom corner (if it is there)
substr($bottom,0,1) = $bl if $bl ne '';
$bottom = substr($bottom,0,$w) if length($bottom) > $w;
# bottom-right corner piece is only there if we have a right border
substr($bottom,-1,1) = $style->[2] if $do_right ne 'none';
# if the border must be collapsed, modify bottom-right edge piece:
if ($self->{border_collapse_right} || $self->{border_collapse_bottom})
{
if ($self->{rightbelow_count} > 0)
{
# place a cross or T piece (see drawing above)
my $piece = 8; # cross
# inverted T
$piece = 11 if $self->{rightbelow_count} < 2 && !$self->{have_below};
$piece = 10 if $self->{rightbelow_count} < 2 && !$self->{have_right};
substr($bottom,-1,1) = $style->[$piece];
}
}
# insert bottom row into FB
$self->_printfb( $fb, 0,$self->{h}-1, $bottom);
}
return if $do_right.$do_left eq 'nonenone'; # both none => done
my $style = $self->_border_style($do_left, 'left');
my $left = $style->[6];
my $lc = scalar @{ $style->[6] } - 1; # count of characters
$style = $self->_border_style($do_right, 'right');
my $right = $style->[7];
my $rc = scalar @{ $style->[7] } - 1; # count of characters
my (@left, @right);
my $l = 0; my $r = 0; # start with first character
my $s = 1; $s = 0 if $do_top eq 'none';
my $h = $self->{h} - 2;
$h ++ if defined $x && $do_bottom eq 'none'; # for seamless rendering
for ($s..$h)
{
push @left, $left->[$l]; $l ++; $l = 0 if $l > $lc;
push @right, $right->[$r]; $r ++; $r = 0 if $r > $rc;
}
# insert left/right columns into FB
$self->_printfb( $fb, 0, $s, @left) unless $do_left eq 'none';
$self->_printfb( $fb, $w-1, $s, @right) unless $do_right eq 'none';
$self;
}
sub _draw_label
{
# Draw the node label into the framebuffer
my ($self, $fb, $x, $y, $shape) = @_;
if ($shape eq 'point')
{
# point-shaped nodes do not show their label in ASCII
my $style = $self->attribute('pointstyle');
my $shape = $self->attribute('pointshape');
my $l = $self->_point_style($shape,$style);
$self->_printfb_line ($fb, 2, $self->{h} - 2, $l) if $l;
return;
}
# +----
# | Label
# 2,1: ----^
my $w = $self->{w} - 4; my $xs = 2;
my $h = $self->{h} - 2; my $ys = 0.5;
my $border = $self->attribute('borderstyle');
if ($border eq 'none')
{
$w += 2; $h += 2;
$xs = 1; $ys = 0;
}
my $align = $self->attribute('align');
$self->_printfb_aligned ($fb, $xs, $ys, $w, $h, $self->_aligned_label($align));
}
sub as_ascii
{
# renders a node or edge like:
# +--------+ .......... ""
# | A node | or : A node : or " --> "
# +--------+ .......... ""
my ($self, $x,$y) = @_;
my $shape = 'rect';
$shape = $self->attribute('shape') unless $self->isa_cell();
if ($shape eq 'edge')
{
my $edge = Graph::Easy::Edge->new();
my $cell = Graph::Easy::Edge::Cell->new( edge => $edge, x => $x, y => $y );
$cell->{w} = $self->{w};
$cell->{h} = $self->{h};
$cell->{att}->{label} = $self->label();
$cell->{type} =
Graph::Easy::Edge::Cell->EDGE_HOR +
Graph::Easy::Edge::Cell->EDGE_LABEL_CELL;
return $cell->as_ascii();
}
# invisible nodes, or very small ones
return '' if $shape eq 'invisible' || $self->{w} == 0 || $self->{h} == 0;
my $fb = $self->_framebuffer($self->{w}, $self->{h});
# point-shaped nodes do not have a border
if ($shape ne 'point')
{
#########################################################################
# draw our border into the framebuffer
my $cache = $self->{cache};
my $b_top = $cache->{top_border} || 'none';
my $b_left = $cache->{left_border} || 'none';
my $b_right = $cache->{right_border} || 'none';
my $b_bottom = $cache->{bottom_border} || 'none';
$self->_draw_border($fb, $b_right, $b_bottom, $b_left, $b_top);
}
###########################################################################
# "draw" the label into the framebuffer (e.g. the node/edge and the text)
$self->_draw_label($fb, $x, $y, $shape);
join ("\n", @$fb);
}
1;
__END__
=head1 NAME
Graph::Easy::As_ascii - Generate ASCII art
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
$graph->add_edge('Bonn', 'Berlin');
print $graph->as_ascii();
=head1 DESCRIPTION
C<Graph::Easy::As_ascii> contains the code to render Nodes/Edges as
ASCII art. It is used by Graph::Easy automatically, and there should
be no need to use it directly.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut