#!/usr/bin/perl -w
# -*- perl -*-

#
# $Id: tkgvizmakefile,v 1.3 2002/10/18 16:14:36 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2002 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: slaven.rezic@berlin.de
# WWW:  http://www.rezic.de/eserte/
#

use GraphViz::Makefile;
use strict;
use vars qw($VERSION);
$VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);

{
    package GraphViz;
    use GraphViz;

    sub as_tk_canvas {
	my($self, $c) = @_;
	GraphViz::TkCanvas::graphviz($c, $self->as_plain);
    }
}

{
    package GraphViz::TkCanvas;
    use Text::ParseWords qw(shellwords);

    sub graphviz {
	my($c, $text) = @_;

	my $tfm = sub { my($x,$y) = @_; ($x*100,$y*100) };
	foreach my $l (split /\n/, $text) {
	    my(@w) = shellwords($l);
	    if ($w[0] eq 'graph') {
		$c->configure(-scrollregion => [$tfm->(0,0),$tfm->($w[2],$w[3])]);
	    } elsif ($w[0] eq 'node') {
		my($x,$y) = $tfm->($w[2],$w[3]);
		my($w,$h) = $tfm->($w[4],$w[5]);
		my $text = $w[6];
		$c->createOval($x-$w/2,$y-$h/2,$x+$w/2,$y+$h/2, -fill=>"gray");
		$c->createText($x,$y,-text => $text, -tag => ["rule","rule_$text"]);
	    } elsif ($w[0] eq 'edge') {
		my $no = $w[3];
		my @coords;
		for(my $i=0; $i<$no*2; $i+=2) {
		    push @coords, $tfm->($w[4+$i], $w[5+$i]);
		}
		$c->createLine(@coords, -arrow => "last", -smooth => 1);
	    } elsif ($w[0] eq 'stop') {
		return;
	    } else {
		warn "Ignore directive @w\n";
	    }
	}
    }
}

{
    package Tk::Canvas;

    # from Tk::CanvasUtil
    sub center_view {
	my($c, $x, $y, %args) = @_;
	my(@xview) = $c->xview;
	my(@yview) = $c->yview;
	my($xwidth) = $xview[1]-$xview[0];
	my($ywidth) = $yview[1]-$yview[0];
	my @scrollregion = ($Tk::VERSION == 800.017
			    ? $c->cget(-scrollregion)
			    : @{$c->cget(-scrollregion)});
	my $see_view = ($c->{Configure}{-seeview} ? $c->{Configure}{-seeview} : 'see_view');
	if (!defined $x || !defined $y) {
	    $c->$see_view(0.5, 0.5, %args);
	} else {
	    $c->$see_view
		(
		 ($x-$scrollregion[0])/($scrollregion[2]-$scrollregion[0])
		 - $xwidth/2,
		 ($y-$scrollregion[1])/($scrollregion[3]-$scrollregion[1])
		 - $ywidth/2,
		 %args
		);
	}
    }

    sub see_view {
	my($c, $tox, $toy) = @_;
	$c->xview('moveto' => $tox);
	$c->yview('moveto' => $toy);
    }

}

package main;
use Getopt::Long;

$ENV{MAKE}="make" if !defined $ENV{MAKE}; # to propagate MAKE to submakefiles

my $file       = "Makefile";
my $outputtype = "tkcanvas";
my $outputfile;
if (!GetOptions("f|file=s" => \$file,
		"T=s" => \$outputtype,
		"o=s" => \$outputfile,
		"v!"  => \$GraphViz::Makefile::V,
	       )) {
    require Pod::Usage;
    Pod::Usage::pod2usage(1);
}
my $rule = shift || "all";
my $gm = GraphViz::Makefile->new(undef, $file);
$gm->generate($rule);

if ($outputtype eq 'tkcanvas') {
    require Tk;
    my $mw = new MainWindow;
    my $c = $mw->Scrolled("Canvas")->pack(-fill=>"both", -expand=>1);
    $gm->{GraphViz}->as_tk_canvas($c);
    my @c = $c->coords("rule_$rule");
    $c->idletasks;
    $c->center_view($c[0],$c[1]);
    &Tk::MainLoop;
} else {
    my $meth = "as_" . $outputtype;
    if (!defined $outputfile) {
	die "-o is missing";
    }
    open(O, ">$outputfile") or die "Can't write to $outputfile: $!";
    binmode O;
    print O $gm->{GraphViz}->$meth();
    close O;
}

# REPO BEGIN
# REPO NAME is_in_path /home/e/eserte/src/repository 
# REPO MD5 1b42243230d92021e6c361e37c9771d1

sub is_in_path {
    my($prog) = @_;
    return $prog if (file_name_is_absolute($prog) and -f $prog and -x $prog);
    require Config;
    my $sep = $Config::Config{'path_sep'} || ':';
    foreach (split(/$sep/o, $ENV{PATH})) {
	if ($^O eq 'MSWin32') {
	    return "$_\\$prog"
		if (-x "$_\\$prog.bat" ||
		    -x "$_\\$prog.com" ||
		    -x "$_\\$prog.exe");
	} else {
	    return "$_/$prog" if (-x "$_/$prog");
	}
    }
    undef;
}
# REPO END

# REPO BEGIN
# REPO NAME file_name_is_absolute /home/e/eserte/src/repository 
# REPO MD5 a77759517bc00f13c52bb91d861d07d0

sub file_name_is_absolute {
    my $file = shift;
    my $r;
    eval {
        require File::Spec;
        $r = File::Spec->file_name_is_absolute($file);
    };
    if ($@) {
	if ($^O eq 'MSWin32') {
	    $r = ($file =~ m;^([a-z]:(/|\\)|\\\\|//);i);
	} else {
	    $r = ($file =~ m|^/|);
	}
    }
    $r;
}
# REPO END

=head1 NAME

tkgvizmakefile - create Tk graphs from Makefiles

=head1 SYNOPSIS

    tkgvizmakefile [-f makefile] [-T output] [-o outputfile] [rule]

=cut

