~ubuntu-branches/ubuntu/lucid/perl-tk/lucid

« back to all changes in this revision

Viewing changes to demos/demos/widtrib/cursor.pl

• browse files at revision 5
• compare with another revision
• download diff
• download tarball
• view history from revision 5

Show diffs side-by-side

added

removed

demos/demos/widtrib/cursor.pl

 

1

# Predefined cursors.

 

2

# -*- perl -*-

 

3

 

 

4

#

 

5

# $Id: $

 

6

# Author: Slaven Rezic

 

7

#

 

8

# Copyright (C) 2006 Slaven Rezic. All rights reserved.

 

9

# This program is free software; you can redistribute it and/or

 

10

# modify it under the same terms as Perl itself.

 

11

#

 

12

# Mail: slaven@rezic.de

 

13

# WWW:  http://www.rezic.de/eserte/

 

14

#

 

15

 

 

16

use vars qw/$TOP/;

 

17

 

 

18

sub cursor {

 

19

    my($demo) = @_;

 

20

    $TOP = $MW->WidgetDemo(

 

21

        -name             => $demo,

 

22

        -text             => <<'EOF',

 

23

This window displays the names of Tk's built-in

 

24

resp. predefined X11 cursors. Click on the names

 

25

to see the cursor shape.

 

26

EOF

 

27

        -geometry_manager => 'grid',

 

28

        -title            => 'Predefined cursors',

 

29

        -iconname         => 'Predefined cursors',

 

30

    );

 

31

 

 

32

    my $fh;

 

33

 TRY_CURSORFONTH: {

 

34

        for my $cursorfonth (Tk->findINC("X11/cursorfont.h"),

 

35

                             "/usr/X11R6/include/X11/cursorfont.h",

 

36

                             "/usr/include/X11/cursorfont.h",

 

37

                            ) {

 

38

            last TRY_CURSORFONTH if (open $fh, $cursorfonth);

 

39

        }

 

40

        $TOP->Label(-text => "Sorry. I can't find X11/cursorfont.h on this system.")->grid;

 

41

        return;

 

42

    }

 

43

 

 

44

    while(<$fh>) {

 

45

        chomp;

 

46

        if (/XC_(\S+)/) {

 

47

            my $cursorname = $1;

 

48

            next if $cursorname eq 'num_glyphs';

 

49

            push @cursors, $cursorname;

 

50

        }

 

51

    }

 

52

 

 

53

    $lb = $TOP->Scrolled("Listbox", -scrollbars => "ose")->grid;

 

54

    $lb->insert("end", @cursors);

 

55

    $lb->bind("<1>", sub {

 

56

                  my($inx) = $lb->curselection;

 

57

                  $lb->configure(-cursor => $cursors[$inx]);

 

58

              });

 

59

}

 

60

 

 

61

__END__

• Older »

Loggerhead is a web-based interface for Breezy
Version: 2.0.1