← Back to branch summary

~ubuntu-branches/ubuntu/trusty/horae/trusty

« back to all changes in this revision

Viewing changes to hephaestus_parts/head.pl

  • Committer: Bazaar Package Importer
  • Author(s): Carlo Segre
  • Date: 2008-02-23 23:13:02 UTC
  • mfrom: (2.1.2 hardy)
  • Revision ID: james.westby@ubuntu.com-20080223231302-mnyyxs3icvrus4ke
Tags: 066-3
Apply patch to athena_parts/misc.pl for compatibility with 
perl-tk 804.28.

Show diffs side-by-side

added added

removed removed

Lines of Context:
hephaestus_parts/head.pl
3
3
## Hephaestus: a souped-up periodic table for the absorption
4
4
##             spectroscopist
5
5
##
6
 
##                  Hephaestus is copyright (c) 2004-2006 Bruce Ravel
 
6
##                  Hephaestus is copyright (c) 2004-2007 Bruce Ravel
7
7
##                                                     bravel@anl.gov
8
8
##                                  http://cars9.uchicago.edu/~ravel/
9
9
##
10
 
##                   Ifeffit is copyright (c) 1992-2006 Matt Newville
 
10
##                   Ifeffit is copyright (c) 1992-2007 Matt Newville
11
11
##                                         newville@cars.uchicago.edu
12
12
##                       http://cars9.uchicago.edu/~newville/ifeffit/
13
13
##
46
46
 
47
47
 
48
48
 
49
 
BEGIN {
50
 
  ## make sure the pgplot environment is sane...
51
 
  ## these defaults assume that the pgplot rpm was installed
52
 
  $ENV{PGPLOT_DIR} ||= '/usr/local/share/pgplot';
53
 
  $ENV{PGPLOT_DEV} ||= '/XSERVE';
54
 
};
 
49
## BEGIN {
 
50
##   ## make sure the pgplot environment is sane...
 
51
##   ## these defaults assume that the pgplot rpm was installed
 
52
##   $ENV{PGPLOT_DIR} ||= '/usr/local/share/pgplot';
 
53
##   $ENV{PGPLOT_DEV} ||= '/XSERVE';
 
54
## };
55
55
 
56
56
use warnings;
57
57
use strict;
88
88
 
89
89
 
90
90
use vars qw($VERSION);
91
 
$VERSION = '0.15';
 
91
$VERSION = '0.17';
92
92
 
93
93
my $is_windows = (($^O eq 'MSWin32') or ($^O eq 'cygwin'));
94
94
## my $is_darwin  = (lc($^O) eq 'darwin');
115
115
};
116
116
my %config;
117
117
tie %config, 'Config::IniFiles', (-file=>$personal_rcfile, -import=>$system_config_ref);
118
 
my $config_ref = tied %config;
 
118
#my $config_ref = tied %config;
119
119
 
120
120
## sanity check the config file and transfer the values into the %data hash
121
121
my %data;
122
 
&verify_config;
 
122
verify_config(tied %config);
123
123
 
124
124
if ($config{general}{ifeffit}) {
125
125
  require Ifeffit;
126
126
  import Ifeffit;
127
127
};
128
128
 
129
 
## use Data::Dumper;
130
 
## print Data::Dumper->Dump([$config_ref], [qw(*config)]);
131
 
 
132
129
 
133
130
my $current = "";
134
131
## absorption data
154
151
  close I;
155
152
};
156
153
 
157
 
tie %userformulas, 'Config::IniFiles', (-file=>File::Spec->catfile($horae_lib, 'hephaestus.data'))
 
154
tie %userformulas, 'Config::IniFiles', (-file=>Ifeffit::FindFile->find("hephaestus", "data"))
158
155
    if (-e File::Spec->catfile($horae_lib, 'hephaestus.data'));
