FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-04-08 07:24:21 +00:00
Code Issues Releases Wiki Activity

55_InfoPanel.pm: updated

Browse Source 
- adjust turtle for new elements
- code cleanup

git-svn-id: https://svn.fhem.de/fhem/trunk@7947 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
betateilchen 2015-02-12 10:03:17 +00:00
parent 9552a289eb
commit 654e5abd66
1 changed files with 87 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
fhem/FHEM/55_InfoPanel.pm
View File

@ -17,8 +17,6 @@ use feature qw/switch/;
use vars qw(%data); use vars qw(%data);
use HttpUtils; use HttpUtils;
my @cmd_halign= qw(thalign ihalign);
my @cmd_valign= qw(tvalign ivalign);
my @valid_valign = qw(auto baseline middle center hanging); my @valid_valign = qw(auto baseline middle center hanging);
my @valid_halign = qw(start middle end); my @valid_halign = qw(start middle end);
@ -208,13 +206,10 @@ sub btIP_itemButton {
my $output = btIP_itemRect($id,$x1,$y1,$x2,$y2,$rx,$ry,1,0,$link,%params); my $output = btIP_itemRect($id,$x1,$y1,$x2,$y2,$rx,$ry,1,0,$link,%params);
$params{rgb} = $oldrgb; $params{rgb} = $oldrgb;
my $oldhalign = $params{thalign}; my ($oldhalign,$oldvalign) = ($params{thalign},$params{tvalign});
my $oldvalign = $params{tvalign}; ($params{thalign},$params{tvalign}) = ("middle","middle");
$params{thalign} = "middle";
$params{tvalign} = "middle";
my $textoutput .= btIP_itemText("${id}_text",($x1+$x2)/2,($y1+$y2)/2,$text,%params); my $textoutput .= btIP_itemText("${id}_text",($x1+$x2)/2,($y1+$y2)/2,$text,%params);
$params{thalign} = $oldhalign; ($params{thalign},$params{tvalign}) = ($oldhalign,$oldvalign);
$params{tvalign} = $oldvalign;
$output =~ s/<\/a>/$textoutput<\/a>/; $output =~ s/<\/a>/$textoutput<\/a>/;
return $output; return $output;
@ -251,7 +246,7 @@ sub btIP_itemCircle {
sub btIP_itemCounter { sub btIP_itemCounter {
my ($id,$x,$y,%params)= @_; my ($id,$x,$y,%params)= @_;
$id = ($id eq '-') ? createUniqueId() : $id; $id = ($id eq '-') ? createUniqueId() : $id;
return btIP_itemText($id,$x,$y,$defs{$params{name}}{fhem}{counter},%params); return btIP_itemText($id,$x,$y,$params{counter},%params);
} }
sub btIP_itemDate { sub btIP_itemDate {
@ -342,7 +337,7 @@ sub btIP_itemImg {
$output .= "<image id=\"$id\" x=\"$x\" y=\"$y\" width=\"${width}px\" height=\"${height}px\" \nxlink:href=\"$data\" />\n"; $output .= "<image id=\"$id\" x=\"$x\" y=\"$y\" width=\"${width}px\" height=\"${height}px\" \nxlink:href=\"$data\" />\n";
$output .= "</a>\n" if($link && length($link)); $output .= "</a>\n" if($link && length($link));
return $output; return ($output,$width,$height);
} }
sub _btIP_imgData { sub _btIP_imgData {
@ -437,7 +432,7 @@ sub btIP_itemPlot {
$output .= "<image id=\"$id\" x=\"$x\" y=\"$y\" width=\"${newWidth}px\" height=\"${newHeight}px\" \nxlink:href=\"$url\" />\n"; $output .= "<image id=\"$id\" x=\"$x\" y=\"$y\" width=\"${newWidth}px\" height=\"${newHeight}px\" \nxlink:href=\"$url\" />\n";
} }
return $output; return ($output,$newWidth,$newHeight);
} }
@ -733,7 +728,7 @@ sub btIP_returnSVG {
my ($bgx,$bgy) = (0,0); my ($bgx,$bgy) = (0,0);
$bgx = ($width - $bgwidth/$u)/2 if AttrVal($name,'bgcenter',1); $bgx = ($width - $bgwidth/$u)/2 if AttrVal($name,'bgcenter',1);
$bgy = ($height - $bgheight/$u)/2 if AttrVal($name,'bgcenter',1); $bgy = ($height - $bgheight/$u)/2 if AttrVal($name,'bgcenter',1);
$output = btIP_itemImg('-',$bgx,$bgy,$scale,'file',$bgfile,undef); ($output,undef,undef) = btIP_itemImg('bgImage',$bgx,$bgy,$scale,'file',$bgfile,undef);
my $opacity = AttrVal($name,'bgopacity',1); my $opacity = AttrVal($name,'bgopacity',1);
$output =~ s/<image\ /<image\ opacity="$opacity" /; $output =~ s/<image\ /<image\ opacity="$opacity" /;
} }
@ -745,7 +740,6 @@ sub btIP_returnSVG {
$svg = btIP_evalLayout($svg, $name, $defs{$name}{fhem}{layout}); $svg = btIP_evalLayout($svg, $name, $defs{$name}{fhem}{layout});
readingsSingleUpdate($defs{$name},'state',localtime(),1); readingsSingleUpdate($defs{$name},'state',localtime(),1);
# $defs{$name}{STATE} = localtime();
}; #warn $@ if $@; }; #warn $@ if $@;
if($@) { if($@) {
@ -770,6 +764,7 @@ sub btIP_evalLayout {
my %params; my %params;
$params{name} = $name; $params{name} = $name;
$params{counter} = $defs{$name}{fhem}{counter};
$params{xx} = 0; $params{xx} = 0;
$params{yy} = 0; $params{yy} = 0;
$params{width} = $width; $params{width} = $width;
@ -791,8 +786,9 @@ sub btIP_evalLayout {
$defs{$name}{fhem}{div} = undef; $defs{$name}{fhem}{div} = undef;
my ($id,$x,$y,$x1,$y1,$x2,$y2,$r1,$r2); my ($id,$x,$y,$x1,$y1,$x2,$y2,$radius,$rx,$ry);
my ($scale,$inline,$boxwidth,$boxheight,$boxcolor); my ($scale,$inline,$boxwidth,$boxheight,$boxcolor);
my ($bgcolor,$fgcolor);
my ($text,$link,$imgtype,$srctype,$arg,$format,$filled,$stroked); my ($text,$link,$imgtype,$srctype,$arg,$format,$filled,$stroked);
my $cont= ""; my $cont= "";
@ -830,8 +826,8 @@ sub btIP_evalLayout {
($x1,$y1)= btIP_xy($x1,$y1,%params); ($x1,$y1)= btIP_xy($x1,$y1,%params);
($x2,$y2)= btIP_xy($x2,$y2,%params); ($x2,$y2)= btIP_xy($x2,$y2,%params);
$link = AnalyzePerlCommand(undef,$link); $link = AnalyzePerlCommand(undef,$link);
$params{xx} = $x; $params{xx} = $x1;
$params{yy} = $y; $params{yy} = $y2;
$svg .= btIP_itemArea($id,$x1,$y1,$x2,$y2,$link,%params); $svg .= btIP_itemArea($id,$x1,$y1,$x2,$y2,$link,%params);
} }
@ -841,15 +837,16 @@ sub btIP_evalLayout {
} }
when("button") { when("button") {
($id,$x1,$y1,$x2,$y2,$r1,$r2,$link,$text)= split("[ \t]+", $def, 9); ($id,$x1,$y1,$x2,$y2,$rx,$ry,$link,$text)= split("[ \t]+", $def, 9);
($x1,$y1)= btIP_xy($x1,$y1,%params); ($x1,$y1)= btIP_xy($x1,$y1,%params);
($x2,$y2)= btIP_xy($x2,$y2,%params); ($x2,$y2)= btIP_xy($x2,$y2,%params);
$params{xx} = $x; ($rx,$ry)= btIP_xy($rx,$ry,%params);
$params{yy} = $y; $params{xx} = $x1;
$params{yy} = $y2;
$link = AnalyzePerlCommand(undef,$link); $link = AnalyzePerlCommand(undef,$link);
$link = (length($link)) ? $link : "-$params{name}.html"; $link = (length($link)) ? $link : "-$params{name}.html";
$text = AnalyzePerlCommand(undef,$text); $text = AnalyzePerlCommand(undef,$text);
$svg .= btIP_itemButton($id,$x1,$y1,$x2,$y2,$r1,$r2,$link,$text,%params); $svg .= btIP_itemButton($id,$x1,$y1,$x2,$y2,$rx,$ry,$link,$text,%params);
} }
when("buttonpanel"){ when("buttonpanel"){
@ -859,12 +856,14 @@ sub btIP_evalLayout {
} }
when("circle") { when("circle") {
($id,$x1,$y1,$r1,$filled,$stroked,$link)= split("[ \t]+", $def, 7); ($id,$x1,$y1,$radius,$filled,$stroked,$link)= split("[ \t]+", $def, 7);
($x1,$y1)= btIP_xy($x1,$y1,%params); ($x1,$y1)= btIP_xy($x1,$y1,%params);
$params{xx} = $x1;
$params{yy} = $y1+$radius;
$filled //= 0; $filled //= 0;
$stroked //= 0; $stroked //= 0;
$link = AnalyzePerlCommand(undef,$link); $link = AnalyzePerlCommand(undef,$link);
$svg .= btIP_itemCircle($id,$x1,$y1,$r1,$filled,$stroked,$link,%params); $svg .= btIP_itemCircle($id,$x1,$y1,$radius,$filled,$stroked,$link,%params);
} }
when("counter") { when("counter") {
@ -884,12 +883,15 @@ sub btIP_evalLayout {
} }
when("ellipse") { when("ellipse") {
($id,$x1,$y1,$r1,$r2,$filled,$stroked,$link)= split("[ \t]+", $def, 8); ($id,$x1,$y1,$rx,$ry,$filled,$stroked,$link)= split("[ \t]+", $def, 8);
($x1,$y1) = btIP_xy($x1,$y1,%params); ($x1,$y1) = btIP_xy($x1,$y1,%params);
($rx,$ry) = btIP_xy($rx,$ry,%params);
$params{xx} = $x1;
$params{yy} = $y1+$ry;
$filled //= 0; $filled //= 0;
$stroked //= 0; $stroked //= 0;
$link = AnalyzePerlCommand(undef,$link); $link = AnalyzePerlCommand(undef,$link);
$svg .= btIP_itemEllipse($id,$x1,$y1,$r1,$r2,$filled,$stroked,$link,%params); $svg .= btIP_itemEllipse($id,$x1,$y1,$rx,$ry,$filled,$stroked,$link,%params);
} }
when("font") { when("font") {
@ -913,14 +915,17 @@ sub btIP_evalLayout {
$params{yy} = $y; $params{yy} = $y;
$arg = AnalyzePerlCommand(undef, $arg); $arg = AnalyzePerlCommand(undef, $arg);
$link = AnalyzePerlCommand(undef,$link); $link = AnalyzePerlCommand(undef,$link);
$svg .= btIP_itemImg($id,$x,$y,$scale,$srctype,$arg,$link,%params); my($output,$width,$height)= btIP_itemImg($id,$x,$y,$scale,$srctype,$arg,$link,%params);
$svg .= $output;
$params{xx} = $x;
$params{yy} = $y+$height;
} }
when("line") { when("line") {
($id,$x1,$y1,$x2,$y2,$format) = split("[ \t]+", $def, 6); ($id,$x1,$y1,$x2,$y2,$format) = split("[ \t]+", $def, 6);
($x1,$y1) = btIP_xy($x1,$y1,%params); ($x1,$y1) = btIP_xy($x1,$y1,%params);
($x2,$y2) = btIP_xy($x2,$y2,%params); ($x2,$y2) = btIP_xy($x2,$y2,%params);
$format //= 1; # set format to 1 as default thickness for the line $format //= 1;
$svg .= btIP_itemLine($id,$x1,$y1,$x2,$y2,$format,%params); $svg .= btIP_itemLine($id,$x1,$y1,$x2,$y2,$format,%params);
} }
@ -945,10 +950,11 @@ sub btIP_evalLayout {
when("plot") { when("plot") {
($id,$x,$y,$scale,$inline,$arg)= split("[ \t]+", $def,6); ($id,$x,$y,$scale,$inline,$arg)= split("[ \t]+", $def,6);
($x,$y)= btIP_xy($x,$y,%params); ($x,$y)= btIP_xy($x,$y,%params);
$arg = AnalyzePerlCommand(undef, $arg);
my($output,$width,$height)= btIP_itemPlot($id,$x,$y,$scale,$inline,$arg,%params);
$svg .= $output;
$params{xx} = $x; $params{xx} = $x;
$params{yy} = $y; $params{yy} = $y+$height;
my $arg = AnalyzePerlCommand(undef, $arg);
$svg .= btIP_itemPlot($id,$x,$y,$scale,$inline,$arg,%params);
} }
when("pop") { when("pop") {
@ -978,15 +984,16 @@ sub btIP_evalLayout {
} }
when("rect") { when("rect") {
($id,$x1,$y1,$x2,$y2,$r1,$r2,$filled,$stroked,$link)= split("[ \t]+", $def, 10); ($id,$x1,$y1,$x2,$y2,$rx,$ry,$filled,$stroked,$link)= split("[ \t]+", $def, 10);
($x1,$y1)= btIP_xy($x1,$y1,%params); ($x1,$y1)= btIP_xy($x1,$y1,%params);
($x2,$y2)= btIP_xy($x2,$y2,%params); ($x2,$y2)= btIP_xy($x2,$y2,%params);
$params{xx} = $x; ($rx,$ry) = btIP_xy($rx,$ry,%params);
$params{yy} = $y; $params{xx} = $x1;
$params{yy} = $y2;
$filled //= 0; # set 0 as default (not filled) $filled //= 0; # set 0 as default (not filled)
$stroked //= 0; # set 0 as default (not stroked) $stroked //= 0; # set 0 as default (not stroked)
$link = AnalyzePerlCommand(undef,$link); $link = AnalyzePerlCommand(undef,$link);
$svg .= btIP_itemRect($id,$x1,$y1,$x2,$y2,$r1,$r2,$filled,$stroked,$link,%params); $svg .= btIP_itemRect($id,$x1,$y1,$x2,$y2,$rx,$ry,$filled,$stroked,$link,%params);
} }
when("rgb"){ when("rgb"){
@ -1053,36 +1060,36 @@ sub btIP_evalLayout {
} }
when("trash") { when("trash") {
($id,$x,$y,$scale,$r1,$r2,$link)= split("[ \t]+", $def,7); ($id,$x,$y,$scale,$fgcolor,$bgcolor,$link)= split("[ \t]+", $def,7);
($x,$y)= btIP_xy($x,$y,%params); ($x,$y)= btIP_xy($x,$y,%params);
$fgcolor = AnalyzePerlCommand(undef,$fgcolor);
$bgcolor = AnalyzePerlCommand(undef,$bgcolor);
$link = AnalyzePerlCommand(undef,$link);
$svg .= btIP_itemTrash($id,$x,$y,$scale,$fgcolor,$bgcolor,$link,%params);
$params{xx} = $x; $params{xx} = $x;
$params{yy} = $y; $params{yy} = $y;
$r1 = AnalyzePerlCommand(undef,$r1);
$r2 = AnalyzePerlCommand(undef,$r2);
$link = AnalyzePerlCommand(undef,$link);
$svg .= btIP_itemTrash($id,$x,$y,$scale,$r1,$r2,$link,%params);
} }
default { when("thalign"){
if($cmd ~~ @cmd_halign) {
my $d = AnalyzePerlCommand(undef, $def); my $d = AnalyzePerlCommand(undef, $def);
if($d ~~ @valid_halign) { if($d ~~ @valid_halign) {
$params{ihalign}= $d unless($cmd eq "thalign"); $params{thalign}= $d;
$params{thalign}= $d unless($cmd eq "ihalign");
} else { } else {
Log3($name, 2, "InfoPanel: $name Illegal horizontal alignment $d"); Log3($name, 2, "InfoPanel: $name Illegal horizontal alignment $d");
} }
} elsif($cmd ~~ @cmd_valign) { }
when("tvalign"){
my $d = AnalyzePerlCommand(undef, $def); my $d = AnalyzePerlCommand(undef, $def);
if($d ~~ @valid_valign) { if($d ~~ @valid_valign) {
$params{ivalign}= $d unless($cmd eq "tvalign"); $params{tvalign}= $d;
$params{tvalign}= $d unless($cmd eq "ivalign");
} else { } else {
Log3($name, 2, "InfoPanel: $name: Illegal vertical alignment $d"); Log3($name, 2, "InfoPanel: $name Illegal vertical alignment $d");
} }
} else { }
default {
Log3($name, 2, "InfoPanel $name: Illegal command $cmd in layout definition."); Log3($name, 2, "InfoPanel $name: Illegal command $cmd in layout definition.");
}
} # default } # default
} # given } # given
} # eval } # eval
@ -1176,20 +1183,15 @@ sub btIP_returnHTML {
sub btIP_HTMLHead { sub btIP_HTMLHead {
my ($title,$refresh) = @_; my ($title,$refresh) = @_;
# my $doctype= '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">';
# my $xmlns= 'xmlns="http://www.w3.org/1999/xhtml"';
my $doctype = '<?xml version="1.0" encoding="utf-8" standalone="no"?> '."\n". my $doctype = '<?xml version="1.0" encoding="utf-8" standalone="no"?> '."\n".
'<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" '. '<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" '.
'"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">'."\n"; '"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">'."\n";
my $xmlns = ""; my $xmlns = "";
my $r= (defined($refresh) && $refresh) ? "<meta http-equiv=\"refresh\" content=\"$refresh\"/>\n" : ""; my $refresh = (defined($refresh) && $refresh) ? "<meta http-equiv=\"refresh\" content=\"$refresh\"/>\n" : "";
# css and js header output should be coded only in one place
my $css= "";
my $scripts = btIP_getScript(); my $scripts = btIP_getScript();
my $meta = "<meta charset=\"UTF-8\">\n"; my $meta = "<meta charset=\"UTF-8\">\n";
my $code= "$doctype\n<html $xmlns>\n<head>\n<title>$title</title>\n$meta$r$css$scripts</head>\n"; my $code = "$doctype\n<html $xmlns>\n<head>\n<title>$title</title>\n$meta$refresh$scripts</head>\n";
return $code; return $code;
} }