#!/usr/bin/perl -w
######################################################################
##  This program is copyright (c) 2001 Bruce Ravel
##  <ravel@phys.washington.edu>
##  http://feff.phys.washington.edu/~ravel/
##
## -------------------------------------------------------------------
##     All rights reserved. This program is free software; you can
##     redistribute it and/or modify it under the same terms as Perl
##     itself.
##
##     This program is distributed in the hope that it will be useful,
##     but WITHOUT ANY WARRANTY; without even the implied warranty of
##     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##     Artistic License for more details.
## -------------------------------------------------------------------
######################################################################

use Xray::Absorption;
Xray::Absorption -> load("elam");
use Chemistry::Formula qw(parse_formula formula_data);
use strict;
use Tk;
use Tk::widgets qw(LabFrame Frame Button Entry Label Listbox
		   Checkbutton Scrollbar Text);
use File::Spec;

my $top = MainWindow->new(-class=>'horae');
$top -> setPalette(foreground=>'black', background=>'cornsilk3',
		   highlightColor=>'black');
$top -> title('TkFormula');
$top -> iconname('TkFormula');
$top -> bind('<Control-q>' => sub{exit});

$top -> iconbitmap('@'.File::Spec->catfile($Chemistry::Formula::install_dir, "morter.xbm"))
  unless (($^O eq 'MSWin32') or ($^O eq 'cygwin'));

my ($string, $energy, $density, $special) = ("", 10000, "", "");
my (%formula, %density);
&formula_data(\%formula, \%density);

my @button_font = ($^O eq "MSWin32") ?
  qw(-font system):
  qw(-font -*-Helvetica-Bold-R-Normal--10-*-*-*-*-*-*-*) ;
my @button_args    = qw(-foreground        seashell
			-background        firebrick4
			-activeforeground  seashell
			-activebackground  firebrick3
			-width             9);

## formula entry
my $frame = $top -> Frame(-relief=>'flat', -borderwidth=>3)
  -> pack(-fill=>'x', -side=>"top");
my $label = $frame -> Label(-text=>'Formula:')
  -> pack(-side=>'left');
my $entry = $frame -> Entry(-width=>40, -textvariable=>\$string)
  -> pack(-side=>'right', -fill=>'x', -expand=>1, -padx=>3);

## energy and density
$frame = $top -> Frame(-relief=>'flat', -borderwidth=>3)
  -> pack();

my $left = $frame -> Frame(-relief=>'flat', -borderwidth=>3)
  -> pack(-side=>'left');

my $right = $frame -> Frame(-relief=>'flat', -borderwidth=>3)
  -> pack(-side=>'left');

$label = $right -> Label(-text=>'Energy')
  -> pack(-side=>'top', -padx=>3);
$entry = $right -> Entry(-width=>9, -textvariable=>\$energy)
  -> pack(-side=>'top', -padx=>3);
$label = $right -> Label(-text=>'Density')
  -> pack(-side=>'top', -padx=>3);
$entry = $right -> Entry(-width=>9, -textvariable=>\$density)
  -> pack(-side=>'top', -padx=>3);
## my $button = $frame -> Button(-text=>'Select', -width=>2,
## 			      @button_args, @button_font,
## 			      -command=>\&select_energy)
##   -> pack(-side=>'right', -padx=>3);

## top button bar
my $button = $right -> Button(-text=>'Compute', -width=>2,
			      @button_args, @button_font,
			      -command=>\&parse_it)
  -> pack(-side=>'right', -padx=>3, -expand=>1, pady=>10);


my $labframe = $left -> LabFrame(-label=>'Known materials', -labelside=>'acrosstop')
  -> pack(-expand=>1, -fill=>'both');

my $lb = $labframe
  -> Scrolled('Listbox', -selectmode=>'single', -scrollbars=>'e',
	      -width=>30, -height=>10)
  -> pack(-expand=>1, -fill=>'both');
$lb -> Subwidget("yscrollbar") -> configure(-background=>'cornsilk3');

$lb -> insert('end', '-- none --');
foreach my $s (sort(keys %formula)) {
  $lb -> insert('end', $s);
};
$lb -> bind('<ButtonRelease-1>' =>
	    sub{
	      my $s = $lb->get('active');
	      (($string, $density) = ("", "")), return if ($s =~ /none/);
	      $special = $s;
	      $string  = $formula{$s};
	      $density = $density{$s};
	    });

## results
my $box = $top -> Scrolled("Text", -scrollbars=>'e', -height=>15, -width=>48,
			   -relief=>'sunken', -wrap=>'word')
  -> pack();
