libprima-perl 1.28-1.4 / usr / share / doc / prima / examples / transparent

#!/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: transparent.pl,v 1.12 2005/10/13 17:22:53 dk Exp $
#
=pod 
=item NAME

Prima toolkit example

=item FEATURES

Demonstrates the usage of Prima::Widget::transparent property.
Test the certain events: for example, when two transparent
widgets are located one upon another, when a graphic content changed
under a transparent widget, etc.

Note that the $tt widget is not transparent but uses shape extension.

=cut

use Prima;
use Prima::Const;
use Prima::Application name => 'Generic.pm';

$w = Prima::MainWindow-> create(
	size => [ 300, 300],
	borderStyle => bs::Dialog,
	backColor => cl::Green,
	onCreate => sub {
		$_[0]-> {delta} = 0;
	},
	onPaint => sub {
		my ($self,$canvas) = @_;
		my $c = $self-> color;
		$canvas-> color( $self-> backColor);
		$canvas-> bar(0,0,$self-> size);
		$canvas-> color( $c);
		my $d = $self-> {delta};
		my $i;
		for ( $i = -1; $i < 7; $i++)
		{
			$canvas-> text_out("Hello!", $d + $i * 40, $d + $i * 40);
		}
	},
);

$w-> insert( Timer =>
	timeout => 100,
	onTick  => sub {
		$w-> {delta} += 2;
		$w-> { delta} = 0 if $w-> { delta} >= 40;
		$w-> repaint;
	}
)-> start;

$w-> insert(
	Widget =>
	origin => [ 90, 90],
	transparent => 1,
	onPaint => sub {
		my $self = $_[0];
		$self-> color( cl::LightGreen);
		$self-> lineWidth( 4);
		$self-> line( 3, 3, $self-> size);
		$self-> ellipse( 50, 50, 80, 80);
	},
	onMouseDown => sub {
		$_[0]-> bring_to_front;
	},
);


my $string = "Hello from Prima::OnScreenDisplay!";
my $tt = Prima::Widget-> create(
	name => 'W1',
	onPaint => sub {
		$_[1]-> color( cl::LightRed);
		$_[1]-> font-> size( 36);
		$_[1]-> text_out( $string, 0, 0);
	},
	onMouseDown => sub {
		$_[0]-> {drag}    = [ $_[3], $_[4]];
		$_[0]-> {lastPos} = [ $_[0]-> left, $_[0]-> bottom];
		$_[0]-> capture(1);
		$_[0]-> repaint;
	},
	onMouseMove => sub{
		return unless exists $_[0]-> { drag};
		my @org = $_[0]-> origin;
		my @st  = @{$_[0]-> {drag}};
		my @new = ( $org[0] + $_[2] - $st[0], $org[1] + $_[3] - $st[1]);
		$_[0]-> origin( $new[0], $new[1]) if $org[1] != $new[1] || $org[0] != $new[0];
	},
	onMouseUp => sub {
		$_[0]-> capture(0);
		delete $_[0]-> {drag};
	},
);

$tt-> begin_paint_info;
$tt-> font-> size(36);
my $font = $tt-> font;
$tt-> width( $tt-> get_text_width( $string));
$tt-> end_paint_info;

my $i = Prima::Image-> create( width => $tt-> width, height => $tt-> height,
type => im::BW, conversion => ict::None);
$i-> begin_paint;
$i-> color( cl::Black);
$i-> bar(0,0,$i-> size);
$i-> color( cl::White);
$i-> font($font);
$i-> text_out( $string, 0, 0);
$i-> end_paint;
$tt-> shape($i);
$tt-> bring_to_front;

run Prima;