← Back to branch summary

~ubuntu-branches/ubuntu/vivid/horae/vivid

« back to all changes in this revision

Viewing changes to hephaestus_parts/absorption.pl

  • Committer: Bazaar Package Importer
  • Author(s): Carlo Segre
  • Date: 2006-12-26 11:54:29 UTC
  • Revision ID: james.westby@ubuntu.com-20061226115429-kjuhf6h9w6bohlwj
Tags: upstream-063
Import upstream version 063

Show diffs side-by-side

added added

removed removed

Lines of Context:
hephaestus_parts/absorption.pl
 
1
#! /usr/bin/perl -w
 
2
 
 
3
## ===========================================================================
 
4
##  This is the absorption portion of hephaestus
 
5
 
 
6
sub absorption {
 
7
  unless ($current =~ /$uses_periodic_regex/) {
 
8
    $periodic_table -> pack(-side=>'top', -padx=>4, -pady=>4, -fill=>'x');
 
9
  };
 
10
  $bottom{$current} -> packForget if $current;
 
11
  $frames{$current} -> configure(-relief=>'flat') if ($current and ($current ne 'help'));
 
12
  $current = "absorption";
 
13
  $frames{$current} -> configure(-relief=>'ridge');
 
14
  $bottom{absorption} -> pack(-side=>'top', -anchor=>'n', -fill=>'x', -expand=>1);
 
15
  $title->configure(-text=>'Periodic Table of Absorption Data');
 
16
  $data{pt_resource} -> grid(-column=>3, -columnspan=>7, -row=>0, -rowspan=>3, , -sticky=>'w');
 
17
};
 
