view release on metacpan or search on metacpan
0.9 AAC::Pvoice::Bitmap
* We now use Image::Magick to create the bitmaps. It's a change to
the internals, so the methods and their parameters stay the same.
* Returned images are cached first (using File::Cache). If an image
has been processed before, it will be retrieved from the cache.
The cache never expires, but every combination of parameters
results in a new cached image (and of course the file modificationtime
of the image is also taken into account.
AAC::Pvoice::Dialog
* This is a newly added class. It's a subclass of Wx::Dialog and
allows you to create dialog boxes, using an AAC::Pvoice::Panel
AAC::Pvoice
* This module now provides the AAC::Pvoice::MessageBox function,
similar to Wx::MessageBox.
0.91 AAC::Pvoice
* Made a little more space between the text and the buttons in the MessageBox
function
AAC::Pvoice::Bitmap
* Minor changes
AAC::Pvoice::Panel
not include anything that is normally distributed (in either source or binary form)
with the major components (compiler, kernel, and so on) of the operating system
on which the executable runs, unless that component itself accompanies the
executable.
If distribution of executable or object code is made by offering access to copy
from a designated place, then offering equivalent access to copy the source
code from the same place counts as distribution of the source code, even though
third parties are not compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program except as
expressly provided under this License. Any attempt otherwise to copy, modify,
sublicense or distribute the Program is void, and will automatically terminate
your rights under this License. However, parties who have received copies, or
rights, from you under this License will not have their licenses terminated so long
as such parties remain in full compliance.
5. You are not required to accept this License, since you have not signed it.
However, nothing else grants you permission to modify or distribute the Program
or its derivative works. These actions are prohibited by law if you do not accept
this License. Therefore, by modifying or distributing the Program (or any work
based on the Program), you indicate your acceptance of this License to do so,
and all its terms and conditions for copying, distributing or modifying the
Program or works based on it.
6. Each time you redistribute the Program (or any work based on the Program),
the recipient automatically receives a license from the original licensor to copy,
distribute or modify the Program subject to these terms and conditions. You
may not impose any further restrictions on the recipients' exercise of the rights
granted herein. You are not responsible for enforcing compliance by third parties
to this License.
7. If, as a consequence of a court judgment or allegation of patent infringement
or for any other reason (not limited to patent issues), conditions are imposed on
you (whether by court order, agreement or otherwise) that contradict the
conditions of this License, they do not excuse you from the conditions of this
License. If you cannot distribute so as to satisfy simultaneously your obligations
under this License and any other pertinent obligations, then as a consequence
charge a fee for this Package itself. However, you may distribute this Package in
aggregate with other (possibly commercial) programs as part of a larger
(possibly commercial) software distribution provided that you do not advertise
this Package as a product of your own.
6. The scripts and library files supplied as input to or produced as output from
the programs of this Package do not automatically fall under the copyright of this
Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.
7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.
8. Aggregation of this Package with a commercial distribution is always permitted
provided that the use of this Package is embedded; that is, when no overt attempt
is made to make this Package's interfaces visible to the end user of the
commercial distribution. Such use shall not be construed as a distribution of
this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
lib/AAC/Pvoice.pm view on Meta::CPAN
BEGIN {
use Exporter ();
use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = 0.91;
@ISA = qw (Exporter);
@EXPORT = qw (MessageBox);
@EXPORT_OK = qw ();
%EXPORT_TAGS = ();
}
sub MessageBox
{
my ($message, $caption, $style, $parent, $x, $y) = @_;
$caption ||= 'Message';
$style ||= wxOK;
$x ||= -1;
$y ||= -1;
$Text::Wrap::columns = 25;
$message = wrap('','',$message)."\n";
lib/AAC/Pvoice.pm view on Meta::CPAN
$messagectrl->SetBackgroundColour($d->{backgroundcolour});
$messagectrl->SetFont(Wx::Font->new(10, # font size
wxDECORATIVE, # font family
wxNORMAL, # style
wxNORMAL, # weight
0,
'Comic Sans MS', # face name
wxFONTENCODING_SYSTEM));
$d->Append($messagectrl,1);
my $ok = [Wx::NewId,AAC::Pvoice::Bitmap->new('',50,25,'OK', Wx::Colour->new(255, 230, 230)),sub{$d->SetReturnCode(wxOK); $d->Close()}];
my $yes = [Wx::NewId,AAC::Pvoice::Bitmap->new('',50,30,'Yes', Wx::Colour->new(255, 230, 230)),sub{$d->SetReturnCode(wxYES); $d->Close()}];
my $no = [Wx::NewId,AAC::Pvoice::Bitmap->new('',50,25,'No', Wx::Colour->new(255, 230, 230)),sub{$d->SetReturnCode(wxNO); $d->Close()}];
my $cancel = [Wx::NewId,AAC::Pvoice::Bitmap->new('',50,60,'Cancel',Wx::Colour->new(255, 230, 230)),sub{$d->SetReturnCode(wxCANCEL);$d->Close()}];
my $items = [];
push @$items, $ok if $style & wxOK;
push @$items, $yes if $style & wxYES_NO;
push @$items, $no if $style & wxYES_NO;
push @$items, $cancel if $style & wxCANCEL;
$d->Append(AAC::Pvoice::Row->new($d->{panel}, # parent
scalar(@$items), # max
$items, # items
wxDefaultPosition, # pos
wxDefaultSize,
lib/AAC/Pvoice/Bitmap.pm view on Meta::CPAN
use base qw(Wx::Bitmap);
our $cache;
BEGIN
{
Wx::InitAllImageHandlers;
$cache = File::Cache->new({namespace => 'images'});
}
#----------------------------------------------------------------------
sub new
{
my $class = shift;
my ($file, $MAX_X, $MAX_Y, $caption, $background, $blowup, $parent_background) = @_;
$caption||='';
$parent_background=Wx::Colour->new(220,220,220) if not defined $parent_background;
my $config = Wx::ConfigBase::Get;
$caption = $config->ReadInt('Caption')?$caption:'';
# return ReadImage($file, $MAX_X, $MAX_Y, $caption, $background, $blowup, $parent_background) if $file;
return ReadImageMagick($file, $MAX_X, $MAX_Y, $caption, $background, $blowup, $parent_background) if $file;
return DrawCaption($MAX_X, $MAX_Y, $caption, $background, $parent_background);
}
sub ReadImage
{
my $file = shift;
my ($x, $y, $caption, $background, $blowup, $parent_background) = @_;
return DrawCaption($x, $y, '?', $background, $parent_background) unless -r $file;
confess "MaxX and MaxY should be positive" if $x < 1 || $y < 1;
my $newbmp;
$caption ||='';
$blowup ||=0;
$background = $parent_background unless defined $background;
lib/AAC/Pvoice/Bitmap.pm view on Meta::CPAN
close($fh);
$cache->set("$file-$x-$y-$caption-$ibg-$blowup-$pbg-$mtime", $image);
}
my $fh = IO::Scalar->new(\$image);
my $contenttype = 'image/png';
return Wx::Bitmap->new(Wx::Image->newStreamMIME($fh, $contenttype))
}
sub wxColor2hex
{
my $color = shift;
my $red = $color->Red();
my $green = $color->Green();
my $blue = $color->Blue();
return sprintf("#%0x%0x%0x", $red,$green,$blue);
}
sub ReadImageMagick
{
my $file = shift;
my ($x, $y, $caption, $bgcolor, $blowup, $parent_background) = @_;
confess "MaxX and MaxY should be positive" if $x < 1 || $y < 1;
return DrawCaption($x, $y, '?', $bgcolor, $parent_background) unless -r $file;
$caption ||='';
$blowup ||=0;
$bgcolor = $parent_background unless defined $bgcolor;
lib/AAC/Pvoice/Bitmap.pm view on Meta::CPAN
my $contenttype = 'image/png';
return Wx::Bitmap->new(Wx::Image->newStreamMIME($fh, $contenttype))
}
END
{
undef $cache;
}
sub DrawCaption
{
my ($x, $y, $caption, $background, $parent_background) = @_;
confess "MaxX and MaxY should be positive" if $x < 1 || $y < 1;
my $newbmp = Wx::Bitmap->new($x, $y);
my $tmpdc = Wx::MemoryDC->new();
$tmpdc->SelectObject($newbmp);
my $bgbr = Wx::Brush->new($parent_background, wxSOLID);
lib/AAC/Pvoice/Bitmap.pm view on Meta::CPAN
100, #maxY
'This is my image', #caption
wxWHITE, #background
1); #blowup?
=head1 DESCRIPTION
This module is a simpler interface to the Wx::Bitmap to do things with
images that I tend to do with almost every image I use in pVoice applications.
It's a subclass of Wx::Bitmap, so you can call any method that a Wx::Bitmap
can handle on the resulting AAC::Pvoice::Bitmap.
=head1 USAGE
=head2 new(image, maxX, maxY, caption, background, blowup, parentbackground)
This constructor returns a bitmap (useable as a normal Wx::Bitmap), that
has a size of maxX x maxY, the image drawn into it as large as possible.
If blowup has a true value, it will enlarge the image to try and match
the maxX and maxY. Any space not filled by the image will be the
lib/AAC/Pvoice/Bitmap.pm view on Meta::CPAN
These are the maximum X and Y size of the resulting image. If the original
image is larger, it will be resized (maintaining the aspect ratio) to
match these values as closely as possible. If the 'blowup' parameter is
set to a true value, it will also enlarge images that are smaller than
maxX and maxY to get the largest possible image within these maximum values.
=item caption
This is an optional caption below the image. The caption's font is Comic Sans MS
and will have a pointsize that will make the caption fit within the maxX
of the image. The resulting height of the caption is subtracted from the
maxY
=item background
This is the background of the image, specified as either a constant
(i.e. wxWHITE) or as an arrayref of RGB colours (like [128,150,201] ).
=item blowup
This boolean parameter determines whether or not images that are smaller
lib/AAC/Pvoice/Dialog.pm view on Meta::CPAN
use strict;
use warnings;
our $VERSION = sprintf("%d.%02d", q$Revision: 1.1 $=~/(\d+)\.(\d+)/);
use Wx qw(:everything);
use Wx::Event qw(EVT_CLOSE);
use base 'Wx::Dialog';
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
my ($x, $y) = ($self->GetClientSize->GetWidth,
$self->GetClientSize->GetHeight);
$self->{margin} = 10;
$self->{ITEMSPACING} = 4;
$self->{selectionborder} = 3;
$self->{backgroundcolour} = Wx::Colour->new(220,220,220);
lib/AAC/Pvoice/Dialog.pm view on Meta::CPAN
$self->{selectionborder}, # selectionborderwidth
1); # disabletitle
$self->{panel}->BackgroundColour($self->{backgroundcolour});
$self->WarpPointer($self->{margin}+1,$self->{margin}+1);
$self->SetFocus();
EVT_CLOSE($self, \&OnClose);
return $self;
}
sub Append
{
my $self = shift;
$self->{panel}->Append(@_);
}
sub OnClose
{
my $self = shift;
$self->Destroy();
}
sub Show
{
my $self = shift;
my $bool = shift;
$self->{panel}->Finalize();
$self->SUPER::Show($bool);
}
sub ShowModal
{
my $self = shift;
$self->{panel}->Finalize();
$self->SUPER::ShowModal();
}
1;
__END__
lib/AAC/Pvoice/Dialog.pm view on Meta::CPAN
=head1 NAME
AAC::Pvoice::Dialog - A class similar to Wx::Dialog, with added accessibility
=head1 SYNOPSIS
use AAC::Pvoice::Dialog;
=head1 DESCRIPTION
This subclass of Wx::Dialog knows all of Wx::Dialog's methods. Therefore
only two methods are described below. The constructor (which is also similar
to the Wx::Dialog constructor) and the (added) Append method.
=head1 USAGE
=head2 new(parent, id, caption, [x,y], [w,h])
This is the constructor for a new AAC::Pvoice::Dialog. It is similar to calling
the constructor of a Wx::Dialog.
=head2 Append
This method is similar to AAC::Pvoice::Panel's Append method and allows you
to append a 'row' (or any Wx::Window subclass) to the Dialog.
=head1 BUGS
probably a lot, patches welcome!
=head1 AUTHOR
Jouke Visser
jouke@pvoice.org
lib/AAC/Pvoice/EditableRow.pm view on Meta::CPAN
use Wx qw(:everything);
use Wx::Perl::Carp;
use Wx::Event qw( EVT_BUTTON );
use AAC::Pvoice::Bitmap;
use base qw(Wx::Panel);
our $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $=~/(\d+)\.(\d+)/);
#----------------------------------------------------------------------
sub new
{
my $class = shift;
my ($parent,$maxitems,$items,$wxPos,$wxSize, $itemmaxX, $itemmaxY, $itemspacing, $background, $style,$name) = @_;
$wxPos ||= wxDefaultPosition;
$wxSize ||= wxDefaultSize;
$style ||= 0;
$name ||= '';
my $self = $class->SUPER::new($parent, -1, $wxPos, $wxSize, $style, $name);
$self->{maxitems} = $maxitems;
lib/AAC/Pvoice/EditableRow.pm view on Meta::CPAN
# Create a new panel
my $sizer = Wx::GridSizer->new(1,0);
$self->{items} = [];
$self->{actions} = [];
my ($maxX, $maxY) = ($itemmaxX, $itemmaxY);
# Add the defined keys for this row
for (@$items)
{
my ($id, $img, $sub) = @$_;
my $button = Wx::BitmapButton->new
($self, # parent
$id, # id
$img, # image
wxDefaultPosition, # position
[$maxX+3, $maxY+3], # size
wxBU_AUTODRAW); # style
$button->SetBackgroundColour($background);
$sizer->Add($button, 0, wxALIGN_CENTRE|wxALL, $self->{itemspacing});
push @{$self->{items}}, $button;
EVT_BUTTON($self, $id, $sub);
}
my $totalitems = scalar(@$items);
$self->{totalitems} = scalar(@{$self->{items}});
$self->SetBackgroundColour($background);
$self->SetSizer($sizer);
# $self->SetAutoLayout(1);
$sizer->Fit($self);
return $self;
}
lib/AAC/Pvoice/Input.pm view on Meta::CPAN
else
{
require Device::ParallelPort::drv::parport;
}
}
use Wx::Event qw( EVT_TIMER
EVT_CHAR
EVT_MOUSE_EVENTS);
our $VERSION = sprintf("%d.%02d", q$Revision: 1.12 $=~/(\d+)\.(\d+)/);
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
bless $self, $class;
$self->{window} = shift;
# We get the configuration from the Windows registry
# If it's not initialized, we provide some defaults
$self->{window}->{config} = Wx::ConfigBase::Get || croak "Can't get Config";
lib/AAC/Pvoice/Input.pm view on Meta::CPAN
$self->_initautoscan if $self->{window}->{config}->ReadInt('Buttons') == 1;
$self->_initkeys;
$self->_initicon;
$self->StartMonitor if $self->{window}->{Device} eq 'adremo';
$self->StartAutoscan if $self->{window}->{config}->ReadInt('Buttons') == 1;
return $self;
}
sub newchild
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
bless $self, $class;
$self->{window} = shift;
# We get the configuration from the Windows registry
# If it's not initialized, we provide some defaults
$self->{window}->{config} = Wx::ConfigBase::Get || croak "Can't get Config";
lib/AAC/Pvoice/Input.pm view on Meta::CPAN
# adremo = electric wheelchair adremo
# keys = keystrokes
$self->{window}->{Device} = $self->{window}->{config}->Read('Device', 'icon');
$self->_initkeys;
$self->_initicon;
return $self;
}
sub _initkeys
{
my $self = shift;
EVT_CHAR($self->{window}, \&_keycontrol)
if $self->{window}->{config}->Read('Device') eq 'keys';
}
sub _initicon
{
my $self = shift;
EVT_MOUSE_EVENTS($self->{window}, \&_iconcontrol)
if $self->{window}->{config}->Read('Device') eq 'icon';
}
sub _initmonitor
{
my $self = shift;
# The event for the adremo device
$self->{window}->{adremotimer} = Wx::Timer->new($self->{window},my $tid = Wx::NewId());
EVT_TIMER($self->{window}, $tid, \&_monitorport);
}
sub _initautoscan
{
my $self = shift;
$self->{window}->{onebuttontimer} = Wx::Timer->new($self->{window},my $obtid = Wx::NewId());
EVT_TIMER($self->{window}, $obtid, sub{my $self = shift; $self->{input}->{next}->() if $self->{input}->{next}});
}
sub StartMonitor
{
my $self = shift;
$self->{window}->{adremotimer}->Start($self->{window}->{Interval}, 0) # 0 is continuous
if $self->{window}->{adremotimer};
}
sub QuitMonitor
{
my $self = shift;
# stop the timer for the port monitor
$self->{window}->{adremotimer}->Stop() if $self->{window}->{adremotimer} && $self->{window}->{adremotimer}->IsRunning;
}
sub StartAutoscan
{
my $self = shift;
$self->{window}->{onebuttontimer}->Start($self->{window}->{OneButtonInterval}, 0) # 0 is continuous
if $self->{window}->{onebuttontimer};
}
sub QuitAutoscan
{
my $self = shift;
$self->{window}->{onebuttontimer}->Stop() if $self->{window}->{onebuttontimer} && $self->{window}->{onebuttontimer}->IsRunning;
}
sub PauseMonitor
{
my $self = shift;
my $bool = shift;
return unless $self->{window}->{config}->Read('Device') eq 'adremo';
$self->QuitMonitor if $bool;
$self->StartMonitor unless $bool;
}
sub PauseAutoscan
{
my $self = shift;
my $bool = shift;
return unless $self->{window}->{config}->ReadInt('Buttons') == 1;
$self->QuitAutoscan if $bool;
$self->StartAutoscan unless $bool;
}
sub Pause
{
my $self = shift;
$self->{pause} = shift;
}
sub GetDevice
{
my $self = shift;
return $self->{window}->{config}->Read('Device');
}
sub SetupMouse
{
my $self = shift;
my ($window, $subgetfocus, $subup, $sublosefocus) = @_;
if ($self->{window}->{config}->Read('Device') eq 'mouse')
{
EVT_MOUSE_EVENTS($window, sub { my ($self, $event) = @_;
&$subup if $event->LeftUp;
&$sublosefocus if $event->Leaving;
&$subgetfocus if $event->Entering;
});
}
}
sub Next
{
my $self = shift;
my $sub = shift;
$self->{next} = $sub;
}
sub Select
{
my $self = shift;
my $sub = shift;
$self->{select} = $sub;
}
sub _keycontrol
{
# BEWARE: $self is the window object this event belongs to
my ($self, $event) = @_;
return if $self->{pause};
$self->{input}->{select}->() if ($event->GetKeyCode == $self->{config}->ReadInt('SelectKey', WXK_RETURN)) || (uc(chr($event->GetKeyCode)) eq uc(chr($self->{config}->ReadInt('SelectKey'))));
$self->{input}->{next}->() if (( ($event->GetKeyCode == $self->{config}->ReadInt('NextKey', WXK_SPACE)) ||
(uc(chr($event->GetKeyCode)) eq uc(chr($self->{config}->ReadInt('NextKey'))))) and
(not $self->{config}->ReadInt('Buttons') == 1));
}
sub _iconcontrol
{
# BEWARE: $self is the window object this event belongs to
my ($self, $event) = @_;
return if $self->{pause};
$self->{input}->{select}->() if $event->LeftUp;
$self->{input}->{next}->() if $event->RightUp &&
not $self->{config}->ReadInt('Buttons') == 1;
}
#----------------------------------------------------------------------
# This sub is used to monitor the parallel port for the adremo device
sub _monitorport
{
# BEWARE: $self is the wxWindow subclass the timer
# belongs to!
my ($self, $event) = @_;
# do nothing if the device is not adremo or
# if we're already running
return if ($self->{monitorrun} ||
(not $self->{input}->{next}) ||
(not $self->{input}->{select}) ||
$self->{pause});
# set the flag that we're checking the port
$self->{monitorrun} = 1;
lib/AAC/Pvoice/Input.pm view on Meta::CPAN
value of the configuration key 'Interval'. This setting is only useful if you connect
an "Adremo" electrical wheelchair to the parallel port of your PC (for more
information see http://www.adremo.nl).
If the key 'Device' is set to 'icon' it will respond to the left and right
mouse button, and if it's set to 'keys' it will respond to the configuration
keys 'SelectKey' and 'NextKey' (which are the keyboard codes for the 'select'
and 'next' events respectively.
AAC::Pvoice::Input has the ability to operate with either one or two buttons.
If you want to use only one button, you need to set the configuration key "Buttons"
to 1, and it will automatically invoke the subroutine you pass to Next()
at an interval of the value set in the configuration key OneButtonInterval (set in milliseconds).
The default for is to operate in two button mode, and if OneButtonInterval is not
set, it will use a default of 2000 milliseconds if "Buttons" is set to 1.
=head2 newchild($window)
This semi-constructor takes the window (usually a child of the panel you
passed to the new() constructor, on which the events will be called as a parameter.
It doesn't start the timers for polling the parallel port and automatic
invocation of the Next() subroutine, because those timers otherwise would
be started multiple times.
Apart from starting those timers, this method works exactly like the new()
=head2 Next(sub)
This method takes a coderef as parameter. This coderef will be invoked when
the 'Next' event happens.
If the Device (see 'new') is set to 'icon', and a right mousebutton is
clicked, a 'Next' event is generated.
If the Device is set to 'adremo' and the headsupport of the wheelchair
is moved to the right, that will also generate a 'Next' event.
If the Device is set to 'keys' and a key is pressed that corresponds with the
keycode set in the 'NextKey', this will generate a 'Next' event too.
=head2 Select(sub)
This method takes a coderef as parameter. This coderef will be invoked when
the 'Select' event happens.
If the Device (see 'new') is set to 'icon', and a left mousebutton is
clicked, a 'Select' event is generated.
If the Device is set to 'adremo' and the headsupport of the wheelchair
is moved to the left, that will also generate a 'Select' event.
If the Device is set to 'keys' and a key is pressed that corresponds with the
keycode set in the 'SelectKey', this will generate a 'Select' event too.
=head2 GetDevice
This method will return the value of the configuration key called 'Device'
=head2 SetupMouse($window, $subgetfocus, $subup, $sublosefocus)
This method is used to setup a button for normal mouse input (when
configuration key 'Device' is set to 'mouse'). It takes the wxWindow
(typically a Wx::BitmapButton) that should respond to this way of
input as the first parameter.
$subgetfocus is the coderef that should be invoked when the mousecursor
hovers over this $window (EVT_ENTER).
$subup is the coderef that should be invoked when the left mousebutton
is released (EVT_LEFT_UP).
$sublosefocus is the coderef that should be invoked when the $window
loses focus (EVT_LEAVE).
=head2 StartMonitor
This method will start polling the the parallel port for input of the Adremo
Electrical Wheelchair.
=head2 QuitMonitor
This method will stop the timer that monitors the parallel port.
lib/AAC/Pvoice/Panel.pm view on Meta::CPAN
use warnings;
our $VERSION = sprintf("%d.%02d", q$Revision: 1.15 $=~/(\d+)\.(\d+)/);
use Wx qw(:everything);
use Wx::Perl::Carp;
use Wx::Event qw(EVT_PAINT EVT_UPDATE_UI);
use base qw(Wx::Panel);
#----------------------------------------------------------------------
sub new
{
my $class = shift;
$_[2] ||= wxDefaultPosition;
$_[3] ||= wxDefaultSize;
$_[4] ||= wxTAB_TRAVERSAL;
my $self = $class->SUPER::new(@_[0..4]);
$self->SetBackgroundColour(wxWHITE);
$self->{parent} = $_[0];
lib/AAC/Pvoice/Panel.pm view on Meta::CPAN
# will be, we'll simple draw an empty title.
$self->TitleFont(Wx::Font->new( 18, # font size
wxDECORATIVE, # font family
wxNORMAL, # style
wxNORMAL, # weight
0,
'Comic Sans MS', # face name
wxFONTENCODING_SYSTEM)) unless $self->TitleFont;
$self->AddTitle('');
my $usableysize = $y - 2*$self->{title}->GetSize()->GetHeight();
# If we want to use a textrow, we have to subtract another 60
# pixels from the y size, since the textrow is always 60 pixels high.
$usableysize-=60 unless $self->{disabletextrow};
$self->ysize($usableysize);
}
# set the default colours...these can of course be changed...
$self->SelectColour(Wx::Colour->new(255,131,131));
$self->BackgroundColour(Wx::Colour->new(220,220,220));
$self->SetSizer($self->{tls});
$self->SetAutoLayout(1);
$self->{displaytextsave} = [];
$self->{speechtextsave} = [];
# Initialize the input stuff
$self->{input} = AAC::Pvoice::Input->new($self);
$self->{input}->Next( sub{$self->Next});
$self->{input}->Select(sub{$self->Select});
$self->{rowcolumnscanning} = ($self->{input}->GetDevice ne 'mouse');
EVT_PAINT($self, \&OnPaint);
EVT_UPDATE_UI($self, $self, \&OnPaint);
return $self;
}
sub SetEditmode
{
my $self = shift;
$self->{editmode} = shift;
}
sub OnPaint
{
my ($self, $event) = @_;
$self->{setselection} = 1;
my $dc = Wx::PaintDC->new($self);
$self->SetBackgroundColour($self->{parent}->GetBackgroundColour);
$self->DrawBackground($dc);
if ($self->{rowcolumnscanning} && not $self->{editmode})
{
$dc = Wx::WindowDC->new($self->{selectedwindow}->GetParent);
$self->DrawBorder($dc);
}
$event->Skip;
}
sub DrawBorder
{
my $self = shift;
my $dc = shift;
my $window = $self->{selectedwindow};
my ($x, $y) = $window->GetPositionXY;
my $size = $window->GetSize;
my ($xsize, $ysize) = ($size->GetWidth, $size->GetHeight);
$dc->BeginDrawing;
$dc->SetBrush(wxTRANSPARENT_BRUSH);
$dc->SetPen(Wx::Pen->new($self->{setselection} ? $self->SelectColour :
$self->BackgroundColour, $self->{selectionborder}, wxSOLID));
$dc->DrawRoundedRectangle($x-($self->{itemspacing}/2-1), $y-($self->{itemspacing}/2-1), $xsize+($self->{itemspacing}/2+1), $ysize+($self->{itemspacing}/2+1), $self->RoundCornerRadius);
$dc->EndDrawing;
}
sub SetSelectionBorder
{
my $self = shift;
$self->{selectedwindow} = shift;
$self->{setselection} = 1;
my $dc = Wx::WindowDC->new($self->{selectedwindow}->GetParent);
$self->DrawBorder($dc);
}
sub SetNormalBorder
{
my $self = shift;
$self->{selectedwindow} = shift;
$self->{setselection} = 0;
my $dc = Wx::WindowDC->new($self->{selectedwindow}->GetParent);
$self->DrawBorder($dc);
}
sub RoundCornerRadius
{
my $self = shift;
$self->{radius} = shift || $self->{radius};
return $self->{radius};
}
sub xsize
{
my $self = shift;
$self->{xsize} = shift || $self->{xsize};
return $self->{xsize}-2*$self->RoundCornerRadius;
}
sub ysize
{
my $self = shift;
$self->{ysize} = shift || $self->{ysize};
return $self->{ysize}-2*$self->RoundCornerRadius;
}
sub lastrow
{
my $self = shift;
return $self->{lastrow};
}
sub SelectColour
{
my $self = shift;
$self->{selectcolour} = shift || $self->{selectcolour};
return $self->{selectcolour};
}
sub BackgroundColour
{
my $self = shift;
$self->{backgroundcolour} = shift || $self->{backgroundcolour};
return $self->{backgroundcolour};
}
sub DrawBackground
{
my $self = shift;
my $dc = shift;
$dc->SetBrush(Wx::Brush->new($self->BackgroundColour, wxSOLID));
$dc->SetPen(Wx::Pen->new($self->BackgroundColour, 1, wxSOLID));
$dc->DrawRoundedRectangle(0,0,$self->{realx}, $self->{realy}, $self->RoundCornerRadius);
}
sub AddTitle
{
my ($self, $title) = @_;
return if $self->{disabletitle};
my $titleupdate = exists $self->{title};
if ($titleupdate)
{
$self->{tls}->Remove($self->{title});
}
# Create the TextControl
$self->{title} = Wx::StaticText->new( $self,
-1,
$title,
wxDefaultPosition,
wxDefaultSize,
wxALIGN_CENTRE);
$self->TitleFont();
# Don't use 'Add' here...the title should be on top!!
$self->{tls}->Prepend($self->{title},0, wxALIGN_CENTRE, 0);
}
sub TitleFont
{
my $self = shift;
$self->{titlefont} = shift || $self->{titlefont};
return if not $self->{titlefont};
$self->{title}->SetFont($self->{titlefont}) if $self->{title};
return $self->{titlefont};
}
sub Append
{
my $self = shift;
my $row = shift;
my $unselectable = shift;
$self->{tls}->Add($row, # what to add
0, # unused
wxALIGN_CENTRE, # style
0); # padding
# setup the input event handling unless we're in editmode
unless ($self->{editmode})
{
$row->{input} = AAC::Pvoice::Input->newchild($row);
$row->{input}->Next( sub{$self->Next});
$row->{input}->Select(sub{$self->Select});
my $index=0;
foreach my $child ($row->GetChildren)
{
$child->{input} = AAC::Pvoice::Input->newchild($child);
$child->{input}->Next( sub{$self->Next});
$child->{input}->Select(sub{$self->Select});
if ((defined $row->{ids}->[$index]) && ($child->GetId == $row->{ids}->[$index]))
{
my $action = $row->{actions}->[$index];
$self->{input}->SetupMouse($child, sub{$self->SetSelectionBorder($child)}, $action, sub{$self->SetNormalBorder($child)});
$index++;
}
}
}
$self->{totalrows}++ if not $unselectable;
$self->{lastrow}++;
push @{$self->{rows}}, $row if not $unselectable;
push @{$self->{unselectablerows}}, $row if $unselectable;
}
sub PauseInput
{
my $self = shift;
my $bool = shift;
$self->{input}->PauseMonitor($bool);
$self->{input}->PauseAutoscan($bool);
$self->{input}->Pause($bool);
}
sub Clear
{
my $self = shift;
$self->{tls}->Remove($_) for (0..$self->{lastrow});
foreach my $row (@{$self->{rows}})
{
$_->Destroy for $row->GetChildren();
$row->Destroy
}
$_->Destroy for @{$self->{unselectablerows}};
$self->{text}->Destroy if exists $self->{text};
$self->{title}->Destroy if exists $self->{title};
$self->{rows} = [];
$self->{unselectablerows} = [];
$self->SUPER::Clear();
$self->{totalrows} = 0;
$self->{lastrow} = 0;
$self->Refresh;
}
sub Finalize
{
my $self = shift;
my $dc = Wx::WindowDC->new($self);
$self->DrawBackground($dc);
unless ($self->{disabletextrow})
{
# Create the TextControl
my $font = Wx::Font->new( 24, # font size
wxSWISS, # font family
lib/AAC/Pvoice/Panel.pm view on Meta::CPAN
# Select the first row
$self->{selectedrow} = 0;
$self->{selecteditem} = 0;
$self->SetSelectionBorder($self->{rows}->[$self->{selectedrow}]) if $self->{rowcolumnscanning} && not $self->{editmode};
$self->{rowselection} = 1;
$self->Refresh;
$self->Update();
$self->{unfinished} = 0;
}
sub Next
{
my $self = shift;
return if ($self->{editmode} || $self->{unfinished});
$self->{input}->QuitAutoscan;
if ($self->{rowselection})
{
$self->SetNormalBorder($self->{rows}->[$self->{selectedrow}]) if $self->{rowcolumnscanning};
if ($self->{selectedrow} < ($self->{totalrows}-1))
{
$self->{selectedrow}++;
lib/AAC/Pvoice/Panel.pm view on Meta::CPAN
}
else
{
$self->{selecteditem} = 0;
}
$self->SetSelectionBorder($self->{rows}->[$self->{selectedrow}]->{items}->[$self->{selecteditem}]) if $self->{rowcolumnscanning};
}
$self->{input}->StartAutoscan;
}
sub Select
{
my $self = shift;
return if $self->{editmode};
$self->{input}->QuitAutoscan;
if (($self->{rowselection}) && (@{$self->{rows}->[$self->{selectedrow}]->{items}} == 1))
{
$self->{rowselection} = 0;
$self->{selecteditem} = 0;
}
if ($self->{rowselection})
lib/AAC/Pvoice/Panel.pm view on Meta::CPAN
{
$self->SetNormalBorder($self->{rows}->[$self->{selectedrow}]->{items}->[$self->{selecteditem}]) if $self->{rowcolumnscanning};
$self->SetSelectionBorder($self->{rows}->[$self->{selectedrow}]) if $self->{rowcolumnscanning};
&{$self->{rows}->[$self->{selectedrow}]->{actions}->[$self->{selecteditem}]};
$self->{rowselection} = 1;
}
$self->{input}->StartAutoscan;
}
sub ToRowSelection
{
my $self = shift;
return if $self->{editmode};
$self->SetNormalBorder($self->{rows}->[$self->{selectedrow}]->{items}->[$self->{selecteditem}]) if $self->{rowcolumnscanning};
$self->SetSelectionBorder($self->{rows}->[$self->{selectedrow}]) if $self->{rowcolumnscanning};
$self->{rowselection} = 1;
}
sub DisplayAddText
{
my $self = shift;
push @{$self->{displaytextsave}}, $_[0];
$self->{text}->AppendText($_[0]);
$self->{text}->Refresh(); # Added to test it on the Mercury...added text
# isn't visible there...
}
sub SpeechAddText
{
my $self = shift;
push @{$self->{speechtextsave}}, $_[0];
}
sub RetrieveText
{
my $self = shift;
return wantarray ? @{$self->{displaytextsave}} : join('', @{$self->{displaytextsave}});
}
sub ClearText
{
my $self = shift;
$self->{displaytextsave}=[];
$self->{speechtextsave}=[];
$self->{text}->SetValue('');
$self->{text}->Refresh(); # Added to test it on the Mercury...added text
# isn't visible there...
}
sub BackspaceText
{
my $self = shift;
pop @{$self->{displaytextsave}};
pop @{$self->{speechtextsave}};
$self->{text}->SetValue(my $x = $self->RetrieveText);
$self->{text}->SetStyle(0, length($self->{text}->GetValue), $self->{ta});
$self->{text}->Refresh(); # Added to test it on the Mercury...added text
# isn't visible there...
}
sub SpeechRetrieveText
{
my $self = shift;
return wantarray ? @{$self->{speechtextsave}} : join('', @{$self->{speechtextsave}});
}
1;
__END__
=pod
lib/AAC/Pvoice/Panel.pm view on Meta::CPAN
This method sets the title of the page and draws it on the AAC::Pvoice::Panel.
By default it uses the Comic Sans MS font at a size of 18pt. You can change
this using TitleFont.
=head2 TitleFont(Wx::Font)
This method gets or sets the Wx::Font used to write the Title.
=head2 Append(row, unselectable)
This method adds a row (AAC::Pvoice::Row or any subclass of Wx::Window) to
the panel. If this row shouldn't be selectable by the user, you should set
unselectable to 1. Omitting this parameter, or setting it to 0 makes the
row selectable.
=head2 Clear
This method clears the panel completely and destroys all objects on it.
=head2 Finalize
lib/AAC/Pvoice/Row.pm view on Meta::CPAN
use strict;
use warnings;
use Wx qw(:everything);
use Wx::Perl::Carp;
use AAC::Pvoice::Bitmap;
use base qw(Wx::Panel);
our $VERSION = sprintf("%d.%02d", q$Revision: 1.5 $=~/(\d+)\.(\d+)/);
#----------------------------------------------------------------------
sub new
{
my $class = shift;
my ($parent,$maxitems,$items,
$wxPos,$wxSize, $itemmaxX, $itemmaxY,
$itemspacing, $background, $style,$name) = @_;
my $self = $class->SUPER::new( $parent,
Wx::NewId,
$wxPos || wxDefaultPosition,
$wxSize || wxDefaultSize,
$style || 0,
lib/AAC/Pvoice/Row.pm view on Meta::CPAN
my $empty = Wx::BitmapButton->new( $self,
Wx::NewId,
wxNullBitmap,
wxDefaultPosition,
[$maxX, $maxY],
wxSUNKEN_BORDER);
$empty->SetBackgroundColour($background);
$sizer->Add($empty,0, wxALIGN_CENTRE|wxALL, $itemspacing);
next;
}
my ($id, $img, $sub) = @$_;
my $button = Wx::BitmapButton->new ($self, # parent
$id, # id
$img, # image
wxDefaultPosition, # position
[$maxX, $maxY],# size
wxSUNKEN_BORDER); # style
$button->SetBackgroundColour($background);
$sizer->Add($button, 0, wxALIGN_CENTRE|wxALL, $itemspacing);
push @{$self->{items}}, $button;
push @{$self->{actions}}, $sub;
push @{$self->{ids}}, $id;
}
my $totalitems = scalar(@$items);
$self->{totalitems} = scalar(@{$self->{items}});
for (0..($self->{maxitems} - $totalitems -1))
{
my $empty = Wx::BitmapButton->new( $self,
Wx::NewId,
wxNullBitmap,
wxDefaultPosition,
lib/AAC/Pvoice/Row.pm view on Meta::CPAN
=head1 NAME
AAC::Pvoice::Row - A row of selectable items
=head1 SYNOPSIS
use AAC::Pvoice::Row;
use Wx;
my $panel = Wx::Panel->new($self, -1);
my $items = [ [Wx::NewId, $SomeWxBitmap, sub{ print "do something useful here"} ],
[Wx::NewId, $SomeOtherWxBitmap, sub{ print "do something else here"} ]];
my $row = AAC::Pvoice::Row->new($panel, # parent
scalar(@$items), # max
$items, # items
wxDefaultPosition,# pos
wxDefaultSize, # size
50, # maxX
75, # maxY
5, # spacing
wxWHITE) # background colour
=head1 DESCRIPTION
AAC::Pvoice::Row is a subclass of Wx::Panel. It will typically be placed
on an AAC::Pvoice::Panel, and contains selectable Wx::Bitmap-s, which,
when selected, will invoke a callback.
=head1 USAGE
=head 2 new(parent, maxitems, items, position, size, maxX, maxY, spacing, backgroundcolour)
This constructor is the only overridden function in AAC::Pvoice::Row. It
takes quite a number of parameters
=over 4
=item parent
The parent on which this row will be placed. Typically you'll be using an
instance of AAC::Pvoice::Panel for this, but it can be any Wx::Window
subclass
=item maxitems
The maximum number of items (images) in this row. If the supplied number
of items (next parameter) is lower than maxitems, the row will be filled up
with (unselectable) WxNullBitmap-s.
=item items
This parameter is a reference to a list of lists. Each item in the listref
t/001_load.t view on Meta::CPAN
# more testing will be added later
use Test::More tests => 2;
use Wx qw(:everything);
BEGIN { use_ok( 'AAC::Pvoice' ); }
package MyApp;
use base 'Wx::App';
sub OnInit
{
my $frame = MyFrame->new();
return 1;
}
package MyFrame;
use base 'Wx::Frame';
sub new
{
my $class = shift;
my $self = $class->SUPER::new(undef, -1, 'Test');
my $panel = AAC::Pvoice::Panel->new ($self, -1);
main::isa_ok ($panel, 'AAC::Pvoice::Panel');
return $self;
}
package main;