#! /bin/sh
#!perl -w # --*- Perl -*--
eval 'exec perl -x $0 ${1+"$@"}'
    if 0;
#------------------------------------------------------------------------------
#$Author: andrius $
#$Date: 2017-05-30 14:51:03 +0300 (Tue, 30 May 2017) $ 
#$Revision: 5376 $
#$URL: svn://www.crystallography.net/cod-tools/tags/v2.1/scripts/cif_fillcell $
#------------------------------------------------------------------------------
#*
#* Generates symmetric atoms from a CIF file.
#*
#* USAGE:
#*    $0 --options input.cif inputs*.cif
#**

use strict;
use warnings;
use File::Basename qw( fileparse );
use COD::CIF::Parser qw( parse_cif );
use COD::CIF::Data qw( get_symmetry_operators );
use COD::CIF::Tags::CanonicalNames qw( canonicalize_names );
use COD::Spacegroups::Symop::Parse qw( symop_from_string modulo_1 );
use COD::Spacegroups::Lookup::COD;
use COD::SOptions qw( getOptions );
use COD::SUsage qw( usage options );
use COD::ErrorHandler qw( process_warnings
                          process_errors
                          process_parser_messages );
use COD::ToolsVersion;

my $Id = '$Id: cif_fillcell 5376 2017-05-30 11:51:03Z andrius $';
my $use_parser = 'c';
my $die_on_errors    = 1;
my $die_on_warnings  = 0;
my $die_on_notes     = 0;
my $die_on_error_level = {
    ERROR   => $die_on_errors,
    WARNING => $die_on_warnings,
    NOTE    => $die_on_notes
};

my $build_supercell = 0;

#* OPTIONS:
#*   --supercell
#*                     Build the 3x3x3 supercell by shifting atoms of the
#*                     unit cell in all 3D directions.
#*   --unit-cell, --no-supercell
#*                     Only build the unit cell (default).
#*   --use-c-parser
#*                     Use the faster C parser for CIFs (default).
#*   --use-perl-parser
#*                     Use the Perl parser for parsing CIFs.
#*   --help, --usage
#*                     Output a short usage message (this message) and exit.
#*   --version
#*                     Output version information and exit.
#**
@ARGV = getOptions(
    '--supercell'    => sub { $build_supercell = 1 },
    '--no-supercell' => sub { $build_supercell = 0 },
    '--unit-cell'    => sub { $build_supercell = 0 },

    '--use-perl-parser' => sub { $use_parser = 'perl' },
    '--use-c-parser'    => sub { $use_parser = 'c' },
    '--options'         => sub { options; exit },
    '--help,--usage'    => sub { usage; exit },
    '--version'         => sub { print 'cod-tools version ',
                                 $COD::ToolsVersion::Version, "\n";
                                 exit }
);

@ARGV = ('-') unless @ARGV;

binmode STDOUT, ':encoding(UTF-8)';
binmode STDERR, ':encoding(UTF-8)';

