view release on metacpan or  search on metacpan

lib/Games/Construder/UI.pm  view on Meta::CPAN

#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
package Games::Construder::UI;
use common::sense;
require Exporter;
use POSIX qw/floor/;
our @ISA = qw/Exporter/;
our @EXPORT = qw/
   ui_text
   ui_title
   ui_border
   ui_subtext
   ui_window
   ui_key
   ui_key_explain
   ui_key_inline_expl
   ui_desc
   ui_subdesc
   ui_caption
   ui_small_text
   ui_hud_window
   ui_hud_window_above
   ui_hud_window_transparent
   ui_hlt_border
   ui_warning
   ui_window_special
   ui_notice
   ui_select_item
   ui_range
   ui_entry
   ui_entry_small
   ui_multiline
   ui_pad_box
/;

=head1 NAME

Games::Construder::UI - Construder Userinterface Theme Definition

=over 4

=cut

our $HIGHLIGHT_BORDER_COLOR = "#ff0000";
our $BORDER_COLOR  = "#8888ff";
our $TITLE_COLOR   = "#8888ff";
our $TEXT_COLOR    = "#ffffff";
our $WARTEXT_COLOR = "#ff0000";
our $NOTICETEXT_COLOR = "#ffffff";
our $SUBTEXT_COLOR = "#ff8888";
our $KEYBIND_COLOR = "#ffff88";
our $BG_COLOR      = "#000022";
our $BG_SEL_COLOR  = "#222244";
our $BG_SEL2_COLOR = "#442222";

sub ui_key {
   my ($key, %args) = @_;
   my $pad = delete $args{pad};
   my $txt =
      ref $key
         ? (join "/", map { "[$_]" } @$key)
         : "[$key]";

   if ($pad == 1) {
      $pad = 20;
      $pad -= length $txt;
      my $hpad = int ($pad / 2);
      my $hpad2 = $pad - $hpad;
      $txt = (" " x $hpad) . $txt . (" " x $hpad2)
   } elsif ($pad == 2) {
      $txt = "$txt ";
   }

   [text => { font => "normal", %args, color => $KEYBIND_COLOR, wrap => -20 },
    $txt
   ]
}
sub ui_title {
   my ($txt, %args) = @_;
   [text => { %args, color => $TITLE_COLOR, font => "big", align => "center", wrap => 30  }, $txt]
}

sub ui_caption {
   my ($txt, %args) = @_;
   [text => { %args, color => $TITLE_COLOR, font => "normal", align => "center"  }, $txt]
}

sub ui_text {
   my ($txt, %args) = @_;
   [text => { wrap => 45, align => "center", %args, color => $TEXT_COLOR }, $txt]
}

sub ui_small_text {
   my ($txt, %args) = @_;
   ui_text ($txt, font => "small", wrap => 70, %args)
}

sub ui_desc {
   my ($desc, %args) = @_;
   ui_text ($desc, align => "center", %args)
}

sub ui_subtext {
   my ($txt, %args) = @_;
   [text => { wrap => 45, align => "center", %args, color => $SUBTEXT_COLOR }, $txt]
}

sub ui_warning {
   my ($txt, %args) = @_;
   [text => { wrap => 20, align => "center", font => "big", color => $WARTEXT_COLOR, %args }, $txt]
}

sub ui_notice {
   my ($txt, %args) = @_;
   [text => { wrap => 20, font => "big", align => "center", color => $NOTICETEXT_COLOR, %args }, $txt]
}

sub ui_subdesc {
   my ($desc, %args) = @_;
   ui_subtext ($desc, align => "center", %args)
}

sub ui_hlt_border {
   my ($hlt, @cont) = @_;
   [box => { dir => "vert", padding => 2, aspect => 1 },
    [box => { dir => "vert", aspect => 1,
              border => {
                 color => ($hlt ? $HIGHLIGHT_BORDER_COLOR : $BORDER_COLOR)
              },
              padding => 2 },
     @cont
    ]
   ]
}

sub ui_border {
   [box => { dir => "vert", padding => 2 },
    [box => { dir => "vert", border => { color => $BORDER_COLOR }, padding => 8 },
     @_
    ]
   ]
}

sub ui_pad_box {
   my ($dir, @childs) = @_;
   [box => { dir => $dir, align => "center" },
      map { [box => { padding => 4, align => $_->[1]->{align} }, $_] } @childs
   ]
}

sub ui_select_item {
   my ($name, $tag, @cont) = @_;
   [select_box => {
      dir => "hor", align => "center", arg => $name, tag => $tag,
      padding => 2, bgcolor => $BG_SEL_COLOR,
      border => { color => $BORDER_COLOR, width => 2 },
      select_border => { color => $HIGHLIGHT_BORDER_COLOR, width => 2 },
    },
    @cont
   ]
}

sub ui_range {
   my ($arg, $min, $max, $step, $fmt, $val) = @_;
   [range => {
       align => "center",
       fmt => $fmt,
       color => $TEXT_COLOR,
       font => "normal",
       arg => $arg,
       step => $step,
       range => [$min, $max],
       highlight => [$BG_COLOR, $BG_SEL_COLOR]
    }, $val]
}