The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
# Games::Construder - A 3D Game written in Perl with an infinite and modifiable world.
# Copyright (C) 2011  Robin Redeker
#
# 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]
}

sub ui_entry_small {
   my ($arg, $txt, $maxchars) = @_;
   [entry => { font => 'small', color => $TEXT_COLOR, arg => $arg,
               align => "center",
               (defined $maxchars ? (max_chars => $maxchars) : ()),
               highlight => [$BG_COLOR, $BG_SEL_COLOR] },
    $txt]
}


sub ui_entry {
   my ($arg, $txt, $maxchars) = @_;
   [entry => { font => 'normal', color => $TEXT_COLOR, arg => $arg,
               align => "center",
               (defined $maxchars ? (max_chars => $maxchars) : ()),
               highlight => [$BG_COLOR, $BG_SEL_COLOR] },
    $txt]
}

sub ui_multiline {
   my ($arg, $txt, %arg) = @_;
   [
      multiline => {
            font => 'normal', color => "#ffffff", arg => $arg,
            highlight => [$BG_COLOR, $BG_SEL_COLOR, $BG_SEL2_COLOR],
            max_chars => 32, wrap => -32,
            height => 25, %arg
      },
      $txt
   ],
}


sub ui_key_inline_expl {
   my ($key, $desc, %args) = @_;
   [box => { dir => "hor", align => "center" },
      ui_key ($key, pad => 2, font => "small"),
      ui_text ($desc, align => "left", wrap => 40, font => "small")
   ]
}

sub ui_key_explain {
   my ($key, $desc, %args) = @_;
   [box => { dir => "hor", align => "left" },
      ui_key ($key, pad => 1),
      ui_text ($desc, wrap => 30, align => "left")
   ]
}

sub ui_window_special {
   my ($title, $pos, @content) = @_;
   {
      window => { pos => $pos, bgcolor => $BG_COLOR },
      layout => ui_border (
         ui_title ($title),
         @content
      )
   }

}

sub ui_window {
   my ($title, @content) = @_;
   ui_window_special ($title, [ center => "center" ], @content)
}

sub ui_hud_window_transparent {
   my ($pos, @content) = @_;
   {
      window => { pos => $pos, bgcolor => $BG_COLOR, sticky => 1, alpha => 0.5 },
      layout => [ box => { dir => "vert" },
         @content
      ]
   }
}

sub ui_hud_window {
   my ($pos, @content) = @_;
   {
      window => { pos => $pos, bgcolor => $BG_COLOR, sticky => 1, alpha => 0.65 },
      layout => [ box => { dir => "vert" },
         @content
      ]
   }
}

sub ui_hud_window_above {
   my ($pos, @content) = @_;
   {
      window => { force_one_higher => 1, pos => $pos, bgcolor => $BG_COLOR, sticky => 1, alpha => 0.65 },
      layout => [ box => { dir => "vert" },
         @content
      ]
   }
}


=back

=head1 AUTHOR

Robin Redeker, C<< <elmex@ta-sa.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2011 Robin Redeker, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the terms of the GNU Affero General Public License.

=cut

1;