foreach my $filename (@ARGV) {
    my $options = { 'parser' => $use_parser, 'no_print' => 1 };
    my ( $data, $err_count, $messages ) = parse_cif( $filename, $options );
    process_parser_messages( $messages, $die_on_error_level );

    foreach my $dataset (@{$data}) {
        canonicalize_names( $dataset );

        my $values   = $dataset->{values};
        my $dataname = 'data_' . $dataset->{'name'} if defined $dataset->{'name'};

        local $SIG{__WARN__} = sub { process_warnings( {
                                       'message'  => @_,
                                       'program'  => $0,
                                       'filename' => $filename,
                                       'add_pos'  => $dataname
                                     }, $die_on_error_level ) };

        eval {
            # extracts atom site label or atom site type symbol
            my $loop_tag;

            if (exists $values->{'_atom_site_label'}) {
                $loop_tag = '_atom_site_label';
            }
            elsif (exists $values->{'_atom_site_type_symbol'})
            {
                $loop_tag = '_atom_site_type_symbol';
            }
            else
            {
                die 'ERROR, neither \'_atom_site_type_symbol\' '
                  . 'nor \'_atom_site_label\' are present in the file' . "\n";
            }

            my $loop_id = $dataset->{'inloop'}{$loop_tag};
            my $atom_loop_tags = $dataset->{'loops'}[$loop_id];

            # extracts symmetry operators
            my $sym_data = get_symmetry_operators($dataset);

            my @sym_operators = map{symop_from_string($_)} @{$sym_data};

            my @atom_loop_values;
            for(my $i = 0; $i < @sym_operators; $i++)
            {
                my $symop = $sym_operators[$i];

                for(my $j = 0; $j < @{$values->{$loop_tag}}; $j++)
                {
                    my @atom_xyz;
                    foreach ( qw( _atom_site_fract_x
                                  _atom_site_fract_y
                                  _atom_site_fract_z ) )
                    {
                        push @atom_xyz, $values->{$_}[$j];
                    }
                    push @atom_xyz, 1;

                    my $new_atom_xyz = symop_apply(\@atom_xyz, $symop);
                    if ($build_supercell) {
                        $new_atom_xyz = shift_atoms($new_atom_xyz);
                    } else {
                        $new_atom_xyz = [$new_atom_xyz];
                    }

                    for(my $m = 0; $m < @{$new_atom_xyz}; $m++)
                    {
                    my @tag_values;
                    foreach my $tag ( @{$atom_loop_tags} )
                    {
                        my $old_atom_data = $values->{$tag};

                        if('_atom_site_adp_type' eq $tag) {
                            next;
                        }

                        if($tag eq '_atom_site_label')
                        {
                            push @tag_values, ${$old_atom_data}[$j].'_'.$i.'_'.$m;
                        }
                        elsif($tag eq '_atom_site_fract_x')
                        {
                            push @tag_values, ${$new_atom_xyz}[$m][0];
                        }
                        elsif($tag eq '_atom_site_fract_y')
                        {
                            push @tag_values, ${$new_atom_xyz}[$m][1];
                        }
                        elsif($tag eq '_atom_site_fract_z')
                        {
                            push @tag_values, ${$new_atom_xyz}[$m][2];
                        }
                        else
                        {
                            push @tag_values, ${$old_atom_data}[$j];
                        }
                    }
                    push @atom_loop_values, \@tag_values;
                    }
                }
            }

            print_cif( $dataset, $atom_loop_tags, \@atom_loop_values );
        };
        if ( $@ ) {
            process_errors( {
              'message'       => $@,
              'program'       => $0,
              'filename'      => $filename,
              'add_pos'       => $dataname
            }, $die_on_errors )
        }
    }
}

#===============================================================#
sub symop_apply
{
    my($atom_xyz, $symop) = @_;
    my @new_atom_xyz;

    for(my $i = 0; $i < @{$symop}; $i++)
    {
        $new_atom_xyz[$i] = 0;
        for(my $j = 0; $j < @{$symop}; $j++)
        {
            ${$atom_xyz}[$j] =~ s/\(\d+\)$//;
            $new_atom_xyz[$i] += ${$atom_xyz}[$j] * ${$symop}[$i][$j];
        }
        $new_atom_xyz[$i] = modulo_1($new_atom_xyz[$i]);
    }

    return \@new_atom_xyz;
}

#===============================================================#
sub shift_atoms
{
    my($atom_xyz) = @_;

    my @shifted_atom_xyz;
    my @shift = (0, -1, 1);

    foreach my $x ( @shift ) {
    foreach my $y ( @shift ) {
    foreach my $z ( @shift ) {
        push @shifted_atom_xyz, [ ${$atom_xyz}[0] + $x,
                                  ${$atom_xyz}[1] + $y,
                                  ${$atom_xyz}[2] + $z ];
    } } }

    return \@shifted_atom_xyz;
}

#==============================================================#
sub print_cif
{
    my ( $dataset, $atom_loop_tags, $atom_loop_values ) = @_;

    my $dataname = $dataset->{'name'};
    my $values = $dataset->{'values'};

    print 'data_' .  $dataname . '_' . fileparse($0) . "\n";

    print '_space_group_IT_number      1' , "\n";
    print '_space_group_name_Hall      \'P 1\'' . "\n";
    print '_space_group_name_H-M_alt   \'P 1\'' . "\n";

    # print unit cell lengths and angles
    foreach ( qw( _cell_angle_alpha
                  _cell_angle_beta
                  _cell_angle_gamma ) )
    {
        if( defined $values->{$_}[0] ) {
            print $_ . '   ' . $values->{$_}[0] . "\n";
        }
    }

    foreach ( qw( _cell_length_a
                  _cell_length_b
                  _cell_length_c ) )
    {
        print $_ . '   ' . $values->{$_}[0] . "\n";
    }

    # print symmetry operator information
    print 'loop_' . "\n";
    print '_space_group_symop_id' . "\n";
    print '_space_group_symop_operation_xyz' . "\n";
    print '1 \'x, y, z\'' . "\n";

    # print atom loop tags
    print "loop_\n";
    foreach ( @{$atom_loop_tags} ) {
        if( '_atom_site_adp_type' ne $_ ) { print $_ . "\n" }
    }

    foreach ( @{$atom_loop_values} ) {
        print join ' ', @{$_};
        print "\n";
    }

    return;
}