$box -> Subwidget("yscrollbar") -> configure(-background=>'cornsilk3');
$box -> tagConfigure('margin', -lmargin1=>4, -lmargin2=>4);
$box -> tagConfigure('error', -lmargin1=>4, -lmargin2=>4, -foreground=>'red3');


## bottom button bar
$frame = $top -> Frame(-relief=>'flat', -borderwidth=>3)
  -> pack(-fill=>'x', -side=>"bottom");
$button = $frame -> Button(-text=>'Exit', -width=>2,
			   @button_args, @button_font,
			   -command=>sub{exit})
  -> pack(-side=>'left', -padx=>3, -expand=>1);
$button = $frame -> Button(-text=>'Help', -width=>2,
			   @button_args, @button_font,
			   -command=>\&give_help)
  -> pack(-side=>'left', -padx=>3, -expand=>1);



## -------------------------------------------------------------------
MainLoop();



## -------------------------------------------------------------------
## subroutines


sub parse_it {
  $box -> delete(qw/1.0 end/);
  my %count;
  unless ($string) {
    $box -> insert('end', "\nNo formula.\n", ['error']);
    return;
  };
  my $ok = parse_formula($string, \%count);
  if ($ok) {
    my ($weight, $xsec, $answer, $dens) = (0,0,"\n",$density);
    $dens = ($density =~ /^(\d+\.?\d*|\.\d+)$/) ? $density : 0;
    $answer .= "  element   number   barns/atom     cm^2/gm\n";
    $answer .= " --------- ----------------------------------\n";
    my ($barns_per_formula_unit, $amu_per_formula_unit) = (0,0);  # 1.6607143
    foreach my $k (sort (keys(%count))) {
      $weight  += Xray::Absorption -> get_atomic_weight($k) * $count{$k};
      my $scale = Xray::Absorption -> get_conversion($k);
      my $this = Xray::Absorption -> cross_section($k, $energy);
      $barns_per_formula_unit += $this * $count{$k};
      $amu_per_formula_unit += Xray::Absorption -> get_atomic_weight($k) * $count{$k};
      if ($count{$k} > 0.001) {
	$answer  .= sprintf("    %-2s %11.3f %11.3f  %11.3f\n",
			    $k, $count{$k}, $this, $this/$scale);
      } else {
	$answer  .= sprintf("    %-2s      %g      %g      %g\n",
			    $k, $count{$k}, $this, $this/$scale);
      };
    };
    ## 1 amu = 1.6607143 x 10^-24 gm
    $xsec = $barns_per_formula_unit / $amu_per_formula_unit / 1.6607143;
    $answer .= sprintf("\nThis weighs %.3f amu.\n", $weight);
    if ($xsec == 0) {
      $answer .= "(Energy too low or not provided.\nAbsorption calculation skipped.)";
    } else {
      $xsec *= $dens;
      if ($xsec > 0) {
	if (10000/$xsec > 500) {
	  $answer .=
	    sprintf("\nAbsorbtion length = %.3f cm at %.2f eV.\n",
		    1/$xsec, $energy);
	} else {
	  $answer .=
	    sprintf("\nAbsorbtion length = %.1f micron at %.2f eV.\n",
		    10000/$xsec, $energy);
	}
      } else {
	$answer .=
	  "(The absorption length calculation\nrequires a value for density.)";
      };
    };
    $box -> insert('end', $answer, ['margin']);
  } else {
    $box -> insert('end', "\nInput error:\n\t".$count{error}, ['error']);
  };
  $box -> yviewMoveto(1);
};



sub select_energy {
  $box -> delete(qw/1.0 end/);
  $box -> insert('end', <<EOH, ['margin']);

A periodic table energy entry will be
available eventually.


EOH
};

sub give_help {
  $box -> delete(qw/1.0 end/);
  my $message = <<EOH

TkFormula is a small application for computing the absorption length
of a material given its chemical formula, its density, and the energy
of the incident photons.

The rules for entering the chemical formulas are pretty flexibe, but
do require some care by the user.  Element symbols must be capitalized
and, if the symbol is two letters, the second letter must be lower
case.  Parantheses and bracket, as used in chemical formulas, are
allowed, but care must be taken that there are equal numbers of open
and close parens or brackets.  Spaces are allowed in the formula -- so
"PbTiO3" and "Pb Ti O3" mean the same thing.  Also the sorts of
mark-up symbols found in LaTeX or the output from an INSPEC search are
allowable as well.

Once you have entered the formula, the density, and the incident energy,
just press the button labeled "Compute".


EOH
    ;
  $message =~ s/\n\n/<NL>/g;
  $message =~ s/\n/ /g;
  $message =~ s/<NL>/\n\n/g;
  $box -> insert('end', $message, ['margin']);
};