159
156
foreach my $k (keys %{$userformulas{data}}) {
160
157
  next if ($k eq '^^^^');
172
169
 
173
170
my  $top = MainWindow->new(-class=>'horae');
174
171
$top -> withdraw;
 
172
$top -> optionAdd('*font', $config{fonts}{small});
 
173
 
175
174
 
176
175
my $splash = $top->Splashscreen();
177
176
$splash -> Label(-image      => $top -> Photo(-file => File::Spec->catfile($hephaestus_lib, "vulcan.gif")),
179
178
  -> pack(qw/-fill both -expand 1 -side left/);
180
179
$splash -> Label(-text       => " Hephaestus $VERSION\nis starting ...",
181
180
                 -background => 'white',
182
 
                 -font       => 'Helvetica 14 bold')
 
181
                 -font       => $config{fonts}{largebold},)
183
182
  -> pack(qw/-fill both -expand 1 -side right/);
184
183
$splash -> Splash;
185
184
$top -> update;
187
186
$top -> setPalette(foreground     => 'black',
188
187
                   background     => $bgcolor,
189
188
                   highlightColor => 'DarkSlateBlue',
190
 
                   #font                  => 'Helvetica 10 bold'
 
189
                   -font          => $config{fonts}{smbold},
191
190
                   );
192
191
my $iconbitmap = File::Spec->catfile($hephaestus_lib, "hephaestus_icon.xbm");
193
192
$top -> iconbitmap('@'.$iconbitmap);
195
194
$top -> bind('<Control-Key-0>' => \&help);
196
195
 
197
196
 
198
 
$top -> configure(-menu=> my $menubar = $top->Menu(-relief=>'ridge'));
 
197
$top -> configure(-menu=> my $menubar = $top->Menu(-relief=>'ridge', -font=>$config{fonts}{smbold}));
199
198
 
200
199
 
201
200
## common widget arguments
202
 
my @label_args     = qw(-foreground        blue4);
203
 
my @button_args    = qw(-foreground        seashell
204
 
                        -background        darkslateblue
205
 
                        -activeforeground  seashell
206
 
                        -activebackground  slateblue),
 
201
my $l_text = $config{fonts}{smbold};
 
202
my $b_text = $config{fonts}{smbold};
 
203
my @label_args     = (-foreground       => 'blue4',
 
204
                      -font             => $l_text);
 
205
my @button_args    = (-foreground       => 'seashell',
 
206
                      -background       => 'darkslateblue',
 
207
                      -activeforeground => 'seashell',
 
208
                      -activebackground => 'slateblue',
 
209
                      -font             => $b_text),
207
210
 
208
211
 
209
212
my @answer_args = (-foreground=>'black',
234
237
use vars qw($title);
235
238
$title = $main -> Label(-foreground=>'#49007a',
236
239
                        #-background=>'white',
237
 
                        -font=>'Helvetica 12 bold',
 
240
                        -font=>$config{fonts}{medbold},
238
241
                        -relief=>'ridge')
239
242
  -> pack(-fill=>'x', -pady=>8, -padx=>4);
240
243
 
339
342
## event, and input focus)
340
343
 
341
344
my $file_menu = $menubar->cascade(-label => '~File',
 
345
                                  -font => $config{fonts}{smbold},
342
346
                                  -menuitems =>[@menuitems,
343
347
                                                "-",
344
348
                                                [ command      =>'~Quit',
407
411
 
408
412
You are using Perl $] and Perl/Tk $Tk::VERSION
409
413
 
410
 
copyright � 2004-2006 Bruce Ravel
 
414
copyright � 2004-2007 Bruce Ravel
411
415
http://cars9.uchicago.edu/~ravel/software/
412
416
bravel\@anl.gov";
413
417
my $help_menu = $menubar->cascade(-label => '~Help',
417
421
                                                 [ command=>'~About',
418
422
                                                  -command=> sub{$top->Dialog(-title   => "About Hephaestus",
419
423
                                                                              -text    => $About_text,
420
 
                                                                              -font    => 'Helvetica 10',
 
424
                                                                              -font    => $config{fonts}{small},
421
425
                                                                              -buttons => ["OK"],
422
426
                                                                              -bitmap  => "info")
423
427
                                                                   -> Show;
428
432
## set up the various frames needed by the utilities
429
433
use vars qw($periodic_table %bottom);
430
434
$periodic_table = periodic_table($main);
 
435
$top -> packPropagate(1);
431
436
foreach my $k (keys %frames) {
432
437
  eval "\$bottom{$k} = setup_$k(\$main)";
433
438
};
438
443
 
439
444
## display the absorption utility at startup, but make sure the window
440
445
## is big enough for both the transition chart and the periodic table
441
 
$top -> packPropagate(1);
442
446
&trans;
443
447
$top -> update;
444
448
my @geom = ($top->width, $top->height);
445
449
&ion;
446
450
$top -> update;
447
 
($geom[0] = $top->width)  if ($geom[0] < $top->width);
448
 
($geom[1] = $top->height) if ($geom[1] < $top->height);
449
 
&absorption;
450
 
$top -> update;
451
 
($geom[0] = $top->width)  if ($geom[0] < $top->width);
452
 
($geom[1] = $top->height) if ($geom[1] < $top->height);
 
451
if (not $is_windows) {
 
452
  ($geom[0] = $top->width)  if ($geom[0] < $top->width);
 
453
  ($geom[1] = $top->height) if ($geom[1] < $top->height);
 
454
  &ion;
 
455
  $top -> update;
 
456
  ($geom[0] = $top->width)  if ($geom[0] < $top->width);
 
457
  ($geom[1] = $top->height) if ($geom[1] < $top->height);
 
458
  &absorption;
 
459
  $top -> update;
 
460
  ($geom[0] = $top->width)  if ($geom[0] < $top->width);
 
461
  ($geom[1] = $top->height) if ($geom[1] < $top->height);
 
462
};
453
463
$top -> geometry(join("x", @geom)) unless $is_windows;
 
464
$top -> update;
454
465
$top -> packPropagate(0);
455
466
 
456
467
STARTUP: {
463
474
  &line,       last STARTUP if  (lc($config{general}{startup}) eq 'line');
464
475
  &f1f2,       last STARTUP if ((lc($config{general}{startup}) eq 'f1f2') and ($config{general}{ifeffit}));
465
476
};
466
 
$top -> update;
467
 
 
468
 
 
469
 
## if ($is_windows) {
470
 
##   open PARID, ">".Ifeffit::FindFile->find("hephaestus", "par") :
471
 
##   print PARID $ENV{PAR_TEMP}, $/;
472
 
##   close PARID;
473
 
## };
474
477
 
475
478
 
476
479
$top -> title('Hephaestus');
501
504
sub periodic_table {
502
505
  my $table = $_[0] -> Frame(-borderwidth=>2, -relief=>'ridge');
503
506
  my $frame = $table -> Frame()
504
 
    -> pack(-side=>'top', -fill=>'x');
 
507
    -> pack(-side=>'top', -fill=>'x', -padx=>2, -pady=>2);
505
508
  my $trans = $table -> Frame()
506
 
    -> pack(-side=>'bottom');
 
509
    -> pack(-side=>'bottom', -padx=>2, -pady=>2);
507
510
 
508
511
 
509
512
  # columns: 0 -- 17    rows: 0 -- 8
623
626
                        -background       => 'darkslategrey',
624
627
                        -activeforeground => 'black',
625
628
                        -activebackground => 'slategrey',
626
 
                        -font             => 'Helvetica 10 bold');
 
629
                        -font             => $config{fonts}{smbold});
627
630
  my @semimetal_args = (-foreground       => 'seashell',
628
631
                        -background       => 'khaki4',
629
632
                        -activeforeground => 'black',
630
633
                        -activebackground => 'khaki3',
631
 
                        -font             => 'Helvetica 10 bold');
 
634
                        -font             => $config{fonts}{smbold});
632
635
  my @nonmetal_args  = (-foreground       => 'seashell',
633
636
                        -background       => 'cadetblue4',
634
637
                        -activeforeground => 'black',
635
638
                        -activebackground => 'cadetblue3',
636
 
                        -font             => 'Helvetica 10 bold');
 
639
                        -font             => $config{fonts}{smbold});
637
640
  my @gas_args       = (-foreground       => 'seashell',
638
641
                        -background       => 'goldenrod4',
639
642
                        -activeforeground => 'black',
640
643
                        -activebackground => 'goldenrod3',
641
 
                        -font             => 'Helvetica 10 bold');
 
644
                        -font             => $config{fonts}{smbold});
642
645
 
643
646
  ## -------------------------------------------------------------------
644
647
  ## set up periodic table
659
662
                                    @button_args,
660
663
                                    -command => [\&multiplexer, $s])
661
664
        -> grid(-column=>$c, -row=>$r, -sticky=>'ew');
 
665
      $button -> bind('<ButtonPress-3>' =>
 
666
                      sub {
 
667
                        return if ($current ne "absorption");
 
668
                        $data{abs_filter} = $s;
 
669
                      });
662
670
    } else {                    # lanthandes and actinides
663
671
      my $button = $trans -> Button(-text    => $s,
664
672
                                    -width   => ($is_windows) ? 3 : 1,
665
673
                                    @button_args,
666
674
                                    -command => [\&multiplexer, $s])
667
675
        -> grid(-column=>$c, -row=>$r-7, -sticky=>'ew');
 
676
      $button -> bind('<ButtonPress-3>' =>
 
677
                      sub {
 
678
                        return if ($current ne "absorption");
 
679
                        $data{abs_filter} = $s;
 
680
                      });
668
681
    };
669
682
  };
