#!/usr/local/bin/perl

use strict;
use Tk;

my $width = 1200;
my $step = $width;
my $m_height = 3;
my $base = 0;

my $m = MainWindow->new;
my $b = $m->Button(-text=>"Quit",-command=>sub {$m->destroy;});
my $c = $m->Canvas(-width=>$width);
$b->pack;
# $c->pack;
$c->pack(-expand => 'yes', -fill => 'both');

my $wsx = $m->Scrollbar( -orient=>"horiz", 
   -relief=>"sunken",-command=>[$c,"xview"]) ;

$c->configure(-xscrollcommand => ['set', $wsx]); 
# $c->configure(-xscrollcommand => sub { $wsx->set($c->xview); });

#    -yscrollcommand => ['set', $wsy]) ;
$c->configure(-scrollregion=>[0,0,$width,$m_height*2]);

$wsx->pack(-side => 'bottom', -fill => 'x');

$m->Button(-text=>'Enlarge',-command=>sub{scale($c,1.6)})
      ->pack(-side=>'left',-expand=>1);
$m->Button(-text=>'Shrink',-command=>sub{scale($c,0.625)})
      ->pack(-side=>'left',-expand=>1);

sub scale {
    my ($c,$scale) = @_;
    my ($w,$h) = ($c->geometry =~ /\d+x\d+([+-]\d+)([+-]\d+)/);
    my (@s) = $c->cget(-scrollregion);
# print "@s\n";
    my ($x,$y) = ($c->canvasx($w/2),$c->canvasy($h/2));

    $s[0] = ($s[0]-$x)*$scale+$x;
    $s[1] = ($s[1]-$y)*$scale+$y;
    $s[2] = ($s[2]-$x)*$scale+$x;
    $s[3] = ($s[3]-$y)*$scale+$y;

    $c->configure(-scrollregion=>\@s);
    $c->scale('all', $x,$y,$scale,$scale);
}


my $malloc_test = "./a.out";

open(TEST,"$malloc_test | sort|") or die("Cannot run $malloc_test $!\n");
my ($min,$max);
my @adr;
my @size;

while(<TEST>) {
    chop;
    # s/0x//g;
    my ($adr,$size) = split;
    $adr = hex($adr);
    $size = hex($size);
    $min = $adr if ($min==0||$adr<$min);
    $max = $adr if ($adr>$max);
    push(@adr,$adr);
    push(@size,$size);
}

# print "$width $max $min\n";
my $scale = $step/($max-$min);

# print "$scale $width $max $min\n";
# $m->update;
# exit;

for(my $i =0; $i<$#adr;$i++) {
    my $adr = ($adr[$i]-$min)*$scale;
    my $size = $size[$i]*$scale;

    my $y = int($adr/$width) * $m_height + $base;
    my $x = int($adr)%$width;

# print STDERR "$adr $size $x $y\n";

    $c->create('rectangle',$x,$y,$x+$size,$y+$m_height,-fill=>'green');
# ,$adr,5,$adr+$size,5+$m_height);
}

# &major(10,$base+20);
# &major(100,$base+25);
# &constant_major(0x1000,$base+3);
# &constant_major(0x100000,$base+8);

sub major {
    my ($div,$y) = @_;
    my ($px);
    for(my $i =0; $i<=$div;$i++) {
        my $adr = int($min+($max-$min)/$div*$i);
        my $x = ($adr-$min)*$scale;
#       $c->create('text',$x,$y,-text=>sprintf("0x%0x",$adr));
        if ($x) {
            $c->create('rectangle',$px,$y,$x,$y+5);
        }
        $px = $x;
    }
}

sub constant_major {
    my ($unit,$y) = @_;
    my ($px);
    for(my $i =$min; $i<$max;$i += $unit) {
        my $x = ($i-$min)*$scale;
        $c->create('text',$x,$y,-text=>sprintf("0x%0x",$i));
        if ($x) {
            $c->create('rectangle',$px,$y,$x,$y+2);
        }
        $px = $x;
    }
}

$m->MainLoop();

# end