## ctk: description Select cursor.
## ctk: title Select cursor.
## ctk: application '' ''
## ctk: strict  0
## ctk: code  0
## ctk: subroutineName dlg_selectCursor
## ctk: autoExtractVariables  1
## ctk: autoExtract2Local  1
## ctk: modalDialogClassName DialogBox
## ctk: modal 1
## ctk: isolGeom 0
## ctk: version 3.099
## ctk: onDeleteWindow  sub{1}
## ctk: Toplevel  1
## ctk: argList  
## ctk: 2007 04 13 - 01:35:36

use Tk;
use Tk::Button;
use Tk::Listbox;;
sub dlg_selectCursor {
my $hwnd = shift;
my (%args) =@_;
my $rv;

##
## ctk: Localvars
my $text ;
## ctk: Localvars end
##
$text = $args{-text} if exists $args{-text};

my $mw = $hwnd->DialogBox(
	-title=> &std::_title((exists $args{-title})? $args{-title}:'Select cursor.'),
	 -buttons=> (exists $args{-buttons}) ? $args{-buttons} : ['OK','Cancel']);

$mw->protocol('WM_DELETE_WINDOW',sub{$mw->Subwidget('B_Cancel')->invoke()});


## ctk: code generated by ctk_w version '3.099' 
## ctk: instantiate and display widgets 

$wr_001 = $mw -> Scrolled ( 'Listbox' , -background , '#ffffff' , -selectmode , 'single' , -relief , 'sunken' , -scrollbars , 'e'  ) -> pack(-anchor=>'nw', -side=>'top', -pady=>5, -fill=>'both', -expand=>1, -padx=>5);
$wr_001; &dlg_selectCursorInit($wr_001);

$wr_002 = $mw -> Button ( -background , '#ffffff' , -command , [\&_testCursor , $wr_001 ] , -state , 'normal' , -relief , 'raised' , -text , 'Test cursor'  ) -> pack(-side=>'top', -anchor=>'nw', -pady=>5, -fill=>'both', -expand=>1, -padx=>5);


## ctk: end of gened Tk-code

$rv =  $mw->Show();

if ($rv =~/^OK/i) {
		$rv = $wr_001->curselection();
		$rv = $wr_001->get($rv);
} else { 
		undef $rv
}
return $rv;

} ## end of dlg_selectCursor 

## ctk: end of dialog code
## ctk: callbacks
sub dlg_selectCursorInit {
my ($lb) = @_;
my @cursors = (qw/X_cursor
arrow
based_arrow_down
based_arrow_up
boat
bogosity
bottom_left_corner
bottom_right_corner
bottom_side
bottom_tee
box_spiral
center_ptr
circle
clock
coffee_mug
cross
cross_reverse
crosshair
diamond_cross
dot
dotbox
double_arrow
draft_large
draft_small
draped_box
exchange
fleur
gobbler
gumby
hand1
hand2
heart
icon
iron_cross
left_ptr
left_side
left_tee
leftbutton
ll_angle
lr_angle
man
middlebutton
mouse
num_glyphs
pencil
pirate
plus
question_arrow
right_ptr
right_side
right_tee
rightbutton
rtl_logo
sailboat
sb_down_arrow
sb_h_double_arrow
sb_left_arrow
sb_right_arrow
sb_up_arrow
sb_v_double_arrow
shuttle
sizing
spider
spraycan
star
target
tcross
top_left_arrow
top_left_corner
top_right_corner
top_side
top_tee
trek
ul_angle
umbrella
ur_angle
watch
xterm/);
map { $lb->insert('end',$_) } @cursors;
}
sub _testCursor {
	my ($lb) = @_;
	my $cursor = $lb->toplevel->cget(-cursor);
	my $x = $lb->curselection();
	if ($x) {
		my $tl = $lb->toplevel;
		$tl->configure(-cursor, $lb->get($x));
		$tl->update();
		$tl->Busy();
		sleep 3;
		$tl->Unbusy();
		$tl->configure(-cursor, $cursor);
		$tl->update();
	} else {}
}
## ctk: other code
## ctk: eof 2007 04 13 - 01:35:36
1;	## make perl compiler happy...

=head1 selectCursor

	This script provides subroutines to set up and run a modal dialog 
	in order to select, demonstrate and return a cursor argument.

=over

=item Methods

	dlg_selectCursor 
	dlg_selectCursorInit 
	_testCursor 


=back

=cut