view release on metacpan or  search on metacpan

lib/Curses/UI/Progressbar.pm  view on Meta::CPAN

# ----------------------------------------------------------------------
# Curses::UI::Progressbar
#
# (c) 2001-2002 by Maurice Makaay. All rights reserved.
# This file is part of Curses::UI. Curses::UI is free software.
# You can redistribute it and/or modify it under the same terms
# as perl itself.
#
# Currently maintained by Marcus Thiesen
# e-mail: marcus@cpan.thiesenweb.de
# ----------------------------------------------------------------------

# TODO: fix dox

package Curses::UI::Progressbar;

use strict;
use Curses;
use Curses::UI::Common;
use Curses::UI::Widget;

use vars qw(
    $VERSION  
    @ISA
);

@ISA = qw(
    Curses::UI::Widget 
    Curses::UI::Common
);

$VERSION = '1.10';

sub new ()
{
    my $class = shift;

        my %userargs = @_;
        keys_to_lowercase(\%userargs);

    my %args = ( 
        -min          => 0,    # minimal value    
        -max          => 100,  # maximum value    
        -pos          => 0,    # the current position
        -nopercentage => 0,    # show the percentage or not?
        -nocenterline => 0,    # show the center line or not?
        -showvalue    => 0,    # show value instead of percentage
        -border       => 1,
	-fg           => -1,
        -bg           => -1,

        %userargs,    
    
        -focusable    => 0,
        -nocursor     => 1,
    );

    # Check that the lowest value comes first.
    if ($args{-min} > $args{-max}) 
    {
        my $tmp = $args{-min};
        $args{-min} = $args{-max};    
        $args{-max} = $tmp;
    }

    my $height = height_by_windowscrheight(1, %args);
    $args{-height} = $height;

    my $this = $class->SUPER::new( %args );    
    return $this;
}

sub get()
{
    my $this = shift;
    return $this->{-pos};
}

sub pos(;$)
{
    my $this = shift;
    my $pos = shift || 0;
    $this->{-pos} = $pos;    
    $this->intellidraw;
    return $this;
}

sub draw(;$)
{
    my $this = shift;
    my $no_doupdate = shift || 0;
    
    # Draw the widget
    $this->SUPER::draw(1) or return $this;

    # Check bounds for the position.
    $this->{-pos} = $this->{-max} if $this->{-pos} > $this->{-max};
    $this->{-pos} = $this->{-min} if $this->{-pos} < $this->{-min};

    if ($Curses::UI::color_support) {
	my $co = $Curses::UI::color_object;
	my $pair = $co->get_color_pair(
			     $this->{-fg},
			     $this->{-bg});

	$this->{-canvasscr}->attron(COLOR_PAIR($pair));

    }

    # Compute percentage
    my $perc = ($this->{-pos}-$this->{-min})
                /($this->{-max}-$this->{-min})*100;

    # Compute the number of blocks to draw. Only draw
    # no blocks or all blocks if resp. the min. or the