670
683
 
684
697
#           pt_explain    => "Using Elam database\nComputing total cross-section",
685
698
#           ion_resource  => "Using Elam database",);
686
699
sub verify_config {
 
700
  my ($config_ref) = @_;
687
701
  delete $config{general}{dummy_parameter};
688
702
 
689
703
  ## general
748
762
    $data{sample_energy} = e2l(9000);
749
763
  };
750
764
  Xray::Absorption -> load($data{resource});
 
765
 
 
766
  ## fallbacks for font settings
 
767
  $config{fonts}{small}     ||= 'Helvetica 10';
 
768
  $config{fonts}{smfixed}   ||= 'Courier 10';
 
769
  $config{fonts}{fixed}     ||= 'Courier 11';
 
770
  $config{fonts}{largebold} ||= 'Helvetica 14 bold';
 
771
  $config{fonts}{medbold}   ||= 'Helvetica 12 bold';
 
772
  $config{fonts}{smbold}    ||= 'Helvetica 10 bold';
 
773
 
 
774
  ## use Data::Dumper;
 
775
  ## print Data::Dumper->Dump([$config_ref], [qw(*config)]);
 
776
 
751
777
  $config_ref -> WriteConfig(Ifeffit::FindFile->find("hephaestus", "rc_personal"));
752
778
};
753
779
 
759
785
  $bottom{$current} -> packForget if $current;
760
786
  $frames{$current} -> configure(-relief=>'flat') if ($current and ($current ne 'help'));
761
787
  $current = "help";
762
 
  $bottom{help} -> pack(-side=>'top', -pady=>4, -expand=>1, -fill=>'both');
 
788
  $bottom{help} -> pack(-side=>'top', -pady=>4, -fill=>'both', -expand=>1);
763
789
  $title->configure(-text=>'Hephaestus Document');
764
790
};