# SPDX-FileCopyrightText: 2022 Stephan Barth # # SPDX-License-Identifier: AGPL-3.0-or-later #!/usr/bin/perl use strict; use warnings; use YAML::XS; use Data::Dumper; use Tk; use Math::Trig; BEGIN { my $pwd = $0; $pwd=~s#/[^/]+$##; push @INC, $pwd; }; use Graphy; use WFparse; my $fn = shift; die unless -e $fn; my $maindata = WFparse::parsefile($fn); #my $fh = undef; #open($fh, '<', $fn) or die "Could not open $fn, as: $!"; #my $data = join '', <$fh>; #close $fh; # #my $yaml = Load($data); # ##print "<<<<<<< ", ref $yaml; # #$yaml = {nodes => $yaml} # unless # 1 == %$yaml and exists $yaml->{nodes} # #'HASH' eq ref $yaml # ; # #print Dumper($yaml); # #print "Analyze \$yaml\n"; #for my $k(keys %$yaml) { # print " Key found: $k\n"; #} # #my $nodes = $yaml->{nodes}; # #print "Analyze \$nodes\n"; #for my $k(keys %$nodes) { # print " Key found: $k\n"; #} # #print Dumper($nodes->{antrag}); # #my $onenode = $nodes->{antrag}; # #print "Analyze \$onenode\n"; #for my $k(keys %$onenode) { # print " Key found: $k\n"; #} # #my $edges = $onenode->{edges}; # #print Dumper($edges); # # #for my $nk(sort keys %$nodes) { # my $ed = $nodes->{$nk}->{edges}; # for my $ek(sort keys %$ed) { # my $src = ' (thin air)'; # $src = $ed->{$ek}->{source} if $ed->{$ek}->{source}; # print "$src --$ek--> $nk\n"; # } # #print " Key found: $k\n"; #} my %xy = (); # xy-extradata, where it is not stated in the yaml my %nodes = %$maindata; my %layout = ( width=>800, height=>800, horsplit=>0.5, vertsplit=>0.5, ); my @nodekeys = sort keys %nodes; for my $i(0..$#nodekeys) { my $nk = $nodekeys[$i]; my $phi = ($i/@nodekeys) * 2 * pi; my $x = 400 + 300*sin $phi; my $y = 400 + 300*cos $phi; #$x = $nodes->{$nk}->{x}*800 if $nodes->{$nk}->{x}; #$y = $nodes->{$nk}->{y}*800 if $nodes->{$nk}->{y}; $xy{$nk} = [$x,$y]; } my $main = MainWindow->new(); my $can = $main->Canvas(-width=>800,-height=>800,-background=>'#000000')->pack(-side=>'left'); my $texte = $main->Frame->pack(-side=>'left'); my $knotentext = $texte->Text->pack; my $knotenwahl = $texte->Frame->pack(-expand=>1,-fill=>'x'); my $kantentext = $texte->Text->pack; my $zentrierer = $knotenwahl->Canvas(-width=>80,-height=>80,-background=>'#000044')->pack(-side=>'left'); my $filler = $knotenwahl->Frame->pack(-side=>'left',-expand=>1,-fill=>'x'); #$knotenwahl->Label(-text=>'Foo')->pack(-side=>'left',-expand=>1,-fill=>'x'); my $picker = sub {return undef}; my @hl = (); $can->Tk::bind('<1>' => [sub { my (undef, $x, $y) = @_; my $got = $picker->($x,$y); if(defined $got) { push @hl, $got; shift @hl if @hl > 2; show(); } }, Ev('x'), Ev('y')]); $can->Tk::bind('<3>' => [sub { my (undef, $x, $y) = @_; @hl = (); show(); }, Ev('x'), Ev('y')]); show(); MainLoop; sub show { $can->delete('all'); my %pts = (); my @trans = (); for my $nk(sort keys %nodes) { my $ed = $nodes{$nk}->{edges}; for my $ek(sort keys %$ed) { my ($xt,$yt) = @{$xy{$nk}}; my $src = ' (thin air)'; my ($xs,$ys) = ($xt,$yt); if($ed->{$ek}->{source}) { $src = $ed->{$ek}->{source}; print "$src --$ek--> $nk\n"; ($xs,$ys) = @{$xy{$src}}; } else { $_ = $_-400 for $xs,$ys; $_ = $_*1.3 for $xs,$ys; my $dx = $ys*0.3; my $dy = -$xs*0.3; $xs += $dx; $ys += $dy; $_ = $_+400 for $xs,$ys; $src = "$nk (thin~ air)"; $pts{$src} = {x=>$xs,y=>$ys,col=>'#8888aa'}; } #$can->createLine($xs,$ys,$xt,$yt,-fill=>'#ffffff',-width=>3); push @trans, {from=>$src, to=>$nk, col=>'#ffffff'} } #print " Key found: $k\n"; my ($x,$y) = @{$xy{$nk}}; $pts{$nk} = {x=>$x,y=>$y,col=>'#8888aa'}; } $picker = Graphy::display( $can, \%pts, \@trans, [], {circr=>42, linescale=>5} ); { my ($x0,$y0,$x1,$y1) = (); if($hl[0]) { my $o = $nodes{$hl[0]}; ($x0, $y0) = @{$xy{$hl[0]}}; my $r = 46; $can->createOval($x0-$r,$y0-$r,$x0+$r,$y0+$r,-fill=>undef,-outline=>'#ff00ff',-width=>6); } if($hl[1]) { my $o = $nodes{$hl[1]}; ($x1, $y1) = @{$xy{$hl[1]}}; my $r = 50; $can->createOval($x1-$r,$y1-$r,$x1+$r,$y1+$r,-fill=>undef,-outline=>'#ff00ff',-width=>9); my $minr = 12; $can->createOval($x1-$minr,$y1-$minr,$x1+$minr,$y1+$minr,-fill=>'#8800ff',-outline=>'#ffffff'); $can->createLine($x0,$y0,$x1,$y1,-fill=>'#8800ff',-width=>$minr); } } } sub show_ { $can->delete('all'); for my $nk(sort keys %nodes) { my $ed = $nodes{$nk}->{edges}; for my $ek(sort keys %$ed) { my ($xt,$yt) = @{$xy{$nk}}; my $src = ' (thin air)'; my ($xs,$ys) = ($xt,$yt); if($ed->{$ek}->{source}) { $src = $ed->{$ek}->{source}; print "$src --$ek--> $nk\n"; ($xs,$ys) = @{$xy{$src}}; } else { $_ = ($_-400)*1.2+400 for $xs,$ys; } $can->createLine($xs,$ys,$xt,$yt,-fill=>'#ffffff',-width=>3); } #print " Key found: $k\n"; } for my $nk(sort keys %nodes) { my ($x,$y) = @{$xy{$nk}}; $can->createOval($x-7,$y-7,$x+7,$y+7,-fill=>'#ffffff'); $can->createText($x,$y,-fill=>'#8888ff',-text=>$nk); } }