--- /dev/null
+package HPlot;
+use POSIX qw/floor ceil strftime/;
+use Data::Dumper;
+use warnings;
+use strict;
+use FileHandle;
+
+my $p;
+
+use constant {TYPE_HISTORY => 1};
+
+use constant {OUT_PNG => 1,
+ OUT_SVG => 2, #n/a
+ OUT_SCREEN => 3}; #n/a
+
+my @color= ('#2222dd','#dd2222','#22dd22','#dd8822','#dd22dd','#22dddd');
+
+sub plot_write {
+ my ($file,$str,$no) = @_;
+ return unless $str;
+ if($no || 0) {
+ print $file $str;
+ }
+ else {
+ print $file $str."\n";
+ }
+ }
+
+
+sub makeTimeString{
+ return strftime("set label 100 \"%H:%M:%S\" at screen 0.02,0.02 left tc rgb \"#000044\" font \"monospace,8\"\n", localtime())
+ }
+
+
+sub PlotInit {
+ my ($c) = @_;
+
+ my $name = $c->{name};
+
+ my $fn = "gnuplot";
+ my $fh = new FileHandle ("|$fn") or die "error: no gnuplot";
+ $fh->autoflush(1);
+
+
+
+ $p->{$name} = $c;
+ $p->{$name}->{fh} = $fh;
+ $p->{$name}->{run} = 0;
+ $p->{$name}->{sizex} = $p->{$name}->{sizex} || 600 ;
+ $p->{$name}->{sizey} = $p->{$name}->{sizey} || 400 ;
+ $p->{$name}->{file} = $p->{$name}->{file} || "dummy" ;
+ $p->{$name}->{curves} = $p->{$name}->{curves} || 1 ;
+ $p->{$name}->{xscale} = $p->{$name}->{xscale} || 1;
+ $p->{$name}->{type} or die "No plot type specified";
+ $p->{$name}->{output} or die "No destination specified";
+
+ @color = @{$p->{$name}->{colors}} if($p->{$name}->{colors});
+
+ foreach my $i (0..($c->{entries}-1)) {
+ for my $j (0..($c->{curves}-1)) {
+ push(@{$p->{$name}->{value}->[$j]},"NaN") ;
+ }
+ }
+
+ if($p->{$name}->{output} == OUT_PNG) {
+ $p->{$name}->{file} or die "No filename specified";
+ plot_write($fh,"set term png size ".$p->{$name}->{sizex}.",".$p->{$name}->{sizey}." font \"monospace,8\"");
+ plot_write($fh,"set out \"".$p->{$name}->{file}.".png\"");
+ }
+ elsif($p->{$name}->{output} == OUT_SCREEN) {
+ plot_write($fh,"set term x11 size ".$p->{$name}->{sizex}.",".$p->{$name}->{sizey});
+ }
+ else {
+ die "Output mode not supported yet";
+ }
+
+ if ($p->{$name}->{nokey}) {
+ plot_write($fh,"unset key");
+ }
+
+ plot_write($fh,"set datafile missing \"NaN\"");
+ plot_write($fh,"set xlabel \"".$p->{$name}->{xlabel}."\"") if $p->{$name}->{xlabel};
+ plot_write($fh,"set ylabel \"".$p->{$name}->{ylabel}."\"") if $p->{$name}->{ylabel};
+
+ if(defined $p->{$name}->{ymin} && defined $p->{$name}->{ymax}) {
+ plot_write($fh,"set yrange [".$p->{$name}->{ymin}.":".$p->{$name}->{ymax}."]");
+ }
+ elsif(defined $p->{$name}->{ymax}) {
+ plot_write($fh,"set yrange [:".$p->{$name}->{ymax}."]");
+ }
+ elsif(defined $p->{$name}->{ymin}) {
+ plot_write($fh,"set yrange [".$p->{$name}->{ymin}.":]");
+ }
+
+ if($p->{$name}->{type} == TYPE_HISTORY) {
+ if($p->{$name}->{fill}) {
+ plot_write($fh,"set style fill solid 1.00");
+ }
+ else {
+ plot_write($fh,"set style fill solid 0");
+ }
+ plot_write($fh,"set boxwidth 2 absolute");
+ plot_write($fh,"set autoscale fix");
+ plot_write($fh,"set xtics autofreq"); #$p->{$name}->{entries}
+ plot_write($fh,"set grid");
+# plot_write($fh,"set style fill solid 1.0");
+ plot_write($fh,"plot ",1);
+ for(my $j=0; $j<$p->{$name}->{curves};$j++) {
+ if($p->{$name}->{fill}) {
+ plot_write($fh,"'-' using 1:2 with filledcurves x1 lt rgb \"$color[$j]\" title \"".($p->{$name}->{titles}->[$j] || "$j")."\" ",1);
+ }
+ elsif($p->{$name}->{dots}) {
+ plot_write($fh,"'-' using 1:2 with points pointsize 0.6 pointtype 2 lt rgb \"$color[$j]\" title \"".($p->{$name}->{titles}->[$j] || "$j")."\" ",1);
+ }
+ else {
+ plot_write($fh,"'-' using 1:2 with lines lt rgb \"$color[$j]\" title \"".($p->{$name}->{titles}->[$j] || "$j")."\" ",1);
+ }
+ plot_write($fh,', ',1) unless ($j+1==$p->{$name}->{curves});
+ }
+ plot_write($fh," ");
+ }
+ else {
+ die "Plot type not supported";
+ }
+
+ }
+
+
+sub PlotDraw {
+ my($name) = @_;
+ if($p->{$name}->{run}>=1) {
+ plot_write($p->{$name}->{fh},"set out \"".$p->{$name}->{file}.".png\"");
+ plot_write($p->{$name}->{fh},makeTimeString());
+ plot_write($p->{$name}->{fh},"replot");
+ }
+ for(my $j=0; $j<$p->{$name}->{curves}; $j++) {
+ for(my $i=0; $i< scalar @{$p->{$name}->{value}->[$j]}; $i++) {
+ plot_write($p->{$name}->{fh},(($i-$p->{$name}->{entries})/$p->{$name}->{xscale})." ".$p->{$name}->{value}->[$j]->[$i]) unless $p->{$name}->{countup};
+ plot_write($p->{$name}->{fh},($i/$p->{$name}->{xscale})." ".$p->{$name}->{value}->[$j]->[$i]) if $p->{$name}->{countup};
+# print $j." ".$i." ".$p->{$name}->{entries}." ".$p->{$name}->{xscale}." ".$p->{$name}->{value}->[$j]->[$i]."\n";
+ }
+ plot_write($p->{$name}->{fh},"e");
+ }
+ $p->{$name}->{run}++;
+ }
+
+
+sub PlotAdd {
+ my($name,$value,$curve) = @_;
+ $curve = 0 unless $curve;
+
+ if($p->{$name}->{type} == TYPE_HISTORY) {
+ push(@{$p->{$name}->{value}->[$curve]},$value||0);
+ shift(@{$p->{$name}->{value}->[$curve]});
+ }
+
+ }
+
+
+1;
\ No newline at end of file
use POSIX;
use CGI ':standard';
use CGI::Carp qw(fatalsToBrowser);
-# use HTML::Entities;
use PlotScheduler;
use MIME::Base64;
use Widgets;
use HADES::TrbNet;
use AccessXmlDb;
require Common;
-
-
use FindBin;
use lib "$FindBin::Bin/..";
use Environment;
##############
my $CBsPerFpga=2;
my $ChipsPerCB=2;
+my $plotWidth=600;
+my $plotHeight=400;
+my $xmldbEntityFile = "../../daqtools/xml-db/cache/CbController.entity";
+##############
+## global variables
+##############
+# - none -
-
-
-
-
-
-
-# subs that are callable via http request
+##############
+## dispatch table (subs that are callable via CGI)
+##############
my $dispatch = {
table_hash => \&table_hash,
plot_request => \&plot_request,
print_selectors => \&print_selectors
};
-my $q = CGI->new;
-
-# for accessing the xml-db stuff
-my $entityFile = "../../daqtools/xml-db/cache/CbController.entity";
-my $xmldb;
-
-my $plotWidth=600;
-my $plotHeight=400;
+#recieve new CGI request
+my $q = CGI->new;
$ENV{'DAQOPSERVER'} = $q->param('DAQOPSERVER') if defined $q->param('DAQOPSERVER');
-
my $daqopserver = $ENV{'DAQOPSERVER'};
print header;
-
-# unless (defined( $FPGA ) && defined( $CB ) && defined( $chip ) && defined( $channel ) && defined( $daqopserver )) {
-# print "<p>usage:</p>";
-# print "<p>adcmon?DAQOPSERVER=...&FPGA=...&CB=...&chip=...&channel=...</p>";
-# exit;
-
if ($q->param('sub')){
my $subname = $q->param('sub');
$dispatch->{$subname}->($q); # give the sub the query
page_body($q);
}
exit;
-# }
-
-
-
-
-
-sub plot_request {
-
- my $q= shift;
-
-
- my @requestStrings = split(",",$q->param('requestStrings'));
-
-# print join("<br>",@requestStrings);
-
- return if (@requestStrings == 0);
-
-
- $ENV{'DAQOPSERVER'} = $q->param('DAQOPSERVER') if defined $q->param('DAQOPSERVER');
- my $daqopserver = $ENV{'DAQOPSERVER'};
-
-# unless (defined( $FPGA ) && defined( $CB ) && defined( $chip ) && defined( $channel ) && defined( $daqopserver )) {
- unless (defined($daqopserver)){
- die "DAQOPSERVER undefined!";
- }
- my $ps = PlotScheduler->new( shm => SHMSYMLINK."adcmon-$daqopserver" );
- # $ps->addRequest( FPGA => "0xd882", CB => "0", chip => "1", channel => "TEMP");
- # $ps->storeRequests();
- $ps->startPlotService() unless $ps->plotServiceRunning();
- $ps->retrieveRequests();
-# $ps->addRequest( FPGA => $FPGA, CB => $CB, chip => $chip, channel => $channel);
- for my $reqStr (@requestStrings){
- $ps->addRequest( requestString => $reqStr );
- }
- # $ps->listRequests();
- $ps->storeRequests();
-# my $plotfile = $ps->{plotDir}."/$FPGA-$CB-$chip-$channel.png";
-# }
-# system("echo 'blah'>".$ps->{plotDir}."/test.txt");
- for my $reqStr (@requestStrings){
- print "<img alt='$reqStr' width='$plotWidth' height='$plotHeight' src='".addpng($ps->{plotDir}."/".$reqStr.".png")."'>";
- print br;
- }
-}
-# sub plot_request {
-#
-# my $q= shift;
-#
-# $ENV{'DAQOPSERVER'} = $q->param('DAQOPSERVER') if defined $q->param('DAQOPSERVER');
-# my $FPGA = $q->param('FPGA');
-# my $CB = $q->param('CB');
-# my $chip = $q->param('chip');
-# my $channel = $q->param('channel');
-# my $daqopserver = $ENV{'DAQOPSERVER'};
-#
-# unless (defined( $FPGA ) && defined( $CB ) && defined( $chip ) && defined( $channel ) && defined( $daqopserver )) {
-#
-# my $ps = PlotScheduler->new( shm => SHMSYMLINK."adcmon-$daqopserver" );
-# # $ps->addRequest( FPGA => "0xd882", CB => "0", chip => "1", channel => "TEMP");
-# # $ps->storeRequests();
-# $ps->startPlotService() unless $ps->plotServiceRunning();
-#
-# $ps->retrieveRequests();
-# $ps->addRequest( FPGA => $FPGA, CB => $CB, chip => $chip, channel => $channel);
-# # $ps->listRequests();
-# $ps->storeRequests();
-# my $plotfile = $ps->{plotDir}."/$FPGA-$CB-$chip-$channel.png";
-# }
-# }
+#################### SUBLAND ######################
-sub print_selectors {
+###############################
+## subs generating html output
+###############################
-my $FPGA = $q->param('FPGA');
-my $CB = $q->param('CB');
-my $chip = $q->param('chip');
-my $channel = $q->param('channel');
-
-
-my $q=shift;
-
-print "<table>";
-print "<tr>";
-print "<td>DAQOPSERVER</td>";
-print "<td colspan=2><input type='text' class='selectorsReloadTrigger' id='input_DAQOPSERVER' value='".$daqopserver."'></td>";
-print "</tr>";
-print "<tr>";
-print "<td>FPGA</td>";
-print "<td>CB</td>";
-print "<td>chip</td>";
-print "</tr>";
-
-print "<tr>";
-print "<td>";
-my $FPGA_selector = fileSelector->new(
- id=>"FPGA_selector",
- name=>"FPGA_selectionDropdown",
- selected=>lc($q->param("FPGA")),
- class=>"selectorsReloadTrigger"
-);
-$FPGA_selector->add_item(value=>'...');
-for my $element (activeTRBs()) {
- $FPGA_selector->add_item(value=>lc(any2hex($element)));
-}
-$FPGA_selector->print_html();
-print "</td>";
-print "<td>";
-my $CB_selector = fileSelector->new(
- id=>"CB_selector",
- name=>"CB_selectionDropdown",
- selected=>$q->param("CB"),
- class=>"selectorsReloadTrigger"
-);
-$CB_selector->add_item(value=>'...');
-for( my $i = 0; $i < $CBsPerFpga; $i++){
- $CB_selector->add_item(value=>$i);
-}
-# $CB_selector->add_item(value=>$q->param("CB")) if defined $q->param("CB");
-$CB_selector->print_html();
-print "</td>";
-print "<td>";
-my $chip_selector = fileSelector->new(
- id=>"chip_selector",
- name=>"chip_selectionDropdown",
- selected=>$q->param("chip"),
- class=>"selectorsReloadTrigger"
-);
-$chip_selector->add_item(value=>'...');
-for( my $i = 0; $i < $ChipsPerCB; $i++){
- $chip_selector->add_item(value=>$i);
-}
-# $chip_selector->add_item(value=>$q->param("chip")) if defined $q->param("chip");
-$chip_selector->print_html();
-print "</td>";
-print "</tr>";
-
-print "</table>";
-
-print "<table>";
-print "<tr>";
-
-print "<td>";
-print "<button id='startStopButton'>start</button>";
-print "</td>";
-print "</tr>";
-
-
-print "<tr class='debugFeature'>";
-print "<td class='debugFeature'>";
-print "<button id='comm_ajax'>ajax!</button>";
-print "</td>";
-print "<td class='debugFeature'>";
-print "<button id='test_but'>test</button>";
-print "</td>";
-print "<td class='debugFeature'>";
-print "<input type='text' name='refresh(ms)' id='refreshInterval' value='1000'>";
-print "</td>";
-print "<tr>";
-
-
-print "</table>";
-
-
-
-
-print "<table id='checkboxTable'>";
-$xmldb = AccessXmlDb->new( entityFile => $entityFile );
-for my $element ( @{$xmldb->channelList()}) {
- print "<tr>";
- print "<td>";
- print "$element";
- print "</td>";
- print "<td>";
- print "<input type='checkbox' class='channelCheckbox' id='checkbox_"
- .$FPGA."-".$CB."-".$chip."-".$element."'>";
- print "</td>";
- print "</tr>";
-}
-print "</table>";
-
-
-}
sub page_body{
init_html();
my $q = shift;
-
-
-
-
-
print '<div id="selectors" class="plasticBox">';
print_selectors($q);
print '</div>';
print '<div id="plotAreaBg" class="plasticBox plotArea">';
+print "<div class='header'>Plots</div>";
# print "plotAreaBg";
print '</div>';
-print '<div id="plotAreaFg" class="plotArea">';
+print '<div id="plotAreaFg" class="plasticBox plotArea">';
# print "plotAreaFg";
print '</div>';
print_debugStuff($q);
print '</div>';
-
}
+sub print_selectors {
+
+ my $q=shift;
+ my $FPGA = $q->param('FPGA');
+ my $CB = $q->param('CB');
+ my $chip = $q->param('chip');
+ my $channel = $q->param('channel');
+
+ print "<div class='header'>Settings</div>";
+
+ print h3 "select chip";
+
+ print "<table>";
+
+ print "<tr>";
+ print "<td>DAQOPSERVER</td>";
+ print "<td colspan=2>
+ <input type='text' class='selectorsReloadTrigger'
+ id='input_DAQOPSERVER' value='".$daqopserver."'></td>";
+ print "</tr>";
+ print "<tr>";
+ print "<td>FPGA</td>";
+ print "<td>CB</td>";
+ print "<td>chip</td>";
+ print "</tr>";
+ print "<tr>";
+ print "<td>";
+ my $FPGA_selector = fileSelector->new(
+ id=>"FPGA_selector",
+ name=>"FPGA_selectionDropdown",
+ selected=>lc($q->param("FPGA")),
+ class=>"selectorsReloadTrigger"
+ );
+ $FPGA_selector->add_item(value=>'...');
+ for my $element (activeTRBs()) {
+ $FPGA_selector->add_item(value=>lc(any2hex($element)));
+ }
+ $FPGA_selector->print_html();
+ print "</td>";
+ print "<td>";
+ my $CB_selector = fileSelector->new(
+ id=>"CB_selector",
+ name=>"CB_selectionDropdown",
+ selected=>$q->param("CB"),
+ class=>"selectorsReloadTrigger"
+ );
+ $CB_selector->add_item(value=>'...');
+ for( my $i = 0; $i < $CBsPerFpga; $i++){
+ $CB_selector->add_item(value=>$i);
+ }
+ $CB_selector->print_html();
+ print "</td>";
+ print "<td>";
+ my $chip_selector = fileSelector->new(
+ id=>"chip_selector",
+ name=>"chip_selectionDropdown",
+ selected=>$q->param("chip"),
+ class=>"selectorsReloadTrigger"
+ );
+ $chip_selector->add_item(value=>'...');
+ for( my $i = 0; $i < $ChipsPerCB; $i++){
+ $chip_selector->add_item(value=>$i);
+ }
+ $chip_selector->print_html();
+ print "</td>";
+ print "</tr>";
+
+ print "</table>";
+
+ print "<table>";
+
+ print "<tr>";
+ print "<td>";
+ print "<button id='startStopButton'>start</button>";
+ print "</td>";
+ print "</tr>";
+ print "<tr class='debugFeature'>";
+ print "<td class='debugFeature'>";
+ print "<button id='comm_ajax'>ajax!</button>";
+ print "</td>";
+ print "<td class='debugFeature'>";
+ print "<button id='test_but'>test</button>";
+ print "</td>";
+ print "<td class='debugFeature'>";
+ print "<input type='text' name='refresh(ms)' id='refreshInterval' value='1000'>";
+ print "</td>";
+ print "<tr>";
+
+ print "</table>";
+
+ print h3 "adc channel";
+
+ print "<table id='checkboxTable'>";
+
+ my $xmldb = AccessXmlDb->new( entityFile => $xmldbEntityFile );
+ for my $element ( @{$xmldb->channelList()}) {
+ print "<tr>";
+ print "<td>";
+ print "$element";
+ print "</td>";
+ print "<td>";
+ print "<input type='checkbox' class='channelCheckbox' id='checkbox_"
+ .$FPGA."-".$CB."-".$chip."-".$element."'>";
+ print "</td>";
+ print "</tr>";
+ }
+
+ print "</table>";
+}
sub print_debugStuff{
my $q=shift();
print "<p> debug stuff: </p>";
table_hash($q);
-# print qq%<p id='placeholder'>placeholder</p>%;
-#
-# print <<EOF
-# <p id="test1">This is a <b>bold</b> paragraph.</p>
-# <p id="test2">This is another <b>bold</b> paragraph.</p>
-# <button id="btn1">Show Old/New Text</button>
-# <button id="btn2">Show Old/New HTML</button>
-# EOF
}
sub table_hash{
print '</table>';
}
+sub plot_request {
+ print "<div class='header'>Plots</div>";
+ my $q= shift;
+ my @requestStrings = split(",",$q->param('requestStrings'));
+ return if (@requestStrings == 0);
+ $ENV{'DAQOPSERVER'} = $q->param('DAQOPSERVER') if defined $q->param('DAQOPSERVER');
+ my $daqopserver = $ENV{'DAQOPSERVER'};
-sub init_html{
+ unless (defined($daqopserver)){
+ die "DAQOPSERVER undefined!";
+ }
+ my $ps = PlotScheduler->new( shm => SHMSYMLINK."adcmon-$daqopserver" );
+ $ps->startPlotService() unless $ps->plotServiceRunning();
+ $ps->retrieveRequests();
+ for my $reqStr (@requestStrings){
+ $ps->addRequest( requestString => $reqStr );
+ }
+ # $ps->listRequests(); #debug output
+ $ps->storeRequests();
+ for my $reqStr (@requestStrings){
+ $reqStr =~ /-([^-]+)$/;
+ print h3 $1;
+# print br;
+ print "<img alt='$reqStr' width='$plotWidth' height='$plotHeight' src='".addpng($ps->{plotDir}."/".$reqStr.".png")."'>";
+# print br;
+ }
+}
+sub init_html{
print start_html(
-title=>'ADC Monitor',
-style=>[{'src'=>'../layout/styles.css'},
{ -type => 'text/javascript', -src => './adcmon.js'},
{ -type => 'text/javascript', -src => '../scripts/jquery.timer.js'}
]
-# # -script=>[
-# # { -type => 'text/javascript', -src => './testgui.js'},
-# # { -type => 'text/javascript', -src => './hideAndShow.js'},
-# # { -type => 'text/javascript', -src => './getdata.js'},
-# # { -type => 'text/javascript', -src => './xmlOperations.js'}
-# # ]
);
-# print start_html(-
-
}
-sub activeTRBs {
+###############################
+## misc utilities
+###############################
+sub activeTRBs {
# trb_init_ports() or die trb_strerror();
trb_init_ports() or return ();
-
# read microsecond counters, return list of active addresses
my $read = trb_register_read(0xFFFF,0x50);
return (keys %$read);
my ($file) = @_;
my $out = "data:image/png;base64,";
open (my $fh, "<$file");
-
local $/;
my $bin = <$fh>;
$fh->close();