← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/horae/intrepid

« back to all changes in this revision

Viewing changes to artemis_parts/athena.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:
artemis_parts/athena.pl
23
23
 
24
24
  ##my $athena_fh = *ORIG;
25
25
  my @athena_index = ();
 
26
  my %athena_group = ();
26
27
  my $nline = 0;
27
28
  my $line = q{};
 
29
  my $cpt = new Safe;
28
30
  ##while (<ORIG>) {
29
31
  while ($athena_fh->gzreadline($line) > 0) {
30
32
    ++$nline;
31
33
    next unless ($line =~ /^\$old_group/);
32
34
    push @athena_index, $nline;
 
35
    ## need to make a map to the groups by old group name so that
 
36
    ## background removal with a standard can be performed correctly
 
37
    $ {$cpt->varglob('old_group')} = $cpt->reval( $line );
 
38
    my $og = $ {$cpt->varglob('old_group')};
 
39
    $athena_group{$og} = {index=>$nline, hlist=>0};
33
40
  };
34
41
  $athena_fh->gzclose();
35
42
  ##close ORIG;
49
56
  };
50
57
  $current_canvas = 'athena';
51
58
 
52
 
  my $canvas = $fat -> Canvas(-relief=>'flat',
53
 
                              -borderwidth=>0,
54
 
                              @window_size,
55
 
                              -highlightcolor=>$config{colors}{background})
56
 
    -> pack();
57
 
 
58
 
  my $ath = $canvas -> Frame(-relief=>'flat',
59
 
                               -borderwidth=>0,
60
 
                               -highlightcolor=>$config{colors}{background});
61
 
  $canvas -> createWindow(0,0, -anchor=>'nw', -window => $ath, @window_size);
 
59
  my $ath = $fat -> Frame(-relief=>'flat',
 
60
                          -borderwidth=>0,
 
61
                          -highlightcolor=>$config{colors}{background})
 
62
    -> pack(-fill=>'both', -expand=>1);
62
63
 
63
64
  my $frm = $ath -> Frame() -> pack(-side=>'top', -anchor=>'w', -padx=>6);
64
65
 
72
73
  $widgets{athena_return} = $ath -> Button(-text=>'Cancel and return to the main window',  @button3_list,
73
74
                                           #-background=>$config{colors}{background},
74
75
                                           #-activebackground=>$config{colors}{activebackground},
75
 
                                           -command=>sub{$canvas->packForget;
 
76
                                           -command=>sub{$ath->packForget;
76
77
                                                         $current_canvas = "";
77
78
                                                         $edit_menu -> menu -> entryconfigure(13, -state=>'normal');
78
79
                                                         &display_properties;
93
94
                                 -width=>20,
94
95
                                 -background=>'white',
95
96
                                 -selectbackground=>$config{colors}{selected},
96
 
                                 -browsecmd=>sub{athena_plot($hlist, $prjfile)},
 
97
                                 -browsecmd=>sub{athena_plot($hlist, $prjfile, \%athena_group)},
97
98
                                )
98
99
    -> pack(-expand=>1, -fill=>'y');
99
100
  $hlist->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background},
132
133
                    -selectcolor      => $config{colors}{check},
133
134
                    -font             => $config{fonts}{med},
134
135
                    -variable         => \$ath_params{plot},
135
 
                    -command          => sub{athena_plot($hlist, $prjfile)});
 
136
                    -command          => sub{athena_plot($hlist, $prjfile, \%athena_group)});
136
137
 
