ONO::Lib::UI::Progress
package ONO::Lib::UI::Progress;
################################################################################
# COPYRIGHT / LICENSE #
################################################################################
#
# This file is part of the ONO Software Project.
#
# Copyright (C) 2000-2025 Jos KIRPS [ www.kirps.com | jos_AT_kirps_DOT_com ]
# and The Joopita Project [ www.joopita.org | contact_AT_joopita_DOT_com ]
#
# This file, as well as other parts of the ONO Software Project or related
# elements, are FREE SOFTWARE available under the ARTISTIC LICENSE 2.0.
#
# 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.
#
# For the full license, see /ono/osr/license/LICENSE.txt, or write to
# jos_AT_kirps_DOT_com or contact_AT_joopita_DOT_com.
#
################################################################################
# END OF COPYRIGHT / LICENSE, HERE COMES THE CODE ... #
################################################################################
use strict;
use ONO::Lib::Code::RandomID;
###############################################################################
# percent
###############################################################################
sub slider {
my (
$self,
$id,
$name,
$value,
$width,
$from,
$to,
$switches,
) = @_;
#: Progress slider.
if (!$width) {
$width = 100;
}
if (!$from) {
$from = 0;
}
if (!$to) {
$to = 100;
}
if (!$value) {
$value = $from;
}
my $ONCHANGE;
if ($switches =~ /p/) {
$ONCHANGE = qq~onchange = "update_slider_$id();" oninput = "update_slider_$id();"~;
}
my $SLIDER = qq~<input type="range" id="$id" name="$name" value="$value" min="$from" max="$to" style="width:${width}px"$ONCHANGE>~;
if ($switches =~ /p/) {
$SLIDER = qq~<table class="default_table">
<tr>
<td>$SLIDER</td>
<td class="small" id="slider_display_$id">${value}%</td>
</tr>
</table>
<script>
function update_slider_$id() {
document.getElementById('slider_display_$id').innerHTML=document.getElementById('$id').value+'\%';
}
</script>
~;
}
return $SLIDER;
}
###############################################################################
# percent
###############################################################################
sub percent {
my (
$self,
$percent,
$class,
$style,
$style_box,
$threshold_yellow,
$threshold_orange,
$threshold_red,
$text,
$switches,
$id,
) = @_;
#: Progress bar, percentage.
#:
#: -R radius10
#: -S apply style bar instead of box
#: -t text followed by percent
#: -T text instead of percent
my ($style_bar,$radius10);
if ($switches =~ /S/) {
$style_bar = $style_box;
$style_box = "";
}
if ($percent < 1) {
$percent = 0;
}
my $color = "green";
if ($threshold_yellow && $percent > $threshold_yellow) {
$color = "yellow";
}
if ($threshold_orange && $percent > $threshold_orange) {
$color = "orange";
}
if ($threshold_red && $percent > $threshold_red) {
$color = "red";
}
my $TEXT = "${percent}%$text";
if ($switches =~ /t/) {
$TEXT = "$text (${percent}%)";
}
if ($switches =~ /T/) {
$TEXT = $text;
}
if ($switches =~ /R/) {
$radius10 = " radius10";
}
return qq~<div class="bo center rel lh125$class$radius10" style="$style$style_box;overflow:hidden">
<div id="ono_ui_progpercent_$id" class="bg_$color abs" style="width:${percent}%;$style;$style_bar"> </div>
<div class="rel">$TEXT</div>
</div>
~;
}
###############################################################################
# progress status
###############################################################################
sub status {
my (
$self,
$prog_ref,
$selected,
$bg,
$radius,
$class,
) = @_;
#: Progress status.
my @progs = @$prog_ref;
if (!$bg) {
$bg = "fabric";
}
if ($radius) {
$radius = "radius$radius";
}
my ($PROG,$counter);
my $num = @progs;
if ($num < 1) {
$num = 1;
}
my $width = int(100/$num)+1;
foreach my $prog (@progs) {
my @pp = split(/:/,$prog);
if ($pp[0] eq $selected) {
$pp[2] = qq~<div class="bg_$pp[1] radius5 bo w90 auto bold">$pp[2]</div>~;
}
$PROG .= qq~<td class="p0" style="width:${width}%">$pp[2]</td>~;
}
return qq~<div class="bg_$bg center $radius $class"><table class="wide_table" style="height:30px"><tr>$PROG</tr></table></div>~;
}
###############################################################################
# progress bar
###############################################################################
sub bar {
my (
$self,
$progs_ref,
$cutoff,
$c1palette_ref,
$c2palette_ref,
$switches,
) = @_;
#: Progress bar.
#: -B alter blue channel
#: -G alter green channel
#: -R alter red channel
my @progs = @$progs_ref;
my @c1palette = @$c1palette_ref;
my @c2palette = @$c2palette_ref;
if ($switches !~ /(R|B)/) {
$switches .= "G";
}
my $num = @progs;
my ($PROG,$pcount,$off);
foreach my $prog (
@progs
) {
if ($pcount > $cutoff-1) {
$off++;
}
if ($prog =~ /:/) {
$pcount++;
my @pp = split(/:/,$prog);
my $c1 = $c1palette[$pcount-1];
my $c2 = $c2palette[$pcount-1];
my $c2b = $c2palette[$pcount-0];
my ($class,$color1,$color2);
if ($pcount == 1) {
$class = "radius5left";
}
if ($pcount == $num-1) {
$class = "radius5right";
}
my $color3 = "#ffffff";
if ($off) {
$c1 = $c2palette[$pcount-1];
$c2 = $c2palette[$pcount-1];
$color3 = "#333333";
}
my ($R,$G,$B) = &_rgb($c1,$c2,$switches);
$color1 = "#$R$G$B";
my ($R,$G,$B) = &_rgb($c1,$c2b,$switches);
$color2 = "#$R$G$B";
$PROG .= qq~<td class="p0 nowrap"><div class="$class" style="height:16px;padding:6px 12px 10px 12px;background-color:$color1;color:$color3">$pp[1]</div></td>~;
if ($pcount < $num-1) {
if ($off || $pcount > $cutoff-1) {
$color2 = "#$c2b$c2b$c2b$c2b$c2b$c2b";
} else {
# this is required to make colours work, although I don't understand why this is the case :
if ($pcount%2 == 0) {
$c1 = $c1palette[$pcount];
my ($R,$G,$B) = &_rgb($c1,$c2b,$switches);
$color2 = "#$R$G$B";
}
}
$PROG .= qq~<td class="p0">
<div style="width:0;height:0;border-top:16px solid $color2;border-left:16px solid $color1;border-bottom:16px solid $color2;"></div>
</td>
~;
}
} else {
my $c = $c2palette[$num-2];
my $c1 = $c1palette[$pcount];
my $c2 = $c2palette[$pcount];
my ($R,$G,$B) = &_rgb($c1,$c2,$switches);
my $color = "#$R$G$B";
if ($off) {
$color = "#$c$c$c$c$c$c";
}
$PROG .= qq~<td class="w100" style="background-color:$color"></td>~;
}
}
return qq~<div class="bg_fabric radius5 mt10 ">
<table class="wide_table"><tr>$PROG</tr></table>
</div>
~;
}
sub _rgb {
#: Internal RGB logic subroutine.
my (
$c1,
$c2b,
$switches,
) = @_;
my $R = "$c1$c1";
my $G = "$c1$c1";
my $B = "$c1$c1";
if ($switches =~ /R/) {
$R = "$c2b$c2b";
}
if ($switches =~ /G/) {
$G = "$c2b$c2b";
}
if ($switches =~ /B/) {
$B = "$c2b$c2b";
}
return ($R,$G,$B);
}
###############################################################################
# end of script
###############################################################################
1;
__END__
################################################################################
# COPYRIGHT / LICENSE #
################################################################################
#
# This file is part of the ONO Software Project.
#
# Copyright (C) 2000-2025 Jos KIRPS [ www.kirps.com | jos_AT_kirps_DOT_com ]
# and The Joopita Project [ www.joopita.org | contact_AT_joopita_DOT_com ]
#
# This file, as well as other parts of the ONO Software Project or related
# elements, are FREE SOFTWARE available under the ARTISTIC LICENSE 2.0.
#
# 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.
#
# For the full license, see /ono/osr/license/LICENSE.txt, or write to
# jos_AT_kirps_DOT_com or contact_AT_joopita_DOT_com.
#
################################################################################
# END OF COPYRIGHT / LICENSE, HERE COMES THE CODE ... #
################################################################################
use strict;
use ONO::Lib::Code::RandomID;
###############################################################################
# percent
###############################################################################
sub slider {
my (
$self,
$id,
$name,
$value,
$width,
$from,
$to,
$switches,
) = @_;
#: Progress slider.
if (!$width) {
$width = 100;
}
if (!$from) {
$from = 0;
}
if (!$to) {
$to = 100;
}
if (!$value) {
$value = $from;
}
my $ONCHANGE;
if ($switches =~ /p/) {
$ONCHANGE = qq~onchange = "update_slider_$id();" oninput = "update_slider_$id();"~;
}
my $SLIDER = qq~<input type="range" id="$id" name="$name" value="$value" min="$from" max="$to" style="width:${width}px"$ONCHANGE>~;
if ($switches =~ /p/) {
$SLIDER = qq~<table class="default_table">
<tr>
<td>$SLIDER</td>
<td class="small" id="slider_display_$id">${value}%</td>
</tr>
</table>
<script>
function update_slider_$id() {
document.getElementById('slider_display_$id').innerHTML=document.getElementById('$id').value+'\%';
}
</script>
~;
}
return $SLIDER;
}
###############################################################################
# percent
###############################################################################
sub percent {
my (
$self,
$percent,
$class,
$style,
$style_box,
$threshold_yellow,
$threshold_orange,
$threshold_red,
$text,
$switches,
$id,
) = @_;
#: Progress bar, percentage.
#:
#: -R radius10
#: -S apply style bar instead of box
#: -t text followed by percent
#: -T text instead of percent
my ($style_bar,$radius10);
if ($switches =~ /S/) {
$style_bar = $style_box;
$style_box = "";
}
if ($percent < 1) {
$percent = 0;
}
my $color = "green";
if ($threshold_yellow && $percent > $threshold_yellow) {
$color = "yellow";
}
if ($threshold_orange && $percent > $threshold_orange) {
$color = "orange";
}
if ($threshold_red && $percent > $threshold_red) {
$color = "red";
}
my $TEXT = "${percent}%$text";
if ($switches =~ /t/) {
$TEXT = "$text (${percent}%)";
}
if ($switches =~ /T/) {
$TEXT = $text;
}
if ($switches =~ /R/) {
$radius10 = " radius10";
}
return qq~<div class="bo center rel lh125$class$radius10" style="$style$style_box;overflow:hidden">
<div id="ono_ui_progpercent_$id" class="bg_$color abs" style="width:${percent}%;$style;$style_bar"> </div>
<div class="rel">$TEXT</div>
</div>
~;
}
###############################################################################
# progress status
###############################################################################
sub status {
my (
$self,
$prog_ref,
$selected,
$bg,
$radius,
$class,
) = @_;
#: Progress status.
my @progs = @$prog_ref;
if (!$bg) {
$bg = "fabric";
}
if ($radius) {
$radius = "radius$radius";
}
my ($PROG,$counter);
my $num = @progs;
if ($num < 1) {
$num = 1;
}
my $width = int(100/$num)+1;
foreach my $prog (@progs) {
my @pp = split(/:/,$prog);
if ($pp[0] eq $selected) {
$pp[2] = qq~<div class="bg_$pp[1] radius5 bo w90 auto bold">$pp[2]</div>~;
}
$PROG .= qq~<td class="p0" style="width:${width}%">$pp[2]</td>~;
}
return qq~<div class="bg_$bg center $radius $class"><table class="wide_table" style="height:30px"><tr>$PROG</tr></table></div>~;
}
###############################################################################
# progress bar
###############################################################################
sub bar {
my (
$self,
$progs_ref,
$cutoff,
$c1palette_ref,
$c2palette_ref,
$switches,
) = @_;
#: Progress bar.
#: -B alter blue channel
#: -G alter green channel
#: -R alter red channel
my @progs = @$progs_ref;
my @c1palette = @$c1palette_ref;
my @c2palette = @$c2palette_ref;
if ($switches !~ /(R|B)/) {
$switches .= "G";
}
my $num = @progs;
my ($PROG,$pcount,$off);
foreach my $prog (
@progs
) {
if ($pcount > $cutoff-1) {
$off++;
}
if ($prog =~ /:/) {
$pcount++;
my @pp = split(/:/,$prog);
my $c1 = $c1palette[$pcount-1];
my $c2 = $c2palette[$pcount-1];
my $c2b = $c2palette[$pcount-0];
my ($class,$color1,$color2);
if ($pcount == 1) {
$class = "radius5left";
}
if ($pcount == $num-1) {
$class = "radius5right";
}
my $color3 = "#ffffff";
if ($off) {
$c1 = $c2palette[$pcount-1];
$c2 = $c2palette[$pcount-1];
$color3 = "#333333";
}
my ($R,$G,$B) = &_rgb($c1,$c2,$switches);
$color1 = "#$R$G$B";
my ($R,$G,$B) = &_rgb($c1,$c2b,$switches);
$color2 = "#$R$G$B";
$PROG .= qq~<td class="p0 nowrap"><div class="$class" style="height:16px;padding:6px 12px 10px 12px;background-color:$color1;color:$color3">$pp[1]</div></td>~;
if ($pcount < $num-1) {
if ($off || $pcount > $cutoff-1) {
$color2 = "#$c2b$c2b$c2b$c2b$c2b$c2b";
} else {
# this is required to make colours work, although I don't understand why this is the case :
if ($pcount%2 == 0) {
$c1 = $c1palette[$pcount];
my ($R,$G,$B) = &_rgb($c1,$c2b,$switches);
$color2 = "#$R$G$B";
}
}
$PROG .= qq~<td class="p0">
<div style="width:0;height:0;border-top:16px solid $color2;border-left:16px solid $color1;border-bottom:16px solid $color2;"></div>
</td>
~;
}
} else {
my $c = $c2palette[$num-2];
my $c1 = $c1palette[$pcount];
my $c2 = $c2palette[$pcount];
my ($R,$G,$B) = &_rgb($c1,$c2,$switches);
my $color = "#$R$G$B";
if ($off) {
$color = "#$c$c$c$c$c$c";
}
$PROG .= qq~<td class="w100" style="background-color:$color"></td>~;
}
}
return qq~<div class="bg_fabric radius5 mt10 ">
<table class="wide_table"><tr>$PROG</tr></table>
</div>
~;
}
sub _rgb {
#: Internal RGB logic subroutine.
my (
$c1,
$c2b,
$switches,
) = @_;
my $R = "$c1$c1";
my $G = "$c1$c1";
my $B = "$c1$c1";
if ($switches =~ /R/) {
$R = "$c2b$c2b";
}
if ($switches =~ /G/) {
$G = "$c2b$c2b";
}
if ($switches =~ /B/) {
$B = "$c2b$c2b";
}
return ($R,$G,$B);
}
###############################################################################
# end of script
###############################################################################
1;
__END__