#!/usr/bin/perl
use Tk;
my $mainwindow = MainWindow->new;
$mainwindow->title("MVD pcf file manipulator");
$mainwindow->Button(-text=>"exit",
                    -command=>sub{exit}
                   )->pack(-side=>'bottom',  -anchor=>'sw');

$frame1 = $mainwindow->Frame(-background=>'yellow')
          ->pack(-side=>'top', -expand=>'1', -fill=>'x');

$frame1->Button(-text=>"show packets ON",
                    -command=> [ \&get_packets, "NO"]
                   )->pack(-side=>'left', -expand=>'1', fill=>'x');

$frame1->Button(-text=>"show packets OFF",
                    -command=> [ \&get_packets, "YES"]
                   )->pack(-side=>'left', expand=>'1', -fill=>'x');

#$text_1 = $mainwindow->Text(-background=>white);   # define but don't pack
$frame2 = $mainwindow->Frame(-background=>'red')
          ->pack(-side   =>'bottom',
                 -expand =>'1',
                 -fill   =>'x',
#                 -after  => $text_1
                );

$frame2->Button(-text=>"turn packets ON",
                    -command=> [ \&switch_packets, "YES"]
                   )->pack(-side=>'left', expand=>'1', -fill=>'x');

$frame2->Button(-text=>"turn packets OFF",
                    -command=> [ \&switch_packets, "NO"]
                   )->pack(-side=>'left', expand=>'1', -fill=>'x');

MainLoop;
 
#==============================================================#

sub switch_packets{
  print("\n   *** Sorry, not yet implemented ***\n\n");
}
#==============================================================#

