File Coverage

blib/lib/Games/Console.pm

Criterion	Covered	Total	%
statement	116	182	63.7
branch	30	76	39.4
condition	12	31	38.7
subroutine	19	31	61.2
pod	22	28	78.5
total	199	348	57.1

# Games-Console - a 2D quake-style console

package Games::Console;

# (C) by Tels

use strict;
use vars qw/$VERSION/;

$VERSION = '0.04';

##############################################################################
# methods

sub new
  {
  # create a new console
  my $class = shift;

  my $self = { };
  bless $self, $class;

  my $args = $_[0];
  $args = { @_ } unless ref $args eq 'HASH';

  $self->{background_color} = $args->{background} || [0.4, 0.6, 1];
  $self->{background_alpha} = $args->{background_alpha} || 0.5;

  $self->{text_color} = $args->{text_color} || [ 0.4, 0.6, 0.8 ];
  $self->{text_alpha} = $args->{text_alpha} || 0.8;

  $self->{max_msg} = $args->{backbuffer_size} || 100;

  $self->{font} = $args->{font};

  # maximum height/width in percent
  $self->{width} = abs($self->{width} || 100);
  $self->{height} = abs($args->{height} || 50);
  $self->{width} = 100 if $self->{width} > 100;
  $self->{height} = 100 if $self->{height} > 100;

  $self->{screen_width} = 640;
  $self->{screen_height} = 480;

  $self->{direction} = 1;
  # in percent per second (50 means it takes 2 seconds to open console)
  $self->{speed} = 50;

  $self->{start_percent} = 0;		# started moving at this percentage
  $self->{start_time} = 0;		# and this time
  $self->{cur_percent} = 0;		# cur percent visible

  $self->{messages} = [];

  $self->{spacing_y} = 0;
  $self->{border_x} = 5;
  $self->{border_y} = 5;
  $self->{prompt} = $args->{prompt} || '> ';
  $self->{cursor} = $args->{cursor} || '_';

  $self->{offset} = 0;

  $self->{last_cursor} = 0;
  $self->{cursor_time} = abs($args->{cursor_time} || 300);

  $self->{current_input} = '';	# what user entered until ENTER key is pressed
  $self->{last_input} = [ ];
  $self->{last_input_pos} = 0;
  $self->{max_last_input} = 64;

  $self->{cur_height} = 0;	# invisble
  $self;
  }

sub close
  {
  my $self = shift;

  $self->{direction} = -1 if $self->{visible};
  }

sub open
  {
  my $self = shift;

  $self->{direction} = 1; $self->{visible} = 1;
  $self->{start_time} = shift;
  $self->{start_percent} = $self->{cur_percent};
  }

sub toggle
  {
  my $self = shift;

  if (!$self->{visible})
    {
    $self->{direction} = 1; $self->{visible} = 1;
    }
  else
    {
    $self->{direction} = - $self->{direction};
    $self->{direction} = -1 if $self->{direction} == 0;
    }
  $self->{start_time} = shift;
  $self->{start_percent} = $self->{cur_percent};
  }

sub visible
  {
  # make immidiately visible/invisible
  my $self = shift;

  if (@_ > 0)
    {
    my $v = $_[0] ? 1 : 0;
    if ($self->{visible} && !$v)
      {
      $self->{direction} = 0;
      $self->{cur_percent} = 0;
      }
    elsif (!$self->{visible} && $v)
      {
      $self->{direction} = 1;
      $self->{start_percent} = 0;
      $self->{start_time} = shift;
      }
    $self->{visible} = $v;
    }
  $self->{visible};
  }

sub render
  {
  my ($self,$current_time) = @_;

  return unless $self->{visible};

  if ($self->{direction} != 0)
    {
    $self->{cur_percent} = $self->{start_percent} +
       $self->{direction} * ($current_time - $self->{start_time}) *
       $self->{speed} / 100;
    }

  if ($self->{cur_percent} < 0)
    {
    # fully closed
    $self->{cur_percent} = 0;
    $self->{start_percent} = 0;
    $self->{direction} = 0;
    $self->{visible} = 0;
    return;
    }

  if ($self->{cur_percent} > 100)
    {
    # fully open
    $self->{cur_percent} = 100;
    $self->{direction} = 0;
    }

  # calculate height/width
  my $w = $self->{width} * $self->{screen_width} / 100;
  my $h = ($self->{cur_percent} / 100)
          * $self->{height} * $self->{screen_height} / 100;

  $self->_render( 0, $self->{screen_height}, $w, $h, $current_time );

  }

