9
## make sure the pgplot environment is sane...
10
## these defaults assume that the pgplot rpm was installed
11
$ENV{PGPLOT_DIR} ||= '/usr/local/share/pgplot';
12
$ENV{PGPLOT_DEV} ||= '/XSERVE';
9
## ## make sure the pgplot environment is sane...
10
## ## these defaults assume that the pgplot rpm was installed
11
## $ENV{PGPLOT_DIR} ||= '/usr/local/share/pgplot';
12
## $ENV{PGPLOT_DEV} ||= '/XSERVE';
15
15
die "Athena requires Tk version 800.022 or later\n" if ($Tk::VERSION < 800.022);
25
26
## need to explicitly state all Tk modules used for the sake of PAR
26
use Tk::widgets qw(Wm FileSelect FBox Frame NoteBook FileDialog Checkbutton
27
use Tk::widgets qw(Wm FileSelect FBox Frame NoteBook Checkbutton
27
28
Menu Menu/Item Menubutton Canvas Radiobutton Text Balloon
28
29
Optionmenu Bitmap Dialog ROText TextUndo Pane Entry Label
29
30
FireButton NumEntryPlain NumEntry LabFrame
30
Pod Pod/Text Pod/Search Pod/Tree More
31
Pod Pod/Text Pod/Search Pod/Tree More DirTree
31
32
Splashscreen Photo waitVariableX ColorEditor
32
33
KeyEntry RetEntry BrowseEntry HList DialogBox);
33
34
### wtf?!?! PerlApp needs these lines:
38
38
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
39
39
use Chemistry::Elements qw(get_Z get_symbol);
204
205
deg_do => 0, trun_do => 0, trun_beforeafter => 'after',
205
206
int_do => 0, al_do => 0, par_do=>0, mark_do=>0);
206
207
my %lcf_data = ();
208
my %mee_energies = ();
208
210
## the maximum amount of heap space in Ifeffit as we begin our work.
209
211
## This will be used in the memory check each time a group is read in.
221
223
## set up main window and post splashscreen
222
224
my $top = MainWindow->new(-class=>'horae');
223
225
$top -> withdraw;
226
$top -> optionAdd('*font', 'Helvetica 14 bold');
227
$top -> optionAdd('*font', 'Helvetica 10 bold');
224
228
my $splash_background = 'antiquewhite2';
225
229
my $splash = $top->Splashscreen(-background => $splash_background);
226
230
my $splash_image = $top -> Photo(-file => $groups{"Default Parameters"} -> find('athena', 'logo'));
232
236
-> pack(qw/-fill both -expand 1/);
233
237
my $splash_status = $splash -> Label(-text => q{},
234
238
-background => $splash_background,
235
-font => 'Helvetica 9 bold',
239
-font => 'Helvetica 10 bold',
236
240
-justify => 'left',
237
241
-borderwidth=> 2,
238
242
-relief => 'ridge')
322
326
$config_ref -> WriteConfig($personal_rcfile);
323
327
unlink $dummy_rcfile;
330
foreach my $fonttype (keys %{ $config{fonts} }) {
331
$top -> optionAdd('*font', $config{fonts}{$fonttype});
333
$top -> optionAdd('*font', $config{fonts}{med});
335
$config{list}{real_x1} = $config{list}{x1} || 0.8;
336
$config{list}{real_x2} = $config{list}{x2} || 0.85;
337
$config{list}{real_y} = $config{list}{y} || 0.86;
325
339
if ($config{general}{listside} eq 'right') {
326
340
$config{general}{fatside}='left';
379
393
unless (-e $groups{"Default Parameters"} -> find('athena', 'plotstyles')) {
380
394
open P, ">".$groups{"Default Parameters"} -> find('athena', 'plotstyles') or die "could not open plst file";
381
print P "[default]\n";
382
foreach my $k (keys %plot_features) {
383
next unless ($k =~ /^[ekqr](_|ma|mi)/);
384
print P "$k = $plot_features{$k}\n";
430
## foreach my $k (keys %plot_features) {
431
## next unless ($k =~ /^[ekqr](_|ma|mi)/);
432
## print P "$k = $plot_features{$k}\n";
514
## import multi-electron data
515
my $system_mee = $groups{"Default Parameters"} -> find('athena', 'system_mee');
516
my $mee_file = $groups{"Default Parameters"} -> find('athena', 'mee');
517
copy($system_mee, $mee_file) if (not -e $mee_file);
519
tie %system, 'Config::IniFiles', (-file=>$system_mee);
520
my $system_ref = tied %system;
521
tie %mee_energies, 'Config::IniFiles', (-file=>$mee_file, -import=>$system_ref);
467
526
## ---------------------------------------------------------------------
471
530
splash_message("Establishing key bindings");
473
532
#$top -> configure(-font => $config{fonts}{small});
474
$top -> setPalette(font => $config{fonts}{small},
533
$top -> setPalette(-font => $config{fonts}{small},
475
534
foreground => $config{colors}{foreground},
476
535
background => $config{colors}{background},
477
536
activeBackground => $config{colors}{activebackground},
502
561
$top -> bind('<Control-l>' => \&get_new_name);
503
562
$top -> bind('<Control-m>' => sub{pod_display(File::Spec->catfile($poddir, "athena.pod"))});
504
563
$top -> bind('<Control-M>' => sub{freeze('marked')});
564
#$top -> bind('<Control-n>' => sub{mark('none')});
505
565
$top -> bind('<Control-o>' => sub{&read_file(0)});
506
566
$top -> bind('<Control-p>' =>
521
581
$top -> bind('<Control-U>' => sub{freeze('none')});
522
582
$top -> bind('<Control-w>' => \&close_project);
523
583
$top -> bind('<Control-y>' => \©_group);
584
$top -> bind('<Control-0>' => \&clear_project_name);
525
586
$top -> bind('<Meta-k>' => \&group_up);
526
587
$top -> bind('<Meta-j>' => \&group_down);
527
588
$top -> bind('<Alt-k>' => \&group_up);
528
589
$top -> bind('<Alt-j>' => \&group_down);
529
$top -> bind('<Meta-o>' => sub{&read_file(1)});
530
$top -> bind('<Alt-o>' => sub{&read_file(1)});
590
if ($Tk::VERSION < 804) {
591
$top -> bind('<Meta-o>' => sub{&read_file(1)});
592
$top -> bind('<Alt-o>' => sub{&read_file(1)});
594
$top -> bind('<Meta-o>' => sub{&read_file(0)});
595
$top -> bind('<Alt-o>' => sub{&read_file(0)});
531
597
$top -> bind('<Meta-d>' => \&Dumpit);
532
598
$top -> bind('<Alt-d>' => \&Dumpit);
585
651
-activebackground => $config{colors}{activebackground});
586
652
my @label_button = (-relief=>'flat', -borderwidth=>0,);
654
my @browseentry_list = (-disabledforeground => $config{colors}{foreground},
655
-state => 'readonly');
656
@browseentry_list = () if $is_windows;
589
658
splash_message("Creating menus");
639
708
## &read_file recognizes raw data, records, and/or projects
641
710
$menubar -> cascade(-label=>'~File', @menu_args,
642
-menuitems=>[[ command =>'Open file', -accelerator=>'Ctrl-o',
711
-menuitems=>[[ command =>($Tk::VERSION < 804) ? 'Open file' : 'Open file(s)',
712
-accelerator=>'Ctrl-o',
643
713
-command =>[\&read_file, 0]],
644
[ command =>'Open many files', -accelerator=>'Alt-o',
645
-command =>[\&read_file, 1]],
714
(($Tk::VERSION < 804)
715
? ([ command =>'Open many files', -accelerator=>'Alt-o',
716
-command =>[\&read_file, 1]],)
646
718
[ cascade =>'Recent files', -tearoff=>0],
647
[ command =>'Open URL',
648
-command => \&fetch_url,
649
-state => 'disabled'],
719
#[ command =>'Open URL',
720
# -command => \&fetch_url,
721
# -state => 'disabled'],
650
722
##-state => ($lwp_exists) ? "normal" : 'disabled'],
651
723
#['command'=>'Open SPEC file', -state=>'disabled'],
670
742
-command => [\&save_chi, 'k2']],
671
743
[ command => "k^3*chi(k)",
672
744
-command => [\&save_chi, 'k3']],
745
[ command => "chi(e)",
746
-command => [\&save_chi, 'ke']],
674
748
[ command => 'Save chi(R)', -command => [\&save_chi, 'R']],
675
749
[ command => 'Save chi(q)', -command => [\&save_chi, 'q']],
677
[ cascade => 'Save marked groups as data',
751
[ cascade => 'Save marked groups to a file as',
679
753
-menuitems => [[ command => 'mu(E)',
680
754
-command => [\&save_marked, 'e']],
706
780
[ command => 'Im[chi(q)]',
707
781
-command => [\&save_marked, 'qi']],
783
[ cascade => 'Save each marked groups as',
785
-menuitems => [[ command => 'mu(E)',
786
-command => [\&save_each, 'e']],
787
[ command => 'norm(E)',
788
-command => [\&save_each, 'n']],
789
[ command => 'deriv(E)',
790
-command => [\&save_each, 'd']],
792
[ command => 'chi(k)',
793
-command => [\&save_each, 'k']],
794
[ command => 'k*chi(k)',
795
-command => [\&save_each, 'k1']],
796
[ command => 'k^2*chi(k)',
797
-command => [\&save_each, 'k2']],
798
[ command => 'k^3*chi(k)',
799
-command => [\&save_each, 'k3']],
800
[ command => 'chi(E)',
801
-command => [\&save_each, 'ke']],
803
[ command => 'chi(R)',
804
-command => [\&save_each, 'R']],
805
[ command => 'chi(q)',
806
-command => [\&save_each, 'q']],
809
[ command => "Clear project name", -accelerator=>'Ctrl-0',
810
-command => \&clear_project_name],
710
812
[ command => "Close project", -accelerator=>'Ctrl-w',
711
813
-command => \&close_project],
751
853
-command => [\&plot_i0, 0]],
752
854
[ command => 'Plot I0, marked', -state=>'normal',
753
855
-command => \&plot_i0_marked],
754
# [ command => 'Plot chi(E)', -state=>'disabled',
755
# -command => sub{my $str = 'k' . $plot_features{k_w} . 'e';
756
# $groups{$current}->plotk($str,$dmode,\%plot_features, \@indicator)
758
# [ command => 'Plot chi(E), marked', -state=>'disabled',
759
# -command => sub{my $str = $plot_features{k_w} . 'e';
760
# $groups{$current}->plot_marked($str,$dmode,\%groups,
761
# \%marked, \%plot_features,
762
# $list, \@indicator)
766
858
my %image_formats = (gif => "GIF (landscape)",
873
965
[command => 'Smooth mu(E)', -command => \&smooth],
874
966
[command => 'Convolute mu(E)', -command => \&convolve],
875
967
[command => 'Self Absorption', -command => \&sa],
968
[command => 'MEE correction', -command => \&mee, -state => ($config{mee}{enable}) ? 'normal' : 'disabled', ],
876
969
##[command => 'Dead time', -state => 'disabled'],
878
971
##[command => 'How many spline knots?', -command=>sub{Echo(&nknots)}xb,
1136
1229
#my $fat = $top -> Scrolled('Pane', -scrollbars=>'oe', -relief=>'sunken',
1137
1230
# -borderwidth=>3, -width=>'13c')
1138
1231
my $container = $top -> Frame(-relief=>'flat', -borderwidth=>0)
1139
-> pack(-fill=>'x', -side=>$config{general}{fatside}); #, -expand=>1);
1232
-> pack(-fill=>'both', -side=>$config{general}{fatside}, -expand=>1);
1140
1233
my $fat = $container -> Frame(-relief=>'sunken', -borderwidth=>3)
1141
1234
-> pack(-fill=>'both', -expand=>1);
1145
1238
my @bold = (-foreground => $config{colors}{foreground},
1146
1239
-background => $config{colors}{activebackground},
1147
-font => $config{fonts}{small});
1240
-font => $config{fonts}{small},
1241
-cursor => $mouse_over_cursor,);
1148
1242
my @normal = (-foreground => $config{colors}{foreground},
1149
1243
-background => $config{colors}{background},
1150
-font => $config{fonts}{small});
1244
-font => $config{fonts}{small},
1245
-cursor => "top_left_arrow");
1152
1247
## right panel (skinny) (group list and plotting palette)
1153
1248
my @skinny_list = ();
1157
1252
-> pack(-side=>'top', -fill => 'x', -anchor=>'n');
1158
1253
my $lab = $top_frame -> Label(-text => q{},
1255
#-cursor => $mouse_over_cursor,
1160
1256
-justify => 'center',
1161
1257
-relief => 'flat')
1162
1258
-> pack(-side=>'right', -fill=>'x', -expand=>1);
1190
1286
$list = $skinny -> Scrolled(qw/Canvas -relief flat -borderwidth 0
1191
1287
-scrollbars e -width 5c -height 0.1c/,
1192
1288
-scrollregion=>['0', '0', '200', '200'])
1193
-> pack(-side=>'top', -expand=>1, -fill=>'both', -anchor=>'w');
1289
## $list = $skinny -> Scrolled(qw/Pane -relief flat -borderwidth 0
1290
## -scrollbars e -width 5c -height 0.1c/,)
1291
-> pack(-side=>'top', -expand=>1, -fill=>'both', -anchor=>'w');
1194
1292
$list->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background});
1195
1293
#BindMouseWheel($list);
1196
1294
## plot button bar
1197
1295
$b_frame = $skinny -> Frame(-relief=>'flat', -borderwidth=>0, -class=>'horae')
1198
1296
-> pack(-side=>'top', -anchor=>'n', -fill=>'x');
1199
$plotsel = $skinny -> NoteBook(-background=>$config{colors}{background},
1200
-backpagecolor=>$config{colors}{background},
1201
-inactivebackground=>$config{colors}{inactivebackground},
1202
-font=>'Arial 8 normal',
1297
$plotsel = $skinny -> NoteBook(-background => $config{colors}{background},
1298
-backpagecolor => $config{colors}{background},
1299
-inactivebackground => $config{colors}{inactivebackground},
1300
-font => $config{fonts}{small},
1205
$plot_features{kw} = 1;
1303
$plot_features{kw} = $plot_features{k_w};
1206
1304
my $red = $config{colors}{single};
1207
1305
my $kw_frame = $skinny -> Frame(-relief=>'ridge', -borderwidth=>2)
1208
1306
-> pack(-side=>'top', -anchor=>'n', -fill => 'x');
1252
1350
-> pack(-side=>'top', -anchor=>'n', -fill => 'x');
1253
1351
my $po_left = $po_frame -> Button(-text => 'v',
1254
1352
-font => $config{fonts}{smbold},
1353
-cursor => $mouse_over_cursor,
1257
1356
-command => \&hide_show_plot_options)
1258
1357
-> pack(-side=>'left', -anchor=>'n');
1259
1358
my $po = $po_frame -> Label(-text => 'Plotting options',
1360
-cursor => $mouse_over_cursor,
1261
1361
-justify => 'center',
1262
1362
-relief => 'raised')
1263
1363
-> pack(-side=>'left', -fill => 'x', -expand=>1);
1264
1364
my $po_right = $po_frame -> Button(-text => 'v',
1265
1365
-font => $config{fonts}{smbold},
1366
-cursor => $mouse_over_cursor,
1268
1369
-command => \&hide_show_plot_options);
1276
1377
$po -> bind('<1>' => sub{Echo("Right click to post the Plot styles menu. Click the arrow button to hide/show the plotting options.")});
1277
1378
$po -> bind('<2>' => \&plst_post_menu);
1278
1379
$po -> bind('<3>' => \&plst_post_menu);
1380
$po_left -> bind('<2>' => \&hide_show_plot_options);
1381
$po_left -> bind('<3>' => \&hide_show_plot_options);
1382
$po_right -> bind('<2>' => \&hide_show_plot_options);
1383
$po_right -> bind('<3>' => \&hide_show_plot_options);
1281
1385
# $b_frame -> Label(-text=>"Plot current group in", -relief=>'raised',
1282
1386
# -font=>$config{fonts}{smbold},
1468
my @pc_args = (-anchor=>'center');
1364
1469
foreach (qw/e k r q/) {
1366
1471
($_ eq 'k') and ($lab = "k");
1367
1472
($_ eq 'r') and ($lab = "R");
1368
1473
($_ eq 'q') and ($lab = "q");
1369
$plotcard{$_} = $plotsel -> add(lc($_), -label=>$lab, -anchor=>'center');
1474
$plotcard{$_} = $plotsel -> add(lc($_), -label=>$lab, @pc_args);
1371
$plotcard{Stack} = $plotsel -> add('Stack', -label=>'Stack', -anchor=>'center');
1372
$plotcard{Ind} = $plotsel -> add('Ind', -label=>'Ind', -anchor=>'center');
1373
$plotcard{PF} = $plotsel -> add('PF', -label=>'PF', -anchor=>'center');
1476
$plotcard{Stack} = $plotsel -> add('Stack', -label=>'Stack', @pc_args);
1477
$plotcard{Ind} = $plotsel -> add('Ind', -label=>'Ind', @pc_args);
1478
$plotcard{PF} = $plotsel -> add('PF', -label=>'PF', @pc_args);
1374
1479
$plotsel->pack(-fill => 'x', -side => 'bottom', -anchor=>'s');
1388
1493
## Setup the toplevel window for various textual interactions,
1389
1494
## including the ifeffit buffer and the raw text edit
1390
1495
my $update = $top -> Toplevel(-class=>'horae');
1496
$update -> withdraw;
1391
1497
$update -> title("Athena palettes");
1392
1498
$update -> bind('<Control-q>' => sub{$update->withdraw});
1393
1499
$update -> protocol(WM_DELETE_WINDOW => sub{$update->withdraw});
1396
1502
-inactivebackground=>$config{colors}{inactivebackground},);
1397
1503
use vars qw(%notecard %notes %labels);
1398
1504
foreach my $n (qw/ifeffit titles data echo macro journal/) {
1399
$notecard{$n} = $notebook -> add(lc($n), -label=>ucfirst($n), -anchor=>'center',);
1505
$notecard{$n} = $notebook -> add(lc($n), -label=>ucfirst($n), -anchor=>'center', -underline=>0);
1400
1506
my $topbar = $notecard{$n} -> Frame(qw/-relief flat -borderwidth 2/)
1401
1507
-> pack(qw/-fill x -side top/);
1402
1508
$topbar -> Button(-text=>'Dismiss', -command=>sub{$update->withdraw}, @button_list)
1420
1526
$notes{$n} = $notecard{$n} -> Scrolled($Text, qw/-relief sunken -borderwidth 2
1421
1527
-wrap none -scrollbars se -width 70 -height/, $h,
1422
1528
-font=>$config{fonts}{fixed})
1423
-> pack(qw/-expand yes -fill both -side top/);
1529
-> pack(qw(-expand 1 -fill both -side top));
1424
1530
$notebook -> pageconfigure($n, -raisecmd=>sub{$notes{$n}->focus});
1425
1531
BindMouseWheel($notes{$n});
1426
1532
disable_mouse3($notes{$n}->Subwidget(lc($Text)));
1427
$notes{$n} -> Subwidget("yscrollbar") -> configure(-background=>$config{colors}{background});
1428
$notes{$n} -> Subwidget("xscrollbar") -> configure(-background=>$config{colors}{background});
1533
$notes{$n} -> Subwidget("yscrollbar") -> configure(-background=>$config{colors}{background});
1534
$notes{$n} -> Subwidget("xscrollbar") -> configure(-background=>$config{colors}{background});
1535
$notes{$n} -> tagConfigure("text", -font=>$config{fonts}{fixedsm});
1430
$notebook->pack(-expand => 'y', -fill => 'both', -side => 'bottom');
1538
$notebook->pack(-expand => 1, -fill => 'both', -side => 'bottom');
1431
1539
$labels{ifeffit} -> configure(-text=>"Ifeffit interaction buffer");
1432
1540
$notes{ifeffit} -> tagConfigure ('command', -foreground=>$config{colors}{foregroun},
1433
1541
-lmargin1=>4, -lmargin2=>4);
1551
1658
## set default analysis parameter values
1552
1659
&clear_session_defaults;
1553
# $setup -> SetDefault(bkg_e0 => $config{bkg}{e0},
1554
# bkg_kw => $config{bkg}{kw},
1555
# bkg_rbkg => $config{bkg}{rbkg},
1556
# bkg_pre1 => $config{bkg}{pre1},
1557
# bkg_pre2 => $config{bkg}{pre2},
1558
# bkg_nor1 => $config{bkg}{nor1},
1559
# bkg_nor2 => $config{bkg}{nor2},
1560
# bkg_spl1 => $config{bkg}{spl1},
1561
# bkg_spl2 => $config{bkg}{spl2},
1562
# bkg_nclamp => $config{bkg}{nclamp},
1563
# bkg_clamp1 => $config{bkg}{clamp1},
1564
# bkg_clamp2 => $config{bkg}{clamp2},
1565
# bkg_flatten => $config{bkg}{flatten},
1566
# fft_kw => $config{fft}{kw},
1567
# fft_dk => $config{fft}{dk},
1568
# fft_win => $config{fft}{win},
1569
# fft_kmin => $config{fft}{kmin},
1570
# fft_kmax => $config{fft}{kmax},
1571
# fft_pc => $config{fft}{pc},
1572
# bft_dr => $config{bft}{dr},
1573
# bft_win => $config{bft}{win},
1574
# bft_rmin => $config{bft}{rmin},
1575
# bft_rmax => $config{bft}{rmax},
1580
1663
draw_properties($fat); #$props);
1581
1664
&set_plotcards;
1582
1665
project_state(1);
1583
foreach (qw(project current bkg bkg_secondary bft fft plot)) {
1666
foreach my $part (qw(project current bkg bkg_secondary fft bft plot)) {
1584
1667
my $fill = $config{colors}{disabledforeground};
1585
$props{$_} -> itemconfigure($header{$_}, -fill=>$fill);
1668
$header{$part} -> configure(-foreground=>$fill);
1587
1670
foreach ($setup -> Keys) {
1588
1671
next if ((/^deg/) or ($_ eq "file") or ($_ eq "line"));
1589
1672
next unless (Exists($widget{$_}));
1590
1673
$widget{$_} -> configure(-state=>'disabled');
1592
$widget{"bkg_$_"} -> configure(-state=>'disabled') foreach (qw(alg fixstep flatten nnorm2 nnorm3));
1675
$widget{"bkg_$_"} -> configure(-state=>'disabled') foreach (qw(alg fixstep flatten nnorm1 nnorm2 nnorm3));
1593
1676
map {($_ =~ /^(deg|lr)/) or $grab{$_} -> configure(-state=>'disabled')} (keys %grab);
1595
1678
##undef $setup;
1599
1682
## set up error handlers
1600
$SIG{__DIE__} = sub{$groups{"Default Parameters"}->trap('Athena', $VERSION, 'die', $trapfile, \&Error)};
1601
$SIG{__WARN__} = sub{$groups{"Default Parameters"}->trap('Athena', $VERSION, 'warn', $trapfile, \&Error)};
1683
#$SIG{__DIE__} = sub{$groups{"Default Parameters"}->trap('Athena', $VERSION, 'die', $trapfile, \&Error)};
1684
#$SIG{__WARN__} = sub{$groups{"Default Parameters"}->trap('Athena', $VERSION, 'warn', $trapfile, \&Error)};
1695
1778
&set_key_params;
1697
1780
my @geom = split(/[+x]/, $top->geometry);
1698
my $extrabit = ($is_windows) ? 0 : 30;
1781
my $extrabit = ($is_windows) ? 0 : 40;
1699
1782
unless ($is_windows) {
1700
1783
$top -> minsize( $geom[0], $geom[1]+$extrabit);
1701
1784
$top -> maxsize(1.3*$geom[0], $geom[1]+$extrabit);
added
removed
athena_parts/head.pl