sub get_packets{
#  (from file pcf_on.pl)
# jan 2002 - Hubert van Hecke
# This script operates on the MVD pcf file. It displays the packets
# that are in the readout.
#
#   $ONLINE_CONFIGURATION/rc/hw/mvd.pcf   is the source of the info.
# 
#------------------ initialize: --------------------------------
$yesno = $_[0];        # first subroutine argument
if ($yesno eq "YES") {print ("Show packets off\n");}
if ($yesno eq "NO")  {print ("Show packets on \n");}

@strips = (" 85 86 87 88 89 90   91 92 93 94 95 96",
           " 61 62 63 64 65 66   67 68 69 70 71 72",
           " 01 02 03 04 05 06   07 08 09 10 11 12",
           " 13 14 15 16 17 18   19 20 21 22 23 24",
           " 25 26 27 28 29 30   31 32 33 34 35 36",
           " 37 38 39 40 41 42   43 44 45 46 47 48",
           " 49 50 51 52 53 54   55 56 57 58 59 60",
           " 73 74 75 76 77 78   79 80 81 82 83 84");

@pads = qw/ 105 117 
            104 116
            103 115
            102 114
            101 113
            100 112
            099 111
            098 110
            097 109
            108 120
            107 119
            106 118 /;
# The arrays above show the physical locations of the data packets
# for the strips and pads. The program assumes that the packets are
# read out, unless they are disabled in pairs in the pcf file by readback=NO,
# or by being replaced by 9999 and readback=YES.

$pcffile = '</export/software/oncs/online_configuration/rc/hw/mvd.pcf';
unless(open INPUT , $pcffile)
 { die "\n Can't open the pcf file - abort\n";}

#-------------- all OK, here we go: ------------------------------
@lines = <INPUT>;              # read the whole file into array @lines
$linecount=1;
foreach (@lines){              # loop over lines
  $linecount += 1;             # increment.    Search for packet ID's:
  if (@lines[$linecount] =~ /packetid1:/){
    $line_id123 = $linecount;
    $id1 = substr($',0,4) -2000;         # next 4 chars after search string
    if ($id1<10) {$id1 = "0".$id1}       # add leading 0 to single digits
    if ($id1>96 && $id1<100) {$id1 = "0".$id1}  # for pads 97 -> 097
    $id2 = $' =~ /packetid2:/;           # ID 2 is in the remainder
    $id2 = substr($',0,4) -2000;
    if ($id2<10) {$id2 = "0".$id2}
    if ($id2>96 && $id2<100) {$id2 = "0".$id2}  # for pads 98 -> 098
    $lineid = $linecount;

    $id3 = 0;                            # special case for singles
    $w9999 = index($lines[$linecount],"9999");
    if ($w9999>1){
      $id3 = substr($lines[$linecount-2],$w9999+14, 4);
      $id3 = $id3-2000;
      if ($id3<10) {$id3 = "0".$id3}     # add leading 0 to single digits
      if ($id3>96 && $id3<100) {$id3 = "0".$id3}  # for pads 97 -> 097
      #print(" ($id1, $id2) id3 = $id3 should also be off (yesno=$yesno)\n");
    }
  }

  if ( ($linecount < $line_id123+12) && (@lines[$linecount] =~ /readout:$yesno/) ) {
    #print("$linecount At readout:~$yesno id1,2,3= $id1 $id2 $id3 \n");
    foreach (0..7) {                     # find the match in the @strips
      if ($strips[$_] =~ $id1) {         # array and replace it with --.
        $strips[$_] = $`."--".$';
      }
      if ($strips[$_] =~ $id2) {
        $strips[$_] = $`."--".$';
      }                              
    }                                    # foreach loop over strips
    foreach (0..23) {
      if ($pads[$_] eq $id1) {           # array and replace it with ---.
        $pads[$_] = "---";
      }
      if ($pads[$_] eq $id2) {
        $pads[$_] = "---";
      }
    }  
  }        # found a readout:YES or NO

  if ( $id3 != 0  &&                     # special 9999 cases
       (@lines[$linecount] =~ /readout:YES/) && 
       ($yesno eq "NO") ) {
    foreach (0..7) {                     # find the match in the @strips
      if ($strips[$_] =~ $id3) {
        $strips[$_] = $`."--".$';
      }                                   
    }                                    # foreach loop over strips
    foreach (0..23) {
      if ($pads[$_] eq $id3) {
        $pads[$_] = "---";
      }
    }     # end loop over pads   
  }       # end id3 special cases
}         # end loop over all lines
close INPUT;

#---------------------------- output: ----------------------------------#
open TMPFILE,">pcf_manipulator.tmp";
$not = "";
if ($yesno eq "YES") {$not = " NOT"}
print TMPFILE ("
  These are the packets that are$not being read out, as defined
  in the MVD pcf file \$ONLINE_CONFIGURATION/rc/hw/mvd.pcf.
  The view is from the top with the bottom folded out. 
  Numbered positions show the packet number (modulo 2000) \n\n");

@title = ("","OB","IB","IM","IT","IT","IM","IB","OB");
print TMPFILE ("
  $pads[0] <-pads                      WEST                      pads-> $pads[1]
  $pads[2]    ------+--------------------+-------------------+------    $pads[3]\n");

foreach (1..8) {
  $title = $_;
  if ($title<=4) {$eastw = "W"}
  if ($title==5) {print TMPFILE (" SOUTH   ------+--------------------+-------------------+------   NORTH\n");}
  if ($title>4) {$eastw = "E"}
  print TMPFILE ("  $pads[$title*2+2]    S$eastw $title[$title] | $strips[$_-1] | N$eastw $title[$title]    $pads[$title*2+3]\n");
}  

print TMPFILE ("  $pads[20]    ------+--------------------+-------------------+------    $pads[21]
  $pads[22]                             EAST                             $pads[23]\n\n");
close TMPFILE;

$text_1->destroy() if Tk::Exists($text_1);
# This section puts up the map, read from the tmp file:
# I should write dirctly to the widget of course.....
# 
$text_1 = $mainwindow->Text(-background=>white, -width=>72, -height=>21);
$text_1->pack(-side=>'bottom');
open (FH,"<pcf_manipulator.tmp") || die "could not open file";
while (<FH>) {
  $text_1->insert('end',$_);
}
close (FH);
#=======================================================================#
}