sub _render
  {
  # prepare the output, render the background and the text
  my ($self,$x,$y,$w,$h,$time) = @_;

  }

sub message
  {
  my ($self,$msg) = @_;

  my $m = $self->{messages};			# shortcut

  push @$m, [ $msg ];

  shift @$m while (scalar @$m > $self->{max_msg});

  $self;
  }

sub screen_width
  {
  my $self = shift;

  if (@_ > 0)
    {
    $self->{screen_width} = $_[0];
    $self->{font}->screen_width($_[0]);
    }
  $self->{screen_width};
  }

sub screen_height
  {
  my $self = shift;

  if (@_ > 0)
    {
    $self->{screen_height} = $_[0];
    $self->{font}->screen_height($_[0]);
    }
  $self->{screen_height};
  }

sub background_color
  {
  my $self = shift;

  $self->{background_color} = shift if @_ > 0;
  $self->{background_color};
  }

sub text_color
  {
  my $self = shift;

  $self->{text_color} = shift if @_ > 0;
  $self->{text_color};
  }

sub background_alpha
  {
  my $self = shift;

  $self->{background_alpha} = shift if @_ > 0;
  $self->{background_alpha};
  }

sub text_alpha
  {
  my $self = shift;

  $self->{text_alpha} = shift if @_ > 0;
  $self->{text_alpha};
  }

sub width
  {
  my $self = shift;

  if (@_ > 0)
    {
    $self->{width} = abs(shift);
    $self->{width} = 100 if $self->{width} > 100;
    }
  $self->{width};
  }

sub height
  {
  my $self = shift;

  if (@_ > 0)
    {
    $self->{height} = abs(shift);
    $self->{height} = 100 if $self->{height} > 100;
    }
  $self->{height};
  }

sub speed
  {
  my $self = shift;

  if (@_ > 0)
    {
    $self->{speed} = abs(shift);
    $self->{speed} = 100 if $self->{speed} > 100;
    }
  $self->{speed};
  }

sub backbuffer_size
  {
  my $self = shift;

  $self->{max_msg} = abs(shift) if @_ > 0;
  $self->{max_msg};
  }

sub cursor
  {
  my $self = shift;

  $self->{cursor} = $_[0] if @_ > 0;
  $self->{cursor};
  }

sub prompt
  {
  my $self = shift;

  $self->{prompt} = $_[0] if @_ > 0;
  $self->{prompt};
  }

sub backspace
  {
  my $self = shift;

  if ($self->{current_input} ne '')
    {
    substr($self->{current_input},-1,1) = '';
    }
  $self->{current_input};
  }

sub autocomplete
  {
  my $self = shift;

  $self->{last_input_pos} = 0;
  }

sub input
  {
  # get/set the current_input buffer
  my $self = shift;

  if (@_ > 0)
    {
    my $m = $self->{last_input};
    unshift @$m, $self->{current_input};
    pop @$m while (scalar @$m > $self->{max_last_input});
    $self->{current_input} = $_[0];
    $self->{last_input_pos} = 0;
    }
  $self->{current_input};
  }

sub last_input
  {
  # set the current_input buffer to the last entered input
  my $self = shift;
  my $dir = shift || 0;

  my $m = $self->{last_input};

  my $pos = $self->{last_input_pos};
  if ($pos < 0 || $pos >= scalar @$m)
    {
    $self->{current_input} = '';
    }
  else
    {
    $self->{current_input} = $m->[$pos] if scalar @$m > 0;
    }
  if ($dir >= 0)
    {
    $pos++ if $pos < scalar @$m;
    }
  else
    {
    $pos-- if $pos >= 0;
    }
  $self->{last_input_pos} = $pos;
  $self->{current_input};
  }

sub add_input
  {
  # add more text to the current_input buffer
  my $self = shift;

  $self->{current_input} .= $_[0];
  }

sub scroll
  {
  my ($self,$ofs) = @_;

  $self->{offset} += $ofs;
  print $self->{offset},"\n";
  $self->{offset} = 0 if $self->{offset} < 0;
  $self->{offset} = scalar @{$self->{messages}}
   if $self->{offset} >= scalar @{$self->{messages}};
  print $self->{offset},"\n";
  $self->{offset};
  }

sub offset
  {
  my ($self) = @_;

  $self->{offset};
  }

sub messages
  {
  # return number of messages in backbuffer
  my $self = shift;

  scalar @{$self->{messages}};
  }

sub clear
  {
  # clear backbuffer
  my $self = shift;

  $self->{messages} = [];
  $self;
  }

1;

__END__