#!/usr/bin/env perl # # This is Widget user interface script -> C struct compiler. # # Compiler is designed to parse structured widget definition files. Compiler # lacks advanced error and syntax checking and such, but it works. # # Copyright (c) 2016-2024, Jani Salonen # All rights reserved. # use 5.10.0; use utf8; use warnings; # This is version tag for output file and must match with the engine's PACKAGE_VERSION # my $DSL_COMPILER_VER = "0.2.9"; # my $on_set = 0; my $on_wnd = 0; my $on_wdg = ""; my @WIDGET_ID = (); my @WINDOW_ID = (); my %WINDOW_ST = (); my @UNVEIL_ST = (); # my %HEADER_ST = ( '@WIDGET_DEFAULT_COLOR' => '', '@WIDGET_DEFAULT_HUE' => '', '@WIDGET_DEFAULT_LIGHT' => '', '@WIDGET_DEFAULT_STATE' => '', '@WIDGET_DEFAULT_STICKY' => '', '@WIDGET_DEFAULT_TITLE_CHARSET' => '', '@WIDGET_DEFAULT_TITLE_COLOR' => '', '@WIDGET_DEFAULT_TITLE_DPI' => '', '@WIDGET_DEFAULT_TITLE_FONT' => '', '@WIDGET_DEFAULT_TITLE_JUSTIFICATION' => '', '@WIDGET_DEFAULT_TITLE_POSITION' => '', '@WIDGET_DEFAULT_TITLE_SIZE' => '', '@WIDGET_DEFAULT_TRIGGER' => '', '@WIDGET_DEFAULT_TYPE' => '', '@WIDGET_DEFAULT_VALUE' => '', '@WIDGET_USE_BOUNDING_BOXES' => '' ); # my @file_inc = (); binmode(STDOUT, ":utf8"); &widget_def({ file => $ARGV[0] }); &widget_out({ this => $0, file => $ARGV[0] }); exit(0); # sub widget_cmd_window { my ($arg) = @_; my ($p) = $arg->{line} =~ /"(.*?)"/; if($p == 0) { &msg_fail({ mess => "Invalid window identifier, it cannot be zero" }); return; } if($p !~ /^\d+$/) { &msg_fail({ mess => "Invalid window identifier '" . $p . "', positive integer was expected" }); return; } if($WINDOW_ST{$p}) { &msg_fail({ mess => "Window definition '" . $p . "' aleady exists" }); return; } # $on_wnd = $p; $WINDOW_ST{$on_wnd} = []; push @WINDOW_ID, $on_wnd; } sub widget_cmd_set { my ($arg) = @_; my ($p) = $arg->{line} =~ /"(.*?)"/; if($p !~ /^\d+$/) { &msg_fail({ mess => "Invalid set identifier '" . $p . "', positive integer was expected" }); return; } if($on_wnd == 0) { &msg_fail({ mess => "Set definition '" . $p . "' must be placed in window block with nonzero id" }); return; } if($on_wdg ne "") { &msg_fail({ mess => "Set definition '" . $p . "' is not allowed in widget block" }); return; } # foreach my $e (@{ $WINDOW_ST{$on_wnd} }) { my @e = split(/\t/, "@{ $e }"); if($e[0] eq "SET" && $e[1] == $p) { &msg_fail({ mess => "Set definition '" . $p . "' already exists" }); return; } } # $on_set = $p; push @{ $WINDOW_ST{$on_wnd} }, [ "SET" . "\t" . $on_set ]; } sub widget_cmd_widget { my ($arg) = @_; my ($p) = $arg->{line} =~ /"(.*?)"/; if($p !~ /^\w+$/) { &msg_fail({ mess => "Invalid widget identifier '" . $p . "', character string was expected" }); return; } if($on_wnd == 0) { &msg_fail({ mess => "Widget definition '" . $p . "' must be placed in window block with nonzero id" }); return; } # $on_wdg = $p; undef @WIDGET_ID; } sub widget_cmd_end { my ($arg) = @_; if($on_wdg ne "") { push @{ $WINDOW_ST{$on_wnd} }, [ "WIDGET" . "\t" . $on_set . "\t" . $on_wdg . "\t" . join("\t", @WIDGET_ID) ]; $on_wdg = ""; undef @WIDGET_ID; } else { if($on_set == 0) { $on_wnd = 0; } else { $on_set = 0; push @{ $WINDOW_ST{$on_wnd} }, [ "SET" . "\t" . $on_set ]; } } } # sub widget_cmd_action { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_action_op({ line => $arg->{line} }); } sub widget_cmd_action_op { my ($arg) = @_; my %o = ( "push" => "", "slide" => "", "toggle" => "", "turn" => "", "keypress" => "", "keyrelease" => "", "buttonpress" => "", "buttonrelease" => "" ); my (@p) = split(/,\s?/, $arg->{line}); while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } &widget_cmd_option({ line => \@p, opts => \%o }); # return "ACTION" . "\t" . "PUSHBUTTON_PUSH " . $o{'push'} . "\t" . "SLIDESWITCH_SLIDE " . $o{'slide'} . "\t" . "TOGGLESWITCH_TOGGLE " . $o{'toggle'} . "\t" . "TURNSWITCH_TURN " . $o{'turn'} . "\t" . "KEYPRESS " . $o{'keypress'} . "\t" . "KEYRELEASE " . $o{'keyrelease'} . "\t" . "BUTTONPRESS " . $o{'buttonpress'} . "\t" . "BUTTONRELEASE " . $o{'buttonrelease'}; } sub widget_cmd_angle { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_angle_op({ line => $arg->{line} }); } sub widget_cmd_angle_op { my ($arg) = @_; my %o = ( "min" => "", "max" => "" ); my (@p) = split(/,\s?/, $arg->{line}); while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } &widget_cmd_option({ line => \@p, opts => \%o }); # $o{'min'} = "0" if(!$o{'min'}); $o{'max'} = "0" if(!$o{'max'}); # while(my ($k, $v) = each %o) { if($o{$k} !~ /^\d+$/) { &msg_fail({ mess => "Widget angle '" . $k . " = " . $v . "' is invalid, positive integer was expected" }); return; } } if($o{'min'} < 0) { &msg_warn({ mess => "Widget min angle " . $o{'min'} . " is invalid, setting it to 0" }); $o{'min'} = 0; } elsif($o{'min'} > 359) { &msg_warn({ mess => "Widget min angle " . $o{'min'} . " is invalid, setting it to 359" }); $o{'min'} = 359; } if($o{'max'} < 0) { &msg_warn({ mess => "Widget max angle " . $o{'max'} . " is invalid, setting it to 0" }); $o{'max'} = 0; } elsif($o{'max'} > 359) { &msg_warn({ mess => "Widget max angle " . $o{'max'} . " is invalid, setting it to 359" }); $o{'max'} = 359; } # return "ANGLE" . "\t" . $o{'min'} . "\t" . $o{'max'}; } sub widget_cmd_border { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_border_op({ line => $arg->{line} }); } sub widget_cmd_border_op { my ($arg) = @_; my %o = ( "color" => "", "thickness" => "" ); my (@p) = split(/,\s?/, $arg->{line}); while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } &widget_cmd_option({ line => \@p, opts => \%o }); # if(!$o{'color'}) { if($HEADER_ST{'@WIDGET_DEFAULT_COLOR'}) { $o{'color'} = $HEADER_ST{'@WIDGET_DEFAULT_COLOR'}; } else { $o{'color'} = "rgba:0xffffffff"; } } $o{'thickness'} = "1" if(!$o{'thickness'}); # if($o{'thickness'} !~ /^\d+$/) { &msg_fail({ mess => "Widget border thickness '" . $o{'thickness'} . "' is invalid, positive integer was expected" }); return; } # return "BORDER" . "\t" . $o{'color'} . "\t" . $o{'thickness'}; } sub widget_cmd_color { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_color_op({ line => $arg->{line} }); } sub widget_cmd_color_op { my ($arg) = @_; my ($p) = $arg->{line} =~ /"(.*?)"/; # return "COLOR" . "\t" . $p; } sub widget_cmd_hue { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_hue_op({ line => $arg->{line} }); } sub widget_cmd_hue_op { my ($arg) = @_; my ($p) = $arg->{line}; # if($p !~ /^\d+$/ && $p !~ /^(\d+)?\.\d+$/) { &msg_fail({ mess => "Widget hue '" . $p . "' is invalid, positive float or integer was expected" }); return; } if($p < 0) { &msg_warn({ mess => "Widget hue " . $p . " is invalid, setting it to 0" }); $p = 0; } elsif($p > 359) { &msg_warn({ mess => "Widget hue " . $p . " is invalid, setting it to 359" }); $p = 359; } # return "HUE" . "\t" . $p; } sub widget_cmd_image { my ($arg) = @_; my $r = &widget_cmd_image_op({ line => $arg->{line} }); push @WIDGET_ID, $r; # Store image path to be used later by unveil() $r =~ s/^.*\t//; push @UNVEIL_ST, $r; } sub widget_cmd_image_op { my ($arg) = @_; my ($p) = $arg->{line} =~ /"(.*?)"/; # return "IMAGE" . "\t" . $p; } sub widget_cmd_label { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_label_op({ line => $arg->{line} }); } sub widget_cmd_label_op { my ($arg) = @_; my %o = ( "charset" => "", "color" => "", "dpi" => "", "font" => "", "justification" => "", "size" => "" ); my %o_justification = ( "l" => "left", "r" => "right", "c" => "center" ); my ($p) = $arg->{line} =~ /"(.*?)"/; # Split by comma followed by even number of double quotes # my (@p) = split(/\s?,\s?(?=(?:[^\"]*\"[^\"]*\")*[^\"]*$)/, $arg->{line}); shift @p; while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } &widget_cmd_option({ line => \@p, opts => \%o }); $p =~ s/\t/ /go; # if(!$o{'color'}) { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_COLOR'}) { $o{'color'} = $HEADER_ST{'@WIDGET_DEFAULT_TITLE_COLOR'}; } else { $o{'color'} = "rgba:0xffffffff"; } } $o{'dpi'} = "WIDGET_DEFAULT_FONT_DPI" if(!$o{'dpi'}); $o{'size'} = "WIDGET_DEFAULT_FONT_SIZE" if(!$o{'size'}); if($o{'justification'} && $o{'justification'} =~ /^$o_justification{substr($o{'justification'}, 0, 1)}/i) { $o{'justification'} = "WIDGET_TITLE_JUSTIFICATION_" . uc($o_justification{substr($o{'justification'}, 0, 1)}); } else { $o{'justification'} = "WIDGET_TITLE_JUSTIFICATION_NONE"; } # return "LABEL" . "\t" . $p . "\t" . $o{'charset'} . "\t" . $o{'color'} . "\t" . $o{'dpi'} . "\t" . $o{'font'} . "\t" . $o{'justification'} . "\t" . $o{'size'}; } sub widget_cmd_light { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_light_op({ line => $arg->{line} }); } sub widget_cmd_light_op { my ($arg) = @_; my %o = ( # (n)o # "n" => "IS_NO", # (d)isable # "d" => "IS_NO", # (f)alse # "f" => "IS_NO", # (0) # "0" => "IS_NO", # (y)es # "y" => "IS_YES", # (e)nable # "e" => "IS_YES", # (t)rue # "t" => "IS_YES", # (1) # "1" => "IS_YES" ); my ($p) = $arg->{line}; while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } # if(!$o{lc(substr($p, 0, 1))}) { &msg_fail({ mess => "Widget light identifier '" . $p . "' is unknown" }); return; } # return "LIGHT" . "\t" . $o{lc(substr($p, 0, 1))}; } sub widget_cmd_name { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_name_op({ line => $arg->{line} }); } sub widget_cmd_name_op { my ($arg) = @_; my ($p) = $arg->{line} =~ /"(.*?)"/; # if($p !~ /^\w+$/) { &msg_fail({ mess => "Widget name '" . $p . "' is invalid, character string was expected" }); return; } # return "NAME" . "\t" . $p; } sub widget_cmd_position { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_position_op({ line => $arg->{line} }); } sub widget_cmd_position_op { my ($arg) = @_; my %o = ( "x" => "", "y" => "" ); my (@p) = split(/,\s?/, $arg->{line}); while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } &widget_cmd_option({ line => \@p, opts => \%o }); # $o{'x'} = "0" if(!$o{'x'}); $o{'y'} = "0" if(!$o{'y'}); # while(my ($k, $v) = each %o) { if($o{$k} !~ /^(-)?\d+$/) { &msg_fail({ mess => "Widget position '" . $k . " = " . $v . "' is invalid, integer was expected" }); return; } } # return "POSITION" . "\t" . $o{'x'} . "\t" . $o{'y'}; } sub widget_cmd_size { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_size_op({ line => $arg->{line} }); } sub widget_cmd_size_op { my ($arg) = @_; my %o = ( "width" => "", "height" => "" ); my (@p) = split(/,\s?/, $arg->{line}); while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } &widget_cmd_option({ line => \@p, opts => \%o }); # $o{'width'} = "0" if(!$o{'width'}); $o{'height'} = "0" if(!$o{'height'}); # while(my ($k, $v) = each %o) { if($o{$k} !~ /^(-)?\d+$/) { &msg_fail({ mess => "Widget size '" . $k . " = " . $v . "' is invalid, integer was expected" }); return; } } # return "SIZE" . "\t" . $o{'width'} . "\t" . $o{'height'}; } sub widget_cmd_slide { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_slide_op({ line => $arg->{line} }); } sub widget_cmd_slide_op { my ($arg) = @_; my %o = ( "start" => "", "total" => "", "length" => "" ); my (@p) = split(/,\s?/, $arg->{line}); while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } &widget_cmd_option({ line => \@p, opts => \%o }); # $o{'start'} = "0" if(!$o{'start'}); $o{'total'} = "0" if(!$o{'total'}); $o{'length'} = "0" if(!$o{'length'}); # while(my ($k, $v) = each %o) { if($o{$k} !~ /^\d+$/) { &msg_fail({ mess => "Widget slide '" . $k . " = " . $v . "' is invalid, positive integer was expected" }); return; } } # return "SLIDE" . "\t" . $o{'length'} . "\t" . $o{'total'} . "\t" . $o{'start'}; } sub widget_cmd_state { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_state_op({ line => $arg->{line} }); } sub widget_cmd_state_op { my ($arg) = @_; my %o = ( # (d)isable # "d" => "WIDGET_STATE_DISABLE", # (f)alse # "f" => "WIDGET_STATE_DISABLE", # (0) # "0" => "WIDGET_STATE_DISABLE", # (e)nable # "e" => "WIDGET_STATE_ENABLE", # (t)rue # "t" => "WIDGET_STATE_ENABLE", # (1) # "1" => "WIDGET_STATE_ENABLE" ); my ($p) = $arg->{line}; while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } # if(!$o{lc(substr($p, 0, 1))}) { &msg_fail({ mess => "Widget state identifier '" . $p . "' is unknown" }); return; } # return "STATE" . "\t" . $o{lc(substr($p, 0, 1))}; } sub widget_cmd_steps { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_steps_op({ line => $arg->{line} }); } sub widget_cmd_steps_op { my ($arg) = @_; my %o = ( "start" => "", "total" => "" ); my (@p) = split(/,\s?/, $arg->{line}); while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } &widget_cmd_option({ line => \@p, opts => \%o }); # $o{'start'} = "0" if(!$o{'start'}); $o{'total'} = "0" if(!$o{'total'}); # while(my ($k, $v) = each %o) { if($o{$k} !~ /^\d+$/) { &msg_fail({ mess => "Widget step '" . $k . " = " . $v . "' is invalid, positive integer was expected" }); return; } } # return "STEPS" . "\t" . $o{'total'} . "\t" . $o{'start'}; } sub widget_cmd_sticky { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_sticky_op({ line => $arg->{line} }); } sub widget_cmd_sticky_op { my ($arg) = @_; my %o = ( # (n)o # "n" => "IS_NO", # (d)isable # "d" => "IS_NO", # (f)alse # "f" => "IS_NO", # (0) # "0" => "IS_NO", # (y)es # "y" => "IS_YES", # (e)nable # "e" => "IS_YES", # (t)rue # "t" => "IS_YES", # (1) # "1" => "IS_YES" ); my ($p) = $arg->{line}; while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } # if(!$o{lc(substr($p, 0, 1))}) { &msg_fail({ mess => "Widget sticky identifier '" . $p . "' is unknown" }); return; } # return "STICKY" . "\t" . $o{lc(substr($p, 0, 1))}; } sub widget_cmd_title { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_title_op({ line => $arg->{line} }); } sub widget_cmd_title_op { my ($arg) = @_; my %o = ( "charset" => "", "color" => "", "dpi" => "", "font" => "", "justification" => "", "position" => "", "size" => "", "x" => "", "y" => "" ); my %o_justification = ( "l" => "left", "r" => "right", "c" => "center" ); my %o_position = ( "a" => "above", "b" => "below", "l" => "left", "r" => "right" ); my ($p) = $arg->{line} =~ /"(.*?)"/; # Split by comma followed by even number of double quotes # my (@p) = split(/\s?,\s?(?=(?:[^\"]*\"[^\"]*\")*[^\"]*$)/, $arg->{line}); shift @p; while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } &widget_cmd_option({ line => \@p, opts => \%o }); $p =~ s/\t/ /go; # if(!$o{'color'}) { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_COLOR'}) { $o{'color'} = $HEADER_ST{'@WIDGET_DEFAULT_TITLE_COLOR'}; } else { $o{'color'} = "rgba:0xffffffff"; } } $o{'dpi'} = "WIDGET_DEFAULT_FONT_DPI" if(!$o{'dpi'}); $o{'size'} = "WIDGET_DEFAULT_FONT_SIZE" if(!$o{'size'}); $o{'x'} = "0" if(!$o{'x'}); $o{'y'} = "0" if(!$o{'y'}); if($o{'justification'} && $o{'justification'} =~ /^$o_justification{substr($o{'justification'}, 0, 1)}/i) { $o{'justification'} = "WIDGET_TITLE_JUSTIFICATION_" . uc($o_justification{substr($o{'justification'}, 0, 1)}); } else { $o{'justification'} = "WIDGET_TITLE_JUSTIFICATION_NONE"; } if($o{'position'} && $o{'position'} =~ /^$o_position{substr($o{'position'}, 0, 1)}/i) { $o{'position'} = "WIDGET_TITLE_POSITION_" . uc($o_position{substr($o{'position'}, 0, 1)}); } else { $o{'position'} = "WIDGET_TITLE_POSITION_NONE"; } # return "TITLE" . "\t" . $p . "\t" . $o{'charset'} . "\t" . $o{'color'} . "\t" . $o{'dpi'} . "\t" . $o{'font'} . "\t" . $o{'justification'} . "\t" . $o{'position'} . "\t" . $o{'size'} . "\t" . $o{'x'} . "\t" . $o{'y'}; } sub widget_cmd_trigger { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_trigger_op({ line => $arg->{line} }); } sub widget_cmd_trigger_op { my ($arg) = @_; my %o = ( # (r)elease # "r" => "WIDGET_TRIGGER_RELEASE", # (o)nce # "o" => "WIDGET_TRIGGER_RELEASE", # (c)onstant # "c" => "WIDGET_TRIGGER_CONSTANT", # (d)rag # "d" => "WIDGET_TRIGGER_CONSTANT" ); my ($p) = $arg->{line}; while(my ($k, $v) = each %o) { $o{$k} =~ s/^"|"$//; } # if(!$o{lc(substr($p, 0, 1))}) { &msg_fail({ mess => "Widget trigger identifier '" . $p . "' is unknown" }); return; } # return "TRIGGER" . "\t" . $o{lc(substr($p, 0, 1))}; } sub widget_cmd_type { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_type_op({ line => $arg->{line} }); } sub widget_cmd_type_op { my ($arg) = @_; my ($p) = $arg->{line}; # if($p !~ /^\d+$/) { &msg_fail({ mess => "Widget type '" . $p . "' is invalid, zero or positive integer was expected" }); return; } if($p < 0) { &msg_warn({ mess => "Widget type " . $p . " is invalid, setting it to 0" }); $p = 0; } elsif($p > 5) { &msg_warn({ mess => "Widget type " . $p . " is invalid, setting it to 5" }); $p = 5; } # return "TYPE" . "\t" . $p; } sub widget_cmd_value { my ($arg) = @_; push @WIDGET_ID, &widget_cmd_value_op({ line => $arg->{line} }); } sub widget_cmd_value_op { my ($arg) = @_; my ($p) = $arg->{line}; # if($p !~ /^\d+$/ && $p !~ /^(\d+)?\.\d+$/) { &msg_fail({ mess => "Widget value '" . $p . "' is invalid, positive float or integer was expected" }); return; } if($p < 0) { &msg_warn({ mess => "Widget value " . $p . " is invalid, setting it to 0" }); $p = 0; } elsif($p > 359) { &msg_warn({ mess => "Widget value " . $p . " is invalid, setting it to 359" }); $p = 359; } # return "VALUE" . "\t" . $p; } # sub widget_cmd_option { my ($arg) = @_; my @p = @{ $arg->{line} }; my $o = $arg->{opts}; foreach my $p (@p) { my ($e, $f) = split(/\s?=\s?/, $p, 2); if(!defined($o->{lc($e)})) { &msg_fail({ mess => "Widget option '" . $e . "' is unknown" }); return; } if($o->{lc($e)} ne "") { &msg_fail({ mess => "Widget option '" . $e . "' is already defined" }); return; } $o->{lc($e)} = $f; } } # sub widget_cmd { my ($arg) = @_; my @f = @{ $arg->{file} }; my $n = 0; foreach my $f (@f) { if($f =~ /^\w+\s"(.*?)"\s?[,{]/ || $f =~ /^\w+\s"(.*?)"$/) { # This is one of the quoted options # my ($c, $p) = split(/\s/, $f, 2); &widget_cmd_op({ cmds => $c, line => $p, deep => $n }); } elsif($f !~ /^\w+\s\d+$/ && $f =~ /^\w+\s\w+$/) { # This is state or trigger # my ($c, $p) = split(/\s/, $f, 2); &widget_cmd_op({ cmds => $c, line => $p, deep => $n }); } elsif($f =~ /^\w+\s\d+$/ || $f =~ /^\w+\s[-+]?[0-9]*\.?[0-9]+$/) { # This is hue, value or probably type # my ($c, $p) = split(/\s/, $f, 2); &widget_cmd_op({ cmds => $c, line => $p, deep => $n }); } elsif($f =~ /^\w+\s\w+\s?=\s?/) { # This is one of the multivalue options # my ($c, $p) = split(/\s/, $f, 2); &widget_cmd_op({ cmds => $c, line => $p, deep => $n }); } $n += $f =~ tr/{$//; $n -= $f =~ tr/}$//; &widget_cmd_end() if($f =~ /}$/); } } sub widget_cmd_op { my ($arg) = @_; my $s = "widget_cmd_" . lc($arg->{cmds}); if(defined(&$s)) { &$s({ line => $arg->{line}, deep => $arg->{deep} }); } else { &msg_fail({ mess => "Unknown identifier '" . $arg->{cmds} . "'" }); return; } } sub widget_pre { my ($arg) = @_; my @f = @{ $arg->{file} }; my @r = (); my $o = ""; foreach my $f (@f) { $f =~ s/\r+|\n+//g; $f =~ s/^\s+//; $f =~ s/\s+$//; $f =~ s/\s\s+/ /g; next if($f eq ""); # Check for header tags first... # if($f =~ /^;/ || $f =~ /^#/) { $f =~ s/^[;#]\s*//; next if($f eq ""); if($f =~ /^\@WIDGET_/i) { my @k = split(/\s+/, $f, 2); $HEADER_ST{uc($k[0])} = $k[1] if($k[1]); } next; } # ...and then check if this is multiline... # if($f =~ /\\$/) { $f =~ s/\\$//; $o .= $f; next; } else { $o .= $f; } # ...or preprocessor command # if($o =~ /^include\s"(.*)"/i) { my ($p) = $o =~ /"(.*)"/; push @r, &widget_get({ file => $p }); } else { push @r, $o; } $o = ""; } return @r; } sub widget_get { my ($arg) = @_; my @f = (); my @r = (); my %m = (); if(!$arg->{file}) { &msg_fail({ mess => "Please provide source file to process" }); return @r; } if(!stat($arg->{file})) { &msg_fail({ mess => "Failed to open source file '" . $arg->{file} . "'" }); return @r; } # Try to detect include loop first... # push @file_inc, $arg->{file}; for(my $i = 0; $i < @file_inc; $i++) { if(defined($file_inc[$i + 1]) && $m{$file_inc[$i + 1]}) { &msg_fail({ mess => "Include loop detected, '" . $file_inc[$i] . "' to include '" . $arg->{file} . "'" }); return; } $m{$file_inc[$i]} = 1; } # ...then open and process the file # if(open(FILE, '<:encoding(UTF-8)', $arg->{file})) { @f = ; close(FILE); } else { &msg_fail({ mess => "Failed to open file '" . $arg->{file} . "'" }); return; } @r = &widget_pre({ file => \@f }); return @r; } sub widget_def { my ($arg) = @_; # if(!$arg->{file} || ($arg->{file} && !stat($arg->{file}))) { &widget_out_min(); } my @r = &widget_get({ file => $arg->{file} }); &widget_cmd({ file => \@r }); } # sub widget_out { my ($arg) = @_; &widget_out_bg({ this => $arg->{this}, file => $arg->{file} }); # Loop through windows... # foreach my $c (@WINDOW_ID) { my $d = 1; my $e = 1; # ...then loop through widgets for this window # foreach my $v (@{ $WINDOW_ST{$c} }) { my @f = split(/\t/, @{ $v }[0]); # Keep on rolling if this is not real widget # next if($f[0] ne "WIDGET"); my $s = "widget_out_cmd_" . lc($f[2]); if(defined(&$s)) { print STDOUT "/* Widget '" . $f[2] . "' in set " . $f[1] . ", on window id " . $c . " */" . "\n"; print STDOUT "static struct widget_type_" . $f[2] . " widget_stack_" . $c . "_" . $d . " = {" . "\n"; &$s({ args => \@f }); print STDOUT "};" . "\n\n"; } else { &msg_fail({ mess => "Unknown widget '" . $f[2] . "'" }); return; } $d++; $e++; } # $d = 1; foreach my $v (@{ $WINDOW_ST{$c} }) { my @f = split(/\t/, @{ $v }[0]); # Keep on rolling if this is not real widget # next if($f[0] ne "WIDGET"); # Get the callbacks if there is any # my %f = (); for(my $i = 0; $i < @f; $i++) { if($f[$i] eq "ACTION") { for(my $j = ($i + 1); $j < ($i + 8); $j++) { my @d = split(/\s+/, $f[$j], 2); $f{$d[0]} = $d[1] if($d[1] && $d[1] ne ""); } last; } } # my $f = keys %f; print STDOUT "/* Widget '" . $f[2] . "' callback functions in set " . $f[1] . ", on window id " . $c . " */" . "\n"; if($f > 0) { print STDOUT "static struct widget_cb widget_cb_" . $c . "_" . $d . "[" . ($f + 1) . "] = {" . "\n"; foreach my $k (sort { lc($a) cmp lc($b) } keys %f) { print STDOUT "\t" . "{ WIDGET_CB_TYPE_" . uc($k) . ", \"" . $f{$k} . "\" }," . "\n"; } print STDOUT "\n"; } else { print STDOUT "static struct widget_cb widget_cb_" . $c . "_" . $d . "[1] = {" . "\n"; } print STDOUT "\t" . "{ WIDGET_CB_TYPE_NONE, NULL }" . "\n"; print STDOUT "};" . "\n\n"; $d++; } # $d = 1; print STDOUT "/* Widgets attached to window id " . $c . " */" . "\n"; print STDOUT "static struct widget_stack widget_stack_" . $c . "[" . $e . "] = {" . "\n"; foreach my $v (@{ $WINDOW_ST{$c} }) { my @f = split(/\t/, @{ $v }[0]); # Keep on rolling if this is not real widget # next if($f[0] ne "WIDGET"); print STDOUT "\t" . "{ WIDGET_TYPE_" . uc($f[2]) . ", &widget_stack_" . $c . "_" . $d . ", widget_cb_" . $c . "_" . $d . " }," . "\n"; $d++; } print STDOUT "\n"; print STDOUT "\t" . "{ WIDGET_TYPE_NONE, NULL, NULL }" . "\n"; print STDOUT "};" . "\n\n"; } # &widget_out_eg({ file => $arg->{file} }); } # sub widget_out_cmd_background { my ($arg) = @_; # See struct widget_type_background in engine/widget.h for details of this structure # my @widget_type_background = ( "\t", "__SET", ",", "\n", "\t", "{ ", "__NAME", ", ", "IS_NO, IS_NO, ", "__STATE", " }," . "\n", "\t", "__IMAGE", ",", "\n", "\t", "__COLOR", ",", "\n", "\t", "__HUE", ", ", "__VALUE", ",", "\n", "\t", "{ 0, 0, 0, 0 }", "\n" ); &widget_out_at_cmd({ args => $arg->{args}, dump => \@widget_type_background }); } sub widget_out_cmd_block { my ($arg) = @_; # See struct widget_type_block in engine/widget.h for details of this structure # my @widget_type_block = ( "\t", "__SET", ",", "\n", "\t", "{ ", "__NAME", ", ", "IS_NO, IS_NO, ", "__STATE", " }," . "\n", "\t", "__IMAGE", ",", "\n", "\t", "__COLOR", ",", "\n", "\t", "__BORDER", ",", "\n", "\t", "NULL", ",", "\n", "\t", "{ ", "__POSITION", ", ", "__SIZE", " }", "\n" ); &widget_out_at_cmd({ args => $arg->{args}, dump => \@widget_type_block }); } sub widget_out_cmd_label { my ($arg) = @_; # See struct widget_type_label in engine/widget.h for details of this structure # my @widget_type_label = ( "\t", "__SET", ",", "\n", "\t", "{ ", "__NAME", ", ", "IS_NO, IS_NO, ", "__STATE", " }," . "\n", "\t", "__LABEL", ",", "\n", "\t", "{ ", "__POSITION", ", 0, 0 }", "\n" ); &widget_out_at_cmd({ args => $arg->{args}, dump => \@widget_type_label }); } sub widget_out_cmd_lamp { my ($arg) = @_; # See struct widget_type_lamp in engine/widget.h for details of this structure # my @widget_type_lamp = ( "\t", "__SET", ",", "\n", "\t", "{ ", "__NAME", ", ", "IS_NO, IS_NO, ", "__STATE", " }," . "\n", "\t", "__TYPE", ",", "\n", "\t", "__TITLE", ",", "\n", "\t", "0, WIDGET_FRAME_LAMP_ANGLES, 2, ", "__LIGHT", ",", "\n", "\t", "__HUE", ",", "\n", "\t", "{ ", "__POSITION", ", 0, 0 }", "\n" ); &widget_out_at_cmd({ args => $arg->{args}, dump => \@widget_type_lamp }); } sub widget_out_cmd_led_1 { my ($arg) = @_; &widget_out_cmd_led_op({ args => $arg->{args} }); } sub widget_out_cmd_led_2 { my ($arg) = @_; &widget_out_cmd_led_op({ args => $arg->{args} }); } sub widget_out_cmd_led_3 { my ($arg) = @_; &widget_out_cmd_led_op({ args => $arg->{args} }); } sub widget_out_cmd_led_op { my ($arg) = @_; # See struct widget_type_led in engine/widget.h for details of this structure # my @widget_type_led = ( "\t", "__SET", ",", "\n", "\t", "{ ", "__NAME", ", ", "IS_NO, IS_NO, ", "__STATE", " }," . "\n", "\t", "__TYPE", ",", "\n", "\t", "__TITLE", ",", "\n", "\t", "0, WIDGET_FRAME_LED_ANGLES, 2, ", "__LIGHT", ",", "\n", "\t", "__HUE", ",", "\n", "\t", "{ ", "__POSITION", ", 0, 0 }", "\n" ); &widget_out_at_cmd({ args => $arg->{args}, dump => \@widget_type_led }); } sub widget_out_cmd_pushbutton_1 { my ($arg) = @_; &widget_out_cmd_pushbutton_op({ args => $arg->{args} }); } sub widget_out_cmd_pushbutton_2 { my ($arg) = @_; &widget_out_cmd_pushbutton_op({ args => $arg->{args} }); } sub widget_out_cmd_pushbutton_3 { my ($arg) = @_; &widget_out_cmd_pushbutton_op({ args => $arg->{args} }); } sub widget_out_cmd_pushbutton_op { my ($arg) = @_; # See struct widget_type_pushbutton in engine/widget.h for details of this structure # my @widget_type_pushbutton = ( "\t", "__SET", ",", "\n", "\t", "{ ", "__NAME", ", ", "IS_NO, IS_NO, ", "__STATE", " }," . "\n", "\t", "__TYPE", ",", "\n", "\t", "__TITLE", ",", "\n", "\t", "0, WIDGET_FRAME_PUSHBUTTON_ANGLES, 2, 0,", "\n", "\t", "__STICKY", ",", "\n", "\t", "__HUE", ",", "\n", "\t", "{ ", "__POSITION", ", 0, 0 }", "\n" ); &widget_out_at_cmd({ args => $arg->{args}, dump => \@widget_type_pushbutton }); } sub widget_out_cmd_slideswitch { my ($arg) = @_; # See struct widget_type_slideswitch in engine/widget.h for details of this structure # my @widget_type_slideswitch = ( "\t", "__SET", ",", "\n", "\t", "{ ", "__NAME", ", ", "IS_NO, IS_NO, ", "__STATE", " }," . "\n", "\t", "__TYPE", ",", "\n", "\t", "__TITLE", ",", "\n", "\t", "0, ", "__SLIDE", ",", "\n", "\t", "__TRIGGER", ",", "\n", "\t", "__HUE", ",", "\n", "\t", "{ ", "__POSITION", ", 0, 0 }, { 0, 0, 0, 0 },", "\n", "\t", "{ WIDGET_SCALE_TYPE_NONE, 0, IS_NO,", "\n", "\t", "{ 0, NULL },", "\n", "\t", "NULL, NULL,", "\n", "\t", "{ 0, NULL },", "\n", "\t", "{ { { 0, 0, 0, 0 } } },", "\n", "\t", "{ 0, 0, 0, 0, { 0, 0 } },", "\n", "\t", "{ 0, 0, 0, 0, { { { 0, 0, 0, 0 } } } },", "\n", "\t", "{ 0, 0, 0, 0, { 0, 0 }, { 0, 0 }, NULL } },", "\n", "\t", "{ 0, WIDGET_INDICATOR_MODE_DISABLE, NULL, NULL, 0, 0, 0, 0, 0, 0, 0,", "\n", "\t", "{ { { 0, 0, 0, 0 } } },", "\n", "\t", "{ 0, 0, 0 },", "\n", "\t", "{ 0, 0, 0, 0, { { { 0, 0, 0, 0 } } } },", "\n", "\t", "{ 0, 0, 0, 0, { 0, 0 }, { 0, 0 }, NULL } }", "\n" ); &widget_out_at_cmd({ args => $arg->{args}, dump => \@widget_type_slideswitch }); } sub widget_out_cmd_toggleswitch { my ($arg) = @_; } sub widget_out_cmd_turnswitch { my ($arg) = @_; # See struct widget_type_turnswitch in engine/widget.h for details of this structure # my @widget_type_turnswitch = ( "\t", "__SET", ",", "\n", "\t", "{ ", "__NAME", ", ", "IS_NO, IS_NO, ", "__STATE", " }," . "\n", "\t", "__TYPE", ",", "\n", "\t", "__TITLE", ",", "\n", "\t", "__ANGLE", ", ", "__STEPS", ",", "\n", "\t", "__TRIGGER", ",", "\n", "\t", "__HUE", ",", "\n", "\t", "{ ", "__POSITION", ", 0, 0 },", "\n", "\t", "{ WIDGET_SCALE_TYPE_NONE, 0, IS_NO,", "\n", "\t", "{ 0, NULL },", "\n", "\t", "NULL, NULL,", "\n", "\t", "{ 0, NULL },", "\n", "\t", "{ { { 0, 0, 0, 0 } } },", "\n", "\t", "{ 0, 0, 0, 0, { 0, 0 } },", "\n", "\t", "{ 0, 0, 0, 0, { { { 0, 0, 0, 0 } } } },", "\n", "\t", "{ 0, 0, 0, 0, { 0, 0 }, { 0, 0 }, NULL } },", "\n", "\t", "{ 0, WIDGET_INDICATOR_MODE_DISABLE, NULL, NULL, 0, 0, 0, 0, 0, 0, 0,", "\n", "\t", "{ { { 0, 0, 0, 0 } } },", "\n", "\t", "{ 0, 0, 0 },", "\n", "\t", "{ 0, 0, 0, 0, { { { 0, 0, 0, 0 } } } },", "\n", "\t", "{ 0, 0, 0, 0, { 0, 0 }, { 0, 0 }, NULL } }", "\n" ); &widget_out_at_cmd({ args => $arg->{args}, dump => \@widget_type_turnswitch }); } sub widget_out_at_cmd { my ($arg) = @_; my $r = ""; foreach my $o (@{ $arg->{dump} }) { if($o =~ /^__/) { $o =~ s/^__//; $r = &widget_out_op_cmd({ args => $arg->{args}, what => $o }); if($r eq "") { $r = &widget_out_op_def({ what => $o }); } $o = $r; } print STDOUT $o; } } # sub widget_out_op_cmd { my ($arg) = @_; my @p = @{ $arg->{args} }; # return $p[1] if($arg->{what} =~ /^SET$/i); # for(my $i = 3; $i < @p; $i++) { if($arg->{what} =~ /^ANGLE$/i && $p[$i] =~ /^ANGLE$/i) { my @s = @p[$i + 1, $i + 2]; return &widget_out_op_cmd_value_multi({ line => \@s }); } elsif($p[$i] =~ /^ANGLE$/i) { $i += 2; } # elsif($arg->{what} =~ /^BORDER$/i && $p[$i] =~ /^BORDER$/i) { my @s = @p[$i + 1, $i + 2]; return &widget_out_op_cmd_border_double({ line => \@s }); } elsif($p[$i] =~ /^BORDER$/i) { $i += 2; } # elsif($arg->{what} =~ /^COLOR$/i && $p[$i] =~ /^COLOR$/i) { return &widget_out_op_cmd_color_single({ line => $p[++$i] }); } elsif($p[$i] =~ /^COLOR$/i) { $i++; } # elsif($arg->{what} =~ /^HUE$/i && $p[$i] =~ /^HUE$/i) { return &widget_out_op_cmd_value_single({ line => $p[++$i] }); } elsif($p[$i] =~ /^HUE$/i) { $i++; } # elsif($arg->{what} =~ /^IMAGE$/i && $p[$i] =~ /^IMAGE$/i) { return &widget_out_op_cmd_image_single({ line => $p[++$i] }); } elsif($p[$i] =~ /^IMAGE$/i) { $i++; } # elsif($arg->{what} =~ /^LABEL$/i && $p[$i] =~ /^LABEL$/i) { my @s = @p[$i + 1 .. $i + 7]; return &widget_out_op_cmd_label_single({ line => \@s }); } elsif($p[$i] =~ /^LABEL$/i) { $i += 7; } # elsif($arg->{what} =~ /^LIGHT$/i && $p[$i] =~ /^LIGHT$/i) { return &widget_out_op_cmd_light_single({ line => $p[++$i] }); } elsif($p[$i] =~ /^LIGHT$/i) { $i++; } # elsif($arg->{what} =~ /^NAME$/i && $p[$i] =~ /^NAME$/i) { return &widget_out_op_cmd_string_single({ line => $p[++$i] }); } elsif($p[$i] =~ /^NAME$/i) { $i++; } # elsif($arg->{what} =~ /^POSITION$/i && $p[$i] =~ /^POSITION$/i) { my @s = @p[$i + 1, $i + 2]; return &widget_out_op_cmd_value_multi({ line => \@s }); } elsif($p[$i] =~ /^POSITION$/i) { $i += 2; } # elsif($arg->{what} =~ /^SIZE$/i && $p[$i] =~ /^SIZE$/i) { my @s = @p[$i + 1, $i + 2]; return &widget_out_op_cmd_value_multi({ line => \@s }); } elsif($p[$i] =~ /^SIZE$/i) { $i += 2; } # elsif($arg->{what} =~ /^SLIDE$/i && $p[$i] =~ /^SLIDE$/i) { my @s = @p[$i + 1 .. $i + 3]; return &widget_out_op_cmd_value_multi({ line => \@s }); } elsif($p[$i] =~ /^SLIDE$/i) { $i += 3; } # elsif($arg->{what} =~ /^STATE$/i && $p[$i] =~ /^STATE$/i) { return &widget_out_op_cmd_bool_single({ line => $p[++$i] }); } elsif($p[$i] =~ /^STATE$/i) { $i++; } # elsif($arg->{what} =~ /^STEPS$/i && $p[$i] =~ /^STEPS$/i) { my @s = @p[$i + 1, $i + 2]; return &widget_out_op_cmd_value_multi({ line => \@s }); } elsif($p[$i] =~ /^STEPS$/i) { $i += 2; } # elsif($arg->{what} =~ /^STICKY$/i && $p[$i] =~ /^STICKY$/i) { return &widget_out_op_cmd_value_single({ line => $p[++$i] }); } elsif($p[$i] =~ /^STICKY$/i) { $i++; } # elsif($arg->{what} =~ /^TITLE$/i && $p[$i] =~ /^TITLE$/i) { my @s = @p[$i + 1 .. $i + 10]; return &widget_out_op_cmd_title_single({ line => \@s }); } elsif($p[$i] =~ /^TITLE$/i) { $i += 10; } # elsif($arg->{what} =~ /^TRIGGER$/i && $p[$i] =~ /^TRIGGER$/i) { return &widget_out_op_cmd_bool_single({ line => $p[++$i] }); } elsif($p[$i] =~ /^TRIGGER$/i) { $i++; } # elsif($arg->{what} =~ /^TYPE$/i && $p[$i] =~ /^TYPE$/i) { return &widget_out_op_cmd_bool_single({ line => $p[++$i] }); } elsif($p[$i] =~ /^TYPE$/i) { $i++; } # elsif($arg->{what} =~ /^VALUE$/i && $p[$i] =~ /^VALUE$/i) { return &widget_out_op_cmd_value_single({ line => $p[++$i] }); } elsif($p[$i] =~ /^VALUE$/i) { $i++; } } } sub widget_out_op_cmd_bool_single { my ($arg) = @_; return $arg->{line}; } sub widget_out_op_cmd_border_double { my ($arg) = @_; return &widget_out_op_cmd_color_single({ line => @{ $arg->{line} }[0] }) . "," . "\n" . "\t" . @{ $arg->{line} }[1]; } sub widget_out_op_cmd_color_single { my ($arg) = @_; my @c = split(/:/, $arg->{line}); if(@c < 2) { my $c = &widget_colors_x11(); my %c = %{ $c }; if($c{lc($c[0])}) { $c[1] = $c{lc($c[0])}; } else { $c[1] = "0xffffffff"; &msg_warn({ mess => "Color definition " . $c[0] . " is unknown, using default " . $c[1] }); } $c[0] = "rgb"; } # substr($c[1], 0, 1, "") if($c[1] =~ /^#/); substr($c[1], 0, 2, "") if($c[1] =~ /^0x/i); # my @r = (0, 0, 0, 0); foreach my $c (split(//, $c[0])) { my $d = substr($c[1], 0, 2, ""); if($d eq "") { &msg_fail({ mess => "Color definition '" . $arg->{line} . "' is invalid" }); return; } $d = "0x" . $d; if($c =~ /r/i) { $r[0] = $d; } elsif($c =~ /g/i) { $r[1] = $d; } elsif($c =~ /b/i) { $r[2] = $d; } elsif($c =~ /a/i) { $r[3] = $d; } } # return "#if defined(IS_BIGENDIAN)" . "\n" . "\t" . "{ { { " . join(", ", @r) . " } } }," . "\n" . "#else" . "\n" . "\t" . "{ { { " . join(", ", reverse(@r)) . " } } }," . "\n" . "#endif //"; } sub widget_out_op_cmd_image_single { my ($arg) = @_; return "(\"" . &widget_out_hex_bytes({ str => $arg->{line} }) . "\")"; } sub widget_out_op_cmd_label_single { my ($arg) = @_; my $r = ""; # my $s = ""; my $n = 0; # This is the label... # if(@{ $arg->{line} }[0]) { $s = @{ $arg->{line} }[0]; $n = &widget_out_len_bytes({ str => $s }); $s = "(\"" . &widget_out_hex_bytes({ str => $s }) . "\")"; } else { $s = "NULL"; $n = 0; } $r .= "{ " . $s . "," . "\n\t" . $n . ", "; # ...then the charset... # if(@{ $arg->{line} }[1]) { $s = "(\"" . &widget_out_hex_bytes({ str => @{ $arg->{line} }[1] }) . "\")"; } else { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_CHARSET'}) { $s = "(\"" . &widget_out_hex_bytes({ str => $HEADER_ST{'@WIDGET_DEFAULT_TITLE_CHARSET'} }) . "\")"; } else { $s = "NULL"; } } $r .= $s . ", "; # ...and the font... # if(@{ $arg->{line} }[4]) { $s = "(\"" . &widget_out_hex_bytes({ str => @{ $arg->{line} }[4] }) . "\")"; } else { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_FONT'}) { $s = "(\"" . &widget_out_hex_bytes({ str => $HEADER_ST{'@WIDGET_DEFAULT_TITLE_FONT'} }) . "\")"; } else { $s = "NULL"; } } $r .= $s . ", "; if(@{ $arg->{line} }[6] eq "WIDGET_DEFAULT_FONT_SIZE") { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_SIZE'}) { $r .= $HEADER_ST{'@WIDGET_DEFAULT_TITLE_SIZE'} . ", "; } else { $r .= @{ $arg->{line} }[6] . ", "; } } else { $r .= @{ $arg->{line} }[6] . ", "; } if(@{ $arg->{line} }[3] eq "WIDGET_DEFAULT_FONT_DPI") { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_DPI'}) { $r .= $HEADER_ST{'@WIDGET_DEFAULT_TITLE_DPI'} . ", " . "\n"; } else { $r .= @{ $arg->{line} }[3] . "," . "\n"; } } else { $r .= @{ $arg->{line} }[3] . "," . "\n"; } # ...the color... # $r .= &widget_out_op_cmd_color_single({ line => @{ $arg->{line} }[2] }) . "," . "\n"; # ...and the other stuff # if(@{ $arg->{line} }[5] eq "WIDGET_TITLE_JUSTIFICATION_NONE") { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_JUSTIFICATION'}) { $s = "WIDGET_TITLE_JUSTIFICATION_" . uc($HEADER_ST{'@WIDGET_DEFAULT_TITLE_JUSTIFICATION'}); } else { $s = @{ $arg->{line} }[5]; } } else { $s = @{ $arg->{line} }[5]; } $r .= "\t" . $s . ", 0, IS_NO," . "\n"; $r .= "\t\t" . "{ 0, 0, 0 }," . "\n"; $r .= "\t\t" . "{ 0, 0, 0, 0, { { { 0, 0, 0, 0 } } } }," . "\n"; $r .= "\t\t" . "{ 0, 0, 0, 0, { 0, 0 }, { 0, 0 }, NULL }" . "\n"; $r .= "\t" . "}"; return $r; } sub widget_out_op_cmd_light_single { my ($arg) = @_; my $r = $arg->{line}; if($arg->{line} eq "IS_YES") { return "1"; } return "0"; } sub widget_out_op_cmd_string_single { my ($arg) = @_; return "(\"" . &widget_out_hex_bytes({ str => $arg->{line} }) . "\"), " . &widget_out_len_bytes({ str => $arg->{line} }); } sub widget_out_op_cmd_title_single { my ($arg) = @_; my $r = ""; # my $s = ""; my $n = 0; # This is the title... # if(@{ $arg->{line} }[0]) { $s = @{ $arg->{line} }[0]; $n = &widget_out_len_bytes({ str => $s }); $s = "(\"" . &widget_out_hex_bytes({ str => $s }) . "\")"; } else { $s = "NULL"; $n = 0; } $r .= "{ " . $s . "," . "\n\t" . $n . ", "; # ...then the charset... # if(@{ $arg->{line} }[1]) { $s = "(\"" . &widget_out_hex_bytes({ str => @{ $arg->{line} }[1] }) . "\")"; } else { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_CHARSET'}) { $s = "(\"" . &widget_out_hex_bytes({ str => $HEADER_ST{'@WIDGET_DEFAULT_TITLE_CHARSET'} }) . "\")"; } else { $s = "NULL"; } } $r .= $s . ", "; # ...and the font... # if(@{ $arg->{line} }[4]) { $s = "(\"" . &widget_out_hex_bytes({ str => @{ $arg->{line} }[4] }) . "\")"; } else { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_FONT'}) { $s = "(\"" . &widget_out_hex_bytes({ str => $HEADER_ST{'@WIDGET_DEFAULT_TITLE_FONT'} }) . "\")"; } else { $s = "NULL"; } } $r .= $s . ", "; if(@{ $arg->{line} }[7] eq "WIDGET_DEFAULT_FONT_SIZE") { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_SIZE'}) { $r .= $HEADER_ST{'@WIDGET_DEFAULT_TITLE_SIZE'} . ", "; } else { $r .= @{ $arg->{line} }[7] . ", "; } } else { $r .= @{ $arg->{line} }[7] . ", "; } if(@{ $arg->{line} }[3] eq "WIDGET_DEFAULT_FONT_DPI") { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_DPI'}) { $r .= $HEADER_ST{'@WIDGET_DEFAULT_TITLE_DPI'} . ", " . "\n"; } else { $r .= @{ $arg->{line} }[3] . "," . "\n"; } } else { $r .= @{ $arg->{line} }[3] . "," . "\n"; } # ...the color... # $r .= &widget_out_op_cmd_color_single({ line => @{ $arg->{line} }[2] }) . "," . "\n"; # ...the other stuff... # if(@{ $arg->{line} }[5] eq "WIDGET_TITLE_JUSTIFICATION_NONE") { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_JUSTIFICATION'}) { $s = "WIDGET_TITLE_JUSTIFICATION_" . uc($HEADER_ST{'@WIDGET_DEFAULT_TITLE_JUSTIFICATION'}); } else { $s = @{ $arg->{line} }[5]; } } else { $s = @{ $arg->{line} }[5]; } $r .= "\t" . $s . ", 0, IS_NO," . "\n"; $r .= "\t\t" . "{ 0, 0, 0 }," . "\n"; $r .= "\t\t" . "{ 0, 0, 0, 0, { { { 0, 0, 0, 0 } } } }," . "\n"; $r .= "\t\t" . "{ 0, 0, 0, 0, { 0, 0 }, { 0, 0 }, NULL }" . "\n"; $r .= "\t" . "}," . "\n"; # ...and last, the position info # if(@{ $arg->{line} }[6] eq "WIDGET_TITLE_POSITION_NONE") { if($HEADER_ST{'@WIDGET_DEFAULT_TITLE_POSITION'}) { $s = "WIDGET_TITLE_POSITION_" . uc($HEADER_ST{'@WIDGET_DEFAULT_TITLE_POSITION'}); } else { $s = @{ $arg->{line} }[6]; } } else { $s = @{ $arg->{line} }[6]; } $r .= "\t" . $s . ", " . @{ $arg->{line} }[8] . ", " . @{ $arg->{line} }[9]; return $r; } sub widget_out_op_cmd_value_single { my ($arg) = @_; return $arg->{line}; } sub widget_out_op_cmd_value_multi { my ($arg) = @_; return join(", ", @{ $arg->{line} }); } # sub widget_out_op_def { my ($arg) = @_; my %o = ( "ANGLE" => "0, 0", "BORDER" => "{ { { 0, 0, 0, 0 } } }, 0", "COLOR" => "{ { { 0, 0, 0, 0 } } }", "HUE" => "0", "IMAGE" => "NULL", "LABEL" => "{ " . "NULL, 0, NULL, NULL, WIDGET_DEFAULT_FONT_SIZE, WIDGET_DEFAULT_FONT_DPI," . "\n" . "\t" . "{ { { 0, 0, 0, 0 } } }," . "\n" . "\t" . "WIDGET_TITLE_JUSTIFICATION_NONE, 0, IS_NO," . "\n" . "\t" . "{ 0, 0, 0 }," . "\n" . "\t" . "{ 0, 0, 0, 0, { { { 0, 0, 0, 0 } } } }," . "\n" . "\t" . "{ 0, 0, 0, 0, { 0, 0 }, { 0, 0 }, NULL }" . "\n" . "\t" . "}", "LIGHT" => "0", "NAME" => "NULL, 0", "POSITION" => "0, 0", "SET" => "0", "SIZE" => "0, 0", "SLIDE" => "0, 0, 0", "STATE" => "WIDGET_STATE_ENABLE", "STEPS" => "0, 0", "STICKY" => "IS_NO", "TITLE" => "{ " . "NULL, 0, NULL, NULL, WIDGET_DEFAULT_FONT_SIZE, WIDGET_DEFAULT_FONT_DPI," . "\n" . "\t" . "{ { { 0, 0, 0, 0 } } }," . "\n" . "\t" . "WIDGET_TITLE_JUSTIFICATION_NONE, 0, IS_NO," . "\n" . "\t" . "{ 0, 0, 0 }," . "\n" . "\t" . "{ 0, 0, 0, 0, { { { 0, 0, 0, 0 } } } }," . "\n" . "\t" . "{ 0, 0, 0, 0, { 0, 0 }, { 0, 0 }, NULL }" . "\n" . "\t" . "}," . "\n" . "\t" . "WIDGET_TITLE_POSITION_NONE, 0, 0", "TRIGGER" => "WIDGET_TRIGGER_RELEASE", "TYPE" => "0", "VALUE" => "0" ); # Check if user provided defaults in source file... # if($arg->{what} =~ /^COLOR$/i && $HEADER_ST{'@WIDGET_DEFAULT_COLOR'} ne "") { return &widget_out_op_cmd_color_single({ line => $HEADER_ST{'@WIDGET_DEFAULT_COLOR'} }); } elsif($arg->{what} =~ /^HUE$/i && $HEADER_ST{'@WIDGET_DEFAULT_HUE'} ne "") { my @s = split(/\t/, &widget_cmd_hue_op({ line => $HEADER_ST{'@WIDGET_DEFAULT_HUE'} })); return $s[1]; } elsif($arg->{what} =~ /^LIGHT$/i && $HEADER_ST{'@WIDGET_DEFAULT_LIGHT'} ne "") { my @s = split(/\t/, &widget_cmd_light_op({ line => $HEADER_ST{'@WIDGET_DEFAULT_LIGHT'} })); return $s[1]; } elsif($arg->{what} =~ /^STATE$/i && $HEADER_ST{'@WIDGET_DEFAULT_STATE'} ne "") { my @s = split(/\t/, &widget_cmd_state_op({ line => $HEADER_ST{'@WIDGET_DEFAULT_STATE'} })); return $s[1]; } elsif($arg->{what} =~ /^STICKY$/i && $HEADER_ST{'@WIDGET_DEFAULT_STICKY'} ne "") { my @s = split(/\t/, &widget_cmd_sticky_op({ line => $HEADER_ST{'@WIDGET_DEFAULT_STICKY'} })); return $s[1]; } elsif($arg->{what} =~ /^TRIGGER$/i && $HEADER_ST{'@WIDGET_DEFAULT_TRIGGER'} ne "") { my @s = split(/\t/, &widget_cmd_trigger_op({ line => $HEADER_ST{'@WIDGET_DEFAULT_TRIGGER'} })); return $s[1]; } elsif($arg->{what} =~ /^TYPE$/i && $HEADER_ST{'@WIDGET_DEFAULT_TYPE'} ne "") { my @s = split(/\t/, &widget_cmd_type_op({ line => $HEADER_ST{'@WIDGET_DEFAULT_TYPE'} })); return $s[1]; } elsif($arg->{what} =~ /^VALUE$/i && $HEADER_ST{'@WIDGET_DEFAULT_VALUE'} ne "") { my @s = split(/\t/, &widget_cmd_value_op({ line => $HEADER_ST{'@WIDGET_DEFAULT_VALUE'} })); return $s[1]; } # ...and if not, use hardcoded default # return $o{$arg->{what}}; } # sub widget_out_bg { my ($arg) = @_; print STDOUT "/**" . "\n"; print STDOUT " *" . " This file is automatically generated." . " To make changes, edit source file" . "\n"; print STDOUT " *" . "\n"; print STDOUT " *" . " " . $arg->{file} . "\n"; print STDOUT " *" . "\n"; print STDOUT " *" . " and regenerate this file by running:" . "\n"; print STDOUT " *" . "\n"; print STDOUT " *" . " \$ " . $arg->{this} . " " . $arg->{file} . " > engine/widget_defs.h" . "\n"; print STDOUT " *" . "\n"; print STDOUT " */" . "\n\n"; } sub widget_out_eg { my ($arg) = @_; # print STDOUT "/* Root of all widget definitions */" . "\n"; print STDOUT "static const struct widget_def widget_def_t[" . (@WINDOW_ID + 1) . "] = {" . "\n"; foreach my $c (@WINDOW_ID) { print STDOUT "\t" . "/* Widgets attached to window id " . $c . " */" . "\n"; print STDOUT "\t" . "{ " . $c . ", widget_stack_" . $c . " }," . "\n"; } # print STDOUT "\n"; print STDOUT "\t" . "{ 0, NULL }" . "\n"; print STDOUT "};" . "\n\n"; # print STDOUT "#if defined(HAVE_UNVEIL) && defined(PROG_HAS_UNVEIL)" . "\n"; print STDOUT "static const struct t_rst t_rst_t[" . (@UNVEIL_ST + 1) . "] = {" . "\n"; my @s = &widget_out_eg_st(@UNVEIL_ST); foreach my $f (sort { lc($a) cmp lc($b) } @s) { print STDOUT "\t" . "{ \"" . $f . "\", \"r\" }," . "\n"; } print STDOUT "\n\t" . "{ NULL, NULL }" . "\n"; print STDOUT "};" . "\n"; print STDOUT "#endif" . "\n\n"; # print STDOUT "/* Various flags for various reasons */" . "\n"; print STDOUT "static int widget_use_bbox = "; if($HEADER_ST{'@WIDGET_USE_BOUNDING_BOXES'} && $HEADER_ST{'@WIDGET_USE_BOUNDING_BOXES'} !~ /^n/i) { print STDOUT "IS_YES"; } else { print STDOUT "IS_NO"; } print STDOUT ";" . "\n\n"; # my $e = $arg->{file}; $e =~ s/"/\\"/go; print STDOUT "#define DSL_COMPILER_VER \"" . $DSL_COMPILER_VER . "\"" . "\n\n"; print STDOUT "/* Check the Makefile before changing this in any way */" . "\n"; print STDOUT "#define DSL_EMBEDDED_W2C \"" . $e . "\"" . "\n\n"; # print STDOUT "/* " . @WINDOW_ID . " top level items processed at " . localtime() . " */" . "\n"; } sub widget_out_eg_st { my %s; grep !$s{$_}++, @_; } # sub widget_out_min { my ($arg) = @_; print STDOUT "static const struct widget_def widget_def_t[1] = {" . "\n"; print STDOUT "\t" . "{ 0, NULL }" . "\n"; print STDOUT "};" . "\n\n"; print STDOUT "#if defined(HAVE_UNVEIL) && defined(PROG_HAS_UNVEIL)" . "\n"; print STDOUT "static const struct t_rst t_rst_t[1] = {" . "\n"; print STDOUT "\t" . "{ NULL, NULL }" . "\n"; print STDOUT "};" . "\n"; print STDOUT "#endif" . "\n\n"; print STDOUT "static int widget_use_bbox = IS_NO;" . "\n\n"; print STDOUT "#define DSL_COMPILER_VER \"" . $DSL_COMPILER_VER . "\"" . "\n"; print STDOUT "#define DSL_EMBEDDED_W2C \"" . "empty" . "\"" . "\n"; exit(0); } # sub widget_colors_x11 { my ($arg) = @_; my %c = ( 'aliceblue' => '0xf0f8ff00', 'alizarincrimson' => '0xe3263600', 'antiquewhite1' => '0xffefdb00', 'antiquewhite2' => '0xeedfcc00', 'antiquewhite3' => '0xcdc0b000', 'antiquewhite4' => '0x8b837800', 'antiquewhite' => '0xfaebd700', 'aquamarine1' => '0x7fffd400', 'aquamarine2' => '0x76eec600', 'aquamarine3' => '0x66cdaa00', 'aquamarine4' => '0x458b7400', 'aquamarinemedium' => '0x66cdaa00', 'aquamarine' => '0x7fffd400', 'aqua' => '0x00ffff00', 'aureolineyellow' => '0xffa82400', 'azure1' => '0xf0ffff00', 'azure2' => '0xe0eeee00', 'azure3' => '0xc1cdcd00', 'azure4' => '0x838b8b00', 'azure' => '0xf0ffff00', 'banana' => '0xe3cf5700', 'beige' => '0xa3948000', 'bisque1' => '0xffe4c400', 'bisque2' => '0xeed5b700', 'bisque3' => '0xcdb79e00', 'bisque4' => '0x8b7d6b00', 'bisque' => '0xffe4c400', 'black' => '0x00000000', 'blanchedalmond' => '0xffebcd00', 'blue1' => '0x0000ff00', 'blue2' => '0x0000ee00', 'blue3' => '0x0000cd00', 'blue4' => '0x00008b00', 'bluelight' => '0xadd8e600', 'bluemedium' => '0x0000cd00', 'blueviolet' => '0x8a2be200', 'blue' => '0x0000ff00', 'brick' => '0x9c661f00', 'brown1' => '0xff404000', 'brown2' => '0xee3b3b00', 'brown3' => '0xcd333300', 'brown4' => '0x8b232300', 'brownmadder' => '0xdb292900', 'brownochre' => '0x87421f00', 'brown' => '0x802a2a00', 'burlywood1' => '0xffd39b00', 'burlywood2' => '0xeec59100', 'burlywood3' => '0xcdaa7d00', 'burlywood4' => '0x8b735500', 'burlywood' => '0xdeb88700', 'burntsienna' => '0x8a360f00', 'burntumber' => '0x8a332400', 'cadetblue1' => '0x98f5ff00', 'cadetblue2' => '0x8ee5ee00', 'cadetblue3' => '0x7ac5cd00', 'cadetblue4' => '0x53868b00', 'cadetblue' => '0x7e7da000', 'cadet' => '0x5f9ea000', 'cadmiumlemon' => '0xffe30300', 'cadmiumorange' => '0xff610300', 'cadmiumreddeep' => '0xe3170d00', 'cadmiumredlight' => '0xff030d00', 'cadmiumyellowlight' => '0xffb00f00', 'cadmiumyellow' => '0xff991200', 'carrot' => '0xed912100', 'cerulean' => '0x05b8cc00', 'chartreuse1' => '0x7fff0000', 'chartreuse2' => '0x76ee0000', 'chartreuse3' => '0x66cd0000', 'chartreuse4' => '0x458b0000', 'chartreuse' => '0x7fff0000', 'chocolate1' => '0xff7f2400', 'chocolate2' => '0xee762100', 'chocolate3' => '0xcd661d00', 'chocolate4' => '0x8b451300', 'chocolate' => '0xd2691e00', 'chromeoxidegreen' => '0x66801400', 'cinnabargreen' => '0x61b32900', 'cobaltgreen' => '0x3d914000', 'cobaltvioletdeep' => '0x91219e00', 'cobalt' => '0x3d59ab00', 'coldgray' => '0x808a8700', 'coral1' => '0xff725600', 'coral2' => '0xee6a5000', 'coral3' => '0xcd5b4500', 'coral4' => '0x8b3e2f00', 'corallight' => '0xf0808000', 'coral' => '0xff7f5000', 'cornflowerblue' => '0x6495ed00', 'cornflower' => '0x6495ed00', 'cornsilk1' => '0xfff8dc00', 'cornsilk2' => '0xeee8cd00', 'cornsilk3' => '0xcdc8b100', 'cornsilk4' => '0x8b887800', 'cornsilk' => '0xfff8dc00', 'cyan1' => '0x00ffff00', 'cyan2' => '0x00eeee00', 'cyan3' => '0x00cdcd00', 'cyan4' => '0x008b8b00', 'cyanwhite' => '0xe0ffff00', 'cyan' => '0x00ffff00', 'darkblue' => '0x00008b00', 'darkcyan' => '0x008b8b00', 'darkgoldenrod1' => '0xffb90f00', 'darkgoldenrod2' => '0xeead0e00', 'darkgoldenrod3' => '0xcd950c00', 'darkgoldenrod4' => '0x8b650800', 'darkgray' => '0xa9a9a900', 'darkgreen' => '0x00530000', 'darkkhaki' => '0xbdb76b00', 'darkmagenta' => '0x8b008b00', 'darkolivegreen1' => '0xcaff7000', 'darkolivegreen2' => '0xbcee6800', 'darkolivegreen3' => '0xa2cd5a00', 'darkolivegreen4' => '0x6e8b3d00', 'darkolivegreen' => '0x4f4f2f00', 'darkorange1' => '0xff7f0000', 'darkorange2' => '0xee760000', 'darkorange3' => '0xcd660000', 'darkorange4' => '0x8b450000', 'darkorange' => '0xff8c0000', 'darkorchid1' => '0xbf3eff00', 'darkorchid2' => '0xb23aee00', 'darkorchid3' => '0x9a32cd00', 'darkorchid4' => '0x68228b00', 'darkorchid' => '0x6a256600', 'darkred' => '0x8b000000', 'darksalmon' => '0xe9967a00', 'darkseagreen1' => '0xc1ffc100', 'darkseagreen2' => '0xb4eeb400', 'darkseagreen3' => '0x9bcd9b00', 'darkseagreen4' => '0x698b6900', 'darkseagreen' => '0x8fbc8f00', 'darkslateblue' => '0x333e6300', 'darkslategray1' => '0x97ffff00', 'darkslategray2' => '0x8deeee00', 'darkslategray3' => '0x79cdcd00', 'darkslategray4' => '0x528b8b00', 'darkslategray' => '0x3c404a00', 'darkturquoise' => '0x1d6f7500', 'darkviolet' => '0x9400d300', 'deepochre' => '0x733d1a00', 'deeppink1' => '0xff149300', 'deeppink2' => '0xee128900', 'deeppink3' => '0xcd107600', 'deeppink4' => '0x8b0a5000', 'deeppink' => '0xff149300', 'deepskyblue1' => '0x00bfff00', 'deepskyblue2' => '0x00b2ee00', 'deepskyblue3' => '0x009acd00', 'deepskyblue4' => '0x00688b00', 'deepskyblue' => '0x00bfff00', 'dimgray' => '0x69696900', 'dodgerblue1' => '0x1e90ff00', 'dodgerblue2' => '0x1c86ee00', 'dodgerblue3' => '0x1874cd00', 'dodgerblue4' => '0x104e8b00', 'dodgerblue' => '0x1e90ff00', 'eggshell' => '0xfce6c900', 'emeraldgreen' => '0x00c95700', 'englishred' => '0xd43d1a00', 'firebrick1' => '0xff303000', 'firebrick2' => '0xee2c2c00', 'firebrick3' => '0xcd262600', 'firebrick4' => '0x8b1a1a00', 'firebrick' => '0xb2222200', 'fleshochre' => '0xff572100', 'flesh' => '0xff7d4000', 'floralwhite' => '0xfffaf000', 'forestgreen' => '0x55c03400', 'fuchsia' => '0xff00ff00', 'gainsboro' => '0xdcdcdc00', 'geraniumlake' => '0xe3123000', 'ghostwhite' => '0xf8f8ff00', 'gold1' => '0xffd70000', 'gold2' => '0xeec90000', 'gold3' => '0xcdad0000', 'gold4' => '0x8b750000', 'goldenrod1' => '0xffc12500', 'goldenrod2' => '0xeeb42200', 'goldenrod3' => '0xcd9b1d00', 'goldenrod4' => '0x8b691400', 'goldenroddark' => '0xb8860b00', 'goldenrodlight' => '0xfafad200', 'goldenrodpale' => '0xeee8aa00', 'goldenrod' => '0xdaa52000', 'goldochre' => '0xc7782600', 'gold' => '0xffd70000', 'gray0' => '0x00000000', 'gray100' => '0xffffff00', 'gray10' => '0x1a1a1a00', 'gray11' => '0x1c1c1c00', 'gray12' => '0x1f1f1f00', 'gray13' => '0x21212100', 'gray14' => '0x24242400', 'gray15' => '0x26262600', 'gray16' => '0x29292900', 'gray17' => '0x2b2b2b00', 'gray18' => '0x2e2e2e00', 'gray19' => '0x30303000', 'gray1' => '0x03030300', 'gray20' => '0x33333300', 'gray21' => '0x36363600', 'gray22' => '0x38383800', 'gray23' => '0x3b3b3b00', 'gray24' => '0x3d3d3d00', 'gray25' => '0x40404000', 'gray26' => '0x42424200', 'gray27' => '0x45454500', 'gray28' => '0x47474700', 'gray29' => '0x4a4a4a00', 'gray2' => '0x05050500', 'gray30' => '0x4d4d4d00', 'gray31' => '0x4f4f4f00', 'gray32' => '0x52525200', 'gray33' => '0x54545400', 'gray34' => '0x57575700', 'gray35' => '0x59595900', 'gray36' => '0x5c5c5c00', 'gray37' => '0x5e5e5e00', 'gray38' => '0x61616100', 'gray39' => '0x63636300', 'gray3' => '0x08080800', 'gray40' => '0x66666600', 'gray41' => '0x69696900', 'gray42' => '0x6b6b6b00', 'gray43' => '0x6e6e6e00', 'gray44' => '0x70707000', 'gray45' => '0x73737300', 'gray46' => '0x75757500', 'gray47' => '0x78787800', 'gray48' => '0x7a7a7a00', 'gray49' => '0x7d7d7d00', 'gray4' => '0x0a0a0a00', 'gray50' => '0x7f7f7f00', 'gray51' => '0x82828200', 'gray52' => '0x85858500', 'gray53' => '0x87878700', 'gray54' => '0x8a8a8a00', 'gray55' => '0x8c8c8c00', 'gray56' => '0x8f8f8f00', 'gray57' => '0x91919100', 'gray58' => '0x94949400', 'gray59' => '0x96969600', 'gray5' => '0x0d0d0d00', 'gray60' => '0x99999900', 'gray61' => '0x9c9c9c00', 'gray62' => '0x9e9e9e00', 'gray63' => '0xa1a1a100', 'gray64' => '0xa3a3a300', 'gray65' => '0xa6a6a600', 'gray66' => '0xa8a8a800', 'gray67' => '0xababab00', 'gray68' => '0xadadad00', 'gray69' => '0xb0b0b000', 'gray6' => '0x0f0f0f00', 'gray70' => '0xb3b3b300', 'gray71' => '0xb5b5b500', 'gray72' => '0xb8b8b800', 'gray73' => '0xbababa00', 'gray74' => '0xbdbdbd00', 'gray75' => '0xbfbfbf00', 'gray76' => '0xc2c2c200', 'gray77' => '0xc4c4c400', 'gray78' => '0xc7c7c700', 'gray79' => '0xc9c9c900', 'gray7' => '0x12121200', 'gray80' => '0xcccccc00', 'gray81' => '0xcfcfcf00', 'gray82' => '0xd1d1d100', 'gray83' => '0xd4d4d400', 'gray84' => '0xd6d6d600', 'gray85' => '0xd9d9d900', 'gray86' => '0xdbdbdb00', 'gray87' => '0xdedede00', 'gray88' => '0xe0e0e000', 'gray89' => '0xe3e3e300', 'gray8' => '0x14141400', 'gray90' => '0xe5e5e500', 'gray91' => '0xe8e8e800', 'gray92' => '0xebebeb00', 'gray93' => '0xededed00', 'gray94' => '0xf0f0f000', 'gray95' => '0xf2f2f200', 'gray96' => '0xf5f5f500', 'gray97' => '0xf7f7f700', 'gray98' => '0xfafafa00', 'gray99' => '0xfcfcfc00', 'gray9' => '0x17171700', 'gray' => '0x80808000', 'green1' => '0x00ff0000', 'green2' => '0x00ee0000', 'green3' => '0x00cd0000', 'green4' => '0x008b0000', 'greendark' => '0x00640000', 'greenishumber' => '0xff3d0d00', 'greenpale' => '0x98fb9800', 'greenyellow' => '0xadff2f00', 'green' => '0x00800000', 'honeydew1' => '0xf0fff000', 'honeydew2' => '0xe0eee000', 'honeydew3' => '0xc1cdc100', 'honeydew4' => '0x838b8300', 'honeydew' => '0xf0fff000', 'hotpink1' => '0xff6eb400', 'hotpink2' => '0xee6aa700', 'hotpink3' => '0xcd609000', 'hotpink4' => '0x8b3a6200', 'hotpink' => '0xff69b400', 'indianred1' => '0xff6a6a00', 'indianred2' => '0xee636300', 'indianred3' => '0xcd555500', 'indianred4' => '0x8b3a3a00', 'indianred' => '0xb0171f00', 'indigo' => '0x2e085400', 'ivory1' => '0xfffff000', 'ivory2' => '0xeeeee000', 'ivory3' => '0xcdcdc100', 'ivory4' => '0x8b8b8300', 'ivoryblack' => '0x29242100', 'ivory' => '0xfffff000', 'khaki1' => '0xfff68f00', 'khaki2' => '0xeee68500', 'khaki3' => '0xcdc67300', 'khaki4' => '0x8b864e00', 'khakidark' => '0xbdb76b00', 'khaki' => '0xf0e68c00', 'lampblack' => '0x2e473b00', 'lavenderblush1' => '0xfff0f500', 'lavenderblush2' => '0xeee0e500', 'lavenderblush3' => '0xcdc1c500', 'lavenderblush4' => '0x8b838600', 'lavenderblush' => '0xfff0f500', 'lavender' => '0xe6e6fa00', 'lawngreen' => '0x7cfc0000', 'lemonchiffon1' => '0xfffacd00', 'lemonchiffon2' => '0xeee9bf00', 'lemonchiffon3' => '0xcdc9a500', 'lemonchiffon4' => '0x8b897000', 'lemonchiffon' => '0xfffacd00', 'lightbeige' => '0xf5f5dc00', 'lightblue1' => '0xbfefff00', 'lightblue2' => '0xb2dfee00', 'lightblue3' => '0x9ac0cd00', 'lightblue4' => '0x68838b00', 'lightblue' => '0xabc5ff00', 'lightcoral' => '0xf0808000', 'lightcyan1' => '0xe0ffff00', 'lightcyan2' => '0xd1eeee00', 'lightcyan3' => '0xb4cdcd00', 'lightcyan4' => '0x7a8b8b00', 'lightcyan' => '0xe0ffff00', 'lightgoldenrod1' => '0xffec8b00', 'lightgoldenrod2' => '0xeedc8200', 'lightgoldenrod3' => '0xcdbe7000', 'lightgoldenrod4' => '0x8b814c00', 'lightgoldenrodyellow' => '0xfafad200', 'lightgoldenrod' => '0xeedd8200', 'lightgray' => '0xd3d3d300', 'lightgreen' => '0x90ee9000', 'lightpink1' => '0xffaeb900', 'lightpink2' => '0xeea2ad00', 'lightpink3' => '0xcd8c9500', 'lightpink4' => '0x8b5f6500', 'lightpink' => '0xffb6c100', 'lightsalmon1' => '0xffa07a00', 'lightsalmon2' => '0xee957200', 'lightsalmon3' => '0xcd816200', 'lightsalmon4' => '0x8b574200', 'lightsalmon' => '0xffa07a00', 'lightseagreen' => '0x20b2aa00', 'lightskyblue1' => '0xb0e2ff00', 'lightskyblue2' => '0xa4d3ee00', 'lightskyblue3' => '0x8db6cd00', 'lightskyblue4' => '0x607b8b00', 'lightskyblue' => '0x87cefa00', 'lightslateblue' => '0x8470ff00', 'lightslategray' => '0x77889900', 'lightsteelblue1' => '0xcae1ff00', 'lightsteelblue2' => '0xbcd2ee00', 'lightsteelblue3' => '0xa2b5cd00', 'lightsteelblue4' => '0x6e7b8b00', 'lightsteelblue' => '0x3498ca00', 'lightyellow1' => '0xffffe000', 'lightyellow2' => '0xeeeed100', 'lightyellow3' => '0xcdcdb400', 'lightyellow4' => '0x8b8b7a00', 'lightyellow' => '0xffffe000', 'limegreen' => '0x32cd3200', 'lime' => '0x00ff0000', 'linen' => '0xfaf0e600', 'madderlakedeep' => '0xe32e3000', 'magenta1' => '0xff00ff00', 'magenta2' => '0xee00ee00', 'magenta3' => '0xcd00cd00', 'magenta4' => '0x8b008b00', 'magenta' => '0xff00d300', 'manganeseblue' => '0x03a89e00', 'maroon1' => '0xff34b300', 'maroon2' => '0xee30a700', 'maroon3' => '0xcd299000', 'maroon4' => '0x8b1c6200', 'maroon' => '0x80000000', 'marsorange' => '0x96451400', 'marsyellow' => '0xe3701a00', 'mediumaquamarine' => '0x15877600', 'mediumblue' => '0x3d62d000', 'mediumforestgreen' => '0x6b8e2300', 'mediumgoldenrod' => '0xb8860b00', 'mediumorchid1' => '0xe066ff00', 'mediumorchid2' => '0xd15fee00', 'mediumorchid3' => '0xb452cd00', 'mediumorchid4' => '0x7a378b00', 'mediumorchid' => '0xac4da600', 'mediumpurple1' => '0xab82ff00', 'mediumpurple2' => '0x9f79ee00', 'mediumpurple3' => '0x8968cd00', 'mediumpurple4' => '0x5d478b00', 'mediumpurple' => '0x9370db00', 'mediumseagreen' => '0x1b865600', 'mediumslateblue' => '0x5f6d9a00', 'mediumspringgreen' => '0x3c8d2300', 'mediumturquoise' => '0x3eacb500', 'mediumvioletred' => '0xc7158500', 'melon' => '0xe3a86900', 'midnightblue' => '0x19197000', 'mintcream' => '0xf5fffa00', 'mint' => '0xbdfcc900', 'mistyrose1' => '0xffe4e100', 'mistyrose2' => '0xeed5d200', 'mistyrose3' => '0xcdb7b500', 'mistyrose4' => '0x8b7d7b00', 'mistyrose' => '0xffe4e100', 'moccasin' => '0xffe4b500', 'naplesyellowdeep' => '0xffa81200', 'navajowhite1' => '0xffdead00', 'navajowhite2' => '0xeecfa100', 'navajowhite3' => '0xcdb38b00', 'navajowhite4' => '0x8b795e00', 'navajowhite' => '0xffdead00', 'navyblue' => '0x00008e00', 'navy' => '0x00008000', 'oldlace' => '0xfdf5e600', 'olivedrab1' => '0xc0ff3e00', 'olivedrab2' => '0xb3ee3a00', 'olivedrab3' => '0x9acd3200', 'olivedrab4' => '0x698b2200', 'olivedrab' => '0x6b8e2300', 'olivegreendark' => '0x556b2f00', 'olive' => '0x80800000', 'orange1' => '0xffa50000', 'orange2' => '0xee9a0000', 'orange3' => '0xcd850000', 'orange4' => '0x8b5a0000', 'orangered1' => '0xff450000', 'orangered2' => '0xee400000', 'orangered3' => '0xcd370000', 'orangered4' => '0x8b250000', 'orangered' => '0xe2412a00', 'orange' => '0xff8a0000', 'orchid1' => '0xff83fa00', 'orchid2' => '0xee7ae900', 'orchid3' => '0xcd69c900', 'orchid4' => '0x8b478900', 'orchiddark' => '0x9932cc00', 'orchidmedium' => '0xba55d300', 'orchid' => '0xda6bd400', 'palegoldenrod' => '0xeee8aa00', 'palegreen1' => '0x9aff9a00', 'palegreen2' => '0x90ee9000', 'palegreen3' => '0x7ccd7c00', 'palegreen4' => '0x548b5400', 'palegreen' => '0x98ff9800', 'paleturquoise1' => '0xbbffff00', 'paleturquoise2' => '0xaeeeee00', 'paleturquoise3' => '0x96cdcd00', 'paleturquoise4' => '0x668b8b00', 'paleturquoise' => '0xafeeee00', 'palevioletred1' => '0xff82ab00', 'palevioletred2' => '0xee799f00', 'palevioletred3' => '0xcd688900', 'palevioletred4' => '0x8b475d00', 'palevioletred' => '0xdb709300', 'papayawhip' => '0xffefd500', 'peachpuff1' => '0xffdab900', 'peachpuff2' => '0xeecbad00', 'peachpuff3' => '0xcdaf9500', 'peachpuff4' => '0x8b776500', 'peachpuff' => '0xffdab900', 'peacock' => '0x33a1c900', 'permanentgreen' => '0x0ac92b00', 'permanentredviolet' => '0xdb264500', 'peru' => '0xcd853f00', 'pink1' => '0xffb5c500', 'pink2' => '0xeea9b800', 'pink3' => '0xcd919e00', 'pink4' => '0x8b636c00', 'pinklight' => '0xffb6c100', 'pink' => '0xffc0cb00', 'plum1' => '0xffbbff00', 'plum2' => '0xeeaeee00', 'plum3' => '0xcd96cd00', 'plum4' => '0x8b668b00', 'plum' => '0xdda0dd00', 'powderblue' => '0xb0e0e600', 'purple1' => '0x9b30ff00', 'purple2' => '0x912cee00', 'purple3' => '0x7d26cd00', 'purple4' => '0x551a8b00', 'purplemedium' => '0x9370db00', 'purple' => '0x80008000', 'raspberry' => '0x87265700', 'rawsienna' => '0xc7611400', 'rawumber' => '0x734a1200', 'red1' => '0xff000000', 'red2' => '0xee000000', 'red3' => '0xcd000000', 'red4' => '0x8b000000', 'red' => '0xff000000', 'rosemadder' => '0xe3363800', 'rosybrown1' => '0xffc1c100', 'rosybrown2' => '0xeeb4b400', 'rosybrown3' => '0xcd9b9b00', 'rosybrown4' => '0x8b696900', 'rosybrown' => '0xbc8f8f00', 'royalblue1' => '0x4876ff00', 'royalblue2' => '0x436eee00', 'royalblue3' => '0x3a5fcd00', 'royalblue4' => '0x27408b00', 'royalblue' => '0x4169e100', 'saddlebrown' => '0x8b451300', 'salmon1' => '0xff8c6900', 'salmon2' => '0xee826200', 'salmon3' => '0xcd705400', 'salmon4' => '0x8b4c3900', 'salmon' => '0xf86d6800', 'sandybrown' => '0xb28f5600', 'sapgreen' => '0x30801400', 'seagreen1' => '0x54ff9f00', 'seagreen2' => '0x4eee9400', 'seagreen3' => '0x43cd8000', 'seagreen4' => '0x2e8b5700', 'seagreendark' => '0x8fbc8f00', 'seagreenlight' => '0x20b2aa00', 'seagreenmedium' => '0x3cb37100', 'seagreen' => '0x2e8b5700', 'seashell1' => '0xfff5ee00', 'seashell2' => '0xeee5de00', 'seashell3' => '0xcdc5bf00', 'seashell4' => '0x8b868200', 'seashell' => '0xfff5ee00', 'sepia' => '0x5e261200', 'sienna1' => '0xff824700', 'sienna2' => '0xee794200', 'sienna3' => '0xcd683900', 'sienna4' => '0x8b472600', 'sienna' => '0x8e6b2300', 'silver' => '0xc0c0c000', 'skyblue1' => '0x87ceff00', 'skyblue2' => '0x7ec0ee00', 'skyblue3' => '0x6ca6cd00', 'skyblue4' => '0x4a708b00', 'skybluedeep' => '0x00bfff00', 'skybluelight' => '0x87cefa00', 'skyblue' => '0x87ceeb00', 'slateblue1' => '0x836fff00', 'slateblue2' => '0x7a67ee00', 'slateblue3' => '0x6959cd00', 'slateblue4' => '0x473c8b00', 'slatebluedark' => '0x483d8b00', 'slatebluelight' => '0x8470ff00', 'slatebluemedium' => '0x7b68ee00', 'slateblue' => '0x7586be00', 'slategray1' => '0xc6e2ff00', 'slategray2' => '0xb9d3ee00', 'slategray3' => '0x9fb6cd00', 'slategray4' => '0x6c7b8b00', 'slategraydark' => '0x2f4f4f00', 'slategraylight' => '0x77889900', 'slategray' => '0x70809000', 'snow1' => '0xfffafa00', 'snow2' => '0xeee9e900', 'snow3' => '0xcdc9c900', 'snow4' => '0x8b898900', 'snow' => '0xfffafa00', 'springgreen1' => '0x00ff7f00', 'springgreen2' => '0x00ee7600', 'springgreen3' => '0x00cd6600', 'springgreen4' => '0x008b4500', 'springgreenmedium' => '0x00fa9a00', 'springgreen' => '0x00ff7f00', 'steelblue1' => '0x63b8ff00', 'steelblue2' => '0x5cacee00', 'steelblue3' => '0x4f94cd00', 'steelblue4' => '0x36648b00', 'steelbluelight' => '0xb0c4de00', 'steelblue' => '0x4682b400', 'tan1' => '0xffa54f00', 'tan2' => '0xee9a4900', 'tan3' => '0xcd853f00', 'tan4' => '0x8b5a2b00', 'tan' => '0xd2b48c00', 'teal' => '0x00808000', 'terreverte' => '0x385e0f00', 'thistle1' => '0xffe1ff00', 'thistle2' => '0xeed2ee00', 'thistle3' => '0xcdb5cd00', 'thistle4' => '0x8b7b8b00', 'thistle' => '0xd8bfd800', 'titaniumwhite' => '0xfcfff000', 'tomato1' => '0xff634700', 'tomato2' => '0xee5c4200', 'tomato3' => '0xcd4f3900', 'tomato4' => '0x8b362600', 'tomato' => '0xff634700', 'turquoise1' => '0x00f5ff00', 'turquoise2' => '0x00e5ee00', 'turquoise3' => '0x00c5cd00', 'turquoise4' => '0x00868b00', 'turquoiseblue' => '0x00c78c00', 'turquoisedark' => '0x00ced100', 'turquoisemedium' => '0x48d1cc00', 'turquoisepale' => '0xafeeee00', 'turquoise' => '0x48d1cc00', 'ultramarineviolet' => '0x5c246e00', 'ultramarine' => '0x120a8f00', 'vandykebrown' => '0x5e260500', 'venetianred' => '0xd41a1f00', 'violetdark' => '0x9400d300', 'violetred1' => '0xff3e9600', 'violetred2' => '0xee3a8c00', 'violetred3' => '0xcd327800', 'violetred4' => '0x8b225200', 'violetredmedium' => '0xc7158500', 'violetredpale' => '0xdb709300', 'violetred' => '0xff009400', 'violet' => '0x9400d300', 'viridianlight' => '0x6eff7000', 'warmgray' => '0x80806900', 'wheat1' => '0xffe7ba00', 'wheat2' => '0xeed8ae00', 'wheat3' => '0xcdba9600', 'wheat4' => '0x8b7e6600', 'wheat' => '0xf5deb300', 'whitesmoke' => '0xf5f5f500', 'white' => '0xffffff00', 'yellow1' => '0xffff0000', 'yellow2' => '0xeeee0000', 'yellow3' => '0xcdcd0000', 'yellow4' => '0x8b8b0000', 'yellowgreen' => '0x9acd3200', 'yellowlight' => '0xffffe000', 'yellowochre' => '0xe3821700', 'yellow' => '0xffff0000', 'zincwhite' => '0xfdf8ff00' ); return \%c; } # sub widget_out_hex_bytes { my ($arg) = @_; my $r = $arg->{str}; my $t = "\t" x 2; use bytes; $r =~ s/(.)/sprintf "\\x%2x", ord $1/seg; my @r = $r =~ /(.{1,64})/g; use utf8; return join("\"\n$t\"", @r); } sub widget_out_len_bytes { my ($arg) = @_; use bytes; my $r = length($arg->{str}); use utf8; return $r; } # sub msg_warn { my ($arg) = @_; if($arg->{line}) { print STDERR $0 . ": " . $arg->{mess} . " at line " . $arg->{line} . "\n"; } else { print STDERR $0 . ": " . $arg->{mess} . "\n"; } } sub msg_fail { my ($arg) = @_; if($arg->{line}) { &msg_warn({ mess => $arg->{mess} . " at line " . $arg->{line} . ". Abort." }); } else { &msg_warn({ mess => $arg->{mess} . ". Abort." }); } exit(1); }