#!/usr/bin/perl -w
#
#  Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen
#  All rights reserved.
#
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#
#  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
#  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
#  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
#  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
#  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
#  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
#  SUCH DAMAGE.
#
#  $Id: scrollbar.pl,v 1.10 2003/08/01 09:45:30 dk Exp $
#

=pod 
=item NAME

A Prima toolkit example

=item FEATURES

Tests correct representation of a color created by a combination
of R,G and B components. The Prima::Widget::sizeMin and Prima::Widget::sizeMax
implementation is tested - the Area widget changes its height on a mouse click,
up to the left button and down to the right button. 
Note how Area widget maintains its maximum size when the window gets maximized.

=cut

use strict;
use Prima qw(ScrollBar);
use Prima::Application name => 'scrollbar';

package MyWindow;
use vars qw(@ISA);
@ISA = qw(Prima::MainWindow);

sub updateArea
{
  $_[0]-> Area-> backColor(
     $_[0]-> Blue-> value|($_[0]-> Green-> value<<8)|($_[0]-> Red-> value<<16)
  );
}

sub Timer1_Tick
{
   $_[ 0]-> Red  -> backColor(( $_[ 0]-> Red  -> backColor == cl::Red  ) ? cl::LightRed   : cl::Red  );
   $_[ 0]-> Green-> backColor(( $_[ 0]-> Green-> backColor == cl::Green) ? cl::LightGreen : cl::Green);
   $_[ 0]-> Blue -> backColor(( $_[ 0]-> Blue -> backColor == cl::Blue ) ? cl::LightBlue  : cl::Blue );
}

package UserInit;

my $w = MyWindow-> create(
   text => "Scrollbar & timer example",
   left    => 100,
   bottom  => 100,
   width   => 300,
   height  => 300,
   borderStyle => bs::Sizeable,
);

$w-> insert(
   "ScrollBar",
    name     => "Red",
    origin   => [ 2, 20],
    vertical => 0,
    max      => 255,
    width    => $w-> width - 2,
    onChange => sub { $w-> updateArea },
);
$w-> insert(
   "ScrollBar",
    name     => "Green",
    origin   => [ 2, 40],
    vertical => 0,
    max      => 255,
    width    => $w-> width - 2,
    onChange => sub { $w-> updateArea },
);
$w-> insert(
   "ScrollBar",
    name     => "Blue",
    origin   => [ 2, 60],
    vertical => 0,
    max      => 255,
    width    => $w-> width - 2,
    onChange => sub { $w-> updateArea },
);

$w-> insert(
   "ScrollBar",
    name     => "Bluex",
    origin   => [ 2, 80],
    vertical => 1,
    max      => 255,
    height    => $w-> height - 80,
);


$w-> insert(
   "Widget",
   name      => "Area",
   rect      => [ 20, 100, 280, 280],
   backColor => cl::Black,
   growMode  => gm::GrowHiX | gm::GrowHiY,
   sizeMin   => [120, 120],
   sizeMax   => [420, 420],
   onPaint => sub
   {
      my ($x,$y)=$_[0]->size;
      $_[0]->color($_[0]->backColor);
      $_[0]-> bar(0,0,$x,$y);
      $_[0]->color(cl::Set);
      $_[0]->rop(rop::XorPut);
      $_[0]->line(0,0,$x,$y);
      $_[0]->line(0,$y,$x,0);
   },
   onMouseDown=>sub{
      $_[0]->height($_[0]->height+(($_[1]==1)?1:-1));
   },
);
my $t = $w-> insert(
   Timer=>
   timeout=> 2000,
   name => 'Timer1',
   delegations => ['Tick'],
);
$t-> start;

run Prima;
