if 0 {

''[escargo] 18 Jan 2005'' - I used [wish-reaper] to download this to my [Windows] XP Pro system.  No ants marched.

[DKF]: IIRC, Tk on Win has a few deficiencies in the dash handling... :^(

[MM] See [Canvas dash lines].
[HJG] and [Dash lines on Windows]
----
}
 # canvas_marching_ants.tcl --
 # 
 # Part of: Useless Widgets Package
 # Contents: test script for the marching ants selection
 # Date: Mon Jan 17, 2005
 # 
 # Abstract
 # 
 #	Selects items with the marching ants.
 # 
 # Copyright (c) 2005 Marco Maggi
 #
 # Most of [uwp_p_marching_ants_start_auto_scan] comes from the TK source
 # version 8.4, file "listbox.tcl".
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
 # Copyright (c) 1998 by Scriptics Corporation.
 # 
 # 
 # The author  hereby grant permission to use,  copy, modify, distribute,
 # and  license this  software  and its  documentation  for any  purpose,
 # provided that  existing copyright notices  are retained in  all copies
 # and that  this notice  is included verbatim  in any  distributions. No
 # written agreement, license, or royalty  fee is required for any of the
 # authorized uses.  Modifications to this software may be copyrighted by
 # their authors and need not  follow the licensing terms described here,
 # provided that the new terms are clearly indicated on the first page of
 # each file where they apply.
 # 
 # IN NO  EVENT SHALL THE AUTHOR  OR DISTRIBUTORS BE LIABLE  TO ANY PARTY
 # FOR  DIRECT, INDIRECT, SPECIAL,  INCIDENTAL, OR  CONSEQUENTIAL DAMAGES
 # ARISING OUT  OF THE  USE OF THIS  SOFTWARE, ITS DOCUMENTATION,  OR ANY
 # DERIVATIVES  THEREOF, EVEN  IF THE  AUTHOR  HAVE BEEN  ADVISED OF  THE
 # POSSIBILITY OF SUCH DAMAGE.
 # 
 # THE  AUTHOR  AND DISTRIBUTORS  SPECIFICALLY  DISCLAIM ANY  WARRANTIES,
 # INCLUDING,   BUT   NOT  LIMITED   TO,   THE   IMPLIED  WARRANTIES   OF
 # MERCHANTABILITY,    FITNESS   FOR    A    PARTICULAR   PURPOSE,    AND
 # NON-INFRINGEMENT.  THIS  SOFTWARE IS PROVIDED  ON AN "AS  IS" BASIS,
 # AND  THE  AUTHOR  AND  DISTRIBUTORS  HAVE  NO  OBLIGATION  TO  PROVIDE
 # MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
 # 
 #
 
 #page
 ## ------------------------------------------------------------
 ## Setup.
 ## ------------------------------------------------------------
 
 package require Tcl 8.4
 package require Tk  8.4
 
 #page
 ## ------------------------------------------------------------
 ## Widget options.
 ## ------------------------------------------------------------
 
 option add *borderWidth				1
 
 option add *Canvas.select_move_cursor		fleur
 option add *Canvas.select_point_cursor		hand1
 
 option add *Canvas.marching_ant_pattern		{10 4}
 option add *Canvas.marching_ant_step		4
 option add *Canvas.marching_ant_select_color	green
 option add *Canvas.marching_ant_marching_color	red
 option add *Canvas.marching_ant_delay		300
 
 
 #page
 ## ------------------------------------------------------------
 ## Main.
 ## ------------------------------------------------------------
 
 proc main {} {
     global	exit_trigger
 
     wm title . "Canvas Marching Ants Selection"
     wm geometry . +200+100
 
     frame .f
     canvas [set c .f.c] -width 300 -height 300 -background white \
 	-xscrollcommand {.f.hb set} -yscrollcommand {.f.vb set}
     scrollbar .f.vb -orient vertical -command {.f.c yview}
     scrollbar .f.hb -orient horizontal -command {.f.c xview}
     grid .f.c -sticky news -row 0 -column 0
     grid .f.vb -sticky ns -row 0 -column 1
     grid .f.hb -sticky ew -row 1 -column 0
 
     listbox .l -background bisque
     
     grid .f .l -sticky news
     
     $c configure -scrollregion [list 0 0 400 400]
     $c create rectangle 20 20 60 60 -tags Rectangle
     $c create text 350 290 -text {This is some text} -tags Text
     $c create oval 50 50 80 80 -tags {"Little Circle"}
     $c create oval 50 50 120 120 -tags {"Medium Circle"}
     $c create oval 50 50 200 200 -tags {"Big Circle"}
     
     uwp_marching_ants_bind $c update_selection_list
 
     grid [button .quit -text Exit -command main_exit]
     focus .quit
     bind .quit <Return> main_exit
     bind . <Escape> main_exit
     
     interp alias {} main_exit {} set exit_trigger 1
     vwait exit_trigger
     exit
 }
 proc update_selection_list { widget selected_items_identifiers_list } {
     set selected_items_first_tags {}
     foreach item $selected_items_identifiers_list {
 	lappend selected_items_first_tags [lindex [$widget gettags $item] 0]
     }
     .l delete 0 end
     eval {.l insert end} $selected_items_first_tags
 }
 #page
 proc uwp_data_set { widget key value } {
     global	uwp_data
     set uwp_data($widget:$key) $value
 }
 proc uwp_data_get { widget key } {
     global	uwp_data
     return $uwp_data($widget:$key)
 }
 proc uwp_p_append_tag { tag widget } {
     bindtags $widget [linsert [bindtags $widget] end $tag]
 }
 proc uwp_p_remove_tag { tag widget } {
     set idx [lsearch [set ell [bindtags $widget]] $tag]
     bindtags $widget [lreplace $ell $idx $idx]
 }
 proc alias { alias args } {
     eval { interp alias {} $alias {} } $args
 }
 #page
 bind MarchingAnts <ButtonPress-1>	{ uwp_marching_ants_event_press %W %x %y }
 bind MarchingAnts <ButtonRelease-1>	{ uwp_marching_ants_event_release %W %x %y }
 bind MarchingAnts <ButtonRelease-3>	{ uwp_marching_ants_event_release3 %W }
 bind MarchingAnts <Enter>		{ uwp_marching_ants_event_enter %W }
 bind MarchingAnts <Leave>		{ uwp_marching_ants_event_leave %W }
 bind MarchingAnts <B1-Leave>		{ uwp_marching_ants_event_pressed_and_leave %W }
 bind MarchingAntsSelect <Motion>	{ uwp_marching_ants_event_motion %W %x %y }
 alias uwp_marching_ants_unbind		uwp_p_remove_tag MarchingAnts
 alias uwp_marching_ants_bind_motion	uwp_p_append_tag MarchingAntsSelect
 alias uwp_marching_ants_unbind_motion	uwp_p_remove_tag MarchingAntsSelect
 
 proc uwp_marching_ants_bind { widget {command {}} } {
     uwp_p_append_tag MarchingAnts $widget
     uwp_data_set $widget MarchingAntsSelectCommand $command
 }
 #page
 proc uwp_marching_ants_event_press { widget x y } {
     uwp_p_marching_ants_delete_and_deselect_all $widget
     uwp_p_marching_ants_set_select_cursor $widget
     uwp_p_marching_ants_save_current_pointer_position $widget $x $y
     uwp_marching_ants_bind_motion $widget
     uwp_p_marching_ants_draw_selection_rectangle $widget $x $y
 }
 proc uwp_marching_ants_event_release { widget x y } {
     uwp_marching_ants_unbind_motion $widget    
     uwp_p_marching_ants_set_point_cursor $widget
     uwp_p_marching_ants_delete_selection_rectangle $widget
     uwp_p_marching_ants_draw_marching_ants $widget $x $y
     uwp_p_marching_ants_select_items $widget
     uwp_p_marching_ants_stop_auto_scan $widget
 }
 proc uwp_marching_ants_event_release3 { widget } {
     uwp_p_marching_ants_delete_and_deselect_all $widget
 }
 proc uwp_marching_ants_event_enter { widget } {
     uwp_p_marching_ants_save_current_cursor $widget
     uwp_p_marching_ants_set_point_cursor $widget
     uwp_p_marching_ants_stop_auto_scan $widget
 }
 proc uwp_marching_ants_event_leave { widget } {
     uwp_p_marching_ants_restore_current_cursor $widget
 }
 proc uwp_marching_ants_event_motion { widget x y } {
     uwp_p_marching_ants_update_selection_rectangle_coords $widget $x $y
 }
 proc uwp_marching_ants_event_pressed_and_leave { widget args } {
     uwp_p_marching_ants_start_auto_scan $widget
 }
 #page
 proc uwp_p_marching_ants_save_current_pointer_position { widget spotX spotY } {
     uwp_data_set $widget spot \
 	[list [$widget canvasx $spotX] [$widget canvasy $spotY]]
 }
 proc uwp_p_marching_ants_save_current_cursor { widget } {
     uwp_data_set $widget oldCursor [. cget -cursor]
 }
 proc uwp_p_marching_ants_restore_current_cursor { widget } {
     . configure -cursor [uwp_data_get $widget oldCursor]
 }
 proc uwp_p_marching_ants_set_point_cursor { widget } {
     . configure -cursor [option get $widget select_point_cursor {}]
 }
 proc uwp_p_marching_ants_set_select_cursor { widget } {
     . configure -cursor [option get $widget select_move_cursor {}]
 }
 #page
 proc uwp_p_marching_ants_draw_selection_rectangle { widget x y } {
     foreach {spotX spotY} [uwp_data_get $widget spot] {}
     $widget create rectangle \
 	$spotX $spotY [$widget canvasx $x] [$widget canvasy $y] \
 	-tags SelectionRectangle \
 	-outline [option get $widget marching_ant_select_color {}] \
 	-dash [option get $widget marching_ant_pattern {}]
 }
 proc uwp_p_marching_ants_delete_selection_rectangle { widget } {
     $widget delete SelectionRectangle
 }
 proc uwp_p_marching_ants_update_selection_rectangle_coords { widget x y } {
     foreach {spotX spotY} [uwp_data_get $widget spot] {}
     $widget coords SelectionRectangle \
 	$spotX $spotY [$widget canvasx $x] [$widget canvasy $y]
 }
 #page
 proc uwp_p_marching_ants_draw_marching_ants { widget x y } {
     foreach {spotX spotY} [uwp_data_get $widget spot] {}
     $widget create rectangle \
 	$spotX $spotY [$widget canvasx $x] [$widget canvasy $y] \
 	-tags MarchingAnts \
 	-dash [option get $widget marching_ant_pattern {}] \
 	-outline [option get $widget marching_ant_marching_color {}]
     uwp_p_marching_ants_schedule_step $widget
 }
 proc uwp_p_marching_ants_delete_marching_ants { widget } {
     uwp_p_marching_ants_unschedule_step $widget
     $widget delete MarchingAnts
 }
 proc uwp_p_marching_ants_schedule_step { widget {step 0} } {
     uwp_data_set $widget MarchingAntsMarchAfterId \
 	[after [option get $widget marching_ant_delay {}] \
 	     [list uwp_p_marching_ants_step $widget \
 		  [incr step [option get $widget marching_ant_step {}]]]]
 }
 proc uwp_p_marching_ants_unschedule_step { widget } {
     catch {after cancel [uwp_data_get $widget MarchingAntsMarchAfterId]}
 }
 proc uwp_p_marching_ants_step { widget step } {
     if { [winfo exists $widget]} {
 	$widget itemconfigure MarchingAnts -dashoffset $step
 	uwp_p_marching_ants_schedule_step $widget $step
     }
 }
 proc uwp_p_marching_ants_delete_and_deselect_all { widget } {
     uwp_p_marching_ants_delete_selection_rectangle $widget
     uwp_p_marching_ants_delete_marching_ants $widget
     uwp_p_marching_ants_deselect_items $widget
 }
 #page
 proc uwp_p_marching_ants_select_items { widget } {
     eval {$widget addtag MarchingAntSelection enclosed} [$widget coords MarchingAnts]
     utp_p_marching_ants_invoke_selection_command $widget \
 	[$widget find withtag MarchingAntSelection]
 }
 proc uwp_p_marching_ants_deselect_items { widget } {
     $widget dtag MarchingAntSelection MarchingAntSelection
     utp_p_marching_ants_invoke_selection_command $widget {}
 }
 proc utp_p_marching_ants_invoke_selection_command { widget selected_items_tags } {
     set command [uwp_data_get $widget MarchingAntsSelectCommand]
     if { [string length $command] } {
 	uplevel \#0 $command [list $widget $selected_items_tags]
     }
 }
 #page
 # Most of this comes from the TK source version 8.4, file "listbox.tcl".
 proc uwp_p_marching_ants_start_auto_scan { widget } {
     if { [winfo exists $widget] } {
 	set x [expr [winfo pointerx $widget]-[winfo rootx $widget]]
 	set y [expr [winfo pointery $widget]-[winfo rooty $widget]]
 	if {$y >= [winfo height $widget]} {
 	    $widget yview scroll 1 units
 	} elseif {$y < 0} {
 	    $widget yview scroll -1 units
 	} elseif {$x >= [winfo width $widget]} {
 	    $widget xview scroll 1 units
 	} elseif {$x < 0} {
 	    $widget xview scroll -1 units
 	} else {
 	    return
 	}
 	uwp_data_set $widget MarchingAntsAutoScanAfterId \
 	    [after 50 [list uwp_marching_ants_event_pressed_and_leave $widget]]
     }
 }
 proc uwp_p_marching_ants_stop_auto_scan { widget } {
     catch {after cancel [uwp_data_get $widget MarchingAntsAutoScanAfterId]}
 }
 #page
 ## ------------------------------------------------------------
 ## Let's go.
 ## ------------------------------------------------------------
 
 main
 
 ### end of file
 # Local Variables:
 # mode: tcl
 # End:
----
[[[Category GUI]]]