← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/horae/gutsy

« back to all changes in this revision

Viewing changes to 0CPAN/Tk-GBARR-2.06/t/6numentry.t

  • Committer: Bazaar Package Importer
  • Author(s): Carlo Segre
  • Date: 2006-12-28 12:36:48 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20061228123648-9xnjr76wfthd92cq
Tags: 064-1
New upstream release, dropped dependency on libtk-filedialog-perl.

Show diffs side-by-side

added added

removed removed

Lines of Context:
0CPAN/Tk-GBARR-2.06/t/6numentry.t
1
 
use strict;
2
 
use vars '$loaded';
3
 
BEGIN { $^W= 1; $| = 1; print "1..6\n"; }
4
 
END {print "not ok 1\n" unless $loaded;}
5
 
use Tk::NumEntry;
6
 
$loaded = 1;
7
 
my $ok = 1;
8
 
print "ok " . $ok++ . "\n";
9
 
 
10
 
######################################################################
11
 
# This test script defines a new NumEntry class, consisting of new
12
 
# FireButton and NumEntryPlain classes.
13
 
#
14
 
# The MyFireButton class replaces the increment and decrement pictures
15
 
# with some predefined Tk bitmaps.
16
 
#
17
 
# The MyNumEntryPlain class adds new key events: Prior and Next for
18
 
# fast keyboard spinning and Home to reset to the default value.
19
 
#
20
 
######################################################################
21
 
# define own FireButton class
22
 
package Tk::MyFireButton;
23
 
use base qw(Tk::FireButton);
24
 
Construct Tk::Widget "MyFireButton";
25
 
 
26
 
sub INCBITMAP { "error" }
27
 
sub DECBITMAP { "gray75" }
28
 
sub HORIZINCBITMAP { "gray50" }
29
 
sub HORIZDECBITMAP { "gray25" }
30
 
 
31
 
######################################################################
32
 
# define own NumEntryPlain class
33
 
package Tk::MyNumEntryPlain;
34
 
use base qw(Tk::NumEntryPlain);
35
 
Construct Tk::Widget "MyNumEntryPlain";
36
 
 
37
 
sub ClassInit {
38
 
    my($class, $mw) = @_;
39
 
    $class->SUPER::ClassInit($mw);
40
 
    $mw->bind($class, '<Shift-Prior>', 'Up10');
41
 
    $mw->bind($class, '<Shift-Next>',  'Down10');
42
 
    $mw->bind($class, '<Shift-Home>',  'Set0');
43
 
}
44
 
 
45
 
sub Set0   { my $w = shift;
46
 
             $w->_parent->value($w->cget(-defaultvalue));
47
 
           }
48
 
sub Up10   { shift->_parent->incdec(10,'initial') }
49
 
sub Down10 { shift->_parent->incdec(-10,'initial') }
50
 
 
51
 
 
52
 
######################################################################
53
 
# define own NumEntry class
54
 
package Tk::MyNumEntry;
55
 
use base qw(Tk::NumEntry);
56
 
Construct Tk::Widget "MyNumEntry";
57
 
 
58
 
sub FireButtonWidget    { "MyFireButton" }
59
 
sub NumEntryPlainWidget { "MyNumEntryPlain"  }
60
 
 
61
 
######################################################################
62
 
# back to main again
63
 
package main;
64
 
 
65
 
my $top = new MainWindow;
66
 
my $ne;
67
 
eval {
68
 
    $ne = $top->MyNumEntry(-defaultvalue => 42,
69
 
                           -increment => '1.0')->pack;
70
 
};
71
 
if ($@) { print "not " } print "ok " . $ok++ . "\n";
72
 
 
73
 
eval {
74
 
    $top->MyNumEntry(-orient       => "horizontal",
75
 
                     -defaultvalue => 4711,
76
 
                     -minvalue => -10000,
77
 
                     -maxvalue => +10000,
78
 
                     -increment    => 0.1,
79
 
                     -bigincrement => 50)->pack;
80
 
};
81
 
if ($@) { print "not " } print "ok " . $ok++ . "\n";
82
 
 
83
 
$ne->configure(-value => 1);
84
 
if ($ne->cget(-value) != 1) { print "not " } print "ok " . $ok++ . "\n";
85
 
 
86
 
$ne->incdec(1);
87
 
if ($ne->cget(-value) != 2) { print "not " } print "ok " . $ok++ . "\n";
88
 
 
89
 
$ne->incdec(-1);
90
 
if ($ne->cget(-value) != 1) { print "not " } print "ok " . $ok++ . "\n";
91
 
 
92
 
$top->update;
93
 
#Tk::MainLoop;