| Index: trunk/extensions/timeline/EasyTimeline.pl |
| — | — | @@ -63,1247 +63,1504 @@ |
| 64 | 64 | # this is a make do solution until full unicode support with external fonts will be added |
| 65 | 65 | # |
| 66 | 66 | # 1.12 June 2009 |
| 67 | | -# - Don't send -mapfile to ploticus without also sending -csmap, this creates an XSS |
| | 67 | +# - Don't send -mapfile to ploticus without also sending -csmap, this creates an XSS |
| 68 | 68 | # vulnerability |
| 69 | 69 | # |
| 70 | 70 | # 1.13 Jan 2010 |
| 71 | 71 | # -change svg encoding from iso-8859-1 -> UTF-8 |
| 72 | 72 | # -allow font to be specified using -f option as opposed to hardcoded FreeSans. |
| 73 | 73 | |
| 74 | | - $version = "1.13" ; |
| | 74 | +$version = "1.13"; |
| 75 | 75 | |
| 76 | | - use Time::Local ; |
| 77 | | - use Getopt::Std ; |
| 78 | | - use Cwd ; |
| | 76 | +use Time::Local; |
| | 77 | +use Getopt::Std; |
| | 78 | +use Cwd; |
| 79 | 79 | |
| 80 | | - $| = 1; # flush screen output |
| | 80 | +$| = 1; # flush screen output |
| 81 | 81 | |
| 82 | | - print "EasyTimeline version $version\n" . |
| 83 | | - "Copyright (C) 2004 Erik Zachte\n" . |
| 84 | | - "Email xxx\@chello.nl (nospam: xxx=epzachte)\n\n" . |
| 85 | | - "This program is free software; you can redistribute it\n" . |
| 86 | | - "and/or modify it under the terms of the \n" . |
| 87 | | - "GNU General Public License version 2 as published by\n" . |
| 88 | | - "the Free Software Foundation\n" . |
| 89 | | - "------------------------------------------------------\n" ; |
| | 82 | +print "EasyTimeline version $version\n" |
| | 83 | + . "Copyright (C) 2004 Erik Zachte\n" |
| | 84 | + . "Email xxx\@chello.nl (nospam: xxx=epzachte)\n\n" |
| | 85 | + . "This program is free software; you can redistribute it\n" |
| | 86 | + . "and/or modify it under the terms of the \n" |
| | 87 | + . "GNU General Public License version 2 as published by\n" |
| | 88 | + . "the Free Software Foundation\n" |
| | 89 | + . "------------------------------------------------------\n"; |
| 90 | 90 | |
| 91 | | - &SetImageFormat ; |
| 92 | | - &ParseArguments ; |
| 93 | | - &InitFiles ; |
| | 91 | +&SetImageFormat; |
| | 92 | +&ParseArguments; |
| | 93 | +&InitFiles; |
| 94 | 94 | |
| 95 | | - open "FILE_IN", "<", $file_in ; |
| 96 | | - @lines = <FILE_IN> ; |
| 97 | | - close "FILE_IN" ; |
| | 95 | +open "FILE_IN", "<", $file_in; |
| | 96 | +@lines = <FILE_IN>; |
| | 97 | +close "FILE_IN"; |
| 98 | 98 | |
| 99 | | - &InitVars ; |
| 100 | | - &ParseScript ; |
| | 99 | +&InitVars; |
| | 100 | +&ParseScript; |
| 101 | 101 | |
| 102 | | - if ($CntErrors == 0) |
| 103 | | - { &WritePlotFile ; } |
| | 102 | +if ($CntErrors == 0) { &WritePlotFile; } |
| 104 | 103 | |
| 105 | | - if ($CntErrors == 1) |
| 106 | | - { &Abort ("1 error found") ; } |
| 107 | | - elsif ($CntErrors > 1) |
| 108 | | - { &Abort ("$CntErrors errors found") ; } |
| 109 | | - else |
| 110 | | - { |
| 111 | | - if (defined @Info) |
| 112 | | - { |
| 113 | | - print "\nINFO\n" ; |
| 114 | | - print @Info ; |
| 115 | | - print "\n" ; |
| | 104 | +if ($CntErrors == 1) { &Abort("1 error found"); } |
| | 105 | +elsif ($CntErrors > 1) { &Abort("$CntErrors errors found"); } |
| | 106 | +else { |
| | 107 | + if (defined @Info) { |
| | 108 | + print "\nINFO\n"; |
| | 109 | + print @Info; |
| | 110 | + print "\n"; |
| 116 | 111 | } |
| 117 | | - if (defined @Warnings) |
| 118 | | - { |
| 119 | | - print "\nWARNING(S)\n" ; |
| 120 | | - print @Warnings ; |
| 121 | | - print "\n" ; |
| | 112 | + if (defined @Warnings) { |
| | 113 | + print "\nWARNING(S)\n"; |
| | 114 | + print @Warnings; |
| | 115 | + print "\n"; |
| 122 | 116 | } |
| 123 | 117 | |
| 124 | | - if (! (-e $file_bitmap)) |
| 125 | | - { |
| 126 | | - print "\nImage $file_bitmap not created.\n" ; |
| 127 | | - if ((! (-e "pl.exe")) && (! (-e "pl"))) |
| 128 | | - { print "\nPloticus not found in local folder. Is it on your system path?\n" ; } |
| | 118 | + if (!(-e $file_bitmap)) { |
| | 119 | + print "\nImage $file_bitmap not created.\n"; |
| | 120 | + if ((!(-e "pl.exe")) && (!(-e "pl"))) { |
| | 121 | + print |
| | 122 | + "\nPloticus not found in local folder. Is it on your system path?\n"; |
| | 123 | + } |
| 129 | 124 | } |
| 130 | | - elsif (! (-e $file_vector)) |
| 131 | | - { |
| 132 | | - print "\nImage $file_vector not created.\n" ; |
| | 125 | + elsif (!(-e $file_vector)) { |
| | 126 | + print "\nImage $file_vector not created.\n"; |
| 133 | 127 | } |
| 134 | | - else |
| 135 | | - { print "\nREADY\nNo errors found.\n" ; } |
| 136 | | - } |
| | 128 | + else { print "\nREADY\nNo errors found.\n"; } |
| | 129 | +} |
| 137 | 130 | |
| 138 | | - exit ; |
| | 131 | +exit; |
| 139 | 132 | |
| 140 | | -sub ParseArguments |
| 141 | | -{ |
| 142 | | - my $options ; |
| 143 | | - getopt ("iTAPef", \%options) ; |
| | 133 | +sub ParseArguments { |
| | 134 | + my $options; |
| | 135 | + getopt("iTAPef", \%options); |
| 144 | 136 | |
| 145 | | - &Abort ("Specify input file as: -i filename") if (! defined (@options {"i"})) ; |
| | 137 | + &Abort("Specify input file as: -i filename") if (!defined(@options{"i"})); |
| 146 | 138 | |
| 147 | | - $file_in = @options {"i"} ; |
| 148 | | - $listinput = @options {"l"} ; # list all input lines (not recommended) |
| 149 | | - $linkmap = @options {"m"} ; # make clickmap for inclusion in html |
| 150 | | - $makehtml = @options {"h"} ; # make test html file with gif/png + svg output |
| 151 | | - $bypass = @options {"b"} ; # do not use in Wikipedia:bypass some checks |
| 152 | | - $showmap = @options {"d"} ; # debug: shows clickable areas in gif/png |
| 153 | | - # The following parameters are used by MediaWiki |
| 154 | | - # to pass config settings from LocalSettings.php to |
| 155 | | - # the perl script |
| 156 | | - $tmpdir = @options {"T"} ; # For MediaWiki: temp directory to use |
| 157 | | - $plcommand = @options {"P"} ; # For MediaWiki: full path of ploticus command |
| 158 | | - $articlepath=@options {"A"} ; # For MediaWiki: Path of an article, relative to this servers root |
| 159 | | - $font_file = @options {"f"} ; # font to use. Must be in environemnt variable GDFONTPATH unless builtin "ascii" font |
| | 139 | + $file_in = @options{"i"}; |
| | 140 | + $listinput = @options{"l"}; # list all input lines (not recommended) |
| | 141 | + $linkmap = @options{"m"}; # make clickmap for inclusion in html |
| | 142 | + $makehtml = @options{"h"}; # make test html file with gif/png + svg output |
| | 143 | + $bypass = @options{"b"}; # do not use in Wikipedia:bypass some checks |
| | 144 | + $showmap = @options{"d"}; # debug: shows clickable areas in gif/png |
| | 145 | + # The following parameters are used by MediaWiki |
| | 146 | + # to pass config settings from LocalSettings.php to |
| | 147 | + # the perl script |
| | 148 | + $tmpdir = @options{"T"}; # For MediaWiki: temp directory to use |
| | 149 | + $plcommand = @options{"P"}; # For MediaWiki: full path of ploticus command |
| | 150 | + $articlepath = @options{"A" |
| | 151 | + }; # For MediaWiki: Path of an article, relative to this servers root |
| | 152 | + $font_file = @options{"f" |
| | 153 | + }; # font to use. Must be in environemnt variable GDFONTPATH unless builtin "ascii" font |
| 160 | 154 | |
| 161 | | - if (! defined @options {"f"} ) |
| 162 | | - { $font_file="ascii"; } |
| | 155 | + if (!defined @options{"f"}) { $font_file = "ascii"; } |
| 163 | 156 | |
| 164 | | - if (! defined @options {"A"} ) |
| 165 | | - { $articlepath="http://en.wikipedia.org/wiki/\$1"; } |
| | 157 | + if (!defined @options{"A"}) { |
| | 158 | + $articlepath = "http://en.wikipedia.org/wiki/\$1"; |
| | 159 | + } |
| 166 | 160 | |
| 167 | | - if (! -e $file_in) |
| 168 | | - { &Abort ("Input file '" . $file_in . "' not found.") ; } |
| | 161 | + if (!-e $file_in) { &Abort("Input file '" . $file_in . "' not found."); } |
| 169 | 162 | } |
| 170 | 163 | |
| 171 | | -sub InitVars |
| 172 | | -{ |
| 173 | | - $true = 1 ; |
| 174 | | - $false = 0 ; |
| 175 | | - $CntErrors = 0 ; |
| 176 | | - $LinkColor = "brightblue" ; |
| 177 | | - $MapPNG = $false ; # switched when link or hint found |
| 178 | | - $MapSVG = $false ; # switched when link found |
| 179 | | - $WarnTextOutsideArea = 0 ; |
| 180 | | - $WarnOnRightAlignedText = 0 ; |
| | 164 | +sub InitVars { |
| | 165 | + $true = 1; |
| | 166 | + $false = 0; |
| | 167 | + $CntErrors = 0; |
| | 168 | + $LinkColor = "brightblue"; |
| | 169 | + $MapPNG = $false; # switched when link or hint found |
| | 170 | + $MapSVG = $false; # switched when link found |
| | 171 | + $WarnTextOutsideArea = 0; |
| | 172 | + $WarnOnRightAlignedText = 0; |
| 181 | 173 | |
| 182 | | - $hPerc = &EncodeInput ("\%") ; |
| 183 | | - $hAmp = &EncodeInput ("\&") ; |
| 184 | | - $hAt = &EncodeInput ("\@") ; |
| 185 | | - $hDollar = &EncodeInput ("\$") ; |
| 186 | | - $hBrO = &EncodeInput ("\(") ; |
| 187 | | - $hBrC = &EncodeInput ("\)") ; |
| 188 | | - $hSemi = &EncodeInput ("\;") ; |
| 189 | | - $hIs = &EncodeInput ("\=") ; |
| 190 | | - $hLt = &EncodeInput ("\<") ; |
| 191 | | - $hGt = &EncodeInput ("\>") ; |
| | 174 | + $hPerc = &EncodeInput("\%"); |
| | 175 | + $hAmp = &EncodeInput("\&"); |
| | 176 | + $hAt = &EncodeInput("\@"); |
| | 177 | + $hDollar = &EncodeInput("\$"); |
| | 178 | + $hBrO = &EncodeInput("\("); |
| | 179 | + $hBrC = &EncodeInput("\)"); |
| | 180 | + $hSemi = &EncodeInput("\;"); |
| | 181 | + $hIs = &EncodeInput("\="); |
| | 182 | + $hLt = &EncodeInput("\<"); |
| | 183 | + $hGt = &EncodeInput("\>"); |
| 192 | 184 | } |
| 193 | 185 | |
| 194 | | -sub InitFiles |
| 195 | | -{ |
| 196 | | - print "\nInput: Script file $file_in\n" ; |
| | 186 | +sub InitFiles { |
| | 187 | + print "\nInput: Script file $file_in\n"; |
| 197 | 188 | |
| 198 | | - $file = $file_in ; |
| 199 | | -# 1.10 dot ignore dots in folder names -> |
| 200 | | - $file =~ s/\.[^\\\/\.]*$// ; # remove extension |
| 201 | | - $file_name = $file ; |
| 202 | | - $file_bitmap = $file . "." . $fmt ; |
| 203 | | - $file_vector = $file . ".svg" ; |
| 204 | | - $file_png = $file . ".png" ; |
| 205 | | - $file_htmlmap = $file . ".map" ; |
| 206 | | - $file_html = $file . ".html" ; |
| 207 | | - $file_errors = $file . ".err" ; |
| 208 | | -# $file_pl_info = $file . ".inf" ; |
| 209 | | -# $file_pl_err = $file . ".err" ; |
| 210 | | - print "Output: Image files $file_bitmap & $file_vector\n" ; |
| | 189 | + $file = $file_in; |
| 211 | 190 | |
| 212 | | - if ($linkmap) |
| 213 | | - { print " Map file $file_htmlmap (add to html for clickable map)\n" ; } |
| 214 | | - if ($makehtml) |
| 215 | | - { print " HTML test file $file_html\n" ; } |
| | 191 | + # 1.10 dot ignore dots in folder names -> |
| | 192 | + $file =~ s/\.[^\\\/\.]*$//; # remove extension |
| | 193 | + $file_name = $file; |
| | 194 | + $file_bitmap = $file . "." . $fmt; |
| | 195 | + $file_vector = $file . ".svg"; |
| | 196 | + $file_png = $file . ".png"; |
| | 197 | + $file_htmlmap = $file . ".map"; |
| | 198 | + $file_html = $file . ".html"; |
| | 199 | + $file_errors = $file . ".err"; |
| 216 | 200 | |
| 217 | | - # remove previous output |
| 218 | | - if (-e $file_bitmap) { unlink $file_bitmap ; } |
| 219 | | - if (-e $file_vector) { unlink $file_vector ; } |
| 220 | | - if (-e $file_png) { unlink $file_png ; } |
| 221 | | - if (-e $file_htmlmap) { unlink $file_htmlmap ; } |
| 222 | | - if (-e $file_html) { unlink $file_html ; } |
| 223 | | - if (-e $file_errors) { unlink $file_errors ; } |
| | 201 | + # $file_pl_info = $file . ".inf" ; |
| | 202 | + # $file_pl_err = $file . ".err" ; |
| | 203 | + print "Output: Image files $file_bitmap & $file_vector\n"; |
| | 204 | + |
| | 205 | + if ($linkmap) { |
| | 206 | + print |
| | 207 | + " Map file $file_htmlmap (add to html for clickable map)\n"; |
| | 208 | + } |
| | 209 | + if ($makehtml) { print " HTML test file $file_html\n"; } |
| | 210 | + |
| | 211 | + # remove previous output |
| | 212 | + if (-e $file_bitmap) { unlink $file_bitmap; } |
| | 213 | + if (-e $file_vector) { unlink $file_vector; } |
| | 214 | + if (-e $file_png) { unlink $file_png; } |
| | 215 | + if (-e $file_htmlmap) { unlink $file_htmlmap; } |
| | 216 | + if (-e $file_html) { unlink $file_html; } |
| | 217 | + if (-e $file_errors) { unlink $file_errors; } |
| 224 | 218 | } |
| 225 | 219 | |
| 226 | | -sub SetImageFormat |
| 227 | | -{ |
| 228 | | - $env = "" ; |
| 229 | | -# $dir = cwd() ; # is there a better way to detect OS? |
| 230 | | -# if ($dir =~ /\//) { $env = "Linux" ; $fmt = "png" ; $pathseparator = "/";} |
| 231 | | -# if ($dir =~ /\\/) { $env = "Windows" ; $fmt = "gif" ; $pathseparator = "\\";} |
| 232 | | -# cwd always to returns '/'s ? -> |
| 233 | | - $OS = $^O ; |
| 234 | | - if ($OS =~ /darwin/i) |
| 235 | | - { $env = "Linux"; $fmt = "png" ; $pathseparator = "/";} |
| 236 | | - elsif ($OS =~ /win/i) |
| 237 | | - { $env = "Windows" ; $fmt = "gif" ; $pathseparator = "\\";} |
| 238 | | - else |
| 239 | | - { $env = "Linux" ; $fmt = "png" ; $pathseparator = "/";} |
| | 220 | +sub SetImageFormat { |
| | 221 | + $env = ""; |
| 240 | 222 | |
| 241 | | - if ($env ne "") |
| 242 | | - { print "\nOS $env detected -> create image in $fmt format.\n" ; } |
| 243 | | - else |
| 244 | | - { |
| 245 | | - print "\nOS not detected. Assuming Windows -> create image in $fmt format.\n" ; |
| 246 | | - $env = "Windows" ; |
| 247 | | - } |
| | 223 | + # $dir = cwd() ; # is there a better way to detect OS? |
| | 224 | + # if ($dir =~ /\//) { $env = "Linux" ; $fmt = "png" ; $pathseparator = "/";} |
| | 225 | + # if ($dir =~ /\\/) { $env = "Windows" ; $fmt = "gif" ; $pathseparator = "\\";} |
| | 226 | + # cwd always to returns '/'s ? -> |
| | 227 | + $OS = $^O; |
| | 228 | + if ($OS =~ /darwin/i) { |
| | 229 | + $env = "Linux"; |
| | 230 | + $fmt = "png"; |
| | 231 | + $pathseparator = "/"; |
| | 232 | + } |
| | 233 | + elsif ($OS =~ /win/i) { |
| | 234 | + $env = "Windows"; |
| | 235 | + $fmt = "gif"; |
| | 236 | + $pathseparator = "\\"; |
| | 237 | + } |
| | 238 | + else { $env = "Linux"; $fmt = "png"; $pathseparator = "/"; } |
| | 239 | + |
| | 240 | + if ($env ne "") { |
| | 241 | + print "\nOS $env detected -> create image in $fmt format.\n"; |
| | 242 | + } |
| | 243 | + else { |
| | 244 | + print |
| | 245 | + "\nOS not detected. Assuming Windows -> create image in $fmt format.\n"; |
| | 246 | + $env = "Windows"; |
| | 247 | + } |
| 248 | 248 | } |
| 249 | | -sub ParseScript |
| 250 | | -{ |
| 251 | | - my $command ; # local version, $Command = global |
| 252 | | - $LineNo = 0 ; |
| 253 | | - $InputParsed = $false ; |
| 254 | | - $CommandNext = "" ; |
| 255 | | - $DateFormat = "x.y" ; |
| 256 | 249 | |
| 257 | | - $firstcmd = $true ; |
| 258 | | - &GetCommand ; |
| | 250 | +sub ParseScript { |
| | 251 | + my $command; # local version, $Command = global |
| | 252 | + $LineNo = 0; |
| | 253 | + $InputParsed = $false; |
| | 254 | + $CommandNext = ""; |
| | 255 | + $DateFormat = "x.y"; |
| 259 | 256 | |
| 260 | | - &StoreColor ("white", &EncodeInput ("gray(0.999)"), "") ; |
| 261 | | - &StoreColor ("barcoldefault", &EncodeInput ("rgb(0,0.6,0)"), "") ; |
| | 257 | + $firstcmd = $true; |
| | 258 | + &GetCommand; |
| 262 | 259 | |
| 263 | | - while (! $InputParsed) |
| 264 | | - { |
| 265 | | - if ($Command =~ /^\s*$/) |
| 266 | | - { &GetCommand ; next ; } |
| | 260 | + &StoreColor("white", &EncodeInput("gray(0.999)"), ""); |
| | 261 | + &StoreColor("barcoldefault", &EncodeInput("rgb(0,0.6,0)"), ""); |
| 267 | 262 | |
| 268 | | - if (! ($Command =~ /$hIs/)) |
| 269 | | - { &Error ("Invalid statement. No '=' found.") ; |
| 270 | | - &GetCommand ; next ; } |
| | 263 | + while (!$InputParsed) { |
| | 264 | + if ($Command =~ /^\s*$/) { &GetCommand; next; } |
| 271 | 265 | |
| 272 | | - if ($Command =~ /$hIs.*$hIs/) |
| 273 | | - { &Error ("Invalid statement. Multiple '=' found.") ; |
| 274 | | - &GetCommand ; next ; } |
| | 266 | + if (!($Command =~ /$hIs/)) { |
| | 267 | + &Error("Invalid statement. No '=' found."); |
| | 268 | + &GetCommand; |
| | 269 | + next; |
| | 270 | + } |
| 275 | 271 | |
| 276 | | - my ($name, $value) = split ($hIs, $Command) ; |
| 277 | | - $name =~ s/^\s*(.*?)\s*$/$1/ ; |
| | 272 | + if ($Command =~ /$hIs.*$hIs/) { |
| | 273 | + &Error("Invalid statement. Multiple '=' found."); |
| | 274 | + &GetCommand; |
| | 275 | + next; |
| | 276 | + } |
| 278 | 277 | |
| 279 | | - if ($name =~ /PlotDividers/i) |
| 280 | | - { &Error ("Command 'PlotDividers' has been renamed to 'LineData', please adjust.") ; |
| 281 | | - &GetCommand ; next ; } |
| 282 | | - if ($name =~ /DrawLines/i) |
| 283 | | - { &Error ("Command 'DrawLines' has been renamed to 'LineData', please adjust.\n" . |
| 284 | | - " Reason for change is consistency: LineData now follows the same syntax rules as PlotData and TextData.") ; |
| 285 | | - &GetCommand ; next ; } |
| | 278 | + my ($name, $value) = split($hIs, $Command); |
| | 279 | + $name =~ s/^\s*(.*?)\s*$/$1/; |
| 286 | 280 | |
| 287 | | - if ((! ($name =~ /^(?:Define)\s/)) && |
| 288 | | - (! ($name =~ /^(?:AlignBars|BarData| |
| | 281 | + if ($name =~ /PlotDividers/i) { |
| | 282 | + &Error( |
| | 283 | + "Command 'PlotDividers' has been renamed to 'LineData', please adjust." |
| | 284 | + ); |
| | 285 | + &GetCommand; |
| | 286 | + next; |
| | 287 | + } |
| | 288 | + if ($name =~ /DrawLines/i) { |
| | 289 | + &Error( |
| | 290 | + "Command 'DrawLines' has been renamed to 'LineData', please adjust.\n" |
| | 291 | + . " Reason for change is consistency: LineData now follows the same syntax rules as PlotData and TextData." |
| | 292 | + ); |
| | 293 | + &GetCommand; |
| | 294 | + next; |
| | 295 | + } |
| | 296 | + |
| | 297 | + if ( |
| | 298 | + (!($name =~ /^(?:Define)\s/)) |
| | 299 | + && ( |
| | 300 | + !( |
| | 301 | + $name =~ /^(?:AlignBars|BarData| |
| 289 | 302 | BackgroundColors|Colors|DateFormat|LineData| |
| 290 | 303 | ScaleMajor|ScaleMinor| |
| 291 | 304 | LegendLeft|LegendTop| |
| 292 | 305 | ImageSize|PlotArea|Legend| |
| 293 | 306 | Period|PlotData|Preset| |
| 294 | | - TextData|TimeAxis)$/xi))) |
| 295 | | - { &ParseUnknownCommand ; |
| 296 | | - &GetCommand ; next ; } |
| 297 | | - |
| 298 | | - $value =~ s/^\s*(.*?)\s*// ; |
| 299 | | - if (! ($name =~ /^(?:BarData|Colors|LineData|PlotData|TextData)$/i)) |
| 300 | | - { |
| 301 | | - if ((! (defined ($value))) || ($value eq "")) |
| 302 | | - { |
| 303 | | - if ($name =~ /Preset/i) |
| | 307 | + TextData|TimeAxis)$/xi |
| | 308 | + ) |
| | 309 | + ) |
| | 310 | + ) |
| 304 | 311 | { |
| 305 | | - &Error ("$name definition incomplete. No value specified\n" . |
| 306 | | - " At the moment only one preset exists: 'TimeVertical_OneBar_UnitYear'.\n" . |
| 307 | | - " See also meta.wikipedia.org/wiki/EasyTimeline/Presets") ; |
| | 312 | + &ParseUnknownCommand; |
| | 313 | + &GetCommand; |
| | 314 | + next; |
| 308 | 315 | } |
| 309 | | - else |
| 310 | | - { &Error ("$name definition incomplete. No attributes specified") ; } |
| 311 | | - &GetCommand ; next ; } |
| 312 | | - } |
| 313 | 316 | |
| 314 | | - if ($name =~ /^(?:BackgroundColors|Colors|Period|ScaleMajor|ScaleMinor|TimeAxis)$/i) |
| 315 | | - { |
| 316 | | - my @attributes = split (" ", $value) ; |
| 317 | | - foreach $attribute (@attributes) |
| 318 | | - { |
| 319 | | - my ($attrname, $attrvalue) = split ("\:", $attribute) ; |
| 320 | | - if (! ($name."-".$attrname =~ /^(?:Colors-Value|Colors-Legend| |
| | 317 | + $value =~ s/^\s*(.*?)\s*//; |
| | 318 | + if (!($name =~ /^(?:BarData|Colors|LineData|PlotData|TextData)$/i)) { |
| | 319 | + if ((!(defined($value))) || ($value eq "")) { |
| | 320 | + if ($name =~ /Preset/i) { |
| | 321 | + &Error("$name definition incomplete. No value specified\n" |
| | 322 | + . " At the moment only one preset exists: 'TimeVertical_OneBar_UnitYear'.\n" |
| | 323 | + . " See also meta.wikipedia.org/wiki/EasyTimeline/Presets" |
| | 324 | + ); |
| | 325 | + } |
| | 326 | + else { |
| | 327 | + &Error( |
| | 328 | + "$name definition incomplete. No attributes specified" |
| | 329 | + ); |
| | 330 | + } |
| | 331 | + &GetCommand; |
| | 332 | + next; |
| | 333 | + } |
| | 334 | + } |
| | 335 | + |
| | 336 | + if ($name =~ |
| | 337 | + /^(?:BackgroundColors|Colors|Period|ScaleMajor|ScaleMinor|TimeAxis)$/i |
| | 338 | + ) |
| | 339 | + { |
| | 340 | + my @attributes = split(" ", $value); |
| | 341 | + foreach $attribute (@attributes) { |
| | 342 | + my ($attrname, $attrvalue) = split("\:", $attribute); |
| | 343 | + if ( |
| | 344 | + !( |
| | 345 | + $name . "-" . $attrname =~ |
| | 346 | + /^(?:Colors-Value|Colors-Legend| |
| 321 | 347 | Period-From|Period-Till| |
| 322 | 348 | ScaleMajor-Color|ScaleMajor-Unit|ScaleMajor-Increment|ScaleMajor-Start| |
| 323 | 349 | ScaleMinor-Color|ScaleMinor-Unit|ScaleMinor-Increment|ScaleMinor-Start| |
| 324 | 350 | BackgroundColors-Canvas|BackgroundColors-Bars| |
| 325 | | - TimeAxis-Orientation|TimeAxis-Format)$/xi)) |
| 326 | | - { &Error ("$name definition invalid. Unknown attribute '$attrname'.") ; |
| 327 | | - &GetCommand ; next ; } |
| | 351 | + TimeAxis-Orientation|TimeAxis-Format)$/xi |
| | 352 | + ) |
| | 353 | + ) |
| | 354 | + { |
| | 355 | + &Error( |
| | 356 | + "$name definition invalid. Unknown attribute '$attrname'." |
| | 357 | + ); |
| | 358 | + &GetCommand; |
| | 359 | + next; |
| | 360 | + } |
| 328 | 361 | |
| 329 | | - if ((! defined ($attrvalue)) || ($attrvalue eq "")) |
| 330 | | - { &Error ("$name definition incomplete. No value specified for attribute '$attrname'.") ; |
| 331 | | - &GetCommand ; next ; } |
| 332 | | - } |
| 333 | | - } |
| | 362 | + if ((!defined($attrvalue)) || ($attrvalue eq "")) { |
| | 363 | + &Error( |
| | 364 | + "$name definition incomplete. No value specified for attribute '$attrname'." |
| | 365 | + ); |
| | 366 | + &GetCommand; |
| | 367 | + next; |
| | 368 | + } |
| | 369 | + } |
| | 370 | + } |
| 334 | 371 | |
| 335 | | - if ($Command =~ /^AlignBars/i) { &ParseAlignBars ; } |
| 336 | | - elsif ($Command =~ /^BackgroundColors/i) { &ParseBackgroundColors ; } |
| 337 | | - elsif ($Command =~ /^BarData/i) { &ParseBarData ; } |
| 338 | | - elsif ($Command =~ /^Colors/i) { &ParseColors ; } |
| 339 | | - elsif ($Command =~ /^DateFormat/i) { &ParseDateFormat ; } |
| 340 | | - elsif ($Command =~ /^Define/i) { &ParseDefine ; } |
| 341 | | - elsif ($Command =~ /^ImageSize/i) { &ParseImageSize ; } |
| 342 | | - elsif ($Command =~ /^Legend/i) { &ParseLegend ; } |
| 343 | | - elsif ($Command =~ /^LineData/i) { &ParseLineData ; } |
| 344 | | - elsif ($Command =~ /^Period/i) { &ParsePeriod ; } |
| 345 | | - elsif ($Command =~ /^PlotArea/i) { &ParsePlotArea ; } |
| 346 | | - elsif ($Command =~ /^PlotData/i) { &ParsePlotData ; } |
| 347 | | - elsif ($Command =~ /^Preset/i) { &ParsePreset ; } |
| 348 | | - elsif ($Command =~ /^Scale/i) { &ParseScale ; } |
| 349 | | - elsif ($Command =~ /^TextData/i) { &ParseTextData ; } |
| 350 | | - elsif ($Command =~ /^TimeAxis/i) { &ParseTimeAxis ; } |
| | 372 | + if ($Command =~ /^AlignBars/i) { &ParseAlignBars; } |
| | 373 | + elsif ($Command =~ /^BackgroundColors/i) { &ParseBackgroundColors; } |
| | 374 | + elsif ($Command =~ /^BarData/i) { &ParseBarData; } |
| | 375 | + elsif ($Command =~ /^Colors/i) { &ParseColors; } |
| | 376 | + elsif ($Command =~ /^DateFormat/i) { &ParseDateFormat; } |
| | 377 | + elsif ($Command =~ /^Define/i) { &ParseDefine; } |
| | 378 | + elsif ($Command =~ /^ImageSize/i) { &ParseImageSize; } |
| | 379 | + elsif ($Command =~ /^Legend/i) { &ParseLegend; } |
| | 380 | + elsif ($Command =~ /^LineData/i) { &ParseLineData; } |
| | 381 | + elsif ($Command =~ /^Period/i) { &ParsePeriod; } |
| | 382 | + elsif ($Command =~ /^PlotArea/i) { &ParsePlotArea; } |
| | 383 | + elsif ($Command =~ /^PlotData/i) { &ParsePlotData; } |
| | 384 | + elsif ($Command =~ /^Preset/i) { &ParsePreset; } |
| | 385 | + elsif ($Command =~ /^Scale/i) { &ParseScale; } |
| | 386 | + elsif ($Command =~ /^TextData/i) { &ParseTextData; } |
| | 387 | + elsif ($Command =~ /^TimeAxis/i) { &ParseTimeAxis; } |
| 351 | 388 | |
| 352 | | - &GetCommand ; |
| 353 | | - $firstcmd = $false ; |
| 354 | | - } |
| | 389 | + &GetCommand; |
| | 390 | + $firstcmd = $false; |
| | 391 | + } |
| 355 | 392 | |
| 356 | | - if ($CntErrors == 0) |
| 357 | | - { &DetectMissingCommands ; } |
| | 393 | + if ($CntErrors == 0) { &DetectMissingCommands; } |
| 358 | 394 | |
| 359 | | - if ($CntErrors == 0) |
| 360 | | - { &ValidateAndNormalizeDimensions ; } |
| | 395 | + if ($CntErrors == 0) { &ValidateAndNormalizeDimensions; } |
| 361 | 396 | } |
| 362 | 397 | |
| | 398 | +sub GetLine { |
| | 399 | + if ($#lines < 0) { $InputParsed = $true; return (""); } |
| 363 | 400 | |
| 364 | | -sub GetLine |
| 365 | | -{ |
| 366 | | - if ($#lines < 0) |
| 367 | | - { $InputParsed = $true ; return ("") ; } |
| | 401 | + # running in Wikipedia context and first line empty ? |
| | 402 | + # skip first line without incrementing line count |
| | 403 | + # this is part behind <timeline> and will not be thought of as line 1 |
| | 404 | + if (defined @options{"A"}) { |
| | 405 | + if (($#lines >= 0) && (@lines[0] =~ /^\s*$/)) { |
| | 406 | + $Line = shift(@lines); |
| | 407 | + } |
| | 408 | + } |
| 368 | 409 | |
| 369 | | - # running in Wikipedia context and first line empty ? |
| 370 | | - # skip first line without incrementing line count |
| 371 | | - # this is part behind <timeline> and will not be thought of as line 1 |
| 372 | | - if (defined @options {"A"}) |
| 373 | | - { |
| 374 | | - if (($#lines >= 0) && (@lines [0] =~ /^\s*$/)) |
| 375 | | - { $Line = shift (@lines) ; } |
| 376 | | - } |
| | 410 | + $Line = ""; |
| | 411 | + while (($#lines >= 0) && ($Line =~ /^\s*$/)) { |
| | 412 | + $LineNo++; |
| | 413 | + $Line = shift(@lines); |
| | 414 | + chomp($Line); |
| 377 | 415 | |
| 378 | | - $Line = "" ; |
| 379 | | - while (($#lines >= 0) && ($Line =~ /^\s*$/)) |
| 380 | | - { |
| 381 | | - $LineNo ++ ; |
| 382 | | - $Line = shift (@lines) ; |
| 383 | | - chomp ($Line) ; |
| | 416 | + if ($listinput) { print "$LineNo: " . &DecodeInput($Line) . "\n"; } |
| 384 | 417 | |
| 385 | | - if ($listinput) |
| 386 | | - { print "$LineNo: " . &DecodeInput ($Line) . "\n" ; } |
| | 418 | + # preserve '#' within double quotes |
| | 419 | + $Line =~ s/(\"[^\"]*\")/$a=$1,$a=~s^\#^\%\?\+^g,$a/ge; |
| 387 | 420 | |
| 388 | | - # preserve '#' within double quotes |
| 389 | | - $Line =~ s/(\"[^\"]*\")/$a=$1,$a=~s^\#^\%\?\+^g,$a/ge ; |
| | 421 | + $Line =~ s/#>.*?<#//g; |
| | 422 | + if ($Line =~ /#>/) { |
| | 423 | + $commentstart = $LineNo; |
| | 424 | + $Line =~ s/#>.*?$//; |
| | 425 | + } |
| | 426 | + elsif ($Line =~ /<#/) { |
| | 427 | + undef $commentstart; |
| | 428 | + $Line =~ s/^.*?<#//x; |
| | 429 | + } |
| | 430 | + elsif (defined($commentstart)) { $Line = ""; next; } |
| 390 | 431 | |
| 391 | | - $Line =~ s/#>.*?<#//g ; |
| 392 | | - if ($Line =~ /#>/) |
| 393 | | - { |
| 394 | | - $commentstart = $LineNo ; |
| 395 | | - $Line =~ s/#>.*?$// ; |
| | 432 | + # remove single line comments (keep html char tags, like  ) |
| | 433 | + $Line =~ s/\&\#/\&\$\%/g; |
| | 434 | + $Line =~ s/\#.*$//; |
| | 435 | + $Line =~ s/\&\$\%/\&\#/g; |
| | 436 | + $Line =~ s/\%\?\+/\#/g; |
| | 437 | + $Line =~ s/\s*$//g; |
| | 438 | + $Line =~ s/\t/ /g; |
| 396 | 439 | } |
| 397 | | - elsif ($Line =~ /<#/) |
| 398 | | - { |
| 399 | | - undef $commentstart ; |
| 400 | | - $Line =~ s/^.*?<#//x ; |
| 401 | | - } |
| 402 | | - elsif (defined ($commentstart)) |
| 403 | | - { $Line = "" ; next ; } |
| 404 | 440 | |
| 405 | | - # remove single line comments (keep html char tags, like  ) |
| 406 | | - $Line =~ s/\&\#/\&\$\%/g ; |
| 407 | | - $Line =~ s/\#.*$// ; |
| 408 | | - $Line =~ s/\&\$\%/\&\#/g ; |
| 409 | | - $Line =~ s/\%\?\+/\#/g ; |
| 410 | | - $Line =~ s/\s*$//g ; |
| 411 | | - $Line =~ s/\t/ /g ; |
| 412 | | - } |
| | 441 | + if ($Line !~ /^\s*$/) { |
| | 442 | + $Line = &EncodeInput($Line); |
| 413 | 443 | |
| 414 | | - if ($Line !~ /^\s*$/) |
| 415 | | - { |
| 416 | | - $Line = &EncodeInput ($Line) ; |
| | 444 | + if (!($Line =~ /^\s*Define/i)) { |
| | 445 | + $Line =~ s/($hDollar[a-zA-Z0-9]+)/&GetDefine($Line,$1)/ge; |
| | 446 | + } |
| | 447 | + } |
| 417 | 448 | |
| 418 | | - if (! ($Line =~ /^\s*Define/i)) |
| 419 | | - { $Line =~ s/($hDollar[a-zA-Z0-9]+)/&GetDefine($Line,$1)/ge ; } |
| 420 | | - } |
| 421 | | - |
| 422 | | - if (($#lines < 0) && (defined ($commentstart))) |
| 423 | | - { &Error2 ("No matching end of comment found for comment block starting at line $commentstart.\n" . |
| 424 | | - "Text between \#> and <\# (multiple lines) or following \# (single line) will be treated as comment.") ; } |
| 425 | | - return ($Line) ; |
| | 449 | + if (($#lines < 0) && (defined($commentstart))) { |
| | 450 | + &Error2( |
| | 451 | + "No matching end of comment found for comment block starting at line $commentstart.\n" |
| | 452 | + . "Text between \#> and <\# (multiple lines) or following \# (single line) will be treated as comment." |
| | 453 | + ); |
| | 454 | + } |
| | 455 | + return ($Line); |
| 426 | 456 | } |
| 427 | 457 | |
| 428 | | -sub GetCommand |
| 429 | | -{ |
| 430 | | - undef (%Attributes) ; |
| 431 | | - $Command = "" ; |
| | 458 | +sub GetCommand { |
| | 459 | + undef(%Attributes); |
| | 460 | + $Command = ""; |
| 432 | 461 | |
| 433 | | - if ($CommandNext ne "") |
| 434 | | - { |
| 435 | | - $Command = $CommandNext ; |
| 436 | | - $CommandNext = "" ; |
| 437 | | - } |
| 438 | | - else |
| 439 | | - { $Command = &GetLine ; } |
| | 462 | + if ($CommandNext ne "") { |
| | 463 | + $Command = $CommandNext; |
| | 464 | + $CommandNext = ""; |
| | 465 | + } |
| | 466 | + else { $Command = &GetLine; } |
| 440 | 467 | |
| 441 | | - if ($Command =~ /^\s/) |
| 442 | | - { |
| 443 | | - &Error ("New command expected instead of data line (= line starting with spaces). Data line(s) ignored.\n") ; |
| 444 | | - $Command = &GetLine ; |
| 445 | | - while (($#lines >= 0) && ($Command =~ /^\s/)) |
| 446 | | - { $Command = &GetLine ; } |
| 447 | | - } |
| | 468 | + if ($Command =~ /^\s/) { |
| | 469 | + &Error( |
| | 470 | + "New command expected instead of data line (= line starting with spaces). Data line(s) ignored.\n" |
| | 471 | + ); |
| | 472 | + $Command = &GetLine; |
| | 473 | + while (($#lines >= 0) && ($Command =~ /^\s/)) { $Command = &GetLine; } |
| | 474 | + } |
| 448 | 475 | |
| 449 | | - if ($Command =~ /^[^\s]/) |
| 450 | | - { |
| 451 | | - $line = $Command ; |
| 452 | | - $line =~ s/^.*$hIs\s*// ; |
| 453 | | - &CollectAttributes ($line) ; |
| 454 | | - } |
| | 476 | + if ($Command =~ /^[^\s]/) { |
| | 477 | + $line = $Command; |
| | 478 | + $line =~ s/^.*$hIs\s*//; |
| | 479 | + &CollectAttributes($line); |
| | 480 | + } |
| 455 | 481 | } |
| 456 | 482 | |
| 457 | | -sub GetData |
| 458 | | -{ |
| 459 | | - undef (%Attributes) ; |
| 460 | | - $Command = "" ; |
| 461 | | - $NoData = $false ; |
| 462 | | - my $line = &GetLine ; |
| | 483 | +sub GetData { |
| | 484 | + undef(%Attributes); |
| | 485 | + $Command = ""; |
| | 486 | + $NoData = $false; |
| | 487 | + my $line = &GetLine; |
| 463 | 488 | |
| 464 | | - if ($line =~ /^[^\s]/) |
| 465 | | - { |
| 466 | | - $CommandNext = $line ; |
| 467 | | - $NoData = $true ; |
| 468 | | - return ("") ; |
| 469 | | - } |
| | 489 | + if ($line =~ /^[^\s]/) { |
| | 490 | + $CommandNext = $line; |
| | 491 | + $NoData = $true; |
| | 492 | + return (""); |
| | 493 | + } |
| 470 | 494 | |
| 471 | | - if ($line =~ /^\s*$/) |
| 472 | | - { |
| 473 | | - $NoData = $true ; |
| 474 | | - return ("") ; |
| 475 | | - } |
| | 495 | + if ($line =~ /^\s*$/) { |
| | 496 | + $NoData = $true; |
| | 497 | + return (""); |
| | 498 | + } |
| 476 | 499 | |
| 477 | | - $line =~ s/^\s*//g ; |
| 478 | | - &CollectAttributes ($line) ; |
| | 500 | + $line =~ s/^\s*//g; |
| | 501 | + &CollectAttributes($line); |
| 479 | 502 | } |
| 480 | 503 | |
| 481 | | -sub CollectAttributes |
| 482 | | -{ |
| 483 | | - my $line = shift ; |
| | 504 | +sub CollectAttributes { |
| | 505 | + my $line = shift; |
| 484 | 506 | |
| 485 | | - $line =~ s/(\slink\:[^\s\:]*)\:/$1'colon'/i ; # replace colon (:), would conflict with syntax |
| 486 | | - $line =~ s/(\stext\:[^\s\:]*)\:/$1'colon'/i ; # replace colon (:), would conflict with syntax |
| 487 | | - $line =~ s/(https?)\:/$1'colon'/i ; # replace colon (:), would conflict with syntax |
| | 507 | + $line =~ s/(\slink\:[^\s\:]*)\:/$1'colon'/i |
| | 508 | + ; # replace colon (:), would conflict with syntax |
| | 509 | + $line =~ s/(\stext\:[^\s\:]*)\:/$1'colon'/i |
| | 510 | + ; # replace colon (:), would conflict with syntax |
| | 511 | + $line =~ s/(https?)\:/$1'colon'/i |
| | 512 | + ; # replace colon (:), would conflict with syntax |
| 488 | 513 | |
| 489 | | - my $text ; |
| 490 | | - ($line, $text) = &ExtractText ($line) ; |
| 491 | | - $text =~ s/'colon'/:/ ; |
| | 514 | + my $text; |
| | 515 | + ($line, $text) = &ExtractText($line); |
| | 516 | + $text =~ s/'colon'/:/; |
| 492 | 517 | |
| 493 | | - $line =~ s/( $hBrO .+? $hBrC )/&RemoveSpaces($1)/gxe ; |
| 494 | | - $line =~ s/\s*\:\s*/:/g ; |
| 495 | | - $line =~ s/([a-zA-Z0-9\_]+)\:/lc($1) . ":"/gxe ; |
| 496 | | - @Fields = split (" ", $line) ; |
| | 518 | + $line =~ s/( $hBrO .+? $hBrC )/&RemoveSpaces($1)/gxe; |
| | 519 | + $line =~ s/\s*\:\s*/:/g; |
| | 520 | + $line =~ s/([a-zA-Z0-9\_]+)\:/lc($1) . ":"/gxe; |
| | 521 | + @Fields = split(" ", $line); |
| 497 | 522 | |
| 498 | | - $name = "" ; |
| 499 | | - foreach $field (@Fields) |
| 500 | | - { |
| 501 | | - if ($field =~ /\:/) |
| 502 | | - { |
| 503 | | - ($name, $value) = split (":", $field) ; |
| 504 | | - $name =~ s/^\s*(.*)\s*$/lc($1)/gxe ; |
| 505 | | - $value =~ s/^\s*(.*)\s*$/$1/gxe ; |
| 506 | | - if (($name ne "bar") && ($name ne "text") && ($name ne "link") && ($name ne "legend")) # && ($name ne "hint") |
| 507 | | - { $value = lc ($value) ; } |
| | 523 | + $name = ""; |
| | 524 | + foreach $field (@Fields) { |
| | 525 | + if ($field =~ /\:/) { |
| | 526 | + ($name, $value) = split(":", $field); |
| | 527 | + $name =~ s/^\s*(.*)\s*$/lc($1)/gxe; |
| | 528 | + $value =~ s/^\s*(.*)\s*$/$1/gxe; |
| | 529 | + if ( ($name ne "bar") |
| | 530 | + && ($name ne "text") |
| | 531 | + && ($name ne "link") |
| | 532 | + && ($name ne "legend")) # && ($name ne "hint") |
| | 533 | + { |
| | 534 | + $value = lc($value); |
| | 535 | + } |
| 508 | 536 | |
| 509 | | - if ($name eq "link") # restore colon |
| 510 | | - { $value =~ s/'colon'/:/ ; } |
| | 537 | + if ($name eq "link") # restore colon |
| | 538 | + { |
| | 539 | + $value =~ s/'colon'/:/; |
| | 540 | + } |
| 511 | 541 | |
| 512 | | - if ($value eq "") |
| 513 | | - { |
| 514 | | - if ($name =~ /Text/i) |
| 515 | | - { $value = " " ; } |
| 516 | | - else |
| 517 | | - { &Error ("No value specified for attribute '$name'. Attribute ignored.") ; } |
| 518 | | - } |
| 519 | | - else |
| 520 | | - { @Attributes {$name} = $value ; } |
| | 542 | + if ($value eq "") { |
| | 543 | + if ($name =~ /Text/i) { $value = " "; } |
| | 544 | + else { |
| | 545 | + &Error( |
| | 546 | + "No value specified for attribute '$name'. Attribute ignored." |
| | 547 | + ); |
| | 548 | + } |
| | 549 | + } |
| | 550 | + else { @Attributes{$name} = $value; } |
| | 551 | + } |
| | 552 | + else { |
| | 553 | + if (defined(@Attributes{"single"})) { |
| | 554 | + &Error( |
| | 555 | + "Invalid attribute '$field' ignored.\nSpecify attributes as 'name:value' pair(s)." |
| | 556 | + ); |
| | 557 | + } |
| | 558 | + else { |
| | 559 | + $field =~ s/^\s*(.*)\s*$/$1/gxe; |
| | 560 | + @Attributes{"single"} = $field; |
| | 561 | + } |
| | 562 | + } |
| 521 | 563 | } |
| 522 | | - else |
| 523 | | - { |
| 524 | | - if (defined (@Attributes {"single"})) |
| 525 | | - { &Error ("Invalid attribute '$field' ignored.\nSpecify attributes as 'name:value' pair(s).") ; } |
| 526 | | - else |
| 527 | | - { |
| 528 | | - $field =~ s/^\s*(.*)\s*$/$1/gxe ; |
| 529 | | - @Attributes {"single"} = $field ; |
| 530 | | - } |
| | 564 | + if (($name ne "") && (@Attributes{"single"} ne "")) { |
| | 565 | + &Error( "Invalid attribute '" |
| | 566 | + . @Attributes{"single"} |
| | 567 | + . "' ignored.\nSpecify attributes as 'name:value' pairs."); |
| | 568 | + delete(@Attributes{"single"}); |
| 531 | 569 | } |
| 532 | | - } |
| 533 | | - if (($name ne "") && (@Attributes {"single"} ne "")) |
| 534 | | - { |
| 535 | | - &Error ("Invalid attribute '" . @Attributes {"single"} . "' ignored.\nSpecify attributes as 'name:value' pairs.") ; |
| 536 | | - delete (@Attributes {"single"}) ; |
| 537 | | - } |
| 538 | 570 | |
| 539 | | - if ((defined ($text)) && ($text ne "")) |
| 540 | | - { @Attributes {"text"} = &ParseText ($text) ; } |
| | 571 | + if ((defined($text)) && ($text ne "")) { |
| | 572 | + @Attributes{"text"} = &ParseText($text); |
| | 573 | + } |
| 541 | 574 | } |
| 542 | 575 | |
| 543 | | -sub GetDefine |
| 544 | | -{ |
| 545 | | - my $command = shift ; |
| 546 | | - my $const = shift ; |
| 547 | | - $const = lc ($const) ; |
| 548 | | - my $value = @Consts {lc ($const)} ; |
| 549 | | - if (! defined ($value)) |
| 550 | | - { |
| 551 | | - &Error ("Unknown constant. 'Define $const = ... ' expected.") ; |
| 552 | | - return ($const); |
| 553 | | - } |
| 554 | | - return ($value) ; |
| | 576 | +sub GetDefine { |
| | 577 | + my $command = shift; |
| | 578 | + my $const = shift; |
| | 579 | + $const = lc($const); |
| | 580 | + my $value = @Consts{ lc($const) }; |
| | 581 | + if (!defined($value)) { |
| | 582 | + &Error("Unknown constant. 'Define $const = ... ' expected."); |
| | 583 | + return ($const); |
| | 584 | + } |
| | 585 | + return ($value); |
| 555 | 586 | } |
| 556 | 587 | |
| 557 | | -sub ParseAlignBars |
| 558 | | -{ |
| 559 | | - &CheckPreset ("AlignBars") ; |
| | 588 | +sub ParseAlignBars { |
| | 589 | + &CheckPreset("AlignBars"); |
| 560 | 590 | |
| 561 | | - $align = @Attributes {"single"} ; |
| 562 | | - if (! ($align =~ /^(?:justify|early|late)$/i)) |
| 563 | | - { &Error ("AlignBars value '$align' invalid. Specify 'justify', 'early' or 'late'.") ; return ; } |
| | 591 | + $align = @Attributes{"single"}; |
| | 592 | + if (!($align =~ /^(?:justify|early|late)$/i)) { |
| | 593 | + &Error( |
| | 594 | + "AlignBars value '$align' invalid. Specify 'justify', 'early' or 'late'." |
| | 595 | + ); |
| | 596 | + return; |
| | 597 | + } |
| 564 | 598 | |
| 565 | | - $AlignBars = lc ($align) ; |
| | 599 | + $AlignBars = lc($align); |
| 566 | 600 | } |
| 567 | 601 | |
| 568 | | -sub ParseBackgroundColors |
| 569 | | -{ |
| 570 | | - if (! &ValidAttributes ("BackgroundColors")) |
| 571 | | - { &GetData ; next ;} |
| | 602 | +sub ParseBackgroundColors { |
| | 603 | + if (!&ValidAttributes("BackgroundColors")) { &GetData; next; } |
| 572 | 604 | |
| 573 | | - &CheckPreset ("BackGroundColors") ; |
| | 605 | + &CheckPreset("BackGroundColors"); |
| 574 | 606 | |
| 575 | | - foreach $attribute (keys %Attributes) |
| 576 | | - { |
| 577 | | - my $attrvalue = @Attributes {$attribute} ; |
| | 607 | + foreach $attribute (keys %Attributes) { |
| | 608 | + my $attrvalue = @Attributes{$attribute}; |
| 578 | 609 | |
| 579 | | - if ($attribute =~ /Canvas/i) |
| 580 | | - { |
| 581 | | - if (! &ColorPredefined ($attrvalue)) |
| 582 | | - { |
| 583 | | - if (! defined (@Colors {lc ($attrvalue)})) |
| 584 | | - { &Error ("BackgroundColors definition invalid. Attribute '$attribute': unknown color '$attrvalue'.\n" . |
| 585 | | - " Specify command 'Color' before this command.") ; return ; } |
| 586 | | - } |
| 587 | | - if (defined (@Colors {lc ($attrvalue)})) |
| 588 | | - { @Attributes {"canvas"} = @Colors { lc ($attrvalue) } ; } |
| 589 | | - else |
| 590 | | - { @Attributes {"canvas"} = lc ($attrvalue) ; } |
| 591 | | - } |
| 592 | | - elsif ($attribute =~ /Bars/i) |
| 593 | | - { |
| 594 | | - if (! defined (@Colors {lc ($attrvalue)})) |
| 595 | | - { &Error ("BackgroundColors definition invalid. Attribute '$attribute' unknown color '$attrvalue'.\n" . |
| 596 | | - " Specify command 'Color' before this command.") ; return ; } |
| | 610 | + if ($attribute =~ /Canvas/i) { |
| | 611 | + if (!&ColorPredefined($attrvalue)) { |
| | 612 | + if (!defined(@Colors{ lc($attrvalue) })) { |
| | 613 | + &Error( |
| | 614 | + "BackgroundColors definition invalid. Attribute '$attribute': unknown color '$attrvalue'.\n" |
| | 615 | + . " Specify command 'Color' before this command." |
| | 616 | + ); |
| | 617 | + return; |
| | 618 | + } |
| | 619 | + } |
| | 620 | + if (defined(@Colors{ lc($attrvalue) })) { |
| | 621 | + @Attributes{"canvas"} = @Colors{ lc($attrvalue) }; |
| | 622 | + } |
| | 623 | + else { @Attributes{"canvas"} = lc($attrvalue); } |
| | 624 | + } |
| | 625 | + elsif ($attribute =~ /Bars/i) { |
| | 626 | + if (!defined(@Colors{ lc($attrvalue) })) { |
| | 627 | + &Error( |
| | 628 | + "BackgroundColors definition invalid. Attribute '$attribute' unknown color '$attrvalue'.\n" |
| | 629 | + . " Specify command 'Color' before this command."); |
| | 630 | + return; |
| | 631 | + } |
| 597 | 632 | |
| 598 | | - @Attributes {"bars"} = lc ($attrvalue) ; |
| | 633 | + @Attributes{"bars"} = lc($attrvalue); |
| | 634 | + } |
| 599 | 635 | } |
| 600 | | - } |
| 601 | 636 | |
| 602 | | - %BackgroundColors = %Attributes ; |
| | 637 | + %BackgroundColors = %Attributes; |
| 603 | 638 | } |
| 604 | 639 | |
| 605 | | -sub ParseBarData |
| 606 | | -{ |
| 607 | | - &GetData ; |
| 608 | | - if ($NoData) |
| 609 | | - { &Error ("Data expected for command 'BarData', but line is not indented.\n") ; return ; } |
| | 640 | +sub ParseBarData { |
| | 641 | + &GetData; |
| | 642 | + if ($NoData) { |
| | 643 | + &Error( |
| | 644 | + "Data expected for command 'BarData', but line is not indented.\n" |
| | 645 | + ); |
| | 646 | + return; |
| | 647 | + } |
| 610 | 648 | |
| 611 | | - my ($bar, $text, $link, $hint, $barset) ; # , $barcount) ; |
| | 649 | + my ($bar, $text, $link, $hint, $barset); # , $barcount) ; |
| 612 | 650 | |
| 613 | | - BarData: |
| 614 | | - while ((! $InputParsed) && (! $NoData)) |
| 615 | | - { |
| 616 | | - if (! &ValidAttributes ("BarData")) |
| 617 | | - { &GetData ; next ;} |
| | 651 | + BarData: |
| | 652 | + while ((!$InputParsed) && (!$NoData)) { |
| | 653 | + if (!&ValidAttributes("BarData")) { &GetData; next; } |
| 618 | 654 | |
| 619 | | - $bar = "" ; $link = "" ; $hint = "" ; $barset = "" ; # $barcount = "" ; |
| | 655 | + $bar = ""; |
| | 656 | + $link = ""; |
| | 657 | + $hint = ""; |
| | 658 | + $barset = ""; # $barcount = "" ; |
| 620 | 659 | |
| 621 | | - my $data2 = $data ; |
| 622 | | - ($data2, $text) = &ExtractText ($data2) ; |
| 623 | | - @Attributes = split (" ", $data2) ; |
| | 660 | + my $data2 = $data; |
| | 661 | + ($data2, $text) = &ExtractText($data2); |
| | 662 | + @Attributes = split(" ", $data2); |
| 624 | 663 | |
| 625 | | - foreach $attribute (keys %Attributes) |
| 626 | | - { |
| 627 | | - my $attrvalue = @Attributes {$attribute} ; |
| | 664 | + foreach $attribute (keys %Attributes) { |
| | 665 | + my $attrvalue = @Attributes{$attribute}; |
| 628 | 666 | |
| 629 | | - if ($attribute =~ /^Bar$/i) |
| 630 | | - { |
| 631 | | - $bar = $attrvalue ; |
| 632 | | - } |
| 633 | | - elsif ($attribute =~ /^BarSet$/i) |
| 634 | | - { |
| 635 | | - $barset = $attrvalue ; |
| 636 | | - } |
| 637 | | - # elsif ($attribute =~ /^BarCount$/i) |
| 638 | | - # { |
| 639 | | - # $barcount = $attrvalue ; |
| 640 | | - # if (($barcount !~ /^\d?\d?\d$/) || ($barcount < 2) || ($barcount > 200)) |
| 641 | | - # { &Error ("BarData attribute 'barcount' invalid. Specify a number between 2 and 200\n") ; |
| 642 | | - # &GetData ; next BarData ; } |
| 643 | | - # } |
| 644 | | - elsif ($attribute =~ /^Text$/i) |
| 645 | | - { |
| 646 | | - $text = $attrvalue ; |
| 647 | | - $text =~ s/\\n/~/gs ; |
| 648 | | - if ($text =~ /\~/) |
| 649 | | - { &Warning ("BarData attribute 'text' contains ~ (tilde).\n" . |
| 650 | | - "Tilde will not be translated into newline character (only in PlotData)") ; } |
| 651 | | - if ($text =~ /\^/) |
| 652 | | - { &Warning ("BarData attribute 'text' contains ^ (caret).\n" . |
| 653 | | - "Caret will not be translated into tab character (only in PlotData)") ; } |
| 654 | | - } |
| 655 | | - elsif ($attribute =~ /^Link$/i) |
| 656 | | - { |
| 657 | | - $link = &ParseText ($attrvalue) ; |
| | 667 | + if ($attribute =~ /^Bar$/i) { |
| | 668 | + $bar = $attrvalue; |
| | 669 | + } |
| | 670 | + elsif ($attribute =~ /^BarSet$/i) { |
| | 671 | + $barset = $attrvalue; |
| | 672 | + } |
| 658 | 673 | |
| 659 | | - if ($link =~ /\[.*\]/) |
| 660 | | - { &Error ("BarData attribute 'link' contains implicit (wiki style) link.\n" . |
| 661 | | - "Use implicit link style with attribute 'text' only.\n") ; |
| 662 | | - &GetData ; next BarData ; } |
| | 674 | + # elsif ($attribute =~ /^BarCount$/i) |
| | 675 | + # { |
| | 676 | + # $barcount = $attrvalue ; |
| | 677 | + # if (($barcount !~ /^\d?\d?\d$/) || ($barcount < 2) || ($barcount > 200)) |
| | 678 | + # { &Error ("BarData attribute 'barcount' invalid. Specify a number between 2 and 200\n") ; |
| | 679 | + # &GetData ; next BarData ; } |
| | 680 | + # } |
| | 681 | + elsif ($attribute =~ /^Text$/i) { |
| | 682 | + $text = $attrvalue; |
| | 683 | + $text =~ s/\\n/~/gs; |
| | 684 | + if ($text =~ /\~/) { |
| | 685 | + &Warning( "BarData attribute 'text' contains ~ (tilde).\n" |
| | 686 | + . "Tilde will not be translated into newline character (only in PlotData)" |
| | 687 | + ); |
| | 688 | + } |
| | 689 | + if ($text =~ /\^/) { |
| | 690 | + &Warning( "BarData attribute 'text' contains ^ (caret).\n" |
| | 691 | + . "Caret will not be translated into tab character (only in PlotData)" |
| | 692 | + ); |
| | 693 | + } |
| | 694 | + } |
| | 695 | + elsif ($attribute =~ /^Link$/i) { |
| | 696 | + $link = &ParseText($attrvalue); |
| 663 | 697 | |
| 664 | | - $link = &EncodeURL (&NormalizeURL ($link)) ; |
| | 698 | + if ($link =~ /\[.*\]/) { |
| | 699 | + &Error( |
| | 700 | + "BarData attribute 'link' contains implicit (wiki style) link.\n" |
| | 701 | + . "Use implicit link style with attribute 'text' only.\n" |
| | 702 | + ); |
| | 703 | + &GetData; |
| | 704 | + next BarData; |
| | 705 | + } |
| 665 | 706 | |
| 666 | | - $MapPNG = $true ; |
| 667 | | - } |
| 668 | | - } |
| | 707 | + $link = &EncodeURL(&NormalizeURL($link)); |
| 669 | 708 | |
| 670 | | - if (($bar eq "") && ($barset eq "")) |
| 671 | | - { &Error ("BarData attribute missing. Specify either 'bar' of 'barset'.\n") ; |
| 672 | | - &GetData ; next BarData ; } |
| | 709 | + $MapPNG = $true; |
| | 710 | + } |
| | 711 | + } |
| 673 | 712 | |
| 674 | | - if (($bar ne "") && ($barset ne "")) |
| 675 | | - { &Error ("BarData attributes 'bar' and 'barset' are mutually exclusive.\nSpecify one of these per data line\n") ; |
| 676 | | - &GetData ; next BarData ; } |
| | 713 | + if (($bar eq "") && ($barset eq "")) { |
| | 714 | + &Error( |
| | 715 | + "BarData attribute missing. Specify either 'bar' of 'barset'.\n" |
| | 716 | + ); |
| | 717 | + &GetData; |
| | 718 | + next BarData; |
| | 719 | + } |
| 677 | 720 | |
| 678 | | - # if (($barset ne "") && ($barcount eq "")) |
| 679 | | - # { &Error ("BarData attribute 'barset' specified without attribute 'barcount'.\n") ; |
| 680 | | - # &GetData ; next BarData ; } |
| | 721 | + if (($bar ne "") && ($barset ne "")) { |
| | 722 | + &Error( |
| | 723 | + "BarData attributes 'bar' and 'barset' are mutually exclusive.\nSpecify one of these per data line\n" |
| | 724 | + ); |
| | 725 | + &GetData; |
| | 726 | + next BarData; |
| | 727 | + } |
| 681 | 728 | |
| 682 | | - # if (($barset eq "") && ($barcount ne "")) |
| 683 | | - # { &Error ("BarData attribute 'barcount' specified without attribute 'barset'.\n") ; |
| 684 | | - # &GetData ; next BarData ; } |
| | 729 | + # if (($barset ne "") && ($barcount eq "")) |
| | 730 | + # { &Error ("BarData attribute 'barset' specified without attribute 'barcount'.\n") ; |
| | 731 | + # &GetData ; next BarData ; } |
| 685 | 732 | |
| 686 | | - if (($barset ne "") && ($link ne "")) |
| 687 | | - { &Error ("BarData attribute 'link' not valid in combination with attribute 'barset'.\n") ; |
| 688 | | - &GetData ; next BarData ; } |
| | 733 | + # if (($barset eq "") && ($barcount ne "")) |
| | 734 | + # { &Error ("BarData attribute 'barcount' specified without attribute 'barset'.\n") ; |
| | 735 | + # &GetData ; next BarData ; } |
| 689 | 736 | |
| 690 | | - if ($link ne "") |
| 691 | | - { |
| 692 | | - if ($text =~ /\[.*\]/) |
| 693 | | - { |
| 694 | | - &Warning ("BarData contains implicit link(s) in attribute 'text' and explicit attribute 'link'.\n" . |
| 695 | | - "Implicit link(s) ignored.") ; |
| 696 | | - $text =~ s/\[+ (?:[^\|]* \|)? ([^\]]*) \]+/$1/gx ; |
| 697 | | - } |
| | 737 | + if (($barset ne "") && ($link ne "")) { |
| | 738 | + &Error( |
| | 739 | + "BarData attribute 'link' not valid in combination with attribute 'barset'.\n" |
| | 740 | + ); |
| | 741 | + &GetData; |
| | 742 | + next BarData; |
| | 743 | + } |
| 698 | 744 | |
| 699 | | - if ($hint eq "") |
| 700 | | - { $hint = &ExternalLinkToHint ($link) ; } |
| 701 | | - } |
| | 745 | + if ($link ne "") { |
| | 746 | + if ($text =~ /\[.*\]/) { |
| | 747 | + &Warning( |
| | 748 | + "BarData contains implicit link(s) in attribute 'text' and explicit attribute 'link'.\n" |
| | 749 | + . "Implicit link(s) ignored."); |
| | 750 | + $text =~ s/\[+ (?:[^\|]* \|)? ([^\]]*) \]+/$1/gx; |
| | 751 | + } |
| 702 | 752 | |
| 703 | | - if (($bar ne "") && ($bar !~ /[a-zA-Z0-9\_]+/)) |
| 704 | | - { &Error ("BarData attribute bar:'$bar' invalid.\nUse only characters 'a'-'z', 'A'-'Z', '0'-'9', '_'\n") ; |
| 705 | | - &GetData ; next BarData ; } |
| | 753 | + if ($hint eq "") { $hint = &ExternalLinkToHint($link); } |
| | 754 | + } |
| 706 | 755 | |
| 707 | | - if ($bar ne "") |
| 708 | | - { |
| 709 | | - if (@Axis {"time"} eq "x") |
| 710 | | - { push @Bars, $bar ; } |
| 711 | | - else |
| 712 | | - { unshift @Bars, $bar ; } |
| | 756 | + if (($bar ne "") && ($bar !~ /[a-zA-Z0-9\_]+/)) { |
| | 757 | + &Error( |
| | 758 | + "BarData attribute bar:'$bar' invalid.\nUse only characters 'a'-'z', 'A'-'Z', '0'-'9', '_'\n" |
| | 759 | + ); |
| | 760 | + &GetData; |
| | 761 | + next BarData; |
| | 762 | + } |
| 713 | 763 | |
| 714 | | - if ($text ne "") |
| 715 | | - { @BarLegend {lc ($bar)} = $text ; } |
| 716 | | - else |
| 717 | | - { @BarLegend {lc ($bar)} = " " ; } |
| | 764 | + if ($bar ne "") { |
| | 765 | + if (@Axis{"time"} eq "x") { push @Bars, $bar; } |
| | 766 | + else { unshift @Bars, $bar; } |
| 718 | 767 | |
| 719 | | - if ($link ne "") |
| 720 | | - { @BarLink {lc ($bar)} = $link ; } |
| 721 | | - } |
| 722 | | - else |
| 723 | | - { |
| 724 | | -# for ($b = 1 ; $b <= $barcount ; $b++) |
| 725 | | -# { |
| 726 | | -# $bar = $barset . "#" . $b ; |
| | 768 | + if ($text ne "") { @BarLegend{ lc($bar) } = $text; } |
| | 769 | + else { @BarLegend{ lc($bar) } = " "; } |
| 727 | 770 | |
| 728 | | - $bar = $barset . "#1" ; |
| 729 | | - if (@Axis {"time"} eq "x") |
| 730 | | - { push @Bars, $bar ; } |
| 731 | | - else |
| 732 | | - { unshift @Bars, $bar ; } |
| | 771 | + if ($link ne "") { @BarLink{ lc($bar) } = $link; } |
| | 772 | + } |
| | 773 | + else { |
| 733 | 774 | |
| 734 | | - if ($text ne "") |
| 735 | | - { @BarLegend {lc ($bar)} = $text . " - " . $b ; } |
| 736 | | - else |
| 737 | | - { @BarLegend {lc ($bar)} = " " ; } |
| 738 | | -# } |
| 739 | | - } |
| | 775 | + # for ($b = 1 ; $b <= $barcount ; $b++) |
| | 776 | + # { |
| | 777 | + # $bar = $barset . "#" . $b ; |
| 740 | 778 | |
| | 779 | + $bar = $barset . "#1"; |
| | 780 | + if (@Axis{"time"} eq "x") { push @Bars, $bar; } |
| | 781 | + else { unshift @Bars, $bar; } |
| 741 | 782 | |
| 742 | | - &GetData ; |
| 743 | | - } |
| | 783 | + if ($text ne "") { @BarLegend{ lc($bar) } = $text . " - " . $b; } |
| | 784 | + else { @BarLegend{ lc($bar) } = " "; } |
| | 785 | + |
| | 786 | + # } |
| | 787 | + } |
| | 788 | + |
| | 789 | + &GetData; |
| | 790 | + } |
| 744 | 791 | } |
| 745 | 792 | |
| 746 | | -sub ParseColors |
| 747 | | -{ |
| | 793 | +sub ParseColors { |
| 748 | 794 | |
| 749 | | - &GetData ; |
| 750 | | - if ($NoData) |
| 751 | | - { &Error ("Data expected for command 'Colors', but line is not indented.\n") ; return ; } |
| | 795 | + &GetData; |
| | 796 | + if ($NoData) { |
| | 797 | + &Error( |
| | 798 | + "Data expected for command 'Colors', but line is not indented.\n" |
| | 799 | + ); |
| | 800 | + return; |
| | 801 | + } |
| 752 | 802 | |
| 753 | | - Colors: |
| 754 | | - while ((! $InputParsed) && (! $NoData)) |
| 755 | | - { |
| 756 | | - if (! &ValidAttributes ("Colors")) |
| 757 | | - { &GetData ; next ;} |
| | 803 | + Colors: |
| | 804 | + while ((!$InputParsed) && (!$NoData)) { |
| | 805 | + if (!&ValidAttributes("Colors")) { &GetData; next; } |
| 758 | 806 | |
| 759 | | - &CheckPreset ("Colors") ; |
| | 807 | + &CheckPreset("Colors"); |
| 760 | 808 | |
| 761 | | - my $addtolegend = $false ; |
| 762 | | - my $legendvalue = "" ; |
| 763 | | - my $colorvalue = "" ; |
| | 809 | + my $addtolegend = $false; |
| | 810 | + my $legendvalue = ""; |
| | 811 | + my $colorvalue = ""; |
| 764 | 812 | |
| 765 | | - foreach $attribute (keys %Attributes) |
| 766 | | - { |
| 767 | | - my $attrvalue = @Attributes {$attribute} ; |
| | 813 | + foreach $attribute (keys %Attributes) { |
| | 814 | + my $attrvalue = @Attributes{$attribute}; |
| 768 | 815 | |
| 769 | | - if ($attribute =~ /Id/i) |
| 770 | | - { |
| 771 | | - $colorname = $attrvalue ; |
| 772 | | - } |
| 773 | | - elsif ($attribute =~ /Legend/i) |
| 774 | | - { |
| 775 | | - $addtolegend = $true ; |
| 776 | | - $legendvalue = $attrvalue ; |
| 777 | | - if ($legendvalue =~ /^[yY]$/) |
| 778 | | - { push @LegendData, $colorname ; } |
| 779 | | - elsif (! ($attrvalue =~ /^[nN]$/)) |
| 780 | | - { |
| 781 | | - $legendvalue = &ParseText ($legendvalue) ; |
| 782 | | - push @LegendData, $legendvalue ; |
| | 816 | + if ($attribute =~ /Id/i) { |
| | 817 | + $colorname = $attrvalue; |
| | 818 | + } |
| | 819 | + elsif ($attribute =~ /Legend/i) { |
| | 820 | + $addtolegend = $true; |
| | 821 | + $legendvalue = $attrvalue; |
| | 822 | + if ($legendvalue =~ /^[yY]$/) { |
| | 823 | + push @LegendData, $colorname; |
| | 824 | + } |
| | 825 | + elsif (!($attrvalue =~ /^[nN]$/)) { |
| | 826 | + $legendvalue = &ParseText($legendvalue); |
| | 827 | + push @LegendData, $legendvalue; |
| | 828 | + } |
| | 829 | + } |
| | 830 | + elsif ($attribute =~ /Value/i) { |
| | 831 | + $colorvalue = $attrvalue; |
| | 832 | + if ($colorvalue =~ /^white$/i) { |
| | 833 | + $colorvalue = "gray" . $hBrO . "0.999" . $hBrC; |
| | 834 | + } |
| | 835 | + } |
| 783 | 836 | } |
| 784 | | - } |
| 785 | | - elsif ($attribute =~ /Value/i) |
| 786 | | - { |
| 787 | | - $colorvalue = $attrvalue ; |
| 788 | | - if ($colorvalue =~ /^white$/i) |
| 789 | | - { $colorvalue = "gray" . $hBrO . "0.999" . $hBrC ; } |
| 790 | | - } |
| 791 | | - } |
| 792 | 837 | |
| 793 | | - if (&ColorPredefined ($colorvalue)) |
| 794 | | - { |
| 795 | | - &StoreColor ($colorname, $colorvalue, $legendvalue) ; |
| 796 | | - &GetData ; next Colors ; |
| 797 | | - } |
| | 838 | + if (&ColorPredefined($colorvalue)) { |
| | 839 | + &StoreColor($colorname, $colorvalue, $legendvalue); |
| | 840 | + &GetData; |
| | 841 | + next Colors; |
| | 842 | + } |
| 798 | 843 | |
| 799 | | - if ($colorvalue =~ /^[a-z]+$/i) |
| 800 | | - { |
| 801 | | - if (! ($colorvalue =~ /^(?:gray|rgb|hsb)/i)) |
| 802 | | - { &Error ("Color value invalid: unknown constant '$colorvalue'.") ; |
| 803 | | - &GetData ; next Colors ; } |
| 804 | | - } |
| | 844 | + if ($colorvalue =~ /^[a-z]+$/i) { |
| | 845 | + if (!($colorvalue =~ /^(?:gray|rgb|hsb)/i)) { |
| | 846 | + &Error( |
| | 847 | + "Color value invalid: unknown constant '$colorvalue'."); |
| | 848 | + &GetData; |
| | 849 | + next Colors; |
| | 850 | + } |
| | 851 | + } |
| 805 | 852 | |
| 806 | | - if (! ($colorvalue =~ /^(?:gray|rgb|hsb) $hBrO .+? $hBrC/xi)) |
| 807 | | - { &Error ("Color value invalid. Specify constant or 'gray/rgb/hsb(numeric values)' ") ; |
| 808 | | - &GetData ; next Colors ; } |
| | 853 | + if (!($colorvalue =~ /^(?:gray|rgb|hsb) $hBrO .+? $hBrC/xi)) { |
| | 854 | + &Error( |
| | 855 | + "Color value invalid. Specify constant or 'gray/rgb/hsb(numeric values)' " |
| | 856 | + ); |
| | 857 | + &GetData; |
| | 858 | + next Colors; |
| | 859 | + } |
| 809 | 860 | |
| 810 | | - if ($colorvalue =~ /^gray/i) |
| 811 | | - { |
| 812 | | - if ($colorvalue =~ /gray $hBrO (?:0|1|0\.\d+) $hBrC/xi) |
| 813 | | - { &StoreColor ($colorname, $colorvalue, $legendvalue) ; } |
| 814 | | - else |
| 815 | | - { &Error ("Color value invalid. Specify 'gray(x) where 0 <= x <= 1' ") ; } |
| | 861 | + if ($colorvalue =~ /^gray/i) { |
| | 862 | + if ($colorvalue =~ /gray $hBrO (?:0|1|0\.\d+) $hBrC/xi) { |
| | 863 | + &StoreColor($colorname, $colorvalue, $legendvalue); |
| | 864 | + } |
| | 865 | + else { |
| | 866 | + &Error( |
| | 867 | + "Color value invalid. Specify 'gray(x) where 0 <= x <= 1' " |
| | 868 | + ); |
| | 869 | + } |
| 816 | 870 | |
| 817 | | - &GetData ; next Colors ; |
| 818 | | - } |
| | 871 | + &GetData; |
| | 872 | + next Colors; |
| | 873 | + } |
| 819 | 874 | |
| 820 | | - if ($colorvalue =~ /^rgb/i) |
| 821 | | - { |
| 822 | | - my $colormode = substr ($colorvalue,0,3) ; |
| 823 | | - if ($colorvalue =~ /rgb $hBrO |
| | 875 | + if ($colorvalue =~ /^rgb/i) { |
| | 876 | + my $colormode = substr($colorvalue, 0, 3); |
| | 877 | + if ( |
| | 878 | + $colorvalue =~ /rgb $hBrO |
| 824 | 879 | (?:0|1|0\.\d+) \, |
| 825 | 880 | (?:0|1|0\.\d+) \, |
| 826 | 881 | (?:0|1|0\.\d+) |
| 827 | | - $hBrC/xi) |
| 828 | | - { &StoreColor ($colorname, $colorvalue, $legendvalue) ; } |
| 829 | | - else |
| 830 | | - { &Error ("Color value invalid. Specify 'rgb(r,g,b) where 0 <= r,g,b <= 1' ") ; } |
| | 882 | + $hBrC/xi |
| | 883 | + ) |
| | 884 | + { |
| | 885 | + &StoreColor($colorname, $colorvalue, $legendvalue); |
| | 886 | + } |
| | 887 | + else { |
| | 888 | + &Error( |
| | 889 | + "Color value invalid. Specify 'rgb(r,g,b) where 0 <= r,g,b <= 1' " |
| | 890 | + ); |
| | 891 | + } |
| 831 | 892 | |
| 832 | | - &GetData ; next Colors ; |
| 833 | | - } |
| | 893 | + &GetData; |
| | 894 | + next Colors; |
| | 895 | + } |
| 834 | 896 | |
| 835 | | - if ($colorvalue =~ /^hsb/i) |
| 836 | | - { |
| 837 | | - my $colormode = substr ($colorvalue,0,3) ; |
| 838 | | - if ($colorvalue =~ /hsb $hBrO |
| | 897 | + if ($colorvalue =~ /^hsb/i) { |
| | 898 | + my $colormode = substr($colorvalue, 0, 3); |
| | 899 | + if ( |
| | 900 | + $colorvalue =~ /hsb $hBrO |
| 839 | 901 | (?:0|1|0\.\d+) \, |
| 840 | 902 | (?:0|1|0\.\d+) \, |
| 841 | 903 | (?:0|1|0\.\d+) |
| 842 | | - $hBrC/xi) |
| 843 | | - { &StoreColor ($colorname, $colorvalue, $legendvalue) ; } |
| 844 | | - else |
| 845 | | - { &Error ("Color value invalid. Specify 'hsb(h,s,b) where 0 <= h,s,b <= 1' ") ; } |
| | 904 | + $hBrC/xi |
| | 905 | + ) |
| | 906 | + { |
| | 907 | + &StoreColor($colorname, $colorvalue, $legendvalue); |
| | 908 | + } |
| | 909 | + else { |
| | 910 | + &Error( |
| | 911 | + "Color value invalid. Specify 'hsb(h,s,b) where 0 <= h,s,b <= 1' " |
| | 912 | + ); |
| | 913 | + } |
| 846 | 914 | |
| 847 | | - &GetData ; next Colors ; |
| | 915 | + &GetData; |
| | 916 | + next Colors; |
| | 917 | + } |
| | 918 | + |
| | 919 | + &Error("Color value invalid."); |
| | 920 | + &GetData; |
| 848 | 921 | } |
| 849 | | - |
| 850 | | - &Error ("Color value invalid.") ; |
| 851 | | - &GetData ; |
| 852 | | - } |
| 853 | 922 | } |
| 854 | 923 | |
| 855 | | -sub StoreColor |
| 856 | | -{ |
| 857 | | - my $colorname = shift ; |
| 858 | | - my $colorvalue = shift ; |
| 859 | | - my $legendvalue = shift ; |
| 860 | | - if (defined (@Colors {lc ($colorname)})) |
| 861 | | - { &Warning ("Color '$colorname' redefined.") ; } |
| 862 | | - @Colors {lc ($colorname)} = lc ($colorvalue) ; |
| 863 | | - if ((defined ($legendvalue)) && ($legendvalue ne "")) |
| 864 | | - { @ColorLabels {lc ($colorname)} = $legendvalue ; } |
| | 924 | +sub StoreColor { |
| | 925 | + my $colorname = shift; |
| | 926 | + my $colorvalue = shift; |
| | 927 | + my $legendvalue = shift; |
| | 928 | + if (defined(@Colors{ lc($colorname) })) { |
| | 929 | + &Warning("Color '$colorname' redefined."); |
| | 930 | + } |
| | 931 | + @Colors{ lc($colorname) } = lc($colorvalue); |
| | 932 | + if ((defined($legendvalue)) && ($legendvalue ne "")) { |
| | 933 | + @ColorLabels{ lc($colorname) } = $legendvalue; |
| | 934 | + } |
| 865 | 935 | } |
| 866 | 936 | |
| 867 | | -sub ParseDateFormat |
| 868 | | -{ |
| 869 | | - &CheckPreset ("DateFormat") ; |
| | 937 | +sub ParseDateFormat { |
| | 938 | + &CheckPreset("DateFormat"); |
| 870 | 939 | |
| 871 | | - my $datevalue = lc (@Attributes {"single"}) ; |
| 872 | | - $datevalue =~ s/\s//g ; |
| 873 | | - $datevalue = lc ($datevalue) ; |
| 874 | | - if (($datevalue ne "dd/mm/yyyy") && ($datevalue ne "mm/dd/yyyy") && ($datevalue ne "yyyy") && ($datevalue ne "x.y")) |
| 875 | | - { &Error ("Invalid DateFormat. Specify as 'dd/mm/yyyy', 'mm/dd/yyyy', 'yyyy' or 'x.y'\n" . |
| 876 | | - " (use first two only for years >= 1800)\n") ; return ; } |
| | 940 | + my $datevalue = lc(@Attributes{"single"}); |
| | 941 | + $datevalue =~ s/\s//g; |
| | 942 | + $datevalue = lc($datevalue); |
| | 943 | + if ( ($datevalue ne "dd/mm/yyyy") |
| | 944 | + && ($datevalue ne "mm/dd/yyyy") |
| | 945 | + && ($datevalue ne "yyyy") |
| | 946 | + && ($datevalue ne "x.y")) |
| | 947 | + { |
| | 948 | + &Error( |
| | 949 | + "Invalid DateFormat. Specify as 'dd/mm/yyyy', 'mm/dd/yyyy', 'yyyy' or 'x.y'\n" |
| | 950 | + . " (use first two only for years >= 1800)\n"); |
| | 951 | + return; |
| | 952 | + } |
| 877 | 953 | |
| 878 | | - $DateFormat = $datevalue ; |
| | 954 | + $DateFormat = $datevalue; |
| 879 | 955 | } |
| 880 | 956 | |
| 881 | | -sub ParseDefine |
| 882 | | -{ |
| 883 | | - my $command = $Command ; |
| 884 | | - my $command2 = $command ; |
| 885 | | - $command2 =~ s/^Define\s*//i ; |
| | 957 | +sub ParseDefine { |
| | 958 | + my $command = $Command; |
| | 959 | + my $command2 = $command; |
| | 960 | + $command2 =~ s/^Define\s*//i; |
| 886 | 961 | |
| 887 | | - my ($name, $value) = split ($hIs, $command2) ; |
| 888 | | - $name =~ s/^\s*(.*?)\s*$/$1/g ; |
| 889 | | - $value =~ s/^\s*(.*?)\s*$/$1/g ; |
| | 962 | + my ($name, $value) = split($hIs, $command2); |
| | 963 | + $name =~ s/^\s*(.*?)\s*$/$1/g; |
| | 964 | + $value =~ s/^\s*(.*?)\s*$/$1/g; |
| 890 | 965 | |
| 891 | | - if (! ($name =~ /^$hDollar/)) |
| 892 | | - { &Error ("Define '$name' invalid. Name does not start with '\$'.") ; return ; } |
| 893 | | - if (! ($name =~ /^$hDollar[a-zA-Z0-9\_]+$/)) |
| 894 | | - { &Error ("Define '$name' invalid. Valid characters are 'a'-'z', 'A'-'Z', '0'-'9', '_'.") ; return ; } |
| | 966 | + if (!($name =~ /^$hDollar/)) { |
| | 967 | + &Error("Define '$name' invalid. Name does not start with '\$'."); |
| | 968 | + return; |
| | 969 | + } |
| | 970 | + if (!($name =~ /^$hDollar[a-zA-Z0-9\_]+$/)) { |
| | 971 | + &Error( |
| | 972 | + "Define '$name' invalid. Valid characters are 'a'-'z', 'A'-'Z', '0'-'9', '_'." |
| | 973 | + ); |
| | 974 | + return; |
| | 975 | + } |
| 895 | 976 | |
| 896 | | - $value =~ s/($hDollar[a-zA-Z0-9]+)/&GetDefine($command,$1)/ge ; |
| 897 | | - @Consts {lc ($name)} = $value ; |
| | 977 | + $value =~ s/($hDollar[a-zA-Z0-9]+)/&GetDefine($command,$1)/ge; |
| | 978 | + @Consts{ lc($name) } = $value; |
| 898 | 979 | } |
| 899 | 980 | |
| 900 | | -sub ParseLineData |
| 901 | | -{ |
| 902 | | - &GetData ; |
| 903 | | - if ($NoData) |
| 904 | | - { &Error ("Data expected for command 'LineData', but line is not indented.\n") ; return ; } |
| | 981 | +sub ParseLineData { |
| | 982 | + &GetData; |
| | 983 | + if ($NoData) { |
| | 984 | + &Error( |
| | 985 | + "Data expected for command 'LineData', but line is not indented.\n" |
| | 986 | + ); |
| | 987 | + return; |
| | 988 | + } |
| 905 | 989 | |
| 906 | | - if ((! (defined ($DateFormat))) || (! (defined (@Period {"from"})))) |
| 907 | | - { |
| 908 | | - if (! (defined ($DateFormat))) |
| 909 | | - { &Error ("LineData invalid. No (valid) command 'DateFormat' specified in previous lines.") ; } |
| 910 | | - else |
| 911 | | - { &Error ("LineData invalid. No (valid) command 'Period' specified in previous lines.") ; } |
| | 990 | + if ((!(defined($DateFormat))) || (!(defined(@Period{"from"})))) { |
| | 991 | + if (!(defined($DateFormat))) { |
| | 992 | + &Error( |
| | 993 | + "LineData invalid. No (valid) command 'DateFormat' specified in previous lines." |
| | 994 | + ); |
| | 995 | + } |
| | 996 | + else { |
| | 997 | + &Error( |
| | 998 | + "LineData invalid. No (valid) command 'Period' specified in previous lines." |
| | 999 | + ); |
| | 1000 | + } |
| 912 | 1001 | |
| 913 | | - while ((! $InputParsed) && (! $NoData)) |
| 914 | | - { &GetData ; } |
| 915 | | - return ; |
| 916 | | - } |
| | 1002 | + while ((!$InputParsed) && (!$NoData)) { &GetData; } |
| | 1003 | + return; |
| | 1004 | + } |
| 917 | 1005 | |
| 918 | | - my ($at, $from, $till, $atpos, $frompos, $tillpos, $color, $layer, $width, $points, $explanation) ; |
| | 1006 | + my ( |
| | 1007 | + $at, $from, $till, $atpos, |
| | 1008 | + $frompos, $tillpos, $color, $layer, |
| | 1009 | + $width, $points, $explanation |
| | 1010 | + ); |
| 919 | 1011 | |
| 920 | | - $layer = "front" ; |
| 921 | | - $width = 2.0 ; |
| | 1012 | + $layer = "front"; |
| | 1013 | + $width = 2.0; |
| 922 | 1014 | |
| 923 | | - my $data2 = $data ; |
| | 1015 | + my $data2 = $data; |
| 924 | 1016 | |
| 925 | | - LineData: |
| 926 | | - while ((! $InputParsed) && (! $NoData)) |
| 927 | | - { |
| 928 | | - $at = "" ; $from = "" ; $till = "" ; $atpos = "" ; $frompos = "" ; $tillpos = "" ; $points = "" ; |
| | 1017 | + LineData: |
| | 1018 | + while ((!$InputParsed) && (!$NoData)) { |
| | 1019 | + $at = ""; |
| | 1020 | + $from = ""; |
| | 1021 | + $till = ""; |
| | 1022 | + $atpos = ""; |
| | 1023 | + $frompos = ""; |
| | 1024 | + $tillpos = ""; |
| | 1025 | + $points = ""; |
| 929 | 1026 | |
| 930 | | - &CheckPreset ("LineData") ; |
| | 1027 | + &CheckPreset("LineData"); |
| 931 | 1028 | |
| 932 | | - if (! &ValidAttributes ("LineData")) |
| 933 | | - { &GetData ; next ;} |
| | 1029 | + if (!&ValidAttributes("LineData")) { &GetData; next; } |
| 934 | 1030 | |
| 935 | | - if (defined (@LineDefs {"color"})) { $color = @LineDefs {"color"} ; } |
| 936 | | - if (defined (@LineDefs {"layer"})) { $layer = @LineDefs {"layer"} ; } |
| 937 | | - if (defined (@LineDefs {"width"})) { $width = @LineDefs {"width"} ; } |
| 938 | | - if (defined (@LineDefs {"frompos"})) { $frompos = @LineDefs {"frompos"} ; } |
| 939 | | - if (defined (@LineDefs {"tillpos"})) { $tillpos = @LineDefs {"tillpos"} ; } |
| 940 | | - if (defined (@LineDefs {"atpos"})) { $atpos = @LineDefs {"atpos"} ; } |
| | 1031 | + if (defined(@LineDefs{"color"})) { $color = @LineDefs{"color"}; } |
| | 1032 | + if (defined(@LineDefs{"layer"})) { $layer = @LineDefs{"layer"}; } |
| | 1033 | + if (defined(@LineDefs{"width"})) { $width = @LineDefs{"width"}; } |
| | 1034 | + if (defined(@LineDefs{"frompos"})) { |
| | 1035 | + $frompos = @LineDefs{"frompos"}; |
| | 1036 | + } |
| | 1037 | + if (defined(@LineDefs{"tillpos"})) { |
| | 1038 | + $tillpos = @LineDefs{"tillpos"}; |
| | 1039 | + } |
| | 1040 | + if (defined(@LineDefs{"atpos"})) { $atpos = @LineDefs{"atpos"}; } |
| 941 | 1041 | |
| 942 | | - foreach $attribute (keys %Attributes) |
| 943 | | - { |
| 944 | | - my $attrvalue = @Attributes {$attribute} ; |
| | 1042 | + foreach $attribute (keys %Attributes) { |
| | 1043 | + my $attrvalue = @Attributes{$attribute}; |
| 945 | 1044 | |
| 946 | | - if ($attribute =~ /^(?:At|From|Till)$/i) |
| 947 | | - { |
| 948 | | - if ($attrvalue =~ /^Start$/i) |
| 949 | | - { $attrvalue = @Period {"from"} ; } |
| | 1045 | + if ($attribute =~ /^(?:At|From|Till)$/i) { |
| | 1046 | + if ($attrvalue =~ /^Start$/i) { |
| | 1047 | + $attrvalue = @Period{"from"}; |
| | 1048 | + } |
| 950 | 1049 | |
| 951 | | - if ($attrvalue =~ /^End$/i) |
| 952 | | - { $attrvalue = @Period {"till"} ; } |
| | 1050 | + if ($attrvalue =~ /^End$/i) { $attrvalue = @Period{"till"}; } |
| 953 | 1051 | |
| 954 | | - if (! &ValidDateFormat ($attrvalue)) |
| 955 | | - { &Error ("LineData attribute '$attribute' invalid.\n" . |
| 956 | | - "Date does not conform to specified DateFormat '$DateFormat'.") ; |
| 957 | | - &GetData ; next LineData ; } |
| | 1052 | + if (!&ValidDateFormat($attrvalue)) { |
| | 1053 | + &Error( "LineData attribute '$attribute' invalid.\n" |
| | 1054 | + . "Date does not conform to specified DateFormat '$DateFormat'." |
| | 1055 | + ); |
| | 1056 | + &GetData; |
| | 1057 | + next LineData; |
| | 1058 | + } |
| 958 | 1059 | |
| 959 | | - if (! &ValidDateRange ($attrvalue)) |
| 960 | | - { &Error ("LineData attribute '$attribute' invalid.\n" . |
| 961 | | - "Date '$attrvalue' not within range as specified by command Period.") ; |
| 962 | | - &GetData ; next LineData ; } |
| | 1060 | + if (!&ValidDateRange($attrvalue)) { |
| | 1061 | + &Error( "LineData attribute '$attribute' invalid.\n" |
| | 1062 | + . "Date '$attrvalue' not within range as specified by command Period." |
| | 1063 | + ); |
| | 1064 | + &GetData; |
| | 1065 | + next LineData; |
| | 1066 | + } |
| 963 | 1067 | |
| 964 | | -# if (substr ($attrvalue,6,4) < 1800) |
| 965 | | -# { &Error ("LineData attribute '$attribute' invalid. Specify year >= 1800.") ; |
| 966 | | -# &GetData ; next LineData ; } |
| | 1068 | + # if (substr ($attrvalue,6,4) < 1800) |
| | 1069 | + # { &Error ("LineData attribute '$attribute' invalid. Specify year >= 1800.") ; |
| | 1070 | + # &GetData ; next LineData ; } |
| 967 | 1071 | |
| 968 | | - if ($attribute =~ /At/i) |
| 969 | | - { |
| 970 | | - $at = $attrvalue ; $from = "" ; $till = "" ; } |
| 971 | | - elsif ($attribute =~ /From/i) |
| 972 | | - { $from = $attrvalue ; $at = "" ; } |
| 973 | | - else |
| 974 | | - { $till = $attrvalue ; $at = "" ; } |
| 975 | | - } |
| 976 | | - elsif ($attribute =~ /^(?:atpos|frompos|tillpos)$/i) |
| 977 | | - { |
| 978 | | - if ($attrvalue =~ /^(?:Start|End)$/i) |
| 979 | | - { $attrvalue = lc ($attrvalue) ; } |
| 980 | | - elsif (! &ValidAbs ($attrvalue)) |
| 981 | | - { &Error ("LineData attribute '$attribute' invalid.\n" . |
| 982 | | - "Specify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ; |
| 983 | | - &GetData ; next LineData ; } |
| | 1072 | + if ($attribute =~ /At/i) { |
| | 1073 | + $at = $attrvalue; |
| | 1074 | + $from = ""; |
| | 1075 | + $till = ""; |
| | 1076 | + } |
| | 1077 | + elsif ($attribute =~ /From/i) { |
| | 1078 | + $from = $attrvalue; |
| | 1079 | + $at = ""; |
| | 1080 | + } |
| | 1081 | + else { $till = $attrvalue; $at = ""; } |
| | 1082 | + } |
| | 1083 | + elsif ($attribute =~ /^(?:atpos|frompos|tillpos)$/i) { |
| | 1084 | + if ($attrvalue =~ /^(?:Start|End)$/i) { |
| | 1085 | + $attrvalue = lc($attrvalue); |
| | 1086 | + } |
| | 1087 | + elsif (!&ValidAbs($attrvalue)) { |
| | 1088 | + &Error( "LineData attribute '$attribute' invalid.\n" |
| | 1089 | + . "Specify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'" |
| | 1090 | + ); |
| | 1091 | + &GetData; |
| | 1092 | + next LineData; |
| | 1093 | + } |
| 984 | 1094 | |
| 985 | | - if ($attribute =~ /atpos/i) |
| 986 | | - { $atpos = &Normalize ($attrvalue) ; } |
| 987 | | - elsif ($attribute =~ /frompos/i) |
| 988 | | - { $frompos = &Normalize ($attrvalue) ; } |
| 989 | | - else |
| 990 | | - { $tillpos = &Normalize ($attrvalue) ; } |
| 991 | | - } |
| 992 | | - elsif ($attribute =~ /Color/i) |
| 993 | | - { |
| 994 | | - if ((! &ColorPredefined ($attrvalue)) && (! defined (@Colors {lc ($attrvalue)}))) |
| 995 | | - { &Error ("LineData attribute '$attribute' invalid. Unknown color '$attrvalue'.\n" . |
| 996 | | - " Specify command 'Color' before this command.") ; |
| 997 | | - &GetData ; next LineData ; } |
| | 1095 | + if ($attribute =~ /atpos/i) { |
| | 1096 | + $atpos = &Normalize($attrvalue); |
| | 1097 | + } |
| | 1098 | + elsif ($attribute =~ /frompos/i) { |
| | 1099 | + $frompos = &Normalize($attrvalue); |
| | 1100 | + } |
| | 1101 | + else { $tillpos = &Normalize($attrvalue); } |
| | 1102 | + } |
| | 1103 | + elsif ($attribute =~ /Color/i) { |
| | 1104 | + if ( (!&ColorPredefined($attrvalue)) |
| | 1105 | + && (!defined(@Colors{ lc($attrvalue) }))) |
| | 1106 | + { |
| | 1107 | + &Error( |
| | 1108 | + "LineData attribute '$attribute' invalid. Unknown color '$attrvalue'.\n" |
| | 1109 | + . " Specify command 'Color' before this command." |
| | 1110 | + ); |
| | 1111 | + &GetData; |
| | 1112 | + next LineData; |
| | 1113 | + } |
| 998 | 1114 | |
| 999 | | - if (! &ColorPredefined ($attrvalue)) |
| 1000 | | - { $attrvalue = @Colors {lc ($attrvalue)} ; } |
| | 1115 | + if (!&ColorPredefined($attrvalue)) { |
| | 1116 | + $attrvalue = @Colors{ lc($attrvalue) }; |
| | 1117 | + } |
| 1001 | 1118 | |
| 1002 | | - $color = $attrvalue ; |
| 1003 | | - } |
| 1004 | | - elsif ($attribute =~ /Layer/i) |
| 1005 | | - { |
| 1006 | | - if (! ($attrvalue =~ /^(?:back|front)$/i)) |
| 1007 | | - { &Error ("LineData attribute '$attrvalue' invalid.\nSpecify back(default) or front") ; |
| 1008 | | - &GetData ; next LineData ; } |
| | 1119 | + $color = $attrvalue; |
| | 1120 | + } |
| | 1121 | + elsif ($attribute =~ /Layer/i) { |
| | 1122 | + if (!($attrvalue =~ /^(?:back|front)$/i)) { |
| | 1123 | + &Error( |
| | 1124 | + "LineData attribute '$attrvalue' invalid.\nSpecify back(default) or front" |
| | 1125 | + ); |
| | 1126 | + &GetData; |
| | 1127 | + next LineData; |
| | 1128 | + } |
| 1009 | 1129 | |
| 1010 | | - $layer = $attrvalue ; |
| 1011 | | - } |
| 1012 | | - elsif ($attribute =~ /Points/i) |
| 1013 | | - { |
| 1014 | | - $attribute =~ s/\s//g ; |
| | 1130 | + $layer = $attrvalue; |
| | 1131 | + } |
| | 1132 | + elsif ($attribute =~ /Points/i) { |
| | 1133 | + $attribute =~ s/\s//g; |
| 1015 | 1134 | |
| 1016 | | - if ($attrvalue !~ /^$hBrO\d+\,\d+$hBrC$hBrO\d+\,\d+$hBrC$/) |
| 1017 | | - { &Error ("LineData attribute '$attrvalue' invalid.\nSpecify 'points:(x1,y1)(x2,y2)'") ; |
| 1018 | | - &GetData ; next LineData ; } |
| | 1135 | + if ($attrvalue !~ /^$hBrO\d+\,\d+$hBrC$hBrO\d+\,\d+$hBrC$/) { |
| | 1136 | + &Error( |
| | 1137 | + "LineData attribute '$attrvalue' invalid.\nSpecify 'points:(x1,y1)(x2,y2)'" |
| | 1138 | + ); |
| | 1139 | + &GetData; |
| | 1140 | + next LineData; |
| | 1141 | + } |
| 1019 | 1142 | |
| 1020 | | - $attrvalue =~ s/^$hBrO(\d+)\,(\d+)$hBrC$hBrO(\d+)\,(\d+)$hBrC$/$1,$2,$3,$4/ ; |
| 1021 | | - $points = $attrvalue ; |
| 1022 | | - } |
| 1023 | | - elsif ($attribute =~ /Width/i) |
| 1024 | | - { |
| 1025 | | - if (! &ValidAbs ($attrvalue)) |
| 1026 | | - { &Error ("LineData attribute '$attribute' invalid.\n" . |
| 1027 | | - "Specify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ; |
| 1028 | | - &GetData ; next LineData ; } |
| | 1143 | + $attrvalue =~ |
| | 1144 | + s/^$hBrO(\d+)\,(\d+)$hBrC$hBrO(\d+)\,(\d+)$hBrC$/$1,$2,$3,$4/; |
| | 1145 | + $points = $attrvalue; |
| | 1146 | + } |
| | 1147 | + elsif ($attribute =~ /Width/i) { |
| | 1148 | + if (!&ValidAbs($attrvalue)) { |
| | 1149 | + &Error( "LineData attribute '$attribute' invalid.\n" |
| | 1150 | + . "Specify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'" |
| | 1151 | + ); |
| | 1152 | + &GetData; |
| | 1153 | + next LineData; |
| | 1154 | + } |
| 1029 | 1155 | |
| 1030 | | - if (($attrvalue < 0.1) || ($attrvalue > 10)) |
| 1031 | | - { &Error ("LineData attribute '$attribute' invalid.\n" . |
| 1032 | | - "Specify value as between 0.1 and 10") ; |
| 1033 | | - &GetData ; next LineData ; } |
| | 1156 | + if (($attrvalue < 0.1) || ($attrvalue > 10)) { |
| | 1157 | + &Error( "LineData attribute '$attribute' invalid.\n" |
| | 1158 | + . "Specify value as between 0.1 and 10"); |
| | 1159 | + &GetData; |
| | 1160 | + next LineData; |
| | 1161 | + } |
| 1034 | 1162 | |
| 1035 | | - $width = $attrvalue ; |
| 1036 | | - } |
| 1037 | | - } |
| | 1163 | + $width = $attrvalue; |
| | 1164 | + } |
| | 1165 | + } |
| 1038 | 1166 | |
| 1039 | | - if (($at eq "") && ($from eq "") && ($till eq "") && ($points eq "")) # upd defaults |
| 1040 | | - { |
| 1041 | | - if ($color ne "") { @LineDefs {"color"} = $color ; } |
| 1042 | | - if ($layer ne "") { @LineDefs {"layer"} = $layer ; } |
| 1043 | | - if ($width ne "") { @LineDefs {"width"} = $width ; } |
| 1044 | | - if ($atpos ne "") { @LineDefs {"atpos"} = $atpos ; } |
| 1045 | | - if ($frompos ne "") { @LineDefs {"frompos"} = $frompos ; } |
| 1046 | | - if ($tillpos ne "") { @LineDefs {"tillpos"} = $tillpos ; } |
| 1047 | | - } |
| | 1167 | + if ( ($at eq "") |
| | 1168 | + && ($from eq "") |
| | 1169 | + && ($till eq "") |
| | 1170 | + && ($points eq "")) # upd defaults |
| | 1171 | + { |
| | 1172 | + if ($color ne "") { @LineDefs{"color"} = $color; } |
| | 1173 | + if ($layer ne "") { @LineDefs{"layer"} = $layer; } |
| | 1174 | + if ($width ne "") { @LineDefs{"width"} = $width; } |
| | 1175 | + if ($atpos ne "") { @LineDefs{"atpos"} = $atpos; } |
| | 1176 | + if ($frompos ne "") { @LineDefs{"frompos"} = $frompos; } |
| | 1177 | + if ($tillpos ne "") { @LineDefs{"tillpos"} = $tillpos; } |
| | 1178 | + } |
| 1048 | 1179 | |
| 1049 | | - if ($layer eq "") |
| 1050 | | - { $layer = "back" ; } |
| | 1180 | + if ($layer eq "") { $layer = "back"; } |
| 1051 | 1181 | |
| 1052 | | - if ($color eq "") |
| 1053 | | - { $color = "black" ; } |
| | 1182 | + if ($color eq "") { $color = "black"; } |
| 1054 | 1183 | |
| 1055 | | - $explanation = "\nA line is defined as follows:\n" . |
| 1056 | | - " Perpendicular to the time axis: 'at frompos tillpos'\n" . |
| 1057 | | - " Parralel to the time axis: 'from till atpos'\n" . |
| 1058 | | - " Any direction: points(x1,y1)(x2,y2)\n" . |
| 1059 | | - " at,from,till expect date/time values, just like with command PlotData\n" . |
| 1060 | | - " frompos,tillpos,atpos,x1,x2,y1,y2 expect coordinates (e.g. pixels values)\n" ; |
| | 1184 | + $explanation = |
| | 1185 | + "\nA line is defined as follows:\n" |
| | 1186 | + . " Perpendicular to the time axis: 'at frompos tillpos'\n" |
| | 1187 | + . " Parralel to the time axis: 'from till atpos'\n" |
| | 1188 | + . " Any direction: points(x1,y1)(x2,y2)\n" |
| | 1189 | + . " at,from,till expect date/time values, just like with command PlotData\n" |
| | 1190 | + . " frompos,tillpos,atpos,x1,x2,y1,y2 expect coordinates (e.g. pixels values)\n"; |
| 1061 | 1191 | |
| 1062 | | - if (($at ne "") && (($from ne "") || ($till ne "") || ($points ne ""))) |
| 1063 | | - { &Error ("LineData attribute 'at' can not be combined with 'from', 'till' or 'points'\n" . $explanation) ; |
| 1064 | | - $explanation = "" ; |
| 1065 | | - &GetData ; next LineData ; } |
| | 1192 | + if ( ($at ne "") |
| | 1193 | + && (($from ne "") || ($till ne "") || ($points ne ""))) |
| | 1194 | + { |
| | 1195 | + &Error( |
| | 1196 | + "LineData attribute 'at' can not be combined with 'from', 'till' or 'points'\n" |
| | 1197 | + . $explanation); |
| | 1198 | + $explanation = ""; |
| | 1199 | + &GetData; |
| | 1200 | + next LineData; |
| | 1201 | + } |
| 1066 | 1202 | |
| 1067 | | - if ((($from ne "") && ($till eq "")) || (($from eq "") && ($till ne ""))) |
| 1068 | | - { &Error ("LineData attributes 'from' and 'till' should always be specified together\n" . $explanation) ; |
| 1069 | | - $explanation = "" ; |
| 1070 | | - &GetData ; next LineData ; } |
| | 1203 | + if ( (($from ne "") && ($till eq "")) |
| | 1204 | + || (($from eq "") && ($till ne ""))) |
| | 1205 | + { |
| | 1206 | + &Error( |
| | 1207 | + "LineData attributes 'from' and 'till' should always be specified together\n" |
| | 1208 | + . $explanation); |
| | 1209 | + $explanation = ""; |
| | 1210 | + &GetData; |
| | 1211 | + next LineData; |
| | 1212 | + } |
| 1071 | 1213 | |
| 1072 | | - if (($points ne "") && (($from ne "") || ($till ne "") || ($at ne ""))) |
| 1073 | | - { &Error ("LineData attribute 'points' can not be combined with 'at', 'from' or 'till'\n" . $explanation) ; |
| 1074 | | - $explanation = "" ; |
| 1075 | | - &GetData ; next LineData ; } |
| | 1214 | + if ( ($points ne "") |
| | 1215 | + && (($from ne "") || ($till ne "") || ($at ne ""))) |
| | 1216 | + { |
| | 1217 | + &Error( |
| | 1218 | + "LineData attribute 'points' can not be combined with 'at', 'from' or 'till'\n" |
| | 1219 | + . $explanation); |
| | 1220 | + $explanation = ""; |
| | 1221 | + &GetData; |
| | 1222 | + next LineData; |
| | 1223 | + } |
| 1076 | 1224 | |
| 1077 | | - if ($at ne "") |
| 1078 | | - { push @DrawLines, sprintf ("1|%s|%s|%s|%s|%s|%s\n", $at, $frompos, $tillpos, lc ($color), $width, lc ($layer)) ; } |
| | 1225 | + if ($at ne "") { |
| | 1226 | + push @DrawLines, |
| | 1227 | + sprintf("1|%s|%s|%s|%s|%s|%s\n", |
| | 1228 | + $at, $frompos, $tillpos, lc($color), $width, lc($layer)); |
| | 1229 | + } |
| 1079 | 1230 | |
| 1080 | | - if ($from ne "") |
| 1081 | | - { push @DrawLines, sprintf ("2|%s|%s|%s|%s|%s|%s\n", $atpos, $from, $till, lc ($color), $width, lc ($layer)) ; } |
| | 1231 | + if ($from ne "") { |
| | 1232 | + push @DrawLines, |
| | 1233 | + sprintf("2|%s|%s|%s|%s|%s|%s\n", |
| | 1234 | + $atpos, $from, $till, lc($color), $width, lc($layer)); |
| | 1235 | + } |
| 1082 | 1236 | |
| 1083 | | - if ($points ne "") |
| 1084 | | - { push @DrawLines, sprintf ("3|%s|%s|%s|%s\n", $points, lc ($color), $width, lc ($layer)) ; } |
| 1085 | | - &GetData ; |
| 1086 | | - } |
| | 1237 | + if ($points ne "") { |
| | 1238 | + push @DrawLines, |
| | 1239 | + sprintf("3|%s|%s|%s|%s\n", |
| | 1240 | + $points, lc($color), $width, lc($layer)); |
| | 1241 | + } |
| | 1242 | + &GetData; |
| | 1243 | + } |
| 1087 | 1244 | } |
| 1088 | 1245 | |
| 1089 | | -sub ParseImageSize |
| 1090 | | -{ |
| 1091 | | - if (! &ValidAttributes ("ImageSize")) { return ; } |
| | 1246 | +sub ParseImageSize { |
| | 1247 | + if (!&ValidAttributes("ImageSize")) { return; } |
| 1092 | 1248 | |
| 1093 | | - &CheckPreset ("ImageSize") ; |
| | 1249 | + &CheckPreset("ImageSize"); |
| 1094 | 1250 | |
| 1095 | | - foreach $attribute (keys %Attributes) |
| 1096 | | - { |
| 1097 | | - my $attrvalue = @Attributes {$attribute} ; |
| | 1251 | + foreach $attribute (keys %Attributes) { |
| | 1252 | + my $attrvalue = @Attributes{$attribute}; |
| 1098 | 1253 | |
| 1099 | | - if ($attribute =~ /Width|Height/i) |
| | 1254 | + if ($attribute =~ /Width|Height/i) { |
| | 1255 | + if ($attrvalue !~ /auto/i) { |
| | 1256 | + if (!&ValidAbs($attrvalue)) { |
| | 1257 | + &Error( "ImageSize attribute '$attribute' invalid.\n" |
| | 1258 | + . "Specify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'" |
| | 1259 | + ); |
| | 1260 | + return; |
| | 1261 | + } |
| | 1262 | + } |
| | 1263 | + } |
| | 1264 | + |
| | 1265 | + elsif ($attribute =~ /BarIncrement/i) { |
| | 1266 | + if (!&ValidAbs($attrvalue)) { |
| | 1267 | + &Error( "ImageSize attribute '$attribute' invalid.\n" |
| | 1268 | + . "Specify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'" |
| | 1269 | + ); |
| | 1270 | + return; |
| | 1271 | + } |
| | 1272 | + |
| | 1273 | + @Attributes{"barinc"} = $attrvalue; |
| | 1274 | + } |
| | 1275 | + |
| | 1276 | + # if ($attribute =~ /Width/i) |
| | 1277 | + # { @Attributes {"width"} = $attrvalue ; } |
| | 1278 | + # elsif ($attribute =~ /Height/i) |
| | 1279 | + # { @Attributes {"height"} = $attrvalue ; } |
| | 1280 | + } |
| | 1281 | + |
| | 1282 | + if ( (@Attributes{"width"} =~ /auto/i) |
| | 1283 | + || (@Attributes{"height"} =~ /auto/i)) |
| 1100 | 1284 | { |
| 1101 | | - if ($attrvalue !~ /auto/i) |
| 1102 | | - { |
| 1103 | | - if (! &ValidAbs ($attrvalue)) |
| 1104 | | - { &Error ("ImageSize attribute '$attribute' invalid.\n" . |
| 1105 | | - "Specify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ; return ; } |
| 1106 | | - } |
| | 1285 | + if (@Attributes{"barinc"} eq "") { |
| | 1286 | + &Error( "ImageSize attribute 'barincrement' missing.\n" |
| | 1287 | + . "Automatic determination of image width or height implies specification of this attribute" |
| | 1288 | + ); |
| | 1289 | + return; |
| | 1290 | + } |
| 1107 | 1291 | } |
| 1108 | 1292 | |
| 1109 | | - elsif ($attribute =~ /BarIncrement/i) |
| | 1293 | + if ( (@Attributes{"width"} !~ /auto/i) |
| | 1294 | + && (@Attributes{"height"} !~ /auto/i)) |
| 1110 | 1295 | { |
| 1111 | | - if (! &ValidAbs ($attrvalue)) |
| 1112 | | - { &Error ("ImageSize attribute '$attribute' invalid.\n" . |
| 1113 | | - "Specify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ; return ; } |
| 1114 | | - |
| 1115 | | - @Attributes {"barinc"} = $attrvalue ; |
| | 1296 | + if (@Attributes{"barinc"} ne "") { |
| | 1297 | + &Error( "ImageSize attribute 'barincrement' not valid now.\n" |
| | 1298 | + . "This attribute is only valid (and mandatory) in combination with 'width:auto' or 'height:auto'" |
| | 1299 | + ); |
| | 1300 | + return; |
| | 1301 | + } |
| 1116 | 1302 | } |
| 1117 | | -# if ($attribute =~ /Width/i) |
| 1118 | | -# { @Attributes {"width"} = $attrvalue ; } |
| 1119 | | -# elsif ($attribute =~ /Height/i) |
| 1120 | | -# { @Attributes {"height"} = $attrvalue ; } |
| 1121 | | - } |
| 1122 | 1303 | |
| 1123 | | - if ((@Attributes {"width"} =~ /auto/i) || (@Attributes {"height"} =~ /auto/i)) |
| 1124 | | - { |
| 1125 | | - if (@Attributes {"barinc"} eq "") |
| 1126 | | - { &Error ("ImageSize attribute 'barincrement' missing.\n" . |
| 1127 | | - "Automatic determination of image width or height implies specification of this attribute") ; return ; } |
| 1128 | | - } |
| | 1304 | + %Image = %Attributes; |
| | 1305 | +} |
| 1129 | 1306 | |
| 1130 | | - if ((@Attributes {"width"} !~ /auto/i) && (@Attributes {"height"} !~ /auto/i)) |
| 1131 | | - { |
| 1132 | | - if (@Attributes {"barinc"} ne "") |
| 1133 | | - { &Error ("ImageSize attribute 'barincrement' not valid now.\n" . |
| 1134 | | - "This attribute is only valid (and mandatory) in combination with 'width:auto' or 'height:auto'") ; return ; } |
| 1135 | | - } |
| | 1307 | +sub ParseLegend { |
| | 1308 | + if (!&ValidAttributes("Legend")) { return; } |
| 1136 | 1309 | |
| 1137 | | - %Image = %Attributes ; |
| 1138 | | -} |
| | 1310 | + &CheckPreset("Legend"); |
| 1139 | 1311 | |
| 1140 | | -sub ParseLegend |
| 1141 | | -{ |
| 1142 | | - if (! &ValidAttributes ("Legend")) { return ; } |
| | 1312 | + foreach $attribute (keys %Attributes) { |
| | 1313 | + my $attrvalue = @Attributes{$attribute}; |
| 1143 | 1314 | |
| 1144 | | - &CheckPreset ("Legend") ; |
| | 1315 | + if ($attribute =~ /Columns/i) { |
| | 1316 | + if (($attrvalue < 1) || ($attrvalue > 4)) { |
| | 1317 | + &Error( |
| | 1318 | + "Legend attribute 'columns' invalid. Specify 1,2,3 or 4"); |
| | 1319 | + return; |
| | 1320 | + } |
| | 1321 | + } |
| | 1322 | + elsif ($attribute =~ /Orientation/i) { |
| | 1323 | + if (!($attrvalue =~ /^(?:hor|horizontal|ver|vertical)$/i)) { |
| | 1324 | + &Error( |
| | 1325 | + "Legend attribute '$attrvalue' invalid. Specify hor[izontal] or ver[tical]" |
| | 1326 | + ); |
| | 1327 | + return; |
| | 1328 | + } |
| 1145 | 1329 | |
| 1146 | | - foreach $attribute (keys %Attributes) |
| 1147 | | - { |
| 1148 | | - my $attrvalue = @Attributes {$attribute} ; |
| | 1330 | + @Attributes{"orientation"} = substr($attrvalue, 0, 3); |
| | 1331 | + } |
| | 1332 | + elsif ($attribute =~ /Position/i) { |
| | 1333 | + if (!($attrvalue =~ /^(?:top|bottom|right)$/i)) { |
| | 1334 | + &Error( |
| | 1335 | + "Legend attribute '$attrvalue' invalid.\nSpecify top, bottom or right" |
| | 1336 | + ); |
| | 1337 | + return; |
| | 1338 | + } |
| | 1339 | + } |
| | 1340 | + elsif ($attribute =~ /Left/i) { |
| | 1341 | + if (!&ValidAbsRel($attrvalue)) { |
| | 1342 | + &Error( |
| | 1343 | + "Legend attribute '$attribute' invalid.\nSpecify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'" |
| | 1344 | + ); |
| | 1345 | + return; |
| | 1346 | + } |
| | 1347 | + } |
| | 1348 | + elsif ($attribute =~ /Top/i) { |
| | 1349 | + if (!&ValidAbsRel($attrvalue)) { |
| | 1350 | + &Error( |
| | 1351 | + "Legend attribute '$attribute' invalid.\nSpecify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'" |
| | 1352 | + ); |
| | 1353 | + return; |
| | 1354 | + } |
| | 1355 | + } |
| | 1356 | + elsif ($attribute =~ /ColumnWidth/i) { |
| | 1357 | + if (!&ValidAbsRel($attrvalue)) { |
| | 1358 | + &Error( |
| | 1359 | + "Legend attribute '$attribute' invalid.\nSpecify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'" |
| | 1360 | + ); |
| | 1361 | + return; |
| | 1362 | + } |
| | 1363 | + } |
| | 1364 | + } |
| 1149 | 1365 | |
| 1150 | | - if ($attribute =~ /Columns/i) |
| 1151 | | - { |
| 1152 | | - if (($attrvalue < 1) || ($attrvalue > 4)) |
| 1153 | | - { &Error ("Legend attribute 'columns' invalid. Specify 1,2,3 or 4") ; return ; } |
| | 1366 | + if (defined(@Attributes{"position"})) { |
| | 1367 | + if (defined(@Attributes{"left"})) { |
| | 1368 | + &Error( |
| | 1369 | + "Legend definition invalid. Attributes 'position' and 'left' are mutually exclusive." |
| | 1370 | + ); |
| | 1371 | + return; |
| | 1372 | + } |
| 1154 | 1373 | } |
| 1155 | | - elsif ($attribute =~ /Orientation/i) |
| 1156 | | - { |
| 1157 | | - if (! ($attrvalue =~ /^(?:hor|horizontal|ver|vertical)$/i)) |
| 1158 | | - { &Error ("Legend attribute '$attrvalue' invalid. Specify hor[izontal] or ver[tical]") ; return ; } |
| | 1374 | + else { |
| | 1375 | + if ((!defined(@Attributes{"left"})) && (!defined(@Attributes{"top"}))) |
| | 1376 | + { |
| | 1377 | + &Info( |
| | 1378 | + "Legend definition: none of attributes 'position', 'left' or 'top' have been defined. Position 'bottom' assumed." |
| | 1379 | + ); |
| | 1380 | + @Attributes{"position"} = "bottom"; |
| | 1381 | + } |
| | 1382 | + elsif ((!defined(@Attributes{"left"})) |
| | 1383 | + || (!defined(@Attributes{"top"}))) |
| | 1384 | + { |
| | 1385 | + &Error( |
| | 1386 | + "Legend definition invalid. Specify 'position', or 'left' & 'top'." |
| | 1387 | + ); |
| | 1388 | + return; |
| | 1389 | + } |
| | 1390 | + } |
| 1159 | 1391 | |
| 1160 | | - @Attributes {"orientation"} = substr ($attrvalue,0,3) ; |
| | 1392 | + if (@Attributes{"position"} =~ /right/i) { |
| | 1393 | + if (defined(@Attributes{"columns"})) { |
| | 1394 | + &Error( |
| | 1395 | + "Legend definition invalid.\nAttribute 'columns' and 'position:right' are mutually exclusive." |
| | 1396 | + ); |
| | 1397 | + return; |
| | 1398 | + } |
| | 1399 | + if (defined(@Attributes{"columnwidth"})) { |
| | 1400 | + &Error( |
| | 1401 | + "Legend definition invalid.\nAttribute 'columnwidth' and 'position:right' are mutually exclusive." |
| | 1402 | + ); |
| | 1403 | + return; |
| | 1404 | + } |
| 1161 | 1405 | } |
| 1162 | | - elsif ($attribute =~ /Position/i) |
| 1163 | | - { |
| 1164 | | - if (! ($attrvalue =~ /^(?:top|bottom|right)$/i)) |
| 1165 | | - { &Error ("Legend attribute '$attrvalue' invalid.\nSpecify top, bottom or right") ; return ; } |
| | 1406 | + |
| | 1407 | + if (@Attributes{"orientation"} =~ /hor/i) { |
| | 1408 | + if (@Attributes{"position"} =~ /right/i) { |
| | 1409 | + &Error( |
| | 1410 | + "Legend definition invalid.\n'position:right' and 'orientation:horizontal' are mutually exclusive." |
| | 1411 | + ); |
| | 1412 | + return; |
| | 1413 | + } |
| | 1414 | + if (defined(@Attributes{"columns"})) { |
| | 1415 | + &Error( |
| | 1416 | + "Legend definition invalid.\nAttribute 'columns' and 'orientation:horizontal' are mutually exclusive." |
| | 1417 | + ); |
| | 1418 | + return; |
| | 1419 | + } |
| | 1420 | + if (defined(@Attributes{"columnwidth"})) { |
| | 1421 | + &Error( |
| | 1422 | + "Legend definition invalid.\nAttribute 'columnwidth' and 'orientation:horizontal' are mutually exclusive." |
| | 1423 | + ); |
| | 1424 | + return; |
| | 1425 | + } |
| 1166 | 1426 | } |
| 1167 | | - elsif ($attribute =~ /Left/i) |
| | 1427 | + |
| | 1428 | + if ( (@Attributes{"orientation"} =~ /hor/i) |
| | 1429 | + && (defined(@Attributes{"columns"}))) |
| 1168 | 1430 | { |
| 1169 | | - if (! &ValidAbsRel ($attrvalue)) |
| 1170 | | - { &Error ("Legend attribute '$attribute' invalid.\nSpecify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ; return ; } } |
| 1171 | | - elsif ($attribute =~ /Top/i) |
| 1172 | | - { |
| 1173 | | - if (! &ValidAbsRel ($attrvalue)) |
| 1174 | | - { &Error ("Legend attribute '$attribute' invalid.\nSpecify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ; return ; } } |
| 1175 | | - elsif ($attribute =~ /ColumnWidth/i) |
| 1176 | | - { |
| 1177 | | - if (! &ValidAbsRel ($attrvalue)) |
| 1178 | | - { &Error ("Legend attribute '$attribute' invalid.\nSpecify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ; return ; } |
| | 1431 | + &Error( |
| | 1432 | + "Legend definition invalid.\nDo not specify attribute 'columns' with 'orientation:horizontal'." |
| | 1433 | + ); |
| | 1434 | + return; |
| 1179 | 1435 | } |
| 1180 | | - } |
| 1181 | 1436 | |
| 1182 | | - if (defined (@Attributes {"position"})) |
| 1183 | | - { |
| 1184 | | - if (defined (@Attributes {"left"})) |
| 1185 | | - { &Error ("Legend definition invalid. Attributes 'position' and 'left' are mutually exclusive.") ; return ; } |
| 1186 | | - } |
| 1187 | | - else |
| 1188 | | - { |
| 1189 | | - if ((! defined (@Attributes {"left"})) && (! defined (@Attributes {"top"}))) |
| 1190 | | - { |
| 1191 | | - &Info ("Legend definition: none of attributes 'position', 'left' or 'top' have been defined. Position 'bottom' assumed.") ; |
| 1192 | | - @Attributes {"position"} = "bottom" ; |
| | 1437 | + if (@Attributes{"columns"} > 1) { |
| | 1438 | + if ( (defined(@Attributes{"left"})) |
| | 1439 | + && (!defined(@Attributes{"columnwidth"}))) |
| | 1440 | + { |
| | 1441 | + &Error( |
| | 1442 | + "Legend attribute 'columnwidth' not defined.\nThis is needed when attribute 'left' is specified." |
| | 1443 | + ); |
| | 1444 | + return; |
| | 1445 | + } |
| 1193 | 1446 | } |
| 1194 | | - elsif ((! defined (@Attributes {"left"})) || (! defined (@Attributes {"top"}))) |
| 1195 | | - { &Error ("Legend definition invalid. Specify 'position', or 'left' & 'top'.") ; return ; } |
| 1196 | | - } |
| 1197 | 1447 | |
| 1198 | | - if (@Attributes {"position"} =~ /right/i) |
| 1199 | | - { |
| 1200 | | - if (defined (@Attributes {"columns"})) |
| 1201 | | - { &Error ("Legend definition invalid.\nAttribute 'columns' and 'position:right' are mutually exclusive.") ; return ; } |
| 1202 | | - if (defined (@Attributes {"columnwidth"})) |
| 1203 | | - { &Error ("Legend definition invalid.\nAttribute 'columnwidth' and 'position:right' are mutually exclusive.") ; return ; } |
| 1204 | | - } |
| | 1448 | + if (!defined(@Attributes{"orientation"})) { |
| | 1449 | + @Attributes{"orientation"} = "ver"; |
| | 1450 | + } |
| 1205 | 1451 | |
| 1206 | | - if (@Attributes {"orientation"} =~ /hor/i) |
| 1207 | | - { |
| 1208 | | - if (@Attributes {"position"} =~ /right/i) |
| 1209 | | - { &Error ("Legend definition invalid.\n'position:right' and 'orientation:horizontal' are mutually exclusive.") ; return ; } |
| 1210 | | - if (defined (@Attributes {"columns"})) |
| 1211 | | - { &Error ("Legend definition invalid.\nAttribute 'columns' and 'orientation:horizontal' are mutually exclusive.") ; return ; } |
| 1212 | | - if (defined (@Attributes {"columnwidth"})) |
| 1213 | | - { &Error ("Legend definition invalid.\nAttribute 'columnwidth' and 'orientation:horizontal' are mutually exclusive.") ; return ; } |
| 1214 | | - } |
| 1215 | | - |
| 1216 | | - if ((@Attributes {"orientation"} =~ /hor/i) && (defined (@Attributes {"columns"}))) |
| 1217 | | - { &Error ("Legend definition invalid.\nDo not specify attribute 'columns' with 'orientation:horizontal'.") ; return ; } |
| 1218 | | - |
| 1219 | | - if (@Attributes {"columns"} > 1) |
| 1220 | | - { |
| 1221 | | - if ((defined (@Attributes {"left"})) && (! defined (@Attributes {"columnwidth"}))) |
| 1222 | | - { &Error ("Legend attribute 'columnwidth' not defined.\nThis is needed when attribute 'left' is specified.") ; return ; } |
| 1223 | | - } |
| 1224 | | - |
| 1225 | | - if (! defined (@Attributes {"orientation"})) |
| 1226 | | - { @Attributes {"orientation"} = "ver" ; } |
| 1227 | | - |
| 1228 | | - %Legend = %Attributes ; |
| | 1452 | + %Legend = %Attributes; |
| 1229 | 1453 | } |
| 1230 | 1454 | |
| 1231 | | -sub ParsePeriod |
| 1232 | | -{ |
| 1233 | | - if (! defined ($DateFormat)) |
| 1234 | | - { &Error ("Period definition ambiguous. No (valid) command 'DateFormat' specified in previous lines.") ; return ; } |
| | 1455 | +sub ParsePeriod { |
| | 1456 | + if (!defined($DateFormat)) { |
| | 1457 | + &Error( |
| | 1458 | + "Period definition ambiguous. No (valid) command 'DateFormat' specified in previous lines." |
| | 1459 | + ); |
| | 1460 | + return; |
| | 1461 | + } |
| 1235 | 1462 | |
| 1236 | | - if (! ValidAttributes ("Period")) { return ; } |
| | 1463 | + if (!ValidAttributes("Period")) { return; } |
| 1237 | 1464 | |
| 1238 | | - foreach $attribute (keys %Attributes) |
| 1239 | | - { |
| 1240 | | - my $attrvalue = @Attributes {$attribute} ; |
| | 1465 | + foreach $attribute (keys %Attributes) { |
| | 1466 | + my $attrvalue = @Attributes{$attribute}; |
| 1241 | 1467 | |
| 1242 | | - if ($DateFormat eq "yyyy") |
| 1243 | | - { |
| 1244 | | - if ($attrvalue !~ /^\-?\d+$/) |
| 1245 | | - { &Error ("Period definition invalid.\nInvalid year '$attrvalue' specified for attribute '$attribute'.") ; return ; } |
| 1246 | | - } |
| 1247 | | - elsif ($DateFormat eq "x.y") |
| 1248 | | - { |
| 1249 | | - if (! ($attrvalue =~ /^\-?\d+(?:\.\d+)?$/)) |
| 1250 | | - { &Error ("Period definition invalid.\nInvalid year '$attrvalue' specified for attribute '$attribute'.") ; return ; } |
| 1251 | | - } |
| 1252 | | - else |
| 1253 | | - { |
| 1254 | | - if (($attrvalue =~ /^\d+$/) && ($attrvalue >= 1800) && ($attrvalue <= 2030)) |
| 1255 | | - { |
| 1256 | | - if ($attribute =~ /^From$/i) |
| 1257 | | - { $attrvalue = "01/01/" . $attrvalue ; } |
| 1258 | | - if ($attribute =~ /^Till$/i) |
| 1259 | | - { |
| 1260 | | - if ($DateFormat eq "dd/mm/yyyy") |
| 1261 | | - { $attrvalue = "31/12/" . $attrvalue ; } |
| 1262 | | - else |
| 1263 | | - { $attrvalue = "12/31/" . $attrvalue ; } |
| | 1468 | + if ($DateFormat eq "yyyy") { |
| | 1469 | + if ($attrvalue !~ /^\-?\d+$/) { |
| | 1470 | + &Error( |
| | 1471 | + "Period definition invalid.\nInvalid year '$attrvalue' specified for attribute '$attribute'." |
| | 1472 | + ); |
| | 1473 | + return; |
| | 1474 | + } |
| 1264 | 1475 | } |
| 1265 | | - } |
| | 1476 | + elsif ($DateFormat eq "x.y") { |
| | 1477 | + if (!($attrvalue =~ /^\-?\d+(?:\.\d+)?$/)) { |
| | 1478 | + &Error( |
| | 1479 | + "Period definition invalid.\nInvalid year '$attrvalue' specified for attribute '$attribute'." |
| | 1480 | + ); |
| | 1481 | + return; |
| | 1482 | + } |
| | 1483 | + } |
| | 1484 | + else { |
| | 1485 | + if ( ($attrvalue =~ /^\d+$/) |
| | 1486 | + && ($attrvalue >= 1800) |
| | 1487 | + && ($attrvalue <= 2030)) |
| | 1488 | + { |
| | 1489 | + if ($attribute =~ /^From$/i) { |
| | 1490 | + $attrvalue = "01/01/" . $attrvalue; |
| | 1491 | + } |
| | 1492 | + if ($attribute =~ /^Till$/i) { |
| | 1493 | + if ($DateFormat eq "dd/mm/yyyy") { |
| | 1494 | + $attrvalue = "31/12/" . $attrvalue; |
| | 1495 | + } |
| | 1496 | + else { $attrvalue = "12/31/" . $attrvalue; } |
| | 1497 | + } |
| | 1498 | + } |
| 1266 | 1499 | |
| 1267 | | - $ValidDate = &ValidDateFormat ($attrvalue) ; |
| 1268 | | - if (! $ValidDate) |
| 1269 | | - { &Error ("Period attribute '$attribute' invalid.\n" . |
| 1270 | | - "Date does not conform to specified DateFormat '$DateFormat'.") ; return ; } |
| 1271 | | - if (substr ($attrvalue,6,4) < 1800) |
| 1272 | | - { &Error ("Period attribute '$attribute' invalid. Specify year >= 1800.") ; return ; } |
| | 1500 | + $ValidDate = &ValidDateFormat($attrvalue); |
| | 1501 | + if (!$ValidDate) { |
| | 1502 | + &Error( "Period attribute '$attribute' invalid.\n" |
| | 1503 | + . "Date does not conform to specified DateFormat '$DateFormat'." |
| | 1504 | + ); |
| | 1505 | + return; |
| | 1506 | + } |
| | 1507 | + if (substr($attrvalue, 6, 4) < 1800) { |
| | 1508 | + &Error( |
| | 1509 | + "Period attribute '$attribute' invalid. Specify year >= 1800." |
| | 1510 | + ); |
| | 1511 | + return; |
| | 1512 | + } |
| 1273 | 1513 | |
| 1274 | | - @Attributes {$attribute} = $attrvalue ; |
| | 1514 | + @Attributes{$attribute} = $attrvalue; |
| | 1515 | + } |
| 1275 | 1516 | } |
| 1276 | | - } |
| 1277 | 1517 | |
| 1278 | | - %Period = %Attributes ; |
| | 1518 | + %Period = %Attributes; |
| 1279 | 1519 | } |
| 1280 | 1520 | |
| 1281 | | -sub ParsePlotArea |
| 1282 | | -{ |
| 1283 | | - if (! &ValidAttributes ("PlotArea")) { return ; } |
| | 1521 | +sub ParsePlotArea { |
| | 1522 | + if (!&ValidAttributes("PlotArea")) { return; } |
| 1284 | 1523 | |
| 1285 | | - &CheckPreset ("PlotArea") ; |
| | 1524 | + &CheckPreset("PlotArea"); |
| 1286 | 1525 | |
| 1287 | | - foreach $attribute (@Attributes) |
| 1288 | | - { |
| 1289 | | - my $attrvalue = @Attributes {$attribute} ; |
| 1290 | | - if (! &ValidAbsRel ($attrvalue)) |
| 1291 | | - { &Error ("PlotArea attribute '$attribute' invalid.\n" . |
| 1292 | | - "Specify value as x[.y][px, in, cm, %] examples: '200', '20px', '1.3in', '80%'") ; return ; } |
| 1293 | | - } |
| | 1526 | + foreach $attribute (@Attributes) { |
| | 1527 | + my $attrvalue = @Attributes{$attribute}; |
| | 1528 | + if (!&ValidAbsRel($attrvalue)) { |
| | 1529 | + &Error( "PlotArea attribute '$attribute' invalid.\n" |
| | 1530 | + . "Specify value as x[.y][px, in, cm, %] examples: '200', '20px', '1.3in', '80%'" |
| | 1531 | + ); |
| | 1532 | + return; |
| | 1533 | + } |
| | 1534 | + } |
| 1294 | 1535 | |
| 1295 | | - if ((@Attributes {"top"} ne "") && (@Attributes {"height"} ne "")) |
| 1296 | | - { &Error ("PlotArea attributes 'top' and 'height' are mutually exclusive. Specify only one of them.") ; return ; } |
| | 1536 | + if ((@Attributes{"top"} ne "") && (@Attributes{"height"} ne "")) { |
| | 1537 | + &Error( |
| | 1538 | + "PlotArea attributes 'top' and 'height' are mutually exclusive. Specify only one of them." |
| | 1539 | + ); |
| | 1540 | + return; |
| | 1541 | + } |
| 1297 | 1542 | |
| 1298 | | - if ((@Attributes {"right"} ne "") && (@Attributes {"width"} ne "")) |
| 1299 | | - { &Error ("PlotArea attributes 'right' and 'width' are mutually exclusive. Specify only one of them.") ; return ; } |
| | 1543 | + if ((@Attributes{"right"} ne "") && (@Attributes{"width"} ne "")) { |
| | 1544 | + &Error( |
| | 1545 | + "PlotArea attributes 'right' and 'width' are mutually exclusive. Specify only one of them." |
| | 1546 | + ); |
| | 1547 | + return; |
| | 1548 | + } |
| 1300 | 1549 | |
| 1301 | | - if ((@Attributes {"top"} eq "") && (@Attributes {"height"} eq "")) |
| 1302 | | - { &Error ("PlotArea definition incomplete. Either attribute 'top' (advised) or 'height' should be specified") ; return ; } |
| | 1550 | + if ((@Attributes{"top"} eq "") && (@Attributes{"height"} eq "")) { |
| | 1551 | + &Error( |
| | 1552 | + "PlotArea definition incomplete. Either attribute 'top' (advised) or 'height' should be specified" |
| | 1553 | + ); |
| | 1554 | + return; |
| | 1555 | + } |
| 1303 | 1556 | |
| 1304 | | - if ((@Attributes {"right"} eq "") && (@Attributes {"width"} eq "")) |
| 1305 | | - { &Error ("PlotArea definition incomplete. Either attribute 'right' (advised) or 'width' should be specified") ; return ; } |
| | 1557 | + if ((@Attributes{"right"} eq "") && (@Attributes{"width"} eq "")) { |
| | 1558 | + &Error( |
| | 1559 | + "PlotArea definition incomplete. Either attribute 'right' (advised) or 'width' should be specified" |
| | 1560 | + ); |
| | 1561 | + return; |
| | 1562 | + } |
| 1306 | 1563 | |
| 1307 | | - %PlotArea = %Attributes ; |
| | 1564 | + %PlotArea = %Attributes; |
| 1308 | 1565 | } |
| 1309 | 1566 | |
| 1310 | 1567 | # command Bars found ? |
| — | — | @@ -1320,2182 +1577,2411 @@ |
| 1321 | 1578 | # | | assume @Bar[0] | |
| 1322 | 1579 | # | |> 1 | |
| 1323 | 1580 | # | | err | |
| 1324 | | -sub ParsePlotData |
| 1325 | | -{ |
| 1326 | | - if (defined (@Bars)) |
| 1327 | | - { $BarsCommandFound = $true ; } |
| 1328 | | - else |
| 1329 | | - { $BarsCommandFound = $false ; } |
| 1330 | | - $prevbar = "" ; |
| | 1581 | +sub ParsePlotData { |
| | 1582 | + if (defined(@Bars)) { $BarsCommandFound = $true; } |
| | 1583 | + else { $BarsCommandFound = $false; } |
| | 1584 | + $prevbar = ""; |
| 1331 | 1585 | |
| 1332 | | - if ((! (defined ($DateFormat))) || (@Period {"from"} eq "") || (@Axis {"time"} eq "")) |
| 1333 | | - { |
| 1334 | | - if (! (defined ($DateFormat))) |
| 1335 | | - { &Error ("PlotData invalid. No (valid) command 'DateFormat' specified in previous lines.") ; } |
| 1336 | | - elsif (@Period {"from"} eq "") |
| 1337 | | - { &Error ("PlotData invalid. No (valid) command 'Period' specified in previous lines.") ; } |
| 1338 | | - else |
| 1339 | | - { &Error ("PlotData invalid. No (valid) command 'TimeAxis' specified in previous lines.") ; } |
| | 1586 | + if ( (!(defined($DateFormat))) |
| | 1587 | + || (@Period{"from"} eq "") |
| | 1588 | + || (@Axis{"time"} eq "")) |
| | 1589 | + { |
| | 1590 | + if (!(defined($DateFormat))) { |
| | 1591 | + &Error( |
| | 1592 | + "PlotData invalid. No (valid) command 'DateFormat' specified in previous lines." |
| | 1593 | + ); |
| | 1594 | + } |
| | 1595 | + elsif (@Period{"from"} eq "") { |
| | 1596 | + &Error( |
| | 1597 | + "PlotData invalid. No (valid) command 'Period' specified in previous lines." |
| | 1598 | + ); |
| | 1599 | + } |
| | 1600 | + else { |
| | 1601 | + &Error( |
| | 1602 | + "PlotData invalid. No (valid) command 'TimeAxis' specified in previous lines." |
| | 1603 | + ); |
| | 1604 | + } |
| 1340 | 1605 | |
| 1341 | | - &GetData ; |
| 1342 | | - while ((! $InputParsed) && (! $NoData)) |
| 1343 | | - { &GetData ; } |
| 1344 | | - return ; |
| 1345 | | - } |
| | 1606 | + &GetData; |
| | 1607 | + while ((!$InputParsed) && (!$NoData)) { &GetData; } |
| | 1608 | + return; |
| | 1609 | + } |
| 1346 | 1610 | |
| 1347 | | - &GetData ; |
| 1348 | | - if ($NoData) |
| 1349 | | - { &Error ("Data expected for command 'PlotData', but line is not indented.\n") ; return ; } |
| | 1611 | + &GetData; |
| | 1612 | + if ($NoData) { |
| | 1613 | + &Error( |
| | 1614 | + "Data expected for command 'PlotData', but line is not indented.\n" |
| | 1615 | + ); |
| | 1616 | + return; |
| | 1617 | + } |
| 1350 | 1618 | |
| 1351 | | - my ($bar, $at, $from, $till, $color, $bgcolor, $textcolor, $fontsize, $width, |
| 1352 | | - $text, $anchor, $align, $shift, $shiftx, $shifty, $mark, $markcolor, $link, $hint) ; |
| | 1619 | + my ( |
| | 1620 | + $bar, $at, $from, $till, $color, |
| | 1621 | + $bgcolor, $textcolor, $fontsize, $width, $text, |
| | 1622 | + $anchor, $align, $shift, $shiftx, $shifty, |
| | 1623 | + $mark, $markcolor, $link, $hint |
| | 1624 | + ); |
| 1353 | 1625 | |
| 1354 | | - @PlotDefs {"anchor"} = "middle" ; |
| | 1626 | + @PlotDefs{"anchor"} = "middle"; |
| 1355 | 1627 | |
| 1356 | | - PlotData: |
| 1357 | | - while ((! $InputParsed) && (! $NoData)) |
| 1358 | | - { |
| 1359 | | - if (! &ValidAttributes ("PlotData")) |
| 1360 | | - { &GetData ; next ;} |
| | 1628 | + PlotData: |
| | 1629 | + while ((!$InputParsed) && (!$NoData)) { |
| | 1630 | + if (!&ValidAttributes("PlotData")) { &GetData; next; } |
| 1361 | 1631 | |
| 1362 | | - $bar = "" ; # $barset = "" ; |
| 1363 | | - $at = "" ; $from = "" ; $till = "" ; |
| 1364 | | - $color = "barcoldefault" ; $bgcolor = "" ; $textcolor = "black" ; $fontsize = "S" ; $width = "0.25" ; |
| 1365 | | - $text = "" ; $align = "left" ; $shift = "" ; $shiftx = "" ; $shifty = "" ; $anchor = "" ; |
| 1366 | | - $mark = "" ; $markcolor = "" ; |
| 1367 | | - $link = "" ; $hint = "" ; |
| | 1632 | + $bar = ""; # $barset = "" ; |
| | 1633 | + $at = ""; |
| | 1634 | + $from = ""; |
| | 1635 | + $till = ""; |
| | 1636 | + $color = "barcoldefault"; |
| | 1637 | + $bgcolor = ""; |
| | 1638 | + $textcolor = "black"; |
| | 1639 | + $fontsize = "S"; |
| | 1640 | + $width = "0.25"; |
| | 1641 | + $text = ""; |
| | 1642 | + $align = "left"; |
| | 1643 | + $shift = ""; |
| | 1644 | + $shiftx = ""; |
| | 1645 | + $shifty = ""; |
| | 1646 | + $anchor = ""; |
| | 1647 | + $mark = ""; |
| | 1648 | + $markcolor = ""; |
| | 1649 | + $link = ""; |
| | 1650 | + $hint = ""; |
| 1368 | 1651 | |
| 1369 | | - &CheckPreset ("PlotData") ; |
| | 1652 | + &CheckPreset("PlotData"); |
| 1370 | 1653 | |
| 1371 | | - if (defined (@PlotDefs {"bar"})) { $bar = @PlotDefs {"bar"} ; } |
| 1372 | | - # if (defined (@PlotDefs {"barset"})) { $barset = @PlotDefs {"barset"} ; } |
| 1373 | | - if (defined (@PlotDefs {"color"})) { $color = @PlotDefs {"color"} ; } |
| 1374 | | - if (defined (@PlotDefs {"bgcolor"})) { $bgcolor = @PlotDefs {"bgcolor"} ; } |
| 1375 | | - if (defined (@PlotDefs {"textcolor"})) { $textcolor = @PlotDefs {"textcolor"} ; } |
| 1376 | | - if (defined (@PlotDefs {"fontsize"})) { $fontsize = @PlotDefs {"fontsize"} ; } |
| 1377 | | - if (defined (@PlotDefs {"width"})) { $width = @PlotDefs {"width"} ; } |
| 1378 | | - if (defined (@PlotDefs {"anchor"})) { $anchor = @PlotDefs {"anchor"} ; } |
| 1379 | | - if (defined (@PlotDefs {"align"})) { $align = @PlotDefs {"align"} ; } |
| 1380 | | - if (defined (@PlotDefs {"shiftx"})) { $shiftx = @PlotDefs {"shiftx"} ; } |
| 1381 | | - if (defined (@PlotDefs {"shifty"})) { $shifty = @PlotDefs {"shifty"} ; } |
| 1382 | | - if (defined (@PlotDefs {"mark"})) { $mark = @PlotDefs {"mark"} ; } |
| 1383 | | - if (defined (@PlotDefs {"markcolor"})) { $markcolor = @PlotDefs {"markcolor"} ; } |
| 1384 | | -# if (defined (@PlotDefs {"link"})) { $link = @PlotDefs {"link"} ; } |
| 1385 | | -# if (defined (@PlotDefs {"hint"})) { $hint = @PlotDefs {"hint"} ; } |
| | 1654 | + if (defined(@PlotDefs{"bar"})) { $bar = @PlotDefs{"bar"}; } |
| 1386 | 1655 | |
| 1387 | | - foreach $attribute (keys %Attributes) |
| 1388 | | - { |
| 1389 | | - my $attrvalue = @Attributes {$attribute} ; |
| 1390 | | - |
| 1391 | | - if ($attribute =~ /^Bar$/i) |
| 1392 | | - { |
| 1393 | | - if (! ($attrvalue =~ /[a-zA-Z0-9\_]+/)) |
| 1394 | | - { &Error ("PlotData attribute '$attribute' invalid.\n" . |
| 1395 | | - "Use only characters 'a'-'z', 'A'-'Z', '0'-'9', '_'\n") ; |
| 1396 | | - &GetData ; next PlotData ; } |
| 1397 | | - |
| 1398 | | - $attrvalue2 = $attrvalue ; |
| 1399 | | - |
| 1400 | | - if ($BarsCommandFound) |
| 1401 | | - { |
| 1402 | | - if (! &BarDefined ($attrvalue2)) |
| 1403 | | - { &Error ("PlotData invalid. Bar '$attrvalue' not (properly) defined.") ; |
| 1404 | | - &GetData ; next PlotData ; } |
| | 1656 | + # if (defined (@PlotDefs {"barset"})) { $barset = @PlotDefs {"barset"} ; } |
| | 1657 | + if (defined(@PlotDefs{"color"})) { $color = @PlotDefs{"color"}; } |
| | 1658 | + if (defined(@PlotDefs{"bgcolor"})) { |
| | 1659 | + $bgcolor = @PlotDefs{"bgcolor"}; |
| 1405 | 1660 | } |
| 1406 | | - else |
| 1407 | | - { |
| 1408 | | - if (! &BarDefined ($attrvalue2)) |
| 1409 | | - { |
| 1410 | | - if (@Axis {"time"} eq "x") |
| 1411 | | - { push @Bars, $attrvalue2 ; } |
| 1412 | | - else |
| 1413 | | - { unshift @Bars, $attrvalue2 ; } |
| 1414 | | - } |
| | 1661 | + if (defined(@PlotDefs{"textcolor"})) { |
| | 1662 | + $textcolor = @PlotDefs{"textcolor"}; |
| 1415 | 1663 | } |
| 1416 | | - $bar = $attrvalue2 ; |
| 1417 | | - $prevbar = $bar ; |
| 1418 | | - } |
| 1419 | | - elsif ($attribute =~ /^BarSet$/i) |
| 1420 | | - { |
| 1421 | | - if (! ($attrvalue =~ /[a-zA-Z0-9\_]+/)) |
| 1422 | | - { &Error ("PlotData attribute '$attribute' invalid.\n" . |
| 1423 | | - "Use only characters 'a'-'z', 'A'-'Z', '0'-'9', '_'\n") ; |
| 1424 | | - &GetData ; next PlotData ; } |
| 1425 | | - |
| 1426 | | - $attrvalue2 = $attrvalue ; |
| 1427 | | - |
| 1428 | | - if ($attrvalue =~ /break/i) |
| 1429 | | - { $barndx = 0 ; } |
| 1430 | | - elsif ($attrvalue =~ /skip/i) |
| 1431 | | - { |
| 1432 | | - $barndx ++ ; |
| 1433 | | - &BarDefined ($prevbar . "#" . $barndx) ; |
| | 1664 | + if (defined(@PlotDefs{"fontsize"})) { |
| | 1665 | + $fontsize = @PlotDefs{"fontsize"}; |
| 1434 | 1666 | } |
| 1435 | | - else |
| 1436 | | - { |
| 1437 | | - if ($BarsCommandFound) |
| 1438 | | - { |
| 1439 | | - if (! &BarDefined ($attrvalue2 . "#1")) |
| 1440 | | - { &Error ("PlotData invalid. BarSet '$attrvalue' not (properly) defined with command BarData.") ; |
| 1441 | | - &GetData ; next PlotData ; } |
| 1442 | | - } |
| 1443 | | - $bar = $attrvalue2 ; |
| 1444 | | - if ($bar ne $prevbar) |
| 1445 | | - { $barndx = 0 ; } |
| 1446 | | - $prevbar = $bar ; |
| | 1667 | + if (defined(@PlotDefs{"width"})) { $width = @PlotDefs{"width"}; } |
| | 1668 | + if (defined(@PlotDefs{"anchor"})) { $anchor = @PlotDefs{"anchor"}; } |
| | 1669 | + if (defined(@PlotDefs{"align"})) { $align = @PlotDefs{"align"}; } |
| | 1670 | + if (defined(@PlotDefs{"shiftx"})) { $shiftx = @PlotDefs{"shiftx"}; } |
| | 1671 | + if (defined(@PlotDefs{"shifty"})) { $shifty = @PlotDefs{"shifty"}; } |
| | 1672 | + if (defined(@PlotDefs{"mark"})) { $mark = @PlotDefs{"mark"}; } |
| | 1673 | + if (defined(@PlotDefs{"markcolor"})) { |
| | 1674 | + $markcolor = @PlotDefs{"markcolor"}; |
| 1447 | 1675 | } |
| 1448 | | - } |
| 1449 | | - elsif ($attribute =~ /^(?:At|From|Till)$/i) |
| 1450 | | - { |
| 1451 | | - if ($attrvalue =~ /^Start$/i) |
| 1452 | | - { $attrvalue = @Period {"from"} ; } |
| 1453 | | - if ($attrvalue =~ /^End$/i) |
| 1454 | | - { $attrvalue = @Period {"till"} ; } |
| 1455 | 1676 | |
| 1456 | | - if (! &ValidDateFormat ($attrvalue)) |
| 1457 | | - { |
| 1458 | | - &Error ("PlotData attribute '$attribute' invalid.\n" . |
| 1459 | | - "Date '$attrvalue' does not conform to specified DateFormat $DateFormat.") ; |
| 1460 | | - &GetData ; next PlotData ; } |
| | 1677 | + # if (defined (@PlotDefs {"link"})) { $link = @PlotDefs {"link"} ; } |
| | 1678 | + # if (defined (@PlotDefs {"hint"})) { $hint = @PlotDefs {"hint"} ; } |
| 1461 | 1679 | |
| 1462 | | - if (! &ValidDateRange ($attrvalue)) |
| 1463 | | - { &Error ("Plotdata attribute '$attribute' invalid.\n" . |
| 1464 | | - "Date '$attrvalue' not within range as specified by command Period.") ; |
| | 1680 | + foreach $attribute (keys %Attributes) { |
| | 1681 | + my $attrvalue = @Attributes{$attribute}; |
| 1465 | 1682 | |
| 1466 | | - &GetData ; next PlotData ; } |
| | 1683 | + if ($attribute =~ /^Bar$/i) { |
| | 1684 | + if (!($attrvalue =~ /[a-zA-Z0-9\_]+/)) { |
| | 1685 | + &Error( "PlotData attribute '$attribute' invalid.\n" |
| | 1686 | + . "Use only characters 'a'-'z', 'A'-'Z', '0'-'9', '_'\n" |
| | 1687 | + ); |
| | 1688 | + &GetData; |
| | 1689 | + next PlotData; |
| | 1690 | + } |
| 1467 | 1691 | |
| 1468 | | - if ($attribute =~ /^At$/i) |
| 1469 | | - { $at = $attrvalue ; } |
| 1470 | | - elsif ($attribute =~ /^From$/i) |
| 1471 | | - { $from = $attrvalue ; } |
| 1472 | | - else |
| 1473 | | - { $till = $attrvalue ; } |
| 1474 | | - } |
| 1475 | | -# elsif ($attribute =~ /^From$/i) |
| 1476 | | -# { |
| 1477 | | -# if ($attrvalue =~ /^Start$/i) |
| 1478 | | -# { $attrvalue = @Period {"from"} ; } |
| | 1692 | + $attrvalue2 = $attrvalue; |
| 1479 | 1693 | |
| 1480 | | -# if (! &ValidDateFormat ($attrvalue)) |
| 1481 | | -# { &Error ("PlotData invalid.\nDate '$attrvalue' does not conform to specified DateFormat $DateFormat.") ; |
| 1482 | | -# &GetData ; next PlotData ; } |
| | 1694 | + if ($BarsCommandFound) { |
| | 1695 | + if (!&BarDefined($attrvalue2)) { |
| | 1696 | + &Error( |
| | 1697 | + "PlotData invalid. Bar '$attrvalue' not (properly) defined." |
| | 1698 | + ); |
| | 1699 | + &GetData; |
| | 1700 | + next PlotData; |
| | 1701 | + } |
| | 1702 | + } |
| | 1703 | + else { |
| | 1704 | + if (!&BarDefined($attrvalue2)) { |
| | 1705 | + if (@Axis{"time"} eq "x") { push @Bars, $attrvalue2; } |
| | 1706 | + else { unshift @Bars, $attrvalue2; } |
| | 1707 | + } |
| | 1708 | + } |
| | 1709 | + $bar = $attrvalue2; |
| | 1710 | + $prevbar = $bar; |
| | 1711 | + } |
| | 1712 | + elsif ($attribute =~ /^BarSet$/i) { |
| | 1713 | + if (!($attrvalue =~ /[a-zA-Z0-9\_]+/)) { |
| | 1714 | + &Error( "PlotData attribute '$attribute' invalid.\n" |
| | 1715 | + . "Use only characters 'a'-'z', 'A'-'Z', '0'-'9', '_'\n" |
| | 1716 | + ); |
| | 1717 | + &GetData; |
| | 1718 | + next PlotData; |
| | 1719 | + } |
| 1483 | 1720 | |
| 1484 | | -# if (! &ValidDateRange ($attrvalue)) |
| 1485 | | -# { &Error ("Plotdata attribute 'from' invalid.\n" . |
| 1486 | | -# "Date '$attrvalue' not within range as specified by command Period.") ; |
| 1487 | | -# &GetData ; next PlotData ; } |
| | 1721 | + $attrvalue2 = $attrvalue; |
| 1488 | 1722 | |
| 1489 | | -# $from = $attrvalue ; |
| 1490 | | -# } |
| 1491 | | -# elsif ($attribute =~ /^Till$/i) |
| 1492 | | -# { |
| 1493 | | -# if ($attrvalue =~ /^End$/i) |
| 1494 | | -# { $attrvalue = @Period {"till"} ; } |
| | 1723 | + if ($attrvalue =~ /break/i) { $barndx = 0; } |
| | 1724 | + elsif ($attrvalue =~ /skip/i) { |
| | 1725 | + $barndx++; |
| | 1726 | + &BarDefined($prevbar . "#" . $barndx); |
| | 1727 | + } |
| | 1728 | + else { |
| | 1729 | + if ($BarsCommandFound) { |
| | 1730 | + if (!&BarDefined($attrvalue2 . "#1")) { |
| | 1731 | + &Error( |
| | 1732 | + "PlotData invalid. BarSet '$attrvalue' not (properly) defined with command BarData." |
| | 1733 | + ); |
| | 1734 | + &GetData; |
| | 1735 | + next PlotData; |
| | 1736 | + } |
| | 1737 | + } |
| | 1738 | + $bar = $attrvalue2; |
| | 1739 | + if ($bar ne $prevbar) { $barndx = 0; } |
| | 1740 | + $prevbar = $bar; |
| | 1741 | + } |
| | 1742 | + } |
| | 1743 | + elsif ($attribute =~ /^(?:At|From|Till)$/i) { |
| | 1744 | + if ($attrvalue =~ /^Start$/i) { |
| | 1745 | + $attrvalue = @Period{"from"}; |
| | 1746 | + } |
| | 1747 | + if ($attrvalue =~ /^End$/i) { $attrvalue = @Period{"till"}; } |
| 1495 | 1748 | |
| 1496 | | -# if (! &ValidDateFormat ($attrvalue)) |
| 1497 | | -# { &Error ("PlotData invalid. Date '$attrvalue' does not conform to specified DateFormat $DateFormat.") ; |
| 1498 | | -# &GetData ; next PlotData ; } |
| | 1749 | + if (!&ValidDateFormat($attrvalue)) { |
| | 1750 | + &Error( "PlotData attribute '$attribute' invalid.\n" |
| | 1751 | + . "Date '$attrvalue' does not conform to specified DateFormat $DateFormat." |
| | 1752 | + ); |
| | 1753 | + &GetData; |
| | 1754 | + next PlotData; |
| | 1755 | + } |
| 1499 | 1756 | |
| 1500 | | -# if (! &ValidDateRange ($attrvalue)) |
| 1501 | | -# { &Error ("Plotdata attribute 'till' invalid.\n" . |
| 1502 | | -# "Date '$attrvalue' not within range as specified by command Period.") ; |
| 1503 | | -# &GetData ; next PlotData ; } |
| | 1757 | + if (!&ValidDateRange($attrvalue)) { |
| | 1758 | + &Error( "Plotdata attribute '$attribute' invalid.\n" |
| | 1759 | + . "Date '$attrvalue' not within range as specified by command Period." |
| | 1760 | + ); |
| 1504 | 1761 | |
| 1505 | | -# $till = $attrvalue ; |
| 1506 | | -# } |
| 1507 | | - elsif ($attribute =~ /^Color$/i) |
| 1508 | | - { |
| 1509 | | - if (! &ColorPredefined ($attrvalue)) |
| 1510 | | - { |
| 1511 | | - if (! defined (@Colors {lc ($attrvalue)})) |
| 1512 | | - { &Error ("PlotData invalid. Attribute '$attribute' has unknown color '$attrvalue'.\n" . |
| 1513 | | - " Specify command 'Color' before this command.") ; |
| 1514 | | - &GetData ; next PlotData ; } |
| 1515 | | - } |
| 1516 | | - if (defined (@Colors {lc ($attrvalue)})) |
| 1517 | | - { $color = @Colors { lc ($attrvalue) } ; } |
| 1518 | | - else |
| 1519 | | - { $color = lc ($attrvalue) ; } |
| | 1762 | + &GetData; |
| | 1763 | + next PlotData; |
| | 1764 | + } |
| 1520 | 1765 | |
| 1521 | | - $color = $attrvalue ; |
| 1522 | | - } |
| 1523 | | - elsif ($attribute =~ /^BgColor$/i) |
| 1524 | | - { |
| 1525 | | - if (! &ColorPredefined ($attrvalue)) |
| 1526 | | - { |
| 1527 | | - if (! defined (@Colors {lc ($attrvalue)})) |
| 1528 | | - { &Error ("PlotData invalid. Attribute '$attribute' has unknown color '$attrvalue'.\n" . |
| 1529 | | - " Specify command 'Color' before this command.") ; |
| 1530 | | - &GetData ; next PlotData ; } |
| 1531 | | - } |
| 1532 | | - if (defined (@Colors {lc ($attrvalue)})) |
| 1533 | | - { $bgcolor = @Colors { lc ($attrvalue) } ; } |
| 1534 | | - else |
| 1535 | | - { $bgcolor = lc ($attrvalue) ; } |
| 1536 | | - } |
| 1537 | | - elsif ($attribute =~ /^TextColor$/i) |
| 1538 | | - { |
| 1539 | | - if (! &ColorPredefined ($attrvalue)) |
| 1540 | | - { |
| 1541 | | - if (! defined (@Colors {lc ($attrvalue)})) |
| 1542 | | - { &Error ("PlotData invalid. Attribute '$attribute' contains unknown color '$attrvalue'.\n" . |
| 1543 | | - " Specify command 'Color' before this command.") ; |
| 1544 | | - &GetData ; next PlotData ; } |
| 1545 | | - } |
| 1546 | | - if (defined (@Colors {lc ($attrvalue)})) |
| 1547 | | - { $textcolor = @Colors { lc ($attrvalue) } ; } |
| 1548 | | - else |
| 1549 | | - { $textcolor = lc ($attrvalue) ; } |
| 1550 | | - } |
| 1551 | | - elsif ($attribute =~ /^Width$/i) |
| 1552 | | - { |
| 1553 | | - $width = &Normalize ($attrvalue) ; |
| 1554 | | - if ($width > $MaxBarWidth) |
| 1555 | | - { $MaxBarWidth = $width ; } |
| 1556 | | - } |
| 1557 | | - elsif ($attribute =~ /^FontSize$/i) |
| 1558 | | - { |
| 1559 | | - if (($attrvalue !~ /\d+(?:\.\d)?/) && ($attrvalue !~ /xs|s|m|l|xl/i)) |
| 1560 | | - { &Error ("PlotData invalid. Specify for attribute '$attribute' a number of XS,S,M,L,XL.") ; |
| 1561 | | - &GetData ; next PlotData ; } |
| | 1766 | + if ($attribute =~ /^At$/i) { $at = $attrvalue; } |
| | 1767 | + elsif ($attribute =~ /^From$/i) { $from = $attrvalue; } |
| | 1768 | + else { $till = $attrvalue; } |
| | 1769 | + } |
| 1562 | 1770 | |
| 1563 | | - $fontsize = $attrvalue ; |
| 1564 | | - if ($fontsize =~ /(?:XS|S|M|L|XL)/i) |
| 1565 | | - { |
| 1566 | | - if ($fontsize !~ /(?:xs|s|m|l|xl)/i) |
| 1567 | | - { |
| 1568 | | - if ($fontsize < 6) |
| 1569 | | - { &Warning ("TextData attribute 'fontsize' value too low. Font size 6 assumed.\n") ; |
| 1570 | | - $fontsize = 6 ; } |
| 1571 | | - if ($fontsize > 30) |
| 1572 | | - { &Warning ("TextData attribute 'fontsize' value too high. Font size 30 assumed.\n") ; |
| 1573 | | - $fontsize = 30 ; } |
| 1574 | | - } |
| 1575 | | - } |
| 1576 | | - } |
| 1577 | | - elsif ($attribute =~ /^Anchor$/i) |
| 1578 | | - { |
| 1579 | | - if (! ($attrvalue =~ /^(?:from|till|middle)$/i)) |
| 1580 | | - { &Error ("PlotData value '$attribute' invalid. Specify 'from', 'till' or 'middle'.") ; |
| 1581 | | - &GetData ; next PlotData ; } |
| | 1771 | + # elsif ($attribute =~ /^From$/i) |
| | 1772 | + # { |
| | 1773 | + # if ($attrvalue =~ /^Start$/i) |
| | 1774 | + # { $attrvalue = @Period {"from"} ; } |
| 1582 | 1775 | |
| 1583 | | - $anchor = lc ($attrvalue) ; |
| 1584 | | - } |
| 1585 | | - elsif ($attribute =~ /^Align$/i) |
| 1586 | | - { |
| 1587 | | - if (! ($attrvalue =~ /^(?:left|right|center)$/i)) |
| 1588 | | - { &Error ("PlotData value '$attribute' invalid. Specify 'left', 'right' or 'center'.") ; |
| 1589 | | - &GetData ; next PlotData ; } |
| | 1776 | + # if (! &ValidDateFormat ($attrvalue)) |
| | 1777 | + # { &Error ("PlotData invalid.\nDate '$attrvalue' does not conform to specified DateFormat $DateFormat.") ; |
| | 1778 | + # &GetData ; next PlotData ; } |
| 1590 | 1779 | |
| 1591 | | - $align = lc ($attrvalue) ; |
| 1592 | | - } |
| 1593 | | - elsif ($attribute =~ /^Shift$/i) |
| 1594 | | - { |
| 1595 | | - $shift = $attrvalue ; |
| 1596 | | - $shift =~ s/$hBrO(.*?)$hBrC/$1/ ; |
| 1597 | | - $shift =~ s/\s//g ; |
| 1598 | | - ($shiftx2,$shifty2) = split (",", $shift) ; |
| 1599 | | - if ($shiftx2 ne "") |
| 1600 | | - { $shiftx = &Normalize ($shiftx2) ; } |
| 1601 | | - if ($shifty2 ne "") |
| 1602 | | - { $shifty = &Normalize ($shifty2) ; } |
| | 1780 | + # if (! &ValidDateRange ($attrvalue)) |
| | 1781 | + # { &Error ("Plotdata attribute 'from' invalid.\n" . |
| | 1782 | + # "Date '$attrvalue' not within range as specified by command Period.") ; |
| | 1783 | + # &GetData ; next PlotData ; } |
| 1603 | 1784 | |
| 1604 | | - if (($shiftx < -10) || ($shiftx > 10) || ($shifty < -10) || ($shifty > 10)) |
| 1605 | | - { &Error ("PlotData invalid. Attribute '$shift', specify value(s) between -1000 and 1000 pixels = -10 and 10 inch.") ; |
| 1606 | | - &GetData ; next PlotData ; } |
| 1607 | | - } |
| 1608 | | - elsif ($attribute =~ /^Text$/i) |
| 1609 | | - { |
| 1610 | | - $text = &ParseText ($attrvalue) ; |
| 1611 | | - $text =~ s/\\n/\n/g ; |
| 1612 | | - if ($text =~ /\^/) |
| 1613 | | - { &Warning ("TextData attribute 'text' contains ^ (caret).\n" . |
| 1614 | | - "Caret symbol will not be translated into tab character (use TextData when tabs are needed)") ; } |
| | 1785 | + # $from = $attrvalue ; |
| | 1786 | + # } |
| | 1787 | + # elsif ($attribute =~ /^Till$/i) |
| | 1788 | + # { |
| | 1789 | + # if ($attrvalue =~ /^End$/i) |
| | 1790 | + # { $attrvalue = @Period {"till"} ; } |
| 1615 | 1791 | |
| 1616 | | -# $text=~ s/(\[\[ [^\]]* \n [^\]]* \]\])/&NormalizeWikiLink($1)/gxe ; |
| 1617 | | - $text=~ s/(\[\[? [^\]]* \n [^\]]* \]?\])/&NormalizeWikiLink($1)/gxe ; |
| 1618 | | - } |
| 1619 | | - elsif ($attribute =~ /^Link$/i) |
| 1620 | | - { |
| 1621 | | - $link = &ParseText ($attrvalue) ; |
| 1622 | | - $link = &EncodeURL (&NormalizeURL ($link)) ; |
| 1623 | | - } |
| 1624 | | -# elsif ($attribute =~ /^Hint$/i) |
| 1625 | | -# { |
| 1626 | | -# $hint = &ParseText ($attrvalue) ; |
| 1627 | | -# $hint =~ s/\\n/\n/g ; |
| 1628 | | -# } |
| 1629 | | - elsif ($attribute =~ /^Mark$/i) |
| 1630 | | - { |
| 1631 | | - $attrvalue =~ s/$hBrO (.*) $hBrC/$1/x ; |
| 1632 | | - (@suboptions) = split (",", $attrvalue) ; |
| 1633 | | - $mark = @suboptions [0] ; |
| 1634 | | - if (! ($mark =~ /^(?:Line|None)$/i)) |
| 1635 | | - { &Error ("PlotData invalid. Value '$mark' for attribute 'mark' unknown.") ; |
| 1636 | | - &GetData ; next PlotData ; } |
| | 1792 | + # if (! &ValidDateFormat ($attrvalue)) |
| | 1793 | + # { &Error ("PlotData invalid. Date '$attrvalue' does not conform to specified DateFormat $DateFormat.") ; |
| | 1794 | + # &GetData ; next PlotData ; } |
| 1637 | 1795 | |
| 1638 | | - if (defined (@suboptions [1])) |
| 1639 | | - { |
| 1640 | | - $markcolor = @suboptions [1] ; |
| | 1796 | + # if (! &ValidDateRange ($attrvalue)) |
| | 1797 | + # { &Error ("Plotdata attribute 'till' invalid.\n" . |
| | 1798 | + # "Date '$attrvalue' not within range as specified by command Period.") ; |
| | 1799 | + # &GetData ; next PlotData ; } |
| 1641 | 1800 | |
| 1642 | | - if (! &ColorPredefined ($markcolor)) |
| 1643 | | - { |
| 1644 | | - if (! defined (@Colors {lc ($markcolor)})) |
| 1645 | | - { &Error ("PlotData invalid. Attribute 'mark': unknown color '$markcolor'.\n" . |
| 1646 | | - " Specify command 'Color' before this command.") ; |
| 1647 | | - &GetData ; next PlotData ; } |
| 1648 | | - } |
| 1649 | | - $markcolor = lc ($markcolor) ; |
| 1650 | | - } |
| 1651 | | - else |
| 1652 | | - { $markcolor = "black" ; } |
| 1653 | | - } |
| 1654 | | - else |
| 1655 | | - { &Error ("PlotData invalid. Unknown attribute '$attribute' found.") ; |
| 1656 | | - &GetData ; next PlotData ; } |
| 1657 | | - } |
| | 1801 | + # $till = $attrvalue ; |
| | 1802 | + # } |
| | 1803 | + elsif ($attribute =~ /^Color$/i) { |
| | 1804 | + if (!&ColorPredefined($attrvalue)) { |
| | 1805 | + if (!defined(@Colors{ lc($attrvalue) })) { |
| | 1806 | + &Error( |
| | 1807 | + "PlotData invalid. Attribute '$attribute' has unknown color '$attrvalue'.\n" |
| | 1808 | + . " Specify command 'Color' before this command." |
| | 1809 | + ); |
| | 1810 | + &GetData; |
| | 1811 | + next PlotData; |
| | 1812 | + } |
| | 1813 | + } |
| | 1814 | + if (defined(@Colors{ lc($attrvalue) })) { |
| | 1815 | + $color = @Colors{ lc($attrvalue) }; |
| | 1816 | + } |
| | 1817 | + else { $color = lc($attrvalue); } |
| 1658 | 1818 | |
| 1659 | | -# if ($text =~ /\[\[.*\[\[/s) |
| 1660 | | -# { &Error ("PlotData invalid. Text segment '$text' contains more than one wiki link. Only one allowed.") ; |
| 1661 | | -# &GetData ; next PlotData ; } |
| | 1819 | + $color = $attrvalue; |
| | 1820 | + } |
| | 1821 | + elsif ($attribute =~ /^BgColor$/i) { |
| | 1822 | + if (!&ColorPredefined($attrvalue)) { |
| | 1823 | + if (!defined(@Colors{ lc($attrvalue) })) { |
| | 1824 | + &Error( |
| | 1825 | + "PlotData invalid. Attribute '$attribute' has unknown color '$attrvalue'.\n" |
| | 1826 | + . " Specify command 'Color' before this command." |
| | 1827 | + ); |
| | 1828 | + &GetData; |
| | 1829 | + next PlotData; |
| | 1830 | + } |
| | 1831 | + } |
| | 1832 | + if (defined(@Colors{ lc($attrvalue) })) { |
| | 1833 | + $bgcolor = @Colors{ lc($attrvalue) }; |
| | 1834 | + } |
| | 1835 | + else { $bgcolor = lc($attrvalue); } |
| | 1836 | + } |
| | 1837 | + elsif ($attribute =~ /^TextColor$/i) { |
| | 1838 | + if (!&ColorPredefined($attrvalue)) { |
| | 1839 | + if (!defined(@Colors{ lc($attrvalue) })) { |
| | 1840 | + &Error( |
| | 1841 | + "PlotData invalid. Attribute '$attribute' contains unknown color '$attrvalue'.\n" |
| | 1842 | + . " Specify command 'Color' before this command." |
| | 1843 | + ); |
| | 1844 | + &GetData; |
| | 1845 | + next PlotData; |
| | 1846 | + } |
| | 1847 | + } |
| | 1848 | + if (defined(@Colors{ lc($attrvalue) })) { |
| | 1849 | + $textcolor = @Colors{ lc($attrvalue) }; |
| | 1850 | + } |
| | 1851 | + else { $textcolor = lc($attrvalue); } |
| | 1852 | + } |
| | 1853 | + elsif ($attribute =~ /^Width$/i) { |
| | 1854 | + $width = &Normalize($attrvalue); |
| | 1855 | + if ($width > $MaxBarWidth) { $MaxBarWidth = $width; } |
| | 1856 | + } |
| | 1857 | + elsif ($attribute =~ /^FontSize$/i) { |
| | 1858 | + if ( ($attrvalue !~ /\d+(?:\.\d)?/) |
| | 1859 | + && ($attrvalue !~ /xs|s|m|l|xl/i)) |
| | 1860 | + { |
| | 1861 | + &Error( |
| | 1862 | + "PlotData invalid. Specify for attribute '$attribute' a number of XS,S,M,L,XL." |
| | 1863 | + ); |
| | 1864 | + &GetData; |
| | 1865 | + next PlotData; |
| | 1866 | + } |
| 1662 | 1867 | |
| 1663 | | -# if (($text ne "") || ($link ne "")) |
| 1664 | | -# { ($text, $link, $hint) = &ProcessWikiLink ($text, $link, $hint) ; } |
| | 1868 | + $fontsize = $attrvalue; |
| | 1869 | + if ($fontsize =~ /(?:XS|S|M|L|XL)/i) { |
| | 1870 | + if ($fontsize !~ /(?:xs|s|m|l|xl)/i) { |
| | 1871 | + if ($fontsize < 6) { |
| | 1872 | + &Warning( |
| | 1873 | + "TextData attribute 'fontsize' value too low. Font size 6 assumed.\n" |
| | 1874 | + ); |
| | 1875 | + $fontsize = 6; |
| | 1876 | + } |
| | 1877 | + if ($fontsize > 30) { |
| | 1878 | + &Warning( |
| | 1879 | + "TextData attribute 'fontsize' value too high. Font size 30 assumed.\n" |
| | 1880 | + ); |
| | 1881 | + $fontsize = 30; |
| | 1882 | + } |
| | 1883 | + } |
| | 1884 | + } |
| | 1885 | + } |
| | 1886 | + elsif ($attribute =~ /^Anchor$/i) { |
| | 1887 | + if (!($attrvalue =~ /^(?:from|till|middle)$/i)) { |
| | 1888 | + &Error( |
| | 1889 | + "PlotData value '$attribute' invalid. Specify 'from', 'till' or 'middle'." |
| | 1890 | + ); |
| | 1891 | + &GetData; |
| | 1892 | + next PlotData; |
| | 1893 | + } |
| 1665 | 1894 | |
| 1666 | | - $shift = $shiftx . "," . $shifty ; |
| | 1895 | + $anchor = lc($attrvalue); |
| | 1896 | + } |
| | 1897 | + elsif ($attribute =~ /^Align$/i) { |
| | 1898 | + if (!($attrvalue =~ /^(?:left|right|center)$/i)) { |
| | 1899 | + &Error( |
| | 1900 | + "PlotData value '$attribute' invalid. Specify 'left', 'right' or 'center'." |
| | 1901 | + ); |
| | 1902 | + &GetData; |
| | 1903 | + next PlotData; |
| | 1904 | + } |
| 1667 | 1905 | |
| 1668 | | - if ($MaxBarWidth eq "") |
| 1669 | | - { $MaxBarWidth = $width - 0.001 ; } |
| | 1906 | + $align = lc($attrvalue); |
| | 1907 | + } |
| | 1908 | + elsif ($attribute =~ /^Shift$/i) { |
| | 1909 | + $shift = $attrvalue; |
| | 1910 | + $shift =~ s/$hBrO(.*?)$hBrC/$1/; |
| | 1911 | + $shift =~ s/\s//g; |
| | 1912 | + ($shiftx2, $shifty2) = split(",", $shift); |
| | 1913 | + if ($shiftx2 ne "") { $shiftx = &Normalize($shiftx2); } |
| | 1914 | + if ($shifty2 ne "") { $shifty = &Normalize($shifty2); } |
| 1670 | 1915 | |
| 1671 | | - if ($bar ne "") |
| 1672 | | - { |
| 1673 | | - if (! defined (@BarLegend {lc($bar)})) |
| 1674 | | - { @BarLegend {lc($bar)} = $bar ; } |
| 1675 | | - if (! defined (@BarWidths {$bar})) |
| 1676 | | - { @BarWidths {$bar} = $width ; } # was 0 ?? |
| 1677 | | - } |
| | 1916 | + if ( ($shiftx < -10) |
| | 1917 | + || ($shiftx > 10) |
| | 1918 | + || ($shifty < -10) |
| | 1919 | + || ($shifty > 10)) |
| | 1920 | + { |
| | 1921 | + &Error( |
| | 1922 | + "PlotData invalid. Attribute '$shift', specify value(s) between -1000 and 1000 pixels = -10 and 10 inch." |
| | 1923 | + ); |
| | 1924 | + &GetData; |
| | 1925 | + next PlotData; |
| | 1926 | + } |
| | 1927 | + } |
| | 1928 | + elsif ($attribute =~ /^Text$/i) { |
| | 1929 | + $text = &ParseText($attrvalue); |
| | 1930 | + $text =~ s/\\n/\n/g; |
| | 1931 | + if ($text =~ /\^/) { |
| | 1932 | + &Warning("TextData attribute 'text' contains ^ (caret).\n" |
| | 1933 | + . "Caret symbol will not be translated into tab character (use TextData when tabs are needed)" |
| | 1934 | + ); |
| | 1935 | + } |
| 1678 | 1936 | |
| 1679 | | - if (($at eq "") && ($from eq "") && ($till eq "")) # upd defaults |
| 1680 | | - { |
| 1681 | | - if ($bar ne "") { @PlotDefs {"bar"} = $bar ; } |
| 1682 | | -# if ($barset ne "") { @PlotDefs {"barset"} = $barset ; } |
| 1683 | | - if ($color ne "") { @PlotDefs {"color"} = $color ; } |
| 1684 | | - if ($bgcolor ne "") { @PlotDefs {"bgcolor"} = $bgcolor ; } |
| 1685 | | - if ($textcolor ne "") { @PlotDefs {"textcolor"} = $textcolor ; } |
| 1686 | | - if ($fontsize ne "") { @PlotDefs {"fontsize"} = $fontsize ; } |
| 1687 | | - if ($width ne "") { @PlotDefs {"width"} = $width ; } |
| 1688 | | - if ($anchor ne "") { @PlotDefs {"anchor"} = $anchor ; } |
| 1689 | | - if ($align ne "") { @PlotDefs {"align"} = $align ; } |
| 1690 | | - if ($shiftx ne "") { @PlotDefs {"shiftx"} = $shiftx ; } |
| 1691 | | - if ($shifty ne "") { @PlotDefs {"shifty"} = $shifty ; } |
| 1692 | | - if ($mark ne "") { @PlotDefs {"mark"} = $mark ; } |
| 1693 | | - if ($markcolor ne "") { @PlotDefs {"markcolor"} = $markcolor ; } |
| 1694 | | -# if ($link ne "") { @PlotDefs {"link"} = $link ; } |
| 1695 | | -# if ($hint ne "") { @PlotDefs {"hint"} = $hint ; } |
| 1696 | | - &GetData ; next PlotData ; |
| 1697 | | - } |
| | 1937 | + # $text=~ s/(\[\[ [^\]]* \n [^\]]* \]\])/&NormalizeWikiLink($1)/gxe ; |
| | 1938 | + $text =~ |
| | 1939 | + s/(\[\[? [^\]]* \n [^\]]* \]?\])/&NormalizeWikiLink($1)/gxe; |
| | 1940 | + } |
| | 1941 | + elsif ($attribute =~ /^Link$/i) { |
| | 1942 | + $link = &ParseText($attrvalue); |
| | 1943 | + $link = &EncodeURL(&NormalizeURL($link)); |
| | 1944 | + } |
| 1698 | 1945 | |
| 1699 | | - if ($bar eq "") |
| 1700 | | - { |
| 1701 | | - if ($prevbar ne "") |
| 1702 | | - { $bar = $prevbar ; } |
| 1703 | | - else |
| 1704 | | - { |
| 1705 | | -# if ($BarsCommandFound) |
| 1706 | | -# { |
| 1707 | | - if ($#Bars > 0) |
| 1708 | | - { &Error ("PlotData invalid. Specify attribute 'bar'.") ; |
| 1709 | | - &GetData ; next PlotData ; } |
| 1710 | | - elsif ($#Bars == 0) |
| 1711 | | - { |
| 1712 | | - $bar = @Bars [0] ; |
| 1713 | | - &Info ($data, "PlotData incomplete. Attribute 'bar' missing, value '" . @Bars [0] . "' assumed.") ; |
| 1714 | | - } |
| 1715 | | - else |
| 1716 | | - { $bar = "1" ; } |
| 1717 | | -# } |
| 1718 | | -# else |
| 1719 | | -# { |
| 1720 | | -# if ($#Bars > 0) |
| 1721 | | -# { &Error ("PlotData invalid. Attribute 'bar' missing.") ; |
| 1722 | | -# &GetData ; next PlotData ; } |
| 1723 | | -# elsif ($#Bars == 0) |
| 1724 | | -# { |
| 1725 | | -# $bar = @Bars [0] ; |
| 1726 | | -# &Info ($data, "PlotData incomplete. Attribute 'bar' missing, value '" . @Bars [0] . "' assumed.") ; |
| 1727 | | -# } |
| 1728 | | -# else { $bar = "1" ; } |
| 1729 | | -# } |
| 1730 | | - $prevbar = $bar ; |
| 1731 | | - } |
| 1732 | | - } |
| | 1946 | + # elsif ($attribute =~ /^Hint$/i) |
| | 1947 | + # { |
| | 1948 | + # $hint = &ParseText ($attrvalue) ; |
| | 1949 | + # $hint =~ s/\\n/\n/g ; |
| | 1950 | + # } |
| | 1951 | + elsif ($attribute =~ /^Mark$/i) { |
| | 1952 | + $attrvalue =~ s/$hBrO (.*) $hBrC/$1/x; |
| | 1953 | + (@suboptions) = split(",", $attrvalue); |
| | 1954 | + $mark = @suboptions[0]; |
| | 1955 | + if (!($mark =~ /^(?:Line|None)$/i)) { |
| | 1956 | + &Error( |
| | 1957 | + "PlotData invalid. Value '$mark' for attribute 'mark' unknown." |
| | 1958 | + ); |
| | 1959 | + &GetData; |
| | 1960 | + next PlotData; |
| | 1961 | + } |
| 1733 | 1962 | |
| 1734 | | - if (&BarDefined ($bar . "#1")) # bar is actually a bar set |
| 1735 | | - { |
| 1736 | | - if (($from ne "") || ($at ne "") || ($text eq " ")) # data line ? |
| 1737 | | - { |
| 1738 | | - $barndx++ ; |
| 1739 | | - if (! &BarDefined ($bar . "#" . $barndx)) |
| 1740 | | - { $barndx = 1 ; } |
| 1741 | | - $bar = $bar . "#" . $barndx ; |
| 1742 | | - # $text = $bar ; |
| 1743 | | - } |
| 1744 | | - } |
| | 1963 | + if (defined(@suboptions[1])) { |
| | 1964 | + $markcolor = @suboptions[1]; |
| 1745 | 1965 | |
| 1746 | | - if (($at ne "") && (($from ne "") || ($till ne ""))) |
| 1747 | | - { &Error ("PlotData invalid. Attributes 'at' and 'from/till' are mutually exclusive.") ; |
| 1748 | | - &GetData ; next PlotData ; } |
| | 1966 | + if (!&ColorPredefined($markcolor)) { |
| | 1967 | + if (!defined(@Colors{ lc($markcolor) })) { |
| | 1968 | + &Error( |
| | 1969 | + "PlotData invalid. Attribute 'mark': unknown color '$markcolor'.\n" |
| | 1970 | + . " Specify command 'Color' before this command." |
| | 1971 | + ); |
| | 1972 | + &GetData; |
| | 1973 | + next PlotData; |
| | 1974 | + } |
| | 1975 | + } |
| | 1976 | + $markcolor = lc($markcolor); |
| | 1977 | + } |
| | 1978 | + else { $markcolor = "black"; } |
| | 1979 | + } |
| | 1980 | + else { |
| | 1981 | + &Error( |
| | 1982 | + "PlotData invalid. Unknown attribute '$attribute' found." |
| | 1983 | + ); |
| | 1984 | + &GetData; |
| | 1985 | + next PlotData; |
| | 1986 | + } |
| | 1987 | + } |
| 1749 | 1988 | |
| 1750 | | - if ((($from eq "") && ($till ne "")) || (($from ne "") && ($till eq ""))) |
| 1751 | | - { &Error ("PlotData invalid. Specify attribute 'at' or 'from' + 'till'.") ; |
| 1752 | | - &GetData ; next PlotData ; } |
| | 1989 | + # if ($text =~ /\[\[.*\[\[/s) |
| | 1990 | + # { &Error ("PlotData invalid. Text segment '$text' contains more than one wiki link. Only one allowed.") ; |
| | 1991 | + # &GetData ; next PlotData ; } |
| 1753 | 1992 | |
| | 1993 | + # if (($text ne "") || ($link ne "")) |
| | 1994 | + # { ($text, $link, $hint) = &ProcessWikiLink ($text, $link, $hint) ; } |
| 1754 | 1995 | |
| 1755 | | - if ($at ne "") |
| 1756 | | - { |
| 1757 | | - if ($text ne "") |
| 1758 | | - { |
| 1759 | | - if ($align eq "") |
| 1760 | | - { &Error ("PlotData invalid. Attribute 'align' missing.") ; |
| 1761 | | - &GetData ; next PlotData ; } |
| 1762 | | - if ($fontsize eq "") |
| 1763 | | - { &Error ("PlotData invalid. Attribute '[font]size' missing.") ; |
| 1764 | | - &GetData ; next PlotData ; } |
| 1765 | | - if ($text eq "") |
| 1766 | | - { &Error ("PlotData invalid. Attribute 'text' missing.") ; |
| 1767 | | - &GetData ; next PlotData ; } |
| 1768 | | - } |
| 1769 | | - } |
| 1770 | | - else |
| 1771 | | - { |
| 1772 | | - if (($text ne "") && ($anchor eq "")) |
| 1773 | | - { &Error ("PlotData invalid. Attribute 'anchor' missing.") ; |
| 1774 | | - &GetData ; next PlotData ; } |
| 1775 | | - if ($color eq "") |
| 1776 | | - { &Error ("PlotData invalid. Attribute 'color' missing.") ; |
| 1777 | | - &GetData ; next PlotData ; } |
| 1778 | | - if ($width eq "") |
| 1779 | | - { &Error ("PlotData invalid. Attribute 'width' missing.") ; |
| 1780 | | - &GetData ; next PlotData ; } |
| 1781 | | - } |
| | 1996 | + $shift = $shiftx . "," . $shifty; |
| 1782 | 1997 | |
| 1783 | | - if ($from ne "") |
| 1784 | | - { |
| 1785 | | - if (($link ne "") && ($hint eq "")) |
| 1786 | | - { $hint = &ExternalLinkToHint ($link) ; } |
| | 1998 | + if ($MaxBarWidth eq "") { $MaxBarWidth = $width - 0.001; } |
| 1787 | 1999 | |
| 1788 | | - if (($link ne "") || ($hint ne "")) |
| 1789 | | - { $MapPNG = $true ; } |
| 1790 | | - if ($link ne "") |
| 1791 | | - { $MapSVG = $true ; } |
| | 2000 | + if ($bar ne "") { |
| | 2001 | + if (!defined(@BarLegend{ lc($bar) })) { |
| | 2002 | + @BarLegend{ lc($bar) } = $bar; |
| | 2003 | + } |
| | 2004 | + if (!defined(@BarWidths{$bar})) { |
| | 2005 | + @BarWidths{$bar} = $width; |
| | 2006 | + } # was 0 ?? |
| | 2007 | + } |
| 1792 | 2008 | |
| 1793 | | - push @PlotBars, sprintf ("%6.3f,%s,%s,%s,%s,%s,%s,\n", $width, $bar, $from, $till, lc ($color),$link,$hint) ; |
| 1794 | | - if ($width > @BarWidths {$bar}) |
| 1795 | | - { @BarWidths {$bar} = $width ; } |
| | 2009 | + if (($at eq "") && ($from eq "") && ($till eq "")) # upd defaults |
| | 2010 | + { |
| | 2011 | + if ($bar ne "") { @PlotDefs{"bar"} = $bar; } |
| 1796 | 2012 | |
| 1797 | | - if ($text ne "") |
| 1798 | | - { |
| 1799 | | - if ($anchor eq "from") |
| 1800 | | - { $at = $from ; } |
| 1801 | | - elsif ($anchor eq "till") |
| 1802 | | - { $at = $till ; } |
| 1803 | | - else |
| 1804 | | - { $at = &DateMedium ($from, $till) ; } |
| 1805 | | - } |
| | 2013 | + # if ($barset ne "") { @PlotDefs {"barset"} = $barset ; } |
| | 2014 | + if ($color ne "") { @PlotDefs{"color"} = $color; } |
| | 2015 | + if ($bgcolor ne "") { @PlotDefs{"bgcolor"} = $bgcolor; } |
| | 2016 | + if ($textcolor ne "") { @PlotDefs{"textcolor"} = $textcolor; } |
| | 2017 | + if ($fontsize ne "") { @PlotDefs{"fontsize"} = $fontsize; } |
| | 2018 | + if ($width ne "") { @PlotDefs{"width"} = $width; } |
| | 2019 | + if ($anchor ne "") { @PlotDefs{"anchor"} = $anchor; } |
| | 2020 | + if ($align ne "") { @PlotDefs{"align"} = $align; } |
| | 2021 | + if ($shiftx ne "") { @PlotDefs{"shiftx"} = $shiftx; } |
| | 2022 | + if ($shifty ne "") { @PlotDefs{"shifty"} = $shifty; } |
| | 2023 | + if ($mark ne "") { @PlotDefs{"mark"} = $mark; } |
| | 2024 | + if ($markcolor ne "") { @PlotDefs{"markcolor"} = $markcolor; } |
| 1806 | 2025 | |
| 1807 | | - if (($mark ne "") && ($mark !~ /none/i)) |
| 1808 | | - { |
| 1809 | | - push @PlotLines, sprintf ("%s,%s,%s,%s,,,\n", $bar, $from, $from, lc ($markcolor)) ; |
| 1810 | | - push @PlotLines, sprintf ("%s,%s,%s,%s,,,\n", $bar, $till, $till, lc ($markcolor)) ; |
| 1811 | | - $mark = "" ; |
| 1812 | | - } |
| 1813 | | - } |
| | 2026 | + # if ($link ne "") { @PlotDefs {"link"} = $link ; } |
| | 2027 | + # if ($hint ne "") { @PlotDefs {"hint"} = $hint ; } |
| | 2028 | + &GetData; |
| | 2029 | + next PlotData; |
| | 2030 | + } |
| 1814 | 2031 | |
| 1815 | | - if ($at ne "") |
| 1816 | | - { |
| 1817 | | - if (($mark ne "") && ($mark !~ /none/i)) |
| 1818 | | - { push @PlotLines, sprintf ("%s,%s,%s,%s,,,\n", $bar, $at, $at, lc ($markcolor)) ; } |
| | 2032 | + if ($bar eq "") { |
| | 2033 | + if ($prevbar ne "") { $bar = $prevbar; } |
| | 2034 | + else { |
| 1819 | 2035 | |
| 1820 | | - if ($text ne "") |
| 1821 | | - { |
| 1822 | | - my $textdetails = "" ; |
| | 2036 | + # if ($BarsCommandFound) |
| | 2037 | + # { |
| | 2038 | + if ($#Bars > 0) { |
| | 2039 | + &Error("PlotData invalid. Specify attribute 'bar'."); |
| | 2040 | + &GetData; |
| | 2041 | + next PlotData; |
| | 2042 | + } |
| | 2043 | + elsif ($#Bars == 0) { |
| | 2044 | + $bar = @Bars[0]; |
| | 2045 | + &Info($data, |
| | 2046 | + "PlotData incomplete. Attribute 'bar' missing, value '" |
| | 2047 | + . @Bars[0] |
| | 2048 | + . "' assumed."); |
| | 2049 | + } |
| | 2050 | + else { $bar = "1"; } |
| 1823 | 2051 | |
| 1824 | | - if ($link ne "") |
| | 2052 | + # } |
| | 2053 | + # else |
| | 2054 | + # { |
| | 2055 | + # if ($#Bars > 0) |
| | 2056 | + # { &Error ("PlotData invalid. Attribute 'bar' missing.") ; |
| | 2057 | + # &GetData ; next PlotData ; } |
| | 2058 | + # elsif ($#Bars == 0) |
| | 2059 | + # { |
| | 2060 | + # $bar = @Bars [0] ; |
| | 2061 | + # &Info ($data, "PlotData incomplete. Attribute 'bar' missing, value '" . @Bars [0] . "' assumed.") ; |
| | 2062 | + # } |
| | 2063 | + # else { $bar = "1" ; } |
| | 2064 | + # } |
| | 2065 | + $prevbar = $bar; |
| | 2066 | + } |
| | 2067 | + } |
| | 2068 | + |
| | 2069 | + if (&BarDefined($bar . "#1")) # bar is actually a bar set |
| 1825 | 2070 | { |
| 1826 | | - if ($text =~ /\[.*\]/) |
| 1827 | | - { |
| 1828 | | - &Warning ("PlotData contains implicit link(s) in attribute 'text' and explicit attribute 'link'. " . |
| 1829 | | - "Implicit link(s) ignored.") ; |
| 1830 | | - $text =~ s/\[+ (?:[^\|]* \|)? ([^\]]*) \]+/$1/gx ; |
| 1831 | | - } |
| 1832 | | - if ($hint eq "") |
| 1833 | | - { $hint = &ExternalLinkToHint ($link) ; } |
| | 2071 | + if (($from ne "") || ($at ne "") || ($text eq " ")) # data line ? |
| | 2072 | + { |
| | 2073 | + $barndx++; |
| | 2074 | + if (!&BarDefined($bar . "#" . $barndx)) { $barndx = 1; } |
| | 2075 | + $bar = $bar . "#" . $barndx; |
| | 2076 | + |
| | 2077 | + # $text = $bar ; |
| | 2078 | + } |
| 1834 | 2079 | } |
| 1835 | 2080 | |
| 1836 | | - if ($anchor eq "") |
| 1837 | | - { $anchor = "middle" ; } |
| 1838 | | - if ($align eq "") |
| 1839 | | - { $align = "center" ; } |
| 1840 | | - if ($color eq "") |
| 1841 | | - { $color = "black" ; } |
| 1842 | | - if ($fontsize eq "") |
| 1843 | | - { $fontsize = "S" ; } |
| 1844 | | - if ($adjust eq "") |
| 1845 | | - { $adjust = "0,0" ; } |
| | 2081 | + if (($at ne "") && (($from ne "") || ($till ne ""))) { |
| | 2082 | + &Error( |
| | 2083 | + "PlotData invalid. Attributes 'at' and 'from/till' are mutually exclusive." |
| | 2084 | + ); |
| | 2085 | + &GetData; |
| | 2086 | + next PlotData; |
| | 2087 | + } |
| 1846 | 2088 | |
| 1847 | | -# $textdetails = " textdetails: align=$align size=$size" ; |
| 1848 | | -# if ($textcolor eq "") |
| 1849 | | -# { $textcolor = "black" ; } |
| 1850 | | -# if ($color ne "") |
| 1851 | | -# { $textdetails .= " color=$textcolor" ; } |
| | 2089 | + if ( (($from eq "") && ($till ne "")) |
| | 2090 | + || (($from ne "") && ($till eq ""))) |
| | 2091 | + { |
| | 2092 | + &Error( |
| | 2093 | + "PlotData invalid. Specify attribute 'at' or 'from' + 'till'." |
| | 2094 | + ); |
| | 2095 | + &GetData; |
| | 2096 | + next PlotData; |
| | 2097 | + } |
| 1852 | 2098 | |
| 1853 | | -# my ($xpos, $ypos) ; |
| 1854 | | -# my $barcnt = 0 ; |
| 1855 | | -# for ($b = 0 ; $b <= $#Bars ; $b++) |
| 1856 | | -# { |
| 1857 | | -# if (lc(@Bars [$b]) eq lc($bar)) |
| 1858 | | -# { $barcnt = ($b + 1) ; last ; } |
| 1859 | | -# } |
| | 2099 | + if ($at ne "") { |
| | 2100 | + if ($text ne "") { |
| | 2101 | + if ($align eq "") { |
| | 2102 | + &Error("PlotData invalid. Attribute 'align' missing."); |
| | 2103 | + &GetData; |
| | 2104 | + next PlotData; |
| | 2105 | + } |
| | 2106 | + if ($fontsize eq "") { |
| | 2107 | + &Error( |
| | 2108 | + "PlotData invalid. Attribute '[font]size' missing."); |
| | 2109 | + &GetData; |
| | 2110 | + next PlotData; |
| | 2111 | + } |
| | 2112 | + if ($text eq "") { |
| | 2113 | + &Error("PlotData invalid. Attribute 'text' missing."); |
| | 2114 | + &GetData; |
| | 2115 | + next PlotData; |
| | 2116 | + } |
| | 2117 | + } |
| | 2118 | + } |
| | 2119 | + else { |
| | 2120 | + if (($text ne "") && ($anchor eq "")) { |
| | 2121 | + &Error("PlotData invalid. Attribute 'anchor' missing."); |
| | 2122 | + &GetData; |
| | 2123 | + next PlotData; |
| | 2124 | + } |
| | 2125 | + if ($color eq "") { |
| | 2126 | + &Error("PlotData invalid. Attribute 'color' missing."); |
| | 2127 | + &GetData; |
| | 2128 | + next PlotData; |
| | 2129 | + } |
| | 2130 | + if ($width eq "") { |
| | 2131 | + &Error("PlotData invalid. Attribute 'width' missing."); |
| | 2132 | + &GetData; |
| | 2133 | + next PlotData; |
| | 2134 | + } |
| | 2135 | + } |
| 1860 | 2136 | |
| 1861 | | -# if (@Axis {"time"} eq "x") |
| 1862 | | -# { $xpos = "$at(s)" ; $ypos = "[$barcnt](s)" ; } |
| 1863 | | -# else |
| 1864 | | -# { $ypos = "$at(s)" ; $xpos = "[$barcnt](s)" ; } |
| | 2137 | + if ($from ne "") { |
| | 2138 | + if (($link ne "") && ($hint eq "")) { |
| | 2139 | + $hint = &ExternalLinkToHint($link); |
| | 2140 | + } |
| 1865 | 2141 | |
| 1866 | | -# if ($shift ne "") |
| 1867 | | -# { |
| 1868 | | -# my ($shiftx, $shifty) = split (",", $shift) ; |
| 1869 | | -# if ($shiftx > 0) |
| 1870 | | -# { $xpos .= "+$shiftx" ; } |
| 1871 | | -# if ($shiftx < 0) |
| 1872 | | -# { $xpos .= "$shiftx" ; } |
| 1873 | | -# if ($shifty > 0) |
| 1874 | | -# { $ypos .= "+$shifty" ; } |
| 1875 | | -# if ($shifty < 0) |
| 1876 | | -# { $ypos .= "$shifty" ; } |
| 1877 | | -# } |
| | 2142 | + if (($link ne "") || ($hint ne "")) { $MapPNG = $true; } |
| | 2143 | + if ($link ne "") { $MapSVG = $true; } |
| 1878 | 2144 | |
| 1879 | | - $text =~ s/\,/\#\%\$/g ; |
| 1880 | | - $link =~ s/\,/\#\%\$/g ; |
| 1881 | | - $hint =~ s/\,/\#\%\$/g ; |
| 1882 | | - $shift =~ s/\,/\#\%\$/g ; |
| 1883 | | - $textcolor =~ s/\,/\#\%\$/g ; |
| 1884 | | - push @PlotText, sprintf ("%s,%s,%s,%s,%s,%s,%s,%s,%s", $at, $bar, $text, $textcolor, $fontsize, $align, $shift, $link, $hint) ; |
| 1885 | | - } |
| 1886 | | - } |
| | 2145 | + push @PlotBars, |
| | 2146 | + sprintf("%6.3f,%s,%s,%s,%s,%s,%s,\n", |
| | 2147 | + $width, $bar, $from, $till, lc($color), $link, $hint); |
| | 2148 | + if ($width > @BarWidths{$bar}) { @BarWidths{$bar} = $width; } |
| 1887 | 2149 | |
| 1888 | | - &GetData ; |
| 1889 | | - } |
| | 2150 | + if ($text ne "") { |
| | 2151 | + if ($anchor eq "from") { $at = $from; } |
| | 2152 | + elsif ($anchor eq "till") { $at = $till; } |
| | 2153 | + else { $at = &DateMedium($from, $till); } |
| | 2154 | + } |
| 1890 | 2155 | |
| 1891 | | - if ((! $BarsCommandFound) && ($#Bars > 1)) |
| 1892 | | - { &Info2 ("PlotBars definition: no (valid) command 'BarData' found in previous lines.\nBars will presented in order of appearance in PlotData.") ; } |
| | 2156 | + if (($mark ne "") && ($mark !~ /none/i)) { |
| | 2157 | + push @PlotLines, |
| | 2158 | + sprintf("%s,%s,%s,%s,,,\n", |
| | 2159 | + $bar, $from, $from, lc($markcolor)); |
| | 2160 | + push @PlotLines, |
| | 2161 | + sprintf("%s,%s,%s,%s,,,\n", |
| | 2162 | + $bar, $till, $till, lc($markcolor)); |
| | 2163 | + $mark = ""; |
| | 2164 | + } |
| | 2165 | + } |
| 1893 | 2166 | |
| 1894 | | - $maxwidth = 0 ; |
| 1895 | | - foreach $key (keys %BarWidths) |
| 1896 | | - { |
| 1897 | | - if (@BarWidths {$key} == 0) |
| 1898 | | - { &Warning ("PlotData incomplete. No bar width defined for bar '$key', assume width from widest bar (used for line marks).") ; } |
| 1899 | | - elsif (@BarWidths {$key} > $maxwidth) |
| 1900 | | - { $maxwidth = @BarWidths {$key} ; } |
| 1901 | | - } |
| 1902 | | - foreach $key (keys %BarWidths) |
| 1903 | | - { |
| 1904 | | - if (@BarWidths {$key} == 0) |
| 1905 | | - { @BarWidths {$key} = $maxwidth ; } |
| 1906 | | - } |
| 1907 | | -} |
| | 2167 | + if ($at ne "") { |
| | 2168 | + if (($mark ne "") && ($mark !~ /none/i)) { |
| | 2169 | + push @PlotLines, |
| | 2170 | + sprintf("%s,%s,%s,%s,,,\n", |
| | 2171 | + $bar, $at, $at, lc($markcolor)); |
| | 2172 | + } |
| 1908 | 2173 | |
| 1909 | | -sub ParsePreset |
| 1910 | | -{ |
| 1911 | | - if (! $firstcmd) |
| 1912 | | - { &Error ("Specify 'Preset' command before any other commands, if desired at all.\n") ; return ; } |
| | 2174 | + if ($text ne "") { |
| | 2175 | + my $textdetails = ""; |
| 1913 | 2176 | |
| 1914 | | - $preset = @Attributes {"single"} ; |
| 1915 | | - if ($preset !~ /^(?:TimeVertical_OneBar_UnitYear|TimeHorizontal_AutoPlaceBars_UnitYear)$/i) |
| 1916 | | - { &Error ("Preset value invalid.\n" . |
| 1917 | | - " At the moment two presets are available:\n" . |
| 1918 | | - " TimeVertical_OneBar_UnitYear and TimeHorizontal_AutoPlaceBars_UnitYear\n" . |
| 1919 | | - " See also meta.wikipedia.org/wiki/EasyTimeline/Presets") ; return ; } |
| | 2177 | + if ($link ne "") { |
| | 2178 | + if ($text =~ /\[.*\]/) { |
| | 2179 | + &Warning( |
| | 2180 | + "PlotData contains implicit link(s) in attribute 'text' and explicit attribute 'link'. " |
| | 2181 | + . "Implicit link(s) ignored."); |
| | 2182 | + $text =~ s/\[+ (?:[^\|]* \|)? ([^\]]*) \]+/$1/gx; |
| | 2183 | + } |
| | 2184 | + if ($hint eq "") { $hint = &ExternalLinkToHint($link); } |
| | 2185 | + } |
| 1920 | 2186 | |
| 1921 | | - $Preset = $preset ; |
| | 2187 | + if ($anchor eq "") { $anchor = "middle"; } |
| | 2188 | + if ($align eq "") { $align = "center"; } |
| | 2189 | + if ($color eq "") { $color = "black"; } |
| | 2190 | + if ($fontsize eq "") { $fontsize = "S"; } |
| | 2191 | + if ($adjust eq "") { $adjust = "0,0"; } |
| 1922 | 2192 | |
| 1923 | | - if ($Preset =~ /^TimeVertical_OneBar_UnitYear/i) |
| 1924 | | - { |
| 1925 | | - $DateFormat = "yyyy" ; |
| 1926 | | - $AlignBars = "early" ; |
| 1927 | | - @Axis {"format"} = "yyyy" ; |
| 1928 | | - @Axis {"time"} = "y" ; |
| 1929 | | - @PlotArea {"left"} = 45 ; |
| 1930 | | - @PlotArea {"right"} = 10 ; |
| 1931 | | - @PlotArea {"top"} = 10 ; |
| 1932 | | - @PlotArea {"bottom"} = 10 ; |
| 1933 | | - push @PresetList, "PlotArea|+|left|" . @PlotArea {"left"} ; |
| 1934 | | - push @PresetList, "PlotArea|+|right|" . @PlotArea {"right"}; |
| 1935 | | - push @PresetList, "PlotArea|+|top|" . @PlotArea {"top"} ; |
| 1936 | | - push @PresetList, "PlotArea|+|bottom|" . @PlotArea {"bottom"} ; |
| 1937 | | - push @PresetList, "PlotArea|-|width" ; |
| 1938 | | - push @PresetList, "PlotArea|-|height" ; |
| 1939 | | - push @PresetList, "Dateformat|-||yyyy" ; |
| 1940 | | - push @PresetList, "TimeAxis|=|format|" . @Axis {"format"} ; |
| 1941 | | - push @PresetList, "TimeAxis|=|orientation|vertical" ; |
| 1942 | | - push @PresetList, "ScaleMajor|=|unit|year" ; |
| 1943 | | - push @PresetList, "ScaleMinor|=|unit|year" ; |
| 1944 | | - push @PresetList, "AlignBars|=||early" ; |
| 1945 | | - push @PresetList, "PlotData|+|mark|" . $hBrO . "line,white" . $hBrC ; |
| 1946 | | - push @PresetList, "PlotData|+|align|left" ; |
| 1947 | | - push @PresetList, "PlotData|+|fontsize|S" ; |
| 1948 | | - push @PresetList, "PlotData|+|width|20" ; |
| 1949 | | - push @PresetList, "PlotData|+|shift|" . $hBrO . "20,0" . $hBrC ; |
| 1950 | | - } |
| 1951 | | - elsif ($Preset =~ /TimeHorizontal_AutoPlaceBars_UnitYear/i) |
| 1952 | | - { |
| 1953 | | - $DateFormat = "yyyy" ; |
| 1954 | | - $AlignBars = "justify" ; |
| 1955 | | - @Axis {"format"} = "yyyy" ; |
| 1956 | | - @Axis {"time"} = "x" ; |
| 1957 | | - @PlotArea {"left"} = 25 ; |
| 1958 | | - @PlotArea {"right"} = 25 ; |
| 1959 | | - @PlotArea {"top"} = 15 ; |
| 1960 | | - @PlotArea {"bottom"} = 30 ; |
| 1961 | | - @Image {"height"} = "auto" ; |
| 1962 | | - @Image {"barinc"} = 20 ; |
| 1963 | | - @BackgroundColors {"canvas"} = "gray(0.7)" ; |
| 1964 | | - @Legend {"orientation"} = "ver" ; |
| 1965 | | - @Legend {"left"} = @PlotArea {"left"}+10 ; |
| 1966 | | - @Legend {"top"} = @PlotArea {"bottom"}+100 ; |
| 1967 | | - &StoreColor ("canvas", &EncodeInput ("gray(0.7)"), "") ; |
| 1968 | | - &StoreColor ("grid1", &EncodeInput ("gray(0.4)"), "") ; |
| 1969 | | - &StoreColor ("grid2", &EncodeInput ("gray(0.2)"), "") ; |
| 1970 | | - push @PresetList, "ImageSize|=|height|auto" ; |
| 1971 | | - push @PresetList, "ImageSize|+|barincrement|20" ; |
| 1972 | | - push @PresetList, "PlotArea|+|left|" . @PlotArea {"left"} ; |
| 1973 | | - push @PresetList, "PlotArea|+|right|" . @PlotArea {"right"}; |
| 1974 | | - push @PresetList, "PlotArea|+|top|" . @PlotArea {"top"} ; |
| 1975 | | - push @PresetList, "PlotArea|+|bottom|" . @PlotArea {"bottom"} ; |
| 1976 | | - push @PresetList, "PlotArea|-|width" ; |
| 1977 | | - push @PresetList, "PlotArea|-|height" ; |
| 1978 | | - push @PresetList, "Dateformat|-||yyyy" ; |
| 1979 | | - push @PresetList, "TimeAxis|=|format|" . @Axis {"format"} ; |
| 1980 | | - push @PresetList, "TimeAxis|=|orientation|horizontal" ; |
| 1981 | | - push @PresetList, "ScaleMajor|=|unit|year" ; |
| 1982 | | - push @PresetList, "ScaleMajor|+|grid|grid1" ; |
| 1983 | | - push @PresetList, "ScaleMinor|=|unit|year" ; |
| 1984 | | - push @PresetList, "AlignBars|=||justify" ; |
| 1985 | | - push @PresetList, "Legend|+|orientation|" . @Legend {"orientation"} ; |
| 1986 | | - push @PresetList, "Legend|+|left|" . @Legend {"left"} ; |
| 1987 | | - push @PresetList, "Legend|+|top|" . @Legend {"top"} ; |
| 1988 | | - push @PresetList, "PlotData|+|align|left" ; |
| 1989 | | - push @PresetList, "PlotData|+|anchor|from" ; |
| 1990 | | - push @PresetList, "PlotData|+|fontsize|M" ; |
| 1991 | | - push @PresetList, "PlotData|+|width|15" ; |
| 1992 | | - push @PresetList, "PlotData|+|textcolor|black" ; |
| 1993 | | - push @PresetList, "PlotData|+|shift|" . $hBrO . "4,-6" . $hBrC ; |
| 1994 | | - } |
| 1995 | | -} |
| | 2193 | + # $textdetails = " textdetails: align=$align size=$size" ; |
| | 2194 | + # if ($textcolor eq "") |
| | 2195 | + # { $textcolor = "black" ; } |
| | 2196 | + # if ($color ne "") |
| | 2197 | + # { $textdetails .= " color=$textcolor" ; } |
| 1996 | 2198 | |
| 1997 | | -sub ParseScale |
| 1998 | | -{ |
| 1999 | | - my ($scale) ; |
| | 2199 | + # my ($xpos, $ypos) ; |
| | 2200 | + # my $barcnt = 0 ; |
| | 2201 | + # for ($b = 0 ; $b <= $#Bars ; $b++) |
| | 2202 | + # { |
| | 2203 | + # if (lc(@Bars [$b]) eq lc($bar)) |
| | 2204 | + # { $barcnt = ($b + 1) ; last ; } |
| | 2205 | + # } |
| 2000 | 2206 | |
| 2001 | | - if ($Command =~ /ScaleMajor/i) |
| 2002 | | - { $scale .= 'Major' ; } |
| 2003 | | - else |
| 2004 | | - { $scale .= 'Minor' ; } |
| | 2207 | + # if (@Axis {"time"} eq "x") |
| | 2208 | + # { $xpos = "$at(s)" ; $ypos = "[$barcnt](s)" ; } |
| | 2209 | + # else |
| | 2210 | + # { $ypos = "$at(s)" ; $xpos = "[$barcnt](s)" ; } |
| 2005 | 2211 | |
| 2006 | | - if (! ValidAttributes ("Scale" . $scale)) { return ; } |
| | 2212 | + # if ($shift ne "") |
| | 2213 | + # { |
| | 2214 | + # my ($shiftx, $shifty) = split (",", $shift) ; |
| | 2215 | + # if ($shiftx > 0) |
| | 2216 | + # { $xpos .= "+$shiftx" ; } |
| | 2217 | + # if ($shiftx < 0) |
| | 2218 | + # { $xpos .= "$shiftx" ; } |
| | 2219 | + # if ($shifty > 0) |
| | 2220 | + # { $ypos .= "+$shifty" ; } |
| | 2221 | + # if ($shifty < 0) |
| | 2222 | + # { $ypos .= "$shifty" ; } |
| | 2223 | + # } |
| 2007 | 2224 | |
| 2008 | | - &CheckPreset (Scale . $scale) ; |
| | 2225 | + $text =~ s/\,/\#\%\$/g; |
| | 2226 | + $link =~ s/\,/\#\%\$/g; |
| | 2227 | + $hint =~ s/\,/\#\%\$/g; |
| | 2228 | + $shift =~ s/\,/\#\%\$/g; |
| | 2229 | + $textcolor =~ s/\,/\#\%\$/g; |
| | 2230 | + push @PlotText, |
| | 2231 | + sprintf( |
| | 2232 | + "%s,%s,%s,%s,%s,%s,%s,%s,%s", |
| | 2233 | + $at, $bar, $text, |
| | 2234 | + $textcolor, $fontsize, $align, |
| | 2235 | + $shift, $link, $hint |
| | 2236 | + ); |
| | 2237 | + } |
| | 2238 | + } |
| 2009 | 2239 | |
| 2010 | | - @Scales {$scale} = $true ; |
| | 2240 | + &GetData; |
| | 2241 | + } |
| 2011 | 2242 | |
| 2012 | | - foreach $attribute (keys %Attributes) |
| 2013 | | - { |
| 2014 | | - my $attrvalue = @Attributes {$attribute} ; |
| | 2243 | + if ((!$BarsCommandFound) && ($#Bars > 1)) { |
| | 2244 | + &Info2( |
| | 2245 | + "PlotBars definition: no (valid) command 'BarData' found in previous lines.\nBars will presented in order of appearance in PlotData." |
| | 2246 | + ); |
| | 2247 | + } |
| 2015 | 2248 | |
| 2016 | | - if ($attribute =~ /Grid/i) # preferred gridcolor instead of grid, grid allowed for compatability |
| 2017 | | - { |
| 2018 | | - if ((! &ColorPredefined ($attrvalue)) && (! defined (@Colors {lc ($attrvalue)}))) |
| 2019 | | - { &Error ("Scale attribute '$attribute' invalid. Unknown color '$attrvalue'.\n" . |
| 2020 | | - " Specify command 'Color' before this command.") ; return ; } |
| 2021 | | - @Attributes {$scale . " grid"} = $attrvalue ; |
| 2022 | | - delete (@Attributes {"grid"}) ; |
| | 2249 | + $maxwidth = 0; |
| | 2250 | + foreach $key (keys %BarWidths) { |
| | 2251 | + if (@BarWidths{$key} == 0) { |
| | 2252 | + &Warning( |
| | 2253 | + "PlotData incomplete. No bar width defined for bar '$key', assume width from widest bar (used for line marks)." |
| | 2254 | + ); |
| | 2255 | + } |
| | 2256 | + elsif (@BarWidths{$key} > $maxwidth) { |
| | 2257 | + $maxwidth = @BarWidths{$key}; |
| | 2258 | + } |
| 2023 | 2259 | } |
| 2024 | | - elsif ($attribute =~ /Text/i) |
| 2025 | | - { |
| 2026 | | - $attrvalue =~ s/\~/\\n/g ; |
| 2027 | | - $attrvalue =~ s/^\"//g ; |
| 2028 | | - $attrvalue =~ s/\"$//g ; |
| 2029 | | - @Attributes {$scale . " stubs"} = $attrvalue ; |
| | 2260 | + foreach $key (keys %BarWidths) { |
| | 2261 | + if (@BarWidths{$key} == 0) { @BarWidths{$key} = $maxwidth; } |
| 2030 | 2262 | } |
| 2031 | | - elsif ($attribute =~ /Unit/i) |
| 2032 | | - { |
| 2033 | | - if ($DateFormat eq "yyyy") |
| 2034 | | - { |
| 2035 | | - if (! ($attrvalue =~ /^(?:year|years)$/i)) |
| 2036 | | - { &Error ("Scale attribute '$attribute' invalid. DateFormat 'yyyy' implies 'unit:year'.") ; return ; } |
| 2037 | | - } |
| 2038 | | - else |
| 2039 | | - { |
| 2040 | | - if (! ($attrvalue =~ /^(?:year|month|day)s?$/i)) |
| 2041 | | - { &Error ("Scale attribute '$attribute' invalid. Specify year, month or day.") ; return ; } |
| 2042 | | - } |
| 2043 | | - $attrvalue =~ s/s$// ; |
| 2044 | | - @Attributes {$scale . " unit"} = $attrvalue ; |
| 2045 | | - delete (@Attributes {"unit"}) ; |
| | 2263 | +} |
| | 2264 | + |
| | 2265 | +sub ParsePreset { |
| | 2266 | + if (!$firstcmd) { |
| | 2267 | + &Error( |
| | 2268 | + "Specify 'Preset' command before any other commands, if desired at all.\n" |
| | 2269 | + ); |
| | 2270 | + return; |
| 2046 | 2271 | } |
| 2047 | | - elsif ($attribute =~ /Increment/i) |
| | 2272 | + |
| | 2273 | + $preset = @Attributes{"single"}; |
| | 2274 | + if ($preset !~ |
| | 2275 | + /^(?:TimeVertical_OneBar_UnitYear|TimeHorizontal_AutoPlaceBars_UnitYear)$/i |
| | 2276 | + ) |
| 2048 | 2277 | { |
| 2049 | | - if ((! ($attrvalue =~ /^\d+$/i)) || ($attrvalue == 0)) |
| 2050 | | - { &Error ("Scale attribute '$attribute' invalid. Specify positive integer.") ; return ; } |
| 2051 | | - @Attributes {$scale . " inc"} = $attrvalue ; |
| 2052 | | - delete (@Attributes {"increment"}) ; |
| | 2278 | + &Error( "Preset value invalid.\n" |
| | 2279 | + . " At the moment two presets are available:\n" |
| | 2280 | + . " TimeVertical_OneBar_UnitYear and TimeHorizontal_AutoPlaceBars_UnitYear\n" |
| | 2281 | + . " See also meta.wikipedia.org/wiki/EasyTimeline/Presets"); |
| | 2282 | + return; |
| 2053 | 2283 | } |
| 2054 | | - elsif ($attribute =~ /Start/i) |
| 2055 | | - { |
| 2056 | | - if (! (defined ($DateFormat))) |
| 2057 | | - { &Error ("Scale attribute '$attribute' invalid.\n" . |
| 2058 | | - "No (valid) command 'DateFormat' specified in previous lines.") ; return ; } |
| 2059 | 2284 | |
| 2060 | | - if (($DateFormat eq "dd/mm/yyyy") || ($DateFormat eq "mm/dd/yyyy")) |
| 2061 | | - { |
| 2062 | | - if (($attrvalue =~ /^\d+$/) && ($attrvalue >= 1800) && ($attrvalue <= 2030)) |
| 2063 | | - { $attrvalue = "01/01/" . $attrvalue ; } |
| 2064 | | - } |
| | 2285 | + $Preset = $preset; |
| 2065 | 2286 | |
| 2066 | | - if (! &ValidDateFormat ($attrvalue)) |
| 2067 | | - { &Error ("Scale attribute '$attribute' invalid.\n" . |
| 2068 | | - "Date does not conform to specified DateFormat '$DateFormat'.") ; return ; } |
| | 2287 | + if ($Preset =~ /^TimeVertical_OneBar_UnitYear/i) { |
| | 2288 | + $DateFormat = "yyyy"; |
| | 2289 | + $AlignBars = "early"; |
| | 2290 | + @Axis{"format"} = "yyyy"; |
| | 2291 | + @Axis{"time"} = "y"; |
| | 2292 | + @PlotArea{"left"} = 45; |
| | 2293 | + @PlotArea{"right"} = 10; |
| | 2294 | + @PlotArea{"top"} = 10; |
| | 2295 | + @PlotArea{"bottom"} = 10; |
| | 2296 | + push @PresetList, "PlotArea|+|left|" . @PlotArea{"left"}; |
| | 2297 | + push @PresetList, "PlotArea|+|right|" . @PlotArea{"right"}; |
| | 2298 | + push @PresetList, "PlotArea|+|top|" . @PlotArea{"top"}; |
| | 2299 | + push @PresetList, "PlotArea|+|bottom|" . @PlotArea{"bottom"}; |
| | 2300 | + push @PresetList, "PlotArea|-|width"; |
| | 2301 | + push @PresetList, "PlotArea|-|height"; |
| | 2302 | + push @PresetList, "Dateformat|-||yyyy"; |
| | 2303 | + push @PresetList, "TimeAxis|=|format|" . @Axis{"format"}; |
| | 2304 | + push @PresetList, "TimeAxis|=|orientation|vertical"; |
| | 2305 | + push @PresetList, "ScaleMajor|=|unit|year"; |
| | 2306 | + push @PresetList, "ScaleMinor|=|unit|year"; |
| | 2307 | + push @PresetList, "AlignBars|=||early"; |
| | 2308 | + push @PresetList, "PlotData|+|mark|" . $hBrO . "line,white" . $hBrC; |
| | 2309 | + push @PresetList, "PlotData|+|align|left"; |
| | 2310 | + push @PresetList, "PlotData|+|fontsize|S"; |
| | 2311 | + push @PresetList, "PlotData|+|width|20"; |
| | 2312 | + push @PresetList, "PlotData|+|shift|" . $hBrO . "20,0" . $hBrC; |
| | 2313 | + } |
| | 2314 | + elsif ($Preset =~ /TimeHorizontal_AutoPlaceBars_UnitYear/i) { |
| | 2315 | + $DateFormat = "yyyy"; |
| | 2316 | + $AlignBars = "justify"; |
| | 2317 | + @Axis{"format"} = "yyyy"; |
| | 2318 | + @Axis{"time"} = "x"; |
| | 2319 | + @PlotArea{"left"} = 25; |
| | 2320 | + @PlotArea{"right"} = 25; |
| | 2321 | + @PlotArea{"top"} = 15; |
| | 2322 | + @PlotArea{"bottom"} = 30; |
| | 2323 | + @Image{"height"} = "auto"; |
| | 2324 | + @Image{"barinc"} = 20; |
| | 2325 | + @BackgroundColors{"canvas"} = "gray(0.7)"; |
| | 2326 | + @Legend{"orientation"} = "ver"; |
| | 2327 | + @Legend{"left"} = @PlotArea{"left"} + 10; |
| | 2328 | + @Legend{"top"} = @PlotArea{"bottom"} + 100; |
| | 2329 | + &StoreColor("canvas", &EncodeInput("gray(0.7)"), ""); |
| | 2330 | + &StoreColor("grid1", &EncodeInput("gray(0.4)"), ""); |
| | 2331 | + &StoreColor("grid2", &EncodeInput("gray(0.2)"), ""); |
| | 2332 | + push @PresetList, "ImageSize|=|height|auto"; |
| | 2333 | + push @PresetList, "ImageSize|+|barincrement|20"; |
| | 2334 | + push @PresetList, "PlotArea|+|left|" . @PlotArea{"left"}; |
| | 2335 | + push @PresetList, "PlotArea|+|right|" . @PlotArea{"right"}; |
| | 2336 | + push @PresetList, "PlotArea|+|top|" . @PlotArea{"top"}; |
| | 2337 | + push @PresetList, "PlotArea|+|bottom|" . @PlotArea{"bottom"}; |
| | 2338 | + push @PresetList, "PlotArea|-|width"; |
| | 2339 | + push @PresetList, "PlotArea|-|height"; |
| | 2340 | + push @PresetList, "Dateformat|-||yyyy"; |
| | 2341 | + push @PresetList, "TimeAxis|=|format|" . @Axis{"format"}; |
| | 2342 | + push @PresetList, "TimeAxis|=|orientation|horizontal"; |
| | 2343 | + push @PresetList, "ScaleMajor|=|unit|year"; |
| | 2344 | + push @PresetList, "ScaleMajor|+|grid|grid1"; |
| | 2345 | + push @PresetList, "ScaleMinor|=|unit|year"; |
| | 2346 | + push @PresetList, "AlignBars|=||justify"; |
| | 2347 | + push @PresetList, "Legend|+|orientation|" . @Legend{"orientation"}; |
| | 2348 | + push @PresetList, "Legend|+|left|" . @Legend{"left"}; |
| | 2349 | + push @PresetList, "Legend|+|top|" . @Legend{"top"}; |
| | 2350 | + push @PresetList, "PlotData|+|align|left"; |
| | 2351 | + push @PresetList, "PlotData|+|anchor|from"; |
| | 2352 | + push @PresetList, "PlotData|+|fontsize|M"; |
| | 2353 | + push @PresetList, "PlotData|+|width|15"; |
| | 2354 | + push @PresetList, "PlotData|+|textcolor|black"; |
| | 2355 | + push @PresetList, "PlotData|+|shift|" . $hBrO . "4,-6" . $hBrC; |
| | 2356 | + } |
| | 2357 | +} |
| 2069 | 2358 | |
| 2070 | | - if (($DateFormat =~ /\d\d\/\d\d\/\d\d\d\d/) && (substr ($attrvalue,6,4) < 1800)) |
| 2071 | | - { &Error ("Scale attribute '$attribute' invalid.\n" . |
| 2072 | | - " Specify year >= 1800.") ; return ; } |
| | 2359 | +sub ParseScale { |
| | 2360 | + my ($scale); |
| 2073 | 2361 | |
| 2074 | | - if (! &ValidDateRange ($attrvalue)) |
| 2075 | | - { &Error ("Scale attribute '$attribute' invalid.\n" . |
| 2076 | | - "Date '$attrvalue' not within range as specified by command Period.") ; return ; } |
| | 2362 | + if ($Command =~ /ScaleMajor/i) { $scale .= 'Major'; } |
| | 2363 | + else { $scale .= 'Minor'; } |
| 2077 | 2364 | |
| 2078 | | - @Attributes {$scale . " start"} = $attrvalue ; |
| 2079 | | - delete (@Attributes {"start"}) ; |
| 2080 | | - } |
| 2081 | | - if ($DateFormat eq "yyyy") { @Attributes {$scale . " unit"} = "year" ; } |
| 2082 | | - } |
| | 2365 | + if (!ValidAttributes("Scale" . $scale)) { return; } |
| 2083 | 2366 | |
| 2084 | | - foreach $attribute (keys %Attributes) |
| 2085 | | - { @Scales {$attribute} = @Attributes {$attribute} ; } |
| 2086 | | -} |
| | 2367 | + &CheckPreset(Scale . $scale); |
| 2087 | 2368 | |
| 2088 | | -sub ParseTextData |
| 2089 | | -{ |
| 2090 | | - &GetData ; |
| 2091 | | - if ($NoData) |
| 2092 | | - { &Error ("Data expected for command 'TextData', but line is not indented.\n") ; return ; } |
| | 2369 | + @Scales{$scale} = $true; |
| 2093 | 2370 | |
| 2094 | | - my ($pos, $tabs, $fontsize, $lineheight, $textcolor, $text, $link, $hint) ; |
| | 2371 | + foreach $attribute (keys %Attributes) { |
| | 2372 | + my $attrvalue = @Attributes{$attribute}; |
| 2095 | 2373 | |
| 2096 | | - TextData: |
| 2097 | | - while ((! $InputParsed) && (! $NoData)) |
| 2098 | | - { |
| 2099 | | - if (! &ValidAttributes ("TextData")) |
| 2100 | | - { &GetData ; next ;} |
| | 2374 | + if ($attribute =~ /Grid/i |
| | 2375 | + ) # preferred gridcolor instead of grid, grid allowed for compatability |
| | 2376 | + { |
| | 2377 | + if ( (!&ColorPredefined($attrvalue)) |
| | 2378 | + && (!defined(@Colors{ lc($attrvalue) }))) |
| | 2379 | + { |
| | 2380 | + &Error( |
| | 2381 | + "Scale attribute '$attribute' invalid. Unknown color '$attrvalue'.\n" |
| | 2382 | + . " Specify command 'Color' before this command."); |
| | 2383 | + return; |
| | 2384 | + } |
| | 2385 | + @Attributes{ $scale . " grid" } = $attrvalue; |
| | 2386 | + delete(@Attributes{"grid"}); |
| | 2387 | + } |
| | 2388 | + elsif ($attribute =~ /Text/i) { |
| | 2389 | + $attrvalue =~ s/\~/\\n/g; |
| | 2390 | + $attrvalue =~ s/^\"//g; |
| | 2391 | + $attrvalue =~ s/\"$//g; |
| | 2392 | + @Attributes{ $scale . " stubs" } = $attrvalue; |
| | 2393 | + } |
| | 2394 | + elsif ($attribute =~ /Unit/i) { |
| | 2395 | + if ($DateFormat eq "yyyy") { |
| | 2396 | + if (!($attrvalue =~ /^(?:year|years)$/i)) { |
| | 2397 | + &Error( |
| | 2398 | + "Scale attribute '$attribute' invalid. DateFormat 'yyyy' implies 'unit:year'." |
| | 2399 | + ); |
| | 2400 | + return; |
| | 2401 | + } |
| | 2402 | + } |
| | 2403 | + else { |
| | 2404 | + if (!($attrvalue =~ /^(?:year|month|day)s?$/i)) { |
| | 2405 | + &Error( |
| | 2406 | + "Scale attribute '$attribute' invalid. Specify year, month or day." |
| | 2407 | + ); |
| | 2408 | + return; |
| | 2409 | + } |
| | 2410 | + } |
| | 2411 | + $attrvalue =~ s/s$//; |
| | 2412 | + @Attributes{ $scale . " unit" } = $attrvalue; |
| | 2413 | + delete(@Attributes{"unit"}); |
| | 2414 | + } |
| | 2415 | + elsif ($attribute =~ /Increment/i) { |
| | 2416 | + if ((!($attrvalue =~ /^\d+$/i)) || ($attrvalue == 0)) { |
| | 2417 | + &Error( |
| | 2418 | + "Scale attribute '$attribute' invalid. Specify positive integer." |
| | 2419 | + ); |
| | 2420 | + return; |
| | 2421 | + } |
| | 2422 | + @Attributes{ $scale . " inc" } = $attrvalue; |
| | 2423 | + delete(@Attributes{"increment"}); |
| | 2424 | + } |
| | 2425 | + elsif ($attribute =~ /Start/i) { |
| | 2426 | + if (!(defined($DateFormat))) { |
| | 2427 | + &Error( "Scale attribute '$attribute' invalid.\n" |
| | 2428 | + . "No (valid) command 'DateFormat' specified in previous lines." |
| | 2429 | + ); |
| | 2430 | + return; |
| | 2431 | + } |
| 2101 | 2432 | |
| 2102 | | - &CheckPreset ("TextData") ; |
| | 2433 | + if ( ($DateFormat eq "dd/mm/yyyy") |
| | 2434 | + || ($DateFormat eq "mm/dd/yyyy")) |
| | 2435 | + { |
| | 2436 | + if ( ($attrvalue =~ /^\d+$/) |
| | 2437 | + && ($attrvalue >= 1800) |
| | 2438 | + && ($attrvalue <= 2030)) |
| | 2439 | + { |
| | 2440 | + $attrvalue = "01/01/" . $attrvalue; |
| | 2441 | + } |
| | 2442 | + } |
| 2103 | 2443 | |
| 2104 | | - $pos = "" ; $tabs = "" ; $fontsize = "" ; $lineheight = "" ; $textcolor = "" ; $link = "" ; $hint = "" ; |
| | 2444 | + if (!&ValidDateFormat($attrvalue)) { |
| | 2445 | + &Error( "Scale attribute '$attribute' invalid.\n" |
| | 2446 | + . "Date does not conform to specified DateFormat '$DateFormat'." |
| | 2447 | + ); |
| | 2448 | + return; |
| | 2449 | + } |
| 2105 | 2450 | |
| 2106 | | - if (defined (@TextDefs {"tabs"})) { $tabs = @TextDefs {"tabs"} ; } |
| 2107 | | - if (defined (@TextDefs {"fontsize"})) { $fontsize = @TextDefs {"fontsize"} ; } |
| 2108 | | - if (defined (@TextDefs {"lineheight"})) { $lineheight = @TextDefs {"lineheight"} ; } |
| 2109 | | - if (defined (@TextDefs {"textcolor"})) { $textcolor = @TextDefs {"textcolor"} ; } |
| | 2451 | + if ( ($DateFormat =~ /\d\d\/\d\d\/\d\d\d\d/) |
| | 2452 | + && (substr($attrvalue, 6, 4) < 1800)) |
| | 2453 | + { |
| | 2454 | + &Error( "Scale attribute '$attribute' invalid.\n" |
| | 2455 | + . " Specify year >= 1800."); |
| | 2456 | + return; |
| | 2457 | + } |
| 2110 | 2458 | |
| 2111 | | - my $data2 = $data ; |
| 2112 | | - ($data2, $text) = &ExtractText ($data2) ; |
| 2113 | | - @Attributes = split (" ", $data2) ; |
| | 2459 | + if (!&ValidDateRange($attrvalue)) { |
| | 2460 | + &Error( "Scale attribute '$attribute' invalid.\n" |
| | 2461 | + . "Date '$attrvalue' not within range as specified by command Period." |
| | 2462 | + ); |
| | 2463 | + return; |
| | 2464 | + } |
| 2114 | 2465 | |
| 2115 | | - foreach $attribute (keys %Attributes) |
| 2116 | | - { |
| 2117 | | - my $attrvalue = @Attributes {$attribute} ; |
| | 2466 | + @Attributes{ $scale . " start" } = $attrvalue; |
| | 2467 | + delete(@Attributes{"start"}); |
| | 2468 | + } |
| | 2469 | + if ($DateFormat eq "yyyy") { |
| | 2470 | + @Attributes{ $scale . " unit" } = "year"; |
| | 2471 | + } |
| | 2472 | + } |
| 2118 | 2473 | |
| 2119 | | - if ($attribute =~ /^FontSize$/i) |
| 2120 | | - { |
| 2121 | | - if (($attrvalue !~ /\d+(?:\.\d)?/) && ($attrvalue !~ /^(?:xs|s|m|l|xl)$/i)) |
| 2122 | | - { &Error ("TextData invalid. Attribute '$attribute': specify number of XS,S,M,L,XL.") ; |
| 2123 | | - &GetData ; next TextData ; } |
| | 2474 | + foreach $attribute (keys %Attributes) { |
| | 2475 | + @Scales{$attribute} = @Attributes{$attribute}; |
| | 2476 | + } |
| | 2477 | +} |
| 2124 | 2478 | |
| 2125 | | - $fontsize = $attrvalue ; |
| | 2479 | +sub ParseTextData { |
| | 2480 | + &GetData; |
| | 2481 | + if ($NoData) { |
| | 2482 | + &Error( |
| | 2483 | + "Data expected for command 'TextData', but line is not indented.\n" |
| | 2484 | + ); |
| | 2485 | + return; |
| | 2486 | + } |
| 2126 | 2487 | |
| 2127 | | - if ($fontsize !~ /^(?:xs|s|m|l|xl)$/i) |
| 2128 | | - { |
| 2129 | | - if ($fontsize < 6) |
| 2130 | | - { &Warning ("TextData attribute 'fontsize' value too low. Font size 6 assumed.\n") ; |
| 2131 | | - $fontsize = 6 ; } |
| 2132 | | - if ($fontsize > 30) |
| 2133 | | - { &Warning ("TextData attribute 'fontsize' value too high. Font size 30 assumed.\n") ; |
| 2134 | | - $fontsize = 30 ; } |
| | 2488 | + my ($pos, $tabs, $fontsize, $lineheight, $textcolor, $text, $link, $hint); |
| | 2489 | + |
| | 2490 | + TextData: |
| | 2491 | + while ((!$InputParsed) && (!$NoData)) { |
| | 2492 | + if (!&ValidAttributes("TextData")) { &GetData; next; } |
| | 2493 | + |
| | 2494 | + &CheckPreset("TextData"); |
| | 2495 | + |
| | 2496 | + $pos = ""; |
| | 2497 | + $tabs = ""; |
| | 2498 | + $fontsize = ""; |
| | 2499 | + $lineheight = ""; |
| | 2500 | + $textcolor = ""; |
| | 2501 | + $link = ""; |
| | 2502 | + $hint = ""; |
| | 2503 | + |
| | 2504 | + if (defined(@TextDefs{"tabs"})) { $tabs = @TextDefs{"tabs"}; } |
| | 2505 | + if (defined(@TextDefs{"fontsize"})) { |
| | 2506 | + $fontsize = @TextDefs{"fontsize"}; |
| 2135 | 2507 | } |
| 2136 | | - } |
| 2137 | | - elsif ($attribute =~ /^LineHeight$/i) |
| 2138 | | - { |
| 2139 | | - $lineheight = &Normalize ($attrvalue) ; |
| 2140 | | - if (($lineheight < -0.4) || ($lineheight > 0.4)) |
| 2141 | | - { |
| 2142 | | - if (! $bypass) |
| 2143 | | - { &Error ("TextData attribute 'lineheight' invalid.\n" . |
| 2144 | | - "Specify value up to 40 pixels = 0.4 inch\n" . |
| 2145 | | - "Run with option -b (bypass checks) when this is correct.\n") ; } |
| | 2508 | + if (defined(@TextDefs{"lineheight"})) { |
| | 2509 | + $lineheight = @TextDefs{"lineheight"}; |
| 2146 | 2510 | } |
| 2147 | | - } |
| 2148 | | - elsif ($attribute =~ /^Pos$/i) |
| 2149 | | - { |
| 2150 | | - $attrvalue =~ s/\s*$hBrO (.*) $hBrC\s*/$1/x ; |
| 2151 | | - ($posx,$posy) = split (",", $attrvalue) ; |
| 2152 | | - $posx = &Normalize ($posx) ; |
| 2153 | | - $posy = &Normalize ($posy) ; |
| 2154 | | - $pos = "$posx,$posy" ; |
| 2155 | | - } |
| 2156 | | - elsif ($attribute =~ /^Tabs$/i) |
| 2157 | | - { |
| 2158 | | - $tabs = $attrvalue ; |
| 2159 | | - } |
| 2160 | | - elsif ($attribute =~ /^(?:Color|TextColor)$/i) |
| 2161 | | - { |
| 2162 | | - if (! &ColorPredefined ($attrvalue)) |
| 2163 | | - { |
| 2164 | | - if (! defined (@Colors {lc ($attrvalue)})) |
| 2165 | | - { &Error ("TextData invalid. Attribute '$attribute' contains unknown color '$attrvalue'.\n" . |
| 2166 | | - " Specify command 'Color' before this command.") ; |
| 2167 | | - &GetData ; next TextData ; } |
| | 2511 | + if (defined(@TextDefs{"textcolor"})) { |
| | 2512 | + $textcolor = @TextDefs{"textcolor"}; |
| 2168 | 2513 | } |
| 2169 | | - if (defined (@Colors {lc ($attrvalue)})) |
| 2170 | | - { $textcolor = @Colors { lc ($attrvalue) } ; } |
| 2171 | | - else |
| 2172 | | - { $textcolor = lc ($attrvalue) ; } |
| 2173 | | - } |
| 2174 | | - elsif ($attribute =~ /^Text$/i) |
| 2175 | | - { |
| 2176 | | - $text = $attrvalue ; |
| 2177 | | - $text =~ s/\\n/~/gs ; |
| 2178 | | - if ($text =~ /\~/) |
| 2179 | | - { &Warning ("TextData attribute 'text' contains ~ (tilde).\n" . |
| 2180 | | - "Tilde will not be translated into newline character (only in PlotData)") ; } |
| 2181 | 2514 | |
| 2182 | | - } |
| 2183 | | - elsif ($attribute =~ /^Link$/i) |
| 2184 | | - { |
| 2185 | | - $link = &ParseText ($attrvalue) ; |
| 2186 | | - $link = &EncodeURL (&NormalizeURL ($link)) ; |
| 2187 | | - } |
| 2188 | | - } |
| | 2515 | + my $data2 = $data; |
| | 2516 | + ($data2, $text) = &ExtractText($data2); |
| | 2517 | + @Attributes = split(" ", $data2); |
| 2189 | 2518 | |
| 2190 | | - if ($fontsize eq "") |
| 2191 | | - { $fontsize = "S" ; } |
| | 2519 | + foreach $attribute (keys %Attributes) { |
| | 2520 | + my $attrvalue = @Attributes{$attribute}; |
| 2192 | 2521 | |
| 2193 | | - if ($lineheight eq "") |
| 2194 | | - { |
| 2195 | | - if ($fontsize =~ /^(?:XS|S|M|L|XL)$/i) |
| 2196 | | - { |
| 2197 | | - if ($fontsize =~ /XS/i) { $lineheight = 0.11 ; } |
| 2198 | | - elsif ($fontsize =~ /S/i) { $lineheight = 0.13 ; } |
| 2199 | | - elsif ($fontsize =~ /M/i) { $lineheight = 0.155 ; } |
| 2200 | | - elsif ($fontsize =~ /XL/i) { $lineheight = 0.24 ; } |
| 2201 | | - else { $lineheight = 0.19 ; } |
| 2202 | | - } |
| 2203 | | - else |
| 2204 | | - { |
| 2205 | | - $lineheight = sprintf ("%.2f", (($fontsize * 1.2) / 100)) ; |
| 2206 | | - if ($lineheight < $fontsize/100 + 0.02) |
| 2207 | | - { $lineheight = $fontsize/100 + 0.02 ; } |
| 2208 | | - } |
| 2209 | | - } |
| | 2522 | + if ($attribute =~ /^FontSize$/i) { |
| | 2523 | + if ( ($attrvalue !~ /\d+(?:\.\d)?/) |
| | 2524 | + && ($attrvalue !~ /^(?:xs|s|m|l|xl)$/i)) |
| | 2525 | + { |
| | 2526 | + &Error( |
| | 2527 | + "TextData invalid. Attribute '$attribute': specify number of XS,S,M,L,XL." |
| | 2528 | + ); |
| | 2529 | + &GetData; |
| | 2530 | + next TextData; |
| | 2531 | + } |
| 2210 | 2532 | |
| 2211 | | - if ($textcolor eq "") |
| 2212 | | - { $textcolor = "black" ; } |
| | 2533 | + $fontsize = $attrvalue; |
| 2213 | 2534 | |
| 2214 | | - if ($pos eq "") |
| 2215 | | - { |
| 2216 | | - $pos = @TextDefs {"pos"} ; |
| 2217 | | - ($posx,$posy) = split (",", $pos) ; |
| 2218 | | - $posy -= $lineheight ; |
| 2219 | | - if ($posy < 0) |
| 2220 | | - { $posy = 0 ; } |
| 2221 | | - $pos = "$posx,$posy" ; |
| 2222 | | - @TextDefs {"pos"} = $pos ; |
| 2223 | | - } |
| | 2535 | + if ($fontsize !~ /^(?:xs|s|m|l|xl)$/i) { |
| | 2536 | + if ($fontsize < 6) { |
| | 2537 | + &Warning( |
| | 2538 | + "TextData attribute 'fontsize' value too low. Font size 6 assumed.\n" |
| | 2539 | + ); |
| | 2540 | + $fontsize = 6; |
| | 2541 | + } |
| | 2542 | + if ($fontsize > 30) { |
| | 2543 | + &Warning( |
| | 2544 | + "TextData attribute 'fontsize' value too high. Font size 30 assumed.\n" |
| | 2545 | + ); |
| | 2546 | + $fontsize = 30; |
| | 2547 | + } |
| | 2548 | + } |
| | 2549 | + } |
| | 2550 | + elsif ($attribute =~ /^LineHeight$/i) { |
| | 2551 | + $lineheight = &Normalize($attrvalue); |
| | 2552 | + if (($lineheight < -0.4) || ($lineheight > 0.4)) { |
| | 2553 | + if (!$bypass) { |
| | 2554 | + &Error( "TextData attribute 'lineheight' invalid.\n" |
| | 2555 | + . "Specify value up to 40 pixels = 0.4 inch\n" |
| | 2556 | + . "Run with option -b (bypass checks) when this is correct.\n" |
| | 2557 | + ); |
| | 2558 | + } |
| | 2559 | + } |
| | 2560 | + } |
| | 2561 | + elsif ($attribute =~ /^Pos$/i) { |
| | 2562 | + $attrvalue =~ s/\s*$hBrO (.*) $hBrC\s*/$1/x; |
| | 2563 | + ($posx, $posy) = split(",", $attrvalue); |
| | 2564 | + $posx = &Normalize($posx); |
| | 2565 | + $posy = &Normalize($posy); |
| | 2566 | + $pos = "$posx,$posy"; |
| | 2567 | + } |
| | 2568 | + elsif ($attribute =~ /^Tabs$/i) { |
| | 2569 | + $tabs = $attrvalue; |
| | 2570 | + } |
| | 2571 | + elsif ($attribute =~ /^(?:Color|TextColor)$/i) { |
| | 2572 | + if (!&ColorPredefined($attrvalue)) { |
| | 2573 | + if (!defined(@Colors{ lc($attrvalue) })) { |
| | 2574 | + &Error( |
| | 2575 | + "TextData invalid. Attribute '$attribute' contains unknown color '$attrvalue'.\n" |
| | 2576 | + . " Specify command 'Color' before this command." |
| | 2577 | + ); |
| | 2578 | + &GetData; |
| | 2579 | + next TextData; |
| | 2580 | + } |
| | 2581 | + } |
| | 2582 | + if (defined(@Colors{ lc($attrvalue) })) { |
| | 2583 | + $textcolor = @Colors{ lc($attrvalue) }; |
| | 2584 | + } |
| | 2585 | + else { $textcolor = lc($attrvalue); } |
| | 2586 | + } |
| | 2587 | + elsif ($attribute =~ /^Text$/i) { |
| | 2588 | + $text = $attrvalue; |
| | 2589 | + $text =~ s/\\n/~/gs; |
| | 2590 | + if ($text =~ /\~/) { |
| | 2591 | + &Warning("TextData attribute 'text' contains ~ (tilde).\n" |
| | 2592 | + . "Tilde will not be translated into newline character (only in PlotData)" |
| | 2593 | + ); |
| | 2594 | + } |
| 2224 | 2595 | |
| 2225 | | -# if ($link ne "") |
| 2226 | | -# { ($text, $link, $hint) = &ProcessWikiLink ($text, $link, $hint) ; } |
| | 2596 | + } |
| | 2597 | + elsif ($attribute =~ /^Link$/i) { |
| | 2598 | + $link = &ParseText($attrvalue); |
| | 2599 | + $link = &EncodeURL(&NormalizeURL($link)); |
| | 2600 | + } |
| | 2601 | + } |
| 2227 | 2602 | |
| 2228 | | - if ($text eq "") # upd defaults |
| 2229 | | - { |
| 2230 | | - if ($pos ne "") { @TextDefs {"pos"} = $pos ; } |
| 2231 | | - if ($tabs ne "") { @TextDefs {"tabs"} = $tabs ; } |
| 2232 | | - if ($fontsize ne "") { @TextDefs {"fontsize"} = $fontsize ; } |
| 2233 | | - if ($textcolor ne "") { @TextDefs {"textcolor"} = $textcolor ; } |
| 2234 | | - if ($lineheight ne "") { @TextDefs {"lineheight"} = $lineheight ; } |
| 2235 | | - &GetData ; next TextData ; |
| 2236 | | - } |
| | 2603 | + if ($fontsize eq "") { $fontsize = "S"; } |
| 2237 | 2604 | |
| 2238 | | - if ($link ne "") |
| 2239 | | - { |
| 2240 | | - if ($text =~ /\[.*\]/) |
| 2241 | | - { |
| 2242 | | - &Warning ("TextData contains implicit link(s) in attribute 'text' and explicit attribute 'link'.\n" . |
| 2243 | | - "Implicit link(s) ignored.") ; |
| 2244 | | - $text =~ s/\[+ (?:[^\|]* \|)? ([^\]]*) \]+/$1/gx ; |
| 2245 | | - } |
| | 2605 | + if ($lineheight eq "") { |
| | 2606 | + if ($fontsize =~ /^(?:XS|S|M|L|XL)$/i) { |
| | 2607 | + if ($fontsize =~ /XS/i) { $lineheight = 0.11; } |
| | 2608 | + elsif ($fontsize =~ /S/i) { $lineheight = 0.13; } |
| | 2609 | + elsif ($fontsize =~ /M/i) { $lineheight = 0.155; } |
| | 2610 | + elsif ($fontsize =~ /XL/i) { $lineheight = 0.24; } |
| | 2611 | + else { $lineheight = 0.19; } |
| | 2612 | + } |
| | 2613 | + else { |
| | 2614 | + $lineheight = sprintf("%.2f", (($fontsize * 1.2) / 100)); |
| | 2615 | + if ($lineheight < $fontsize / 100 + 0.02) { |
| | 2616 | + $lineheight = $fontsize / 100 + 0.02; |
| | 2617 | + } |
| | 2618 | + } |
| | 2619 | + } |
| 2246 | 2620 | |
| 2247 | | - if ($hint eq "") |
| 2248 | | - { $hint = &ExternalLinkToHint ($link) ; } |
| 2249 | | - } |
| | 2621 | + if ($textcolor eq "") { $textcolor = "black"; } |
| 2250 | 2622 | |
| 2251 | | - if ($text =~ /\[ [^\]]* \^ [^\]]* \]/x) |
| 2252 | | - { |
| 2253 | | - &Warning ("TextData attribute 'text' contains tab character (^) inside implicit link ([[..]]). Tab ignored.") ; |
| 2254 | | - $text =~ s/(\[+ [^\]]* \^ [^\]]* \]+)/($a = $1), ($a =~ s+\^+ +g), $a/gxe ; |
| 2255 | | - } |
| | 2623 | + if ($pos eq "") { |
| | 2624 | + $pos = @TextDefs{"pos"}; |
| | 2625 | + ($posx, $posy) = split(",", $pos); |
| | 2626 | + $posy -= $lineheight; |
| | 2627 | + if ($posy < 0) { $posy = 0; } |
| | 2628 | + $pos = "$posx,$posy"; |
| | 2629 | + @TextDefs{"pos"} = $pos; |
| | 2630 | + } |
| 2256 | 2631 | |
| 2257 | | - if (defined ($tabs) && ($tabs ne "")) |
| 2258 | | - { |
| 2259 | | - $tabs =~ s/^\s*$hBrO (.*) $hBrC\s*$/$1/x ; |
| 2260 | | - @Tabs = split (",", $tabs) ; |
| 2261 | | - foreach $tab (@Tabs) |
| 2262 | | - { |
| 2263 | | - $tab =~ s/\s* (.*) \s*$/$1/x ; |
| 2264 | | - if (! ($tab =~ /\d+\-(?:center|left|right)$/)) |
| 2265 | | - { &Error ("Specify attribute 'tabs' as 'n-a,n-a,n-a,.. where n = numeric value, a = left|right|center.") ; |
| 2266 | | - while ((! $InputParsed) && (! $NoData)) { &GetData ; } return ; } |
| 2267 | | - } |
| | 2632 | + # if ($link ne "") |
| | 2633 | + # { ($text, $link, $hint) = &ProcessWikiLink ($text, $link, $hint) ; } |
| 2268 | 2634 | |
| 2269 | | - @Text = split ('\^', $text) ; |
| 2270 | | - if ($#Text > $#Tabs + 1) |
| 2271 | | - { &Error ("TextData invalid. " . $#Text . " tab characters ('^') in text, only " . ($#Tabs+1) . " tab(s) defined.") ; |
| 2272 | | - &GetData ; next TextData ; } |
| 2273 | | - } |
| | 2635 | + if ($text eq "") # upd defaults |
| | 2636 | + { |
| | 2637 | + if ($pos ne "") { @TextDefs{"pos"} = $pos; } |
| | 2638 | + if ($tabs ne "") { @TextDefs{"tabs"} = $tabs; } |
| | 2639 | + if ($fontsize ne "") { @TextDefs{"fontsize"} = $fontsize; } |
| | 2640 | + if ($textcolor ne "") { @TextDefs{"textcolor"} = $textcolor; } |
| | 2641 | + if ($lineheight ne "") { @TextDefs{"lineheight"} = $lineheight; } |
| | 2642 | + &GetData; |
| | 2643 | + next TextData; |
| | 2644 | + } |
| 2274 | 2645 | |
| 2275 | | - &WriteText ("^", "", 0, $posx, $posy, $text, $textcolor, $fontsize, "left", $link, $hint, $tabs) ; |
| | 2646 | + if ($link ne "") { |
| | 2647 | + if ($text =~ /\[.*\]/) { |
| | 2648 | + &Warning( |
| | 2649 | + "TextData contains implicit link(s) in attribute 'text' and explicit attribute 'link'.\n" |
| | 2650 | + . "Implicit link(s) ignored."); |
| | 2651 | + $text =~ s/\[+ (?:[^\|]* \|)? ([^\]]*) \]+/$1/gx; |
| | 2652 | + } |
| 2276 | 2653 | |
| 2277 | | - &GetData ; |
| 2278 | | - } |
| | 2654 | + if ($hint eq "") { $hint = &ExternalLinkToHint($link); } |
| | 2655 | + } |
| | 2656 | + |
| | 2657 | + if ($text =~ /\[ [^\]]* \^ [^\]]* \]/x) { |
| | 2658 | + &Warning( |
| | 2659 | + "TextData attribute 'text' contains tab character (^) inside implicit link ([[..]]). Tab ignored." |
| | 2660 | + ); |
| | 2661 | + $text =~ |
| | 2662 | + s/(\[+ [^\]]* \^ [^\]]* \]+)/($a = $1), ($a =~ s+\^+ +g), $a/gxe; |
| | 2663 | + } |
| | 2664 | + |
| | 2665 | + if (defined($tabs) && ($tabs ne "")) { |
| | 2666 | + $tabs =~ s/^\s*$hBrO (.*) $hBrC\s*$/$1/x; |
| | 2667 | + @Tabs = split(",", $tabs); |
| | 2668 | + foreach $tab (@Tabs) { |
| | 2669 | + $tab =~ s/\s* (.*) \s*$/$1/x; |
| | 2670 | + if (!($tab =~ /\d+\-(?:center|left|right)$/)) { |
| | 2671 | + &Error( |
| | 2672 | + "Specify attribute 'tabs' as 'n-a,n-a,n-a,.. where n = numeric value, a = left|right|center." |
| | 2673 | + ); |
| | 2674 | + while ((!$InputParsed) && (!$NoData)) { &GetData; } |
| | 2675 | + return; |
| | 2676 | + } |
| | 2677 | + } |
| | 2678 | + |
| | 2679 | + @Text = split('\^', $text); |
| | 2680 | + if ($#Text > $#Tabs + 1) { |
| | 2681 | + &Error( "TextData invalid. " |
| | 2682 | + . $#Text |
| | 2683 | + . " tab characters ('^') in text, only " |
| | 2684 | + . ($#Tabs + 1) |
| | 2685 | + . " tab(s) defined."); |
| | 2686 | + &GetData; |
| | 2687 | + next TextData; |
| | 2688 | + } |
| | 2689 | + } |
| | 2690 | + |
| | 2691 | + &WriteText( |
| | 2692 | + "^", "", 0, $posx, |
| | 2693 | + $posy, $text, $textcolor, $fontsize, |
| | 2694 | + "left", $link, $hint, $tabs |
| | 2695 | + ); |
| | 2696 | + |
| | 2697 | + &GetData; |
| | 2698 | + } |
| 2279 | 2699 | } |
| 2280 | 2700 | |
| 2281 | | -sub ParseTimeAxis |
| 2282 | | -{ |
| 2283 | | - if (! &ValidAttributes ("TimeAxis")) { return ; } |
| | 2701 | +sub ParseTimeAxis { |
| | 2702 | + if (!&ValidAttributes("TimeAxis")) { return; } |
| 2284 | 2703 | |
| 2285 | | - &CheckPreset ("TimeAxis") ; |
| | 2704 | + &CheckPreset("TimeAxis"); |
| 2286 | 2705 | |
| 2287 | | - foreach $attribute (keys %Attributes) |
| 2288 | | - { |
| 2289 | | - my $attrvalue = @Attributes {$attribute} ; |
| | 2706 | + foreach $attribute (keys %Attributes) { |
| | 2707 | + my $attrvalue = @Attributes{$attribute}; |
| 2290 | 2708 | |
| | 2709 | + if ($attribute =~ /Format/i) { |
| | 2710 | + if ($attrvalue =~ /^yy$/i) { |
| | 2711 | + &Error( |
| | 2712 | + "TimeAxis attribute '$attribute' valid but not available, waiting for bug fix.\n" |
| | 2713 | + . "Please specify 'format:yyyy' instead of 'format:yy'." |
| | 2714 | + ); |
| | 2715 | + return; |
| | 2716 | + } |
| 2291 | 2717 | |
| 2292 | | - if ($attribute =~ /Format/i) |
| 2293 | | - { |
| 2294 | | - if ($attrvalue =~ /^yy$/i) |
| 2295 | | - { &Error ("TimeAxis attribute '$attribute' valid but not available, waiting for bug fix.\n" . |
| 2296 | | - "Please specify 'format:yyyy' instead of 'format:yy'.") ; return ; } |
| | 2718 | + if ($DateFormat eq "yyyy") { |
| | 2719 | + if (!($attrvalue =~ /^(?:yy|yyyy)$/i)) { |
| | 2720 | + &Error( "TimeAxis attribute '$attribute' invalid.\n" |
| | 2721 | + . "DateFormat 'yyyy' implies 'format:yy' or 'format:yyyy'." |
| | 2722 | + ); |
| | 2723 | + return; |
| | 2724 | + } |
| | 2725 | + } |
| | 2726 | + } |
| 2297 | 2727 | |
| 2298 | | - if ($DateFormat eq "yyyy") |
| 2299 | | - { |
| 2300 | | - if (! ($attrvalue =~ /^(?:yy|yyyy)$/i)) |
| 2301 | | - { &Error ("TimeAxis attribute '$attribute' invalid.\n" . |
| 2302 | | - "DateFormat 'yyyy' implies 'format:yy' or 'format:yyyy'.") ; return ; } |
| 2303 | | - } |
| 2304 | | - } |
| | 2728 | + elsif ($attribute =~ /Order/i) { |
| | 2729 | + if ($attrvalue !~ /^(?:normal|reverse)$/i) { |
| | 2730 | + &Error( "TimeAxis attribute '$attribute' invalid.\n" |
| | 2731 | + . " Specify 'order:normal' (default) or 'order:reverse'\n" |
| | 2732 | + . " normal =\n" |
| | 2733 | + . " vertical axis: highest date on top,\n" |
| | 2734 | + . " horizontal axis: highest date at right side\n"); |
| | 2735 | + return; |
| | 2736 | + } |
| 2305 | 2737 | |
| 2306 | | - elsif ($attribute =~ /Order/i) |
| 2307 | | - { |
| 2308 | | - if ($attrvalue !~ /^(?:normal|reverse)$/i) |
| 2309 | | - { &Error ("TimeAxis attribute '$attribute' invalid.\n" . |
| 2310 | | - " Specify 'order:normal' (default) or 'order:reverse'\n" . |
| 2311 | | - " normal =\n" . |
| 2312 | | - " vertical axis: highest date on top,\n" . |
| 2313 | | - " horizontal axis: highest date at right side\n" ) ; return ; } |
| | 2738 | + if (($attrvalue =~ /reverse/i) && ($DateFormat ne "yyyy")) { |
| | 2739 | + &Error( "TimeAxis attribute '$attribute' invalid.\n" |
| | 2740 | + . " 'order:reverse' is only possible with DateFormat=yyyy (sorry)\n" |
| | 2741 | + ); |
| | 2742 | + return; |
| | 2743 | + } |
| 2314 | 2744 | |
| 2315 | | - if (($attrvalue =~ /reverse/i) && ($DateFormat ne "yyyy")) |
| 2316 | | - { &Error ("TimeAxis attribute '$attribute' invalid.\n" . |
| 2317 | | - " 'order:reverse' is only possible with DateFormat=yyyy (sorry)\n") ; return ; } |
| | 2745 | + @Attributes{"order"} = lc($attrvalue); |
| | 2746 | + } |
| 2318 | 2747 | |
| 2319 | | - @Attributes {"order"} = lc ($attrvalue) ; |
| | 2748 | + elsif ($attribute =~ /Orientation/i) { |
| | 2749 | + if ($attrvalue =~ /^hor(?:izontal)?$/i) { |
| | 2750 | + @Attributes{"time"} = "x"; |
| | 2751 | + } |
| | 2752 | + elsif ($attrvalue =~ /^ver(?:tical)?$/i) { |
| | 2753 | + @Attributes{"time"} = "y"; |
| | 2754 | + } |
| | 2755 | + else { |
| | 2756 | + &Error( "TimeAxis attribute '$attribute' invalid.\n" |
| | 2757 | + . "Specify hor[izontal] or ver[tical]"); |
| | 2758 | + return; |
| | 2759 | + } |
| | 2760 | + delete(@Attributes{"orientation"}); |
| | 2761 | + } |
| 2320 | 2762 | } |
| 2321 | 2763 | |
| 2322 | | - elsif ($attribute =~ /Orientation/i) |
| 2323 | | - { |
| 2324 | | - if ($attrvalue =~ /^hor(?:izontal)?$/i) |
| 2325 | | - { @Attributes {"time"} = "x" ; } |
| 2326 | | - elsif ($attrvalue =~ /^ver(?:tical)?$/i) |
| 2327 | | - { @Attributes {"time"} = "y" ; } |
| 2328 | | - else |
| 2329 | | - { &Error ("TimeAxis attribute '$attribute' invalid.\n" . |
| 2330 | | - "Specify hor[izontal] or ver[tical]") ; return ; } |
| 2331 | | - delete (@Attributes {"orientation"}) ; |
| 2332 | | - } |
| 2333 | | - } |
| | 2764 | + if (!defined(@Attributes{"format"})) { @Attributes{"format"} = "yyyy"; } |
| 2334 | 2765 | |
| 2335 | | - if (! defined (@Attributes {"format"})) |
| 2336 | | - { @Attributes {"format"} = "yyyy" ; } |
| 2337 | | - |
| 2338 | | - %Axis = %Attributes ; |
| | 2766 | + %Axis = %Attributes; |
| 2339 | 2767 | } |
| 2340 | 2768 | |
| 2341 | | -sub ParseUnknownCommand |
| 2342 | | -{ |
| 2343 | | - $name = $Command ; |
| 2344 | | - $name =~ s/[^a-zA-Z].*$// ; |
| 2345 | | - &Error ("Command '$name' unknown.") ; |
| | 2769 | +sub ParseUnknownCommand { |
| | 2770 | + $name = $Command; |
| | 2771 | + $name =~ s/[^a-zA-Z].*$//; |
| | 2772 | + &Error("Command '$name' unknown."); |
| 2346 | 2773 | } |
| 2347 | 2774 | |
| 2348 | | -sub RemoveSpaces |
| 2349 | | -{ |
| 2350 | | - my $text = shift ; |
| 2351 | | - $text =~ s/\s//g ; |
| 2352 | | - return ($text) ; |
| | 2775 | +sub RemoveSpaces { |
| | 2776 | + my $text = shift; |
| | 2777 | + $text =~ s/\s//g; |
| | 2778 | + return ($text); |
| 2353 | 2779 | } |
| 2354 | 2780 | |
| 2355 | | -sub DetectMissingCommands |
| 2356 | | -{ |
| 2357 | | - if (! defined (%Image)) { &Error2 ("Command ImageSize missing or invalid") ; } |
| 2358 | | - if (! defined (%PlotArea)) { &Error2 ("Command PlotArea missing or invalid") ; } |
| 2359 | | - if (! defined ($DateFormat)) { &Error2 ("Command DateFormat missing or invalid") ; } |
| 2360 | | - if (! defined (@Axis {"time"})) { &Error2 ("Command TimeAxis missing or invalid") ; } |
| | 2781 | +sub DetectMissingCommands { |
| | 2782 | + if (!defined(%Image)) { |
| | 2783 | + &Error2("Command ImageSize missing or invalid"); |
| | 2784 | + } |
| | 2785 | + if (!defined(%PlotArea)) { |
| | 2786 | + &Error2("Command PlotArea missing or invalid"); |
| | 2787 | + } |
| | 2788 | + if (!defined($DateFormat)) { |
| | 2789 | + &Error2("Command DateFormat missing or invalid"); |
| | 2790 | + } |
| | 2791 | + if (!defined(@Axis{"time"})) { |
| | 2792 | + &Error2("Command TimeAxis missing or invalid"); |
| | 2793 | + } |
| 2361 | 2794 | |
| 2362 | | - if ((@Image {"width"} =~ /auto/i) && (@Axis {"time"} =~ /x/i)) |
| 2363 | | - { &Error2 ("ImageSize value 'width:auto' only allowed with TimeAxis value 'orientation:vertical'") ; } |
| 2364 | | - if ((@Image {"height"} =~ /auto/i) && (@Axis {"time"} =~ /y/i)) |
| 2365 | | - { &Error2 ("ImageSize value 'height:auto' only allowed with TimeAxis value 'orientation:horizontal'") ; } |
| | 2795 | + if ((@Image{"width"} =~ /auto/i) && (@Axis{"time"} =~ /x/i)) { |
| | 2796 | + &Error2( |
| | 2797 | + "ImageSize value 'width:auto' only allowed with TimeAxis value 'orientation:vertical'" |
| | 2798 | + ); |
| | 2799 | + } |
| | 2800 | + if ((@Image{"height"} =~ /auto/i) && (@Axis{"time"} =~ /y/i)) { |
| | 2801 | + &Error2( |
| | 2802 | + "ImageSize value 'height:auto' only allowed with TimeAxis value 'orientation:horizontal'" |
| | 2803 | + ); |
| | 2804 | + } |
| 2366 | 2805 | } |
| 2367 | 2806 | |
| 2368 | | -sub Normalize |
| 2369 | | -{ |
| 2370 | | - my $number = shift ; |
| 2371 | | - my $reference = shift ; |
| 2372 | | - my ($val, $dim) ; |
| | 2807 | +sub Normalize { |
| | 2808 | + my $number = shift; |
| | 2809 | + my $reference = shift; |
| | 2810 | + my ($val, $dim); |
| 2373 | 2811 | |
| 2374 | | - if (($number eq "") || ($number =~ /auto/i)) |
| 2375 | | - { return ($number) ; } |
| | 2812 | + if (($number eq "") || ($number =~ /auto/i)) { return ($number); } |
| 2376 | 2813 | |
| 2377 | | - $val = $number ; $val =~ s/[^\d\.\-].*$//g ; |
| 2378 | | - $dim = $number ; $dim =~ s/\d//g ; |
| 2379 | | - if ($dim =~ /in/i) { $number = $val ; } |
| 2380 | | - elsif ($dim =~ /cm/i) { $number = $val / 2.54 ; } |
| 2381 | | - elsif ($dim =~ /%/) { $number = $reference * $val / 100 ; } |
| 2382 | | - else { $number = $val / 100 ; } |
| 2383 | | - return (sprintf ("%.3f", $number)) ; |
| | 2814 | + $val = $number; |
| | 2815 | + $val =~ s/[^\d\.\-].*$//g; |
| | 2816 | + $dim = $number; |
| | 2817 | + $dim =~ s/\d//g; |
| | 2818 | + if ($dim =~ /in/i) { $number = $val; } |
| | 2819 | + elsif ($dim =~ /cm/i) { $number = $val / 2.54; } |
| | 2820 | + elsif ($dim =~ /%/) { $number = $reference * $val / 100; } |
| | 2821 | + else { $number = $val / 100; } |
| | 2822 | + return (sprintf("%.3f", $number)); |
| 2384 | 2823 | } |
| 2385 | 2824 | |
| 2386 | | -sub ValidateAndNormalizeDimensions |
| 2387 | | -{ |
| 2388 | | - my ($val, $dim) ; |
| | 2825 | +sub ValidateAndNormalizeDimensions { |
| | 2826 | + my ($val, $dim); |
| 2389 | 2827 | |
| 2390 | | - if (@Image {"width"} =~ /auto/i) |
| 2391 | | - { |
| 2392 | | - foreach $attribute ("width","left","right") |
| 2393 | | - { if (@PlotArea {$attribute} =~ /\%/) |
| 2394 | | - { &Error2 ("You specified 'ImageSize = width:auto'.\n" . |
| 2395 | | - " This implies absolute values in PlotArea attributes 'left', 'right' and/or 'width' (no \%).\n") ; return ; } |
| | 2828 | + if (@Image{"width"} =~ /auto/i) { |
| | 2829 | + foreach $attribute ("width", "left", "right") { |
| | 2830 | + if (@PlotArea{$attribute} =~ /\%/) { |
| | 2831 | + &Error2( "You specified 'ImageSize = width:auto'.\n" |
| | 2832 | + . " This implies absolute values in PlotArea attributes 'left', 'right' and/or 'width' (no \%).\n" |
| | 2833 | + ); |
| | 2834 | + return; |
| | 2835 | + } |
| | 2836 | + } |
| | 2837 | + |
| | 2838 | + if ( (@PlotArea{"width"} ne "") |
| | 2839 | + || (@PlotArea{"left"} eq "") |
| | 2840 | + || (@PlotArea{"right"} eq "")) |
| | 2841 | + { |
| | 2842 | + &Error2( "You specified 'ImageSize = width:auto'.\n" |
| | 2843 | + . " This implies 'PlotArea = width:auto'.\n" |
| | 2844 | + . " Instead of 'width' specify plot margins with PlotArea attributes 'left' and 'right'.\n" |
| | 2845 | + ); |
| | 2846 | + return; |
| | 2847 | + } |
| 2396 | 2848 | } |
| 2397 | 2849 | |
| 2398 | | - if ((@PlotArea {"width"} ne "") || (@PlotArea {"left"} eq "") || (@PlotArea {"right"} eq "")) |
| 2399 | | - { &Error2 ("You specified 'ImageSize = width:auto'.\n" . |
| 2400 | | - " This implies 'PlotArea = width:auto'.\n" . |
| 2401 | | - " Instead of 'width' specify plot margins with PlotArea attributes 'left' and 'right'.\n") ; return ; } |
| 2402 | | - } |
| | 2850 | + if (@Image{"height"} =~ /auto/i) { |
| | 2851 | + foreach $attribute ("height", "top", "bottom") { |
| | 2852 | + if (@PlotArea{$attribute} =~ /\%/) { |
| | 2853 | + &Error2( "You specified 'ImageSize = height:auto'.\n" |
| | 2854 | + . " This implies absolute values in PlotArea attributes 'top', 'bottom' and/or 'height' (no \%).\n" |
| | 2855 | + ); |
| | 2856 | + return; |
| | 2857 | + } |
| | 2858 | + } |
| 2403 | 2859 | |
| 2404 | | - |
| 2405 | | - if (@Image {"height"} =~ /auto/i) |
| 2406 | | - { |
| 2407 | | - foreach $attribute ("height","top","bottom") |
| 2408 | | - { if (@PlotArea {$attribute} =~ /\%/) |
| 2409 | | - { &Error2 ("You specified 'ImageSize = height:auto'.\n" . |
| 2410 | | - " This implies absolute values in PlotArea attributes 'top', 'bottom' and/or 'height' (no \%).\n") ; return ; } |
| | 2860 | + if ( (@PlotArea{"height"} ne "") |
| | 2861 | + || (@PlotArea{"top"} eq "") |
| | 2862 | + || (@PlotArea{"bottom"} eq "")) |
| | 2863 | + { |
| | 2864 | + &Error2( "You specified 'ImageSize = height:auto'.\n" |
| | 2865 | + . " This implies 'PlotArea = height:auto'.\n" |
| | 2866 | + . " Instead of 'height' specify plot margins with PlotArea attributes 'top' and 'bottom'.\n" |
| | 2867 | + ); |
| | 2868 | + return; |
| | 2869 | + } |
| 2411 | 2870 | } |
| 2412 | 2871 | |
| 2413 | | - if ((@PlotArea {"height"} ne "") || (@PlotArea {"top"} eq "") || (@PlotArea {"bottom"} eq "")) |
| 2414 | | - { &Error2 ("You specified 'ImageSize = height:auto'.\n" . |
| 2415 | | - " This implies 'PlotArea = height:auto'.\n" . |
| 2416 | | - " Instead of 'height' specify plot margins with PlotArea attributes 'top' and 'bottom'.\n") ; return ; } |
| 2417 | | - } |
| | 2872 | + @Image{"width"} = &Normalize(@Image{"width"}); |
| | 2873 | + @Image{"height"} = &Normalize(@Image{"height"}); |
| | 2874 | + @Image{"barinc"} = &Normalize(@Image{"barinc"}); |
| | 2875 | + @PlotArea{"width"} = &Normalize(@PlotArea{"width"}, @Image{"width"}); |
| | 2876 | + @PlotArea{"height"} = &Normalize(@PlotArea{"height"}, @Image{"height"}); |
| | 2877 | + @PlotArea{"left"} = &Normalize(@PlotArea{"left"}, @Image{"width"}); |
| | 2878 | + @PlotArea{"right"} = &Normalize(@PlotArea{"right"}, @Image{"width"}); |
| | 2879 | + @PlotArea{"bottom"} = &Normalize(@PlotArea{"bottom"}, @Image{"height"}); |
| | 2880 | + @PlotArea{"top"} = &Normalize(@PlotArea{"top"}, @Image{"height"}); |
| 2418 | 2881 | |
| 2419 | | - @Image {"width"} = &Normalize (@Image {"width"}) ; |
| 2420 | | - @Image {"height"} = &Normalize (@Image {"height"}) ; |
| 2421 | | - @Image {"barinc"} = &Normalize (@Image {"barinc"}) ; |
| 2422 | | - @PlotArea {"width"} = &Normalize (@PlotArea {"width"}, @Image {"width"}) ; |
| 2423 | | - @PlotArea {"height"} = &Normalize (@PlotArea {"height"}, @Image {"height"}) ; |
| 2424 | | - @PlotArea {"left"} = &Normalize (@PlotArea {"left"}, @Image {"width"}) ; |
| 2425 | | - @PlotArea {"right"} = &Normalize (@PlotArea {"right"}, @Image {"width"}) ; |
| 2426 | | - @PlotArea {"bottom"} = &Normalize (@PlotArea {"bottom"}, @Image {"height"}) ; |
| 2427 | | - @PlotArea {"top"} = &Normalize (@PlotArea {"top"}, @Image {"height"}) ; |
| | 2882 | + if (@Image{"width"} =~ /auto/i) { |
| | 2883 | + @PlotArea{"width"} = $#Bars * @Image{"barinc"}; |
| | 2884 | + @Image{"width"} = |
| | 2885 | + @PlotArea{"left"} + @PlotArea{"width"} + @PlotArea{"right"}; |
| | 2886 | + } |
| 2428 | 2887 | |
| 2429 | | - if (@Image {"width"} =~ /auto/i) |
| 2430 | | - { |
| 2431 | | - @PlotArea {"width"} = $#Bars * @Image {"barinc"} ; |
| 2432 | | - @Image {"width"} = @PlotArea {"left"} + @PlotArea {"width"} + @PlotArea {"right"} ; |
| 2433 | | - } |
| | 2888 | + elsif (@Image{"height"} =~ /auto/i) { |
| | 2889 | + @PlotArea{"height"} = $#Bars * @Image{"barinc"}; |
| | 2890 | + @Image{"height"} = |
| | 2891 | + @PlotArea{"top"} + @PlotArea{"height"} + @PlotArea{"bottom"}; |
| | 2892 | + } |
| 2434 | 2893 | |
| 2435 | | - elsif (@Image {"height"} =~ /auto/i) |
| 2436 | | - { |
| 2437 | | - @PlotArea {"height"} = $#Bars * @Image {"barinc"} ; |
| 2438 | | - @Image {"height"} = @PlotArea {"top"} + @PlotArea {"height"} + @PlotArea {"bottom"} ; |
| 2439 | | - } |
| | 2894 | + if (@PlotArea{"right"} ne "") { |
| | 2895 | + @PlotArea{"width"} = |
| | 2896 | + @Image{"width"} - @PlotArea{"left"} - @PlotArea{"right"}; |
| | 2897 | + } |
| 2440 | 2898 | |
| 2441 | | - if (@PlotArea {"right"} ne "") |
| 2442 | | - { @PlotArea {"width"} = @Image {"width"} - @PlotArea {"left"} - @PlotArea {"right"} ; } |
| | 2899 | + if (@PlotArea{"top"} ne "") { |
| | 2900 | + @PlotArea{"height"} = |
| | 2901 | + @Image{"height"} - @PlotArea{"top"} - @PlotArea{"bottom"}; |
| | 2902 | + } |
| 2443 | 2903 | |
| 2444 | | - if (@PlotArea {"top"} ne "") |
| 2445 | | - { @PlotArea {"height"} = @Image {"height"} - @PlotArea {"top"} - @PlotArea {"bottom"} ; } |
| | 2904 | + if ((@Image{"width"} > 16) || (@Image{"height"} > 20)) { |
| | 2905 | + if (!$bypass) { |
| | 2906 | + &Error2( "Maximum image size is 1600x2000 pixels = 16x20 inch\n" |
| | 2907 | + . " Run with option -b (bypass checks) when this is correct.\n" |
| | 2908 | + ); |
| | 2909 | + return; |
| | 2910 | + } |
| | 2911 | + } |
| 2446 | 2912 | |
| 2447 | | - if ((@Image {"width"} > 16) || (@Image {"height"} > 20)) |
| 2448 | | - { |
| 2449 | | - if (! $bypass) |
| 2450 | | - { &Error2 ("Maximum image size is 1600x2000 pixels = 16x20 inch\n" . |
| 2451 | | - " Run with option -b (bypass checks) when this is correct.\n") ; return ; } |
| 2452 | | - } |
| | 2913 | + if ((@Image{"width"} < 0.25) || (@Image{"height"} < 0.25)) { |
| | 2914 | + &Error2("Minimum image size is 25x25 pixels = 0.25x0.25 inch\n"); |
| | 2915 | + return; |
| | 2916 | + } |
| 2453 | 2917 | |
| 2454 | | - if ((@Image {"width"} < 0.25) || (@Image {"height"} < 0.25)) |
| 2455 | | - { |
| 2456 | | - &Error2 ("Minimum image size is 25x25 pixels = 0.25x0.25 inch\n") ; |
| 2457 | | - return ; |
| 2458 | | - } |
| | 2918 | + if (@PlotArea{"width"} > @Image{"width"}) { |
| | 2919 | + &Error2("Plot width larger than image width. Please adjust.\n"); |
| | 2920 | + return; |
| | 2921 | + } |
| 2459 | 2922 | |
| 2460 | | - if (@PlotArea {"width"} > @Image {"width"}) |
| 2461 | | - { &Error2 ("Plot width larger than image width. Please adjust.\n") ; return ; } |
| | 2923 | + if (@PlotArea{"width"} < 0.2) { |
| | 2924 | + &Error2( |
| | 2925 | + "Plot width less than 20 pixels = 0.2 inch. Please adjust.\n"); |
| | 2926 | + return; |
| | 2927 | + } |
| 2462 | 2928 | |
| 2463 | | - if (@PlotArea {"width"} < 0.2) |
| 2464 | | - { &Error2 ("Plot width less than 20 pixels = 0.2 inch. Please adjust.\n") ; return ; } |
| | 2929 | + if (@PlotArea{"height"} > @Image{"height"}) { |
| | 2930 | + &Error2("Plot height larger than image height. Please adjust.\n"); |
| | 2931 | + return; |
| | 2932 | + } |
| 2465 | 2933 | |
| 2466 | | - if (@PlotArea {"height"} > @Image {"height"}) |
| 2467 | | - { &Error2 ("Plot height larger than image height. Please adjust.\n") ; return ; } |
| | 2934 | + if (@PlotArea{"height"} < 0.2) { |
| | 2935 | + &Error2( |
| | 2936 | + "Plot height less than 20 pixels = 0.2 inch. Please adjust.\n"); |
| | 2937 | + return; |
| | 2938 | + } |
| 2468 | 2939 | |
| 2469 | | - if (@PlotArea {"height"} < 0.2) |
| 2470 | | - { &Error2 ("Plot height less than 20 pixels = 0.2 inch. Please adjust.\n") ; return ; } |
| | 2940 | + if (@PlotArea{"left"} + @PlotArea{"width"} > @Image{"width"}) { |
| | 2941 | + &Error2( |
| | 2942 | + "Plot width + margins larger than image width. Please adjust.\n"); |
| | 2943 | + return; |
| | 2944 | + } |
| 2471 | 2945 | |
| 2472 | | - if (@PlotArea {"left"} + @PlotArea {"width"} > @Image {"width"}) |
| 2473 | | - { &Error2 ("Plot width + margins larger than image width. Please adjust.\n") ; return ; } |
| 2474 | | -# @PlotArea {"left"} = @Image {"width"} - @PlotArea {"width"} ; } |
| | 2946 | + # @PlotArea {"left"} = @Image {"width"} - @PlotArea {"width"} ; } |
| 2475 | 2947 | |
| 2476 | | - if (@PlotArea {"left"} < 0) |
| 2477 | | - { @PlotArea {"left"} = 0 ; } |
| | 2948 | + if (@PlotArea{"left"} < 0) { @PlotArea{"left"} = 0; } |
| 2478 | 2949 | |
| 2479 | | - if (@PlotArea {"bottom"} + @PlotArea {"height"} > @Image {"height"}) |
| 2480 | | - { &Error2 ("Plot height + margins larger than image height. Please adjust.\n") ; return ; } |
| 2481 | | -# @PlotArea {"bottom"} = @Image {"height"} - @PlotArea {"height"} ; } |
| | 2950 | + if (@PlotArea{"bottom"} + @PlotArea{"height"} > @Image{"height"}) { |
| | 2951 | + &Error2( |
| | 2952 | + "Plot height + margins larger than image height. Please adjust.\n" |
| | 2953 | + ); |
| | 2954 | + return; |
| | 2955 | + } |
| 2482 | 2956 | |
| 2483 | | - if (@PlotArea {"bottom"} < 0) |
| 2484 | | - { @PlotArea {"bottom"} = 0 ; } |
| | 2957 | + # @PlotArea {"bottom"} = @Image {"height"} - @PlotArea {"height"} ; } |
| 2485 | 2958 | |
| 2486 | | - if ((defined (@Scales {"Major"})) || |
| 2487 | | - (defined (@Scales {"Minor"}))) |
| 2488 | | - { |
| 2489 | | - if (defined (@Scales {"Major"})) |
| 2490 | | - { $margin = 0.2 ; } |
| 2491 | | - else |
| 2492 | | - { $margin = 0.05 ; } |
| | 2959 | + if (@PlotArea{"bottom"} < 0) { @PlotArea{"bottom"} = 0; } |
| 2493 | 2960 | |
| 2494 | | - if (@Axis {"time"} eq "x") |
| | 2961 | + if ( (defined(@Scales{"Major"})) |
| | 2962 | + || (defined(@Scales{"Minor"}))) |
| 2495 | 2963 | { |
| 2496 | | - if (@PlotArea {"bottom"} < $margin) |
| 2497 | | - { &Error2 ("Not enough space below plot area for plotting time axis\n" . |
| 2498 | | - " Specify 'PlotArea = bottom:x', where x is at least " . (100 * $margin) . " pixels = $margin inch\n") ; return ; } |
| | 2964 | + if (defined(@Scales{"Major"})) { $margin = 0.2; } |
| | 2965 | + else { $margin = 0.05; } |
| | 2966 | + |
| | 2967 | + if (@Axis{"time"} eq "x") { |
| | 2968 | + if (@PlotArea{"bottom"} < $margin) { |
| | 2969 | + &Error2( |
| | 2970 | + "Not enough space below plot area for plotting time axis\n" |
| | 2971 | + . " Specify 'PlotArea = bottom:x', where x is at least " |
| | 2972 | + . (100 * $margin) |
| | 2973 | + . " pixels = $margin inch\n"); |
| | 2974 | + return; |
| | 2975 | + } |
| | 2976 | + } |
| | 2977 | + else { |
| | 2978 | + if (@PlotArea{"left"} < $margin) { |
| | 2979 | + &Error2( |
| | 2980 | + "Not enough space outside plot area for plotting time axis\n" |
| | 2981 | + . " Specify 'PlotArea = left:x', where x is at least " |
| | 2982 | + . (100 * $margin) |
| | 2983 | + . " pixels = $margin inch\n"); |
| | 2984 | + return; |
| | 2985 | + } |
| | 2986 | + } |
| 2499 | 2987 | } |
| 2500 | | - else |
| 2501 | | - { |
| 2502 | | - if (@PlotArea {"left"} < $margin) |
| 2503 | | - { &Error2 ("Not enough space outside plot area for plotting time axis\n" . |
| 2504 | | - " Specify 'PlotArea = left:x', where x is at least " . (100 * $margin) . " pixels = $margin inch\n") ; return ; } |
| 2505 | | - } |
| 2506 | | - } |
| 2507 | 2988 | |
| 2508 | | - if (defined (@Legend {"orientation"})) |
| 2509 | | - { |
| 2510 | | - if (defined (@Legend {"left"})) |
| 2511 | | - { @Legend {"left"} = &Normalize (@Legend {"left"}, @Image {"width"}) ; } |
| 2512 | | - if (defined (@Legend {"top"})) |
| 2513 | | - { @Legend {"top"} = &Normalize (@Legend {"top"}, @Image {"height"}) ; } |
| 2514 | | - if (defined (@Legend {"columnwidth"})) |
| 2515 | | - { @Legend {"columnwidth"} = &Normalize (@Legend {"columnwidth"}, @Image {"width"}) ; } |
| | 2989 | + if (defined(@Legend{"orientation"})) { |
| | 2990 | + if (defined(@Legend{"left"})) { |
| | 2991 | + @Legend{"left"} = &Normalize(@Legend{"left"}, @Image{"width"}); |
| | 2992 | + } |
| | 2993 | + if (defined(@Legend{"top"})) { |
| | 2994 | + @Legend{"top"} = &Normalize(@Legend{"top"}, @Image{"height"}); |
| | 2995 | + } |
| | 2996 | + if (defined(@Legend{"columnwidth"})) { |
| | 2997 | + @Legend{"columnwidth"} = |
| | 2998 | + &Normalize(@Legend{"columnwidth"}, @Image{"width"}); |
| | 2999 | + } |
| 2516 | 3000 | |
| 2517 | | - if (! defined (@Legend {"columns"})) |
| 2518 | | - { |
| 2519 | | - @Legend {"columns"} = 1 ; |
| 2520 | | - if ((@Legend {"orientation"} =~ /ver/i) && |
| 2521 | | - (@Legend {"position"} =~ /^(?:top|bottom)$/i)) |
| 2522 | | - { |
| 2523 | | - if ($#LegendData > 10) |
| 2524 | | - { |
| 2525 | | - @Legend {"columns"} = 3 ; |
| 2526 | | - &Info2 ("Legend attribute 'columns' not defined. 3 columns assumed.") ; |
| | 3001 | + if (!defined(@Legend{"columns"})) { |
| | 3002 | + @Legend{"columns"} = 1; |
| | 3003 | + if ( (@Legend{"orientation"} =~ /ver/i) |
| | 3004 | + && (@Legend{"position"} =~ /^(?:top|bottom)$/i)) |
| | 3005 | + { |
| | 3006 | + if ($#LegendData > 10) { |
| | 3007 | + @Legend{"columns"} = 3; |
| | 3008 | + &Info2( |
| | 3009 | + "Legend attribute 'columns' not defined. 3 columns assumed." |
| | 3010 | + ); |
| | 3011 | + } |
| | 3012 | + elsif ($#LegendData > 5) { |
| | 3013 | + @Legend{"columns"} = 2; |
| | 3014 | + &Info2( |
| | 3015 | + "Legend attribute 'columns' not defined. 2 columns assumed." |
| | 3016 | + ); |
| | 3017 | + } |
| | 3018 | + } |
| 2527 | 3019 | } |
| 2528 | | - elsif ($#LegendData > 5) |
| 2529 | | - { |
| 2530 | | - @Legend {"columns"} = 2 ; |
| 2531 | | - &Info2 ("Legend attribute 'columns' not defined. 2 columns assumed.") ; |
| | 3020 | + |
| | 3021 | + if (@Legend{"position"} =~ /top/i) { |
| | 3022 | + if (!defined(@Legend{"left"})) { |
| | 3023 | + @Legend{"left"} = @PlotArea{"left"}; |
| | 3024 | + } |
| | 3025 | + if (!defined(@Legend{"top"})) { |
| | 3026 | + @Legend{"top"} = (@Image{"height"} - 0.2); |
| | 3027 | + } |
| | 3028 | + if ( (!defined(@Legend{"columnwidth"})) |
| | 3029 | + && (@Legend{"columns"} > 1)) |
| | 3030 | + { |
| | 3031 | + @Legend{"columnwidth"} = sprintf( |
| | 3032 | + "%02f", |
| | 3033 | + ( |
| | 3034 | + (@PlotArea{"left"} + @PlotArea{"width"} - 0.2) / |
| | 3035 | + @Legend{"columns"} |
| | 3036 | + ) |
| | 3037 | + ); |
| | 3038 | + } |
| 2532 | 3039 | } |
| 2533 | | - } |
| | 3040 | + elsif (@Legend{"position"} =~ /bottom/i) { |
| | 3041 | + if (!defined(@Legend{"left"})) { |
| | 3042 | + @Legend{"left"} = @PlotArea{"left"}; |
| | 3043 | + } |
| | 3044 | + if (!defined(@Legend{"top"})) { |
| | 3045 | + @Legend{"top"} = (@PlotArea{"bottom"} - 0.4); |
| | 3046 | + } |
| | 3047 | + if ( (!defined(@Legend{"columnwidth"})) |
| | 3048 | + && (@Legend{"columns"} > 1)) |
| | 3049 | + { |
| | 3050 | + @Legend{"columnwidth"} = sprintf( |
| | 3051 | + "%02f", |
| | 3052 | + ( |
| | 3053 | + (@PlotArea{"left"} + @PlotArea{"width"} - 0.2) / |
| | 3054 | + @Legend{"columns"} |
| | 3055 | + ) |
| | 3056 | + ); |
| | 3057 | + } |
| | 3058 | + } |
| | 3059 | + elsif (@Legend{"position"} =~ /right/i) { |
| | 3060 | + if (!defined(@Legend{"left"})) { |
| | 3061 | + @Legend{"left"} = |
| | 3062 | + (@PlotArea{"left"} + @PlotArea{"width"} + 0.2); |
| | 3063 | + } |
| | 3064 | + if (!defined(@Legend{"top"})) { |
| | 3065 | + @Legend{"top"} = |
| | 3066 | + (@PlotArea{"bottom"} + @PlotArea{"height"} - 0.2); |
| | 3067 | + } |
| | 3068 | + } |
| 2534 | 3069 | } |
| 2535 | 3070 | |
| 2536 | | - if (@Legend {"position"} =~ /top/i) |
| 2537 | | - { |
| 2538 | | - if (! defined (@Legend {"left"})) |
| 2539 | | - { @Legend {"left"} = @PlotArea {"left"} ; } |
| 2540 | | - if (! defined (@Legend {"top"})) |
| 2541 | | - { @Legend {"top"} = (@Image {"height"} - 0.2) ; } |
| 2542 | | - if ((! defined (@Legend {"columnwidth"})) && (@Legend {"columns"} > 1)) |
| 2543 | | - { @Legend {"columnwidth"} = sprintf ("%02f", ((@PlotArea {"left"} + @PlotArea {"width"} - 0.2) / @Legend {"columns"})) ; } |
| 2544 | | - } |
| 2545 | | - elsif (@Legend {"position"} =~ /bottom/i) |
| 2546 | | - { |
| 2547 | | - if (! defined (@Legend {"left"})) |
| 2548 | | - { @Legend {"left"} = @PlotArea {"left"} ; } |
| 2549 | | - if (! defined (@Legend {"top"})) |
| 2550 | | - { @Legend {"top"} = (@PlotArea {"bottom"} - 0.4) ; } |
| 2551 | | - if ((! defined (@Legend {"columnwidth"})) && (@Legend {"columns"} > 1)) |
| 2552 | | - { @Legend {"columnwidth"} = sprintf ("%02f", ((@PlotArea {"left"} + @PlotArea {"width"} - 0.2) / @Legend {"columns"})) ; } |
| 2553 | | - } |
| 2554 | | - elsif (@Legend {"position"} =~ /right/i) |
| 2555 | | - { |
| 2556 | | - if (! defined (@Legend {"left"})) |
| 2557 | | - { @Legend {"left"} = (@PlotArea {"left"} + @PlotArea {"width"} + 0.2) ; } |
| 2558 | | - if (! defined (@Legend {"top"})) |
| 2559 | | - { @Legend {"top"} = (@PlotArea {"bottom"} + @PlotArea {"height"} - 0.2) ; } |
| 2560 | | - } |
| 2561 | | - } |
| 2562 | | - |
| 2563 | | - if (! defined (@Axis {"order"})) |
| 2564 | | - { @Axis {"order"} = "normal" ; } |
| | 3071 | + if (!defined(@Axis{"order"})) { @Axis{"order"} = "normal"; } |
| 2565 | 3072 | } |
| 2566 | 3073 | |
| 2567 | | -sub WriteProcAnnotate |
| 2568 | | -{ |
| 2569 | | - my $bar = shift ; |
| 2570 | | - my $shiftx = shift ; |
| 2571 | | - my $xpos = shift ; |
| 2572 | | - my $ypos = shift ; |
| 2573 | | - my $text = shift ; |
| 2574 | | - my $textcolor = shift ; |
| 2575 | | - my $fontsize = shift ; |
| 2576 | | - my $align = shift ; |
| 2577 | | - my $link = shift ; |
| 2578 | | - my $hint = shift ; |
| | 3074 | +sub WriteProcAnnotate { |
| | 3075 | + my $bar = shift; |
| | 3076 | + my $shiftx = shift; |
| | 3077 | + my $xpos = shift; |
| | 3078 | + my $ypos = shift; |
| | 3079 | + my $text = shift; |
| | 3080 | + my $textcolor = shift; |
| | 3081 | + my $fontsize = shift; |
| | 3082 | + my $align = shift; |
| | 3083 | + my $link = shift; |
| | 3084 | + my $hint = shift; |
| 2579 | 3085 | |
| 2580 | | - if (length ($text) > 250) |
| 2581 | | - { &Error ("Text segments can be up to 250 characters long. This segment is " . length ($text) . " chars.\n" . |
| 2582 | | - " You can either shorten the text or\n" . |
| 2583 | | - " - PlotData: insert line breaks (~)\n" . |
| 2584 | | - " - TextData: insert tabs (~) to produce columns\n") ; return ; } |
| | 3086 | + if (length($text) > 250) { |
| | 3087 | + &Error( |
| | 3088 | + "Text segments can be up to 250 characters long. This segment is " |
| | 3089 | + . length($text) |
| | 3090 | + . " chars.\n" |
| | 3091 | + . " You can either shorten the text or\n" |
| | 3092 | + . " - PlotData: insert line breaks (~)\n" |
| | 3093 | + . " - TextData: insert tabs (~) to produce columns\n"); |
| | 3094 | + return; |
| | 3095 | + } |
| 2585 | 3096 | |
| 2586 | | - if ($textcolor eq "") |
| 2587 | | - { $textcolor = "black" ; } |
| | 3097 | + if ($textcolor eq "") { $textcolor = "black"; } |
| 2588 | 3098 | |
| 2589 | | - my $textdetails = " textdetails: align=$align size=$fontsize color=$textcolor" ; |
| | 3099 | + my $textdetails = |
| | 3100 | + " textdetails: align=$align size=$fontsize color=$textcolor"; |
| 2590 | 3101 | |
| 2591 | | - push @PlotTextsPng, "#proc annotate\n" ; |
| 2592 | | - push @PlotTextsSvg, "#proc annotate\n" ; |
| | 3102 | + push @PlotTextsPng, "#proc annotate\n"; |
| | 3103 | + push @PlotTextsSvg, "#proc annotate\n"; |
| 2593 | 3104 | |
| 2594 | | - push @PlotTextsPng, " location: $xpos $ypos\n" ; |
| 2595 | | - push @PlotTextsSvg, " location: $xpos $ypos\n" ; |
| | 3105 | + push @PlotTextsPng, " location: $xpos $ypos\n"; |
| | 3106 | + push @PlotTextsSvg, " location: $xpos $ypos\n"; |
| 2596 | 3107 | |
| 2597 | | - push @PlotTextsPng, $textdetails . "\n" ; |
| 2598 | | - push @PlotTextsSvg, $textdetails . "\n" ; |
| | 3108 | + push @PlotTextsPng, $textdetails . "\n"; |
| | 3109 | + push @PlotTextsSvg, $textdetails . "\n"; |
| 2599 | 3110 | |
| 2600 | | - $text2 = $text ; |
| 2601 | | - $text2 =~ s/\[\[//g ; |
| 2602 | | - $text2 =~ s/\]\]//g ; |
| 2603 | | - if ($text2 =~ /^\s/) |
| 2604 | | - { push @PlotTextsPng, " text: \n\\$text2\n\n" ; } |
| 2605 | | - else |
| 2606 | | - { push @PlotTextsPng, " text: $text2\n\n" ; } |
| | 3111 | + $text2 = $text; |
| | 3112 | + $text2 =~ s/\[\[//g; |
| | 3113 | + $text2 =~ s/\]\]//g; |
| | 3114 | + if ($text2 =~ /^\s/) { push @PlotTextsPng, " text: \n\\$text2\n\n"; } |
| | 3115 | + else { push @PlotTextsPng, " text: $text2\n\n"; } |
| 2607 | 3116 | |
| 2608 | | - $text2 = $text ; |
| 2609 | | - if ($link ne "") |
| 2610 | | - { |
| 2611 | | - # put placeholder in Ploticus input file |
| 2612 | | - # will be replaced by real link after SVG generation |
| 2613 | | - # this allows adding color info |
| 2614 | | - push @linksSVG, &DecodeInput ($link) ; |
| 2615 | | - my $lcnt = $#linksSVG ; |
| 2616 | | - $text2 =~ s/\[\[ ([^\]]+) \]\]/\[$lcnt\[$1\]$lcnt\]/x ; |
| 2617 | | - $text2 =~ s/\[\[ ([^\]]+) $/\[$lcnt\[$1\]$lcnt\]/x ; |
| 2618 | | - $text2 =~ s/^ ([^\[]+) \]\]/\[$lcnt\[$1\]$lcnt\]/x ; |
| 2619 | | - } |
| | 3117 | + $text2 = $text; |
| | 3118 | + if ($link ne "") { |
| 2620 | 3119 | |
| 2621 | | - $text3 = &EncodeHtml ($text2) ; |
| 2622 | | - if ($text2 ne $text3) |
| 2623 | | - { |
| 2624 | | - # put placeholder in Ploticus input file |
| 2625 | | - # will be replaced by real text after SVG generation |
| 2626 | | - # Ploticus would autoscale image improperly when text contains &#xxx; tags |
| 2627 | | - # because this would count as 5 chars |
| 2628 | | - push @textsSVG, &DecodeInput ($text3) ; |
| 2629 | | - $text3 = "{{" . $#textsSVG . "}}" ; |
| 2630 | | - while (length ($text3) < length ($text2)) { $text3 .= "x" ; } |
| 2631 | | - } |
| | 3120 | + # put placeholder in Ploticus input file |
| | 3121 | + # will be replaced by real link after SVG generation |
| | 3122 | + # this allows adding color info |
| | 3123 | + push @linksSVG, &DecodeInput($link); |
| | 3124 | + my $lcnt = $#linksSVG; |
| | 3125 | + $text2 =~ s/\[\[ ([^\]]+) \]\]/\[$lcnt\[$1\]$lcnt\]/x; |
| | 3126 | + $text2 =~ s/\[\[ ([^\]]+) $/\[$lcnt\[$1\]$lcnt\]/x; |
| | 3127 | + $text2 =~ s/^ ([^\[]+) \]\]/\[$lcnt\[$1\]$lcnt\]/x; |
| | 3128 | + } |
| 2632 | 3129 | |
| 2633 | | - if ($text3 =~ /^\s/) |
| 2634 | | - { push @PlotTextsSvg, " text: \n\\$text3\n\n" ; } |
| 2635 | | - else |
| 2636 | | - { push @PlotTextsSvg, " text: $text3\n\n" ; } |
| | 3130 | + $text3 = &EncodeHtml($text2); |
| | 3131 | + if ($text2 ne $text3) { |
| 2637 | 3132 | |
| 2638 | | - if ($link ne "") |
| 2639 | | - { |
| 2640 | | - $MapPNG = $true ; |
| | 3133 | + # put placeholder in Ploticus input file |
| | 3134 | + # will be replaced by real text after SVG generation |
| | 3135 | + # Ploticus would autoscale image improperly when text contains &#xxx; tags |
| | 3136 | + # because this would count as 5 chars |
| | 3137 | + push @textsSVG, &DecodeInput($text3); |
| | 3138 | + $text3 = "{{" . $#textsSVG . "}}"; |
| | 3139 | + while (length($text3) < length($text2)) { $text3 .= "x"; } |
| | 3140 | + } |
| 2641 | 3141 | |
| 2642 | | - push @PlotTextsPng, "#proc annotate\n" ; |
| 2643 | | - push @PlotTextsPng, " location: $xpos $ypos\n" ; |
| | 3142 | + if ($text3 =~ /^\s/) { push @PlotTextsSvg, " text: \n\\$text3\n\n"; } |
| | 3143 | + else { push @PlotTextsSvg, " text: $text3\n\n"; } |
| 2644 | 3144 | |
| 2645 | | -# push @PlotTextsPng, " boxmargin: 0.01\n" ; |
| | 3145 | + if ($link ne "") { |
| | 3146 | + $MapPNG = $true; |
| 2646 | 3147 | |
| 2647 | | - if ($align ne "right") |
| 2648 | | - { |
| 2649 | | - push @PlotTextsPng, " clickmapurl: $link\n" ; |
| 2650 | | - if ($hint ne "") |
| 2651 | | - { push @PlotTextsPng, " clickmaplabel: $hint\n" ; } |
| 2652 | | - } |
| 2653 | | - else |
| 2654 | | - { |
| 2655 | | - if ($bar eq "") |
| 2656 | | - { |
| 2657 | | - if ($WarnOnRightAlignedText ++ == 0) |
| 2658 | | - { &Warning2 ("Links on right aligned texts are only supported for svg output,\npending Ploticus bug fix.") ; } |
| 2659 | | - return ; |
| 2660 | | - } |
| 2661 | | - else |
| 2662 | | - { |
| 2663 | | - push @PlotTextsPng, " clickmapurl: $link\&\&$shiftx\n" ; |
| 2664 | | - if ($hint ne "") |
| 2665 | | - { push @PlotTextsPng, " clickmaplabel: $hint\n" ; } |
| 2666 | | - } |
| 2667 | | - } |
| | 3148 | + push @PlotTextsPng, "#proc annotate\n"; |
| | 3149 | + push @PlotTextsPng, " location: $xpos $ypos\n"; |
| 2668 | 3150 | |
| 2669 | | - $textdetails =~ s/color=[^\s]+/color=$LinkColor/ ; |
| 2670 | | - push @PlotTextsPng, $textdetails . "\n" ; |
| | 3151 | + # push @PlotTextsPng, " boxmargin: 0.01\n" ; |
| 2671 | 3152 | |
| 2672 | | - $text = &DecodeInput ($text) ; |
| 2673 | | - if ($text =~ /^[^\[]+\]\]/) |
| 2674 | | - { $text = "[[" . $text ; } |
| 2675 | | - if ($text =~ /\[\[[^\]]+$/) |
| 2676 | | - { $text .= "]]" ; } |
| 2677 | | - my $pos1 = index ($text, "[[") ; |
| 2678 | | - my $pos2 = index ($text, "]]") + 1 ; |
| 2679 | | - if (($pos1 > -1) && ($pos2 > -1)) |
| 2680 | | - { |
| 2681 | | - for (my $i = 0 ; $i < length ($text) ; $i++) |
| 2682 | | - { |
| 2683 | | - $c = substr ($text, $i, 1) ; |
| 2684 | | - if ($c ne "\n") |
| 2685 | | - { |
| 2686 | | - if (($i < $pos1) || ($i > $pos2)) |
| 2687 | | - { substr ($text, $i, 1) = " " ; } |
| | 3153 | + if ($align ne "right") { |
| | 3154 | + push @PlotTextsPng, " clickmapurl: $link\n"; |
| | 3155 | + if ($hint ne "") { |
| | 3156 | + push @PlotTextsPng, " clickmaplabel: $hint\n"; |
| | 3157 | + } |
| 2688 | 3158 | } |
| 2689 | | - } |
| 2690 | | - } |
| | 3159 | + else { |
| | 3160 | + if ($bar eq "") { |
| | 3161 | + if ($WarnOnRightAlignedText++ == 0) { |
| | 3162 | + &Warning2( |
| | 3163 | + "Links on right aligned texts are only supported for svg output,\npending Ploticus bug fix." |
| | 3164 | + ); |
| | 3165 | + } |
| | 3166 | + return; |
| | 3167 | + } |
| | 3168 | + else { |
| | 3169 | + push @PlotTextsPng, " clickmapurl: $link\&\&$shiftx\n"; |
| | 3170 | + if ($hint ne "") { |
| | 3171 | + push @PlotTextsPng, " clickmaplabel: $hint\n"; |
| | 3172 | + } |
| | 3173 | + } |
| | 3174 | + } |
| 2691 | 3175 | |
| 2692 | | - $text =~ s/\[\[(.*?)\]\]/$1/s ; |
| | 3176 | + $textdetails =~ s/color=[^\s]+/color=$LinkColor/; |
| | 3177 | + push @PlotTextsPng, $textdetails . "\n"; |
| 2693 | 3178 | |
| 2694 | | - if ($text =~ /^\s/) |
| 2695 | | - { push @PlotTextsPng, " text: \n\\$text\n\n" ; } |
| 2696 | | - else |
| 2697 | | - { push @PlotTextsPng, " text: $text\n\n" ; } |
| | 3179 | + $text = &DecodeInput($text); |
| | 3180 | + if ($text =~ /^[^\[]+\]\]/) { $text = "[[" . $text; } |
| | 3181 | + if ($text =~ /\[\[[^\]]+$/) { $text .= "]]"; } |
| | 3182 | + my $pos1 = index($text, "[["); |
| | 3183 | + my $pos2 = index($text, "]]") + 1; |
| | 3184 | + if (($pos1 > -1) && ($pos2 > -1)) { |
| | 3185 | + for (my $i = 0; $i < length($text); $i++) { |
| | 3186 | + $c = substr($text, $i, 1); |
| | 3187 | + if ($c ne "\n") { |
| | 3188 | + if (($i < $pos1) || ($i > $pos2)) { |
| | 3189 | + substr($text, $i, 1) = " "; |
| | 3190 | + } |
| | 3191 | + } |
| | 3192 | + } |
| | 3193 | + } |
| 2698 | 3194 | |
| 2699 | | -# push @PlotTextsPng, "#proc rect\n" ; |
| 2700 | | -# push @PlotTextsPng, " color: green\n" ; |
| 2701 | | -# push @PlotTextsPng, " rectangle: 1(s)+0.25 1937.500(s)+0.06 1(s)+0.50 1937.500(s)+0.058\n" ; |
| 2702 | | -# push @PlotTextsPng, "\n\n" ; |
| 2703 | | - } |
| 2704 | | -} |
| | 3195 | + $text =~ s/\[\[(.*?)\]\]/$1/s; |
| 2705 | 3196 | |
| 2706 | | -sub WriteText |
| 2707 | | -{ |
| 2708 | | - my $mode = shift ; |
| 2709 | | - my $bar = shift ; |
| 2710 | | - my $shiftx = shift ; |
| 2711 | | - my $posx = shift ; |
| 2712 | | - my $posy = shift ; |
| 2713 | | - my $text = shift ; |
| 2714 | | - my $textcolor = shift ; |
| 2715 | | - my $fontsize = shift ; |
| 2716 | | - my $align = shift ; |
| 2717 | | - my $link = shift ; |
| 2718 | | - my $hint = shift ; |
| 2719 | | - my $tabs = shift ; |
| 2720 | | - my ($link2, $hint2, $tab) ; |
| 2721 | | - my $outside = $false ; |
| 2722 | | - if (@Axis {"order"} =~ /reverse/i) |
| 2723 | | - { |
| 2724 | | - if (@Axis {"time"} eq "y") |
| 2725 | | - { $posy =~ s/(.*)(\(s\))/(-$1).$2/xe ; } |
| 2726 | | - else |
| 2727 | | - { $posx =~ s/(.*)(\(s\))/(-$1).$2/xe ; } |
| 2728 | | - } |
| | 3197 | + if ($text =~ /^\s/) { push @PlotTextsPng, " text: \n\\$text\n\n"; } |
| | 3198 | + else { push @PlotTextsPng, " text: $text\n\n"; } |
| 2729 | 3199 | |
| 2730 | | - if ($posx !~ /\(s\)/) |
| 2731 | | - { |
| 2732 | | - if ($posx < 0) |
| 2733 | | - { $outside = $true ; } |
| 2734 | | - if (@Image {"width"} !~ /auto/i) |
| 2735 | | - { |
| 2736 | | - if ($posx > @Image {"width"}/100) |
| 2737 | | - { $outside = $true ; } |
| 2738 | | - } |
| 2739 | | - } |
| 2740 | | - if ($posy !~ /\(s\)/) |
| 2741 | | - { |
| 2742 | | - if ($posy < 0) |
| 2743 | | - { $outside = $true ; } |
| 2744 | | - if (@Image {"height"} !~ /auto/i) |
| 2745 | | - { |
| 2746 | | - if ($posy > @Image {"height"}/100) |
| 2747 | | - { $outside = $true ; } |
| 2748 | | - } |
| 2749 | | - } |
| 2750 | | - if ($outside) |
| 2751 | | - { |
| 2752 | | - if ($WarnTextOutsideArea++ < 5) |
| 2753 | | - { $text =~ s/\n/~/g ; |
| 2754 | | - &Error ("Text segment '$text' falls outside image area. Text ignored.") ; } |
| 2755 | | - return ; |
| 2756 | | - } |
| | 3200 | + # push @PlotTextsPng, "#proc rect\n" ; |
| | 3201 | + # push @PlotTextsPng, " color: green\n" ; |
| | 3202 | + # push @PlotTextsPng, " rectangle: 1(s)+0.25 1937.500(s)+0.06 1(s)+0.50 1937.500(s)+0.058\n" ; |
| | 3203 | + # push @PlotTextsPng, "\n\n" ; |
| | 3204 | + } |
| | 3205 | +} |
| 2757 | 3206 | |
| 2758 | | - my @Tabs = split (",", $tabs) ; |
| 2759 | | - foreach $tab (@Tabs) |
| 2760 | | - { $tab =~ s/\s* (.*) \s*$/$1/x ; } |
| | 3207 | +sub WriteText { |
| | 3208 | + my $mode = shift; |
| | 3209 | + my $bar = shift; |
| | 3210 | + my $shiftx = shift; |
| | 3211 | + my $posx = shift; |
| | 3212 | + my $posy = shift; |
| | 3213 | + my $text = shift; |
| | 3214 | + my $textcolor = shift; |
| | 3215 | + my $fontsize = shift; |
| | 3216 | + my $align = shift; |
| | 3217 | + my $link = shift; |
| | 3218 | + my $hint = shift; |
| | 3219 | + my $tabs = shift; |
| | 3220 | + my ($link2, $hint2, $tab); |
| | 3221 | + my $outside = $false; |
| 2761 | 3222 | |
| 2762 | | - $posx0 = $posx ; |
| 2763 | | - my @Text ; |
| 2764 | | - my $dy = 0 ; |
| | 3223 | + if (@Axis{"order"} =~ /reverse/i) { |
| | 3224 | + if (@Axis{"time"} eq "y") { $posy =~ s/(.*)(\(s\))/(-$1).$2/xe; } |
| | 3225 | + else { $posx =~ s/(.*)(\(s\))/(-$1).$2/xe; } |
| | 3226 | + } |
| 2765 | 3227 | |
| 2766 | | - if ($text =~ /\[\[.*\]\]/) |
| 2767 | | - { |
| 2768 | | - $link = "" ; $hint = "" ; |
| 2769 | | - } |
| 2770 | | - |
| 2771 | | - my @Text ; |
| 2772 | | - if ($mode eq "^") |
| 2773 | | - { @Text = split ('\^', $text) ; } |
| 2774 | | - elsif ($mode eq "~") |
| 2775 | | - { |
| 2776 | | - @Text = split ('\n', $text) ; |
| 2777 | | - |
| 2778 | | - if ($fontsize =~ /^(?:XS|S|M|L|XL)$/i) |
| 2779 | | - { |
| 2780 | | - if ($fontsize =~ /XS/i) { $dy = 0.09 ; } |
| 2781 | | - elsif ($fontsize =~ /S/i) { $dy = 0.11 ; } |
| 2782 | | - elsif ($fontsize =~ /M/i) { $dy = 0.135 ; } |
| 2783 | | - elsif ($fontsize =~ /XL/i) { $dy = 0.21 ; } |
| 2784 | | - else { $dy = 0.16 ; } |
| | 3228 | + if ($posx !~ /\(s\)/) { |
| | 3229 | + if ($posx < 0) { $outside = $true; } |
| | 3230 | + if (@Image{"width"} !~ /auto/i) { |
| | 3231 | + if ($posx > @Image{"width"} / 100) { $outside = $true; } |
| | 3232 | + } |
| 2785 | 3233 | } |
| 2786 | | - else |
| 2787 | | - { |
| 2788 | | - $dy = sprintf ("%.2f", (($fontsize * 1.2) / 100)) ; |
| 2789 | | - if ($dy < $fontsize/100 + 0.02) |
| 2790 | | - { $dy = $fontsize/100 + 0.02 ; } |
| | 3234 | + if ($posy !~ /\(s\)/) { |
| | 3235 | + if ($posy < 0) { $outside = $true; } |
| | 3236 | + if (@Image{"height"} !~ /auto/i) { |
| | 3237 | + if ($posy > @Image{"height"} / 100) { $outside = $true; } |
| | 3238 | + } |
| 2791 | 3239 | } |
| 2792 | | - } |
| 2793 | | - else |
| 2794 | | - { push @Text, $text ; } |
| | 3240 | + if ($outside) { |
| | 3241 | + if ($WarnTextOutsideArea++ < 5) { |
| | 3242 | + $text =~ s/\n/~/g; |
| | 3243 | + &Error( |
| | 3244 | + "Text segment '$text' falls outside image area. Text ignored." |
| | 3245 | + ); |
| | 3246 | + } |
| | 3247 | + return; |
| | 3248 | + } |
| 2795 | 3249 | |
| | 3250 | + my @Tabs = split(",", $tabs); |
| | 3251 | + foreach $tab (@Tabs) { $tab =~ s/\s* (.*) \s*$/$1/x; } |
| 2796 | 3252 | |
| 2797 | | - foreach $text (@Text) |
| 2798 | | - { |
| 2799 | | - if ($text !~ /^[\n\s]*$/) |
| 2800 | | - { |
| 2801 | | - $link2 = "" ; |
| 2802 | | - $hint2 = "" ; |
| 2803 | | - ($text, $link2, $hint2) = &ProcessWikiLink ($text, $link2, $hint2) ; |
| | 3253 | + $posx0 = $posx; |
| | 3254 | + my @Text; |
| | 3255 | + my $dy = 0; |
| 2804 | 3256 | |
| 2805 | | - if ($link2 eq "") |
| 2806 | | - { |
| 2807 | | - $link2 = $link ; |
| 2808 | | - if (($link ne "") && ($text !~ /\[\[.*\]\]/)) |
| 2809 | | - { $text = "[[" . $text . "]]" ;} |
| 2810 | | - } |
| 2811 | | - if ($hint2 eq "") |
| 2812 | | - { $hint2 = $hint ; } |
| 2813 | | - |
| 2814 | | - &WriteProcAnnotate ($bar, $shiftx, $posx, $posy, $text, $textcolor, $fontsize, $align, $link2, $hint2) ; |
| | 3257 | + if ($text =~ /\[\[.*\]\]/) { |
| | 3258 | + $link = ""; |
| | 3259 | + $hint = ""; |
| 2815 | 3260 | } |
| 2816 | 3261 | |
| 2817 | | - if ($#Tabs >= 0) |
| 2818 | | - { |
| 2819 | | - $tab = shift (@Tabs) ; |
| 2820 | | - ($dx,$align) = split ("\-", $tab) ; |
| 2821 | | - $posx = $posx0 + &Normalize ($dx) ; |
| | 3262 | + my @Text; |
| | 3263 | + if ($mode eq "^") { @Text = split('\^', $text); } |
| | 3264 | + elsif ($mode eq "~") { |
| | 3265 | + @Text = split('\n', $text); |
| | 3266 | + |
| | 3267 | + if ($fontsize =~ /^(?:XS|S|M|L|XL)$/i) { |
| | 3268 | + if ($fontsize =~ /XS/i) { $dy = 0.09; } |
| | 3269 | + elsif ($fontsize =~ /S/i) { $dy = 0.11; } |
| | 3270 | + elsif ($fontsize =~ /M/i) { $dy = 0.135; } |
| | 3271 | + elsif ($fontsize =~ /XL/i) { $dy = 0.21; } |
| | 3272 | + else { $dy = 0.16; } |
| | 3273 | + } |
| | 3274 | + else { |
| | 3275 | + $dy = sprintf("%.2f", (($fontsize * 1.2) / 100)); |
| | 3276 | + if ($dy < $fontsize / 100 + 0.02) { |
| | 3277 | + $dy = $fontsize / 100 + 0.02; |
| | 3278 | + } |
| | 3279 | + } |
| 2822 | 3280 | } |
| 2823 | | - if ($posy =~ /\+/) |
| 2824 | | - { ($posy1, $posy2) = split ('\+', $posy) ; } |
| 2825 | | - elsif ($posy =~ /.+\-/) |
| 2826 | | - { |
| 2827 | | - if ($posy =~ /^\-/) |
| 2828 | | - { |
| 2829 | | - ($sign, $posy1, $posy2) = split ('\-', $posy) ; $posy2 = -$posy2 ; |
| 2830 | | - $posy1 = "-" . $posy1 ; |
| 2831 | | - } |
| 2832 | | - else |
| 2833 | | - { ($posy1, $posy2) = split ('\-', $posy) ; $posy2 = -$posy2 ; } |
| 2834 | | - } |
| 2835 | | - else |
| 2836 | | - { $posy1 = $posy ; $posy2 = 0 ; } |
| | 3281 | + else { push @Text, $text; } |
| 2837 | 3282 | |
| 2838 | | - $posy2 -= $dy ; |
| | 3283 | + foreach $text (@Text) { |
| | 3284 | + if ($text !~ /^[\n\s]*$/) { |
| | 3285 | + $link2 = ""; |
| | 3286 | + $hint2 = ""; |
| | 3287 | + ($text, $link2, $hint2) = &ProcessWikiLink($text, $link2, $hint2); |
| 2839 | 3288 | |
| 2840 | | - if ($posy2 == 0) |
| 2841 | | - { $posy = $posy1 ; } |
| 2842 | | - elsif ($posy2 < 0) |
| 2843 | | - { $posy = $posy1 . "$posy2" ; } |
| 2844 | | - else |
| 2845 | | - { $posy = $posy1 . "+" . $posy2 ; } |
| 2846 | | - } |
| 2847 | | -} |
| | 3289 | + if ($link2 eq "") { |
| | 3290 | + $link2 = $link; |
| | 3291 | + if (($link ne "") && ($text !~ /\[\[.*\]\]/)) { |
| | 3292 | + $text = "[[" . $text . "]]"; |
| | 3293 | + } |
| | 3294 | + } |
| | 3295 | + if ($hint2 eq "") { $hint2 = $hint; } |
| 2848 | 3296 | |
| 2849 | | -sub WriteProcDrawCommandsOld |
| 2850 | | -{ |
| 2851 | | - my $posx = shift ; |
| 2852 | | - my $posy = shift ; |
| 2853 | | - my $text = shift ; |
| 2854 | | - my $textcolor = shift ; |
| 2855 | | - my $fontsize = shift ; |
| 2856 | | - my $link = shift ; |
| 2857 | | - my $hint = shift ; |
| | 3297 | + &WriteProcAnnotate( |
| | 3298 | + $bar, $shiftx, $posx, $posy, $text, |
| | 3299 | + $textcolor, $fontsize, $align, $link2, $hint2 |
| | 3300 | + ); |
| | 3301 | + } |
| 2858 | 3302 | |
| 2859 | | - $posx0 = $posx ; |
| 2860 | | - my @Text = split ('\^', $text) ; |
| 2861 | | - my $align = "text" ; |
| 2862 | | - foreach $text (@Text) |
| 2863 | | - { |
| 2864 | | - push @TextData, " mov $posx $posy\n" ; |
| 2865 | | - push @TextData, " textsize $fontsize\n" ; |
| 2866 | | - push @TextData, " color $textcolor\n" ; |
| 2867 | | - push @TextData, " $align $text\n" ; |
| | 3303 | + if ($#Tabs >= 0) { |
| | 3304 | + $tab = shift(@Tabs); |
| | 3305 | + ($dx, $align) = split("\-", $tab); |
| | 3306 | + $posx = $posx0 + &Normalize($dx); |
| | 3307 | + } |
| | 3308 | + if ($posy =~ /\+/) { ($posy1, $posy2) = split('\+', $posy); } |
| | 3309 | + elsif ($posy =~ /.+\-/) { |
| | 3310 | + if ($posy =~ /^\-/) { |
| | 3311 | + ($sign, $posy1, $posy2) = split('\-', $posy); |
| | 3312 | + $posy2 = -$posy2; |
| | 3313 | + $posy1 = "-" . $posy1; |
| | 3314 | + } |
| | 3315 | + else { |
| | 3316 | + ($posy1, $posy2) = split('\-', $posy); |
| | 3317 | + $posy2 = -$posy2; |
| | 3318 | + } |
| | 3319 | + } |
| | 3320 | + else { $posy1 = $posy; $posy2 = 0; } |
| 2868 | 3321 | |
| | 3322 | + $posy2 -= $dy; |
| 2869 | 3323 | |
| 2870 | | - $tab = shift (@Tabs) ; |
| 2871 | | - ($dx,$align) = split ("\-", $tab) ; |
| 2872 | | - $posx = $posx0 + &Normalize ($dx) ; |
| 2873 | | - if ($align =~ /left/i) { $align = "text" ; } |
| 2874 | | - elsif ($align =~ /right/i) { $align = "rightjust" ; } |
| 2875 | | - else { $align = "centext" ; } |
| 2876 | | - } |
| | 3324 | + if ($posy2 == 0) { $posy = $posy1; } |
| | 3325 | + elsif ($posy2 < 0) { $posy = $posy1 . "$posy2"; } |
| | 3326 | + else { $posy = $posy1 . "+" . $posy2; } |
| | 3327 | + } |
| 2877 | 3328 | } |
| 2878 | 3329 | |
| 2879 | | -sub WritePlotFile |
| 2880 | | -{ |
| 2881 | | - &WriteTexts ; |
| | 3330 | +sub WriteProcDrawCommandsOld { |
| | 3331 | + my $posx = shift; |
| | 3332 | + my $posy = shift; |
| | 3333 | + my $text = shift; |
| | 3334 | + my $textcolor = shift; |
| | 3335 | + my $fontsize = shift; |
| | 3336 | + my $link = shift; |
| | 3337 | + my $hint = shift; |
| 2882 | 3338 | |
| 2883 | | - $script = "" ; |
| 2884 | | - my ($color) ; |
| 2885 | | - if (@Axis {"time"} eq "x") |
| 2886 | | - { $AxisBars = "y" ; } |
| 2887 | | - else |
| 2888 | | - { $AxisBars = "x" ; } |
| | 3339 | + $posx0 = $posx; |
| | 3340 | + my @Text = split('\^', $text); |
| | 3341 | + my $align = "text"; |
| | 3342 | + foreach $text (@Text) { |
| | 3343 | + push @TextData, " mov $posx $posy\n"; |
| | 3344 | + push @TextData, " textsize $fontsize\n"; |
| | 3345 | + push @TextData, " color $textcolor\n"; |
| | 3346 | + push @TextData, " $align $text\n"; |
| 2889 | 3347 | |
| 2890 | | -# if ((@Axis {"time"} eq "y") && ($#Bars > 0)) |
| 2891 | | -# { |
| 2892 | | -# undef @BarsTmp ; |
| 2893 | | -# while ($#Bars >= 0) |
| 2894 | | -# { push @BarsTmp, pop @Bars ; } |
| 2895 | | -# @Bars = @BarsTmp ; |
| 2896 | | -# } |
| | 3348 | + $tab = shift(@Tabs); |
| | 3349 | + ($dx, $align) = split("\-", $tab); |
| | 3350 | + $posx = $posx0 + &Normalize($dx); |
| | 3351 | + if ($align =~ /left/i) { $align = "text"; } |
| | 3352 | + elsif ($align =~ /right/i) { $align = "rightjust"; } |
| | 3353 | + else { $align = "centext"; } |
| | 3354 | + } |
| | 3355 | +} |
| 2897 | 3356 | |
| 2898 | | - if ($tmpdir ne "") |
| 2899 | | - { $file_script = $tmpdir.$pathseparator."EasyTimeline.txt.$$" ; } |
| 2900 | | - else |
| 2901 | | - { $file_script = "EasyTimeline.txt" ; } |
| | 3357 | +sub WritePlotFile { |
| | 3358 | + &WriteTexts; |
| 2902 | 3359 | |
| 2903 | | - print "Ploticus input file = ".$file_script."\n"; |
| | 3360 | + $script = ""; |
| | 3361 | + my ($color); |
| | 3362 | + if (@Axis{"time"} eq "x") { $AxisBars = "y"; } |
| | 3363 | + else { $AxisBars = "x"; } |
| 2904 | 3364 | |
| 2905 | | - # $fmt = "gif" ; |
| 2906 | | - open "FILE_OUT", ">", $file_script ; |
| | 3365 | + # if ((@Axis {"time"} eq "y") && ($#Bars > 0)) |
| | 3366 | + # { |
| | 3367 | + # undef @BarsTmp ; |
| | 3368 | + # while ($#Bars >= 0) |
| | 3369 | + # { push @BarsTmp, pop @Bars ; } |
| | 3370 | + # @Bars = @BarsTmp ; |
| | 3371 | + # } |
| 2907 | 3372 | |
| 2908 | | - #proc settings |
| 2909 | | -# $script .= "#proc settings\n" ; |
| 2910 | | -# $script .= " xml_encoding: utf-8\n" ; |
| 2911 | | -# $script .= "\n" ; |
| | 3373 | + if ($tmpdir ne "") { |
| | 3374 | + $file_script = $tmpdir . $pathseparator . "EasyTimeline.txt.$$"; |
| | 3375 | + } |
| | 3376 | + else { $file_script = "EasyTimeline.txt"; } |
| 2912 | 3377 | |
| 2913 | | - # proc page |
| 2914 | | - $script .= "#proc page\n" ; |
| 2915 | | - $script .= " dopagebox: no\n" ; |
| 2916 | | - $script .= " pagesize: ". @Image {"width"} . " ". @Image {"height"} . "\n" ; |
| 2917 | | - if (defined (@BackgroundColors {"canvas"})) |
| 2918 | | - { $script .= " backgroundcolor: " . @BackgroundColors {"canvas"} . "\n" ; } |
| 2919 | | - $script .= "\n" ; |
| | 3378 | + print "Ploticus input file = " . $file_script . "\n"; |
| 2920 | 3379 | |
| 2921 | | - $barcnt = $#Bars + 1 ; |
| | 3380 | + # $fmt = "gif" ; |
| | 3381 | + open "FILE_OUT", ">", $file_script; |
| 2922 | 3382 | |
| 2923 | | -# if ($AlignBars eq "justify") && ($#Bars > 0) |
| 2924 | | -# |
| 2925 | | -# given P = plotwidth in pixels |
| 2926 | | -# given B = half bar width in pixels |
| 2927 | | -# get U = plotwidth in units |
| 2928 | | -# get x = half bar width in units |
| 2929 | | -# |
| 2930 | | -# first bar plotted at unit 1 |
| 2931 | | -# last bar plotted at unit c |
| 2932 | | -# let C = c - 1 (units between centers of lowest and highest bar) -> x = (U-C) / 2 |
| 2933 | | -# |
| 2934 | | -# Justify: calculate range for axis in units: |
| 2935 | | -# axis starts at 1-x and ends at c+x = |
| 2936 | | -# x/B = U/P -> x = BU/P (1) |
| 2937 | | -# U = c+x - (1-x) = (c-1) + 2x -> x = (U-(c-1))/2 (2) |
| 2938 | | -# |
| 2939 | | -# (1) & (2) -> BU/P = (U-(c-1))/2 |
| 2940 | | -# -> 2BU/P = U-(c-1) |
| 2941 | | -# -> 2BU/P = U - C |
| 2942 | | -# -> 2BU = PU - PC |
| 2943 | | -# -> U (2B-P) = -PC |
| 2944 | | -# -> U = -PC/(2B-P) |
| 2945 | | -# P = @PlotArea {$extent} |
| 2946 | | -# C = c - 1 = $#Bars |
| 2947 | | -# 2B = $MaxBarWidth |
| 2948 | | - if (! defined ($AlignBars)) |
| 2949 | | - { |
| 2950 | | - &Info2 ("AlignBars not defined. Alignment 'early' assumed.") ; |
| 2951 | | - $AlignBars = "early" ; |
| 2952 | | - } |
| | 3383 | + #proc settings |
| | 3384 | + # $script .= "#proc settings\n" ; |
| | 3385 | + # $script .= " xml_encoding: utf-8\n" ; |
| | 3386 | + # $script .= "\n" ; |
| 2953 | 3387 | |
| 2954 | | - if (@Axis {"time"} eq "x") |
| 2955 | | - { $extent = "height" ; } |
| 2956 | | - else |
| 2957 | | - { $extent = "width" ; } |
| | 3388 | + # proc page |
| | 3389 | + $script .= "#proc page\n"; |
| | 3390 | + $script .= " dopagebox: no\n"; |
| | 3391 | + $script .= |
| | 3392 | + " pagesize: " . @Image{"width"} . " " . @Image{"height"} . "\n"; |
| | 3393 | + if (defined(@BackgroundColors{"canvas"})) { |
| | 3394 | + $script .= " backgroundcolor: " . @BackgroundColors{"canvas"} . "\n"; |
| | 3395 | + } |
| | 3396 | + $script .= "\n"; |
| 2958 | 3397 | |
| 2959 | | - if ($MaxBarWidth > @PlotArea {$extent}) |
| 2960 | | - { &Error2 ("Maximum bar width exceeds plotarea " . $extent . ".") ; return ; } |
| | 3398 | + $barcnt = $#Bars + 1; |
| 2961 | 3399 | |
| 2962 | | - if ($MaxBarWidth == @PlotArea {$extent}) |
| 2963 | | - { @PlotArea {$extent} += 0.01 ; } |
| | 3400 | + # if ($AlignBars eq "justify") && ($#Bars > 0) |
| | 3401 | + # |
| | 3402 | + # given P = plotwidth in pixels |
| | 3403 | + # given B = half bar width in pixels |
| | 3404 | + # get U = plotwidth in units |
| | 3405 | + # get x = half bar width in units |
| | 3406 | + # |
| | 3407 | + # first bar plotted at unit 1 |
| | 3408 | + # last bar plotted at unit c |
| | 3409 | + # let C = c - 1 (units between centers of lowest and highest bar) -> x = (U-C) / 2 |
| | 3410 | + # |
| | 3411 | + # Justify: calculate range for axis in units: |
| | 3412 | + # axis starts at 1-x and ends at c+x = |
| | 3413 | + # x/B = U/P -> x = BU/P (1) |
| | 3414 | + # U = c+x - (1-x) = (c-1) + 2x -> x = (U-(c-1))/2 (2) |
| | 3415 | + # |
| | 3416 | + # (1) & (2) -> BU/P = (U-(c-1))/2 |
| | 3417 | + # -> 2BU/P = U-(c-1) |
| | 3418 | + # -> 2BU/P = U - C |
| | 3419 | + # -> 2BU = PU - PC |
| | 3420 | + # -> U (2B-P) = -PC |
| | 3421 | + # -> U = -PC/(2B-P) |
| | 3422 | + # P = @PlotArea {$extent} |
| | 3423 | + # C = c - 1 = $#Bars |
| | 3424 | + # 2B = $MaxBarWidth |
| | 3425 | + if (!defined($AlignBars)) { |
| | 3426 | + &Info2("AlignBars not defined. Alignment 'early' assumed."); |
| | 3427 | + $AlignBars = "early"; |
| | 3428 | + } |
| 2964 | 3429 | |
| 2965 | | - if ($MaxBarWidth == @PlotArea {$extent}) |
| 2966 | | - { |
| 2967 | | - $till = 1 ; |
| 2968 | | - $from = 1 ; |
| 2969 | | - } |
| 2970 | | - else |
| 2971 | | - { |
| 2972 | | - if ($AlignBars eq "justify") |
| 2973 | | - { |
| 2974 | | - if ($#Bars > 0) |
| 2975 | | - { |
| 2976 | | - $U = - (@PlotArea {$extent} * $#Bars) / ($MaxBarWidth - @PlotArea {$extent}) ; |
| 2977 | | - $x = ($U - $#Bars) / 2 ; |
| 2978 | | - $from = 1 - $x ; |
| 2979 | | - $till = 1 + $#Bars + $x ; |
| 2980 | | - } |
| 2981 | | - else # one bar-> "justify" is misnomer here, treat as "center" |
| 2982 | | - { |
| 2983 | | - # $x = ($MaxBarWidth /2) / @PlotArea {$extent} ; |
| 2984 | | - # $from = 0.5 - $x ; |
| 2985 | | - # $till = $from + 1 ; |
| 2986 | | - $from = 0.5 ; |
| 2987 | | - $till = 1.5 ; |
| 2988 | | - } |
| | 3430 | + if (@Axis{"time"} eq "x") { $extent = "height"; } |
| | 3431 | + else { $extent = "width"; } |
| | 3432 | + |
| | 3433 | + if ($MaxBarWidth > @PlotArea{$extent}) { |
| | 3434 | + &Error2("Maximum bar width exceeds plotarea " . $extent . "."); |
| | 3435 | + return; |
| 2989 | 3436 | } |
| 2990 | | - elsif ($AlignBars eq "early") |
| 2991 | | - { |
| 2992 | | - $U = $#Bars + 1 ; |
| 2993 | | - if ($U == 0) |
| 2994 | | - { $U = 1 ; } |
| 2995 | | - $x = (($MaxBarWidth /2) * $U) / @PlotArea {$extent} ; |
| 2996 | | - $from = 1 - $x ; |
| 2997 | | - $till = $from + $U ; |
| 2998 | | - } |
| 2999 | | - elsif ($AlignBars eq "late") |
| 3000 | | - { |
| 3001 | | - $U = $#Bars + 1 ; |
| 3002 | | - $x = (($MaxBarWidth /2) * $U) / @PlotArea {$extent} ; |
| 3003 | | - $till = $U + $x ; |
| 3004 | | - $from = $till - $U ; |
| 3005 | | - } |
| 3006 | | - } |
| 3007 | 3437 | |
| 3008 | | -# if ($#Bars == 0) |
| 3009 | | -# { |
| 3010 | | -# $from = 1 - $MaxBarWidth ; |
| 3011 | | -# $till = 1 + $MaxBarWidth ; |
| 3012 | | -# } |
| 3013 | | - if ($from eq $till) |
| 3014 | | - { $till = $from + 1 ; } |
| | 3438 | + if ($MaxBarWidth == @PlotArea{$extent}) { @PlotArea{$extent} += 0.01; } |
| 3015 | 3439 | |
| 3016 | | - #proc areadef |
| 3017 | | - $script .= "#proc areadef\n" ; |
| 3018 | | - $script .= " rectangle: " . @PlotArea {"left"} . " " . @PlotArea {"bottom"} . " " . |
| 3019 | | - sprintf ("%.2f", @PlotArea {"left"} + @PlotArea {"width"}). " " . sprintf ("%.2f", @PlotArea {"bottom"} + @PlotArea {"height"}) . "\n" ; |
| 3020 | | - if (($DateFormat eq "yyyy") || ($DateFormat eq "x.y")) |
| 3021 | | - { $script .= " " . @Axis {"time"} . "scaletype: linear\n" ; } # date yyyy |
| 3022 | | - else |
| 3023 | | - { $script .= " " . @Axis {"time"} . "scaletype: date $DateFormat\n" ; } |
| | 3440 | + if ($MaxBarWidth == @PlotArea{$extent}) { |
| | 3441 | + $till = 1; |
| | 3442 | + $from = 1; |
| | 3443 | + } |
| | 3444 | + else { |
| | 3445 | + if ($AlignBars eq "justify") { |
| | 3446 | + if ($#Bars > 0) { |
| | 3447 | + $U = |
| | 3448 | + -(@PlotArea{$extent} * $#Bars) / |
| | 3449 | + ($MaxBarWidth - @PlotArea{$extent}); |
| | 3450 | + $x = ($U - $#Bars) / 2; |
| | 3451 | + $from = 1 - $x; |
| | 3452 | + $till = 1 + $#Bars + $x; |
| | 3453 | + } |
| | 3454 | + else # one bar-> "justify" is misnomer here, treat as "center" |
| | 3455 | + { |
| 3024 | 3456 | |
| 3025 | | - if (@Axis {"order"} !~ /reverse/i) |
| 3026 | | - { $script .= " " . @Axis {"time"} . "range: " . @Period{"from"} . " " . @Period{"till"} . "\n" ; } |
| 3027 | | - else |
| 3028 | | - { $script .= " " . @Axis {"time"} . "range: " . (-@Period{"till"}) . " " . (-@Period{"from"}) . "\n" ; } |
| | 3457 | + # $x = ($MaxBarWidth /2) / @PlotArea {$extent} ; |
| | 3458 | + # $from = 0.5 - $x ; |
| | 3459 | + # $till = $from + 1 ; |
| | 3460 | + $from = 0.5; |
| | 3461 | + $till = 1.5; |
| | 3462 | + } |
| | 3463 | + } |
| | 3464 | + elsif ($AlignBars eq "early") { |
| | 3465 | + $U = $#Bars + 1; |
| | 3466 | + if ($U == 0) { $U = 1; } |
| | 3467 | + $x = (($MaxBarWidth / 2) * $U) / @PlotArea{$extent}; |
| | 3468 | + $from = 1 - $x; |
| | 3469 | + $till = $from + $U; |
| | 3470 | + } |
| | 3471 | + elsif ($AlignBars eq "late") { |
| | 3472 | + $U = $#Bars + 1; |
| | 3473 | + $x = (($MaxBarWidth / 2) * $U) / @PlotArea{$extent}; |
| | 3474 | + $till = $U + $x; |
| | 3475 | + $from = $till - $U; |
| | 3476 | + } |
| | 3477 | + } |
| 3029 | 3478 | |
| 3030 | | - $script .= " " . $AxisBars . "scaletype: linear\n" ; |
| 3031 | | - $script .= " " . $AxisBars . "range: " . sprintf ("%.3f", $from-0.001) . " " . sprintf ("%.3f", $till) . "\n" ; |
| 3032 | | - $script .= " #saveas: A\n" ; |
| 3033 | | - $script .= "\n" ; |
| | 3479 | + # if ($#Bars == 0) |
| | 3480 | + # { |
| | 3481 | + # $from = 1 - $MaxBarWidth ; |
| | 3482 | + # $till = 1 + $MaxBarWidth ; |
| | 3483 | + # } |
| | 3484 | + if ($from eq $till) { $till = $from + 1; } |
| 3034 | 3485 | |
| 3035 | | - #proc rect (test) |
| 3036 | | -# $script .= "#proc rect\n" ; |
| 3037 | | -# $script .= " rectangle 1.0 1.0 1.4 1.4\n" ; |
| 3038 | | -# $script .= " color gray(0.95)\n" ; |
| 3039 | | -# $script .= " clickmaplabel: Vladimir Ilyich Lenin\n" ; |
| 3040 | | -# $script .= " clickmapurl: http://www.wikipedia.org/wiki/Vladimir_Lenin\n" ; |
| | 3486 | + #proc areadef |
| | 3487 | + $script .= "#proc areadef\n"; |
| | 3488 | + $script .= |
| | 3489 | + " rectangle: " |
| | 3490 | + . @PlotArea{"left"} . " " |
| | 3491 | + . @PlotArea{"bottom"} . " " |
| | 3492 | + . sprintf("%.2f", @PlotArea{"left"} + @PlotArea{"width"}) . " " |
| | 3493 | + . sprintf("%.2f", @PlotArea{"bottom"} + @PlotArea{"height"}) . "\n"; |
| | 3494 | + if (($DateFormat eq "yyyy") || ($DateFormat eq "x.y")) { |
| | 3495 | + $script .= " " . @Axis{"time"} . "scaletype: linear\n"; |
| | 3496 | + } # date yyyy |
| | 3497 | + else { |
| | 3498 | + $script .= " " . @Axis{"time"} . "scaletype: date $DateFormat\n"; |
| | 3499 | + } |
| 3041 | 3500 | |
| | 3501 | + if (@Axis{"order"} !~ /reverse/i) { |
| | 3502 | + $script .= " " |
| | 3503 | + . @Axis{"time"} |
| | 3504 | + . "range: " |
| | 3505 | + . @Period{"from"} . " " |
| | 3506 | + . @Period{"till"} . "\n"; |
| | 3507 | + } |
| | 3508 | + else { |
| | 3509 | + $script .= " " |
| | 3510 | + . @Axis{"time"} |
| | 3511 | + . "range: " |
| | 3512 | + . (-@Period{"till"}) . " " |
| | 3513 | + . (-@Period{"from"}) . "\n"; |
| | 3514 | + } |
| 3042 | 3515 | |
| 3043 | | - #proc legendentry |
| 3044 | | - foreach $color (sort keys %Colors) |
| 3045 | | - { |
| 3046 | | - $script .= "#proc legendentry\n" ; |
| 3047 | | - $script .= " sampletype: color\n" ; |
| | 3516 | + $script .= " " . $AxisBars . "scaletype: linear\n"; |
| | 3517 | + $script .= " " |
| | 3518 | + . $AxisBars |
| | 3519 | + . "range: " |
| | 3520 | + . sprintf("%.3f", $from - 0.001) . " " |
| | 3521 | + . sprintf("%.3f", $till) . "\n"; |
| | 3522 | + $script .= " #saveas: A\n"; |
| | 3523 | + $script .= "\n"; |
| 3048 | 3524 | |
| 3049 | | - if ((defined (@ColorLabels {$color})) && (@ColorLabels {$color} ne "")) |
| 3050 | | - { $script .= " label: " . @ColorLabels {$color} . "\n" ; } |
| 3051 | | - $script .= " details: " . @Colors {$color} . "\n" ; |
| 3052 | | - $script .= " tag: $color\n" ; |
| 3053 | | - $script .= "\n" ; |
| 3054 | | - } |
| | 3525 | + #proc rect (test) |
| | 3526 | + # $script .= "#proc rect\n" ; |
| | 3527 | + # $script .= " rectangle 1.0 1.0 1.4 1.4\n" ; |
| | 3528 | + # $script .= " color gray(0.95)\n" ; |
| | 3529 | + # $script .= " clickmaplabel: Vladimir Ilyich Lenin\n" ; |
| | 3530 | + # $script .= " clickmapurl: http://www.wikipedia.org/wiki/Vladimir_Lenin\n" ; |
| 3055 | 3531 | |
| 3056 | | - if (defined (@BackgroundColors {"bars"})) |
| 3057 | | - { |
| 3058 | | - #proc getdata / #proc bars |
| 3059 | | - $script .= "#proc getdata\n" ; |
| 3060 | | - $script .= " delim: comma\n" ; |
| 3061 | | - $script .= " data:\n" ; |
| | 3532 | + #proc legendentry |
| | 3533 | + foreach $color (sort keys %Colors) { |
| | 3534 | + $script .= "#proc legendentry\n"; |
| | 3535 | + $script .= " sampletype: color\n"; |
| 3062 | 3536 | |
| 3063 | | - $maxwidth = 0 ; |
| 3064 | | - foreach $entry (@PlotBars) |
| 3065 | | - { |
| 3066 | | - ($width) = split (",", $entry) ; |
| 3067 | | - if ($width > $maxwidth) |
| 3068 | | - { $maxwidth = $width ; } |
| | 3537 | + if ((defined(@ColorLabels{$color})) && (@ColorLabels{$color} ne "")) { |
| | 3538 | + $script .= " label: " . @ColorLabels{$color} . "\n"; |
| | 3539 | + } |
| | 3540 | + $script .= " details: " . @Colors{$color} . "\n"; |
| | 3541 | + $script .= " tag: $color\n"; |
| | 3542 | + $script .= "\n"; |
| 3069 | 3543 | } |
| 3070 | 3544 | |
| 3071 | | - for ($b = 0 ; $b <= $#Bars ; $b++) |
| 3072 | | - { $script .= ($b+1) . "," . @Period {"from"} . "," . @Period {"till"} . ",". |
| 3073 | | - @BackgroundColors {"bars"} . "\n" ; } |
| 3074 | | - $script .= "\n" ; |
| | 3545 | + if (defined(@BackgroundColors{"bars"})) { |
| 3075 | 3546 | |
| 3076 | | - #proc bars |
| 3077 | | - $script .= "#proc bars\n" ; |
| 3078 | | - $script .= " axis: " . @Axis {"time"} . "\n" ; |
| 3079 | | - $script .= " barwidth: $maxwidth\n" ; |
| 3080 | | - $script .= " outline: no\n" ; |
| 3081 | | - if (@Axis {"time"} eq "x") |
| 3082 | | - { $script .= " horizontalbars: yes\n" ; } |
| 3083 | | - $script .= " locfield: 1\n" ; |
| 3084 | | - $script .= " segmentfields: 2 3\n" ; |
| 3085 | | - $script .= " colorfield: 4\n" ; |
| | 3547 | + #proc getdata / #proc bars |
| | 3548 | + $script .= "#proc getdata\n"; |
| | 3549 | + $script .= " delim: comma\n"; |
| | 3550 | + $script .= " data:\n"; |
| 3086 | 3551 | |
| 3087 | | -# $script .= " clickmaplabel: Vladimir Ilyich Lenin\n" ; |
| 3088 | | -# $script .= " clickmapurl: http://www.wikipedia.org/wiki/Vladimir_Lenin\n" ; |
| | 3552 | + $maxwidth = 0; |
| | 3553 | + foreach $entry (@PlotBars) { |
| | 3554 | + ($width) = split(",", $entry); |
| | 3555 | + if ($width > $maxwidth) { $maxwidth = $width; } |
| | 3556 | + } |
| 3089 | 3557 | |
| 3090 | | - $script .= "\n" ; |
| 3091 | | - } |
| | 3558 | + for ($b = 0; $b <= $#Bars; $b++) { |
| | 3559 | + $script .= |
| | 3560 | + ($b + 1) . "," |
| | 3561 | + . @Period{"from"} . "," |
| | 3562 | + . @Period{"till"} . "," |
| | 3563 | + . @BackgroundColors{"bars"} . "\n"; |
| | 3564 | + } |
| | 3565 | + $script .= "\n"; |
| 3092 | 3566 | |
| 3093 | | - #proc axis |
| 3094 | | - if (defined (@Scales {"Minor grid"})) |
| 3095 | | - { &PlotScale ("Minor", $true) ; } |
| 3096 | | - if (defined (@Scales {"Major grid"})) |
| 3097 | | - { &PlotScale ("Major", $true) ; } |
| | 3567 | + #proc bars |
| | 3568 | + $script .= "#proc bars\n"; |
| | 3569 | + $script .= " axis: " . @Axis{"time"} . "\n"; |
| | 3570 | + $script .= " barwidth: $maxwidth\n"; |
| | 3571 | + $script .= " outline: no\n"; |
| | 3572 | + if (@Axis{"time"} eq "x") { $script .= " horizontalbars: yes\n"; } |
| | 3573 | + $script .= " locfield: 1\n"; |
| | 3574 | + $script .= " segmentfields: 2 3\n"; |
| | 3575 | + $script .= " colorfield: 4\n"; |
| 3098 | 3576 | |
| 3099 | | - &PlotLines ("back") ; |
| | 3577 | + # $script .= " clickmaplabel: Vladimir Ilyich Lenin\n" ; |
| | 3578 | + # $script .= " clickmapurl: http://www.wikipedia.org/wiki/Vladimir_Lenin\n" ; |
| 3100 | 3579 | |
| 3101 | | - @PlotBarsNow = @PlotBars ; |
| 3102 | | - &PlotBars ; |
| | 3580 | + $script .= "\n"; |
| | 3581 | + } |
| 3103 | 3582 | |
| 3104 | | - $script .= "\n([inc3])\n\n" ; # will be replace by rects |
| | 3583 | + #proc axis |
| | 3584 | + if (defined(@Scales{"Minor grid"})) { &PlotScale("Minor", $true); } |
| | 3585 | + if (defined(@Scales{"Major grid"})) { &PlotScale("Major", $true); } |
| 3105 | 3586 | |
| 3106 | | -%x = %BarWidths ; |
| 3107 | | - foreach $entry (@PlotLines) |
| 3108 | | - { |
| 3109 | | - ($bar) = split (",", $entry) ; |
| 3110 | | - $bar =~ s/\#.*// ; |
| 3111 | | - $width = @BarWidths {$bar} ; |
| 3112 | | - $entry = sprintf ("%6.3f",$width) . "," . $entry ; |
| 3113 | | - } |
| | 3587 | + &PlotLines("back"); |
| 3114 | 3588 | |
| 3115 | | - @PlotBarsNow = @PlotLines ; |
| 3116 | | - &PlotBars ; |
| | 3589 | + @PlotBarsNow = @PlotBars; |
| | 3590 | + &PlotBars; |
| 3117 | 3591 | |
| 3118 | | - #proc axis |
| 3119 | | - if ($#Bars > 0) |
| 3120 | | - { |
| 3121 | | - $scriptPng2 = "#proc " . $AxisBars . "axis\n" ; |
| 3122 | | - $scriptSvg2 = "#proc " . $AxisBars . "axis\n" ; |
| 3123 | | - if ($AxisBars eq "x") |
| 3124 | | - { |
| 3125 | | - $scriptPng2 .= " stubdetails: adjust=0,0.09\n" ; |
| 3126 | | - $scriptSvg2 .= " stubdetails: adjust=0,0.09\n" ; |
| | 3592 | + $script .= "\n([inc3])\n\n"; # will be replace by rects |
| | 3593 | + |
| | 3594 | + %x = %BarWidths; |
| | 3595 | + foreach $entry (@PlotLines) { |
| | 3596 | + ($bar) = split(",", $entry); |
| | 3597 | + $bar =~ s/\#.*//; |
| | 3598 | + $width = @BarWidths{$bar}; |
| | 3599 | + $entry = sprintf("%6.3f", $width) . "," . $entry; |
| 3127 | 3600 | } |
| 3128 | | - else |
| 3129 | | - { |
| 3130 | | - $scriptPng2 .= " stubdetails: adjust=0.09,0\n" ; |
| 3131 | | - $scriptSvg2 .= " stubdetails: adjust=0.09,0\n" ; |
| 3132 | | - } |
| 3133 | | - $scriptPng2 .= " tics: none\n" ; |
| 3134 | | - $scriptSvg2 .= " tics: none\n" ; |
| 3135 | | - $scriptPng2 .= " stubrange: 1\n" ; |
| 3136 | | - $scriptSvg2 .= " stubrange: 1\n" ; |
| 3137 | | - if ($AxisBars eq "y") |
| 3138 | | - { |
| 3139 | | - $scriptPng2 .= " stubslide: -" . sprintf ("%.2f", $MaxBarWidth / 2) . "\n" ; |
| 3140 | | - $scriptSvg2 .= " stubslide: -" . sprintf ("%.2f", $MaxBarWidth / 2) . "\n" ; |
| 3141 | | - } |
| 3142 | | - $scriptPng2 .= " stubs: text\n" ; |
| 3143 | | - $scriptSvg2 .= " stubs: text\n" ; |
| 3144 | 3601 | |
| 3145 | | - my ($text, $link, $hint) ; |
| | 3602 | + @PlotBarsNow = @PlotLines; |
| | 3603 | + &PlotBars; |
| 3146 | 3604 | |
| 3147 | | - undef (@Bars2) ; |
| 3148 | | - foreach $bar (@Bars) |
| 3149 | | - { |
| 3150 | | - if ($AxisBars eq "y") |
| 3151 | | - { push @Bars2, $bar ; } |
| 3152 | | - else |
| 3153 | | - { unshift @Bars2, $bar ; } |
| 3154 | | - } |
| | 3605 | + #proc axis |
| | 3606 | + if ($#Bars > 0) { |
| | 3607 | + $scriptPng2 = "#proc " . $AxisBars . "axis\n"; |
| | 3608 | + $scriptSvg2 = "#proc " . $AxisBars . "axis\n"; |
| | 3609 | + if ($AxisBars eq "x") { |
| | 3610 | + $scriptPng2 .= " stubdetails: adjust=0,0.09\n"; |
| | 3611 | + $scriptSvg2 .= " stubdetails: adjust=0,0.09\n"; |
| | 3612 | + } |
| | 3613 | + else { |
| | 3614 | + $scriptPng2 .= " stubdetails: adjust=0.09,0\n"; |
| | 3615 | + $scriptSvg2 .= " stubdetails: adjust=0.09,0\n"; |
| | 3616 | + } |
| | 3617 | + $scriptPng2 .= " tics: none\n"; |
| | 3618 | + $scriptSvg2 .= " tics: none\n"; |
| | 3619 | + $scriptPng2 .= " stubrange: 1\n"; |
| | 3620 | + $scriptSvg2 .= " stubrange: 1\n"; |
| | 3621 | + if ($AxisBars eq "y") { |
| | 3622 | + $scriptPng2 .= |
| | 3623 | + " stubslide: -" . sprintf("%.2f", $MaxBarWidth / 2) . "\n"; |
| | 3624 | + $scriptSvg2 .= |
| | 3625 | + " stubslide: -" . sprintf("%.2f", $MaxBarWidth / 2) . "\n"; |
| | 3626 | + } |
| | 3627 | + $scriptPng2 .= " stubs: text\n"; |
| | 3628 | + $scriptSvg2 .= " stubs: text\n"; |
| 3155 | 3629 | |
| 3156 | | - foreach $bar (@Bars2) |
| 3157 | | - { |
| 3158 | | - $hint = "" ; |
| 3159 | | - $text = @BarLegend {lc ($bar)} ; |
| 3160 | | - if ($text =~ /^\s*$/) |
| 3161 | | - { $text = "\\" ; } |
| | 3630 | + my ($text, $link, $hint); |
| 3162 | 3631 | |
| 3163 | | - $link = @BarLink {lc ($bar)} ; |
| 3164 | | - if (! defined ($link)) |
| 3165 | | - { |
| 3166 | | - if ($text =~ /\[.*\]/) |
| 3167 | | - { ($text, $link, $hint) = &ProcessWikiLink ($text, $link, $hint) ; } |
| 3168 | | - } |
| | 3632 | + undef(@Bars2); |
| | 3633 | + foreach $bar (@Bars) { |
| | 3634 | + if ($AxisBars eq "y") { push @Bars2, $bar; } |
| | 3635 | + else { unshift @Bars2, $bar; } |
| | 3636 | + } |
| 3169 | 3637 | |
| 3170 | | - $text =~ s/\[+([^\]]*)\]+/$1/ ; |
| 3171 | | - $scriptPng2 .= "$text\n" ; |
| 3172 | | - if (defined ($link)) |
| 3173 | | - { |
| 3174 | | - push @linksSVG, $link ; |
| 3175 | | - my $lcnt = $#linksSVG ; |
| 3176 | | - $scriptSvg2 .= "[" . $lcnt . "[" . $text . "]" . $lcnt . "]\n" ; |
| 3177 | | - } |
| 3178 | | - else |
| 3179 | | - { $scriptSvg2 .= "$text\n" ; } |
| 3180 | | - } |
| 3181 | | - $scriptPng2 .= "\n" ; |
| 3182 | | - $scriptSvg2 .= "\n" ; |
| | 3638 | + foreach $bar (@Bars2) { |
| | 3639 | + $hint = ""; |
| | 3640 | + $text = @BarLegend{ lc($bar) }; |
| | 3641 | + if ($text =~ /^\s*$/) { $text = "\\"; } |
| 3183 | 3642 | |
| 3184 | | - $scriptPng2 .= "#proc " . $AxisBars . "axis\n" ; |
| 3185 | | - if ($AxisBars eq "x") |
| 3186 | | - { $scriptPng2 .= " stubdetails: adjust=0,0.09 color=$LinkColor\n" ; } |
| 3187 | | - else |
| 3188 | | - { $scriptPng2 .= " stubdetails: adjust=0.09,0 color=$LinkColor\n" ; } |
| 3189 | | - $scriptPng2 .= " tics: none\n" ; |
| 3190 | | - $scriptPng2 .= " stubrange: 1\n" ; |
| 3191 | | - if ($AxisBars eq "y") |
| 3192 | | - { $scriptPng2 .= " stubslide: -" . sprintf ("%.2f", $MaxBarWidth / 2) . "\n" ; } |
| 3193 | | - $scriptPng2 .= " stubs: text\n" ; |
| | 3643 | + $link = @BarLink{ lc($bar) }; |
| | 3644 | + if (!defined($link)) { |
| | 3645 | + if ($text =~ /\[.*\]/) { |
| | 3646 | + ($text, $link, $hint) = |
| | 3647 | + &ProcessWikiLink($text, $link, $hint); |
| | 3648 | + } |
| | 3649 | + } |
| 3194 | 3650 | |
| 3195 | | - $barcnt = $#Bars + 1 ; |
| 3196 | | - foreach $bar (@Bars2) |
| 3197 | | - { |
| 3198 | | - $hint = "" ; |
| 3199 | | - $text = @BarLegend {lc ($bar)} ; |
| 3200 | | - if ($text =~ /^\s*$/) |
| 3201 | | - { $text = "\\" ; } |
| | 3651 | + $text =~ s/\[+([^\]]*)\]+/$1/; |
| | 3652 | + $scriptPng2 .= "$text\n"; |
| | 3653 | + if (defined($link)) { |
| | 3654 | + push @linksSVG, $link; |
| | 3655 | + my $lcnt = $#linksSVG; |
| | 3656 | + $scriptSvg2 .= |
| | 3657 | + "[" . $lcnt . "[" . $text . "]" . $lcnt . "]\n"; |
| | 3658 | + } |
| | 3659 | + else { $scriptSvg2 .= "$text\n"; } |
| | 3660 | + } |
| | 3661 | + $scriptPng2 .= "\n"; |
| | 3662 | + $scriptSvg2 .= "\n"; |
| 3202 | 3663 | |
| 3203 | | - $link = @BarLink {lc ($bar)} ; |
| 3204 | | - if (! defined ($link)) |
| 3205 | | - { |
| 3206 | | - if ($text =~ /\[.*\]/) |
| 3207 | | - { ($text, $link, $hint) = &ProcessWikiLink ($text, $link, $hint) ; } |
| 3208 | | - } |
| 3209 | | - if ((! defined ($link)) || ($link eq "")) |
| 3210 | | - { $text = "\\" ; } |
| 3211 | | - else |
| 3212 | | - { |
| 3213 | | - $scriptPng3 .= "#proc rect\n" ; |
| 3214 | | - $scriptPng3 .= " rectangle: 0 $barcnt(s)+0.05 " . @PlotArea {"left"} . " $barcnt(s)-0.05\n" ; |
| 3215 | | - $scriptPng3 .= " color: " . @BackgroundColors {"canvas"} . "\n" ; |
| 3216 | | - $scriptPng3 .= " clickmapurl: " . $link . "\n" ; |
| 3217 | | - if ((defined ($hint)) && ($hint ne "")) |
| 3218 | | - { $scriptPng3 .= " clickmaplabel: " . $hint . "\n" ; } |
| | 3664 | + $scriptPng2 .= "#proc " . $AxisBars . "axis\n"; |
| | 3665 | + if ($AxisBars eq "x") { |
| | 3666 | + $scriptPng2 .= " stubdetails: adjust=0,0.09 color=$LinkColor\n"; |
| | 3667 | + } |
| | 3668 | + else { |
| | 3669 | + $scriptPng2 .= " stubdetails: adjust=0.09,0 color=$LinkColor\n"; |
| | 3670 | + } |
| | 3671 | + $scriptPng2 .= " tics: none\n"; |
| | 3672 | + $scriptPng2 .= " stubrange: 1\n"; |
| | 3673 | + if ($AxisBars eq "y") { |
| | 3674 | + $scriptPng2 .= |
| | 3675 | + " stubslide: -" . sprintf("%.2f", $MaxBarWidth / 2) . "\n"; |
| | 3676 | + } |
| | 3677 | + $scriptPng2 .= " stubs: text\n"; |
| 3219 | 3678 | |
| 3220 | | - $text =~ s/\[+([^\]]*)\]+/$1/ ; |
| 3221 | | - } |
| 3222 | | - $scriptPng2 .= "$text\n" ; |
| | 3679 | + $barcnt = $#Bars + 1; |
| | 3680 | + foreach $bar (@Bars2) { |
| | 3681 | + $hint = ""; |
| | 3682 | + $text = @BarLegend{ lc($bar) }; |
| | 3683 | + if ($text =~ /^\s*$/) { $text = "\\"; } |
| 3223 | 3684 | |
| 3224 | | - $barcnt-- ; |
| | 3685 | + $link = @BarLink{ lc($bar) }; |
| | 3686 | + if (!defined($link)) { |
| | 3687 | + if ($text =~ /\[.*\]/) { |
| | 3688 | + ($text, $link, $hint) = |
| | 3689 | + &ProcessWikiLink($text, $link, $hint); |
| | 3690 | + } |
| | 3691 | + } |
| | 3692 | + if ((!defined($link)) || ($link eq "")) { $text = "\\"; } |
| | 3693 | + else { |
| | 3694 | + $scriptPng3 .= "#proc rect\n"; |
| | 3695 | + $scriptPng3 .= |
| | 3696 | + " rectangle: 0 $barcnt(s)+0.05 " |
| | 3697 | + . @PlotArea{"left"} |
| | 3698 | + . " $barcnt(s)-0.05\n"; |
| | 3699 | + $scriptPng3 .= |
| | 3700 | + " color: " . @BackgroundColors{"canvas"} . "\n"; |
| | 3701 | + $scriptPng3 .= " clickmapurl: " . $link . "\n"; |
| | 3702 | + if ((defined($hint)) && ($hint ne "")) { |
| | 3703 | + $scriptPng3 .= " clickmaplabel: " . $hint . "\n"; |
| | 3704 | + } |
| | 3705 | + |
| | 3706 | + $text =~ s/\[+([^\]]*)\]+/$1/; |
| | 3707 | + } |
| | 3708 | + $scriptPng2 .= "$text\n"; |
| | 3709 | + |
| | 3710 | + $barcnt--; |
| | 3711 | + } |
| | 3712 | + $scriptPng2 .= "\n"; |
| 3225 | 3713 | } |
| 3226 | | - $scriptPng2 .= "\n" ; |
| 3227 | | - } |
| 3228 | 3714 | |
| 3229 | | - &PlotLines ("front") ; |
| | 3715 | + &PlotLines("front"); |
| 3230 | 3716 | |
| 3231 | | - $script .= "\n([inc1])\n\n" ; # will be replaced by annotations |
| 3232 | | - $script .= "\n([inc2])\n\n" ; |
| | 3717 | + $script .= "\n([inc1])\n\n"; # will be replaced by annotations |
| | 3718 | + $script .= "\n([inc2])\n\n"; |
| 3233 | 3719 | |
| | 3720 | + if ($#PlotTextsPng >= 0) { |
| | 3721 | + foreach $command (@PlotTextsPng) { |
| | 3722 | + if ($command =~ /^\s*location/) { |
| | 3723 | + $command =~ s/(.*)\[(.*)\](.*)/$1 . ($#Bars - $2 + 2) . $3/xe; |
| | 3724 | + } |
| 3234 | 3725 | |
| 3235 | | - if ($#PlotTextsPng >= 0) |
| 3236 | | - { |
| 3237 | | - foreach $command (@PlotTextsPng) |
| 3238 | | - { |
| 3239 | | - if ($command =~ /^\s*location/) |
| 3240 | | - { $command =~ s/(.*)\[(.*)\](.*)/$1 . ($#Bars - $2 + 2) . $3/xe ; } |
| 3241 | | - |
| 3242 | | - $scriptPng1 .= $command ; |
| | 3726 | + $scriptPng1 .= $command; |
| | 3727 | + } |
| | 3728 | + $scriptPng1 .= "\n"; |
| 3243 | 3729 | } |
| 3244 | | - $scriptPng1 .= "\n" ; |
| 3245 | | - } |
| 3246 | 3730 | |
| 3247 | | - if ($#PlotTextsSvg >= 0) |
| 3248 | | - { |
| 3249 | | - foreach $command (@PlotTextsSvg) |
| 3250 | | - { |
| 3251 | | - if ($command =~ /^\s*location/) |
| 3252 | | - { $command =~ s/(.*)\[(.*)\](.*)/$1 . ($#Bars - $2 + 2) . $3/xe ; } |
| | 3731 | + if ($#PlotTextsSvg >= 0) { |
| | 3732 | + foreach $command (@PlotTextsSvg) { |
| | 3733 | + if ($command =~ /^\s*location/) { |
| | 3734 | + $command =~ s/(.*)\[(.*)\](.*)/$1 . ($#Bars - $2 + 2) . $3/xe; |
| | 3735 | + } |
| 3253 | 3736 | |
| 3254 | | - $scriptSvg1 .= $command ; |
| | 3737 | + $scriptSvg1 .= $command; |
| | 3738 | + } |
| | 3739 | + $scriptSvg1 .= "\n"; |
| 3255 | 3740 | } |
| 3256 | | - $scriptSvg1 .= "\n" ; |
| 3257 | | - } |
| 3258 | 3741 | |
| 3259 | | -# $script .= "#proc symbol\n" ; |
| 3260 | | -# $script .= " location: 01/01/1943(s) Korea \n" ; |
| 3261 | | -# $script .= " symbol: style=fill shape=downtriangle fillcolor=white radius=0.04\n" ; |
| 3262 | | -# $script .= "\n" ; |
| | 3742 | + # $script .= "#proc symbol\n" ; |
| | 3743 | + # $script .= " location: 01/01/1943(s) Korea \n" ; |
| | 3744 | + # $script .= " symbol: style=fill shape=downtriangle fillcolor=white radius=0.04\n" ; |
| | 3745 | + # $script .= "\n" ; |
| 3263 | 3746 | |
| 3264 | | - #proc axis |
| 3265 | | - # repeat without grid to get axis on top of bar |
| 3266 | | - # needed because axis may overlap bar slightly |
| 3267 | | - if (defined (@Scales {"Minor"})) |
| 3268 | | - { &PlotScale ("Minor", $false) ; } |
| 3269 | | - if (defined (@Scales {"Major"})) |
| 3270 | | - { &PlotScale ("Major", $false) ; } |
| | 3747 | + #proc axis |
| | 3748 | + # repeat without grid to get axis on top of bar |
| | 3749 | + # needed because axis may overlap bar slightly |
| | 3750 | + if (defined(@Scales{"Minor"})) { &PlotScale("Minor", $false); } |
| | 3751 | + if (defined(@Scales{"Major"})) { &PlotScale("Major", $false); } |
| 3271 | 3752 | |
| 3272 | | - #proc drawcommands |
| 3273 | | - if ($#TextData >= 0) |
| 3274 | | - { |
| 3275 | | - $script .= "#proc drawcommands\n" ; |
| 3276 | | - $script .= " commands:\n" ; |
| 3277 | | - foreach $entry (@TextData) |
| 3278 | | - { $script .= $entry ; } |
| 3279 | | - $script .= "\n" ; |
| 3280 | | - } |
| | 3753 | + #proc drawcommands |
| | 3754 | + if ($#TextData >= 0) { |
| | 3755 | + $script .= "#proc drawcommands\n"; |
| | 3756 | + $script .= " commands:\n"; |
| | 3757 | + foreach $entry (@TextData) { $script .= $entry; } |
| | 3758 | + $script .= "\n"; |
| | 3759 | + } |
| 3281 | 3760 | |
| 3282 | | - #proc legend |
| 3283 | | - if (defined (@Legend {"orientation"})) |
| 3284 | | - { |
| 3285 | | - if (($#LegendData < 0) && ($Preset eq "")) |
| 3286 | | - { &Error2 ("Command 'Legend' found, but no entries for the legend were specified.\n" . |
| 3287 | | - " Please remove or disable command (disable = put \# before the command)\n" . |
| 3288 | | - " or specify entries for the legend with command 'Colors', attribute 'legend'\n") ; |
| 3289 | | - return ; } |
| | 3761 | + #proc legend |
| | 3762 | + if (defined(@Legend{"orientation"})) { |
| | 3763 | + if (($#LegendData < 0) && ($Preset eq "")) { |
| | 3764 | + &Error2( |
| | 3765 | + "Command 'Legend' found, but no entries for the legend were specified.\n" |
| | 3766 | + . " Please remove or disable command (disable = put \# before the command)\n" |
| | 3767 | + . " or specify entries for the legend with command 'Colors', attribute 'legend'\n" |
| | 3768 | + ); |
| | 3769 | + return; |
| | 3770 | + } |
| 3290 | 3771 | |
| 3291 | | - $perColumn = 999 ; |
| 3292 | | - if (@Legend {"orientation"} =~ /ver/i) |
| 3293 | | - { |
| 3294 | | - if (@Legend {"columns"} > 1) |
| 3295 | | - { |
| 3296 | | - $perColumn = 0 ; |
| 3297 | | - while ((@Legend {"columns"} * $perColumn) < $#LegendData + 1) |
| 3298 | | - { $perColumn ++ ; } |
| 3299 | | - } |
| | 3772 | + $perColumn = 999; |
| | 3773 | + if (@Legend{"orientation"} =~ /ver/i) { |
| | 3774 | + if (@Legend{"columns"} > 1) { |
| | 3775 | + $perColumn = 0; |
| | 3776 | + while ((@Legend{"columns"} * $perColumn) < $#LegendData + 1) { |
| | 3777 | + $perColumn++; |
| | 3778 | + } |
| | 3779 | + } |
| | 3780 | + } |
| | 3781 | + |
| | 3782 | + for ($l = 1; $l <= @Legend{"columns"}; $l++) { |
| | 3783 | + $script .= "#proc legend\n"; |
| | 3784 | + $script .= " noclear: yes\n"; |
| | 3785 | + if (@Legend{"orientation"} =~ /ver/i) { |
| | 3786 | + $script .= " format: multiline\n"; |
| | 3787 | + } |
| | 3788 | + else { $script .= " format: singleline\n"; } |
| | 3789 | + $script .= " seglen: 0.2\n"; |
| | 3790 | + $script .= " swatchsize: 0.12\n"; |
| | 3791 | + $script .= " textdetails: size=S\n"; |
| | 3792 | + $script .= |
| | 3793 | + " location: " |
| | 3794 | + . (@Legend{"left"} + 0.2) . " " |
| | 3795 | + . @Legend{"top"} . "\n"; |
| | 3796 | + $script .= " specifyorder:\n"; |
| | 3797 | + for ($l2 = 1; $l2 <= $perColumn; $l2++) { |
| | 3798 | + $category = shift(@LegendData); |
| | 3799 | + if (defined($category)) { $script .= "$category\n"; } |
| | 3800 | + } |
| | 3801 | + $script .= "\n"; |
| | 3802 | + @Legend{"left"} += @Legend{"columnwidth"}; |
| | 3803 | + } |
| 3300 | 3804 | } |
| 3301 | 3805 | |
| 3302 | | - for ($l = 1 ; $l <= @Legend {"columns"} ; $l++) |
| 3303 | | - { |
| 3304 | | - $script .= "#proc legend\n" ; |
| 3305 | | - $script .= " noclear: yes\n" ; |
| 3306 | | - if (@Legend {"orientation"} =~ /ver/i) |
| 3307 | | - { $script .= " format: multiline\n" ; } |
| 3308 | | - else |
| 3309 | | - { $script .= " format: singleline\n" ; } |
| 3310 | | - $script .= " seglen: 0.2\n" ; |
| 3311 | | - $script .= " swatchsize: 0.12\n" ; |
| 3312 | | - $script .= " textdetails: size=S\n" ; |
| 3313 | | - $script .= " location: " . (@Legend{"left"}+0.2) . " " . @Legend{"top"} . "\n" ; |
| 3314 | | - $script .= " specifyorder:\n" ; |
| 3315 | | - for ($l2 = 1 ; $l2 <= $perColumn ; $l2++) |
| 3316 | | - { |
| 3317 | | - $category = shift (@LegendData) ; |
| 3318 | | - if (defined ($category)) |
| 3319 | | - { $script .= "$category\n" ; } |
| 3320 | | - } |
| 3321 | | - $script .= "\n" ; |
| 3322 | | - @Legend {"left"} += @Legend {"columnwidth"} ; |
| | 3806 | + $script .= "#endproc\n"; |
| | 3807 | + |
| | 3808 | + print "\nGenerating output:\n"; |
| | 3809 | + if ($plcommand ne "") { $pl = $plcommand; } |
| | 3810 | + else { |
| | 3811 | + $pl = "pl.exe"; |
| | 3812 | + if ($env eq "Linux") { $pl = "pl"; } |
| 3323 | 3813 | } |
| 3324 | | - } |
| 3325 | 3814 | |
| 3326 | | - $script .= "#endproc\n" ; |
| | 3815 | + print "Using ploticus command \"" . $pl . "\" (" . $plcommand . ")\n"; |
| 3327 | 3816 | |
| 3328 | | - print "\nGenerating output:\n" ; |
| 3329 | | - if ( $plcommand ne "" ) |
| 3330 | | - { $pl = $plcommand; } |
| 3331 | | - else |
| 3332 | | - { |
| 3333 | | - $pl = "pl.exe" ; |
| 3334 | | - if ($env eq "Linux") |
| 3335 | | - { $pl = "pl" ; } |
| 3336 | | - } |
| | 3817 | + $script_save = $script; |
| 3337 | 3818 | |
| 3338 | | - print "Using ploticus command \"".$pl."\" (".$plcommand.")\n"; |
| | 3819 | + $script =~ s/\(\[inc1\]\)/$scriptSvg1/; |
| | 3820 | + $script =~ s/\(\[inc2\]\)/$scriptSvg2/; |
| | 3821 | + $script =~ s/\(\[inc3\]\)//; |
| 3339 | 3822 | |
| 3340 | | - $script_save = $script ; |
| | 3823 | + $script =~ s/textsize XS/textsize 7/gi; |
| | 3824 | + $script =~ s/textsize S/textsize 8.9/gi; |
| 3341 | 3825 | |
| 3342 | | - $script =~ s/\(\[inc1\]\)/$scriptSvg1/ ; |
| 3343 | | - $script =~ s/\(\[inc2\]\)/$scriptSvg2/ ; |
| 3344 | | - $script =~ s/\(\[inc3\]\)// ; |
| | 3826 | + $script =~ s/textsize M/textsize 10.5/gi; |
| | 3827 | + $script =~ s/textsize L/textsize 13/gi; |
| | 3828 | + $script =~ s/textsize XL/textsize 17/gi; |
| | 3829 | + $script =~ s/size=XS/size=7/gi; |
| | 3830 | + $script =~ s/size=S/size=8.9/gi; |
| | 3831 | + $script =~ s/size=M/size=10.5/gi; |
| | 3832 | + $script =~ s/size=L/size=13/gi; |
| | 3833 | + $script =~ s/size=XL/size=17/gi; |
| 3345 | 3834 | |
| 3346 | | - $script =~ s/textsize XS/textsize 7/gi ; |
| 3347 | | - $script =~ s/textsize S/textsize 8.9/gi ; |
| | 3835 | + $script =~ s/(\n location:.*)/&ShiftOnePixelForSVG($1)/ge; |
| 3348 | 3836 | |
| 3349 | | - $script =~ s/textsize M/textsize 10.5/gi ; |
| 3350 | | - $script =~ s/textsize L/textsize 13/gi ; |
| 3351 | | - $script =~ s/textsize XL/textsize 17/gi ; |
| 3352 | | - $script =~ s/size=XS/size=7/gi ; |
| 3353 | | - $script =~ s/size=S/size=8.9/gi ; |
| 3354 | | - $script =~ s/size=M/size=10.5/gi ; |
| 3355 | | - $script =~ s/size=L/size=13/gi ; |
| 3356 | | - $script =~ s/size=XL/size=17/gi ; |
| | 3837 | + open "FILE_OUT", ">", $file_script; |
| | 3838 | + print FILE_OUT &DecodeInput($script); |
| | 3839 | + close "FILE_OUT"; |
| 3357 | 3840 | |
| | 3841 | + $map = ($MapSVG) ? "-map" : ""; |
| 3358 | 3842 | |
| 3359 | | - $script =~ s/(\n location:.*)/&ShiftOnePixelForSVG($1)/ge ; |
| | 3843 | + print "Running Ploticus to generate svg file\n"; |
| 3360 | 3844 | |
| 3361 | | - open "FILE_OUT", ">", $file_script ; |
| 3362 | | - print FILE_OUT &DecodeInput($script) ; |
| 3363 | | - close "FILE_OUT" ; |
| | 3845 | + # my $cmd = "$pl $map -" . "svg" . " -o $file_vector $file_script -tightcrop -font \"Times\"" ; |
| | 3846 | + # my $cmd = "$pl $map -" . "svg" . " -o $file_vector $file_script -tightcrop" ; |
| | 3847 | + my $cmd = |
| | 3848 | + EscapeShellArg($pl) |
| | 3849 | + . " $map -" . "svg" . " -o " |
| | 3850 | + . EscapeShellArg($file_vector) . " " |
| | 3851 | + . EscapeShellArg($file_script) |
| | 3852 | + . " -tightcrop -xml_encoding UTF-8"; |
| | 3853 | + print "$cmd\n"; |
| | 3854 | + system($cmd); |
| 3364 | 3855 | |
| 3365 | | - $map = ($MapSVG) ? "-map" : ""; |
| | 3856 | + $script = $script_save; |
| | 3857 | + $script =~ s/dopagebox: no/dopagebox: yes/; |
| 3366 | 3858 | |
| 3367 | | - print "Running Ploticus to generate svg file\n" ; |
| 3368 | | -# my $cmd = "$pl $map -" . "svg" . " -o $file_vector $file_script -tightcrop -font \"Times\"" ; |
| 3369 | | -# my $cmd = "$pl $map -" . "svg" . " -o $file_vector $file_script -tightcrop" ; |
| 3370 | | - my $cmd = EscapeShellArg($pl) . " $map -" . "svg" . " -o " . |
| 3371 | | - EscapeShellArg($file_vector) . " " . EscapeShellArg($file_script) . " -tightcrop -xml_encoding UTF-8" ; |
| 3372 | | - print "$cmd\n"; |
| 3373 | | - system ($cmd) ; |
| | 3859 | + $script =~ s/\(\[inc1\]\)/$scriptPng1/; |
| | 3860 | + $script =~ s/\(\[inc2\]\)/$scriptPng2/; |
| | 3861 | + $script =~ s/\(\[inc3\]\)/$scriptPng3/; |
| 3374 | 3862 | |
| 3375 | | - $script = $script_save ; |
| 3376 | | - $script =~ s/dopagebox: no/dopagebox: yes/ ; |
| | 3863 | + $script =~ s/textsize XS/textsize 6/gi; |
| | 3864 | + $script =~ s/textsize S/textsize 8/gi; |
| | 3865 | + $script =~ s/textsize M/textsize 10/gi; |
| | 3866 | + $script =~ s/textsize L/textsize 14/gi; |
| | 3867 | + $script =~ s/textsize XL/textsize 18/gi; |
| | 3868 | + $script =~ s/size=XS/size=6/gi; |
| | 3869 | + $script =~ s/size=S/size=8/gi; |
| | 3870 | + $script =~ s/size=M/size=10/gi; |
| | 3871 | + $script =~ s/size=L/size=14/gi; |
| | 3872 | + $script =~ s/size=XL/size=18/gi; |
| 3377 | 3873 | |
| 3378 | | - $script =~ s/\(\[inc1\]\)/$scriptPng1/ ; |
| 3379 | | - $script =~ s/\(\[inc2\]\)/$scriptPng2/ ; |
| 3380 | | - $script =~ s/\(\[inc3\]\)/$scriptPng3/ ; |
| | 3874 | + open "FILE_OUT", ">", $file_script; |
| | 3875 | + print FILE_OUT &DecodeInput($script); |
| | 3876 | + close "FILE_OUT"; |
| 3381 | 3877 | |
| 3382 | | - $script =~ s/textsize XS/textsize 6/gi ; |
| 3383 | | - $script =~ s/textsize S/textsize 8/gi ; |
| 3384 | | - $script =~ s/textsize M/textsize 10/gi ; |
| 3385 | | - $script =~ s/textsize L/textsize 14/gi ; |
| 3386 | | - $script =~ s/textsize XL/textsize 18/gi ; |
| 3387 | | - $script =~ s/size=XS/size=6/gi ; |
| 3388 | | - $script =~ s/size=S/size=8/gi ; |
| 3389 | | - $script =~ s/size=M/size=10/gi ; |
| 3390 | | - $script =~ s/size=L/size=14/gi ; |
| 3391 | | - $script =~ s/size=XL/size=18/gi ; |
| | 3878 | + if ($MapPNG && $linkmap) { |
| | 3879 | + $map = "-csmap -mapfile " . EscapeShellArg($file_htmlmap); |
| | 3880 | + } |
| | 3881 | + elsif ($linkmap && $showmap) { |
| | 3882 | + $map = "-csmapdemo -mapfile " . EscapeShellArg($file_htmlmap); |
| | 3883 | + } |
| | 3884 | + else { |
| | 3885 | + $map = ''; |
| | 3886 | + } |
| 3392 | 3887 | |
| 3393 | | - open "FILE_OUT", ">", $file_script ; |
| 3394 | | - print FILE_OUT &DecodeInput($script) ; |
| 3395 | | - close "FILE_OUT" ; |
| | 3888 | + # $crop = "-crop 0,0," + @ImageSize {"width"} . "," . @ImageSize {"height"} ; |
| | 3889 | + print "Running Ploticus to generate bitmap\n"; |
| 3396 | 3890 | |
| 3397 | | - if ($MapPNG && $linkmap) { |
| 3398 | | - $map = "-csmap -mapfile " . EscapeShellArg($file_htmlmap); |
| 3399 | | - } elsif ($linkmap && $showmap) { |
| 3400 | | - $map = "-csmapdemo -mapfile ". EscapeShellArg($file_htmlmap); |
| 3401 | | - } else { |
| 3402 | | - $map = ''; |
| 3403 | | - } |
| | 3891 | + # $cmd = "$pl $map -" . $fmt . " -o $file_bitmap $file_script -tightcrop" ; # -v $file_bitmap" ; |
| | 3892 | + # $cmd = "$pl $map -" . $fmt . " -o $file_bitmap $file_script -tightcrop -diagfile $file_pl_info -errfile $file_pl_err" ; |
| | 3893 | + $cmd = |
| | 3894 | + EscapeShellArg($pl) |
| | 3895 | + . " $map -" |
| | 3896 | + . $fmt . " -o " |
| | 3897 | + . EscapeShellArg($file_bitmap) . " " |
| | 3898 | + . EscapeShellArg($file_script) |
| | 3899 | + . " -tightcrop -font " |
| | 3900 | + . EscapeShellArg($font_file); |
| | 3901 | + print "$cmd\n"; |
| | 3902 | + system($cmd); |
| 3404 | 3903 | |
| 3405 | | -# $crop = "-crop 0,0," + @ImageSize {"width"} . "," . @ImageSize {"height"} ; |
| 3406 | | - print "Running Ploticus to generate bitmap\n" ; |
| 3407 | | -# $cmd = "$pl $map -" . $fmt . " -o $file_bitmap $file_script -tightcrop" ; # -v $file_bitmap" ; |
| 3408 | | -# $cmd = "$pl $map -" . $fmt . " -o $file_bitmap $file_script -tightcrop -diagfile $file_pl_info -errfile $file_pl_err" ; |
| 3409 | | - $cmd = EscapeShellArg($pl) . " $map -" . $fmt . " -o " . |
| 3410 | | - EscapeShellArg($file_bitmap) . " " . EscapeShellArg($file_script) . " -tightcrop -font " . EscapeShellArg($font_file); |
| 3411 | | - print "$cmd\n"; |
| 3412 | | - system ($cmd) ; |
| | 3904 | + if ((-e $file_bitmap) && (-s $file_bitmap > 500 * 1024)) { |
| | 3905 | + &Error2( "Output image size exceeds 500 K. Image deleted.\n" |
| | 3906 | + . "Run with option -b (bypass checks) when this is correct.\n" |
| | 3907 | + ); |
| | 3908 | + unlink $file_bitmap; |
| | 3909 | + } |
| 3413 | 3910 | |
| 3414 | | - if ((-e $file_bitmap) && (-s $file_bitmap > 500 * 1024)) |
| 3415 | | - { |
| 3416 | | - &Error2 ("Output image size exceeds 500 K. Image deleted.\n" . |
| 3417 | | - "Run with option -b (bypass checks) when this is correct.\n") ; |
| 3418 | | - unlink $file_bitmap ; |
| 3419 | | - } ; |
| | 3911 | + # not for Wikipedia, only for offline use: |
| | 3912 | + if ((-e $file_bitmap) && ($fmt eq "gif")) { |
| | 3913 | + print "Running nconvert to convert gif image to png format\n\n"; |
| | 3914 | + print |
| | 3915 | + "---------------------------------------------------------------------------\n"; |
| | 3916 | + $cmd = "nconvert.exe -out png " . EscapeShellArg($file_bitmap); |
| | 3917 | + system($cmd); |
| | 3918 | + print |
| | 3919 | + "---------------------------------------------------------------------------\n"; |
| 3420 | 3920 | |
| 3421 | | - # not for Wikipedia, only for offline use: |
| 3422 | | - if ((-e $file_bitmap) && ($fmt eq "gif")) |
| 3423 | | - { |
| 3424 | | - print "Running nconvert to convert gif image to png format\n\n" ; |
| 3425 | | - print "---------------------------------------------------------------------------\n" ; |
| 3426 | | - $cmd = "nconvert.exe -out png " . EscapeShellArg($file_bitmap) ; |
| 3427 | | - system ($cmd) ; |
| 3428 | | - print "---------------------------------------------------------------------------\n" ; |
| | 3921 | + if (!(-e $file_png)) { |
| | 3922 | + print "PNG file not created (is nconvert.exe missing?)\n\n"; |
| | 3923 | + } |
| | 3924 | + } |
| 3429 | 3925 | |
| 3430 | | - if (! (-e $file_png)) |
| 3431 | | - { print "PNG file not created (is nconvert.exe missing?)\n\n" ; } |
| 3432 | | - } |
| | 3926 | + if (-e $file_htmlmap |
| | 3927 | + ) # correct click coordinates of right aligned texts (Ploticus bug) |
| | 3928 | + { |
| | 3929 | + open "FILE_IN", "<", $file_htmlmap; |
| | 3930 | + @map = <FILE_IN>; |
| | 3931 | + close "FILE_IN"; |
| 3433 | 3932 | |
| 3434 | | - if (-e $file_htmlmap) # correct click coordinates of right aligned texts (Ploticus bug) |
| 3435 | | - { |
| 3436 | | - open "FILE_IN", "<", $file_htmlmap ; |
| 3437 | | - @map = <FILE_IN> ; |
| 3438 | | - close "FILE_IN" ; |
| | 3933 | + foreach $line (@map) { |
| | 3934 | + chomp $line; |
| | 3935 | + if ($line =~ /\&\&/) { |
| | 3936 | + $coords = $line; |
| | 3937 | + $shift = $line; |
| | 3938 | + $coords =~ s/^.*coords\=\"([^\"]*)\".*$/$1/; |
| | 3939 | + $shift =~ s/^.*\&\&([^\"]*)\".*$/$1/; |
| | 3940 | + $line =~ s/\&\&[^\"]*//; |
| | 3941 | + (@updcoords) = split(",", $coords); |
| | 3942 | + $maplength = @updcoords[2] - @updcoords[0]; |
| | 3943 | + @updcoords[0] = @updcoords[0] - 2 * ($maplength - 25); |
| | 3944 | + @updcoords[2] = @updcoords[0] + $maplength; |
| | 3945 | + $coordsnew = join(",", @updcoords); |
| | 3946 | + $line =~ s/$coords/$coordsnew/; |
| | 3947 | + push @map2, $line . "\n"; |
| | 3948 | + } |
| | 3949 | + else { push @map2, $line . "\n"; } |
| | 3950 | + } |
| 3439 | 3951 | |
| 3440 | | - foreach $line (@map) |
| 3441 | | - { |
| 3442 | | - chomp $line ; |
| 3443 | | - if ($line =~ /\&\&/) |
| 3444 | | - { |
| 3445 | | - $coords = $line ; |
| 3446 | | - $shift = $line ; |
| 3447 | | - $coords =~ s/^.*coords\=\"([^\"]*)\".*$/$1/ ; |
| 3448 | | - $shift =~ s/^.*\&\&([^\"]*)\".*$/$1/ ; |
| 3449 | | - $line =~ s/\&\&[^\"]*// ; |
| 3450 | | - (@updcoords) = split (",", $coords) ; |
| 3451 | | - $maplength = @updcoords [2] - @updcoords [0] ; |
| 3452 | | - @updcoords [0] = @updcoords [0] - 2 * ($maplength-25) ; |
| 3453 | | - @updcoords [2] = @updcoords [0] + $maplength ; |
| 3454 | | - $coordsnew = join (",", @updcoords) ; |
| 3455 | | - $line =~ s/$coords/$coordsnew/ ; |
| 3456 | | - push @map2, $line . "\n" ; |
| 3457 | | - } |
| 3458 | | - else |
| 3459 | | - { push @map2, $line . "\n" ; } |
| | 3952 | + open "FILE_OUT", ">", $file_htmlmap; |
| | 3953 | + print FILE_OUT @map2; |
| | 3954 | + close "FILE_OUT"; |
| 3460 | 3955 | } |
| 3461 | 3956 | |
| 3462 | | - open "FILE_OUT", ">", $file_htmlmap ; |
| 3463 | | - print FILE_OUT @map2 ; |
| 3464 | | - close "FILE_OUT" ; |
| 3465 | | - } |
| | 3957 | + if (-e $file_vector) { |
| | 3958 | + open "FILE_IN", "<", $file_vector; |
| | 3959 | + @svg = <FILE_IN>; |
| | 3960 | + close "FILE_IN"; |
| 3466 | 3961 | |
| 3467 | | - if (-e $file_vector) |
| 3468 | | - { |
| 3469 | | - open "FILE_IN", "<", $file_vector ; |
| 3470 | | - @svg = <FILE_IN> ; |
| 3471 | | - close "FILE_IN" ; |
| | 3962 | + foreach $line (@svg) { |
| | 3963 | + $line =~ s/\{\{(\d+)\}\}x+/@textsSVG[$1]/gxe; |
| | 3964 | + $line =~ |
| | 3965 | + s/\[(\d+)\[ (.*?) \]\d+\]/'<a style="fill:blue;" xlink:href="' . @linksSVG[$1] . '">' . $2 . '<\/a>'/gxe; |
| | 3966 | + } |
| 3472 | 3967 | |
| 3473 | | - foreach $line (@svg) |
| 3474 | | - { |
| 3475 | | - $line =~ s/\{\{(\d+)\}\}x+/@textsSVG[$1]/gxe ; |
| 3476 | | - $line =~ s/\[(\d+)\[ (.*?) \]\d+\]/'<a style="fill:blue;" xlink:href="' . @linksSVG[$1] . '">' . $2 . '<\/a>'/gxe ; |
| | 3968 | + open "FILE_OUT", ">", $file_vector; |
| | 3969 | + print FILE_OUT @svg; |
| | 3970 | + close "FILE_OUT"; |
| 3477 | 3971 | } |
| 3478 | 3972 | |
| 3479 | | - open "FILE_OUT", ">", $file_vector ; |
| 3480 | | - print FILE_OUT @svg ; |
| 3481 | | - close "FILE_OUT" ; |
| 3482 | | - } |
| | 3973 | + # not for Wikipedia, for offline use: |
| | 3974 | + if ($makehtml) { |
| | 3975 | + $map = ""; |
| | 3976 | + if ($linkmap) { |
| | 3977 | + open "FILE_IN", "<", $file_htmlmap; |
| | 3978 | + while ($line = <FILE_IN>) { $map .= $line; } |
| | 3979 | + close "FILE_IN"; |
| | 3980 | + } |
| | 3981 | + print "Generating html test file\n"; |
| | 3982 | + $width = sprintf("%.0f", @Image{"width"} * 100); |
| | 3983 | + $height = sprintf("%.0f", @Image{"height"} * 100); |
| | 3984 | + $html = <<__HTML__ ; |
| 3483 | 3985 | |
| 3484 | | - # not for Wikipedia, for offline use: |
| 3485 | | - if ($makehtml) |
| 3486 | | - { |
| 3487 | | - $map = "" ; |
| 3488 | | - if ($linkmap) |
| 3489 | | - { |
| 3490 | | - open "FILE_IN", "<", $file_htmlmap ; |
| 3491 | | - while ($line = <FILE_IN>) |
| 3492 | | - { $map .= $line ; } |
| 3493 | | - close "FILE_IN" ; |
| 3494 | | - } |
| 3495 | | - print "Generating html test file\n" ; |
| 3496 | | - $width = sprintf ("%.0f", @Image {"width"} * 100) ; |
| 3497 | | - $height = sprintf ("%.0f", @Image {"height"} * 100) ; |
| 3498 | | - $html = <<__HTML__ ; |
| 3499 | | - |
| 3500 | 3986 | <html> |
| 3501 | 3987 | <head> |
| 3502 | 3988 | <title>%FILENAME% - EasyTimeline test file</title>\n |
| — | — | @@ -3539,1195 +4025,1205 @@ |
| 3540 | 4026 | |
| 3541 | 4027 | __HTML__ |
| 3542 | 4028 | |
| 3543 | | - $html =~ s/\%FILENAME\%/$file_name/ ; |
| | 4029 | + $html =~ s/\%FILENAME\%/$file_name/; |
| 3544 | 4030 | |
| 3545 | | - open "FILE_OUT", ">", $file_html ; |
| 3546 | | - print FILE_OUT $html ; |
| 3547 | | - close "FILE_OUT" ; |
| 3548 | | - } |
| 3549 | | -# my $cmd = "\"c:\\\\Program Files\\\\XnView\\\\xnview.exe\"" ; |
| 3550 | | -# system ("\"c:\\\\Program Files\\\\XnView\\\\xnview.exe\"", "d:\\\\Wikipedia\\Perl\\\\Wo2\\\\Test.png") ; |
| | 4031 | + open "FILE_OUT", ">", $file_html; |
| | 4032 | + print FILE_OUT $html; |
| | 4033 | + close "FILE_OUT"; |
| | 4034 | + } |
| | 4035 | + |
| | 4036 | + # my $cmd = "\"c:\\\\Program Files\\\\XnView\\\\xnview.exe\"" ; |
| | 4037 | + # system ("\"c:\\\\Program Files\\\\XnView\\\\xnview.exe\"", "d:\\\\Wikipedia\\Perl\\\\Wo2\\\\Test.png") ; |
| 3551 | 4038 | } |
| 3552 | 4039 | |
| 3553 | | -sub WriteTexts |
| 3554 | | -{ |
| 3555 | | - my ($line, $xpos, $ypos) ; |
| 3556 | | - foreach $line (@PlotText) |
| 3557 | | - { |
| 3558 | | - my ($at, $bar, $text, $textcolor, $fontsize, $align, $shift, $link, $hint) = split (",", $line) ; |
| 3559 | | - $text =~ s/\#\%\$/\,/g ; |
| 3560 | | - $link =~ s/\#\%\$/\,/g ; |
| 3561 | | - $hint =~ s/\#\%\$/\,/g ; |
| 3562 | | - $shift =~ s/\#\%\$/\,/g ; |
| 3563 | | - $textcolor =~ s/\#\%\$/\,/g ; |
| | 4040 | +sub WriteTexts { |
| | 4041 | + my ($line, $xpos, $ypos); |
| | 4042 | + foreach $line (@PlotText) { |
| | 4043 | + my ( |
| | 4044 | + $at, $bar, $text, $textcolor, $fontsize, |
| | 4045 | + $align, $shift, $link, $hint |
| | 4046 | + ) = split(",", $line); |
| | 4047 | + $text =~ s/\#\%\$/\,/g; |
| | 4048 | + $link =~ s/\#\%\$/\,/g; |
| | 4049 | + $hint =~ s/\#\%\$/\,/g; |
| | 4050 | + $shift =~ s/\#\%\$/\,/g; |
| | 4051 | + $textcolor =~ s/\#\%\$/\,/g; |
| 3564 | 4052 | |
| 3565 | | - my $barcnt = 0 ; |
| 3566 | | - for ($b = 0 ; $b <= $#Bars ; $b++) |
| 3567 | | - { |
| 3568 | | - if (lc(@Bars [$b]) eq lc($bar)) |
| 3569 | | - { $barcnt = ($b + 1) ; last ; } |
| 3570 | | - } |
| | 4053 | + my $barcnt = 0; |
| | 4054 | + for ($b = 0; $b <= $#Bars; $b++) { |
| | 4055 | + if (lc(@Bars[$b]) eq lc($bar)) { $barcnt = ($b + 1); last; } |
| | 4056 | + } |
| 3571 | 4057 | |
| 3572 | | - if (@Axis {"time"} eq "x") |
| 3573 | | - { $xpos = "$at(s)" ; $ypos = "[$barcnt](s)" ; } |
| 3574 | | - else |
| 3575 | | - { $ypos = "$at(s)" ; $xpos = "[$barcnt](s)" ; } |
| | 4058 | + if (@Axis{"time"} eq "x") { |
| | 4059 | + $xpos = "$at(s)"; |
| | 4060 | + $ypos = "[$barcnt](s)"; |
| | 4061 | + } |
| | 4062 | + else { $ypos = "$at(s)"; $xpos = "[$barcnt](s)"; } |
| 3576 | 4063 | |
| 3577 | | - if ($shift ne "") |
| 3578 | | - { |
| 3579 | | - my ($shiftx, $shifty) = split (",", $shift) ; |
| 3580 | | - if ($shiftx > 0) |
| 3581 | | - { $xpos .= "+$shiftx" ; } |
| 3582 | | - if ($shiftx < 0) |
| 3583 | | - { $xpos .= "$shiftx" ; } |
| 3584 | | - if ($shifty > 0) |
| 3585 | | - { $ypos .= "+$shifty" ; } |
| 3586 | | - if ($shifty < 0) |
| 3587 | | - { $ypos .= "$shifty" ; } |
| | 4064 | + if ($shift ne "") { |
| | 4065 | + my ($shiftx, $shifty) = split(",", $shift); |
| | 4066 | + if ($shiftx > 0) { $xpos .= "+$shiftx"; } |
| | 4067 | + if ($shiftx < 0) { $xpos .= "$shiftx"; } |
| | 4068 | + if ($shifty > 0) { $ypos .= "+$shifty"; } |
| | 4069 | + if ($shifty < 0) { $ypos .= "$shifty"; } |
| | 4070 | + } |
| | 4071 | + |
| | 4072 | + &WriteText( |
| | 4073 | + "~", $bar, $shiftx, $xpos, |
| | 4074 | + $ypos, $text, $textcolor, $fontsize, |
| | 4075 | + $align, $link, $hint |
| | 4076 | + ); |
| 3588 | 4077 | } |
| 3589 | | - |
| 3590 | | - &WriteText ("~", $bar, $shiftx, $xpos, $ypos, $text, $textcolor, $fontsize, $align, $link, $hint) ; |
| 3591 | | - } |
| 3592 | 4078 | } |
| 3593 | 4079 | |
| 3594 | | -sub PlotBars |
| 3595 | | -{ |
| 3596 | | - #proc getdata / #proc bars |
| 3597 | | - while ($#PlotBarsNow >= 0) |
| 3598 | | - { |
| 3599 | | - undef @PlotBarsLater ; |
| | 4080 | +sub PlotBars { |
| 3600 | 4081 | |
| 3601 | | - $maxwidth = 0 ; |
| 3602 | | - foreach $entry (@PlotBarsNow) |
| 3603 | | - { |
| 3604 | | - ($width) = split (",", $entry) ; |
| 3605 | | - if ($width > $maxwidth) |
| 3606 | | - { $maxwidth = $width ; } |
| 3607 | | - } |
| | 4082 | + #proc getdata / #proc bars |
| | 4083 | + while ($#PlotBarsNow >= 0) { |
| | 4084 | + undef @PlotBarsLater; |
| 3608 | 4085 | |
| 3609 | | - $script .= "#proc getdata\n" ; |
| 3610 | | - $script .= " delim: comma\n" ; |
| 3611 | | - $script .= " data:\n" ; |
| | 4086 | + $maxwidth = 0; |
| | 4087 | + foreach $entry (@PlotBarsNow) { |
| | 4088 | + ($width) = split(",", $entry); |
| | 4089 | + if ($width > $maxwidth) { $maxwidth = $width; } |
| | 4090 | + } |
| 3612 | 4091 | |
| 3613 | | - foreach $entry (@PlotBarsNow) |
| 3614 | | - { |
| 3615 | | - my ($width, $bar, $from, $till, $color, $link, $hint) = split (",", $entry) ; |
| 3616 | | - if ($width < $maxwidth) |
| 3617 | | - { |
| 3618 | | - push @PlotBarsLater, $entry ; |
| 3619 | | - next ; |
| 3620 | | - } |
| 3621 | | - for ($b = 0 ; $b <= $#Bars ; $b++) |
| 3622 | | - { |
| 3623 | | - if (lc(@Bars [$b]) eq lc($bar)) |
| 3624 | | - { $bar = ($#Bars - ($b - 1)) ; last ; } |
| 3625 | | - } |
| 3626 | | - if (@Axis {"order"} !~ /reverse/i) |
| 3627 | | - { $entry = "$bar,$from,$till,$color,$link,$hint,\n" ; } |
| 3628 | | - else |
| 3629 | | - { $entry = "$bar," . (-$till) . "," . (-$from) . ",$color,$link,$hint,\n" ; } |
| | 4092 | + $script .= "#proc getdata\n"; |
| | 4093 | + $script .= " delim: comma\n"; |
| | 4094 | + $script .= " data:\n"; |
| 3630 | 4095 | |
| 3631 | | - $script .= "$entry" ; |
| 3632 | | - } |
| 3633 | | - $script .= "\n" ; |
| | 4096 | + foreach $entry (@PlotBarsNow) { |
| | 4097 | + my ($width, $bar, $from, $till, $color, $link, $hint) = |
| | 4098 | + split(",", $entry); |
| | 4099 | + if ($width < $maxwidth) { |
| | 4100 | + push @PlotBarsLater, $entry; |
| | 4101 | + next; |
| | 4102 | + } |
| | 4103 | + for ($b = 0; $b <= $#Bars; $b++) { |
| | 4104 | + if (lc(@Bars[$b]) eq lc($bar)) { |
| | 4105 | + $bar = ($#Bars - ($b - 1)); |
| | 4106 | + last; |
| | 4107 | + } |
| | 4108 | + } |
| | 4109 | + if (@Axis{"order"} !~ /reverse/i) { |
| | 4110 | + $entry = "$bar,$from,$till,$color,$link,$hint,\n"; |
| | 4111 | + } |
| | 4112 | + else { |
| | 4113 | + $entry = "$bar," |
| | 4114 | + . (-$till) . "," |
| | 4115 | + . (-$from) |
| | 4116 | + . ",$color,$link,$hint,\n"; |
| | 4117 | + } |
| 3634 | 4118 | |
| 3635 | | - #proc bars |
| 3636 | | - $script .= "#proc bars\n" ; |
| 3637 | | - $script .= " axis: " . @Axis {"time"} . "\n" ; |
| 3638 | | - $script .= " barwidth: $maxwidth\n" ; |
| 3639 | | - $script .= " outline: no\n" ; |
| 3640 | | -# $script .= " thinbarline: width=5\n" ; |
| 3641 | | - if (@Axis {"time"} eq "x") |
| 3642 | | - { $script .= " horizontalbars: yes\n" ; } |
| 3643 | | - $script .= " locfield: 1\n" ; |
| 3644 | | - $script .= " segmentfields: 2 3\n" ; |
| 3645 | | - $script .= " colorfield: 4\n" ; |
| 3646 | | -# $script .= " outline: width=1\n" ; |
| 3647 | | -# $script .= " barwidthfield: 5\n" ; |
| 3648 | | -# if (@fields [4] ne "") |
| 3649 | | -# { $script .= " clickmapurl: " . &LinkToUrl ($text) . "\n" ; } |
| 3650 | | -# if (@fields [5] ne "") |
| 3651 | | -# { $script .= " clickmaplabel: $text\n" ; } |
| 3652 | | - $script .= " clickmapurl: \@\@5\n" ; |
| 3653 | | - $script .= " clickmaplabel: \@\@6\n" ; |
| 3654 | | - $script .= "\n" ; |
| | 4119 | + $script .= "$entry"; |
| | 4120 | + } |
| | 4121 | + $script .= "\n"; |
| 3655 | 4122 | |
| 3656 | | - @PlotBarsNow = @PlotBarsLater ; |
| 3657 | | - } |
| | 4123 | + #proc bars |
| | 4124 | + $script .= "#proc bars\n"; |
| | 4125 | + $script .= " axis: " . @Axis{"time"} . "\n"; |
| | 4126 | + $script .= " barwidth: $maxwidth\n"; |
| | 4127 | + $script .= " outline: no\n"; |
| | 4128 | + |
| | 4129 | + # $script .= " thinbarline: width=5\n" ; |
| | 4130 | + if (@Axis{"time"} eq "x") { $script .= " horizontalbars: yes\n"; } |
| | 4131 | + $script .= " locfield: 1\n"; |
| | 4132 | + $script .= " segmentfields: 2 3\n"; |
| | 4133 | + $script .= " colorfield: 4\n"; |
| | 4134 | + |
| | 4135 | + # $script .= " outline: width=1\n" ; |
| | 4136 | + # $script .= " barwidthfield: 5\n" ; |
| | 4137 | + # if (@fields [4] ne "") |
| | 4138 | + # { $script .= " clickmapurl: " . &LinkToUrl ($text) . "\n" ; } |
| | 4139 | + # if (@fields [5] ne "") |
| | 4140 | + # { $script .= " clickmaplabel: $text\n" ; } |
| | 4141 | + $script .= " clickmapurl: \@\@5\n"; |
| | 4142 | + $script .= " clickmaplabel: \@\@6\n"; |
| | 4143 | + $script .= "\n"; |
| | 4144 | + |
| | 4145 | + @PlotBarsNow = @PlotBarsLater; |
| | 4146 | + } |
| 3658 | 4147 | } |
| 3659 | 4148 | |
| 3660 | | -sub PlotScale |
| 3661 | | -{ |
| 3662 | | - my $scale = shift ; |
| 3663 | | - my $grid = shift ; |
| 3664 | | - my ($color, $from, $till, $start) ; |
| | 4149 | +sub PlotScale { |
| | 4150 | + my $scale = shift; |
| | 4151 | + my $grid = shift; |
| | 4152 | + my ($color, $from, $till, $start); |
| 3665 | 4153 | |
| 3666 | | - %x = %Period ; |
| 3667 | | -# if (($DateFormat =~ /\//) && ($grid)) |
| 3668 | | -# { return ; } |
| | 4154 | + %x = %Period; |
| 3669 | 4155 | |
| 3670 | | -# if (($DateFormat =~ /\//) |
| 3671 | | -# { |
| 3672 | | -# } |
| | 4156 | + # if (($DateFormat =~ /\//) && ($grid)) |
| | 4157 | + # { return ; } |
| 3673 | 4158 | |
| 3674 | | -# if (! $grid) # redefine area, scale linear for time axis, showl whole years always, Ploticus bug |
| 3675 | | -# { |
| | 4159 | + # if (($DateFormat =~ /\//) |
| | 4160 | + # { |
| | 4161 | + # } |
| | 4162 | + |
| | 4163 | + # if (! $grid) # redefine area, scale linear for time axis, showl whole years always, Ploticus bug |
| | 4164 | + # { |
| 3676 | 4165 | # $from = @Period {"from"} ; |
| 3677 | 4166 | # $till = @Period {"till"} ; |
| 3678 | | - $from = &DateToFloat (@Period {"from"}) ; |
| 3679 | | - $till = &DateToFloat (@Period {"till"}) ; |
| | 4167 | + $from = &DateToFloat(@Period{"from"}); |
| | 4168 | + $till = &DateToFloat(@Period{"till"}); |
| | 4169 | + |
| 3680 | 4170 | # $from =~ s/.*\///g ; # delete dd mm if present |
| 3681 | 4171 | # $till =~ s/.*\///g ; |
| 3682 | 4172 | #proc areadef |
| 3683 | | - $script .= "#proc areadef\n" ; |
| 3684 | | - $script .= " #clone: A\n" ; |
| 3685 | | - $script .= " " . @Axis {"time"} . "scaletype: linear\n" ; # date yyyy |
| | 4173 | + $script .= "#proc areadef\n"; |
| | 4174 | + $script .= " #clone: A\n"; |
| | 4175 | + $script .= " " . @Axis{"time"} . "scaletype: linear\n"; # date yyyy |
| 3686 | 4176 | |
| 3687 | | - if (@Axis {"order"} !~ /reverse/i) |
| 3688 | | - { $script .= " " . @Axis {"time"} . "range: $from $till\n" ; } |
| 3689 | | - else |
| 3690 | | - { $script .= " " . @Axis {"time"} . "range: " . (-$till) . " " . (-$from) . "\n" ; } |
| | 4177 | + if (@Axis{"order"} !~ /reverse/i) { |
| | 4178 | + $script .= " " . @Axis{"time"} . "range: $from $till\n"; |
| | 4179 | + } |
| | 4180 | + else { |
| | 4181 | + $script .= " " |
| | 4182 | + . @Axis{"time"} |
| | 4183 | + . "range: " |
| | 4184 | + . (-$till) . " " |
| | 4185 | + . (-$from) . "\n"; |
| | 4186 | + } |
| 3691 | 4187 | |
| 3692 | | - $script .= "\n" ; |
| 3693 | | -# } |
| | 4188 | + $script .= "\n"; |
| 3694 | 4189 | |
| 3695 | | - $script .= "#proc " . @Axis {"time"} . "axis\n" ; |
| | 4190 | + # } |
| 3696 | 4191 | |
| 3697 | | - if (($scale eq "Major") && (! $grid)) |
| 3698 | | - { |
| 3699 | | -# $script .= " stubs: incremental " . @Scales {"Major inc"} . " " . @Scales {"Major unit"} . "\n" ; |
| 3700 | | -# if ($DateFormat =~ /\//) |
| 3701 | | -# { $script .= " stubformat: " . @Axis {"format"} . "\n" ; } |
| 3702 | | -# temp always show whole years (Ploticus autorange bug) |
| 3703 | | - if (@Scales {"Major stubs"} eq "") # ($DateFormat !~ /\//) |
| 3704 | | - { $script .= " stubs: incremental " . @Scales {"Major inc"} . "\n" ; } |
| 3705 | | - else |
| 3706 | | - { $script .= " stubs: list " . @Scales {"Major stubs"} . "\n" ; } |
| 3707 | | - } |
| 3708 | | - else |
| 3709 | | - { $script .= " stubs: none\n" ; } |
| | 4192 | + $script .= "#proc " . @Axis{"time"} . "axis\n"; |
| 3710 | 4193 | |
| 3711 | | - if ($DateFormat !~ /\//) |
| 3712 | | -# { $script .= " ticincrement: " . @Scales {"$scale inc"} . " " . @Scales {"$scale unit"} . "\n" ; } |
| 3713 | | - { $script .= " ticincrement: " . @Scales {"$scale inc"} . "\n" ; } |
| 3714 | | - else |
| 3715 | | - { |
| 3716 | | - my $unit = 1 ; |
| 3717 | | - if (@Scales {"$scale unit"} =~ /month/i) |
| 3718 | | - { $unit = 1/12 ; } |
| 3719 | | - if (@Scales {"$scale unit"} =~ /day/i) |
| 3720 | | - { $unit = 1/365 ; } |
| 3721 | | - $script .= " ticincrement: " . @Scales {"$scale inc"} . " $unit\n" ; |
| 3722 | | - } |
| | 4194 | + if (($scale eq "Major") && (!$grid)) { |
| 3723 | 4195 | |
| 3724 | | - if (defined (@Scales {"$scale start"})) |
| 3725 | | - { |
| 3726 | | - $start = @Scales {"$scale start"} ; |
| 3727 | | - # $start =~ s/.*\///g ; # delete dd mm if present |
| 3728 | | - $start = &DateToFloat ($start) ; |
| 3729 | | - if (@Axis {"order"} =~ /reverse/i) |
| | 4196 | + # $script .= " stubs: incremental " . @Scales {"Major inc"} . " " . @Scales {"Major unit"} . "\n" ; |
| | 4197 | + # if ($DateFormat =~ /\//) |
| | 4198 | + # { $script .= " stubformat: " . @Axis {"format"} . "\n" ; } |
| | 4199 | + # temp always show whole years (Ploticus autorange bug) |
| | 4200 | + if (@Scales{"Major stubs"} eq "") # ($DateFormat !~ /\//) |
| | 4201 | + { |
| | 4202 | + $script .= " stubs: incremental " . @Scales{"Major inc"} . "\n"; |
| | 4203 | + } |
| | 4204 | + else { $script .= " stubs: list " . @Scales{"Major stubs"} . "\n"; } |
| | 4205 | + } |
| | 4206 | + else { $script .= " stubs: none\n"; } |
| | 4207 | + |
| | 4208 | + if ($DateFormat !~ /\//) |
| | 4209 | + |
| | 4210 | + # { $script .= " ticincrement: " . @Scales {"$scale inc"} . " " . @Scales {"$scale unit"} . "\n" ; } |
| 3730 | 4211 | { |
| 3731 | | - $loop = 0 ; |
| 3732 | | - $start = -$start ; |
| 3733 | | - while ($start - @Scales {"$scale inc"} >= - @Period {"till"}) |
| 3734 | | - { |
| 3735 | | - $start -= @Scales {"$scale inc"} ; |
| 3736 | | - if (++$loop > 1000) { last ; } # precaution |
| 3737 | | - } |
| | 4212 | + $script .= " ticincrement: " . @Scales{"$scale inc"} . "\n"; |
| 3738 | 4213 | } |
| 3739 | | - $script .= " stubrange: $start\n" ; |
| 3740 | | - } |
| | 4214 | + else { |
| | 4215 | + my $unit = 1; |
| | 4216 | + if (@Scales{"$scale unit"} =~ /month/i) { $unit = 1 / 12; } |
| | 4217 | + if (@Scales{"$scale unit"} =~ /day/i) { $unit = 1 / 365; } |
| | 4218 | + $script .= " ticincrement: " . @Scales{"$scale inc"} . " $unit\n"; |
| | 4219 | + } |
| 3741 | 4220 | |
| 3742 | | - if ($scale eq "Major") |
| 3743 | | - { |
| 3744 | | - $script .= " ticlen: 0.05\n" ; |
| 3745 | | - if (@Axis {"time"} eq "y") |
| 3746 | | - { $script .= " stubdetails: adjust=0.05,0\n" ; } |
| 3747 | | - if (@Axis {"order"} =~ /reverse/i) |
| 3748 | | - { $script .= " signreverse: yes\n" ; } |
| 3749 | | - } |
| 3750 | | - else |
| 3751 | | - { $script .= " ticlen: 0.02\n" ; } |
| 3752 | | -# $script .= " location: 4\n" ; test |
| | 4221 | + if (defined(@Scales{"$scale start"})) { |
| | 4222 | + $start = @Scales{"$scale start"}; |
| 3753 | 4223 | |
| 3754 | | - $color .= @Scales {"$scale grid"} ; |
| | 4224 | + # $start =~ s/.*\///g ; # delete dd mm if present |
| | 4225 | + $start = &DateToFloat($start); |
| | 4226 | + if (@Axis{"order"} =~ /reverse/i) { |
| | 4227 | + $loop = 0; |
| | 4228 | + $start = -$start; |
| | 4229 | + while ($start - @Scales{"$scale inc"} >= -@Period{"till"}) { |
| | 4230 | + $start -= @Scales{"$scale inc"}; |
| | 4231 | + if (++$loop > 1000) { last; } # precaution |
| | 4232 | + } |
| | 4233 | + } |
| | 4234 | + $script .= " stubrange: $start\n"; |
| | 4235 | + } |
| 3755 | 4236 | |
| 3756 | | - if (defined (@Colors {$color})) |
| 3757 | | - { $color = @Colors {$color} ; } |
| | 4237 | + if ($scale eq "Major") { |
| | 4238 | + $script .= " ticlen: 0.05\n"; |
| | 4239 | + if (@Axis{"time"} eq "y") { |
| | 4240 | + $script .= " stubdetails: adjust=0.05,0\n"; |
| | 4241 | + } |
| | 4242 | + if (@Axis{"order"} =~ /reverse/i) { |
| | 4243 | + $script .= " signreverse: yes\n"; |
| | 4244 | + } |
| | 4245 | + } |
| | 4246 | + else { $script .= " ticlen: 0.02\n"; } |
| 3758 | 4247 | |
| 3759 | | - if ($grid) |
| 3760 | | - { $script .= " grid: color=$color\n" ; } |
| | 4248 | + # $script .= " location: 4\n" ; test |
| 3761 | 4249 | |
| 3762 | | - $script .= "\n" ; |
| | 4250 | + $color .= @Scales{"$scale grid"}; |
| 3763 | 4251 | |
| 3764 | | - if ($grid) # restore areadef |
| 3765 | | - { |
| 3766 | | - #proc areadef |
| 3767 | | - $script .= "#proc areadef\n" ; |
| 3768 | | - $script .= " #clone: A\n" ; |
| 3769 | | - $script .= "\n" ; |
| 3770 | | - } |
| | 4252 | + if (defined(@Colors{$color})) { $color = @Colors{$color}; } |
| | 4253 | + |
| | 4254 | + if ($grid) { $script .= " grid: color=$color\n"; } |
| | 4255 | + |
| | 4256 | + $script .= "\n"; |
| | 4257 | + |
| | 4258 | + if ($grid) # restore areadef |
| | 4259 | + { |
| | 4260 | + |
| | 4261 | + #proc areadef |
| | 4262 | + $script .= "#proc areadef\n"; |
| | 4263 | + $script .= " #clone: A\n"; |
| | 4264 | + $script .= "\n"; |
| | 4265 | + } |
| 3771 | 4266 | } |
| 3772 | 4267 | |
| 3773 | | -sub PlotLines |
| 3774 | | -{ |
| 3775 | | - my $layer = shift ; |
| | 4268 | +sub PlotLines { |
| | 4269 | + my $layer = shift; |
| 3776 | 4270 | |
| 3777 | | - if ($#DrawLines < 0) |
| 3778 | | - { return ; } |
| | 4271 | + if ($#DrawLines < 0) { return; } |
| 3779 | 4272 | |
| 3780 | | - undef (@DrawLinesNow) ; |
| | 4273 | + undef(@DrawLinesNow); |
| 3781 | 4274 | |
| 3782 | | - foreach $line (@DrawLines) |
| 3783 | | - { |
| 3784 | | - if ($line =~ /\|$layer\n/) |
| 3785 | | - { push @DrawLinesNow, $line ; } |
| 3786 | | - } |
| | 4275 | + foreach $line (@DrawLines) { |
| | 4276 | + if ($line =~ /\|$layer\n/) { push @DrawLinesNow, $line; } |
| | 4277 | + } |
| 3787 | 4278 | |
| 3788 | | - if ($#DrawLinesNow < 0) |
| 3789 | | - { return ; } |
| | 4279 | + if ($#DrawLinesNow < 0) { return; } |
| 3790 | 4280 | |
| 3791 | | - foreach $entry (@DrawLinesNow) |
| 3792 | | - { |
| 3793 | | - chomp ($entry) ; |
| 3794 | | - $script .= "#proc line\n" ; |
| 3795 | | -# $script .= " notation: scaled\n" ; |
| 3796 | | - if ($entry =~ /^[12]/) |
| 3797 | | - { ($mode, $at, $from, $till, $color, $width) = split ('\|', $entry) ; } |
| 3798 | | - else |
| 3799 | | - { ($mode, $points, $color, $width) = split ('\|', $entry) ; } |
| | 4281 | + foreach $entry (@DrawLinesNow) { |
| | 4282 | + chomp($entry); |
| | 4283 | + $script .= "#proc line\n"; |
| 3800 | 4284 | |
| 3801 | | - $script .= " linedetails: width=$width color=$color style=0\n" ; |
| | 4285 | + # $script .= " notation: scaled\n" ; |
| | 4286 | + if ($entry =~ /^[12]/) { |
| | 4287 | + ($mode, $at, $from, $till, $color, $width) = split('\|', $entry); |
| | 4288 | + } |
| | 4289 | + else { ($mode, $points, $color, $width) = split('\|', $entry); } |
| 3802 | 4290 | |
| 3803 | | - if ($mode == 1) # draw perpendicular to time axis |
| 3804 | | - { |
| 3805 | | - if (@Axis {"order"} =~ /reverse/i) |
| 3806 | | - { $at = -$at ; } |
| | 4291 | + $script .= " linedetails: width=$width color=$color style=0\n"; |
| 3807 | 4292 | |
| 3808 | | - if (@Axis {"time"} eq "x") |
| 3809 | | - { |
| 3810 | | - if ($from eq "") |
| 3811 | | - { $from = @PlotArea {"bottom"} } |
| 3812 | | - if ($till eq "") |
| 3813 | | - { $till = @PlotArea {"bottom"} + @PlotArea {"height"} } |
| 3814 | | - $from += ($width/200) ; # compensate for overstrechting of thick lines |
| 3815 | | - $till -= ($width/200) ; |
| 3816 | | - if ($from > @Image {"height"}) |
| 3817 | | - { $from = @Image {"height"} ; } |
| 3818 | | - if ($till > @Image {"height"}) |
| 3819 | | - { $till = @Image {"height"} ; } |
| 3820 | | - $script .= " points: $at(s) $from $at(s) $till\n" ; |
| 3821 | | - } |
| 3822 | | - else |
| 3823 | | - { |
| 3824 | | - if ($from eq "") |
| 3825 | | - { $from = @PlotArea {"left"} } |
| 3826 | | - if ($till eq "") |
| 3827 | | - { $till = @PlotArea {"left"} + @PlotArea {"width"} } |
| 3828 | | - $from += ($width/200) ; |
| 3829 | | - $till -= ($width/200) ; |
| 3830 | | - if ($from > @Image {"width"}) |
| 3831 | | - { $from = @Image {"width"} ; } |
| 3832 | | - if ($till > @Image {"width"}) |
| 3833 | | - { $till = @Image {"width"} ; } |
| 3834 | | - $script .= " points: $from $at(s) $till $at(s)\n" ; |
| 3835 | | - } |
| 3836 | | - } |
| | 4293 | + if ($mode == 1) # draw perpendicular to time axis |
| | 4294 | + { |
| | 4295 | + if (@Axis{"order"} =~ /reverse/i) { $at = -$at; } |
| 3837 | 4296 | |
| 3838 | | - if ($mode == 2) # draw parralel to time axis |
| 3839 | | - { |
| 3840 | | - if (@Axis {"order"} =~ /reverse/i) |
| 3841 | | - { |
| 3842 | | - $from = -$from ; |
| 3843 | | - $till = -$till ; |
| 3844 | | - } |
| | 4297 | + if (@Axis{"time"} eq "x") { |
| | 4298 | + if ($from eq "") { $from = @PlotArea{"bottom"} } |
| | 4299 | + if ($till eq "") { |
| | 4300 | + $till = @PlotArea{"bottom"} + @PlotArea{"height"}; |
| | 4301 | + } |
| | 4302 | + $from += ($width / 200) |
| | 4303 | + ; # compensate for overstrechting of thick lines |
| | 4304 | + $till -= ($width / 200); |
| | 4305 | + if ($from > @Image{"height"}) { $from = @Image{"height"}; } |
| | 4306 | + if ($till > @Image{"height"}) { $till = @Image{"height"}; } |
| | 4307 | + $script .= " points: $at(s) $from $at(s) $till\n"; |
| | 4308 | + } |
| | 4309 | + else { |
| | 4310 | + if ($from eq "") { $from = @PlotArea{"left"} } |
| | 4311 | + if ($till eq "") { |
| | 4312 | + $till = @PlotArea{"left"} + @PlotArea{"width"}; |
| | 4313 | + } |
| | 4314 | + $from += ($width / 200); |
| | 4315 | + $till -= ($width / 200); |
| | 4316 | + if ($from > @Image{"width"}) { $from = @Image{"width"}; } |
| | 4317 | + if ($till > @Image{"width"}) { $till = @Image{"width"}; } |
| | 4318 | + $script .= " points: $from $at(s) $till $at(s)\n"; |
| | 4319 | + } |
| | 4320 | + } |
| 3845 | 4321 | |
| 3846 | | - $from .= "(s)+" .($width/200) ; |
| 3847 | | - $till .= "(s)-" .($width/200) ; |
| 3848 | | - if (@Axis {"time"} eq "x") |
| 3849 | | - { |
| 3850 | | - if ($at eq "") |
| 3851 | | - { $at = @PlotArea {"bottom"} ; } |
| 3852 | | - if ($at > @Image {"height"}) |
| 3853 | | - { $at = @Image {"height"} ; } |
| 3854 | | - $script .= " points: $from $at $till $at\n" ; |
| 3855 | | - } |
| 3856 | | - else |
| 3857 | | - { |
| 3858 | | - if ($at eq "") |
| 3859 | | - { $at = @PlotArea {"left"} ; } |
| 3860 | | - if ($at > @Image {"width"}) |
| 3861 | | - { $at = @Image {"width"} ; } |
| 3862 | | - $script .= " points: $at $from $at $till\n" ; |
| 3863 | | - } |
| 3864 | | - } |
| | 4322 | + if ($mode == 2) # draw parralel to time axis |
| | 4323 | + { |
| | 4324 | + if (@Axis{"order"} =~ /reverse/i) { |
| | 4325 | + $from = -$from; |
| | 4326 | + $till = -$till; |
| | 4327 | + } |
| 3865 | 4328 | |
| 3866 | | - if ($mode == 3) # draw free line |
| 3867 | | - { |
| 3868 | | - @Points = split (",", $points) ; |
| 3869 | | - foreach $point (@Points) |
| 3870 | | - { $point = &Normalize ($point) ; } |
| 3871 | | - if ((@Points [0] > @Image {"width"}) || |
| 3872 | | - (@Points [1] > @Image {"height"}) || |
| 3873 | | - (@Points [2] > @Image {"width"}) || |
| 3874 | | - (@Points [3] > @Image {"height"})) |
| 3875 | | - { &Error2 ("Linedata attribute 'points' invalid.\n" . |
| 3876 | | - sprintf ("(%d,%d)(%d,%d)", @Points[0]*100, @Points[1]*100, @Points[2]*100, @Points[3]*100) . " does not fit in image\n") ; |
| 3877 | | - return ; } |
| 3878 | | - $script .= " points: @Points[0] @Points[1] @Points[2] @Points[3]\n" ; |
| | 4329 | + $from .= "(s)+" . ($width / 200); |
| | 4330 | + $till .= "(s)-" . ($width / 200); |
| | 4331 | + if (@Axis{"time"} eq "x") { |
| | 4332 | + if ($at eq "") { $at = @PlotArea{"bottom"}; } |
| | 4333 | + if ($at > @Image{"height"}) { $at = @Image{"height"}; } |
| | 4334 | + $script .= " points: $from $at $till $at\n"; |
| | 4335 | + } |
| | 4336 | + else { |
| | 4337 | + if ($at eq "") { $at = @PlotArea{"left"}; } |
| | 4338 | + if ($at > @Image{"width"}) { $at = @Image{"width"}; } |
| | 4339 | + $script .= " points: $at $from $at $till\n"; |
| | 4340 | + } |
| | 4341 | + } |
| | 4342 | + |
| | 4343 | + if ($mode == 3) # draw free line |
| | 4344 | + { |
| | 4345 | + @Points = split(",", $points); |
| | 4346 | + foreach $point (@Points) { $point = &Normalize($point); } |
| | 4347 | + if ( (@Points[0] > @Image{"width"}) |
| | 4348 | + || (@Points[1] > @Image{"height"}) |
| | 4349 | + || (@Points[2] > @Image{"width"}) |
| | 4350 | + || (@Points[3] > @Image{"height"})) |
| | 4351 | + { |
| | 4352 | + &Error2( |
| | 4353 | + "Linedata attribute 'points' invalid.\n" |
| | 4354 | + . sprintf("(%d,%d)(%d,%d)", |
| | 4355 | + @Points[0] * 100, |
| | 4356 | + @Points[1] * 100, |
| | 4357 | + @Points[2] * 100, |
| | 4358 | + @Points[3] * 100) |
| | 4359 | + . " does not fit in image\n" |
| | 4360 | + ); |
| | 4361 | + return; |
| | 4362 | + } |
| | 4363 | + $script .= |
| | 4364 | + " points: @Points[0] @Points[1] @Points[2] @Points[3]\n"; |
| | 4365 | + } |
| 3879 | 4366 | } |
| 3880 | | - } |
| 3881 | 4367 | |
| 3882 | | - |
| 3883 | | - $script .= "\n" ; |
| | 4368 | + $script .= "\n"; |
| 3884 | 4369 | } |
| 3885 | 4370 | |
| 3886 | | -sub ColorPredefined |
| 3887 | | -{ |
| 3888 | | - my $color = shift ; |
| 3889 | | - if ($color =~ /^(?:black|white|tan1|tan2|red|magenta|claret|coral|pink|orange| |
| | 4371 | +sub ColorPredefined { |
| | 4372 | + my $color = shift; |
| | 4373 | + if ( |
| | 4374 | + $color =~ |
| | 4375 | + /^(?:black|white|tan1|tan2|red|magenta|claret|coral|pink|orange| |
| 3890 | 4376 | redorange|lightorange|yellow|yellow2|dullyellow|yelloworange| |
| 3891 | 4377 | brightgreen|green|kelleygreen|teal|drabgreen|yellowgreen| |
| 3892 | 4378 | limegreen|brightblue|darkblue|blue|oceanblue|skyblue| |
| 3893 | | - purple|lavender|lightpurple|powderblue|powderblue2)$/xi) |
| 3894 | | - { |
| 3895 | | - if (! defined (@Colors {lc ($color)})) |
| 3896 | | - { &StoreColor ($color, $color, "", $command) ; } |
| 3897 | | - return ($true) ; |
| 3898 | | - } |
| 3899 | | - else |
| 3900 | | - { return ($false) ; } |
| | 4379 | + purple|lavender|lightpurple|powderblue|powderblue2)$/xi |
| | 4380 | + ) |
| | 4381 | + { |
| | 4382 | + if (!defined(@Colors{ lc($color) })) { |
| | 4383 | + &StoreColor($color, $color, "", $command); |
| | 4384 | + } |
| | 4385 | + return ($true); |
| | 4386 | + } |
| | 4387 | + else { return ($false); } |
| 3901 | 4388 | } |
| 3902 | 4389 | |
| 3903 | | -sub ValidAbs |
| 3904 | | -{ |
| 3905 | | - $value = shift ; |
| 3906 | | - if ($value =~ /^ \d+ \.? \d* (?:px|in|cm)? $/xi) |
| 3907 | | - { return ($true) ; } |
| 3908 | | - else |
| 3909 | | - { return ($false) ; } |
| | 4390 | +sub ValidAbs { |
| | 4391 | + $value = shift; |
| | 4392 | + if ($value =~ /^ \d+ \.? \d* (?:px|in|cm)? $/xi) { return ($true); } |
| | 4393 | + else { return ($false); } |
| 3910 | 4394 | } |
| 3911 | 4395 | |
| 3912 | | -sub ValidAbsRel |
| 3913 | | -{ |
| 3914 | | - $value = shift ; |
| 3915 | | - if ($value =~ /^ \d+ \.? \d* (?:px|in|cm|$hPerc)? $/xi) |
| 3916 | | - { return ($true) ; } |
| 3917 | | - else |
| 3918 | | - { return ($false) ; } |
| | 4396 | +sub ValidAbsRel { |
| | 4397 | + $value = shift; |
| | 4398 | + if ($value =~ /^ \d+ \.? \d* (?:px|in|cm|$hPerc)? $/xi) { |
| | 4399 | + return ($true); |
| | 4400 | + } |
| | 4401 | + else { return ($false); } |
| 3919 | 4402 | } |
| 3920 | 4403 | |
| 3921 | | -sub ValidDateFormat |
| 3922 | | -{ |
| 3923 | | - my $date = shift ; |
| 3924 | | - my ($day, $month, $year) ; |
| | 4404 | +sub ValidDateFormat { |
| | 4405 | + my $date = shift; |
| | 4406 | + my ($day, $month, $year); |
| 3925 | 4407 | |
| 3926 | | -# if ($date=~ /^\-?\d+$/) # for now full years are always allowed |
| 3927 | | -# { return ($true) ; } |
| | 4408 | + # if ($date=~ /^\-?\d+$/) # for now full years are always allowed |
| | 4409 | + # { return ($true) ; } |
| 3928 | 4410 | |
| 3929 | | - if ($DateFormat eq "yyyy") |
| 3930 | | - { |
| 3931 | | - if (! ($date=~ /^\-?\d+$/)) |
| 3932 | | - { return ($false) ; } |
| 3933 | | - return ($true) ; |
| 3934 | | - } |
| | 4411 | + if ($DateFormat eq "yyyy") { |
| | 4412 | + if (!($date =~ /^\-?\d+$/)) { return ($false); } |
| | 4413 | + return ($true); |
| | 4414 | + } |
| 3935 | 4415 | |
| 3936 | | - if ($DateFormat eq "x.y") |
| 3937 | | - { |
| 3938 | | - if (! ($date=~ /^\-?\d+(?:\.\d+)?$/)) |
| 3939 | | - { return ($false) ; } |
| 3940 | | - return ($true) ; |
| 3941 | | - } |
| | 4416 | + if ($DateFormat eq "x.y") { |
| | 4417 | + if (!($date =~ /^\-?\d+(?:\.\d+)?$/)) { return ($false); } |
| | 4418 | + return ($true); |
| | 4419 | + } |
| 3942 | 4420 | |
| 3943 | | - if (! ($date=~ /^\d\d\/\d\d\/\d\d\d\d$/)) |
| 3944 | | - { return ($false) ; } |
| | 4421 | + if (!($date =~ /^\d\d\/\d\d\/\d\d\d\d$/)) { return ($false); } |
| 3945 | 4422 | |
| 3946 | | - if ($DateFormat eq "dd/mm/yyyy") |
| 3947 | | - { |
| 3948 | | - $day = substr ($date,0,2) ; |
| 3949 | | - $month = substr ($date,3,2) ; |
| 3950 | | - $year = substr ($date,6,4) ; |
| 3951 | | - } |
| 3952 | | - else |
| 3953 | | - { |
| 3954 | | - $day = substr ($date,3,2) ; |
| 3955 | | - $month = substr ($date,0,2) ; |
| 3956 | | - $year = substr ($date,6,4) ; |
| 3957 | | - } |
| | 4423 | + if ($DateFormat eq "dd/mm/yyyy") { |
| | 4424 | + $day = substr($date, 0, 2); |
| | 4425 | + $month = substr($date, 3, 2); |
| | 4426 | + $year = substr($date, 6, 4); |
| | 4427 | + } |
| | 4428 | + else { |
| | 4429 | + $day = substr($date, 3, 2); |
| | 4430 | + $month = substr($date, 0, 2); |
| | 4431 | + $year = substr($date, 6, 4); |
| | 4432 | + } |
| 3958 | 4433 | |
| 3959 | | - if ($month =~ /^(?:01|03|05|07|08|10|12)$/) |
| 3960 | | - { if ($day > 31) { return ($false) ; }} |
| 3961 | | - elsif ($month =~ /^(?:04|06|09|11)$/) |
| 3962 | | - { if ($day > 30) { return ($false) ; }} |
| 3963 | | - elsif ($month =~ /^02$/) |
| 3964 | | - { |
| 3965 | | - if (($year % 4 == 0) && ($year % 100 != 0)) |
| 3966 | | - { if ($day > 29) { return ($false) ; }} |
| 3967 | | - else |
| 3968 | | - { if ($day > 28) { return ($false) ; }} |
| 3969 | | - } |
| 3970 | | - else { return ($false) ; } |
| 3971 | | - return ($true) ; |
| | 4434 | + if ($month =~ /^(?:01|03|05|07|08|10|12)$/) { |
| | 4435 | + if ($day > 31) { return ($false); } |
| | 4436 | + } |
| | 4437 | + elsif ($month =~ /^(?:04|06|09|11)$/) { |
| | 4438 | + if ($day > 30) { return ($false); } |
| | 4439 | + } |
| | 4440 | + elsif ($month =~ /^02$/) { |
| | 4441 | + if (($year % 4 == 0) && ($year % 100 != 0)) { |
| | 4442 | + if ($day > 29) { return ($false); } |
| | 4443 | + } |
| | 4444 | + else { |
| | 4445 | + if ($day > 28) { return ($false); } |
| | 4446 | + } |
| | 4447 | + } |
| | 4448 | + else { return ($false); } |
| | 4449 | + return ($true); |
| 3972 | 4450 | } |
| 3973 | 4451 | |
| 3974 | | -sub ValidDateRange |
| 3975 | | -{ |
| 3976 | | - my $date = shift ; |
| 3977 | | - my ($day, $month, $year, |
| 3978 | | - $dayf, $monthf, $yearf, |
| 3979 | | - $dayt, $montht, $yeart) ; |
| | 4452 | +sub ValidDateRange { |
| | 4453 | + my $date = shift; |
| | 4454 | + my ($day, $month, $year, $dayf, $monthf, $yearf, $dayt, $montht, $yeart); |
| 3980 | 4455 | |
| 3981 | | - my $from = @Period {"from"} ; |
| 3982 | | - my $till = @Period {"till"} ; |
| | 4456 | + my $from = @Period{"from"}; |
| | 4457 | + my $till = @Period{"till"}; |
| 3983 | 4458 | |
| 3984 | | - if (($DateFormat eq "yyyy") || ($DateFormat eq "x.y")) |
| 3985 | | - { |
| 3986 | | - if (($date < $from) || ($date > $till)) |
| 3987 | | - { return ($false) ; } |
| 3988 | | - return ($true) ; |
| 3989 | | - } |
| | 4459 | + if (($DateFormat eq "yyyy") || ($DateFormat eq "x.y")) { |
| | 4460 | + if (($date < $from) || ($date > $till)) { return ($false); } |
| | 4461 | + return ($true); |
| | 4462 | + } |
| 3990 | 4463 | |
| 3991 | | - if ($DateFormat eq "dd/mm/yyyy") |
| 3992 | | - { |
| 3993 | | - $day = substr ($date,0,2) ; |
| 3994 | | - $month = substr ($date,3,2) ; |
| 3995 | | - $year = substr ($date,6,4) ; |
| 3996 | | - $dayf = substr ($from,0,2) ; |
| 3997 | | - $monthf = substr ($from,3,2) ; |
| 3998 | | - $yearf = substr ($from,6,4) ; |
| 3999 | | - $dayt = substr ($till,0,2) ; |
| 4000 | | - $montht = substr ($till,3,2) ; |
| 4001 | | - $yeart = substr ($till,6,4) ; |
| 4002 | | - } |
| 4003 | | - if ($DateFormat eq "mm/dd/yyyy") |
| 4004 | | - { |
| 4005 | | - $day = substr ($date,3,2) ; |
| 4006 | | - $month = substr ($date,0,2) ; |
| 4007 | | - $year = substr ($date,6,4) ; |
| 4008 | | - $dayf = substr ($from,3,2) ; |
| 4009 | | - $monthf = substr ($from,0,2) ; |
| 4010 | | - $yearf = substr ($from,6,4) ; |
| 4011 | | - $dayt = substr ($till,3,2) ; |
| 4012 | | - $montht = substr ($till,0,2) ; |
| 4013 | | - $yeart = substr ($till,6,4) ; |
| 4014 | | - } |
| | 4464 | + if ($DateFormat eq "dd/mm/yyyy") { |
| | 4465 | + $day = substr($date, 0, 2); |
| | 4466 | + $month = substr($date, 3, 2); |
| | 4467 | + $year = substr($date, 6, 4); |
| | 4468 | + $dayf = substr($from, 0, 2); |
| | 4469 | + $monthf = substr($from, 3, 2); |
| | 4470 | + $yearf = substr($from, 6, 4); |
| | 4471 | + $dayt = substr($till, 0, 2); |
| | 4472 | + $montht = substr($till, 3, 2); |
| | 4473 | + $yeart = substr($till, 6, 4); |
| | 4474 | + } |
| | 4475 | + if ($DateFormat eq "mm/dd/yyyy") { |
| | 4476 | + $day = substr($date, 3, 2); |
| | 4477 | + $month = substr($date, 0, 2); |
| | 4478 | + $year = substr($date, 6, 4); |
| | 4479 | + $dayf = substr($from, 3, 2); |
| | 4480 | + $monthf = substr($from, 0, 2); |
| | 4481 | + $yearf = substr($from, 6, 4); |
| | 4482 | + $dayt = substr($till, 3, 2); |
| | 4483 | + $montht = substr($till, 0, 2); |
| | 4484 | + $yeart = substr($till, 6, 4); |
| | 4485 | + } |
| 4015 | 4486 | |
| 4016 | | - if (($year < $yearf) || |
| 4017 | | - (($year == $yearf) && |
| 4018 | | - (($month < $monthf) || |
| 4019 | | - (($month == $monthf) && ($day < $dayf)) |
| 4020 | | - ))) |
| 4021 | | - { return ($false) } |
| | 4487 | + if ( |
| | 4488 | + ($year < $yearf) |
| | 4489 | + || ( |
| | 4490 | + ($year == $yearf) |
| | 4491 | + && ( ($month < $monthf) |
| | 4492 | + || (($month == $monthf) && ($day < $dayf))) |
| | 4493 | + ) |
| | 4494 | + ) |
| | 4495 | + { |
| | 4496 | + return ($false); |
| | 4497 | + } |
| 4022 | 4498 | |
| 4023 | | - if (($year > $yeart) || |
| 4024 | | - (($year == $yeart) && |
| 4025 | | - (($month > $montht) || |
| 4026 | | - (($month == $montht) && ($day > $dayt)) |
| 4027 | | - ))) |
| 4028 | | - { return ($false) } |
| | 4499 | + if ( |
| | 4500 | + ($year > $yeart) |
| | 4501 | + || ( |
| | 4502 | + ($year == $yeart) |
| | 4503 | + && ( ($month > $montht) |
| | 4504 | + || (($month == $montht) && ($day > $dayt))) |
| | 4505 | + ) |
| | 4506 | + ) |
| | 4507 | + { |
| | 4508 | + return ($false); |
| | 4509 | + } |
| 4029 | 4510 | |
| 4030 | | - return ($true) ; |
| | 4511 | + return ($true); |
| 4031 | 4512 | } |
| 4032 | 4513 | |
| 4033 | | -sub DateMedium |
| 4034 | | -{ |
| 4035 | | - my $from = shift ; |
| 4036 | | - my $till = shift ; |
| | 4514 | +sub DateMedium { |
| | 4515 | + my $from = shift; |
| | 4516 | + my $till = shift; |
| 4037 | 4517 | |
| 4038 | | - if (($DateFormat eq "yyyy") || ($DateFormat eq "x.y")) |
| 4039 | | - { return (sprintf ("%.3f", ($from + $till) / 2)) ; } |
| | 4518 | + if (($DateFormat eq "yyyy") || ($DateFormat eq "x.y")) { |
| | 4519 | + return (sprintf("%.3f", ($from + $till) / 2)); |
| | 4520 | + } |
| 4040 | 4521 | |
| 4041 | | - $from2 = &DaysFrom1800 ($from) ; |
| 4042 | | - $till2 = &DaysFrom1800 ($till) ; |
| 4043 | | - my $date = &DateFrom1800 (int (($from2 + $till2) / 2)) ; |
| 4044 | | - return ($date) ; |
| | 4522 | + $from2 = &DaysFrom1800($from); |
| | 4523 | + $till2 = &DaysFrom1800($till); |
| | 4524 | + my $date = &DateFrom1800(int(($from2 + $till2) / 2)); |
| | 4525 | + return ($date); |
| 4045 | 4526 | } |
| 4046 | 4527 | |
| 4047 | | -sub DaysFrom1800 |
| 4048 | | -{ |
| 4049 | | - @mmm = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) ; |
| 4050 | | - my $date = shift ; |
| 4051 | | - if ($DateFormat eq "dd/mm/yyyy") |
| 4052 | | - { |
| 4053 | | - $day = substr ($date,0,2) ; |
| 4054 | | - $month = substr ($date,3,2) ; |
| 4055 | | - $year = substr ($date,6,4) ; |
| 4056 | | - } |
| 4057 | | - else |
| 4058 | | - { |
| 4059 | | - $day = substr ($date,3,2) ; |
| 4060 | | - $month = substr ($date,0,2) ; |
| 4061 | | - $year = substr ($date,6,4) ; |
| 4062 | | - } |
| 4063 | | - if ($year < 1800) |
| 4064 | | - { &Error2 ("Function 'DaysFrom1800' expects year >= 1800, not '$year'.") ; return ; } |
| | 4528 | +sub DaysFrom1800 { |
| | 4529 | + @mmm = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); |
| | 4530 | + my $date = shift; |
| | 4531 | + if ($DateFormat eq "dd/mm/yyyy") { |
| | 4532 | + $day = substr($date, 0, 2); |
| | 4533 | + $month = substr($date, 3, 2); |
| | 4534 | + $year = substr($date, 6, 4); |
| | 4535 | + } |
| | 4536 | + else { |
| | 4537 | + $day = substr($date, 3, 2); |
| | 4538 | + $month = substr($date, 0, 2); |
| | 4539 | + $year = substr($date, 6, 4); |
| | 4540 | + } |
| | 4541 | + if ($year < 1800) { |
| | 4542 | + &Error2("Function 'DaysFrom1800' expects year >= 1800, not '$year'."); |
| | 4543 | + return; |
| | 4544 | + } |
| 4065 | 4545 | |
| 4066 | | - $days = ($year - 1800) * 365 ; |
| 4067 | | - $days += int (($year -1 - 1800) / 4) ; |
| 4068 | | - $days -= int (($year -1 - 1800) / 100) ; |
| 4069 | | - if ($month > 1) |
| 4070 | | - { |
| 4071 | | - for ($m = $month - 2 ; $m >= 0 ; $m--) |
| 4072 | | - { |
| 4073 | | - $days += @mmm [$m] ; |
| 4074 | | - if ($m == 1) |
| 4075 | | - { |
| 4076 | | - if ((($year % 4) == 0) && (($year % 100) != 0)) |
| 4077 | | - { $days ++ ; } |
| 4078 | | - } |
| | 4546 | + $days = ($year - 1800) * 365; |
| | 4547 | + $days += int(($year - 1 - 1800) / 4); |
| | 4548 | + $days -= int(($year - 1 - 1800) / 100); |
| | 4549 | + if ($month > 1) { |
| | 4550 | + for ($m = $month - 2; $m >= 0; $m--) { |
| | 4551 | + $days += @mmm[$m]; |
| | 4552 | + if ($m == 1) { |
| | 4553 | + if ((($year % 4) == 0) && (($year % 100) != 0)) { $days++; } |
| | 4554 | + } |
| | 4555 | + } |
| 4079 | 4556 | } |
| 4080 | | - } |
| 4081 | | - $days += $day ; |
| | 4557 | + $days += $day; |
| 4082 | 4558 | |
| 4083 | | - return ($days) ; |
| | 4559 | + return ($days); |
| 4084 | 4560 | } |
| 4085 | 4561 | |
| 4086 | | -sub DateToFloat |
| 4087 | | -{ |
| 4088 | | - my $date = shift ; |
| 4089 | | - if ($DateFormat !~ /\//) |
| 4090 | | - { return ($date) ; } |
| 4091 | | - my $year = $date ; |
| 4092 | | - $year =~ s/.*\///g ; # delete dd mm/mm dd |
| 4093 | | - my $fraction = (&DaysFrom1800 ($date) - &DaysFrom1800 ("01/01/" . $year)) / 365.25 ; |
| 4094 | | - return ($year + $fraction) ; |
| | 4562 | +sub DateToFloat { |
| | 4563 | + my $date = shift; |
| | 4564 | + if ($DateFormat !~ /\//) { return ($date); } |
| | 4565 | + my $year = $date; |
| | 4566 | + $year =~ s/.*\///g; # delete dd mm/mm dd |
| | 4567 | + my $fraction = |
| | 4568 | + (&DaysFrom1800($date) - &DaysFrom1800("01/01/" . $year)) / 365.25; |
| | 4569 | + return ($year + $fraction); |
| 4095 | 4570 | } |
| 4096 | 4571 | |
| 4097 | | -sub DateFrom1800 |
| 4098 | | -{ |
| 4099 | | - my $days = shift ; |
| | 4572 | +sub DateFrom1800 { |
| | 4573 | + my $days = shift; |
| 4100 | 4574 | |
| 4101 | | - @mmm = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) ; |
| | 4575 | + @mmm = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); |
| 4102 | 4576 | |
| 4103 | | - $year = 1800 ; |
| 4104 | | - while ($days > 365 + (($year % 4) == 0)) |
| 4105 | | - { |
| 4106 | | - if ((($year % 4) == 0) && (($year % 100) != 0)) |
| 4107 | | - { $days -= 366 ; } |
| 4108 | | - else |
| 4109 | | - { $days -= 365 ; } |
| 4110 | | - $year ++ ; |
| 4111 | | - } |
| | 4577 | + $year = 1800; |
| | 4578 | + while ($days > 365 + (($year % 4) == 0)) { |
| | 4579 | + if ((($year % 4) == 0) && (($year % 100) != 0)) { $days -= 366; } |
| | 4580 | + else { $days -= 365; } |
| | 4581 | + $year++; |
| | 4582 | + } |
| 4112 | 4583 | |
| 4113 | | - $month = 0 ; |
| 4114 | | - while ($days > @mmm [$month]) |
| 4115 | | - { |
| 4116 | | - $days -= @mmm [$month] ; |
| 4117 | | - if ($month == 1) |
| 4118 | | - { |
| 4119 | | - if ((($year % 4) == 0) && (($year % 100) != 0)) |
| 4120 | | - { $days -- ; } ; |
| | 4584 | + $month = 0; |
| | 4585 | + while ($days > @mmm[$month]) { |
| | 4586 | + $days -= @mmm[$month]; |
| | 4587 | + if ($month == 1) { |
| | 4588 | + if ((($year % 4) == 0) && (($year % 100) != 0)) { $days--; } |
| | 4589 | + } |
| | 4590 | + $month++; |
| 4121 | 4591 | } |
| 4122 | | - $month++ ; |
| 4123 | | - } |
| 4124 | | - $day = $days ; |
| | 4592 | + $day = $days; |
| 4125 | 4593 | |
| 4126 | | - $month ++ ; |
| 4127 | | - if ($DateFormat eq "dd/mm/yyyy") |
| 4128 | | - { $date = sprintf ("%02d/%02d/%04d", $day, $month, $year) ; } |
| 4129 | | - else |
| 4130 | | - { $date = sprintf ("%02d/%02d/%04d", $month, $day, $year) ; } |
| | 4594 | + $month++; |
| | 4595 | + if ($DateFormat eq "dd/mm/yyyy") { |
| | 4596 | + $date = sprintf("%02d/%02d/%04d", $day, $month, $year); |
| | 4597 | + } |
| | 4598 | + else { $date = sprintf("%02d/%02d/%04d", $month, $day, $year); } |
| 4131 | 4599 | |
| 4132 | | - return ($date) ; |
| | 4600 | + return ($date); |
| 4133 | 4601 | } |
| 4134 | 4602 | |
| 4135 | | -sub ExtractText |
| 4136 | | -{ |
| 4137 | | - my $data = shift ; |
| 4138 | | - my $data2 = $data ; |
| 4139 | | - my $text = "" ; |
| | 4603 | +sub ExtractText { |
| | 4604 | + my $data = shift; |
| | 4605 | + my $data2 = $data; |
| | 4606 | + my $text = ""; |
| 4140 | 4607 | |
| 4141 | | - # special case: allow embedded spaces when 'text' is last attribute |
| 4142 | | -# $data2 =~ s/\:\:/\@\#\!/g ; |
| 4143 | | - if ($data2 =~ /text\:[^\:]+$/) |
| 4144 | | - { |
| 4145 | | - $text = $data2 ; |
| 4146 | | - $text =~ s/^.*?text\:// ; |
| 4147 | | -# $text =~ s/^\s(.*?)\s*$/$1/ ; ?? -> |
| 4148 | | - $text =~ s/^(.*?)\s*$/$1/ ; |
| 4149 | | - $text =~ s/\\n/\n/g ; |
| 4150 | | - $text =~ s/\"\"/\@\#\$/g ; |
| 4151 | | - $text =~ s/\"//g ; |
| 4152 | | - $text =~ s/\@\#\$/"/g ; |
| 4153 | | - $data2 =~ s/text\:.*$// ; |
| 4154 | | - } |
| | 4608 | + # special case: allow embedded spaces when 'text' is last attribute |
| | 4609 | + # $data2 =~ s/\:\:/\@\#\!/g ; |
| | 4610 | + if ($data2 =~ /text\:[^\:]+$/) { |
| | 4611 | + $text = $data2; |
| | 4612 | + $text =~ s/^.*?text\://; |
| 4155 | 4613 | |
| 4156 | | - # extract text between double quotes |
| 4157 | | - $data2 =~ s/\"\"/\@\#\$/g ; |
| 4158 | | - if ($data2 =~ /text\:\s*\"/) |
| 4159 | | - { |
| 4160 | | - $text = $data2 ; |
| 4161 | | - $text =~ s/^.*?text\:\s*\"// ; |
| | 4614 | + # $text =~ s/^\s(.*?)\s*$/$1/ ; ?? -> |
| | 4615 | + $text =~ s/^(.*?)\s*$/$1/; |
| | 4616 | + $text =~ s/\\n/\n/g; |
| | 4617 | + $text =~ s/\"\"/\@\#\$/g; |
| | 4618 | + $text =~ s/\"//g; |
| | 4619 | + $text =~ s/\@\#\$/"/g; |
| | 4620 | + $data2 =~ s/text\:.*$//; |
| | 4621 | + } |
| 4162 | 4622 | |
| 4163 | | - if (! ($text =~ /\"/)) |
| 4164 | | - { &Error ("PlotData invalid. Attribute 'text': no closing \" found.") ; |
| 4165 | | - return ("x", "x") ; } |
| | 4623 | + # extract text between double quotes |
| | 4624 | + $data2 =~ s/\"\"/\@\#\$/g; |
| | 4625 | + if ($data2 =~ /text\:\s*\"/) { |
| | 4626 | + $text = $data2; |
| | 4627 | + $text =~ s/^.*?text\:\s*\"//; |
| 4166 | 4628 | |
| 4167 | | - $text =~ s/\".*$//; |
| 4168 | | - $text =~ s/\@\#\$/"/g ; |
| 4169 | | - $text =~ s/\\n/\n/g ; |
| 4170 | | - } |
| 4171 | | - $data2 =~ s/text\:\s*\"[^\"]*\"// ; |
| 4172 | | - $data2 =~ s/\@\#\$/"/g ; |
| 4173 | | - return ($data2, $text) ; |
| | 4629 | + if (!($text =~ /\"/)) { |
| | 4630 | + &Error( |
| | 4631 | + "PlotData invalid. Attribute 'text': no closing \" found."); |
| | 4632 | + return ("x", "x"); |
| | 4633 | + } |
| | 4634 | + |
| | 4635 | + $text =~ s/\".*$//; |
| | 4636 | + $text =~ s/\@\#\$/"/g; |
| | 4637 | + $text =~ s/\\n/\n/g; |
| | 4638 | + } |
| | 4639 | + $data2 =~ s/text\:\s*\"[^\"]*\"//; |
| | 4640 | + $data2 =~ s/\@\#\$/"/g; |
| | 4641 | + return ($data2, $text); |
| 4174 | 4642 | } |
| 4175 | 4643 | |
| 4176 | | -sub ParseText |
| 4177 | | -{ |
| 4178 | | - my $text = shift ; |
| 4179 | | - $text =~ s/\_\_/\@\#\$/g ; |
| 4180 | | - $text =~ s/\_/ /g ; |
| 4181 | | - $text =~ s/\@\#\$/_/g ; |
| | 4644 | +sub ParseText { |
| | 4645 | + my $text = shift; |
| | 4646 | + $text =~ s/\_\_/\@\#\$/g; |
| | 4647 | + $text =~ s/\_/ /g; |
| | 4648 | + $text =~ s/\@\#\$/_/g; |
| 4182 | 4649 | |
| 4183 | | - $text =~ s/\~\~/\@\#\$/g ; |
| 4184 | | - $text =~ s/\~/\\n/g ; |
| 4185 | | - $text =~ s/\@\#\$/~/g ; |
| | 4650 | + $text =~ s/\~\~/\@\#\$/g; |
| | 4651 | + $text =~ s/\~/\\n/g; |
| | 4652 | + $text =~ s/\@\#\$/~/g; |
| 4186 | 4653 | |
| 4187 | | - return ($text) ; |
| | 4654 | + return ($text); |
| 4188 | 4655 | } |
| 4189 | 4656 | |
| 4190 | | -sub BarDefined |
| 4191 | | -{ |
| 4192 | | - my $bar = shift ; |
| 4193 | | - foreach $bar2 (@Bars) |
| 4194 | | - { |
| 4195 | | - if (lc ($bar2) eq lc ($bar)) |
| 4196 | | - { return ($true) ; } |
| 4197 | | - } |
| | 4657 | +sub BarDefined { |
| | 4658 | + my $bar = shift; |
| | 4659 | + foreach $bar2 (@Bars) { |
| | 4660 | + if (lc($bar2) eq lc($bar)) { return ($true); } |
| | 4661 | + } |
| 4198 | 4662 | |
| 4199 | | -# not part of barset ? return |
| 4200 | | - if ($bar != /\#\d+$/) |
| 4201 | | - { return ($false) ; } |
| | 4663 | + # not part of barset ? return |
| | 4664 | + if ($bar != /\#\d+$/) { return ($false); } |
| 4202 | 4665 | |
| 4203 | | -# find previous bar in barset |
| 4204 | | - my $barcnt = $bar ; |
| 4205 | | - my $barid = $bar ; |
| 4206 | | - $barcnt =~ s/.*\#(\d+$)/$1/ ; |
| 4207 | | - $barid =~ s/(.*\#)\d+$/$1/ ; |
| 4208 | | - $barcnt -- ; |
| 4209 | | - $a = $#Bars ; |
| 4210 | | - for (my $b = 0 ; $b <= $#Bars ; $b++) |
| 4211 | | - { |
| 4212 | | - if (lc (@Bars [$b]) eq lc ($barid . $barcnt)) |
| 4213 | | - { |
| 4214 | | - $b++ ; |
| 4215 | | - for (my $b2 = $#Bars + 1 ; $b2 > $b ; $b2--) |
| 4216 | | - { @Bars [$b2] = @Bars [$b2-1]; } |
| 4217 | | - @Bars [$b] = lc ($bar) ; |
| 4218 | | - @BarLegend {lc ($bar)} = " " ; |
| 4219 | | - return ($true) ; |
| | 4666 | + # find previous bar in barset |
| | 4667 | + my $barcnt = $bar; |
| | 4668 | + my $barid = $bar; |
| | 4669 | + $barcnt =~ s/.*\#(\d+$)/$1/; |
| | 4670 | + $barid =~ s/(.*\#)\d+$/$1/; |
| | 4671 | + $barcnt--; |
| | 4672 | + $a = $#Bars; |
| | 4673 | + for (my $b = 0; $b <= $#Bars; $b++) { |
| | 4674 | + if (lc(@Bars[$b]) eq lc($barid . $barcnt)) { |
| | 4675 | + $b++; |
| | 4676 | + for (my $b2 = $#Bars + 1; $b2 > $b; $b2--) { |
| | 4677 | + @Bars[$b2] = @Bars[ $b2 - 1 ]; |
| | 4678 | + } |
| | 4679 | + @Bars[$b] = lc($bar); |
| | 4680 | + @BarLegend{ lc($bar) } = " "; |
| | 4681 | + return ($true); |
| | 4682 | + } |
| 4220 | 4683 | } |
| 4221 | | - } |
| 4222 | | - return ($false) ; |
| | 4684 | + return ($false); |
| 4223 | 4685 | } |
| 4224 | 4686 | |
| 4225 | | -sub ValidAttributes |
| 4226 | | -{ |
| 4227 | | - my $command = shift ; |
| | 4687 | +sub ValidAttributes { |
| | 4688 | + my $command = shift; |
| 4228 | 4689 | |
| 4229 | | - if ($command =~ /^BackgroundColors$/i) |
| 4230 | | - { return (CheckAttributes ($command, "", "canvas,bars")) ; } |
| | 4690 | + if ($command =~ /^BackgroundColors$/i) { |
| | 4691 | + return (CheckAttributes($command, "", "canvas,bars")); |
| | 4692 | + } |
| 4231 | 4693 | |
| 4232 | | - if ($command =~ /^BarData$/i) |
| 4233 | | -# { return (CheckAttributes ($command, "", "bar,barset,barcount,link,text")) ; } |
| 4234 | | - { return (CheckAttributes ($command, "", "bar,barset,link,text")) ; } |
| | 4694 | + if ($command =~ /^BarData$/i) |
| 4235 | 4695 | |
| 4236 | | - if ($command =~ /^Colors$/i) |
| 4237 | | - { return (CheckAttributes ($command, "id,value", "legend")) ; } |
| | 4696 | + # { return (CheckAttributes ($command, "", "bar,barset,barcount,link,text")) ; } |
| | 4697 | + { |
| | 4698 | + return (CheckAttributes($command, "", "bar,barset,link,text")); |
| | 4699 | + } |
| 4238 | 4700 | |
| 4239 | | - if ($command =~ /^ImageSize$/i) |
| 4240 | | - { return (CheckAttributes ($command, "", "width,height,barincrement")) ; } |
| | 4701 | + if ($command =~ /^Colors$/i) { |
| | 4702 | + return (CheckAttributes($command, "id,value", "legend")); |
| | 4703 | + } |
| 4241 | 4704 | |
| 4242 | | - if ($command =~ /^Legend$/i) |
| 4243 | | - { return (CheckAttributes ($command, "", "columns,columnwidth,orientation,position,left,top")) ; } |
| | 4705 | + if ($command =~ /^ImageSize$/i) { |
| | 4706 | + return (CheckAttributes($command, "", "width,height,barincrement")); |
| | 4707 | + } |
| 4244 | 4708 | |
| 4245 | | - if ($command =~ /^LineData$/i) |
| 4246 | | - { return (CheckAttributes ($command, "", "at,from,till,atpos,frompos,tillpos,points,color,layer,width")) ; } |
| | 4709 | + if ($command =~ /^Legend$/i) { |
| | 4710 | + return ( |
| | 4711 | + CheckAttributes( |
| | 4712 | + $command, "", |
| | 4713 | + "columns,columnwidth,orientation,position,left,top" |
| | 4714 | + ) |
| | 4715 | + ); |
| | 4716 | + } |
| 4247 | 4717 | |
| 4248 | | - if ($command =~ /^Period$/i) |
| 4249 | | - { return (CheckAttributes ($command, "from,till", "")) ; } |
| | 4718 | + if ($command =~ /^LineData$/i) { |
| | 4719 | + return ( |
| | 4720 | + CheckAttributes( |
| | 4721 | + $command, |
| | 4722 | + "", |
| | 4723 | + "at,from,till,atpos,frompos,tillpos,points,color,layer,width" |
| | 4724 | + ) |
| | 4725 | + ); |
| | 4726 | + } |
| 4250 | 4727 | |
| 4251 | | - if ($command =~ /^PlotArea$/i) |
| 4252 | | - { return (CheckAttributes ($command, "", "left,bottom,width,height,right,top")) ; } |
| | 4728 | + if ($command =~ /^Period$/i) { |
| | 4729 | + return (CheckAttributes($command, "from,till", "")); |
| | 4730 | + } |
| 4253 | 4731 | |
| 4254 | | - if ($command =~ /^PlotData$/i) |
| 4255 | | - { return (CheckAttributes ($command, "", "align,anchor,at,bar,barset,color,fontsize,from,link,mark,shift,text,textcolor,till,width")) ; } |
| | 4732 | + if ($command =~ /^PlotArea$/i) { |
| | 4733 | + return ( |
| | 4734 | + CheckAttributes( |
| | 4735 | + $command, "", "left,bottom,width,height,right,top" |
| | 4736 | + ) |
| | 4737 | + ); |
| | 4738 | + } |
| 4256 | 4739 | |
| 4257 | | - if ($command =~ /^Scale/i) |
| 4258 | | - { return (CheckAttributes ($command, "increment,start", "unit,grid,gridcolor,text")) ; } |
| | 4740 | + if ($command =~ /^PlotData$/i) { |
| | 4741 | + return ( |
| | 4742 | + CheckAttributes( |
| | 4743 | + $command, |
| | 4744 | + "", |
| | 4745 | + "align,anchor,at,bar,barset,color,fontsize,from,link,mark,shift,text,textcolor,till,width" |
| | 4746 | + ) |
| | 4747 | + ); |
| | 4748 | + } |
| 4259 | 4749 | |
| 4260 | | - if ($command =~ /^TextData$/i) |
| 4261 | | - { return (CheckAttributes ($command, "", "fontsize,lineheight,link,pos,tabs,text,textcolor")) ; } |
| | 4750 | + if ($command =~ /^Scale/i) { |
| | 4751 | + return ( |
| | 4752 | + CheckAttributes( |
| | 4753 | + $command, "increment,start", "unit,grid,gridcolor,text" |
| | 4754 | + ) |
| | 4755 | + ); |
| | 4756 | + } |
| 4262 | 4757 | |
| 4263 | | - if ($command =~ /^TimeAxis$/i) |
| 4264 | | - { return (CheckAttributes ($command, "", "orientation,format,order")) ; } |
| | 4758 | + if ($command =~ /^TextData$/i) { |
| | 4759 | + return ( |
| | 4760 | + CheckAttributes( |
| | 4761 | + $command, "", |
| | 4762 | + "fontsize,lineheight,link,pos,tabs,text,textcolor" |
| | 4763 | + ) |
| | 4764 | + ); |
| | 4765 | + } |
| 4265 | 4766 | |
| 4266 | | - return ($true) ; |
| | 4767 | + if ($command =~ /^TimeAxis$/i) { |
| | 4768 | + return (CheckAttributes($command, "", "orientation,format,order")); |
| | 4769 | + } |
| | 4770 | + |
| | 4771 | + return ($true); |
| 4267 | 4772 | } |
| 4268 | 4773 | |
| 4269 | | -sub CheckAttributes |
| 4270 | | -{ |
| 4271 | | - my $name = shift ; |
| 4272 | | - my @Required = split (",", shift) ; |
| 4273 | | - my @Allowed = split (",", shift) ; |
| | 4774 | +sub CheckAttributes { |
| | 4775 | + my $name = shift; |
| | 4776 | + my @Required = split(",", shift); |
| | 4777 | + my @Allowed = split(",", shift); |
| 4274 | 4778 | |
| 4275 | | - my $attribute ; |
| 4276 | | - my %Attributes2 = %Attributes ; |
| | 4779 | + my $attribute; |
| | 4780 | + my %Attributes2 = %Attributes; |
| 4277 | 4781 | |
| 4278 | | - $hint = "\nSyntax: '$name =" ; |
| 4279 | | - foreach $attribute (@Required) |
| 4280 | | - { $hint .= " $attribute:.." ; } |
| 4281 | | - foreach $attribute (@Allowed) |
| 4282 | | - { $hint .= " [$attribute:..]" ; } |
| 4283 | | - $hint .= "'" ; |
| | 4782 | + $hint = "\nSyntax: '$name ="; |
| | 4783 | + foreach $attribute (@Required) { $hint .= " $attribute:.."; } |
| | 4784 | + foreach $attribute (@Allowed) { $hint .= " [$attribute:..]"; } |
| | 4785 | + $hint .= "'"; |
| 4284 | 4786 | |
| 4285 | | - foreach $attribute (@Required) |
| 4286 | | - { |
| 4287 | | - if ((! defined (@Attributes {$attribute})) || (@Attributes {$attribute} eq "")) |
| 4288 | | - { &Error ("$name definition incomplete. $hint") ; |
| 4289 | | - undef (@Attributes) ; return ($false) ; } |
| 4290 | | - delete (@Attributes2 {$attribute}) ; |
| 4291 | | - } |
| 4292 | | - foreach $attribute (@Allowed) |
| 4293 | | - { delete (@Attributes2 {$attribute}) ; } |
| | 4787 | + foreach $attribute (@Required) { |
| | 4788 | + if ( (!defined(@Attributes{$attribute})) |
| | 4789 | + || (@Attributes{$attribute} eq "")) |
| | 4790 | + { |
| | 4791 | + &Error("$name definition incomplete. $hint"); |
| | 4792 | + undef(@Attributes); |
| | 4793 | + return ($false); |
| | 4794 | + } |
| | 4795 | + delete(@Attributes2{$attribute}); |
| | 4796 | + } |
| | 4797 | + foreach $attribute (@Allowed) { delete(@Attributes2{$attribute}); } |
| 4294 | 4798 | |
| 4295 | | - @AttrKeys = keys %Attributes2 ; |
| 4296 | | - if ($#AttrKeys >= 0) |
| 4297 | | - { |
| 4298 | | - if (@AttrKeys [0] eq "single") |
| 4299 | | - { &Error ("$name definition invalid. Specify all attributes as name:value pairs.") ; } |
| 4300 | | - else |
| 4301 | | - { &Error ("$name definition invalid. Invalid attribute '" . @AttrKeys [0] . "' found. $hint") ; } |
| 4302 | | - undef (@Attributes) ; return ($false) ; } |
| | 4799 | + @AttrKeys = keys %Attributes2; |
| | 4800 | + if ($#AttrKeys >= 0) { |
| | 4801 | + if (@AttrKeys[0] eq "single") { |
| | 4802 | + &Error( |
| | 4803 | + "$name definition invalid. Specify all attributes as name:value pairs." |
| | 4804 | + ); |
| | 4805 | + } |
| | 4806 | + else { |
| | 4807 | + &Error( "$name definition invalid. Invalid attribute '" |
| | 4808 | + . @AttrKeys[0] |
| | 4809 | + . "' found. $hint"); |
| | 4810 | + } |
| | 4811 | + undef(@Attributes); |
| | 4812 | + return ($false); |
| | 4813 | + } |
| 4303 | 4814 | |
| 4304 | | - return ($true) ; |
| | 4815 | + return ($true); |
| 4305 | 4816 | } |
| 4306 | 4817 | |
| 4307 | | -sub CheckPreset |
| 4308 | | -{ |
| 4309 | | - my $command = shift ; |
| 4310 | | - my ($preset, $action, $attrname, $attrvalue) ; |
| | 4818 | +sub CheckPreset { |
| | 4819 | + my $command = shift; |
| | 4820 | + my ($preset, $action, $attrname, $attrvalue); |
| 4311 | 4821 | |
| 4312 | | - my $newcommand = $true ; |
| 4313 | | - my $addvalue = $true ; |
| 4314 | | - if ($command =~ /^$prevcommand$/i) |
| 4315 | | - { $newcommand = $false ; } |
| 4316 | | - if ((! $newcommand) && ($command =~ /^(?:DrawLines|PlotData|TextData)$/i)) |
| 4317 | | - { $addvalue = $false ; } |
| 4318 | | - $prevcommand = $command ; |
| 4319 | | - |
| 4320 | | - foreach $preset (@PresetList) |
| 4321 | | - { |
| 4322 | | - if ($preset =~ /^$command\|/i) |
| | 4822 | + my $newcommand = $true; |
| | 4823 | + my $addvalue = $true; |
| | 4824 | + if ($command =~ /^$prevcommand$/i) { $newcommand = $false; } |
| | 4825 | + if ((!$newcommand) && ($command =~ /^(?:DrawLines|PlotData|TextData)$/i)) |
| 4323 | 4826 | { |
| 4324 | | - ($command, $action, $attrname, $attrpreset) = split ('\|', $preset) ; |
| 4325 | | - if ($attrname eq "") |
| 4326 | | - { $attrname = "single" ; } |
| | 4827 | + $addvalue = $false; |
| | 4828 | + } |
| | 4829 | + $prevcommand = $command; |
| 4327 | 4830 | |
| 4328 | | - $attrvalue = @Attributes {$attrname} ; |
| | 4831 | + foreach $preset (@PresetList) { |
| | 4832 | + if ($preset =~ /^$command\|/i) { |
| | 4833 | + ($command, $action, $attrname, $attrpreset) = |
| | 4834 | + split('\|', $preset); |
| | 4835 | + if ($attrname eq "") { $attrname = "single"; } |
| 4329 | 4836 | |
| 4330 | | - if (($action eq "-") && ($attrvalue ne "")) |
| 4331 | | - { |
| 4332 | | - if ($attrname eq "single") |
| 4333 | | - { &Error ("Chosen preset makes this command redundant.\n" . |
| 4334 | | - " Please remove this command.") ; } |
| 4335 | | - else |
| 4336 | | - { &Error ("Chosen preset conflicts with '$attrname:...'.\n" . |
| 4337 | | - " Please remove this attribute.") ; } |
| 4338 | | - @Attributes {$attrname} = "" ; |
| 4339 | | - } |
| | 4837 | + $attrvalue = @Attributes{$attrname}; |
| 4340 | 4838 | |
| 4341 | | - if (($action eq "+") && ($attrvalue eq "")) |
| 4342 | | - { |
| 4343 | | - if ($addvalue) |
| 4344 | | - { @Attributes {$attrname} = $attrpreset ; } |
| 4345 | | - } |
| | 4839 | + if (($action eq "-") && ($attrvalue ne "")) { |
| | 4840 | + if ($attrname eq "single") { |
| | 4841 | + &Error( "Chosen preset makes this command redundant.\n" |
| | 4842 | + . " Please remove this command."); |
| | 4843 | + } |
| | 4844 | + else { |
| | 4845 | + &Error("Chosen preset conflicts with '$attrname:...'.\n" |
| | 4846 | + . " Please remove this attribute."); |
| | 4847 | + } |
| | 4848 | + @Attributes{$attrname} = ""; |
| | 4849 | + } |
| 4346 | 4850 | |
| 4347 | | - if (($action eq "=") && ($attrvalue eq "")) |
| 4348 | | - { @Attributes {$attrname} = $attrpreset ; } |
| | 4851 | + if (($action eq "+") && ($attrvalue eq "")) { |
| | 4852 | + if ($addvalue) { @Attributes{$attrname} = $attrpreset; } |
| | 4853 | + } |
| 4349 | 4854 | |
| 4350 | | - if (($action eq "=") && ($attrvalue ne "") && |
| 4351 | | - ($attrvalue !~ /$attrpreset/i)) |
| 4352 | | - { |
| 4353 | | - if ($attrname eq "single") |
| 4354 | | - { &Error ("Conflicting settings.\nPreset defines '$attrpreset'.") ; } |
| 4355 | | - else |
| 4356 | | - { &Error ("Conflicting settings.\nPreset defines '$attrname:$attrpreset'.") ; } |
| 4357 | | - @Attributes {$attrname} = $attrpreset ; |
| 4358 | | - } |
| | 4855 | + if (($action eq "=") && ($attrvalue eq "")) { |
| | 4856 | + @Attributes{$attrname} = $attrpreset; |
| | 4857 | + } |
| | 4858 | + |
| | 4859 | + if ( ($action eq "=") |
| | 4860 | + && ($attrvalue ne "") |
| | 4861 | + && ($attrvalue !~ /$attrpreset/i)) |
| | 4862 | + { |
| | 4863 | + if ($attrname eq "single") { |
| | 4864 | + &Error( |
| | 4865 | + "Conflicting settings.\nPreset defines '$attrpreset'." |
| | 4866 | + ); |
| | 4867 | + } |
| | 4868 | + else { |
| | 4869 | + &Error( |
| | 4870 | + "Conflicting settings.\nPreset defines '$attrname:$attrpreset'." |
| | 4871 | + ); |
| | 4872 | + } |
| | 4873 | + @Attributes{$attrname} = $attrpreset; |
| | 4874 | + } |
| | 4875 | + } |
| 4359 | 4876 | } |
| 4360 | | - } |
| 4361 | 4877 | } |
| 4362 | 4878 | |
| 4363 | | -sub ShiftOnePixelForSVG |
| 4364 | | -{ |
| 4365 | | - my $line = shift ; |
| 4366 | | - $line =~ s/location:\s*// ; |
| 4367 | | - my ($posx, $posy) = split (" ", $line) ; |
| | 4879 | +sub ShiftOnePixelForSVG { |
| | 4880 | + my $line = shift; |
| | 4881 | + $line =~ s/location:\s*//; |
| | 4882 | + my ($posx, $posy) = split(" ", $line); |
| 4368 | 4883 | |
| 4369 | | - if ($posy =~ /\+/) |
| 4370 | | - { ($posy1, $posy2) = split ('\+', $posy) ; } |
| 4371 | | - elsif ($posy =~ /.+\-/) |
| 4372 | | - { |
| 4373 | | - if ($posy =~ /^\-/) |
| 4374 | | - { |
| 4375 | | - ($sign, $posy1, $posy2) = split ('\-', $posy) ; $posy2 = - $posy2 ; |
| 4376 | | - $posy1 = "-" . $posy1 ; |
| | 4884 | + if ($posy =~ /\+/) { ($posy1, $posy2) = split('\+', $posy); } |
| | 4885 | + elsif ($posy =~ /.+\-/) { |
| | 4886 | + if ($posy =~ /^\-/) { |
| | 4887 | + ($sign, $posy1, $posy2) = split('\-', $posy); |
| | 4888 | + $posy2 = -$posy2; |
| | 4889 | + $posy1 = "-" . $posy1; |
| | 4890 | + } |
| | 4891 | + else { ($posy1, $posy2) = split('\-', $posy); $posy2 = -$posy2 } |
| 4377 | 4892 | } |
| 4378 | | - else |
| 4379 | | - { ($posy1, $posy2) = split ('\-', $posy) ; $posy2 = - $posy2 } |
| 4380 | | - } |
| 4381 | | - else |
| 4382 | | - { $posy1 = $posy ; $posy2 = 0 ; } |
| | 4893 | + else { $posy1 = $posy; $posy2 = 0; } |
| 4383 | 4894 | |
| 4384 | | - if ($posy1 !~ /(s)/) |
| 4385 | | - { $posy += 0.01 ; } |
| 4386 | | - else |
| 4387 | | - { |
| 4388 | | - $posy2 += 0.01 ; |
| 4389 | | - if ($posy2 == 0) |
| 4390 | | - { $posy = $posy1 ; } |
| 4391 | | - elsif ($posy2 < 0) |
| 4392 | | - { $posy = $posy1 . "$posy2" ; } |
| 4393 | | - else |
| 4394 | | - { $posy = $posy1 . "+" . $posy2 ; } |
| 4395 | | - } |
| | 4895 | + if ($posy1 !~ /(s)/) { $posy += 0.01; } |
| | 4896 | + else { |
| | 4897 | + $posy2 += 0.01; |
| | 4898 | + if ($posy2 == 0) { $posy = $posy1; } |
| | 4899 | + elsif ($posy2 < 0) { $posy = $posy1 . "$posy2"; } |
| | 4900 | + else { $posy = $posy1 . "+" . $posy2; } |
| | 4901 | + } |
| 4396 | 4902 | |
| 4397 | | - $line = "\n location: $posx $posy" ; |
| 4398 | | - return ($line) ; |
| | 4903 | + $line = "\n location: $posx $posy"; |
| | 4904 | + return ($line); |
| 4399 | 4905 | } |
| 4400 | 4906 | |
| 4401 | | -sub NormalizeURL |
| 4402 | | -{ |
| 4403 | | - my $url = shift ; |
| 4404 | | - $url =~ s/(https?)\:?\/?\/?/$1:\/\// ; # add possibly missing special characters |
| 4405 | | - $url =~ s/ /%20/g ; |
| 4406 | | - return ($url) ; |
| | 4907 | +sub NormalizeURL { |
| | 4908 | + my $url = shift; |
| | 4909 | + $url =~ s/(https?)\:?\/?\/?/$1:\/\// |
| | 4910 | + ; # add possibly missing special characters |
| | 4911 | + $url =~ s/ /%20/g; |
| | 4912 | + return ($url); |
| 4407 | 4913 | } |
| 4408 | 4914 | |
| 4409 | 4915 | # wiki style link may include linebreak characters -> split into several wiki links |
| 4410 | | -sub NormalizeWikiLink |
| 4411 | | -{ |
| 4412 | | - my $text = shift ; |
| | 4916 | +sub NormalizeWikiLink { |
| | 4917 | + my $text = shift; |
| 4413 | 4918 | |
| 4414 | | - my $brdouble = $false ; |
| 4415 | | - if ($text =~ /\[\[.*\]\]/) |
| 4416 | | - { $brdouble = $true ; } |
| | 4919 | + my $brdouble = $false; |
| | 4920 | + if ($text =~ /\[\[.*\]\]/) { $brdouble = $true; } |
| 4417 | 4921 | |
| 4418 | | - $text =~ s/\[\[?// ; |
| 4419 | | - $text =~ s/\]?\]// ; |
| | 4922 | + $text =~ s/\[\[?//; |
| | 4923 | + $text =~ s/\]?\]//; |
| 4420 | 4924 | |
| 4421 | | - my ($hide,$show) = split ('\|', $text) ; |
| 4422 | | - if ($show eq "") |
| 4423 | | - { $show = $hide ; } |
| 4424 | | - $hide =~ s/\s*\n\s*/ /g ; |
| | 4925 | + my ($hide, $show) = split('\|', $text); |
| | 4926 | + if ($show eq "") { $show = $hide; } |
| | 4927 | + $hide =~ s/\s*\n\s*/ /g; |
| 4425 | 4928 | |
| 4426 | | - my @Show = split ("\n", $show) ; |
| 4427 | | - $text = "" ; |
| 4428 | | - foreach $part (@Show) |
| 4429 | | - { |
| 4430 | | - if ($brdouble) |
| 4431 | | - { $part = "[[" . $hide . "|" . $part . "]]" ; } |
| 4432 | | - else |
| 4433 | | - { $part = "[" . $hide . "|" . $part . "]" ; } |
| 4434 | | - } |
| 4435 | | - $text = join ("\n", @Show) ; |
| | 4929 | + my @Show = split("\n", $show); |
| | 4930 | + $text = ""; |
| | 4931 | + foreach $part (@Show) { |
| | 4932 | + if ($brdouble) { $part = "[[" . $hide . "|" . $part . "]]"; } |
| | 4933 | + else { $part = "[" . $hide . "|" . $part . "]"; } |
| | 4934 | + } |
| | 4935 | + $text = join("\n", @Show); |
| 4436 | 4936 | |
| 4437 | | - return ($text) ; |
| | 4937 | + return ($text); |
| 4438 | 4938 | } |
| 4439 | 4939 | |
| 4440 | | -sub ProcessWikiLink |
| 4441 | | -{ |
| 4442 | | - my $text = shift ; |
| 4443 | | - my $link = shift ; |
| 4444 | | - my $hint = shift ; |
| 4445 | | - my $wikilink = $false ; |
| | 4940 | +sub ProcessWikiLink { |
| | 4941 | + my $text = shift; |
| | 4942 | + my $link = shift; |
| | 4943 | + my $hint = shift; |
| | 4944 | + my $wikilink = $false; |
| 4446 | 4945 | |
| 4447 | | - chomp ($text) ; |
| 4448 | | - chomp ($link) ; |
| 4449 | | - chomp ($hint) ; |
| | 4946 | + chomp($text); |
| | 4947 | + chomp($link); |
| | 4948 | + chomp($hint); |
| 4450 | 4949 | |
| 4451 | | - my ($wiki, $title) ; |
| 4452 | | - if ($link ne "") # ignore wiki brackets in text when explicit link is specified |
| 4453 | | - { |
| 4454 | | - $text =~ s/\[\[ [^\|]+ \| (.*) \]\]/$1/gx ; |
| 4455 | | - $text =~ s/\[\[ [^\:]+ \: (.*) \]\]/$1/gx ; |
| 4456 | | -# $text =~ s/\[\[ (.*) \]\]/$1/gx ; |
| 4457 | | - } |
| 4458 | | - else |
| 4459 | | - { |
| 4460 | | - if ($text =~ /\[.+\]/) # keep first link in text segment, remove others |
| | 4950 | + my ($wiki, $title); |
| | 4951 | + if ($link ne |
| | 4952 | + "") # ignore wiki brackets in text when explicit link is specified |
| 4461 | 4953 | { |
| 4462 | | - $link = $text ; |
| 4463 | | - $link =~ s/\n//g ; |
| 4464 | | - $link =~ s/^[^\[\]]*\[/[/x ; |
| | 4954 | + $text =~ s/\[\[ [^\|]+ \| (.*) \]\]/$1/gx; |
| | 4955 | + $text =~ s/\[\[ [^\:]+ \: (.*) \]\]/$1/gx; |
| 4465 | 4956 | |
| 4466 | | - if ($link =~ /^\[\[/) |
| 4467 | | - { $wikilink = $true ; } |
| | 4957 | + # $text =~ s/\[\[ (.*) \]\]/$1/gx ; |
| | 4958 | + } |
| | 4959 | + else { |
| | 4960 | + if ($text =~ |
| | 4961 | + /\[.+\]/) # keep first link in text segment, remove others |
| | 4962 | + { |
| | 4963 | + $link = $text; |
| | 4964 | + $link =~ s/\n//g; |
| | 4965 | + $link =~ s/^[^\[\]]*\[/[/x; |
| 4468 | 4966 | |
| 4469 | | - $link =~ s/^ [^\[]* \[+ ([^\[\]]*) \].*$/$1/x ; |
| 4470 | | - $link =~ s/\|.*$// ; |
| 4471 | | - if ($wikilink) |
| 4472 | | - { $link = "[[" . $link . "]]" ; } |
| | 4967 | + if ($link =~ /^\[\[/) { $wikilink = $true; } |
| 4473 | 4968 | |
| 4474 | | - $text =~ s/(\[+) [^\|\]]+ \| ([^\]]*) (\]+)/$1$2$3/gx ; |
| 4475 | | - $text =~ s/(https?)\:/$1colon/gx ; |
| 4476 | | -# $text =~ s/(\[+) [^\:\]]+ \: ([^\]]*) (\]+)/$1$2$3/gx ; #??? |
| | 4969 | + $link =~ s/^ [^\[]* \[+ ([^\[\]]*) \].*$/$1/x; |
| | 4970 | + $link =~ s/\|.*$//; |
| | 4971 | + if ($wikilink) { $link = "[[" . $link . "]]"; } |
| 4477 | 4972 | |
| 4478 | | - # remove interwiki link prefix |
| 4479 | | - $text =~ s/(\[+) (?:.{2,3}|(?:zh\-.*)|simple|minnan|tokipona) \: ([^\]]*) (\]+)/$1$2$3/gxi ; #??? |
| | 4973 | + $text =~ s/(\[+) [^\|\]]+ \| ([^\]]*) (\]+)/$1$2$3/gx; |
| | 4974 | + $text =~ s/(https?)\:/$1colon/gx; |
| 4480 | 4975 | |
| 4481 | | - $text =~ s/\[+ ([^\]]+) \]+/{{{$1}}}/x ; |
| 4482 | | - $text =~ s/\[+ ([^\]]+) \]+/$1/gx ; |
| 4483 | | - $text =~ s/\{\{\{ ([^\}]*) \}\}\}/[[$1]]/x ; |
| 4484 | | - } |
| 4485 | | -# if ($text =~ /\[\[.+\]\]/) |
| 4486 | | -# { |
| 4487 | | -# $wikilink = $true ; |
| 4488 | | -# $link = $text ; |
| 4489 | | -# $link =~ s/\n//g ; |
| 4490 | | -# $link =~ s/^.*?\[\[/[[/x ; |
| 4491 | | -# $link =~ s/\| .*? \]\].*$/]]/x ; |
| 4492 | | -# $link =~ s/\]\].*$/]]/x ; |
| 4493 | | -# $text =~ s/\[\[ [^\|\]]+ \| (.*?) \]\]/[[$1]]/x ; |
| 4494 | | -# $text =~ s/\[\[ [^\:\]]+ \: (.*?) \]\]/[[$1]]/x ; |
| | 4976 | + # $text =~ s/(\[+) [^\:\]]+ \: ([^\]]*) (\]+)/$1$2$3/gx ; #??? |
| 4495 | 4977 | |
| 4496 | | -# # remove remaining links |
| 4497 | | -# $text =~ s/\[\[ ([^\]]+) \]\]/^%#$1#%^/x ; |
| 4498 | | -# $text =~ s/\[+ ([^\]]+) \]+/$1/gx ; |
| 4499 | | -# $text =~ s/\^$hPerc\# (.*?) \#$hPerc\^/[[$1]]/x ; |
| 4500 | | -# } |
| 4501 | | -# elsif ($text =~ /\[.+\]/) |
| 4502 | | -# { |
| 4503 | | -# $link = $text ; |
| 4504 | | -# $link =~ s/\n//g ; |
| 4505 | | -# $link =~ s/^.*?\[/[/x ; |
| 4506 | | -# $link =~ s/\| .*? \].*$/]/x ; |
| 4507 | | -# $link =~ s/\].*$/]/x ; |
| 4508 | | -# $link =~ s/\[ ([^\]]+) \]/$1/x ; |
| 4509 | | -# $text =~ s/\[ [^\|\]]+ \| (.*?) \]/[[$1]]/x ; |
| | 4978 | + # remove interwiki link prefix |
| | 4979 | + $text =~ |
| | 4980 | + s/(\[+) (?:.{2,3}|(?:zh\-.*)|simple|minnan|tokipona) \: ([^\]]*) (\]+)/$1$2$3/gxi |
| | 4981 | + ; #??? |
| 4510 | 4982 | |
| 4511 | | -# # remove remaining links |
| 4512 | | -# $text =~ s/\[\[ ([^\]]+) \]\]/^%#$1#%^/x ; |
| 4513 | | -# $text =~ s/\[+ ([^\]]+) \]+/$1/gx ; |
| 4514 | | -# $text =~ s/\^$hPerc\# (.*?) \#$hPerc\^/[[$1]]/x ; |
| | 4983 | + $text =~ s/\[+ ([^\]]+) \]+/{{{$1}}}/x; |
| | 4984 | + $text =~ s/\[+ ([^\]]+) \]+/$1/gx; |
| | 4985 | + $text =~ s/\{\{\{ ([^\}]*) \}\}\}/[[$1]]/x; |
| | 4986 | + } |
| | 4987 | + |
| | 4988 | + # if ($text =~ /\[\[.+\]\]/) |
| | 4989 | + # { |
| | 4990 | + # $wikilink = $true ; |
| | 4991 | + # $link = $text ; |
| | 4992 | + # $link =~ s/\n//g ; |
| | 4993 | + # $link =~ s/^.*?\[\[/[[/x ; |
| | 4994 | + # $link =~ s/\| .*? \]\].*$/]]/x ; |
| | 4995 | + # $link =~ s/\]\].*$/]]/x ; |
| | 4996 | + # $text =~ s/\[\[ [^\|\]]+ \| (.*?) \]\]/[[$1]]/x ; |
| | 4997 | + # $text =~ s/\[\[ [^\:\]]+ \: (.*?) \]\]/[[$1]]/x ; |
| | 4998 | + |
| | 4999 | + # # remove remaining links |
| | 5000 | + # $text =~ s/\[\[ ([^\]]+) \]\]/^%#$1#%^/x ; |
| | 5001 | + # $text =~ s/\[+ ([^\]]+) \]+/$1/gx ; |
| | 5002 | + # $text =~ s/\^$hPerc\# (.*?) \#$hPerc\^/[[$1]]/x ; |
| | 5003 | + # } |
| | 5004 | + # elsif ($text =~ /\[.+\]/) |
| | 5005 | + # { |
| | 5006 | + # $link = $text ; |
| | 5007 | + # $link =~ s/\n//g ; |
| | 5008 | + # $link =~ s/^.*?\[/[/x ; |
| | 5009 | + # $link =~ s/\| .*? \].*$/]/x ; |
| | 5010 | + # $link =~ s/\].*$/]/x ; |
| | 5011 | + # $link =~ s/\[ ([^\]]+) \]/$1/x ; |
| | 5012 | + # $text =~ s/\[ [^\|\]]+ \| (.*?) \]/[[$1]]/x ; |
| | 5013 | + |
| | 5014 | + # # remove remaining links |
| | 5015 | + # $text =~ s/\[\[ ([^\]]+) \]\]/^%#$1#%^/x ; |
| | 5016 | + # $text =~ s/\[+ ([^\]]+) \]+/$1/gx ; |
| | 5017 | + # $text =~ s/\^$hPerc\# (.*?) \#$hPerc\^/[[$1]]/x ; |
| 4515 | 5018 | ## $text =~ s/\[\[ (.*) \]\]/$1/gx ; |
| 4516 | | -# } |
| | 5019 | + # } |
| 4517 | 5020 | |
| 4518 | | - } |
| | 5021 | + } |
| 4519 | 5022 | |
| 4520 | | - if ($wikilink) |
| 4521 | | - { |
| 4522 | | -# if ($link =~ /^\[\[.+\:.+\]\]$/) # has a colon in its name |
| 4523 | | - if ($link =~ /^\[\[ (?:.{2,3}|(?:zh\-.*)|simple|minnan|tokipona) \: .+\]\]$/xi) # has a interwiki link prefix |
| 4524 | | - { |
| 4525 | | - # This will fail for all interwiki links other than Wikipedia. |
| 4526 | | - $wiki = lc ($link) ; |
| 4527 | | - $title = $link ; |
| 4528 | | - $wiki =~ s/\[\[([^\:]+)\:.*$/$1/x ; |
| 4529 | | - $title =~ s/^[^\:]+\:(.*)\]\]$/$1/x ; |
| 4530 | | - $title =~ s/ /_/g ; |
| 4531 | | - $link = "http://$wiki.wikipedia.org/wiki/$title" ; |
| 4532 | | - $link = &EncodeURL ($title) ; |
| 4533 | | - if (($hint eq "") && ($title ne "")) |
| 4534 | | - { $hint = "$wiki: $title" ; } |
| | 5023 | + if ($wikilink) { |
| | 5024 | + |
| | 5025 | + # if ($link =~ /^\[\[.+\:.+\]\]$/) # has a colon in its name |
| | 5026 | + if ($link =~ |
| | 5027 | + /^\[\[ (?:.{2,3}|(?:zh\-.*)|simple|minnan|tokipona) \: .+\]\]$/xi |
| | 5028 | + ) # has a interwiki link prefix |
| | 5029 | + { |
| | 5030 | + |
| | 5031 | + # This will fail for all interwiki links other than Wikipedia. |
| | 5032 | + $wiki = lc($link); |
| | 5033 | + $title = $link; |
| | 5034 | + $wiki =~ s/\[\[([^\:]+)\:.*$/$1/x; |
| | 5035 | + $title =~ s/^[^\:]+\:(.*)\]\]$/$1/x; |
| | 5036 | + $title =~ s/ /_/g; |
| | 5037 | + $link = "http://$wiki.wikipedia.org/wiki/$title"; |
| | 5038 | + $link = &EncodeURL($title); |
| | 5039 | + if (($hint eq "") && ($title ne "")) { $hint = "$wiki: $title"; } |
| | 5040 | + } |
| | 5041 | + else { |
| | 5042 | + |
| | 5043 | + # $wiki = "en" ; |
| | 5044 | + $title = $link; |
| | 5045 | + $title =~ s/^\[\[(.*)\]\]$/$1/x; |
| | 5046 | + $title =~ s/ /_/g; |
| | 5047 | + $link = $articlepath; |
| | 5048 | + $urlpart = &EncodeURL($title); |
| | 5049 | + $link =~ s/\$1/$urlpart/; |
| | 5050 | + if (($hint eq "") && ($title ne "")) { $hint = "$title"; } |
| | 5051 | + } |
| | 5052 | + $hint =~ s/_/ /g; |
| 4535 | 5053 | } |
| 4536 | | - else |
| 4537 | | - { |
| 4538 | | - # $wiki = "en" ; |
| 4539 | | - $title = $link ; |
| 4540 | | - $title =~ s/^\[\[(.*)\]\]$/$1/x ; |
| 4541 | | - $title =~ s/ /_/g ; |
| 4542 | | - $link = $articlepath ; |
| 4543 | | - $urlpart = &EncodeURL ($title) ; |
| 4544 | | - $link =~ s/\$1/$urlpart/ ; |
| 4545 | | - if (($hint eq "") && ($title ne "")) |
| 4546 | | - { $hint = "$title" ; } |
| | 5054 | + else { |
| | 5055 | + if ($link ne "") { $hint = &ExternalLinkToHint($link); } |
| 4547 | 5056 | } |
| 4548 | | - $hint =~ s/_/ /g ; |
| 4549 | | - } |
| 4550 | | - else |
| 4551 | | - { |
| 4552 | | - if ($link ne "") |
| 4553 | | - { $hint = &ExternalLinkToHint ($link) ; } |
| 4554 | | - } |
| 4555 | 5057 | |
| 4556 | | - if (($link ne "") && ($text !~ /\[\[/) && ($text !~ /\]\]/)) |
| 4557 | | - { $text = "[[" . $text . "]]" ; } |
| | 5058 | + if (($link ne "") && ($text !~ /\[\[/) && ($text !~ /\]\]/)) { |
| | 5059 | + $text = "[[" . $text . "]]"; |
| | 5060 | + } |
| 4558 | 5061 | |
| 4559 | | - $hint = &EncodeHtml ($hint) ; |
| 4560 | | - return ($text, $link, $hint) ; |
| | 5062 | + $hint = &EncodeHtml($hint); |
| | 5063 | + return ($text, $link, $hint); |
| 4561 | 5064 | } |
| 4562 | 5065 | |
| 4563 | | -sub ExternalLinkToHint |
| 4564 | | -{ |
| 4565 | | - my $hint = shift ; |
| 4566 | | - $hint =~ s/^https?\:?\/?\/?// ; |
| 4567 | | - $hint =~ s/\/.*$// ; |
| 4568 | | - return (&EncodeHtml ($hint . "/..")) ; |
| | 5066 | +sub ExternalLinkToHint { |
| | 5067 | + my $hint = shift; |
| | 5068 | + $hint =~ s/^https?\:?\/?\/?//; |
| | 5069 | + $hint =~ s/\/.*$//; |
| | 5070 | + return (&EncodeHtml($hint . "/..")); |
| 4569 | 5071 | } |
| 4570 | 5072 | |
| 4571 | | -sub EncodeInput |
| 4572 | | -{ |
| 4573 | | - my $text = shift ; |
| 4574 | | - # revert encoding of '<' & '>' by MediaWiki |
| 4575 | | - $text =~ s/\<\;/\</g ; |
| 4576 | | - $text =~ s/\>\;/\>/g ; |
| 4577 | | - $text =~ s/([\`\{\}\%\&\@\$\(\)\;\=])/"%" . sprintf ("%X", ord($1)) . "%";/ge ; |
| 4578 | | - return ($text) ; |
| | 5073 | +sub EncodeInput { |
| | 5074 | + my $text = shift; |
| | 5075 | + |
| | 5076 | + # revert encoding of '<' & '>' by MediaWiki |
| | 5077 | + $text =~ s/\<\;/\</g; |
| | 5078 | + $text =~ s/\>\;/\>/g; |
| | 5079 | + $text =~ |
| | 5080 | + s/([\`\{\}\%\&\@\$\(\)\;\=])/"%" . sprintf ("%X", ord($1)) . "%";/ge; |
| | 5081 | + return ($text); |
| 4579 | 5082 | } |
| 4580 | 5083 | |
| 4581 | | -sub DecodeInput |
| 4582 | | -{ |
| 4583 | | - my $text = shift ; |
| 4584 | | - $text =~ s/\%([0-9A-F]{2})\%/chr(hex($1))/ge ; |
| 4585 | | - return ($text) ; |
| | 5084 | +sub DecodeInput { |
| | 5085 | + my $text = shift; |
| | 5086 | + $text =~ s/\%([0-9A-F]{2})\%/chr(hex($1))/ge; |
| | 5087 | + return ($text); |
| 4586 | 5088 | } |
| 4587 | 5089 | |
| 4588 | | -sub EncodeHtml |
| 4589 | | -{ |
| 4590 | | - my $text = shift ; |
| 4591 | | - $text =~ s/([\<\>\&\'\"])/"\&\#" . ord($1) . "\;"/ge ; |
| 4592 | | - $text =~ s/\n/<br>/g ; |
| 4593 | | - return ($text) ; |
| | 5090 | +sub EncodeHtml { |
| | 5091 | + my $text = shift; |
| | 5092 | + $text =~ s/([\<\>\&\'\"])/"\&\#" . ord($1) . "\;"/ge; |
| | 5093 | + $text =~ s/\n/<br>/g; |
| | 5094 | + return ($text); |
| 4594 | 5095 | } |
| 4595 | 5096 | |
| 4596 | | -sub EncodeURL |
| 4597 | | -{ |
| 4598 | | - my $url = shift ; |
| 4599 | | - # For some reason everything gets run through this weird internal |
| 4600 | | - # encoding that's similar to URL-encoding. Armor against this as well, |
| 4601 | | - # or else adjacent encoded bytes will be corrupted. |
| 4602 | | - $url =~ s/([^0-9a-zA-Z\%\:\/\._])/"%25%".sprintf ("%02X",ord($1))/ge ; |
| 4603 | | - return ($url) ; |
| | 5097 | +sub EncodeURL { |
| | 5098 | + my $url = shift; |
| | 5099 | + |
| | 5100 | + # For some reason everything gets run through this weird internal |
| | 5101 | + # encoding that's similar to URL-encoding. Armor against this as well, |
| | 5102 | + # or else adjacent encoded bytes will be corrupted. |
| | 5103 | + $url =~ s/([^0-9a-zA-Z\%\:\/\._])/"%25%".sprintf ("%02X",ord($1))/ge; |
| | 5104 | + return ($url); |
| 4604 | 5105 | } |
| 4605 | 5106 | |
| 4606 | | -sub Error |
| 4607 | | -{ |
| 4608 | | - my $msg = &DecodeInput(shift) ; |
| 4609 | | - $msg =~ s/\n\s*/\n /g ; # indent consecutive lines |
| | 5107 | +sub Error { |
| | 5108 | + my $msg = &DecodeInput(shift); |
| | 5109 | + $msg =~ s/\n\s*/\n /g; # indent consecutive lines |
| 4610 | 5110 | |
| 4611 | | - $CntErrors++ ; |
| 4612 | | - if (! $listinput) |
| 4613 | | - { push @Errors, "Line $LineNo: " . &DecodeInput($Line) . "\n" ; } |
| 4614 | | - push @Errors, "- $msg\n\n" ; |
| 4615 | | - if ($CntErrors > 10) |
| 4616 | | - { &Abort ("More than 10 errors found") ; } |
| | 5111 | + $CntErrors++; |
| | 5112 | + if (!$listinput) { |
| | 5113 | + push @Errors, "Line $LineNo: " . &DecodeInput($Line) . "\n"; |
| | 5114 | + } |
| | 5115 | + push @Errors, "- $msg\n\n"; |
| | 5116 | + if ($CntErrors > 10) { &Abort("More than 10 errors found"); } |
| 4617 | 5117 | } |
| 4618 | 5118 | |
| 4619 | | -sub Error2 |
| 4620 | | -{ |
| 4621 | | - my $msg = &DecodeInput(shift) ; |
| 4622 | | - $msg =~ s/\n\s*/\n /g ; # indent consecutive lines |
| 4623 | | - $CntErrors++ ; |
| 4624 | | - push @Errors, "- $msg\n" ; |
| | 5119 | +sub Error2 { |
| | 5120 | + my $msg = &DecodeInput(shift); |
| | 5121 | + $msg =~ s/\n\s*/\n /g; # indent consecutive lines |
| | 5122 | + $CntErrors++; |
| | 5123 | + push @Errors, "- $msg\n"; |
| 4625 | 5124 | } |
| 4626 | 5125 | |
| 4627 | | -sub Warning |
| 4628 | | -{ |
| 4629 | | - my $msg = &DecodeInput(shift) ; |
| 4630 | | - $msg =~ s/\n\s*/\n /g ; # indent consecutive lines |
| 4631 | | - if (! $listinput) |
| 4632 | | - { push @Warnings, "Line $LineNo: " . &DecodeInput ($Line) . "\n" ; } |
| 4633 | | - push @Warnings, "- $msg\n\n" ; |
| | 5126 | +sub Warning { |
| | 5127 | + my $msg = &DecodeInput(shift); |
| | 5128 | + $msg =~ s/\n\s*/\n /g; # indent consecutive lines |
| | 5129 | + if (!$listinput) { |
| | 5130 | + push @Warnings, "Line $LineNo: " . &DecodeInput($Line) . "\n"; |
| | 5131 | + } |
| | 5132 | + push @Warnings, "- $msg\n\n"; |
| 4634 | 5133 | } |
| 4635 | 5134 | |
| 4636 | | -sub Warning2 |
| 4637 | | -{ |
| 4638 | | - my $msg = &DecodeInput(shift) ; |
| 4639 | | - $msg =~ s/\n\s*/\n /g ; # indent consecutive lines |
| 4640 | | - push @Warnings, "- $msg\n" ; |
| | 5135 | +sub Warning2 { |
| | 5136 | + my $msg = &DecodeInput(shift); |
| | 5137 | + $msg =~ s/\n\s*/\n /g; # indent consecutive lines |
| | 5138 | + push @Warnings, "- $msg\n"; |
| 4641 | 5139 | } |
| 4642 | 5140 | |
| 4643 | | -sub Info |
| 4644 | | -{ |
| 4645 | | - my $msg = &DecodeInput(shift) ; |
| 4646 | | - $msg =~ s/\n\s*/\n /g ; # indent consecutive lines |
| 4647 | | - if (! $listinput) |
| 4648 | | - { push @Info, "Line $LineNo: " . &DecodeInput ($Line) . "\n" ; } |
| 4649 | | - push @Info, "- $msg\n\n" ; |
| | 5141 | +sub Info { |
| | 5142 | + my $msg = &DecodeInput(shift); |
| | 5143 | + $msg =~ s/\n\s*/\n /g; # indent consecutive lines |
| | 5144 | + if (!$listinput) { |
| | 5145 | + push @Info, "Line $LineNo: " . &DecodeInput($Line) . "\n"; |
| | 5146 | + } |
| | 5147 | + push @Info, "- $msg\n\n"; |
| 4650 | 5148 | } |
| 4651 | 5149 | |
| 4652 | | -sub Info2 |
| 4653 | | -{ |
| 4654 | | - my $msg = &DecodeInput(shift) ; |
| 4655 | | - $msg =~ s/\n\s*/\n /g ; # indent consecutive lines |
| 4656 | | - push @Info, "- $msg\n" ; |
| | 5150 | +sub Info2 { |
| | 5151 | + my $msg = &DecodeInput(shift); |
| | 5152 | + $msg =~ s/\n\s*/\n /g; # indent consecutive lines |
| | 5153 | + push @Info, "- $msg\n"; |
| 4657 | 5154 | } |
| 4658 | 5155 | |
| 4659 | | -sub Abort |
| 4660 | | -{ |
| 4661 | | - my $msg = &DecodeInput(shift) ; |
| | 5156 | +sub Abort { |
| | 5157 | + my $msg = &DecodeInput(shift); |
| 4662 | 5158 | |
| 4663 | | - print "\n\n***** " . $msg . " *****\n\n" ; |
| 4664 | | - print @Errors ; |
| 4665 | | - print "Execution aborted.\n" ; |
| | 5159 | + print "\n\n***** " . $msg . " *****\n\n"; |
| | 5160 | + print @Errors; |
| | 5161 | + print "Execution aborted.\n"; |
| 4666 | 5162 | |
| 4667 | | - open "FILE_OUT", ">", $file_errors ; |
| 4668 | | - print FILE_OUT "<p>EasyTimeline $version</p><p><b>Timeline generation failed: " . &EncodeHtml ($msg) ."</b></p>\n" ; |
| 4669 | | - foreach $line (@Errors) |
| 4670 | | - { print FILE_OUT &EncodeHtml ($line) . "\n" ; } |
| 4671 | | - close "FILE_OUT" ; |
| | 5163 | + open "FILE_OUT", ">", $file_errors; |
| | 5164 | + print FILE_OUT |
| | 5165 | + "<p>EasyTimeline $version</p><p><b>Timeline generation failed: " |
| | 5166 | + . &EncodeHtml($msg) |
| | 5167 | + . "</b></p>\n"; |
| | 5168 | + foreach $line (@Errors) { print FILE_OUT &EncodeHtml($line) . "\n"; } |
| | 5169 | + close "FILE_OUT"; |
| 4672 | 5170 | |
| 4673 | | - if ($makehtml) # generate html test file, which would normally contain png + svg (+ image map) |
| 4674 | | - { |
| 4675 | | - open "FILE_IN", "<", $file_errors ; |
| 4676 | | - open "FILE_OUT", ">", $file_html ; |
| 4677 | | - print FILE_OUT "<html><head>\n<title>Graphical Timelines - HTML test file</title>\n</head>\n" . |
| 4678 | | - "<body><h1><font color='green'>EasyTimeline</font> - Test Page</h1>\n\n" . |
| 4679 | | - "<code>\n" ; |
| 4680 | | - print FILE_OUT <FILE_IN> ; |
| 4681 | | - print FILE_OUT "</code>\n\n</body>\n</html>" ; |
| 4682 | | - close "FILE_IN" ; |
| 4683 | | - close "FILE_OUT" ; |
| 4684 | | - } |
| 4685 | | - exit ; |
| | 5171 | + if ($makehtml |
| | 5172 | + ) # generate html test file, which would normally contain png + svg (+ image map) |
| | 5173 | + { |
| | 5174 | + open "FILE_IN", "<", $file_errors; |
| | 5175 | + open "FILE_OUT", ">", $file_html; |
| | 5176 | + print FILE_OUT |
| | 5177 | + "<html><head>\n<title>Graphical Timelines - HTML test file</title>\n</head>\n" |
| | 5178 | + . "<body><h1><font color='green'>EasyTimeline</font> - Test Page</h1>\n\n" |
| | 5179 | + . "<code>\n"; |
| | 5180 | + print FILE_OUT <FILE_IN>; |
| | 5181 | + print FILE_OUT "</code>\n\n</body>\n</html>"; |
| | 5182 | + close "FILE_IN"; |
| | 5183 | + close "FILE_OUT"; |
| | 5184 | + } |
| | 5185 | + exit; |
| 4686 | 5186 | } |
| 4687 | 5187 | |
| 4688 | | -sub EscapeShellArg |
| 4689 | | -{ |
| 4690 | | - my $arg = shift; |
| 4691 | | - if ($env eq "Linux") { |
| 4692 | | - $arg =~ s/'/\\'/; |
| 4693 | | - $arg = "'$arg'"; |
| 4694 | | - } else { |
| 4695 | | - $arg =~ s/"/\\"/; |
| 4696 | | - $arg = "\"$arg\""; |
| 4697 | | - } |
| 4698 | | - return $arg; |
| | 5188 | +sub EscapeShellArg { |
| | 5189 | + my $arg = shift; |
| | 5190 | + if ($env eq "Linux") { |
| | 5191 | + $arg =~ s/'/\\'/; |
| | 5192 | + $arg = "'$arg'"; |
| | 5193 | + } |
| | 5194 | + else { |
| | 5195 | + $arg =~ s/"/\\"/; |
| | 5196 | + $arg = "\"$arg\""; |
| | 5197 | + } |
| | 5198 | + return $arg; |
| 4699 | 5199 | } |
| 4700 | 5200 | |
| 4701 | 5201 | # vim: set sts=2 ts=2 sw=2 et : |
| 4702 | 5202 | |
| 4703 | 5203 | sub UnicodeToAscii { |
| 4704 | | - my $unicode = shift ; |
| 4705 | | - my $char = substr ($unicode,0,1) ; |
| 4706 | | - my $ord = ord ($char) ; |
| | 5204 | + my $unicode = shift; |
| | 5205 | + my $char = substr($unicode, 0, 1); |
| | 5206 | + my $ord = ord($char); |
| 4707 | 5207 | |
| 4708 | | - if ($ord < 128) # plain ascii character |
| 4709 | | - { return ($unicode) ; } # (will not occur in this script) |
| 4710 | | - else |
| 4711 | | - { |
| 4712 | | - # for completeness sake complete routine, only 2 byte unicodes sent here |
| 4713 | | - if ($ord >= 252) |
| 4714 | | - { $value = $ord - 252 ; } |
| 4715 | | - elsif ($ord >= 248) |
| 4716 | | - { $value = $ord - 248 ; } |
| 4717 | | - elsif ($ord >= 240) |
| 4718 | | - { $value = $ord - 240 ; } |
| 4719 | | - elsif ($ord >= 224) |
| 4720 | | - { $value = $ord - 224 ; } |
| 4721 | | - else |
| 4722 | | - { $value = $ord - 192 ; } |
| 4723 | | - for ($c = 1 ; $c < length ($unicode) ; $c++) |
| 4724 | | - { $value = $value * 64 + ord (substr ($unicode, $c,1)) - 128 ; } |
| | 5208 | + if ($ord < 128) # plain ascii character |
| | 5209 | + { |
| | 5210 | + return ($unicode); |
| | 5211 | + } # (will not occur in this script) |
| | 5212 | + else { |
| 4725 | 5213 | |
| 4726 | | -# $html = "\&\#" . $value . ";" ; any unicode can be specified as html char |
| | 5214 | + # for completeness sake complete routine, only 2 byte unicodes sent here |
| | 5215 | + if ($ord >= 252) { $value = $ord - 252; } |
| | 5216 | + elsif ($ord >= 248) { $value = $ord - 248; } |
| | 5217 | + elsif ($ord >= 240) { $value = $ord - 240; } |
| | 5218 | + elsif ($ord >= 224) { $value = $ord - 224; } |
| | 5219 | + else { $value = $ord - 192; } |
| | 5220 | + for ($c = 1; $c < length($unicode); $c++) { |
| | 5221 | + $value = $value * 64 + ord(substr($unicode, $c, 1)) - 128; |
| | 5222 | + } |
| 4727 | 5223 | |
| 4728 | | - if (($value >= 128) && ($value <= 255)) |
| 4729 | | - { return (chr ($value)) ; } |
| 4730 | | - else |
| 4731 | | - { return "?" ; } |
| 4732 | | - } |
| | 5224 | + # $html = "\&\#" . $value . ";" ; any unicode can be specified as html char |
| | 5225 | + |
| | 5226 | + if (($value >= 128) && ($value <= 255)) { return (chr($value)); } |
| | 5227 | + else { return "?"; } |
| | 5228 | + } |
| 4733 | 5229 | } |
| 4734 | 5230 | |