From f6f558fe867d1004c08a862ca5b6d0b9c5a9bb5e Mon Sep 17 00:00:00 2001 From: Yorhel Date: Wed, 1 Apr 2020 15:24:30 +0200 Subject: VN::Graph: Also generate VN graphs on-demand Same change as with Producers::Graph before. This also adds an option to show/hide unofficial relations. Restructured the code a bit to allow for sharing code between Producers::Graph and VN::Graph. --- lib/VNDB/Handler/VNPage.pm | 23 ------- lib/VNDB/Types.pm | 20 +++--- lib/VNDB/Util/CommonHTML.pm | 25 +------- lib/VNWeb/Discussions/Search.pm | 2 +- lib/VNWeb/Graph.pm | 117 +++++++++++++++++++++++++++++++++++ lib/VNWeb/HTML.pm | 25 ++++---- lib/VNWeb/Prelude.pm | 4 +- lib/VNWeb/Producers/Graph.pm | 132 +++++++--------------------------------- lib/VNWeb/VN/Graph.pm | 86 ++++++++++++++++++++++++++ 9 files changed, 251 insertions(+), 183 deletions(-) create mode 100644 lib/VNWeb/Graph.pm create mode 100644 lib/VNWeb/VN/Graph.pm diff --git a/lib/VNDB/Handler/VNPage.pm b/lib/VNDB/Handler/VNPage.pm index 8b01fabc..2f35744f 100644 --- a/lib/VNDB/Handler/VNPage.pm +++ b/lib/VNDB/Handler/VNPage.pm @@ -13,7 +13,6 @@ use POSIX 'strftime'; TUWF::register( qr{v/rand} => \&rand, - qr{v([1-9]\d*)/rg} => \&rg, qr{v([1-9]\d*)/releases} => \&releases, qr{v([1-9]\d*)/(chars)} => \&page, qr{v([1-9]\d*)/staff} => sub { $_[0]->resRedirect("/v$_[1]#staff") }, @@ -27,28 +26,6 @@ sub rand { } -sub rg { - my($self, $vid) = @_; - - my $v = $self->dbVNGet(id => $vid, what => 'relgraph')->[0]; - return $self->resNotFound if !$v->{id} || !$v->{rgraph}; - - my $title = "Relation graph for $v->{title}"; - return if $self->htmlRGHeader($title, 'v', $v); - - $v->{svg} =~ s/id="node_v$vid"/id="graph_current"/; - - div class => 'mainbox'; - h1 $title; - p 'Note: Unofficial relations are excluded if the graph would otherwise be too large.'; - p class => 'center'; - lit $v->{svg}; - end; - end; - $self->htmlFooter; -} - - # Description of each column, field: # id: Identifier used in URLs # sort_field: Name of the field when sorting diff --git a/lib/VNDB/Types.pm b/lib/VNDB/Types.pm index 5b51b1c0..dfb187f4 100644 --- a/lib/VNDB/Types.pm +++ b/lib/VNDB/Types.pm @@ -104,16 +104,16 @@ hash PLATFORM => # SQL: ENUM vn_relation hash VN_RELATION => - seq => { reverse => 'preq', txt => 'Sequel' }, - preq => { reverse => 'seq', txt => 'Prequel' }, - set => { reverse => 'set', txt => 'Same setting' }, - alt => { reverse => 'alt', txt => 'Alternative version' }, - char => { reverse => 'char', txt => 'Shares characters' }, - side => { reverse => 'par', txt => 'Side story' }, - par => { reverse => 'side', txt => 'Parent story' }, - ser => { reverse => 'ser', txt => 'Same series' }, - fan => { reverse => 'orig', txt => 'Fandisc' }, - orig => { reverse => 'fan', txt => 'Original game' }; + seq => { reverse => 'preq', pref => 1, txt => 'Sequel' }, + preq => { reverse => 'seq', pref => 0, txt => 'Prequel' }, + set => { reverse => 'set', pref => 0, txt => 'Same setting' }, + alt => { reverse => 'alt', pref => 0, txt => 'Alternative version' }, + char => { reverse => 'char', pref => 0, txt => 'Shares characters' }, + side => { reverse => 'par', pref => 1, txt => 'Side story' }, + par => { reverse => 'side', pref => 0, txt => 'Parent story' }, + ser => { reverse => 'ser', pref => 0, txt => 'Same series' }, + fan => { reverse => 'orig', pref => 1, txt => 'Fandisc' }, + orig => { reverse => 'fan', pref => 0, txt => 'Original game' }; diff --git a/lib/VNDB/Util/CommonHTML.pm b/lib/VNDB/Util/CommonHTML.pm index 7a3d554c..03b1bd28 100644 --- a/lib/VNDB/Util/CommonHTML.pm +++ b/lib/VNDB/Util/CommonHTML.pm @@ -12,7 +12,7 @@ use POSIX 'ceil'; our @EXPORT = qw| htmlMainTabs htmlDenied htmlHiddenMessage htmlRevision - htmlEditMessage htmlItemMessage htmlVoteStats htmlSearchBox htmlRGHeader + htmlEditMessage htmlItemMessage htmlVoteStats htmlSearchBox |; @@ -301,27 +301,4 @@ sub htmlSearchBox { } -sub htmlRGHeader { - my($self, $title, $type, $obj) = @_; - - # This used to be a good test for inline SVG support, but I'm not sure it is nowadays. - if(($self->reqHeader('Accept')||'') !~ /application\/xhtml\+xml/) { - $self->htmlHeader(title => $title); - $self->htmlMainTabs($type, $obj, 'rg'); - div class => 'mainbox'; - h1 $title; - div class => 'warning'; - h2 'Not supported'; - p 'Your browser sucks, it doesn\'t have the functionality to render our nice relation graphs.'; - end; - end; - $self->htmlFooter; - return 1; - } - $self->htmlHeader(title => $title); - $self->htmlMainTabs($type, $obj, 'rg'); - return 0; -} - - 1; diff --git a/lib/VNWeb/Discussions/Search.pm b/lib/VNWeb/Discussions/Search.pm index 06366caf..6b56b47b 100644 --- a/lib/VNWeb/Discussions/Search.pm +++ b/lib/VNWeb/Discussions/Search.pm @@ -107,7 +107,7 @@ sub posts_ { td_ class => 'tc4', sub { div_ class => 'title', sub { a_ href => $link, $l->{title} }; div_ class => 'thread', sub { lit_( - TUWF::XML::xml_escape($l->{headline}) + xml_escape($l->{headline}) =~ s/\[raw\]//gr =~ s/\[\/raw\]/<\/b>/gr =~ s/\[code\]/...<\/b>
/gr diff --git a/lib/VNWeb/Graph.pm b/lib/VNWeb/Graph.pm new file mode 100644 index 00000000..f3e26678 --- /dev/null +++ b/lib/VNWeb/Graph.pm @@ -0,0 +1,117 @@ +package VNWeb::Graph; + +# Utility functions for VNWeb::Producers::Graph anv VNWeb::VN::Graph. + +use v5.26; +use AnyEvent::Util; +use TUWF::XML 'xml_escape'; +use Encode 'encode_utf8', 'decode_utf8'; +use Exporter 'import'; +use List::Util 'max'; +use VNDB::Config; + +our @EXPORT = qw/gen_nodes dot2svg val_escape node_more gen_dot/; + + +# Given a starting ID, an array of {id0,id1} relation hashes and a number of +# nodes to be included, returns a hash of (id=>{id, distance, rels}) nodes. +# +# This is basically a breath-first search that prioritizes nodes with fewer +# relations. Direct relations with the starting node are always included, +# regardless of $num. +sub gen_nodes { + my($id, $rel, $num) = @_; + + my %rels; + push $rels{$_->{id0}}->@*, $_->{id1} for @$rel; + + my %nodes; + my @q = ({ id => $id, distance => 0 }); + while(my $n = shift @q) { + next if $nodes{$n->{id}}; + last if $num <= 0 && $n->{distance} > 1; + $num--; + $n->{rels} = $rels{$n->{id}}; + $nodes{$n->{id}} = $n; + push @q, map +{ id => $_, distance => $n->{distance}+1 }, sort { $rels{$a}->@* <=> $rels{$b}->@* } grep !$nodes{$_}, $n->{rels}->@*; + } + + \%nodes; +} + + +sub dot2svg { + my($dot) = @_; + + $dot = encode_utf8 $dot; + local $SIG{CHLD} = undef; # Fixed in TUWF 4d8a59cc1dfb5f919298ee495b8865f7872f6cbb + my $e = run_cmd([config->{graphviz_path},'-Tsvg'], '<', \$dot, '>', \my $out, '2>', \my $err)->recv; + warn "graphviz STDERR: $err\n" if chomp $err; + $e and die "Failed to run graphviz"; + + # - Remove declaration and (not compatible with embedding in HTML5) + # - Remove comments (unused) + # - Remove elements (unused) + # - Remove first <polygon> element (emulates a background color) + # - Replace stroke and fill attributes with classes (so that coloring is done in CSS) + # (I used to have an implementation based on XML::Parser, but regexes are so much faster...) + decode_utf8($out) + =~ s/<\?xml.+?\?>//r + =~ s/<!DOCTYPE[^>]*>//r + =~ s/<!--.*?-->//srg + =~ s/<title>.+?<\/title>//gr + =~ s/<polygon.+?\/>//r + =~ s/(?:stroke|fill)="([^"]+)"/$1 eq '#111111' ? 'class="border"' : $1 eq '#222222' ? 'class="nodebg"' : ''/egr; +} + + +sub val_escape { $_[0] =~ s/\\/\\\\/rg =~ s/"/\\"/rg =~ s/&/&/rg } + + +sub node_more { + my($id, $url, $number) = @_; + return () if !$number; + ( + qq|\tns$id [ URL = "$url", label="$number more..." ]|, + qq|\tn$id -- ns$id [ dir = "forward", style = "dashed" ]| + ) +} + + +sub gen_dot { + my($lines, $nodes, $rel, $rel_types) = @_; + + # Attempt to figure out a good 'rankdir' to minimize the width of the + # graph. Ideally we'd just generate two graphs and pick the least wide one, + # but that's way too slow. Graphviz tends to put adjacent nodes next to + # each other, so going for the LR (left-right) rank order tends to work + # better with large fan-out, while TB (top-bottom) often results in less + # wide graphs for large depths. + #my $max_distance = max map $_->{distance}, values %$nodes; + my $max_fanout = max map scalar grep($nodes->{$_}, $_->{rels}->@*), values %$nodes; + my $rankdir = $max_fanout > 6 ? 'LR' : 'TB'; + + for (@$rel) { + next if $_->{id0} < $_->{id1}; + my $r1 = $rel_types->{$_->{relation}}; + my $r2 = $rel_types->{ $r1->{reverse} }; + my $style = exists $_->{official} && !$_->{official} ? 'style="dotted", ' : ''; + push @$lines, + qq|n$_->{id0} -- n$_->{id1} [$style|.( + $r1 == $r2 ? qq|label="$r1->{txt}"| : + $r1->{pref} ? qq|headlabel="$r1->{txt}", dir = "forward"| : + $r2->{pref} ? qq|taillabel="$r2->{txt}", dir = "back"| : + qq|headlabel="$r1->{txt}", taillabel="$r2->{txt}"| + ).']'; + } + + qq|graph rgraph {\n|. + qq|\trankdir = "$rankdir"\n|. + qq|\tnode [ fontname = "Arial", shape = "plaintext", fontsize = 8, color = "#111111" ]\n|. + qq|\tedge [ labeldistance = 2.5, labelangle = -20, labeljust = 1, minlen = 2, dir = "both",|. + qq| fontname = "Arial", fontsize = 7, arrowsize = 0.7, color = "#111111" ]\n|. + join("\n", @$lines). + qq|\n}\n|; +} + +1; diff --git a/lib/VNWeb/HTML.pm b/lib/VNWeb/HTML.pm index 69413cea..c13cd045 100644 --- a/lib/VNWeb/HTML.pm +++ b/lib/VNWeb/HTML.pm @@ -23,7 +23,7 @@ our @EXPORT = qw/ debug_ join_ user_ user_displayname - rdate_ + rdate rdate_ elm_ framework_ revision_ @@ -95,19 +95,20 @@ sub user_displayname { } +# Format a release date as a string. +sub rdate { + my($y, $m, $d) = ($1, $2, $3) if sprintf('%08d', shift||0) =~ /^([0-9]{4})([0-9]{2})([0-9]{2})$/; + $y == 0 ? 'unknown' : + $y == 9999 ? 'TBA' : + $m == 99 ? sprintf('%04d', $y) : + $d == 99 ? sprintf('%04d-%02d', $y, $m) : + sprintf('%04d-%02d-%02d', $y, $m, $d); +} + # Display a release date. sub rdate_ { - my $date = sprintf '%08d', shift||0; - my $future = $date > strftime '%Y%m%d', gmtime; - my($y, $m, $d) = ($1, $2, $3) if $date =~ /^([0-9]{4})([0-9]{2})([0-9]{2})$/; - - my $str = $y == 0 ? 'unknown' : - $y == 9999 ? 'TBA' : - $m == 99 ? sprintf('%04d', $y) : - $d == 99 ? sprintf('%04d-%02d', $y, $m) : - sprintf('%04d-%02d-%02d', $y, $m, $d); - - $future ? b_ class => 'future', $str : txt_ $str + my $str = rdate $_[0]; + $_[0] > strftime '%Y%m%d', gmtime ? b_ class => 'future', $str : txt_ $str; } diff --git a/lib/VNWeb/Prelude.pm b/lib/VNWeb/Prelude.pm index 0a596bf6..e504d8e7 100644 --- a/lib/VNWeb/Prelude.pm +++ b/lib/VNWeb/Prelude.pm @@ -4,7 +4,7 @@ # use warnings; # use utf8; # -# use TUWF ':html5_', 'mkclass', 'xml_string'; +# use TUWF ':html5_', 'mkclass', 'xml_string', 'xml_escape'; # use Exporter 'import'; # use Time::HiRes 'time'; # use List::Util 'min', 'max', 'sum'; @@ -48,7 +48,7 @@ sub import { die $@ if !eval <<" EOM;"; package $c; - use TUWF ':html5_', 'mkclass', 'xml_string'; + use TUWF ':html5_', 'mkclass', 'xml_string', 'xml_escape'; use Exporter 'import'; use Time::HiRes 'time'; use List::Util 'min', 'max', 'sum'; diff --git a/lib/VNWeb/Producers/Graph.pm b/lib/VNWeb/Producers/Graph.pm index 8a5972c6..e1fcaace 100644 --- a/lib/VNWeb/Producers/Graph.pm +++ b/lib/VNWeb/Producers/Graph.pm @@ -1,116 +1,7 @@ package VNWeb::Producers::Graph; use VNWeb::Prelude; -use AnyEvent::Util; -use TUWF::XML 'xml_escape'; -use Encode 'encode_utf8', 'decode_utf8'; - - -# Given a starting ID, an array of {id0,id1} relation hashes and a number of -# nodes to be included, returns a hash of (id=>{id, distance, rels}) nodes. -# -# This is basically a breath-first search that prioritizes nodes with fewer -# relations. Direct relations with the starting node are always included, -# regardless of $num. -sub gen_nodes { - my($id, $rel, $num) = @_; - - my %rels; - push $rels{$_->{id0}}->@*, $_->{id1} for @$rel; - - my %nodes; - my @q = ({ id => $id, distance => 0 }); - while(my $n = shift @q) { - next if $nodes{$n->{id}}; - last if $num <= 0 && $n->{distance} > 1; - $num--; - $n->{rels} = $rels{$n->{id}}; - $nodes{$n->{id}} = $n; - push @q, map +{ id => $_, distance => $n->{distance}+1 }, sort { $rels{$a}->@* <=> $rels{$b}->@* } grep !$nodes{$_}, $n->{rels}->@*; - } - - \%nodes; -} - - -sub dot2svg { - my($dot) = @_; - - $dot = encode_utf8 $dot; - local $SIG{CHLD} = undef; # Fixed in TUWF 4d8a59cc1dfb5f919298ee495b8865f7872f6cbb - my $e = run_cmd([config->{graphviz_path},'-Tsvg'], '<', \$dot, '>', \my $out, '2>', \my $err)->recv; - warn "graphviz STDERR: $err\n" if chomp $err; - $e and die "Failed to run graphviz"; - - # - Remove <?xml> declaration and <!DOCTYPE> (not compatible with embedding in HTML5) - # - Remove comments (unused) - # - Remove <title> elements (unused) - # - Remove first <polygon> element (emulates a background color) - # - Replace stroke and fill attributes with classes (so that coloring is done in CSS) - # (I used to have an implementation based on XML::Parser, but regexes are so much faster...) - decode_utf8($out) - =~ s/<\?xml.+?\?>//r - =~ s/<!DOCTYPE[^>]*>//r - =~ s/<!--.*?-->//srg - =~ s/<title>.+?<\/title>//gr - =~ s/<polygon.+?\/>//r - =~ s/(?:stroke|fill)="([^"]+)"/$1 eq '#111111' ? 'class="border"' : $1 eq '#222222' ? 'class="nodebg"' : ''/egr; -} - - -sub gen_dot { - my($rel, $nodes, $params) = @_; - - # Attempt to figure out a good 'rankdir' to minimize the width of the - # graph. Ideally we'd just generate two graphs and pick the least wide one, - # but that's way too slow. Graphviz tends to put adjacent nodes next to - # each other, so going for the LR (left-right) rank order tends to work - # better with large fan-out, while TB (top-bottom) often results in less - # wide graphs for large depths. - #my $max_distance = max map $_->{distance}, values %$nodes; - my $max_fanout = max map scalar grep($nodes->{$_}, $_->{rels}->@*), values %$nodes; - my $rankdir = $max_fanout > 6 ? 'LR' : 'TB'; - - my $dot = - qq|graph rgraph {\n|. - qq|\trankdir=$rankdir\n|. - qq|\tnode [ fontname = "Arial", shape = "plaintext", fontsize = 8, color = "#111111" ]\n|. - qq|\tedge [ labeldistance = 2.5, labelangle = -20, labeljust = 1, minlen = 2, dir = "both",|. - qq| fontname = "Arial", fontsize = 7, arrowsize = 0.7, color = "#111111" ]\n|; - - for my $n (sort { $a->{id} <=> $b->{id} } values %$nodes) { - my $name = xml_escape shorten $n->{name}, 27; - my $tooltip = $n->{name} =~ s/\\/\\\\/rg =~ s/"/\\"/rg =~ s/&/&/rg; - my $nodeid = $n->{distance} == 0 ? 'id = "graph_current", ' : ''; - $dot .= - qq|\tn$n->{id} [ $nodeid URL = "/p$n->{id}", tooltip = "$tooltip", label=<|. - qq|<TABLE CELLSPACING="0" CELLPADDING="2" BORDER="0" CELLBORDER="1" BGCOLOR="#222222">|. - qq|<TR><TD COLSPAN="2" ALIGN="CENTER" CELLPADDING="3"><FONT POINT-SIZE="9"> $name </FONT></TD></TR>|. - qq|<TR><TD ALIGN="CENTER"> $LANGUAGE{$n->{lang}} </TD><TD ALIGN="CENTER"> $PRODUCER_TYPE{$n->{type}} </TD></TR>|. - qq|</TABLE>> ]\n|; - - my $notshown = grep !$nodes->{$_}, $n->{rels}->@*; - $dot .= - qq|\tns$n->{id} [ URL = "/p$n->{id}/rg$params", label="$notshown more..." ]\n|. - qq|\tn$n->{id} -- ns$n->{id} [ dir = "forward", style = "dashed" ]\n| - if $notshown; - } - - for (grep $_->{id0} < $_->{id1} && $nodes->{$_->{id0}} && $nodes->{$_->{id1}}, @$rel) { - my $r1 = $PRODUCER_RELATION{$_->{relation}}; - my $r2 = $PRODUCER_RELATION{ $r1->{reverse} }; - $dot .= - qq|\tn$_->{id0} -- n$_->{id1} [|.( - $r1 == $r2 ? qq|label="$r1->{txt}"| : - $r1->{pref} ? qq|headlabel="$r1->{txt}", dir = "forward"| : - $r2->{pref} ? qq|taillabel="$r2->{txt}", dir = "back"| : - qq|headlabel="$r1->{txt}", taillabel="$r2->{txt}"| - )."]\n"; - } - - $dot .= "}\n"; - $dot -} +use VNWeb::Graph; TUWF::get qr{/$RE{pid}/rg}, sub { @@ -136,6 +27,25 @@ TUWF::get qr{/$RE{pid}/rg}, sub { my $total_nodes = keys { map +($_->{id0},1), @$rel }->%*; my $visible_nodes = keys %$nodes; + my @lines; + my $params = $num == 15 ? '' : "?num=$num"; + for my $n (sort { $a->{id} <=> $b->{id} } values %$nodes) { + my $name = xml_escape shorten $n->{name}, 27; + my $tooltip = val_escape $n->{name}; + my $nodeid = $n->{distance} == 0 ? 'id = "graph_current", ' : ''; + push @lines, + qq|n$n->{id} [ $nodeid URL = "/p$n->{id}", tooltip = "$tooltip", label=<|. + qq|<TABLE CELLSPACING="0" CELLPADDING="2" BORDER="0" CELLBORDER="1" BGCOLOR="#222222">|. + qq|<TR><TD COLSPAN="2" ALIGN="CENTER" CELLPADDING="3"><FONT POINT-SIZE="9"> $name </FONT></TD></TR>|. + qq|<TR><TD ALIGN="CENTER"> $LANGUAGE{$n->{lang}} </TD><TD ALIGN="CENTER"> $PRODUCER_TYPE{$n->{type}} </TD></TR>|. + qq|</TABLE>> ]|; + + push @lines, node_more $n->{id}, "/p$n->{id}/rg$params", scalar grep !$nodes->{$_}, $n->{rels}->@*; + } + + $rel = [ grep $nodes->{$_->{id0}} && $nodes->{$_->{id1}}, @$rel ]; + my $dot = gen_dot \@lines, $nodes, $rel, \%PRODUCER_RELATION; + framework_ title => "Relations for $p->{name}", type => 'p', dbobj => $p, tab => 'rg', sub { div_ class => 'mainbox', style => 'float: left; min-width: 100%', sub { @@ -154,7 +64,7 @@ TUWF::get qr{/$RE{pid}/rg}, sub { }, grep($_ < $total_nodes, 10, 15, 25, 50, 75, 100, 150, 250, 500, 750, 1000), $total_nodes; txt_ '.'; } if $total_nodes > 10; - p_ class => 'center', sub { lit_ dot2svg gen_dot $rel, $nodes, $num == 15 ? '' : "?num=$num" }; + p_ class => 'center', sub { lit_ dot2svg $dot }; }; clearfloat_; }; diff --git a/lib/VNWeb/VN/Graph.pm b/lib/VNWeb/VN/Graph.pm new file mode 100644 index 00000000..3c81e55f --- /dev/null +++ b/lib/VNWeb/VN/Graph.pm @@ -0,0 +1,86 @@ +package VNWeb::VN::Graph; + +use VNWeb::Prelude; +use VNWeb::Graph; + + +TUWF::get qr{/$RE{vid}/rg}, sub { + my $id = tuwf->capture(1); + my $num = tuwf->validate(get => num => { uint => 1, onerror => 15 })->data; + my $unoff = tuwf->validate(get => unoff => { anybool => 1 })->data; + my $v = tuwf->dbRowi('SELECT id, title, original, hidden AS entry_hidden, locked AS entry_locked FROM vn WHERE id =', \$id); + + # Big list of { id0, id1, relation } hashes. + # Each relation is included twice, with id0 and id1 reversed. + my $where = $unoff ? '1=1' : 'vr.official'; + my $rel = tuwf->dbAlli(q{ + WITH RECURSIVE rel(id0, id1, relation, official) AS ( + SELECT id, vid, relation, official FROM vn_relations vr WHERE id =}, \$id, 'AND', $where, q{ + UNION + SELECT id, vid, vr.relation, vr.official FROM vn_relations vr JOIN rel r ON vr.id = r.id1 WHERE}, $where, q{ + ) SELECT * FROM rel ORDER BY id0 + }); + return tuwf->resNotFound if !@$rel; + + # Fetch the nodes + my $nodes = gen_nodes $id, $rel, $num; + enrich_merge id => "SELECT id, title, c_released, array_to_string(c_languages, '/') AS lang FROM vn WHERE id IN", values %$nodes; + + my $total_nodes = keys { map +($_->{id0},1), @$rel }->%*; + my $visible_nodes = keys %$nodes; + + my @lines; + my $params = "?num=$num&unoff=$unoff"; + for my $n (sort { $a->{id} <=> $b->{id} } values %$nodes) { + my $title = xml_escape shorten $n->{title}, 27; + my $tooltip = val_escape $n->{title}; + my $date = rdate $n->{c_released}; + my $lang = $n->{lang}||'N/A'; + my $nodeid = $n->{distance} == 0 ? 'id = "graph_current", ' : ''; + push @lines, + qq|n$n->{id} [ $nodeid URL = "/v$n->{id}", tooltip = "$tooltip", label=<|. + qq|<TABLE CELLSPACING="0" CELLPADDING="2" BORDER="0" CELLBORDER="1" BGCOLOR="#222222">|. + qq|<TR><TD COLSPAN="2" ALIGN="CENTER" CELLPADDING="3"><FONT POINT-SIZE="9"> $title </FONT></TD></TR>|. + qq|<TR><TD> $date </TD><TD> $lang </TD></TR>|. + qq|</TABLE>> ]|; + + push @lines, node_more $n->{id}, "/v$n->{id}/rg$params", scalar grep !$nodes->{$_}, $n->{rels}->@*; + } + + $rel = [ grep $nodes->{$_->{id0}} && $nodes->{$_->{id1}}, @$rel ]; + my $dot = gen_dot \@lines, $nodes, $rel, \%VN_RELATION; + + framework_ title => "Relations for $v->{title}", type => 'v', dbobj => $v, tab => 'rg', + sub { + div_ class => 'mainbox', style => 'float: left; min-width: 100%', sub { + h1_ "Relations for $v->{title}"; + p_ sub { + txt_ sprintf "Displaying %d out of %d related visual novels.", $visible_nodes, $total_nodes; + debug_ +{ nodes => $nodes, rel => $rel }; + br_; + if($unoff) { + txt_ 'Show / '; + a_ href => "?num=$num&unoff=0", 'Hide'; + } else { + a_ href => "?num=$num&unoff=1", 'Show'; + txt_ ' / Hide'; + } + txt_ ' unofficial relations. '; + br_; + txt_ 'Adjust graph size: '; + join_ ', ', sub { + if($_ == min $num, $total_nodes) { + txt_ $_ ; + } else { + a_ href => "/v$id/rg?num=$_", $_; + } + }, grep($_ < $total_nodes, 10, 15, 25, 50, 75, 100, 150, 250, 500, 750, 1000), $total_nodes; + txt_ '.'; + } if $total_nodes > 10; + p_ class => 'center', sub { lit_ dot2svg $dot }; + }; + clearfloat_; + }; +}; + +1; -- cgit v1.2.3