18
 
 
19
 
 
20
sub setup_absorption {
 
21
  my $frame = $_[0] -> Frame(-borderwidth=>2, -relief=>'flat');
 
22
 
 
23
 
 
24
  ## energy and thickness entry widgets
 
25
  $data{abs_energy_label} = $frame -> Label(-text=>'Energy', @label_args)
 
26
    -> grid(-column=>0, -row=>4, -sticky=>'w');
 
27
  my $entry = $frame -> Entry(-width=>9, -textvariable=>\$data{abs_energy},
 
28
                              -validate=>'key', -validatecommand=>\&set_variable)
 
29
    -> grid(-column=>1, -row=>4, -sticky=>'ew');
 
30
  $data{abs_units_label} = $frame -> Label(-text=>"eV", @label_args)
 
31
    -> grid(-column=>2, -row=>4, -sticky=>'w');
 
32
 
 
33
  my $label = $frame -> Label(-text=>'Thickness', @label_args)
 
34
    -> grid(-column=>0, -row=>5, -sticky=>'w');
 
35
  $entry = $frame -> Entry(-width=>9, -textvariable=>\$data{abs_thickness},
 
36
                           -validate=>'key', -validatecommand=>\&set_variable)
 
37
    -> grid(-column=>1, -row=>5, -sticky=>'ew');
 
38
  $label = $frame -> Label(-text=>'�m', @label_args)
 
39
    -> grid(-column=>2, -row=>5, -sticky=>'w');
 
40
 
 
41
 
 
42
  my $r = -1;
 
43
  foreach my $l ('Name', 'Number', 'Weight', 'Density',
 
44
                 'Absorption Length', 'Transmitted Fraction') {
 
45
    $r=5 if ($l eq 'Absorption Length');
 
46
    $label = $frame -> Label(-text=>$l, @label_args)
 
47
      -> grid(-column=>0, -row=>++$r, -sticky=>'w', -padx=>2);
 
48
    $entry = $frame -> Label(-relief=>'flat', -textvariable=>\$data{"abs_$l"},
 
49
                             -width=>12, -anchor=>'w', -font=>'Helvetica 10', @answer_args)
 
50
      -> grid(-column=>1, -row=>$r, -sticky=>'e', -padx=>2);
 
51
  };
 
52
 
 
53
 
 
54
 
 
55
  ## Table of Edge energies
 
56
  my $edges = $frame -> Scrolled("HList",
 
57
                                 -columns    => 2,
 
58
                                 -header     => 1,
 
59
                                 -scrollbars => 'oe',
 
60
                                 -background => $bgcolor,
 
61
                                 -selectmode => 'extended',
 
62
                                 #-selectbackground => $bgcolor,
 
63
                                 -highlightcolor => $bgcolor,
 
64
                                 -width      => 15,
 
65
                                 -relief     => 'ridge',
 
66
                                 )
 
67
      -> grid(-column=>4, -row=>0, -rowspan=>9, -padx=>3);
 
68
  my @header_style_params = ('text', -font=>'Helvetica 10 bold', -anchor=>'center', -foreground=>'blue4');
 
69
  my @label_style_params  = ('text', -anchor=>'center', -foreground=>'blue4');
 
70
  my $header_style = $edges -> ItemStyle(@header_style_params);
 
71
  my $label_style  = $edges -> ItemStyle(@label_style_params);
 
72
  $edges -> headerCreate(0, -text          => "Edge",
 
73
                         -style            => $header_style,
 
74
                         -headerbackground => $bgcolor,
 
75
                         -borderwidth      => 1);
 
76
  $edges -> headerCreate(1, -text          => "Energy",
 
77
                         -style            => $header_style,
 
78
                         -headerbackground => $bgcolor,
 
79
                         -borderwidth      => 1);
 
80
  $edges -> columnWidth(0, -char=>6);
 
81
  $edges -> columnWidth(1, -char=>8);
 
82
  $edges -> Subwidget("yscrollbar")
 
83
    -> configure(-background=>$bgcolor, ($is_windows) ? () : (-width=>8));
 
84
  foreach my $e (qw(K L1 L2 L3 M1 M2 M3 M4 M5 N1 N2 N3 N4 N5 N6 N7
 
85
                    O1 O2 O3 O4 O5 P1 P2 P3)) {
 
86
    $edges -> add($e);
 
87
    $edges -> itemCreate($e, 0, -text=>$e, -style=>$label_style);
 
88
    $edges -> itemCreate($e, 1);
 
89
  };
 
90
  $energies{edges} = $edges;
 
91
 
 
92
  ## Table of Line energies
 
93
  my $lines = $frame -> Scrolled("HList",
 
94
                                 -columns    => 4,
 
95
                                 -header     => 1,
 
96
                                 -scrollbars => 'oe',
 
97
                                 -background => $bgcolor,
 
98
                                 -selectmode => 'extended',
 
99
                                 #-selectbackground => $bgcolor,
 
100
                                 -highlightcolor => $bgcolor,
 
101
                                 -width      => 36,
 
102
                                 -relief     => 'ridge',
 
103
                                 )
 
104
      -> grid(-column=>5, -row=>0, -rowspan=>9, -padx=>3, -sticky=>'ew');
 
105
  $header_style = $lines -> ItemStyle(@header_style_params);
 
106
  $label_style  = $edges -> ItemStyle(@label_style_params);
 
107
  $lines -> headerCreate(0, -text          => "Line",
 
108
                         -style            => $header_style,
 
109
                         -headerbackground => $bgcolor,
 
110
                         -borderwidth      => 1);
 
111
  $lines -> headerCreate(1, -text          => "Trans.",
 
112
                         -style            => $header_style,
 
113
                         -headerbackground => $bgcolor,
 
114
                         -borderwidth      => 1);
 
115
  $lines -> headerCreate(2, -text          => "Energy",
 
116
                         -style            => $header_style,
 
117
                         -headerbackground => $bgcolor,
 
118
                         -borderwidth      => 1);
 
119
  $lines -> headerCreate(3, -text          => "Prob.",
 
120
                         -style            => $header_style,
 
121
                         -headerbackground => $bgcolor,
 
122
                         -borderwidth      => 1);
 
123
  $lines -> columnWidth(0, -char=>9);
 
124
  $lines -> columnWidth(1, -char=>10);
 
125
  $lines -> columnWidth(2, -char=>9);
 
126
  $lines -> columnWidth(3, -char=>7);
 
127
  $lines -> Subwidget("yscrollbar")
 
128
    -> configure(-background=>$bgcolor, ($is_windows) ? () : (-width=>8));
 
129
  foreach my $e (qw(Ka1 Ka2 Ka3 Kb1 Kb2 Kb3 Kb4 Kb5
 
130
                    La1 La2 Lb1 Lb2 Lb3 Lb4 Lb5 Lb6
 
131
                    Lg1 Lg2 Lg3 Lg6 Ll Ln Ma Mb Mg Mz)) {
 
132
    $lines -> add($e);
 
133
    $lines -> itemCreate($e, 0, -text=>Xray::Absorption -> get_Siegbahn_full($e), -style=>$label_style);
 
134
    $lines -> itemCreate($e, 1, -text=>Xray::Absorption -> get_IUPAC($e),         -style=>$label_style);
 
135
    $lines -> itemCreate($e, 2);
 
136
    $lines -> itemCreate($e, 3);
 
137
  };
 
138
  $energies{lines} = $lines;
 
139
 
 
140
  return $frame;
 
141
};
 
