#!/usr/bin/perl
#
# MARTIN 
#
#  routine pour passer un fichier du format carthagene au format rhmap
#
$[ = 1;			# set array base to 1
$, = ' ';		# set output field separator
$\ = "\n";		# set output record separator
#
{
((($ficin,$ficout) = @ARGV) == 2 && -r $ficin) || die "PROBLEME d'arguments \n\n   USAGE: maptorhmap.pl fichierentre fichiersortie\n\n"; 
open(SAVEERR, ">&STDERR");
#open(STDERR, ">formate.err") || die "==> PB ouverture stderr : formate.err";
select(STDERR); $| =1;
#
open(FIN,"<$ficin") || die "=> PB ouverture : $ficin ";
open(FOUT,">$ficout") || die "=> PB ouverture : $ficout ";

@tableau = <FIN>;
@ligne= split( " ",$tableau[2]);
$nbm = $ligne[2];
$nbi = $ligne[1];
#
#  Ecriture 1ere ligne : un probleme, nbm loci, nbi individu, screen option
#
printf FOUT "%4.4s%4.4s%4.4s%4.4s\n",1,$nbm,$nbi,1;
#
#  Ecriture 2eme ligne : nom des marqueurs 20 par ligne
#
$combien=0;
for ($i=1 ; $i <= $nbm; $i++)
{
    printf FOUT "%-4.4s","M$i";
    $combien++;
    if ($combien == 20) { printf FOUT "\n";$combien=0;}
}
if ($combien != 0) {printf FOUT "\n";}
#
#  Ecriture 3eme ligne : format de lecture des lignes d'individus
#
printf FOUT "(A4,%s(1X,A1),T5,I1)\n",$nbm;
#
#  Ecriture 4eme ligne : codage present, absent, manquant
#
printf FOUT "+-?\n";
#
#  Ecriture nbi ligne : No individus, pour chaque marqueurs codage
#
for ($i=1 ; $i <= $nbi; $i++)
{
    printf FOUT "%4.4s","$i";
    for ($j=1 ; $j <= $nbm; $j++)
    {
       @ligne=split( " ",$tableau[$j+2]);
       @col=split("",$ligne[2]);

       $signe = (($col[$i] eq 'H') ? "+" : ( ($col[$i] eq '-') ? "?" : (($col[$i] eq 'A') ? "-" : $col[$i])));
      #$signe= ($col[$i] eq 'A') ? "-" : $col[$i];
       printf FOUT " %1.1s",$signe;
    }
    printf FOUT "  \n";
}
#
#  Ecriture nbm , equal retention, list of locus order, partially typed,
#          no upper bound  et autres pour le probleme
#
printf FOUT "%4.4s   1   1   1   0   0   0     0.0\n", $nbm;
#
#  Ecriture 2eme ligne : nom des marqueurs 20 par ligne
#
$combien=0;
for ($i=1 ; $i <= $nbm; $i++)
{
    printf FOUT "%-4.4s","M$i";
    $combien++;
    if ($combien == 20) { printf FOUT "\n";$combien=0;}
}
if ($combien != 0) {printf FOUT "\n";}
printf FOUT "%4.4s\n",1;
#
#  Ecriture 
#
printf FOUT "(%sA4)\n",$nbm;
#
for ($i=1 ; $i <= $nbm; $i++)
{
    printf FOUT "%-4.4s","M$i";
}
printf FOUT "\n";

#while ( eq '*')) 
#  {;}
}
#------------------------------------------------------------------------------
#
# GETLINE0
#
#------------------------------------------------------------------------------
sub Getline0 {
    local ($fichier) = @_;
    if ($getline_ok = (($_ = <$fichier>) ne '')) {
       chop;	# strip record separator
    } #end if
    $_;
} #end sub Getline0