--- /dev/null
+#!/usr/bin/perl
+my $path = '';
+if ($ENV{'SERVER_SOFTWARE'} =~ /HTTPi/i) {
+ print "HTTP/1.0 200 OK\n";
+ print "Content-type: text/html\r\n\r\n";
+}
+
+else {
+ use lib '..';
+ use if (!($ENV{'SERVER_SOFTWARE'} =~ /HTTPi/i)), apacheEnv;
+ print "Content-type: text/html\n\n";
+ $path = "/home/hadaq/trbsoft/daqtools/base/";
+}
+
+use CGI ':standard';
+use HADES::TrbNet;
+use POSIX;
+use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
+use lib qw|../commands htdocs/commands|;
+use xmlpage;
+use Data::Dumper;
+ trb_init_ports() or
+ die("can not connect to trbnet-daemon on the $ENV{'DAQOPSERVER'}");
+
+my @regs = (0,1,2,4,5,6,8,9,10,12,13,14,0x31,0x32,0x33,0x34);
+
+sub getdata {
+ my @boards = @_;
+ my $data;
+ foreach my $b (@boards) {
+ my $offset = 0xdf00;
+ $offset = 0xcf00 if $b == 0x8880;
+
+ foreach my $r (@regs) {
+ my $o = trb_register_read($b,$r+$offset);
+ if(defined $o->{$b}) {
+ $data->{$b}{$r} = $o->{$b};
+ }
+ else {
+ $data->{$b}{$r} = undef;
+ }
+ }
+ }
+ return $data;
+ }
+
+sub getposition {
+ my @boards = @_;
+ my $pos;
+ shift @boards;
+ foreach my $b (@boards) {
+ my @path = trb_nettrace($b);
+ if (scalar @path) {
+ $pos->{$path[-1][-1]->{port}} = $b;
+ }
+ }
+ return $pos;
+ }
+
+sub convbox {
+ my $tmp = $_[0];
+ my $multtmp = $_[1];
+
+ my @t = split('',$tmp);
+ my @m = split('',$multtmp);
+
+ my $out = "";
+
+ foreach my $i (0..(scalar @t)-1) {
+ $out .= "<font style=\"color:#0a0;\">◼</font>" if (($m[$i] ==1) && ($t[$i] eq '0'));
+ $out .= "<font style=\"color:#0a0;\">◼</font>" if (($m[$i] ==1) && ($t[$i] eq '1'));
+ $out .= "<font style=\"color:black\">◼</font>" if (($m[$i] ==0) && ($t[$i] eq '1'));
+ $out .= "<font style=\"color:black\">◻</font>" if (($m[$i] ==0) && ($t[$i] eq '0'));
+
+
+ if ($i%4 == 3) {$out .=' ';}
+ }
+
+ return $out;
+}
+
+sub makeinputbits {
+ my ($d,$s) = @_;
+ my $o = "";
+ my $multtmp = $d->{0x33};
+ $multtmp = 0 if (! ($d->{0x34} & (1 << (8+$s))));
+
+ $multtmp = sprintf("%032b", $multtmp);
+ my $tmp = sprintf("%032b",$d->{$s*4});
+ $tmp = convbox($tmp,$multtmp);
+ $o .= $tmp."<br>";
+
+ $multtmp = sprintf("%032b",0);
+ $tmp = sprintf("%032b",$d->{$s*4+1});
+ $tmp = convbox($tmp,$multtmp);
+ $o .= $tmp;
+
+ return $o;
+ }
+
+sub makemasterbits {
+ my ($d,$i,$s,$t) = @_; #data,slot,output,type
+ my $o = "";
+
+ if($t eq 'trb3sc') {
+ $o .= "<font style=\"color:red\" title=\"for output 1\">".(($d->{0} & (1<<($i*2+$s)))?'◼':'◻')."</font> ";
+ $o .= "<font style=\"color:blue\" title=\"for output 2\">".(($d->{4} & (1<<($i*2+$s)))?'◼':'◻')."</font><br>";
+ $o .= "<font style=\"color:#0a0\" title=\"for mult\">".(($d->{0x33} & (1<<($i*2+$s)))?'◼':'◻')."</font><br>";
+ }
+ if($t eq 'trb3') {
+ $o .= "<font style=\"color:red\" title=\"for output 1\">".(($d->{0} & (1<<($i*4+$s)))?'◼':'◻')."</font> ";
+ $o .= "<font style=\"color:blue\" title=\"for output 2\">".(($d->{4} & (1<<($i*4+$s)))?'◼':'◻')."</font><br>";
+ $o .= "<font style=\"color:#0a0\" title=\"for mult\">".(($d->{0x33} & (1<<($i*4+$s)))?'◼':'◻')."</font><br>";
+ }
+ return $o;
+ }
+
+sub gettable {
+ my ($type,$boards) = @_;
+ my $data = getdata(@{$boards});
+ my $pos = getposition(@{$boards});
+ my $out = "";
+
+ if($type eq 'trb3sc') {
+
+ $out .= "<table class=\"triggermap\">";
+ $out .= "<tr><th>Board<th colspan=\"2\">Output 1<th colspan=\"2\">Output 2";
+ foreach my $i (0..8) {
+ my $b = $boards->[0];
+
+ if($i==4) {
+ $out .= sprintf("<tr class=\"master\"><td>0x%4x<td colspan=\"2\"><td colspan=\"2\"><td>",$b);
+ if ($data->{$boards->[0]}{0x33} != 0) {
+ $out .= "mult >=".(($data->{$boards->[0]}{0x32} >> 16)&0xFF)." ";
+ $out .= "<font style=\"color:red\" title=\"for output 1\">".(($data->{$b}{0x34} & (1 << 8))?'◼':'◻')."</font> ";
+ $out .= "<font style=\"color:blue\" title=\"for output 21\">".(($data->{$b}{0x34} & (9 << 9))?'◼':'◻')."</font> ";
+# $out .= sprintf("on outputs %04b",($data->{$b}{0x34} >> 8));
+ }
+ }
+
+ $b = $pos->{$i};
+ if($b) {
+ $out .= sprintf("<tr><td>0x%04x",$b);
+ $out .= "<td>".makeinputbits($data->{$b},2);
+ $out .= "<td class=\"master\">".makemasterbits($data->{$boards->[0]},$i,0,$type);
+ $out .= "<td>".makeinputbits($data->{$b},3);
+ $out .= "<td class=\"master\">".makemasterbits($data->{$boards->[0]},$i,1,$type);
+ $out .= "<td>";
+ if ($data->{$b}{0x33} != 0) {
+ $out .= "mult >=".(($data->{$b}{0x32} >> 16)&0xFF)."<br>"
+ }
+
+ }
+ elsif(!$b) {
+ $out .= "<tr class=\"empty\"><td >empty<td>";
+ $out .= "<td class=\"master\">".makemasterbits($data->{$boards->[0]},$i,0,$type);
+ $out .= "<td>";
+ $out .= "<td class=\"master\">".makemasterbits($data->{$boards->[0]},$i,1,$type);
+ $out .= "<td>";
+ }
+ }
+ $out .= "</table>";
+ $out .= qq#<table><tr><th>Red<td>selected in 'or' for output 1 on master
+ <tr><th>Blue<td>selected in 'or' for output 2 on master
+ <tr><th>Green<td>selected for multiplicity logic
+ <tr><th>Black<td>enabled in 'or'
+ </table>#;
+ }
+
+ if($type eq 'trb3') {
+
+ $out .= "<table class=\"triggermap\">";
+ $out .= "<tr><th>Board<th colspan=\"2\">Output 1<th colspan=\"2\">Output 2<th colspan=\"2\">Output 3<th colspan=\"2\">Output 4";
+ foreach my $i (0..3) {
+ my $b = $boards->[0];
+
+
+ $b = $pos->{$i};
+ if($b) {
+ $out .= sprintf("<tr><td>0x%04x",$b);
+ $out .= "<td>".makeinputbits($data->{$b},0);
+ $out .= "<td class=\"master\">".makemasterbits($data->{$boards->[0]},$i,0,$type);
+ $out .= "<td>".makeinputbits($data->{$b},1);
+ $out .= "<td class=\"master\">".makemasterbits($data->{$boards->[0]},$i,1,$type);
+ $out .= "<td>".makeinputbits($data->{$b},2);
+ $out .= "<td class=\"master\">".makemasterbits($data->{$boards->[0]},$i,2,$type);
+ $out .= "<td>".makeinputbits($data->{$b},3);
+ $out .= "<td class=\"master\">".makemasterbits($data->{$boards->[0]},$i,3,$type);
+ $out .= "<td>";
+ if ($data->{$b}{0x33} != 0) {
+ $out .= "mult >=".(($data->{$b}{0x32} >> 16)&0xFF)."<br>"
+ }
+
+ }
+ elsif(!$b) {
+ $out .= "<tr class=\"empty\"><td >empty<td>";
+ $out .= "<td class=\"master\">".makemasterbits($data->{$boards->[0]},$i,0,$type);
+ $out .= "<td>";
+ $out .= "<td class=\"master\">".makemasterbits($data->{$boards->[0]},$i,1,$type);
+ $out .= "<td>";
+ $out .= "<td class=\"master\">".makemasterbits($data->{$boards->[0]},$i,2,$type);
+ $out .= "<td>";
+ $out .= "<td class=\"master\">".makemasterbits($data->{$boards->[0]},$i,3,$type);
+ $out .= "<td>";
+ }
+ }
+
+ $b = $boards->[0];
+ $out .= sprintf("<tr class=\"master\"><td>0x%4x<td colspan=\"2\"><td colspan=\"2\"><td colspan=\"2\"><td colspan=\"2\"><td>",$b);
+ if ($data->{$boards->[0]}{0x33} != 0) {
+ $out .= "mult >=".(($data->{$boards->[0]}{0x32} >> 16)&0xFF)." ";
+ $out .= "<font style=\"color:red\" title=\"for output 1\">".(($data->{$b}{0x34} & (1 << 8))?'◼':'◻')."</font> ";
+ $out .= "<font style=\"color:blue\" title=\"for output 21\">".(($data->{$b}{0x34} & (9 << 9))?'◼':'◻')."</font> ";
+# $out .= sprintf("on outputs %04b",($data->{$b}{0x34} >> 8));
+ }
+
+ $out .= "</table>";
+ $out .= qq#<table><tr><th>Red<td>selected in 'or' for output 1 on master board
+ <tr><th>Blue<td>selected in 'or' for output 2 on master board
+ <tr><th>Green<td>selected for multiplicity logic
+ <tr><th>Black<td>Enabled in 'or'
+ </table>#;
+ }
+
+ return $out;
+ }
+
+
+my $setups = {
+ '0x8a00' => [0x8a00,0x6010,0x6011,0x6012,0x6003,0x6004,0x6005,0x6006],
+ '0x8a01' => [0x8a01,0x6020,0x6021,0x6022,0x6013,0x6014,0x6015,0x6016],
+ '0x8a02' => [0x8a02,0x6030,0x6031,0x6032,0x6023,0x6024,0x6025,0x6026],
+ '0x8a03' => [0x8a03,0x6040,0x6041,0x6042,0x6033,0x6034,0x6035,0x6036],
+ '0x8a04' => [0x8a04,0x6050,0x6051,0x6052,0x6043,0x6044,0x6045,0x6046],
+ '0x8a05' => [0x8a05,0x6000,0x6001,0x6002,0x6053,0x6054,0x6055,0x6056],
+ '0x0100' => [0x0100],
+ '0x8880' => [0x8880,0x5000,0x5001,0x5002,0x5003],
+};
+
+my $types = {
+ '0x8a00' => 'trb3sc',
+ '0x8a01' => 'trb3sc',
+ '0x8a02' => 'trb3sc',
+ '0x8a03' => 'trb3sc',
+ '0x8a04' => 'trb3sc',
+ '0x8a05' => 'trb3sc',
+ '0x0100' => 'rjkel',
+ '0x8880' => 'trb3',
+};
+
+if($ENV{'QUERY_STRING'} =~ /getmap/) {
+ my ($cmd,$setup) = split('-',$ENV{'QUERY_STRING'});
+
+ print gettable($types->{$setup},$setups->{$setup});
+ }
+
+else {
+ my $page;
+ $page->{title} = "TrbNet Trigger Generation Setup";
+ $page->{link} = "../";
+ $page->{getscript} = "trigger.pl";
+
+ my @setup;
+
+push(@setup,({name => "EC0",
+ cmd => "getmap-0x8a00",
+ period => -1,
+ noaddress => 1,
+ norate => 1,
+ nocache => 1,}));
+push(@setup,({name => "EC1",
+ cmd => "getmap-0x8a01",
+ period => -1,
+ noaddress => 1,
+ norate => 1,
+ nocache => 1,}));
+push(@setup,({name => "EC2",
+ cmd => "getmap-0x8a02",
+ period => -1,
+ noaddress => 1,
+ norate => 1,
+ nocache => 1,}));
+push(@setup,({name => "EC3",
+ cmd => "getmap-0x8a03",
+ period => -1,
+ noaddress => 1,
+ norate => 1,
+ nocache => 1,}));
+push(@setup,({name => "EC4",
+ cmd => "getmap-0x8a04",
+ period => -1,
+ noaddress => 1,
+ norate => 1,
+ nocache => 1,}));
+push(@setup,({name => "EC5",
+ cmd => "getmap-0x8a05",
+ period => -1,
+ noaddress => 1,
+ norate => 1,
+ nocache => 1,}));
+push(@setup,({name => "Start",
+ cmd => "getmap-0x8880",
+ period => -1,
+ noaddress => 1,
+ norate => 1,
+ nocache => 1,}));
+
+ xmlpage::initPage(\@setup,$page);
+ }
+
+
+1;
jspc29 / daqtools.git / commitdiff