142
 
 
143
 
 
144
 
 
145
 
 
146
 
 
147
sub get_foils_data {
 
148
  my $elem = $_[0];
 
149
  my $in_resource = Xray::Absorption -> in_resource($elem);
 
150
  map {$probs{$_} = ''} keys(%probs);
 
151
  ## enable writing in the entry widgets
 
152
  #map {$_ -> configure(-state=>'normal')} @all_entries;
 
153
  $data{abs_Name}    = get_name($elem);
 
154
  $data{abs_Number}  = get_Z($elem);
 
155
  my $z              = $data{abs_Number};
 
156
  $data{abs_Weight}  = Xray::Absorption -> get_atomic_weight($elem);
 
157
  $data{abs_Weight}  = ($data{abs_Weight}) ? $data{abs_Weight} . ' amu' : '' ;
 
158
  my $density    = Xray::Absorption -> get_density($elem);
 
159
  $data{abs_Density} = ($density) ? $density . ' g/cm^3' : '' ;
 
160
 
 
161
  my @edges = (qw(K L1 L2 L3 M1 M2 M3 M4 M5 N1 N2 N3 N4 N5 N6 N7
 
162
                    O1 O2 O3 O4 O5 P1 P2 P3));
 
163
  my @lines = (qw(Ka1 Ka2 Ka3 Kb1 Kb2 Kb3 Kb4 Kb5
 
164
                    La1 La2 Lb1 Lb2 Lb3 Lb4 Lb5 Lb6
 
165
                    Lg1 Lg2 Lg3 Lg6 Ll Ln Ma Mb Mg Mz));
 
166
 
 
167
  foreach my $e (@edges, @lines) {
 
168
    $energies{$e} = Xray::Absorption -> get_energy($elem, $e);
 
169
    $energies{$e} ||= '';
 
170
    unless ($e =~ /^(K|([LMNOP][1-7]))$/) {
 
171
      next unless $energies{$e};
 
172
      if ($Xray::Absorption::resource eq 'elam') {
 
173
        $probs{$e} =
 
174
          sprintf "%6.4f", Xray::Absorption -> get_intensity($elem, $e);
 
175
      };
 
176
    };
 
177
  };
 
178
 
 
179
  if (($z >= 22) and ($z <= 29)) {
 
180
    $energies{M4} = '';
 
181
    $energies{M5} = '';
 
182
  };
 
183
  if ($z <= 17) {
 
184
    $energies{M1} = '';
 
185
    $energies{M2} = '';
 
186
    $energies{M3} = '';
 
187
  };
 
188
  if ($data{units} eq "Wavelengths") {
 
189
    foreach (keys(%energies)) {
 
190
      next if ($_ eq 'lines');
 
191
      next if ($_ eq 'edges');
 
192
      $energies{$_} = &e2l($energies{$_});
 
193
    };
 
194
  };
 
195
 
 
196
  ## fill Edge and Line tables with these values
 
197
  my @data_style_params = ('text', -font=>'Helvetica 10', -anchor=>'e', -foreground=>'black');
 
198
  my $data_style   = $energies{edges} -> ItemStyle(@data_style_params);
 
199
  foreach my $e (@edges) {
 
200
    $energies{edges} -> itemConfigure($e, 1, -text=>$energies{$e}, -style=>$data_style);
 
201
  };
 
202
  $energies{edges} -> selectionClear;
 
203
  $energies{edges} -> anchorClear;
 
204
  $data_style   = $energies{lines} -> ItemStyle(@data_style_params);
 
205
  foreach my $l (@lines) {
 
206
    $energies{lines} -> itemConfigure($l, 2, -text=>$energies{$l}, -style=>$data_style);
 
207
    $energies{lines} -> itemConfigure($l, 3, -text=>$probs{$l}, -style=>$data_style);
 
208
  };
 
209
  $energies{lines} -> selectionClear;
 
210
  $energies{lines} -> anchorClear;
 
211
 
 
212
 
 
213
  ##My $is_gas = ($elem =~ /\b(Ar|Br|Cl|F|H|He|Kr|N|Ne|O|Rn|Xe)\b/);
 
214
  my $is_gas = ($elem =~ /\b(Ar|Cl|H|He|Kr|N|Ne|O|Rn|Xe)\b/);
 
215
 
 
216
  $data{'abs_Absorption Length'} = '';
 
217
  $data{'abs_Transmitted Fraction'}       = '';
 
218
  my $bail = 0;
 
219
  if ($data{abs_energy} and $in_resource) {
 
220
    if ((lc($data{resource}) eq "henke") and ($data{abs_energy} > 30000)) {
 
221
      my $dialog =
 
222
        $top -> Dialog(-bitmap         => 'info',
 
223
                       -text           => "The Henke tables only include data up to 30 keV.",
 
224
                       -title          => 'Hephaestus warning',
 
225
                       -buttons        => [qw/OK/],
 
226
                       -default_button => 'OK')
 
227
          -> Show();
 
228
      return;
 
229
    };
 
230
    if (($data{abs_energy} < $data{abs_odd_value}) and ($data{units} eq "Energies")) {
 
231
      my $dialog = $top -> DialogBox(-title=>"Hephaestus warning!",
 
232
                                     -buttons=>['OK', 'Cancel'],);
 
233
      $dialog -> add("Label", qw/-padx .25c -pady .25c -text/,
 
234
                     "You have chosen a very low energy.  Should I$/" .
 
235
                     "try to calculate the absorption length?$/" .
 
236
                     "(There might be no data at that energy!)",)
 
237
        -> pack(-side=>'left');
 
238
      my $answer = $dialog -> Show;
 
239
      ($answer eq 'Cancel') and $bail = 1;
 
240
    } elsif (($data{abs_energy} > $data{abs_odd_value}) and ($data{units} eq "Wavelengths")) {
 
241
      my $dialog = $top -> DialogBox(-title=>"Hephaestus warning!",
 
242
                                     -buttons=>['OK', 'Cancel'],);
 
243
      $dialog -> add("Label", qw/-padx .25c -pady .25c -text/,
 
244
                     "You have chosen a very large wavelnegth.  Should I$/" .
 
245
                     "try to calculate the absorption length?$/" .
 
246
                     "(There might be no data at that wavelength!)",)
 
247
        -> pack(-side=>'left');
 
248
      my $answer = $dialog -> Show;
 
249
      ($answer eq 'Cancel') and $bail = 1;
 
250
    };
 
251
    unless ($bail) {
 
252
      my $conv   = Xray::Absorption -> get_conversion($elem);
 
253
      ($data{units} eq "Wavelengths") and $data{abs_energy} = &e2l($data{abs_energy});
 
254
      my $barns  = Xray::Absorption -> cross_section($elem, $data{abs_energy}, $data{xsec});
 
255
      ($data{units} eq "Wavelengths") and $data{abs_energy} = &e2l($data{abs_energy});
 
256
      my $factor = ($is_gas) ? 1 : 10000;
 
257
      my $abslen = ($conv and $barns and $density) ?
 
258
        $factor/($barns*$density/$conv) : 0;
 
259
      $data{'abs_Absorption Length'} = '';
 
260
      if ($abslen) {
 
261
        $data{'abs_Absorption Length'}  =       sprintf "%8.2f", $abslen;
 
262
        $data{'abs_Absorption Length'} .= ($is_gas) ? ' cm' : ' �m';
 
263
        $data{'abs_Absorption Length'} =~ s/^\s+//;
 
264
      };
 
265
 
 
266
      $data{'abs_Transmitted Fraction'} = '';
 
267
      ##print join("  ", $conv, $barns, $density, $thickness, $abslen, $is_gas, $/);
 
268
      if ($data{abs_thickness} and $abslen) {
 
269
        my $factor = $data{abs_thickness} / $abslen;
 
270
        $data{'abs_Transmitted Fraction'} = sprintf ("%6.4g", exp(-1 * $factor));
 
271
      };
 
272
    };
 
273
  };
 
274
  ## and disable writing in the entry widgets once again
 
275
  #map {$_ -> configure(-state=>'disabled')} @all_entries;
 
276
}