@@ -1,5 +1,9 @@
Revision history for Perl module Prima
+1.41 2014-11-08
+ - Add ImageViewer.autoZoom
+ - Fixes to Notebook
+
1.40 2014-08-17
- Remove Win9X support
- Cygwin default build is for X11
@@ -4,7 +4,7 @@
"Dmitry Karasik <dmitry@karasik.eu.org>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921",
+ "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.142690",
"license" : [
"freebsd"
],
@@ -51,5 +51,5 @@
"url" : "http://github.com/dk/Prima"
}
},
- "version" : "1.40"
+ "version" : "1.41"
}
@@ -3,15 +3,15 @@ abstract: 'a perl graphic toolkit'
author:
- 'Dmitry Karasik <dmitry@karasik.eu.org>'
build_requires:
- ExtUtils::MakeMaker: 0
+ ExtUtils::MakeMaker: '0'
configure_requires:
- ExtUtils::MakeMaker: 0
+ ExtUtils::MakeMaker: '0'
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921'
+generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.142690'
license: open_source
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: Prima
no_index:
directory:
@@ -30,4 +30,4 @@ requires: {}
resources:
homepage: http://www.prima.eu.org/
repository: http://github.com/dk/Prima
-version: 1.40
+version: '1.41'
@@ -24,6 +24,16 @@
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
+use strict;
+use warnings;
+
+package MY::orderedhash;
+require Tie::Hash;
+our @ISA = qw(Tie::ExtraHash);
+sub tie { CORE::tie my %a, $_[0], $_[1]; \%a }
+sub TIEHASH { bless [{%{$_[1]}}], $_[0] }
+sub FIRSTKEY { $_[0][1] = [ sort keys %{$_[0][0]} ]; shift @{ $_[0][1] } }
+sub NEXTKEY { shift @{ $_[0][1] } }
package MY;
use strict;
@@ -2043,13 +2053,13 @@ WriteMakefile(
VERSION_FROM => 'Prima.pm',
ABSTRACT_FROM => 'Prima.pm',
AUTHOR => 'Dmitry Karasik <dmitry@karasik.eu.org>',
- PM => \%ALL_PM_INSTALL,
+ PM => MY::orderedhash->tie(\%ALL_PM_INSTALL),
OPTIMIZE => $OPTIMIZE,
PREREQ_PM => \%PREREQ,
OBJECT => "@o_files",
INC =>
- $cmd_options{EXTRA_CCFLAGS} . ' ' .
- join(' ', map { "-I$_" } @INCPATH ),
+ join(' ', map { "-I$_" } @INCPATH ).
+ ' ' . $cmd_options{EXTRA_CCFLAGS},
LIBS => [
$cmd_options{EXTRA_LDFLAGS} . ' ' .
':nosearch ' .
@@ -2059,7 +2069,7 @@ WriteMakefile(
LICENSE => 'FREEBSD',
EXE_FILES => \@exe_files,
PL_FILES => {},
- MAN3PODS => \%ALL_MAN_INSTALL,
+ MAN3PODS => MY::orderedhash->tie(\%ALL_MAN_INSTALL),
META_MERGE => {
resources => {
homepage => 'http://www.prima.eu.org/',
@@ -2072,3 +2082,4 @@ WriteMakefile(
},
clean => { FILES => "@target_clean" },
);
+
@@ -242,10 +242,10 @@ sub get_cell_text
sub get_range
{
- my ( $self, $axis, $index) = @_;
+ my ( $self, $vertical, $index) = @_;
my ( $min, $max) = ( 1, 16384 ); # actually, no real restriction on $max -
# just a reasonable non-undef value
- $self-> notify(q(GetRange), $axis, $index, \$min, \$max);
+ $self-> notify(q(GetRange), $vertical, $index, \$min, \$max);
$min = 1 if $min < 1;
$max = $min if $max < $min;
return $min, $max;
@@ -2015,8 +2015,16 @@ sub on_getrange
sub on_measure
{
- my ( $self, $col, $row, $sref) = @_;
- $$sref = $self-> get_text_width( $self-> get_cell_text( $col, $row), 1);
+ my ( $self, $vertical, $index, $sref) = @_;
+ if ( $vertical) {
+ $$sref = $self-> font-> height + 2;
+ } else {
+ $$sref = 0;
+ for ( my $i = 0; $i < $self-> {colMax}; $i++ ) {
+ my $w = $self-> get_text_width( $self->get_cell_text($i, $index), 1);
+ $$sref = $w if $$sref < $w;
+ }
+ }
}
package Prima::GridViewer;
@@ -2280,11 +2288,15 @@ sub on_fontchanged
sub on_measure
{
- my ( $self, $column, $index, $sref) = @_;
- if ( $column) {
- $$sref = $self-> get_text_width( $self-> {cells}-> [0]-> [$index], 1);
- } else {
+ my ( $self, $vertical, $index, $sref) = @_;
+ if ( $vertical) {
$$sref = $self-> font-> height + 2;
+ } else {
+ $$sref = 0;
+ for ( @{$self-> {cells}}) {
+ my $w = $self-> get_text_width( $$_[$index], 1);
+ $$sref = $w if $$sref < $w;
+ }
}
}
@@ -2626,10 +2638,10 @@ Returns text string assigned to cell in COLUMN and ROW.
Since the class does not assume the item storage organization,
the text is queried via C<Stringify> notification.
-=item get_range AXIS, INDEX
+=item get_range VERTICAL, INDEX
Returns a pair of integers, minimal and maximal breadth of INDEXth column
-or row in pixels. If AXIS is 1, the rows are queried; if 0, the columns.
+or row in pixels. If VERTICAL is 1, the rows are queried; if 0, the columns.
The method calls C<GetRange> notification.
@@ -2775,14 +2787,14 @@ SELECTED and FOCUSED are boolean
flags, if the cell must be drawn correspondingly in selected and
focused states.
-=item GetRange AXIS, INDEX, MIN, MAX
+=item GetRange VERTICAL, INDEX, MIN, MAX
-Puts minimal and maximal breadth of INDEXth column ( AXIS = 0 ) or row ( AXIS = 1)
+Puts minimal and maximal breadth of INDEXth column ( VERTICAL = 0 ) or row ( VERTICAL = 1)
in corresponding MIN and MAX scalar references.
-=item Measure AXIS, INDEX, BREADTH
+=item Measure VERTICAL, INDEX, BREADTH
-Puts breadth in pixels of INDEXth column ( AXIS = 0 ) or row ( AXIS = 1)
+Puts breadth in pixels of INDEXth column ( VERTICAL = 0 ) or row ( VERTICAL = 1)
into BREADTH scalar reference.
This notification by default may be called from within
@@ -2793,9 +2805,9 @@ set internal flag C<{NoBulkPaintInfo}> to 1.
Called when a cell with COLUMN and ROW coordinates is focused.
-=item SetExtent AXIS, INDEX, BREADTH
+=item SetExtent VERTICAL, INDEX, BREADTH
-Reports breadth in pixels of INDEXth column ( AXIS = 0 ) or row ( AXIS = 1),
+Reports breadth in pixels of INDEXth column ( VERTICAL = 0 ) or row ( VERTICAL = 1),
as a response to C<columnWidth> and C<rowHeight> calls.
=item Stringify COLUMN, ROW, TEXT_REF
@@ -124,9 +124,14 @@ sub load_link
open UNIQUE_FILE_HANDLE_NEVER_TO_BE_CLOSED, "|start $link";
close UNIQUE_FILE_HANDLE_NEVER_TO_BE_CLOSED if 0;
} else {
- my $pg = $::application-> sys_action('browser');
- $self-> owner-> status("Cannot start browser"), return unless
- defined $pg && ! system( "$pg $link &");
+ my $pg;
+ CMD: for my $cmd ( qw(sensible-browser xdg-open x-www-browser www-browser firefox mozilla netscape)) {
+ for ( split /:/, $ENV{PATH} ) {
+ $pg = "$_/$cmd", last CMD if -x "$_/$cmd";
+ }
+ }
+ $self-> owner-> status("Cannot start browser"), return
+ unless defined $pg && ! system( "$pg $link &");
}
return;
}
@@ -40,6 +40,7 @@ sub profile_default
{
my $def = $_[0]-> SUPER::profile_default;
my %prf = (
+ autoZoom => 0,
image => undef,
imageFile => undef,
stretch => 0,
@@ -70,14 +71,14 @@ sub init
my $self = shift;
for ( qw( image ImageFile))
{ $self-> {$_} = undef; }
- for ( qw( alignment quality valignment imageX imageY stretch))
+ for ( qw( alignment autoZoom quality valignment imageX imageY stretch))
{ $self-> {$_} = 0; }
for ( qw( zoom integralScreen integralImage))
{ $self-> {$_} = 1; }
$self-> {zoomPrecision} = 10;
my %profile = $self-> SUPER::init(@_);
$self-> { imageFile} = $profile{ imageFile};
- for ( qw( image zoomPrecision zoom stretch alignment valignment quality)) {
+ for ( qw( image zoomPrecision zoom autoZoom stretch alignment valignment quality)) {
$self-> $_($profile{$_});
}
return %profile;
@@ -196,6 +197,33 @@ sub on_keydown
$self-> deltas( $dx, $dy);
}
+sub on_size
+{
+ my $self = shift;
+ $self->apply_auto_zoom if $self->{autoZoom};
+ $self->SUPER::on_size(@_);
+}
+
+sub apply_auto_zoom
+{
+ my $self = shift;
+ $self->hScroll(0);
+ $self->vScroll(0);
+ return unless $self->image;
+ my @szA = $self->image-> size;
+ my @szB = $self-> get_active_area(2);
+ my $xx = $szB[0] / $szA[0];
+ my $yy = $szB[1] / $szA[1];
+ $self-> zoom( $xx < $yy ? $xx : $yy);
+}
+
+sub set_auto_zoom
+{
+ my ( $self, $az ) = @_;
+ $self->{autoZoom} = $az;
+ $self->apply_auto_zoom if $az;
+}
+
sub set_alignment
{
$_[0]-> {alignment} = $_[1];
@@ -235,7 +263,7 @@ sub set_image
my $do_cubic;
if ( $self-> {bitmap}) {
- $do_cubic = not($img-> monochrome) && $::application-> get_bpp > 8;
+ $do_cubic = not($img-> monochrome) && $::application-> get_bpp == 8;
} else {
$do_cubic = ( $img-> type & im::BPP) > 8;
}
@@ -437,6 +465,7 @@ sub point2screen
return @ret;
}
+sub autoZoom {($#_)?$_[0]-> set_auto_zoom($_[1]):return $_[0]-> {autoZoom}}
sub alignment {($#_)?($_[0]-> set_alignment( $_[1])) :return $_[0]-> {alignment} }
sub valignment {($#_)?($_[0]-> set_valignment( $_[1])) :return $_[0]-> {valignment} }
sub image {($#_)?$_[0]-> set_image($_[1]):return $_[0]-> {image} }
@@ -550,6 +579,11 @@ Selects the horizontal image alignment.
Default value: C<ta::Left>
+=item autoZoom BOOLEAN
+
+When set, the image is automatically stretched while keeping aspects to the best available fit,
+given the C<zoomPrecision>. Scrollbars are turned off if C<autoZoom> is set to 1.
+
=item image OBJECT
Selects the image object to be displayed. OBJECT can be
@@ -562,7 +596,8 @@ a loading success flag.
=item stretch BOOLEAN
-If set, the image is simply stretched over the visual area. Scroll bars, zooming and
+If set, the image is simply stretched over the visual area,
+without keeping the aspect. Scroll bars, zooming and
keyboard navigation become disabled.
=item quality BOOLEAN
@@ -589,6 +589,51 @@ sub set_tabs
$self-> update_view;
}
+sub insert_tab
+{
+ my ( $self, $text, $at ) = @_;
+
+ $at = -1 unless defined $at;
+
+ my $t = $self->{tabs};
+ $at = @$t - $at + 1 if $at < 0;
+ return if $at > @$t || $at < 0;
+ splice( @$t, $at, 0, $text );
+
+ my $iw = 0;
+ my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(MeasureTab));
+ $self-> begin_paint_info;
+ $self-> push_event;
+ $notifier-> ( @notifyParms, $at, \$iw);
+ $self-> pop_event;
+ $self-> end_paint_info;
+
+ splice( @{$self->{widths}}, $at, 0, $iw);
+
+ $self-> reset;
+ $self-> tabIndex( $self-> tabIndex);
+ $self-> repaint;
+
+ return $at;
+}
+
+sub delete_tab
+{
+ my ( $self, $at ) = @_;
+ my $t = $self->{tabs};
+ $at = @$t - $at if $at < 0;
+ return if $at > $#$t || $at < 0;
+ splice( @$t, $at, 1 );
+ splice( @{$self->{widths}}, $at, 1 );
+
+ $self-> reset;
+ $self-> lock;
+ $self-> firstTab( $self-> firstTab);
+ $self-> tabIndex( $self-> tabIndex);
+ $self-> unlock;
+ $self-> update_view;
+}
+
sub set_top_most
{
my ( $self, $tm) = @_;
@@ -693,19 +738,38 @@ sub insert_page
splice( @{$self-> {widgets}}, $at, 0, []);
$self-> {pageCount}++;
$self-> pageIndex(0) if $self-> {pageCount} == 1;
+
+ return $at;
}
sub delete_page
{
my ( $self, $at, $removeChildren) = @_;
+
+ return unless $self->{pageCount};
$removeChildren = 1 unless defined $removeChildren;
$at = -1 unless defined $at;
$at = $self-> {pageCount} - 1 if $at < 0 || $at >= $self-> {pageCount};
+
+ my $idx = $self->pageIndex;
+ if ($at == $idx && $self->{pageCount} > 1) {
+ # switch away to record widget states properly
+ if ( $at > 0 ) {
+ $self->pageIndex( --$idx );
+ } else {
+ $self->pageIndex( 1 );
+ $idx = 0;
+ }
+ } elsif ( $idx > $at) {
+ $idx--;
+ }
+ $idx = 0 if $idx < 0;
my $r = splice( @{$self-> {widgets}}, $at, 1);
$self-> {pageCount}--;
- $self-> pageIndex( $self-> pageIndex);
+ $self-> {pageIndex} = $idx;
+
if ( $removeChildren) {
$_-> [0]-> destroy for @$r;
}
@@ -1180,7 +1244,9 @@ sub page2tab
my $j = 0;
while( $i < $index) {
$j++;
- $i += $$t[ $j*2 + 1];
+ my $n = $$t[ $j*2 + 1];
+ last unless defined $n;
+ $i += $n;
}
return $j;
}
@@ -1202,7 +1268,6 @@ sub TabSet_Change
$self-> pageIndex( $self-> tab2page( $tabset-> tabIndex));
}
-
sub set_tabs
{
my $self = shift;
@@ -1337,7 +1402,71 @@ sub adjust_widgets
$self-> repaint;
}
-sub tabIndex {($#_)?($_[0]-> {tabSet}-> tabIndex( $_[1])) :return $_[0]-> {tabSet}-> tabIndex}
+sub insert_page
+{
+ my ( $self, $tabName, $at ) = @_;
+
+ my $book = $self->{notebook};
+ $at = -1 unless defined $at;
+ $at = $book->pageCount + $at + 1 if $at < 0;
+ return if $at > $book->pageCount || $at < 0;
+
+ local $self-> {changeLock} = 1;
+ $self-> {notebook}->insert_page($at);
+
+ my $ctab = $self->page2tab($at);
+ my $tabs = $self->{tabs};
+ if ( defined($tabs->[$ctab * 2]) && $tabs->[$ctab * 2] eq $tabName) {
+ $tabs->[$ctab * 2 + 1]++;
+ } elsif ( $ctab > 0 && defined($tabs->[$ctab * 2 - 2]) && $tabs->[$ctab * 2 - 2] eq $tabName) {
+ $tabs->[$ctab * 2 - 1]++;
+ } else {
+ splice( @$tabs, $ctab * 2, 0, $tabName, 1 );
+ $self-> {tabSet}->insert_tab($tabName, $ctab);
+ }
+
+ $self->repaint if $self->{style} != tns::Simple;
+
+ return $at;
+}
+
+sub delete_page
+{
+ my ( $self, $at, $removeChildren ) = @_;
+
+ my $book = $self->{notebook};
+ $at = -1 unless defined $at;
+ $at = $book->pageCount + $at if $at < 0;
+ return if $at >= $book->pageCount || $at < 0;
+
+ local $self-> {changeLock} = 1;
+ my $ctab = $self->page2tab($at);
+ my $tabs = $self->{tabs};
+
+ # stay on page within same tab, if possible
+ if ( $tabs->[$ctab * 2 + 1] > 1 && $at == $self->pageIndex && $at > 0 ) {
+ $book->pageIndex( $book->pageIndex + 1 );
+ }
+ $book->delete_page($at, $removeChildren);
+ $ctab = $self->page2tab($at);
+
+ unless ( --$tabs->[$ctab * 2 + 1] ) {
+ splice(@$tabs, $ctab * 2, 2 );
+ $self->{tabSet}->delete_tab( $ctab );
+
+ # further collapse?
+ while ( 4 < @$tabs && $ctab * 2 < @$tabs && $tabs->[$ctab * 2] eq $tabs->[$ctab * 2 - 2]) {
+ my ( undef, $n) = splice(@$tabs, $ctab * 2, 2 );
+ $tabs->[$ctab * 2 - 1] += $n;
+ $self->{tabSet}->delete_tab( $ctab );
+ }
+ }
+ $self->repaint if $self->{style} != tns::Simple;
+
+ # futher collapse
+}
+
+sub tabIndex {($#_)?($_[0]-> {tabSet}-> tabIndex( $_[1])) :return $_[0]-> {tabSet}-> tabIndex}
sub pageIndex {($#_)?($_[0]-> set_page_index ( $_[1])) :return $_[0]-> {notebook}-> pageIndex}
sub tabs {($#_)?(shift-> set_tabs ( @_ )) :return $_[0]-> get_tabs}
@@ -1717,6 +1846,14 @@ Returns width in pixels of INDEXth tab.
Returns the index of a tab, that will be drawn leftmost if
INDEXth tab is to be displayed.
+=item insert_tab TEXT, [ POSITION = -1 ]
+
+Inserts a new tab text at the given position, which is at the end by default
+
+=item delete_tab POSITION
+
+Removes a tab from the given position
+
=back
=head2 Events
@@ -1912,6 +2049,16 @@ Returns second-level tab index, that corresponds to the INDEXth first-level tab.
Returns first-level tab index, that corresponds to the INDEXth second-level
tab.
+=item insert_page TEXT, [ POSITION = -1 ]
+
+Inserts a new page with text at the given position, which is at the end by default.
+If TEXT is same as the existing tab left or right from POSITION, the page is joined
+the existing tab; otherwise a new tab is created.
+
+=item delete_page POSITION
+
+Removes a page from the given position.
+
=back
=head2 Events
@@ -854,12 +854,12 @@ sub on_paint
$cr[2] = $x1 - 1 if $cr[2] > $x1 - 1;
$cr[2] = $aa[2] if $cr[2] > $aa[2];
$cr[2] = $aa[0] if $cr[2] < $aa[0];
- if ( $cr[0] <= $cr[2]) {
- $self-> selection_state( $canvas)
- if $self-> {selectionPaintMode};
- $self-> clipRect( @cr);
- $self-> block_draw( $canvas, $b, $x, $y);
- }
+ if ( $cr[0] <= $cr[2]) {
+ $self-> selection_state( $canvas)
+ if $self-> {selectionPaintMode};
+ $self-> clipRect( @cr);
+ $self-> block_draw( $canvas, $b, $x, $y);
+ }
@cr = @clipRect;
}
$self-> {selectionPaintMode} = (( $eq || $j == $sy1 ) ? 1 : 0);
@@ -1758,7 +1758,7 @@ special commands to L<block_wrap>.
C<OP_TEXT> commands to draw a string, from offset C<tb::BLK_TEXT_OFFSET + TEXT_OFFSET>,
with a length TEXT_LENGTH. The third parameter TEXT_WIDTH contains the width of the text
-in pixels. Such the two-part offset scheme is made for simplification or an imaginary code,
+in pixels. Such the two-part offset scheme is made for simplification of an imaginary code,
that would alter ( insert to, or delete part of ) the big text chunk; the updating procedure
would not need to traverse all commands, but just the block headers.
@@ -1899,9 +1899,9 @@ cleared in the output block.
=item block_draw CANVAS, BLOCK, X, Y
-The C<block_draw> draws BLOCK onto CANVAS in screen coordinates (X,Y).
-It can not only be used for drawing inside begin_paint/end_paint brackets;
-CANVAS can be an arbitrary C<Prima::Drawable> descendant.
+The C<block_draw> draws BLOCK onto CANVAS in screen coordinates (X,Y). It can
+be used not only inside begin_paint/end_paint brackets; CANVAS can be an
+arbitrary C<Prima::Drawable> descendant.
=back
@@ -1912,7 +1912,7 @@ Prima::TextView employs two its own coordinate systems:
The document coordinate system is isometric and measured in pixels. Its origin is located
into the imaginary point of the beginning of the document ( not of the first block! ),
-in the upper-left point. X increases to the right, Y increases downwards.
+in the upper-left pixel. X increases to the right, Y increases down.
The block header values BLK_X and BLK_Y are in document coordinates, and
the widget's pane extents ( regulated by C<::paneSize>, C<::paneWidth> and
C<::paneHeight> properties ) are also in document coordinates.
@@ -1921,7 +1921,7 @@ The block coordinate system in an-isometric - its second axis, BLOCK, is an inde
of a text block in the widget's blocks storage, C<$self-E<gt>{blocks}>, and
its first axis, TEXT_OFFSET is a text offset from the beginning of the block.
-Below described different coordinate system converters
+Below different coordinate system converters are described
=over
@@ -1962,7 +1962,7 @@ Accepts big text offset and returns BLOCK coordinate.
=head2 Text selection
-The text selection is performed automatically when the user selects the
+The text selection is performed automatically when the user selects a text
region with a mouse. The selection is stored in (TEXT_OFFSET,BLOCK)
coordinate pair, and is accessible via the C<::selection> property.
If its value is assigned to (-1,-1,-1,-1) this indicates that there is
@@ -1996,4 +1996,13 @@ rectangles, and the C<contains> method returns an integer value, whether
the passed coordinates are inside one of its rectangles or not; in the first
case it is the rectangle index.
+=head1 AUTHOR
+
+Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.
+
+=head1 SEE ALSO
+
+L<Prima::PodView>, F<examples/mouse_tale.pl>.
+
+
=cut
@@ -999,7 +999,7 @@ sub prf_types
{
my $pt = $_[ 0]-> SUPER::prf_types;
my %de = (
- bool => [qw(hScroll vScroll quality autoHScroll autoVScroll )],
+ bool => [qw(hScroll vScroll quality autoHScroll autoVScroll stretch)],
uiv => [qw(borderWidth zoom)],
image => ['image'],
align => ['alignment',],
@@ -46,8 +46,6 @@ sub XOpenDisplay
__DATA__
-=for rcs $Id$
-
=head1 NAME
Prima::noX11 - Use Prima without X11
@@ -34,7 +34,7 @@ require DynaLoader;
use vars qw($VERSION @ISA $__import @preload);
@ISA = qw(DynaLoader);
sub dl_load_flags { 0x00 }
-$VERSION = '1.40';
+$VERSION = '1.41';
bootstrap Prima $VERSION;
unless ( UNIVERSAL::can('Prima', 'init')) {
$::application = 0;
@@ -1741,7 +1741,7 @@ my $w = Prima::MainWindow-> create(
text => 'Canvas demo',
menuItems => [
['~Object' => [
- (map { [ $_ => "~$_" => \&insert] }
+ (map { [ $_ => "~$_" => \&insert_from_menu] }
qw(Rectangle Ellipse Arc Chord Sector Image Bitmap Line Polygon Text Button InputLine)),
[],
[ '~Delete' => 'Del' , kb::Delete , \&delete]
@@ -1886,6 +1886,12 @@ sub insert
$c-> focused_object( $c-> insert_object( "Prima::Canvas::$obj", %profile));
}
+sub insert_from_menu
+{
+ my ( $self, $obj ) = @_;
+ insert($self, $obj);
+}
+
sub delete
{
my $obj;
@@ -85,7 +85,6 @@ my %iv_prf = (
onMouseUp => \&iv_mouseup,
onMouseMove => \&iv_mousemove,
onMouseWheel => \&iv_mousewheel,
- onSize => \&iv_size,
);
sub status
@@ -149,11 +148,9 @@ sub menuadd
]],
['~Zoom' => [
['~Normal ( 100%)' => 'Ctrl+Z' => '^Z' => sub{$_[0]-> IV-> zoom(1.0)}],
- ['~Best fit' => 'Ctrl+Shift+Z' => km::Shift|km::Ctrl|ord('z') => \&zbestfit],
+ ['~Best fit' => 'Ctrl+Shift+Z' => km::Shift|km::Ctrl|ord('z') => sub { $_[0]->IV->apply_auto_zoom } ],
[],
- ['@abfit' => '~Auto best fit' => sub{
- zbestfit($_[0]) if $_[0]-> IV-> {autoBestFit} = $_[2];
- }],
+ ['@abfit' => '~Auto best fit' => sub{ $_[0]->IV->autoZoom($_[2]) }],
[],
['25%' => sub{$_[0]-> IV-> zoom(0.25)}],
['50%' => sub{$_[0]-> IV-> zoom(0.5)}],
@@ -323,16 +320,6 @@ sub iinfo
);
}
-sub zbestfit
-{
- my $iv = $_[0]-> IV;
- my @szA = $iv-> image-> size;
- my @szB = $iv-> get_active_area(2);
- my $x = $szB[0]/$szA[0];
- my $y = $szB[1]/$szA[1];
- $iv-> zoom( $x < $y ? $x : $y);
-}
-
sub iv_mousedown
{
my ( $self, $btn, $mod, $x, $y) = @_;
@@ -378,11 +365,6 @@ sub iv_mousewheel
}
-sub iv_size
-{
- zbestfit($_[0]-> owner) if $_[0]-> {autoBestFit};
-}
-
sub iv_destroy
{
$winCount--;
@@ -41,11 +41,7 @@ L<Prima::TabbedNotebook> standard class.
use strict;
use warnings;
-use Prima;
-use Prima::Buttons;
-use Prima::Notebooks;
-use Prima::ScrollWidget;
-use Prima::Application;
+use Prima qw(Buttons Notebooks ScrollWidget Application MsgBox);
package Bla;
use vars qw(@ISA);
@@ -60,6 +56,7 @@ sub init
pack => { fill => 'both', expand => 1, padx => 20, pady => 20 },
# pageCount => 11,
tabs => [0..5,5,5..10],
+ name => 'book',
);
$n-> insert_to_page( 0 => 'Button');
@@ -101,7 +98,31 @@ package Generic;
my $w = Bla-> create(
size => [ 600, 300],
y_centered => 1,
- # current => 1,
+ menuItems => [[ '~Action' => [
+ [ '~New tab', 'Ctrl+N', '^N', sub {
+ my $book = shift->book;
+ my $tabid = scalar(@{$book->TabSet->tabs}) + 1;
+ my $pageno = $book->insert_page("tab$tabid");
+ $book->insert_to_page($pageno, Button =>
+ origin => [ 20, 20 ],
+ text => "$tabid",
+ ),
+ }],
+ [ 'New ~page', 'Ctrl+M', '^M', sub {
+ my $book = shift->book;
+ my $tabid = $book->page2tab($book->pageIndex) + 1;
+ my $pageid = $book->pageIndex + 1;
+ my $pageno = $book->insert_page("tab$tabid", $pageid - 1);
+ $book->insert_to_page($pageno, Button =>
+ origin => [ 20, 20 ],
+ text => "$tabid/$pageid",
+ ),
+ }],
+ [ '~Delete tab', 'Ctrl+W', '^W', sub {
+ my $book = shift->book;
+ $book->delete_page($book->pageIndex, 1);
+ }],
+ ]]],
);
run Prima;
@@ -82,6 +82,9 @@ ibc_repad( Byte * source, Byte * dest, int srcLineSize, int dstLineSize, int src
if ( convProc == nil) {
convProc = (void*)memcpy_bitconvproc;
srcBpp = dstBpp = 1;
+ sb = srcLineSize;
+ db = dstLineSize;
+ bsc = sb > db ? db : sb;
}
if ( reverse) {
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::Clipboard - GUI interprocess data exchange
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::Drawable - 2-D graphic interface
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::File - asynchronous stream I/O.
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::Image - Bitmap routines
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::Menu - pull-down and pop-up menu objects
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::Object - Prima toolkit base classes
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::Printer - system printing services
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::Timer - programmable periodical events
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::Widget - window management
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::Window - top-level window management
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::X11 - usage guide for X11 environment
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::codecs - How to write a codec for Prima image subsystem
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::faq - Frequently asked questions about Prima
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::gp-problems - Problems, questionable or intricate topics in 2-D Graphics
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::image-load - Using image subsystem
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::internals - Prima internal architecture
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
Prima::tutorial - introductory tutorial
@@ -1,5 +1,3 @@
-=for rcs $Id$
-
=head1 NAME
gencls - class interface compiler for Prima core modules