From: hadaq Date: Thu, 4 Apr 2019 14:59:48 +0000 (+0200) Subject: add trigger.pl GUI X-Git-Url: https://jspc29.x-matter.uni-frankfurt.de/git/?a=commitdiff_plain;h=fea8547631ff4954ff0abfad055519b63f0ed19b;p=daqtools.git add trigger.pl GUI --- diff --git a/web/htdocs/network/trigger.pl b/web/htdocs/network/trigger.pl new file mode 100755 index 0000000..10ab828 --- /dev/null +++ b/web/htdocs/network/trigger.pl @@ -0,0 +1,312 @@ +#!/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 .= "◼" if (($m[$i] ==1) && ($t[$i] eq '0')); + $out .= "◼" if (($m[$i] ==1) && ($t[$i] eq '1')); + $out .= "◼" if (($m[$i] ==0) && ($t[$i] eq '1')); + $out .= "◻" 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."
"; + + $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 .= "".(($d->{0} & (1<<($i*2+$s)))?'◼':'◻')." "; + $o .= "".(($d->{4} & (1<<($i*2+$s)))?'◼':'◻')."
"; + $o .= "".(($d->{0x33} & (1<<($i*2+$s)))?'◼':'◻')."
"; + } + if($t eq 'trb3') { + $o .= "".(($d->{0} & (1<<($i*4+$s)))?'◼':'◻')." "; + $o .= "".(($d->{4} & (1<<($i*4+$s)))?'◼':'◻')."
"; + $o .= "".(($d->{0x33} & (1<<($i*4+$s)))?'◼':'◻')."
"; + } + return $o; + } + +sub gettable { + my ($type,$boards) = @_; + my $data = getdata(@{$boards}); + my $pos = getposition(@{$boards}); + my $out = ""; + + if($type eq 'trb3sc') { + + $out .= ""; + $out .= "
BoardOutput 1Output 2"; + foreach my $i (0..8) { + my $b = $boards->[0]; + + if($i==4) { + $out .= sprintf("
0x%4x",$b); + if ($data->{$boards->[0]}{0x33} != 0) { + $out .= "mult >=".(($data->{$boards->[0]}{0x32} >> 16)&0xFF)." "; + $out .= "".(($data->{$b}{0x34} & (1 << 8))?'◼':'◻')." "; + $out .= "".(($data->{$b}{0x34} & (9 << 9))?'◼':'◻')." "; +# $out .= sprintf("on outputs %04b",($data->{$b}{0x34} >> 8)); + } + } + + $b = $pos->{$i}; + if($b) { + $out .= sprintf("
0x%04x",$b); + $out .= "".makeinputbits($data->{$b},2); + $out .= "".makemasterbits($data->{$boards->[0]},$i,0,$type); + $out .= "".makeinputbits($data->{$b},3); + $out .= "".makemasterbits($data->{$boards->[0]},$i,1,$type); + $out .= ""; + if ($data->{$b}{0x33} != 0) { + $out .= "mult >=".(($data->{$b}{0x32} >> 16)&0xFF)."
" + } + + } + elsif(!$b) { + $out .= "
empty"; + $out .= "".makemasterbits($data->{$boards->[0]},$i,0,$type); + $out .= ""; + $out .= "".makemasterbits($data->{$boards->[0]},$i,1,$type); + $out .= ""; + } + } + $out .= "
"; + $out .= qq#
Redselected in 'or' for output 1 on master +
Blueselected in 'or' for output 2 on master +
Greenselected for multiplicity logic +
Blackenabled in 'or' +
#; + } + + if($type eq 'trb3') { + + $out .= ""; + $out .= "
BoardOutput 1Output 2Output 3Output 4"; + foreach my $i (0..3) { + my $b = $boards->[0]; + + + $b = $pos->{$i}; + if($b) { + $out .= sprintf("
0x%04x",$b); + $out .= "".makeinputbits($data->{$b},0); + $out .= "".makemasterbits($data->{$boards->[0]},$i,0,$type); + $out .= "".makeinputbits($data->{$b},1); + $out .= "".makemasterbits($data->{$boards->[0]},$i,1,$type); + $out .= "".makeinputbits($data->{$b},2); + $out .= "".makemasterbits($data->{$boards->[0]},$i,2,$type); + $out .= "".makeinputbits($data->{$b},3); + $out .= "".makemasterbits($data->{$boards->[0]},$i,3,$type); + $out .= ""; + if ($data->{$b}{0x33} != 0) { + $out .= "mult >=".(($data->{$b}{0x32} >> 16)&0xFF)."
" + } + + } + elsif(!$b) { + $out .= "
empty"; + $out .= "".makemasterbits($data->{$boards->[0]},$i,0,$type); + $out .= ""; + $out .= "".makemasterbits($data->{$boards->[0]},$i,1,$type); + $out .= ""; + $out .= "".makemasterbits($data->{$boards->[0]},$i,2,$type); + $out .= ""; + $out .= "".makemasterbits($data->{$boards->[0]},$i,3,$type); + $out .= ""; + } + } + + $b = $boards->[0]; + $out .= sprintf("
0x%4x",$b); + if ($data->{$boards->[0]}{0x33} != 0) { + $out .= "mult >=".(($data->{$boards->[0]}{0x32} >> 16)&0xFF)." "; + $out .= "".(($data->{$b}{0x34} & (1 << 8))?'◼':'◻')." "; + $out .= "".(($data->{$b}{0x34} & (9 << 9))?'◼':'◻')." "; +# $out .= sprintf("on outputs %04b",($data->{$b}{0x34} >> 8)); + } + + $out .= "
"; + $out .= qq#
Redselected in 'or' for output 1 on master board +
Blueselected in 'or' for output 2 on master board +
Greenselected for multiplicity logic +
BlackEnabled in 'or' +
#; + } + + 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;