#!/usr/bin/perl
# -- Mark J Cox, mark@awe.com, April 2006, http://www.awe.com/ha

use Tk;
use Tk::Font;
use strict;

my %GUI;
$GUI{main} = MainWindow->new(-background=>"white");
$GUI{main}->fontCreate("head", -family=>"helvetica",-size=>16);

# Find size of heading font
my $delmef = $GUI{main}->Frame()->pack();
my $delme = $delmef->Label(-text=>"Loading...",-font=>"head")->pack();
$GUI{main}->update;
$delmef->packForget;
my $xbm = &curve(5,$delmef->height+5);
$GUI{curve_l} = $GUI{main}->Photo('-format'=>'xpm',-data=>$xbm);
$xbm =~ s/(\"\.\.[^\"]+\")/reverse($1)/ge;
$GUI{curve_r} = $GUI{main}->Photo('-format'=>'xpm',-data=>$xbm);

&heading($GUI{main},"This is a test");
MainLoop();

sub curve 
{
    my ($width, $height) = @_;
    my $lead = "." x $width;
    my $xbm = sprintf("/* XPM */\n{\n\"%d %d 6 1\",\n",$width+8,$height);
    $xbm .= "\". c #FFFFFF\",\n\"+ c #DBEBF0\",\n\"8 c #A1D7EB\",\n";
    $xbm .= "\"1 c #59B9E1\",\n\": c #27A3D9\",\n\"A c #0095D6\",\n";
    $xbm .= "\"$lead....+8:A\",\n";
    $xbm .= "\"$lead...8:AAA\",\n";
    $xbm .= "\"$lead..8:AAAA\",\n";
    $xbm .= "\"$lead.+1AAAAA\",\n";
    $xbm .= "\"$lead.8AAAAAA\",\n";
    $xbm .= "\"$lead.1AAAAAA\",\n";
    $xbm .= "\"$lead.:AAAAAA\",\n";
    for (my $i = 0; $i < $height-12; $i++) {
        $xbm .= "\"$lead.AAAAAAA\",\n";
    }
    $xbm .= "\"$lead.AAA:1+.\",\n";
    $xbm .= "\"$lead.AA1+...\",\n";
    $xbm .= "\"$lead.A1+....\",\n";
    $xbm .= "\"$lead.:8.....\",\n";
    $xbm .= "\"$lead.1+.....\"\n};\n";
    return $xbm;
}

sub heading
{
    my ($frame,$title) = @_;

    $frame->Label(-image=>$GUI{curve_l},-borderwidth=>0) \
->pack(-side=>"left",-anchor=>"n");
    $frame->Label(-image=>$GUI{curve_r},-borderwidth=>0) \
->pack(-side=>"right",-anchor=>"n");
    return unless $title;
    return $frame->Label(-text=>$title,-font=>"head",-background=>"#0095D6", \
-foreground=>"white")->pack(-fill=>"x");
}