#!/usr/bin/env perl

# --8<--8<--8<--8<--
#
# Copyright (C) 2006-2017 Smithsonian Astrophysical Observatory
#
# This file is part of trace-shell
#
# trace-shell is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# 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
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
# -->8-->8-->8-->8--

use v5.10.1;

use strict;
use warnings;

use File::Spec::Functions qw( catdir );
use File::Basename;
use Hash::Wrap;

# use our Perl libraries first.  May need to override
use lib '/build/phase1/lib/perl5';


# load MST_Env, if available
if ( eval "use MST_Env" ) {
    # save PFILES; don't screw over user
    my %EXPORT = MST::envs();
    delete $EXPORT{PFILES};
    %ENV = ( %ENV, %EXPORT );
}

use constant PROGRAM => basename( $0, '.pl' );
our $VERSION = '2.3.4';
use constant BP2FITS_CONFIG_DIR => catdir($ENV{SAOTRACE_DATADIR} // '/build/phase1/share', 'bp2fits');

if ( !caller ) {
    eval { main() } && exit 0;

    my $logpfx = "# $$ " . PROGRAM . ": ";
    print STDERR $logpfx, "$_\n" foreach split /\n/, $@;
    exit 1 ;
}

sub main {
    require CIAO::Lib::Param;
    my $pars = wrap_hash( { CIAO::Lib::Param::pquery( PROGRAM, \@ARGV ) } );

    help( 2 ) if $pars->help;

    do { print "@{[ PROGRAM ]} $VERSION\n"; return }
      if $pars->version;

    my $shell = TraceShell->new( %$pars, bp2fits_config_dir => BP2FITS_CONFIG_DIR );

    $shell->raytrace() unless $shell->debug->reuse;

    $shell->summarize( $pars );

    # update parameter file
    CIAO::Lib::Param::pset( PROGRAM, %{ $pars } );

    return 1;
}

sub help {
    my ( $verbose ) = @_;

    # verbosity = 2 causes pod2usage to call perldoc, which already pages
    require IO::Pager::Page if $verbose < 2;
    require Pod::Usage;
    Pod::Usage::pod2usage( { -exitval => 0, -verbose => $verbose } );
}

package TraceShell {

    use POSIX;
    use IO::File;
    use File::Spec::Functions qw( catfile catpath splitpath rel2abs );
    use Text::Template;
    use File::Slurper;
    use File::Basename qw( fileparse );
    use Safe::Isa;

    use IPC::PrettyPipe::DSL qw( :all );
    use MST::Raytrace qw[ read_focus read_tot_wt write_summary ];
    use RDB;
    use Hash::Wrap;

    use Types::Standard -types;
    use Types::Common::Numeric -types;
    use Type::Params qw( compile_named_oo );

    use Moo;

BEGIN{

    has tag           => ( is => 'ro', isa => Str, required => 1 );
    has srcpars       => ( is => 'ro', isa => Str, required => 1 );
    has shell         => ( is => 'ro', isa => PositiveInt, required => 1 );
    has tstart        => ( is => 'ro', isa => PositiveOrZeroNum );
    has limit         => ( is => 'ro', isa => PositiveOrZeroNum, required => 1 );
    has z             => ( is => 'ro', isa => PositiveOrZeroNum, required => 1 );
    has src           => ( is => 'ro', isa => Str, default => 'default' );
    has output        => ( is => 'ro', isa => Str, default => 'default' );
    has output_fmt    => ( is => 'ro', isa => Enum[ qw( bp bpipe fr fullray rdb ) ] | StrMatch[ qr/^fits-.*/], default => 'bpipe' );
    has output_coord  => ( is => 'ro', isa => Enum[ qw( osac hrma xrcf) ], default => 'hrma' );
    has output_fields => ( is => 'ro', isa => Str, default =>  'all' );
    has limit_type    => ( is => 'ro', isa => Enum[ qw( Mrays krays rays ksec sec r/cm2 r/mm2) ], default => 'r/mm2');
    has seed1         => ( is => 'ro', isa => PositiveInt, default => 1 );
    has seed2         => ( is => 'ro', isa => PositiveInt, default => 1 );
    has block         => ( is => 'ro', isa => PositiveOrZeroInt, default => 0 );
    has block_inc     => ( is => 'ro', isa => PositiveInt->where( '$_ >= 100' ), default => 100);
    has focus         => ( is => 'ro', isa => Bool, default => 0 );
    has tally         => ( is => 'ro', isa => PositiveOrZeroInt, default => 0 );
    has config_dir    => ( is => 'ro', isa => Str, required => 1 );
    has config_db     => ( is => 'ro', isa => Str, required => 1 );
    has debug         => ( is => 'ro', isa => InstanceOf['DBFlags'] );
    has help          => ( is => 'ro', isa => Bool, default => 0 );
    has version       => ( is => 'ro', isa => Bool, default => 0 );
    has cfg           => ( is => 'lazy', isa => InstanceOf[ 'RTConfig' ]  );
    has rblock        => ( is => 'lazy', isa => InstanceOf[ 'Block' ] );
    has node          => ( is => 'lazy', isa => Num );
    has bp2fits_config_dir       => ( is => 'ro', isa => Str, required => 1);

    around 'BUILDARGS' => sub {
        my ( $orig, $class, @args ) = @_;
        my $args = $class->$orig( @args );

        # add suffix if necessary
        $args->{config_db} .= '.cnf'
          if exists $args->{config_db} && $args->{config_db} !~ /[.]cnf$/;

        $args->{debug}  = $args->{debug}->$_isa( 'DBFlags' ) ? $args->{debug} : DBFlags->new_from_string( $args->{debug} // '' );

        return $args;
    };

    sub BUILD {
        my ( $self, $args ) = @_;

        die(
            "can't specify 'debug' parameter 'normalize_limit' unless 'limit_type' parameter is 'r/mm2' or 'r/cm2'\n"
          )
          if $self->debug->normalize_limit && !grep { $self->limit_type eq $_ }
          qw[ r/mm2 r/cm2 ];
    }

    sub _build_cfg {
        my $self = shift;

        my $debug = $self->debug;

        my $cfg = RTConfig->new(
            shell      => $self->shell,
            config_dir => $self->config_dir,
            config_db  => $self->config_db,
            src        => $self->src,
        );

        $cfg->set( 'onlygoodrays' => $debug->noghosts ? 'yes' : 'no' );

        {
            my $sys = 'scat';

            my @attrs = qw( in_plane out_of_plane min_prob max_prob );

            for my $attr ( @attrs ) {
                for my $optic ( undef, 'p', 'h' ) {
                    my $sys_var   = join( '_', $sys, $attr, ( $optic // () ) );
                    my $predicate = "has_${sys_var}";
                    next unless $debug->$predicate;
                    $cfg->set_sys_var( $sys, $attr, $optic, $debug->$sys_var );
                }
            }
        }

        return $cfg;
    }

    sub _build_rblock {
        my $self = shift;
        Block->new( $self->block, $self->block_inc );
    }

    sub _build_node {
        my $self = shift;
        my $cfg = $self->cfg;
        get_node( $cfg->shell, $cfg->mirror_geo_db, $cfg->entrance_ap_db );
    }

    sub check_file {
        my $self = shift;
        my ( $key ) = @_;

        my $file = $self->cfg->get( $key );

        die "couldn't access $key file `$file'\n"
          unless -f $file;

        return $file;
    }

    sub logfile_ctx {
        my $self = shift;
        my ( $package, $caller ) = ( caller(1) )[0,3];
        $package =~ s/\W/\\$1/;
        $caller =~ s/^${package}:://;
        $self->logfile( $caller, @_ );
    }

    sub logfile {
        my $self = shift;
        my @extras = @_;
        return join( '.', $self->tag, @extras ) . '.log';
    }

    sub get_mirror {
        my ( $cfg, $geo, $surf_no ) = @_;

        my $shell = $cfg->shell;

        $cfg->set( 'geo', $geo );

        my $rdb = RDB->new( $cfg->mirror_geo_db )
          or die( "error opening ", $cfg->mirror_geo_db, "\n" );

        my $mirror = "${geo}${shell}";
        my %mirror;
        1 while $rdb->read( \%mirror ) && $mirror{mirror} ne $mirror;

        die( "no mirror info in @{[ $cfg->mirror_geo_db ]} for ${mirror}\n" )
          unless $mirror{mirror} eq $mirror;

        $mirror{surf_no} = $surf_no;
        $mirror{geo}     = $geo;

        $mirror{optic_type} = 1;    # xray
        $mirror{dfm}        = 1;

        # template for deformation file
        $mirror{dfm_file}  = $cfg->get( "mirror_${mirror}_dfm_db" );
        $mirror{dfm_scale} = $cfg->get( "mirror_${mirror}_dfm_scale" );

        my ( $file, $path, $suffix )
          = fileparse( $mirror{dfm_file}, '\.[^.]*$' );

        if ( $suffix !~ /((?:b?(?:spl|dfr))|fits)$/i ) {
            die( "unknown deformation type for mirror `$geo':", " $suffix\n" );
        }

        $suffix = lc( $1 );

        # default to Fourier-Legendre
        $mirror{dfm_type} = 0;

        # FITS implies spline.  At least for now.
        if ( 'fits' eq $suffix ) {
            $mirror{dfm_type} = 1;
        }

        # /b?spl/i is old binary/ascii spline
        elsif ( 'spl' eq $suffix ) {
            $mirror{dfm_type} = 1;
            # see if we can grab a more optimized version of this file
            for $suffix ( 'spl', 'BSPL', 'SPL' ) {
                my $try = "$path$file.$suffix";
                if ( -e $try ) {
                    $mirror{dfm_file} = $try;
                    last;
                }
            }
        }

        die
          "couldn't find primary deformation file `$mirror{dfm_file}'\n",
          unless -f $mirror{dfm_file};

        # second deformation
        $mirror{dfm2_file}  = $cfg->get( "mirror_${mirror}_dfm2_db" );
        $mirror{dfm2_scale} = $cfg->get( "mirror_${mirror}_dfm2_scale" );

        if ( '' ne $mirror{dfm2_file} ) {
            my ( $file, $path, $suffix )
              = fileparse( $mirror{dfm2_file}, '\.[^.]*$' );    #');
            if ( !( $suffix =~ /([b]?)(dfr)/i ) ) {
                die( "unknown deformation2 type for mirror `$geo':",
                    " $suffix\n" );
            }

            die
              "couldn't find secondary deformation file `$mirror{dfm2_file}'\n",
              unless -f $mirror{dfm2_file};

            $mirror{dfm_type} = 2;
        }

        if ( $cfg->getbool( "micro_scatter_${geo}" ) ) {
            $mirror{scatter_table}
              = $cfg->exists( "micro_scat_${mirror}_db" )
              ? $cfg->get( "micro_scat_${mirror}_db" )
              : $cfg->get( "micro_scat_db" );

            die "couldn't find scattering table '$mirror{scatter_table}'\n"
              unless -f $mirror{scatter_table};
        }

        $mirror{reflect_table} = $cfg->get( "reflect_${mirror}_db" );

        return wrap_hash( \%mirror );
    }



   # get mirror node.  if the node parameter is in the geometry file header, use
   # that, else use the z position of the entrance aperture node for this shell.
   # this will result in an incorrect raytrace, but until the geometry file
   # is updated, that's the best we can do.

    sub get_node {
        my ( $shell, $geo_db, $eap_db ) = @_;

        {
            my $rdb = RDB->new( $geo_db )
              or die( "error opening $geo_db\n" );

            my $node = $rdb->getvar( 'node' );
            return $node if defined $node;
        }

        my $rdb = RDB->new( $eap_db )
          or die( "error opening $eap_db\n" );

        my %data;
        1 while $rdb->read( \%data ) && $data{shell} != $shell;

        die( "unable to find shell $shell in $eap_db\n" )
          unless $data{shell} == $shell;

        die( "couldn't find column 'z' in $eap_db\n" )
          unless defined $data{z};

        return $data{z};
    }

    sub raytrace {

        my $self = shift;

        my $pipe = $self->raytrace_pipeline;

        print STDERR $pipe->render, "\n"
          if $self->debug->pcomm;

        unless ( $self->debug->noexec ) {
            $pipe->run or die( "error in raytrace pipe\n" );
            File::Slurper::write_text( "@{[ $self->tag ]}.block",
                $self->rblock->current . "\n" );
        }
    }

    sub raytrace_pipeline {

        my $self = shift;

        my $cfg = $self->cfg;

        if ( $self->focus ) {

            # turn off micro scattering
            $cfg->micro_scatter( 0 );
            $cfg->micro_scatter_p( 0 );
            $cfg->micro_scatter_h( 0 );

            # set the focus target if the default source was requested
            $cfg->set( 'raygen_cfg', $cfg->raygen_focus_cfg )
              if $self->src eq 'default';

            # don't allow ghosts
            $cfg->onlygoodrays( 1 );
        }

        # OSAC system gi parameters
        my %system = (
            zoff_origin => 1,         # STD
            zoff        => $self->z
        );
        my $gi_file = $self->tag . '.gi';

        my $paraboloid  = get_mirror( $self->cfg, 'p', 1 );
        my $hyperboloid = get_mirror( $self->cfg, 'h', 2 );

        require SAOsac::gi;
        SAOsac::gi::create( $gi_file, $self->tag . ': shell ' . $cfg->shell,
            \%system, $paraboloid, $hyperboloid )
          || die "\n";

        $paraboloid->{gi_file} = $hyperboloid->{gi_file} = $gi_file;

        my $shell = $cfg->shell;

        my $pipe = ppipe;

        $pipe
          |= $self->raygen
          | $self->save_history( 'input' );

        $pipe |= tap( 'input', $self->debug->input_tap )
          if $self->debug->has_input_tap;
        $pipe |= filter( $self->debug->input_filter )
          if $self->debug->has_input_filter;

        $pipe
          |= $self->tot_wt( 'in' ) # number of rays that hit the entrance ap.
          | $self->aperture( 'precollimator')
          | $self->surface( $paraboloid )
          | $self->aperture( 'cap' )
          | $self->surface( $hyperboloid )
          | $self->aperture( 'postcollimator');

        $pipe |= $self->focus_rays( $paraboloid->{gi_file} ) if $self->focus;
        $pipe |= $self->project unless $self->debug->noproject;

        # post raytrace energy based correction factor
        $pipe |= $self->post_en_corr if $cfg->getbool( 'post_en_corr' );

        $pipe |= $self->normalize_limit if $self->debug->normalize_limit;

        $pipe |= $self->tap( 'output', $self->debug->output_tap )
          if $self->debug->has_output_tap;
        $pipe |= $self->filter( $self->debug->output_filter )
          if $self->debug->has_output_filter;

        $pipe |= $self->tallyphot() if $self->tally;

        $pipe |= $self->coord_xfrm;

        $pipe |= $self->tot_wt( 'out' );    # record rays that left the system

        $pipe |= $self->filter_output_fields;

        my ( $cmd, $output ) = $self->reformat;

        $pipe |= $cmd;

        $pipe->valsubst( qr/^OUTPUT$/, 'stdout', lastvalue => $output );

        return $pipe;
    }

    sub tot_wt {
        my ( $self, $id ) = @_;

        ppcmd 'tot_wt', argsep( '=' ),
          [
            input   => 'stdin',
            output  => 'OUTPUT',
            logfile => $self->logfile_ctx( $id ),
            mode => 'H',
          ];
    }

    sub tap {
        my ( $self, $stage, $tap ) = @_;

        return ppipe() unless defined $tap;

        my $comm = eval { $self->interpolate( $tap ); };
        die "error in $stage tap spec: $@" if $@;

        ppcmd 'fountain', argpfx '-', [ b => 500000 ], 's', [ c => $comm ];
    }

    sub filter {
        my ( $self, $filter ) = @_;

        return ppipe() unless defined $filter;
        return $self->clean_filter( $filter );
    }

    sub focus_rays {
        my ( $self, $gi_file ) = @_;

        return

          # focus routine. it'll drop the rays off at the zoff defined
          # in the gi file

          ppcmd(
            saofocus => argsep( '=' ), [
                input        => 'stdin',
                output       => 'OUTPUT',
                gi_filename  => $gi_file,
                logfile      => $self->logfile( 'focus' ),
                onlygoodrays => 'yes',
                help         => 'no',
                mode => 'H',
            ] )

          |

          # focus sets z to zero (bogus!). must correct
          ppcmd(
            photz => argsep( '=' ), [
                input  => 'stdin',
                output => 'OUTPUT',
                z      => $self->z,
                mode => 'H',
            ] );
    }

    sub filter_output_fields {
        my $self = shift;

        my @include;
        my @exclude;

        my @fields = split( ',', $self->output_fields );
        @include = grep { !/^-/ } @fields;
        @exclude = map { s/-//; $_ } grep { /^-/ } @fields;

        @include = () if grep { $_ eq 'all' } @include;
        @include
          = map { $_ eq 'min' ? qw[ position direction weight energy time ] : $_ }
          @include;

        return ppipe() if !@include && !@exclude;

        return ppcmd
          bpmanip => argpfx( '--' ),
          [
            input => 'stdin',
            @include ? ( include => join( ',', @include ) ) : (),
            @exclude ? ( exclude => join( ',', @exclude ) ) : (),
            output => 'OUTPUT',
          ];

    }

    sub coord_xfrm {
        my $self  = shift;

        my $coord = $self->output_coord;

        if ( $coord eq 'xrcf' ) {

            return ppcmd(
                osac2xrcf => argsep( '=' ),
                [
                    input  => 'stdin',
                    output => 'OUTPUT',
                    mode => 'H',
                ] );
        }

        elsif ( $coord eq 'hrma' ) {

            return ppcmd(
                osac2hrma => argsep( '=' ),
                [
                    input  => 'stdin',
                    output => 'OUTPUT',
                    mode => 'H',
                ] );
        }

        elsif ( $coord eq 'osac' ) {
            return ppipe;
        }

        die( "unknown output coordinate system: $coord\n" );
    }

    # convert to final output format
    sub reformat {
        my $self = shift;
        my $fmt = $self->output_fmt;

        my $ext;
        my $cmd;

        # native is bpipe; do nothing
        if ( $fmt =~ /^bp(ipe)?$/ ) {
            $ext = 'bp';
            $cmd = ppipe;
        }

        # old fullray style
        elsif ( $fmt =~ /^fr|fullray$/ ) {
            $ext = 'fr';
            $cmd = ppcmd(
                bp2fr => argsep( '=' ),
                [
                    input  => 'stdin',
                    output => 'OUTPUT',
                    mode => 'H',
                ] );
        }

        # rdb
        elsif ( $fmt eq 'rdb' ) {
            $ext = 'rdb';
            $cmd = ppcmd(
                bp2rdb => argsep( '=' ),
                [
                    input  => 'stdin',
                    output => 'OUTPUT',
                    mode => 'H',
                ] );
        }

        # FITS of some flavor
        elsif ( $fmt =~ /^fits(?:-(?<subtype>.*))?$/ ) {
            $ext = 'fits';
            my $trans = 'default';

            if ( defined $+{subtype} ) {
                $trans
                  = catfile( $self->bp2fits_config_dir, "$+{subtype}.rdb" );
                die( "unknown fits output format: $+{subtype} ($trans doesn't exist)\n" )
                  unless -f $trans;
            }

            $cmd = ppcmd(
                bp2fits => argsep( '=' ),
                [
                    input      => 'stdin',
                    output     => 'OUTPUT',
                    trans      => $trans,
                    longstrn   => 'yes',
                    reserved   => 'yes',
                    doublepass => 'yes',
                    vectors    => 'no',
                    verbose    => 0,
                    mode => 'H',
                ] );
        }

        else {
            die( "unknown output format: $fmt\n" );

        }

        return $cmd,
          $self->output eq 'default'
          ? sprintf( "%s.%s", $self->tag, $ext )
          : $self->output;
    }

    sub summarize {
        my ( $self, $param )  = @_;

        return if $self->debug->noexec;

        my $tag = $param->tag;

        ( my $block ) = File::Slurper::read_lines( "$tag.block" );

        my %summary = (
            shell      => 0 + $self->cfg->shell,
            tot_wt_in  => scalar read_tot_wt( $self->logfile( qw[ tot_wt in ] ) ),
            tot_wt_out => scalar read_tot_wt( $self->logfile( qw[ tot_wt out ] ) ),
            param      => { %$param }, # want regular hash, not blessed hash
            block      => 0 + $block,
        );

        $summary{focus} = read_focus( $self->logfile( 'focus' ) )
          if $param->focus;

        {
            my $wt = $summary{tot_wt_out}{wt};
            my $n  = 0 + $summary{tot_wt_out}{n};
            my $pd = $self->debug->normalize_limit ? 1 : $param->limit;

            # $pd may be zero; if so don't bother with the effective area
            # calculations
            if ( $pd ) {
                $summary{ea} = { n => $n };

                if ( $param->limit_type eq 'r/mm2' ) {
                    my $ea = $summary{ea}{ea} = $wt / ( $pd * 100 );
                    $summary{ea}{err} = $ea / sqrt( $n );
                }

                elsif ( $param->limit_type eq 'r/cm2' ) {
                    my $ea = $summary{ea}{ea} = $wt / ( $pd );
                    $summary{ea}{err} = $ea / sqrt( $n );
                }
            }
        }

        write_summary( "$tag.summary", \%summary );
    }

    sub raygen {

        my $self = shift;
        my $cfg = $self->cfg;

        my $cfgpars = "@{[ $self->tag ]}.raygen.cfgpars.lua";
        {
            my $srcpars;

            # if the srcpars parameter looks like a lua script
            # use it directly
            if ( $self->srcpars =~ /[.]lua$/ ) {
                $srcpars = $self->srcpars;
            }

            # else it's code; shove it into another file
            else {

                $srcpars = "@{[ $self->tag ]}.raygen.srcpars.lua";
                my $fh = IO::File->new( $srcpars, 'w' )
                  or die( "error creating raygen srcpars file: $srcpars\n" );
                $fh->say( $self->srcpars );
                $fh->close;
            }

            my %vars = (
                node           => $self->node,
                entrance_ap_db => $cfg->entrance_ap_db,
                shell          => $self->shell,
                srcpars        => $srcpars,
            );
            my $code
              = Text::Template::fill_in_string( <<~'EOT', hash => \%vars );
            config = require('saotrace.config').raygen
            config.node = {{ sprintf "%f", $node }}
            box = require('saotrace.suplib.box')
            box.boxit( getfenv(), '{{ $srcpars }}')
            tables = require('saotrace.suplib.tables')
            config.scripts.entrance_aperture.args = tables.copy(getfenv())
            config.scripts.entrance_aperture.args.file  = '{{ $entrance_ap_db }}'
            config.scripts.entrance_aperture.args.shell = {{$shell}}
            EOT
            File::Slurper::write_text( $cfgpars, $code );
        }


        # generate rays
        ppcmd 'raygen', argsep( '=' ),
          [
            cfgfile    => $cfg->raygen_cfg,
            cfgpars    => $cfgpars,
            output     => 'OUTPUT',
            logfile    => $self->logfile_ctx,
            tstart     => $self->tstart,
            limit      => $self->limit,
            limit_type => $self->limit_type,
            seed1      => $self->seed1,
            seed2      => $self->seed2,
            block      => $self->rblock->next,
            mode => 'H',
          ];
    }

    sub surface {
        my ( $self, $mirror ) = @_;

        my $shell = $self->cfg->shell;
        my $geo   = $mirror->geo;

        my $pipe = ppipe;

        $pipe |= $self->aperture( 'ghostbaffle', 'in' )
          if $shell == 6 && $geo eq 'p';

        $pipe
          |= $self->surface_intercept( $mirror )
          |  $self->multilayer_reflect( $mirror );

        $pipe |= $self->scatter( $mirror )
          if $self->cfg->getbool( "micro_scatter_$geo" );

        $pipe |= $self->aperture( 'ghostbaffle', 'out' )
          if $shell == 6 && $geo eq 'p';

        return $pipe;
    }

    sub scatter {
        my ( $self, $mirror ) = @_;

        my $cfg   = $self->cfg;
        my $shell = $cfg->shell;
        my $geo   = $mirror->geo;

        return
            $self->save_history( 'pre-scatter' => $geo )
          | ppcmd(
            scatter => argsep( '=' ),
            [
                input                      => 'stdin',
                output                     => 'OUTPUT',
                logfile                    => $self->logfile_ctx( $geo),
                seed1                      => $self->seed1,
                seed2                      => $self->seed2,
                block                      => $self->rblock->next,
                scatter_db                 => $mirror->scatter_table,
                mirror_db                  => $cfg->mirror_geo_db,
                in_plane                   => yesno( $cfg->getbool( "scat_${geo}${shell}_in_plane" ) ),
                out_of_plane               => yesno( $cfg->getbool( "scat_${geo}${shell}_out_of_plane" ) ),
                min_cumulative_probability => $cfg->get( "scat_${geo}${shell}_min_prob" ),
                max_cumulative_probability => $cfg->get( "scat_${geo}${shell}_max_prob" ),
                shell                      => $shell,
                surf_no                    => $mirror->surf_no,
                theta                      => 0,
                phi                        => 0,
                mode => 'H',
            ] )
          | $self->save_history( 'post-scatter' => $geo );
    }

    sub surface_intercept {
        my ( $self, $mirror ) = @_;

        return
            $self->save_history( 'pre-intercept' => $mirror->geo  )
          | ppcmd(
            surface_intercept => argsep( '=' ),
            [
                input           => 'stdin',
                output          => 'OUTPUT',
                surf_no         => $mirror->surf_no,
                logfile         => $self->logfile( 'intercept', $mirror->geo ),
                gi_filename     => $mirror->gi_file,
                dfm_filename    => $mirror->dfm_file,
                dfm_scale       => $mirror->dfm_scale,
                dfm2_filename   => $mirror->dfm2_file,
                dfm2_scale      => $mirror->dfm2_scale,
                dfm_type        => $mirror->dfm_type,
                theta0          => $mirror->theta0,
                theta02         => '0',
                do_osac_reflect => 'no',
                onlygoodrays    => yesno( $self->cfg->getbool( 'onlygoodrays' ) ),
                debug           => '',
                mode => 'H',
            ] )
          | $self->save_history( 'post-intercept' => $mirror->geo );
    }

    sub multilayer_reflect {
        my ( $self, $mirror ) = @_;

        return
            $self->save_history( 'pre-reflect' => $mirror->geo  )
          | ppcmd(
            multilayer_reflect => argsep( '=' ),
            [
                input            => 'stdin',
                output           => 'OUTPUT',
                logfile          => $self->logfile( 'reflect', $mirror->geo ),
                layerdata_rdb    => $mirror->reflect_table,
                energy_xfrm      => 'lin',
                reflectance_xfrm => 'lin',
                mode => 'H',
            ] )
          | $self->save_history( 'post-reflect' => $mirror->geo )
          ;
    }

    sub project {
        my ( $self ) = @_;
        ppcmd(
            projray => argsep( '=' ),
            [
                input  => 'stdin',
                output => 'OUTPUT',
                z      => $self->z,
                mode => 'H',
            ] );
    }

    sub save_history {

        my ( $self, @location ) = @_;

        my $fields = join( ',', @{ $self->debug->save_history_fields } );

        my $location = join( '-', @location );

        my $pipe = ppipe;

        $pipe |= ppcmd( tee => "@{[ $self->tag ]}.${location}.bp" )
          if $self->debug->save_rays->{$location};

        $pipe |= ppcmd(
            'bp-save-history',
            argsep( '=' ),
            [
                input   => 'stdin',
                output  => 'stdout',
                fields  => $fields,
                help    => 'no',
                version => 'no',
                mode => 'H',
            ] ) if $self->debug->save_history->{$location};

        return $pipe;
    }


    sub aperture {
        my ( $self, $assembly, $logtag ) = @_;

        my $cfg = $self->cfg;

        return ppipe() unless defined $assembly && $cfg->getbool( $assembly );

        my $spec = $cfg->get( $assembly . '_spec' );

        my $db = $self->check_file( $assembly . '_db' );

        my $cfgpars = "@{[ $self->tag ]}.aperture.$assembly.lua";
        {
            my $rcfg = IO::File->new( $cfgpars, 'w' )
              or
              die( "error creating aperture configuration file: $cfgpars\n" );

            $rcfg->printf( "shell = %d\n",           $self->shell );
            $rcfg->printf( "assembly_name = '%s'\n", $assembly );
            $rcfg->printf( "config_db = '%s'\n",     $db );
        }

        # all of the override values are strings; quote strings for Lua
        return ppcmd(
            aperture => argsep( '=' ),
            [
                cfgfile => $spec,
                cfgpars => $cfgpars,
                input   => 'stdin',
                output  => 'OUTPUT',
                statfname => $self->logfile_ctx( $assembly, ( $logtag ) || () ),
                loop => 'no',
                mode => 'H',
            ] );
    }

    sub post_en_corr {
        my $self = shift;
        my $cfg = $self->cfg;

        ppcmd(
            quef => argsep( '=' ),
            [
                input       => 'stdin',
                output      => 'OUTPUT',
                lookuptable => $cfg->post_en_corr_file,
                begin       => $cfg->post_en_corr_begin,
                end         => $cfg->post_en_corr_end,
                qe          => $cfg->post_en_corr_qe . $cfg->shell,
                xtype       => 'lin',
                ytype       => 'lin',
                qeclip      => 'no',
                qemax       => 1.0,
                qemin       => 0.0,
                killzerowt  => 'yes',
                mode => 'H',
            ] );
    }

    sub normalize_limit {
        my $self = shift;
        ppcmd(
            bpsetwt => argsep( '=' ),
            [
                input   => 'stdin',
                output  => 'OUTPUT',
                op      => 'div',
                operand => $self->limit,
                mode => 'H',
            ] );
    }

    sub tallyphot {
        my $self = shift;
        ppcmd(
            tallyphot => argsep( '=' ),
            [
                input  => 'stdin',
                output => 'OUTPUT',
                outcnt => $self->tally,
                time   => 'yes',
                mode => 'H',
            ] );
    }


    # expand variables in $text, but put an error message in
    # if the variable isn't defined
    sub interpolate {
        my ( $self, $text ) = @_;
        $text =~ s{
       \$                         # find a literal dollar sign
      (?:{(\w+)}|(\w+))            # find a "word" and store it in $1 or $2
  }{
      my $t = defined $2 ? $2 : $1;
      if (defined $self->{$t}) {
          $self->{$t};                    # expand global variables only
      } else {
          "[NO SUCH VARIABLE: \$$t]";  # error msg
      }
  }egx;
        die( $text, "\n" ) if $text =~ /NO SUCH VARIABLE/;
        $text;
    }

    sub clean_filter {

        my ( $self, $filter ) = @_;

        require Text::ParseWords;
        my $pipe = ppipe;

        # split on white space and the pipe symbol. keep delimiters so
        # we can search for the pipe symbol
        my @tokens
          = Text::ParseWords::parse_line( '\s+|\|', 'delimiters', $filter );

        # there may be multiple commands (separated by the pipe symbol)
        my @comms = ( [] );
        for my $token ( @tokens ) {
            if ( $token eq '|' ) {
                push @comms, [];
            }
            else {
                push @{ $comms[-1] }, eval { $self->interpolate( $token ) };
                die "error in filter spec ($filter): $@" if $@;
            }
        }

        # now remove all of the extraneous  white space-only tokens
        # and any quotes from quoted tokens

        $pipe |= ppcmd Text::ParseWords::shellwords( @{$_} ) foreach @comms;

        return $pipe;
    }

sub yesno {
    require Lingua::Boolean::Tiny;
    state $lb = Lingua::Boolean::Tiny->new( 'en' );
    return $lb->yesno( @_ );
}

}

}

package Block {

    sub new {
        my ( $class, $block, $block_inc ) = @_;
        my $self = bless {
            block     => $block,
            block_inc => $block_inc
        }, $class;
        return $self;
    }

    sub current { return $_[0]->{block} }

    sub next {
        my $self = shift;
        my $next = $self->{block};
        $self->{block} += $self->{block_inc};
        return $next;
    }
}

package DBFlags {

    use Types::Standard -types, -coercions;
    use Types::Common::Numeric qw( NumRange );
    use Moo;
    use MooX::StrictConstructor;

    use constant HISTORY_LOCATIONS =>
      ( 'input', map {; "$_-p", "$_-h" }
        qw(  pre-scatter post-scatter pre-intercept post-intercept pre-reflect post-reflect )
      );

    BEGIN {

        has pcomm => (
            is      => 'ro',
            isa     => Bool,
            predicate => 1,
            default => 0
        );

        has noexec => (
            is      => 'ro',
            isa     => Bool,
            predicate => 1,
            default => 0
        );

        has reuse => (
            is      => 'ro',
            isa     => Bool,
            predicate => 1,
            default => 0
        );

        has normalize_limit => (
            is      => 'ro',
            isa     => Bool,
            predicate => 1,
            default => 0
        );

        has noproject => (
            is      => 'ro',
            isa     => Bool,
            predicate => 1,
            default => 0
        );

        has save_rays => (
            is       => 'ro',
            isa => Map [ Enum([HISTORY_LOCATIONS ]), Bool ],
            default  => sub { {} },
            predicate => 1,
            init_arg => 'save-rays'
        );

        has save_history => (
            is  => 'ro',
            isa => Map [ Enum([HISTORY_LOCATIONS ]), Bool ],
            default  => sub { {} },
            predicate => 1,
            init_arg => 'save-history'
        );

        has save_history_fields => (
            is       => 'ro',
            isa      => ArrayRef->of(Str)->plus_coercions( Split[qr/[:,]/] ),
            coerce   => 1,
            init_arg => 'save-history-fields',
            default  => sub { [ '%all' ] },
            predicate => 1,
        );

        has input_tap => (
            is        => 'ro',
            isa       => Str,
            predicate => 1,
        );

        has input_filter => (
            is        => 'ro',
            isa       => Str,
            predicate => 1,
        );

        has noghosts => (
            is      => 'ro',
            isa     => Bool,
            predicate => 1,
            default => 0,
        );

        has output_tap => (
            is        => 'ro',
            isa       => Str,
            predicate => 1,
        );
        has output_filter => (
            is        => 'ro',
            isa       => Str,
            predicate => 1,
        );

        has scat_min_prob => (
            is        => 'ro',
            isa       => NumRange [ 0, 1 ],
            predicate => 1,
        );

        has scat_min_prob_h => (
            is        => 'rwp',
            isa       => NumRange [ 0, 1 ],
            predicate => 1,
        );

        has scat_min_prob_p => (
            is        => 'rwp',
            isa       => NumRange [ 0, 1 ],
            predicate => 1,
        );

        has scat_max_prob => (
            is        => 'ro',
            isa       => NumRange [ 0, 1 ],
            predicate => 1,
        );

        has scat_max_prob_h => (
            is        => 'ro',
            isa       => NumRange [ 0, 1 ],
            predicate => 1,
        );

        has scat_max_prob_p => (
            is        => 'ro',
            isa       => NumRange [ 0, 1 ],
            predicate => 1,
        );

        has scat_in_plane => (
            is      => 'ro',
            isa     => Bool,
            predicate => 1,
        );

        has scat_in_plane_p => (
            is      => 'rwp',
            isa     => Bool,
            predicate => 1,
        );

        has scat_in_plane_h => (
            is      => 'rwp',
            isa     => Bool,
            predicate => 1,
        );

        has scat_out_of_plane => (
            is      => 'ro',
            isa     => Bool,
            predicate => 1,
        );

        has scat_out_of_plane_p => (
            is      => 'rwp',
            isa     => Bool,
            predicate => 1,
        );

        has scat_out_of_plane_h => (
            is      => 'rwp',
            isa     => Bool,
            predicate => 1,
        );

        sub new_from_string {
            my ( $class, $debug )  = @_;

            require Text::ParseWords;

            my %arg;

            foreach ( Text::ParseWords::quotewords( ',', 0, $debug ) ) {
                # ignore leading and trailing whitespace
                s/^\s+//;
                s/\s+$//;
                if ( /^(?<key>[\w\-]+)\s*(?<sep>[=:])\s*(?<value>.*)/ ) {

                    if ( $+{sep} eq '=' ) {
                        $arg{ $+{key} } = $+{value};
                    }
                    elsif ( $+{sep} eq ':' ) {
                        ( $arg{ $+{key} } //= {} )->{ $+{value} }++;
                    }
                }
                else {
                    $arg{$_} = 1;
                }
            }
            return $class->new( \%arg );
        }
    }
}

package RTConfig {

    use parent 'Config::Wild';
    use constant CFG_VERSION => '2.0.0';

    use Type::Params qw( compile_named_oo );
    use Types::Standard -types;
    use Types::Common::Numeric -types;

    sub new {
        my $class = shift;

        state $check = compile_named_oo(
            config_db  => Str,
            config_dir => Str,
            shell      => PositiveInt,
            src        => Str,
        );

        my $args = $check->( @_ );
        my $self = $class->SUPER::new( {
                path  => [ split( ':', $args->config_dir ) ],
                UNDEF => sub {
                    die "@{[ $args->config_db ]}: undefined keyword: $_[0]\n";
                },
            } );

        # preset some things
        $self->set( 'shell' => $args->shell );

        $self->set( 'mirror_{.*}_dfm2_db'    => '' );
        $self->set( 'mirror_{.*}_dfm_scale'  => 1 );
        $self->set( 'mirror_{.*}_dfm2_scale' => 1 );

        $self->default_cascade( 'scat', 'min_prob', 0 );
        $self->default_cascade( 'scat', 'max_prob', 1 );

        $self->default_cascade( 'scat', 'in_plane',     'yes' );
        $self->default_cascade( 'scat', 'out_of_plane', 'yes' );


        $self->set( 'post_en_corr'       => 'no' );
        $self->set( 'post_en_corr_qe'    => 'fac_' );
        $self->set( 'post_en_corr_begin' => 'emin' );
        $self->set( 'post_en_corr_end'   => 'emax' );

        # older configurations won't have "micro_scatter_p" or "micro_scatter_h"
        # for newer configs with no "micro_scatter", that'll get created later
        # the $self->load() will override this, if necessary.
        $self->set( 'micro_scatter_{.*}' => '$(micro_scatter)' );

        $self->load( $args->config_db );

        die(
            "@{[ $args->config_db ]} is not supported by this version of trace-shell\n"
          )
          if !$self->exists( 'version' )
          || $self->get( 'version' ) ne CFG_VERSION;


        # upgrade some configuration options
        for my $options ( [ precoll => 'precollimator' ],
                          [ postcoll => 'postcollimator' ] ) {

            my ( $old, $new ) = @$options;

            if ( $self->exists( $old ) ) {
                for my $sfx ( '', '_spec', '_db' ) {
                    my $old = "${old}${sfx}";
                    my $new = "${new}${sfx}";
                    $self->set( $new, $self->get( $old ) )
                      if $self->exists( $old );
                }
            }
        }

        # set up source_spec from parameter file, unless it was requested
        # to be the default in the configuration file
        if ( $args->src eq 'default' ) {

            die( "error: no default raygen configuration\n" )
              unless $self->exists( 'raygen_default_cfg' );

            $self->set( 'raygen_cfg', $self->raygen_default_cfg );

        }
        else {
            $self->set( 'raygen_cfg', $args->src );
        }

        # create "micro_scatter" if needed.  may not exist in newer
        # configuration files
        unless ( $self->exists( 'micro_scatter' ) ) {
            my $micro_scatter
              = grep { $self->exists( $_ ) && $self->getbool( $_ ) }
              qw( micro_scatter_p micro_scatter_h );

            $self->set( 'micro_scatter', yesno( $micro_scatter ) );
        }

        return $self;
    }

    sub default_cascade {
        my $self = shift;
        my ( $pfx, $sfx, $default ) = @_;

        my $shell = $self->shell;

        $self->set( "${pfx}_${sfx}" => $default );

        $self->set( "${pfx}_${shell}_${sfx}" => "\$(${pfx}_${sfx})" );

        $self->set( "${pfx}_h_${sfx}" => "\$(${pfx}_${shell}_${sfx})" );
        $self->set( "${pfx}_p_${sfx}" => "\$(${pfx}_${shell}_${sfx})" );

        $self->set( "${pfx}_h${shell}_${sfx}" => "\$(${pfx}_h_${sfx})" );
        $self->set( "${pfx}_p${shell}_${sfx}" => "\$(${pfx}_p_${sfx})" );
    }

    sub set_sys_var {

        my $self = shift;
        my $value = pop;
        my ( $sys, $var, $geo ) = @_;

        my $shell = $self->shell;

        my $slot = join( '_', $sys, ( $geo // () ), $var );

        $self->set( $slot => $value );

    }

}


1;

__END__

=pod

=head1 NAME

trace-shell - ray trace a shell, hey!

=head1 SYNOPSIS

B<trace-shell> I<options>

=head1 ARGUMENTS

B<trace-shell> uses an IRAF-compatible parameter interface. The
available parameters are:

=over 8

=item B<tag>

A prefix to be used on all intermediate files created.  There are lots
of intermediate files; see the section on L<Intermediate Files>.


=item B<src>

The location of a B<raygen> compatible source script.  If it is the
string C<default>, the value of the C<source_spec> keyword in the
B<trace-shell> configuration file is used.

=item B<srcpars>

Extra parameters to be passed to the source script.  If it ends in
C<.lua> it is interpreted as being the name of a Lua script. See the
documentation for the source script for information on which
parameters are available.

=item B<output>

The output stream to which to write the rays.  It may be a filename,
or the string C<stdout>, in which case rays will be written to the
standard output stream.  If it is the string C<default>, a file name
will be created by appending the B<output_fmt> to the B<tag> (with an
intervening period).

=item B<output_fmt>

The output format of the rays.  May be one of C<fr>, C<bpipe>, C<rdb>,
or a C<fits> variant.  See L<Output Formats> for more information.

=item B<output_coord>

The output coordinate system of the rays.  May be one of C<osac>,
C<hrma>, C<xrcf>.

=item B<output_fields>

Which data fields to output for each ray.  The value may be one of

=over

=item C<all>

A rather large amount of information.

=item <field names>

A comma delimited list of field names to output.  Field names may be
prefixed with C<->, indicating that they are to be I<removed> from the
list of output fields.  If the only fields specified are those to be
removed, the initial output list contains all of the fields in the data.

The field name C<min> is an alias for specifying the following fields:

  position direction weight energy time

The order of additive and subtractive fields is unimportant; all additive
fields are inserted into the list before the subtractive fields are removed.

=back


=item B<shell>

The shell to raytrace.

=item B<seed1>

The first seed for the random number generator.  It must be in the range
[1,2147483562].

=item B<seed2>

The second seed for the random number generator.  It must be in the range
[1,214748339]

=item B<block>

The random number block at which to start.  It must be in the range
[0,1048575].

=item B<block_inc>

The spacing between random number blocks for each random process.  100
is a good number.

=item B<tstart>

The start time of the observation in seconds.  If less than zero and
jitter is turned on, the start of the valid jitter time range is used.


=item B<limit>

The quantity of whatever C<limit_type> specifies that B<raygen> must
generate.  If C<limit_type> is a unit of time, this is added to the
start time (see C<tstart>) to determine the stop time of the
simulation. If jitter is on and this is set to C<0>, then the stop
time is set equal to the end of the valid jitter time range.

=item B<limit_type>

The units of the limit at which to stop generating rays.

=over 8

=item C<ksec>

kiloseconds of observation time

=item C<sec>

seconds of observation time

=item C<Mrays>

millions of rays at the entrance aperture

=item C<krays>

thousands of rays at the entrance aperture

=item C<rays>

rays at the entrance aperture

=item C<r/mm2>

a ray density at the entrance aperture in rays / mm^2

=item C<r/cm2>

a ray density at the entrance aperture in rays / cm^2

=back

=item B<focus>

A boolean parameter indicating that the focus of the system is to be
determined.  See the L</Focus> section for more details.

=item B<z>

The position along the I<Z> (optical) axis at which to leave the rays.

=item B<tally>

If non-zero, a tally of photons will be written to the standard
error stream every C<tally> rays.  This is useful if you're wondering
why it's taking so long to run the raytrace.  This tallies the number
of rays which make it out of the shell, after all of the post-optic
apertures.

=item B<config_dir>

B<trace-shell> will change into this directory before reading
the configuration file.  This allows relative includes within
standard configuration files to work.

=item B<config_db>

The name of the configuration file which provides the details of the
mirror configuration.  If this begins with C<.> or C</>, the
configuration file in the specified directory will be used.  Note that
B<trace-shell> will still change directory to B<config_dir> before
reading the configuration file.


=item B<version>

Print out the version information and exit.

=item B<help>

Print out this message and exit.

=item B<debug>

A comma separated list of debugging options.  See L</Debugging>
for more information.

=back

=head1 DESCRIPTION

B<trace-shell> raytraces a single Wolter type I X-ray telescope
shell with various apertures and baffles.  It was designed around the
AXAF HRMA, but may be used for other systems.  In order to isolate the
source specification from the specification of the optics, it uses a
separate optics configuration file (see L<Configuration File>).

B<trace-shell> uses a variety of programs to accomplish the
raytrace.  To see the actual raytrace command pipeline, use the
B<debug> C<pcomm> option.

=head2 Configuration File

The B<trace-shell> configuration file (specified by the
B<config_dir> and B<config_db> parameters) describes the telescope
configuration. See the B<ts_config> documentation for more information.


=head2 Intermediate Files

B<trace-shell> produces a few intermediate files, prefixed by the
value of the B<tag> parameter:

=over 8

=item C<tag.gi>

This is a rather arcanely formatted file required by B<SAOdrat>.  It's not of
much general interest.

=item C<tag.tot_wt.in.log>

This file contains the number and weight of the rays at the entrance aperture.
It is produced by B<tot_wt>.

=item C<tag.tot_wt.out.log>

This file contains the number and weight of the rays which have made it through
the entire configuration.  It is produced by B<tot_wt>.

=item C<tag.focus.log>

This is an arcanely formatted file created during a focus run by
B<saofocus>.

=item C<tag.summary.rdb>

This summarizes the C<tag.tot_wt.in.log>, C<tag.tot_wt.out.log>, and C<tag.focus.log>
files.

=back

=head2 Output Formats

B<trace-shell> produces output in one of the following formats,
specified by the B<output_fmt> parameter:

=over 8

=item C<fr>

The C<fr> format has no header.  Each ray is in a C<fullray> structure.
See F</proj/axaf/simul/include/fullray.h> for the formats of the ray
structure.

=item C<bpipe>

The rays are in C<bpipe> format. See the B<bpipe> documentation for
more information on this.

=item C<rdb>

The rays are written as an RDB table.

=item a C<fits> variant

Various FITS formatted outputs may be specified.  In all cases the
output must be to a file.

=over

=item C<fits-axaf>

The rays are written according to the AXAF FITS Photon standard.

=item C<fits-events>

The rays are written in the common astronomical X-ray
"events" format.  Most X-ray Astronomy software uses this convention.

=back

=back


=head2 Focus

If you wish to determine where the focal point for a given
configuration is, set the B<focus> parameter to C<yes>.  Because of
bad interactions between the focus algorithm and wildly scattered
rays, micro-roughness induced ray scattering and ghost-ray tracking is
turned off when focussing.  You should nominally only focus with a
point source.  If the B<src> parameter is set to C<default>, the
default focus source (as specified in the configuration file) will be
used.  You may need to specify arguments for the focus source via the
B<srcpars> parameter. The focus procedure is carred out by
B<saofocus> which leaves its results in files called C<tag.focus.log>
and C<tag.focus.rdb> (where you've specified B<tag>).  The first file's
format is pretty arcane; generally to extract the focus from there, run the
script F<getfocus> on it:

  getfocus tag.focus.log

which will write out the focal position (in OSAC coordinates) to the
standard output stream.  The second file (C<tag.focus.rdb>) contains
the three-dimensional position of the Global Optimal Focus.


=head2 Debugging

The B<debug> options that are available are:

=over 8

=item C<pcomm>

Print out the raytrace command before executing it.  This gives you
some idea of which programs are running and what their inputs are.

=item C<noexec>

Generate the raytrace command and any required intermediate files, but
do not execute it.  Most useful with the C<pcomm> debug option.

=item C<reuse>

Reuse the raytrace output from a previous B<identical> run to
regenerate the summary information.  C<noexec> must I<not> be
specified simultaneously.  The raytrace parameters should be
identical except for the addition of this flag.

=item C<normalize_limit>

If specified and the C<limit_type> parameter is density related, the
output ray weights will be scaled so that the input photon density is
1.  This allows specifying different photon densities for each shell
to provide a uniform statistical errors while retaining the ability to
easily coadd the raytraces for different shells.

=item C<noproject>

Do not project the rays to the value specified by the C<z> parameter.
This is a temporary kludge, and will probably not survive into the
next version of B<trace-shell>.

=item C<save-rays>:I<location>

=item C<save-history>:I<location>

C<save-rays> and C<save-history> are complementary means of getting a
look at the rays as they pass through the raytrace.

=over

=item *

C<save-rays> will create a copy of the current state of the rays on disk.
Save intermediate rays. Rays are saved in C<bpipe> format to the file
F<${tag}.where.bp>.

=item *

C<save-history> will store a copy of the current state of the rays in
the ray stream.  It does this by changing every data packet field into an
array, and using it as a stack; newer data is at index 0; the oldest
is at the end of the array.  To limit the number of fields which have
history, use the C<save-history-fields> debug option.

=back

There are a number of pre-defined locations in the raytrace at which ray history
may be saved.  Multiple locations may be specified. Use the format

  save-rays:location1,save-rays:location2,...
  save-history:location1,save-history:location2,...

I<location> is one of

=over

=item input

Rays coming out of the ray generator

=item h-pre-intercept

=item p-pre-intercept

Rays before they are intercepted with the optic.

=item h-post-intercept

=item p-post-intercept

Rays after they are intercepted with the optic.

=item h-pre-reflect

=item p-pre-reflect

Rays before they are reflected at the optic.

=item h-post-reflect

=item p-post-reflect

Rays after they are reflected at the optic.

=item h-pre-scatter

=item p-pre-scatter

Rays before they are scattered off of the optic

=item h-post-scatter

=item p-post-scatter

Rays after they are scattered off of the optic

=back

=item C<save-history-fields>=I<colon separated list of fields>

By default, saving history (see the C<save-history> debug option)
saves I<all> fields.  This can be expensive.  To limit the number of
fields saved, set this option to a I<colon> separated list of fields:

  save-history-fields=position:direction:id

=item C<input-tap>=I<command>

The rays exiting the ray generator (before they hit the shells) will
be copied to the standard input stream of the specified command (thus
the name C<input-tap>).  The command may refer to any of the
parameters given to B<trace-shell> using the syntax C<$parameter> or
C<${parameter}>.  For example,

  debug=input-tap='frobnicator input=stdin output=$tag.frob'

The rays are in B<bpipe> format.

=item C<input-filter>=I<command>

The rays exiting the ray generator are passed through the provided
command before being sent to the shells.  The command must read the
rays from its standard input and write the modified rays to its
standard output.  The command may refer to any of the parameters given
to B<trace-shell> using the syntax C<$parameter> or C<${parameter}>.
For example,

  debug=input-filter='snackmaster input=stdin output=stdout'

The rays are in B<bpipe> format.

=item C<noghosts>

Ghost rays will not be propagated through the system.

=item C<output-tap>=I<command>

The rays exiting the optics (after projecting to the final
requested position, but before any coordinate conversions) will
be copied to the standard input stream of the specified command (thus
the name C<output-tap>).  The command may refer to any of the
parameters given to B<trace-shell> using the syntax C<$parameter> or
C<${parameter}>.  For example,

  debug=output-tap='frobnicator input=stdin output=$tag.frob'

The rays are in B<bpipe> format.

=item C<output-filter>=I<command>

The rays exiting the optics (after projecting to the final requested
position, but before any coordinate conversions) are passed through
the provided command before being tallied and finally written to the
requested destination. The command must read the rays from its
standard input and write the modified rays to its standard output.
The command may refer to any of the parameters given to
B<trace-shell> using the syntax C<$parameter> or C<${parameter}>.
For example,

  debug=output-filter='snackmaster input=stdin output=stdout'

The rays are in B<bpipe> format.

=item C<scat_min_prob>=I<fractional probability>

=item C<scat_max_prob>=I<fractional probability>

set the minimum or maximum scattering probability for both optics

=item C<scat_min_prob_${optic}>=I<fractional probability>

=item C<scat_max_prob_${optic}>=I<fractional probability>

set the minimum or maximum scattering probability for the specified
optic.  The string I<$optic> may be one of C<p> or C<h>.

=item C<scat_in_plane>=C<yes>|C<no>

=item C<scat_out_of_plane>=C<yes>|C<no>

Turn on or off in or out-of-plane scattering for both optics.  The
default is taken from the raytrace configuration file.

=item C<scat_in_plane_${optic}>=C<yes>|C<no>

=item C<scat_out_of_plane_${optic}>=C<yes>|C<no>

Turn on or off in or out-of-plane scattering for the specified
optic.  The string I<$optic> may be one of C<p> or C<h>.

=back

=head1 SEE ALSO

B<trace-nest>, B<ts_config>

=head1 COPYRIGHT AND LICENSE

Copyright 2006 The Smithsonian Astrophysical Observatory

This software is released under the GNU General Public License.  You
may find a copy at: L<http://www.fsf.org/copyleft/gpl.html>

=head1 AUTHOR

Diab Jerius E<lt>djerius@cfa.harvard.eduE<gt>

=cut