137
138
  $fr = $labframe -> LabFrame(-label=>'Plot as ... ',
138
139
                              -labelside=>'acrosstop',
177
178
  $labframe -> Button(-text=>"Import these data",
178
179
                      @button3_list,
179
180
                      -command=>sub{
180
 
                        $canvas->packForget;
 
181
                        $ath->packForget;
181
182
                        $current_canvas = "";
182
183
                        $edit_menu -> menu -> entryconfigure(13, -state=>'normal');
183
184
                        athena_import($hlist, $prjfile, $orig, $ath_params{params});
191
192
  my $old_group = "";
192
193
  my $line_number = 1;
193
194
 
194
 
  foreach my $i (@athena_index) {
 
195
  #foreach my $i (@athena_index) {
 
196
  foreach my $g (sort {$athena_group{$a}{index} <=> $athena_group{$b}{index}} keys(%athena_group)) {
 
197
    my $i = $athena_group{$g}{index};
195
198
    my %args = athena_get_array($prjfile, $i, "args");
196
199
    $args{label} =~ s{[\"\']}{}g;
197
200
    next unless ($args{is_xmu} or $args{is_chi});
198
201
    $hlist -> add($i, -data=>$i);
199
202
    $hlist -> itemCreate($i, 0, -text=>$args{label});
 
203
    $athena_group{$g}{hlist} = $i;
200
204
  };
201
205
  $hlist -> anchorSet($athena_index[0]);
202
206
  $hlist -> selectionSet($athena_index[0]);
203
 
  athena_plot($hlist, $prjfile);
 
207
  athena_plot($hlist, $prjfile, \%athena_group);
204
208
 
205
209
## set_fit_button('fit');
206
210
 
250
254
  my $n = $_[0]->info('anchor');
251
255
  my $i = $_[0]->info('data', $n);
252
256
  my $prjfile = $_[1];
 
257
  my $r_athena_group = $_[2];
 
258
  my $noplot = $_[3];
 
259
  my $gname = "a___thena" ;
 
260
  if ($noplot) {
 
261
    $n = $r_athena_group->{$noplot}->{hlist};
 
262
    $i = $_[0]->info('data', $n);
 
263
    $gname = "st___andard";
 
264
  };
253
265
 
254
266
  ## get the args hash
255
267
  my %args = athena_get_array($prjfile, $i, "args");
269
281
    $widgets{athena_titles} -> insert('end', $l.$/);
270
282
  };
271
283
 
272
 
  $paths{data0}->dispose("##\n## reading Athena record \"$title\" into group a___thena:", $dmode);
 
284
  $paths{data0}->dispose("erase \@group $gname\n");
 
285
  $paths{data0}->dispose("##\n## reading Athena record \"$title\" into group $gname:", $dmode);
273
286
  $paths{data0}->dispose("set \&status=0", $dmode);
274
287
  if ($args{is_xmu}) {
275
 
    Ifeffit::put_array("a___thena.energy", \@x);
276
 
    Ifeffit::put_array("a___thena.xmu", \@y);
 
288
    Ifeffit::put_array($gname.".energy", \@x);
 
289
    Ifeffit::put_array($gname.".xmu", \@y);
 
290
    #Ifeffit::ifeffit("newplot($gname.energy, $gname.xmu)\n");
 
291
    #print join(" ", %args), $/;
 
292
    #sleep 5;
277
293
    $args{bkg_clamp1} = $clamp{$args{bkg_clamp1}};
278
294
    $args{bkg_clamp2} = $clamp{$args{bkg_clamp2}};
279
 
    my $spline  = "a___thena.energy, a___thena.xmu, e0=$args{bkg_e0}, ";
 
295
 
 
296
    my $stan_string = q{};
 
297
    if ($args{bkg_stan} ne 'None') {
 
298
      athena_plot($_[0], $_[1], $r_athena_group, $args{bkg_stan});
 
299
      $stan_string = "k_std=st___andard.k, chi_std=st___andard.chi, ";
 
300
      ## need to remove background function from standard if standard
 
301
      ## is mu(E) data!
 
302
    };
 
303
 
 
304
    my $spline  = "$gname.energy, $gname.xmu, e0=$args{bkg_e0}, ";
280
305
    $spline    .= "rbkg=$args{bkg_rbkg}, kmin=$args{bkg_spl1}, ";
281
306
    $spline    .= "kmax=$args{bkg_spl2}, kweight=$args{bkg_kw}, ";
282
307
    $spline    .= "dk=$args{bkg_dk}, kwindow=$args{bkg_win}, pre1=$args{bkg_pre1}, ";
283
308
    $spline    .= "pre2=$args{bkg_pre2}, norm1=$args{bkg_nor1}, norm2=$args{bkg_nor2}, ";
284
309
    $spline    .= "clamp1=$args{bkg_clamp1}, clamp2=$args{bkg_clamp2}, nclamp=5, ";
 
310
    $spline    .= $stan_string;
285
311
    $spline    .= "interp=quad)\n";
286
312
    $spline     = wrap("spline(", "       ", $spline);
287
313
    ## remove the background and plot the data
289
315
    $paths{data0}->dispose($spline, $dmode);
290
316
    my $status = Ifeffit::get_scalar('&status');
291
317
    $paths{data0}->dispose($spline, $dmode) if ($status > 1);
 
318
    #Ifeffit::ifeffit("newplot($gname.k, $gname.k*$gname.chi)\n");
 
319
    #sleep 5;
292
320
    $paths{data0}->dispose("set \&status=0", $dmode);
293
321
  } else {
294
 
    Ifeffit::put_array("a___thena.k", \@x);
295
 
    Ifeffit::put_array("a___thena.chi", \@y);
 
322
    Ifeffit::put_array("$gname.k", \@x);
 
323
    Ifeffit::put_array("$gname.chi", \@y);
296
324
  };
297
325
 
 
326
  $top -> Unbusy, return if $noplot;
298
327
  my ($plot, $sp);
299
 
 
300
328
  ## plot this in k-space
301
329
  if ($ath_params{plot} eq 'chi') {
302
330
    my $ylabel = "";
315
343
  } elsif ($ath_params{plot} =~ /chir/) {
316
344
    my $ylabel = '';
317
345
  SWITCH: {
318
 
      $ylabel = sprintf("|\\gx(R)| (\\A\\u-%s\\d)",   $args{fft_kw}+1),
 
346
      $ylabel = sprintf("|\\gx(R)| (\\A\\u-%s\\d)",   $plot_features{kweight}+1),
319
347
          last SWITCH if ($ath_params{plot} =~ /mag$/);
320
 
      $ylabel = sprintf("Re[\\gx(R)] (\\A\\u-%s\\d)", $args{fft_kw}+1),
 
348
      $ylabel = sprintf("Re[\\gx(R)] (\\A\\u-%s\\d)", $plot_features{kweight}+1),
321
349
          last SWITCH if ($ath_params{plot} =~ /re$/);
322
 
      $ylabel = sprintf("Im[\\gx(R)] (\\A\\u-%s\\d)", $args{fft_kw}+1),
 
350
      $ylabel = sprintf("Im[\\gx(R)] (\\A\\u-%s\\d)", $plot_features{kweight}+1),
323
351
          last SWITCH if ($ath_params{plot} =~ /im$/);
324
352
    };
325
 
    my $fft   = "a___thena.chi, k=a___thena.k, kweight=$args{fft_kw}, ";
 
353
    my $fft   = "a___thena.chi, k=a___thena.k, kweight=$plot_features{kweight}, ";
326
354
    $fft     .= "kmin=$args{fft_kmin}, kmax=$args{fft_kmax}, ";
327
355
    $fft     .= "dk=$args{fft_dk}, kwindow=$args{fft_win})\n";
328
356
    $fft      = wrap("fftf(", "     ", $fft);
337
365
  } else {
338
366
    my $ylabel = '';
339
367
  SWITCH: {
340
 
      $ylabel = sprintf("|\\gx(q)| (\\A\\u-%s\\d)",   $args{fft_kw}),
 
368
      $ylabel = sprintf("|\\gx(q)| (\\A\\u-%s\\d)",   $plot_features{kweight}),
341
369
          last SWITCH if ($ath_params{plot} =~ /mag$/);
342
 
      $ylabel = sprintf("Re[\\gx(q)] (\\A\\u-%s\\d)", $args{fft_kw}),
 
370
      $ylabel = sprintf("Re[\\gx(q)] (\\A\\u-%s\\d)", $plot_features{kweight}),
343
371
          last SWITCH if ($ath_params{plot} =~ /re$/);
344
 
      $ylabel = sprintf("Im[\\gx(q)] (\\A\\u-%s\\d)", $args{fft_kw}),
 
372
      $ylabel = sprintf("Im[\\gx(q)] (\\A\\u-%s\\d)", $plot_features{kweight}),
345
373
          last SWITCH if ($ath_params{plot} =~ /im$/);
346
374
    };
347
 
    my $fft   = "a___thena.chi, k=a___thena.k, kweight=$args{fft_kw}, ";
 
375
    my $fft   = "a___thena.chi, k=a___thena.k, kweight=$plot_features{kweight}, ";
348
376
    $fft     .= "kmin=$args{fft_kmin}, kmax=$args{fft_kmax}, ";
349
377
    $fft     .= "dk=$args{fft_dk}, kwindow=$args{fft_win})\n";
350
378
    $fft      = wrap("fftf(", "     ", $fft);
381
409
                     -title          => 'Athena: Reading data',
382
410
                     -buttons        => [qw/Change New Cancel/],
383
411
                     -default_button => 'Change',
 
412
                     -font           => $config{fonts}{med},
384
413
                     -popover        => 'cursor');
385
414
    &posted_Dialog;
386
415
    $response = $dialog->Show();
420
449
    $erase .= "erase \$athena_title_$i\n";
421
450
    ++$i;
422
451
  };
423
 
  (my $fname = $args{label}) =~ s/[.:@&\/\\ ]/_/g;
 
452
  (my $fname = $args{label}) =~ s/[.,:@&\/\\ ]/_/g;
424
453
  my $file = File::Spec->catfile($project_folder, "chi_data", $fname.".chi");
425
454
  $paths{data0}->dispose("write_data(file=$file,\n           a___thena.k, a___thena.chi, \$athena_title_*)", $dmode);
426
455
  if ($args{is_xmu}) {
427
456
    my $file = File::Spec->catfile($project_folder, "chi_data", $fname.".xmu");
428
457
    $paths{data0}->dispose("write_data(file=$file,\n           a___thena.energy, a___thena.xmu, \$athena_title_*)", $dmode);
429
458
  };
 
459
 
430
460
  $group = ($response eq 'Change') ?
431
461
    read_data($paths{$current}->data, $file, 1) :
432
462
      read_data(0, $file, 1);