Server IP : 103.119.228.120 / Your IP : 52.15.37.74 Web Server : Apache System : Linux v8.techscape8.com 3.10.0-1160.119.1.el7.tuxcare.els2.x86_64 #1 SMP Mon Jul 15 12:09:18 UTC 2024 x86_64 User : nobody ( 99) PHP Version : 5.6.40 Disable Function : shell_exec,symlink,system,exec,proc_get_status,proc_nice,proc_terminate,define_syslog_variables,syslog,openlog,closelog,escapeshellcmd,passthru,ocinum cols,ini_alter,leak,listen,chgrp,apache_note,apache_setenv,debugger_on,debugger_off,ftp_exec,dl,dll,myshellexec,proc_open,socket_bind,proc_close,escapeshellarg,parse_ini_filepopen,fpassthru,exec,passthru,escapeshellarg,escapeshellcmd,proc_close,proc_open,ini_alter,popen,show_source,proc_nice,proc_terminate,proc_get_status,proc_close,pfsockopen,leak,apache_child_terminate,posix_kill,posix_mkfifo,posix_setpgid,posix_setsid,posix_setuid,dl,symlink,shell_exec,system,dl,passthru,escapeshellarg,escapeshellcmd,myshellexec,c99_buff_prepare,c99_sess_put,fpassthru,getdisfunc,fx29exec,fx29exec2,is_windows,disp_freespace,fx29sh_getupdate,fx29_buff_prepare,fx29_sess_put,fx29shexit,fx29fsearch,fx29ftpbrutecheck,fx29sh_tools,fx29sh_about,milw0rm,imagez,sh_name,myshellexec,checkproxyhost,dosyayicek,c99_buff_prepare,c99_sess_put,c99getsource,c99sh_getupdate,c99fsearch,c99shexit,view_perms,posix_getpwuid,posix_getgrgid,posix_kill,parse_perms,parsesort,view_perms_color,set_encoder_input,ls_setcheckboxall,ls_reverse_all,rsg_read,rsg_glob,selfURL,dispsecinfo,unix2DosTime,addFile,system,get_users,view_size,DirFiles,DirFilesWide,DirPrintHTMLHeaders,GetFilesTotal,GetTitles,GetTimeTotal,GetMatchesCount,GetFileMatchesCount,GetResultFiles,fs_copy_dir,fs_copy_obj,fs_move_dir,fs_move_obj,fs_rmdir,SearchText,getmicrotime MySQL : ON | cURL : ON | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : ON Directory : /usr/local/share/perl5/Graph/Easy/ |
Upload File : |
############################################################################# # 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