======
 # canvas_cyclic_selection.tcl --
 # 
 # Part of: Useless Widgets Package
 # Contents: test script for the cyclic object selection
 # Date: Wed Jan 19, 2005
 # 
 # Abstract
 # 
 #        Shows how to select a group of objects, and then each sub-object
 #        cyclically, by point-and-click on an object. This is useful when
 #        composite objects are placed on        a canvas and we want to be able
 #        to configure them as a whole, as well as to configure a        component
 #        alone.
 # 
 #          It should work well for "planar" drawings, like electrical
 #        circuits and flow charts. If there are many objects stacked one
 #        over the other: the selection by point-and-click may become
 #        unfriendly to the user; in this case another way to select
 #        the objects should be used in replacement of [$canvas find closest].
 #
 # Copyright (c) 2005 Marco Maggi
 # 
 # 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.uwp_cyclic_selection_cursor                        hand2
 
 #page
 ## ------------------------------------------------------------
 ## Main.
 ## ------------------------------------------------------------
 
 proc main {} {
     global        exit_trigger groups
 
     wm title . "Canvas Cyclic Selection"
     wm geometry . +10+10
 
     # Draw two canvas widgets with a listbox associated to each to
     # display the list of currently selected objects.
     grid [frame .f] -sticky news
     foreach master {.f.left .f.right} {
         frame $master -relief sunken
         grid [label $master.l -text $master] -sticky news
         canvas $master.c -width 300 -height 300 -background white
         listbox $master.lb -background bisque
         grid $master.c $master.lb -sticky news -padx 5
         pack $master -side left -expand yes -fill both
     }
     foreach { canvasA listboxA canvasB listboxB } \
         { .f.left.c .f.left.lb .f.right.c .f.right.lb } {}
 
     # Draw the exit button.
     grid [button .quit -text Exit -command main_exit]
     focus .quit
     bind .quit <Return> main_exit
     bind . <Escape> main_exit
 
     # An object  is unselectable if  it is not  registered as part  of a
     # group.   Unselectable objects ARE  useful, examples:  a background
     # grid of lines; a coordinates system of reference.
     $canvasA create text 100 200 -text "This text is an\nunselectable object."
     $canvasB create text 100 200 -text "This text is an\nunselectable object."
     
     # Setup canvaes bindings.
     set tokenA "unique_global_varname"
     set tokenB "another_global_varname"
     setup $tokenA $canvasA CanvasA_Activation $listboxA
     setup $tokenB $canvasB CanvasB_Activation $listboxB
 
     alias main_exit set exit_trigger 1
     vwait exit_trigger
 
     # Cleanup groups and context instances  (this is just to show how to
     # do it, it is not really required at the end of the script).
     cleanup $tokenA $canvasA CanvasA_Activation
     cleanup $tokenB $canvasB CanvasB_Activation
     
     exit
 }
 proc setup { token canvas activation_tag listbox } {
     global        groups
     
     uwp_cyclic_selection_bind $canvas
     uwp_cyclic_selection_activate_token $token
     uwp_append_tag $activation_tag $canvas
     bind $activation_tag <Enter> \
         [list activate_canvas_selection $token $canvas $listbox]
 
     # Groups must have empty intersection.
     uwp_cyclic_selection_register_groups \
         [lappend groupOne \
              [$canvas create oval 250 50 200 100 -tags LittleOval] \
              [$canvas create oval 230 80 160 200 -tags MediumOval] \
              [$canvas create oval 200 100 280 240 -tags BigOval]] \
         [lappend groupTwo \
              [$canvas create rectangle 40 40 100 100 -tags LittleRectangle] \
              [$canvas create rectangle 60 60 140 140 -tags MediumRectangle] \
              [$canvas create rectangle 100 100 240 240 -tags BigRectangle]]
     lappend groups($canvas) $groupOne $groupTwo
 }
 proc cleanup { token canvas activation_tag } {
     global        groups
 
     uwp_cyclic_selection_unbind $canvas
     uwp_remove_tag $activation_tag $canvas
     uwp_cyclic_selection_activate_token $token
     eval { uwp_cyclic_selection_forget_groups } $groups($canvas)
     uplevel \#0 [list unset $token]
 }
 #page
 ## ------------------------------------------------------------
 ## UWP infrastructure procedures.
 ## ------------------------------------------------------------
 
 proc alias { alias args } { eval { interp alias {} $alias {} } $args }
 proc uwp_append_tag { tag widget } {
     bindtags $widget [linsert [bindtags $widget] end $tag]
 }
 proc uwp_remove_tag { tag widget } {
     set idx [lsearch [set ell [bindtags $widget]] $tag]
     bindtags $widget [lreplace $ell $idx $idx]
 }
 proc uwp_application_set_mouse_cursor_of_parent { widget } {
     $widget configure -cursor [[winfo parent $widget] cget -cursor]
 }
 #page
 ## ------------------------------------------------------------
 ## User defined object interface procedures.
 ## ------------------------------------------------------------
 
 proc activate_canvas_selection { token_name canvas_widget listbox_widget } {
     uwp_cyclic_selection_activate_token $token_name
 
     alias uwp_cyclic_selection_draw_selected_object \
         object_draw_selected $canvas_widget
 
     alias uwp_cyclic_selection_draw_deselected_object \
         object_draw_deselected $canvas_widget
 
     alias uwp_cyclic_selection_notify_selection \
         object_notify_selection $canvas_widget $listbox_widget
 }
 proc object_draw_selected { canvas_widget  object_identifier } {
     $canvas_widget itemconfigure $object_identifier -outline red
 }
 proc object_draw_deselected { canvas_widget  object_identifier } {
     $canvas_widget itemconfigure $object_identifier -outline black
 }
 proc object_notify_selection { canvas_widget listbox_widget  selection_list } {
     $listbox_widget delete 0 end
     foreach object_identifier $selection_list {
         $listbox_widget insert end \
             [lindex [$canvas_widget gettags $object_identifier] 0]
     }
 }
 #page
 ## ------------------------------------------------------------
 ## Cyclic selection tag bindings.
 ## ------------------------------------------------------------
 
 bind UWPCyclicSelection <ButtonRelease-1> { uwp_cyclic_selection_event_release %W %x %y }
 bind UWPCyclicSelection <ButtonRelease-3> { uwp_cyclic_selection_event_release3 %W }
 
 proc uwp_cyclic_selection_bind { widget } {
     uwp_append_tag UWPCyclicSelection $widget
     $widget configure -cursor [option get $widget uwp_cyclic_selection_cursor Cursor]
 }
 alias uwp_cyclic_selection_unbind uwp_remove_tag UWPCyclicSelection
 #page
 ## ------------------------------------------------------------
 ## Cyclic selection event handling procedures.
 ## ------------------------------------------------------------
 
 proc uwp_cyclic_selection_event_release { canvas_widget x y } {
     set id [$canvas_widget find closest \
                 [$canvas_widget canvasx $x] [$canvas_widget canvasy $y]]
     # We check the string because it can be empty if no object is on the
     # canvas.
     if { [string length $id] } {
         uwp_cyclic_selection_select_from_identifier $canvas_widget $id
     }
 }
 proc uwp_cyclic_selection_event_release3 { canvas_widget } {
     uwp_cyclic_selection_deselect_all $canvas_widget
 }
 #page
 ## ------------------------------------------------------------
 ## Cyclic selection objects groups handlind procedures.
 ## ------------------------------------------------------------
 
 # The lists of identifiers are never modified, so it is efficient to
 # use them directly as values in arrays.
 
 proc uwp_cyclic_selection_activate_token { unique_name_in_global_namespace } {
     uplevel        \#0 \
         [list upvar \#0 $unique_name_in_global_namespace uwp_cyclic_selection_token]
     upvar        \#0 uwp_cyclic_selection_token data
     if { ! [info exists data(selected_object_index)] } {
         set data(selected_object_index) all
     }
     if { ! [info exists data(selected_group)] } { set data(selected_group) {} }
 }
 proc uwp_cyclic_selection_register_groups { args } {
     upvar        \#0 uwp_cyclic_selection_token data
     foreach object_identifiers_list $args \
         { foreach identifier $object_identifiers_list \
               { set data(id:$identifier) $object_identifiers_list } }
 }
 proc uwp_cyclic_selection_forget_groups { args } {
     upvar        \#0 uwp_cyclic_selection_token data
     foreach object_identifiers_list $args \
         { foreach identifier $object_identifiers_list { unset data(id:$identifier) } }
 }
 #page
 ## ------------------------------------------------------------
 ## Cyclic selection procedures.
 ## ------------------------------------------------------------
 
 proc uwp_cyclic_selection_deselect_all { canvas_widget } {
     upvar        \#0 uwp_cyclic_selection_token data
     uwp_cyclic_selection_notify_selection {}    
     uwp_cyclic_selection_deselect $canvas_widget
     set data(selected_group) {}
     set data(selected_object_index) all
 }
 proc uwp_cyclic_selection_select_from_identifier { canvas_widget object_identifier } {
     upvar        \#0 uwp_cyclic_selection_token data
 
     uwp_cyclic_selection_deselect $canvas_widget
     if { ! [info exists data(id:$object_identifier)] } {
         uwp_cyclic_selection_deselect_all $canvas_widget
     } else {
         if { [lsearch $data(selected_group) $object_identifier] >= 0 } {
             uwp_cyclic_selection_advance_current_selection
         } else {
             set data(selected_group) $data(id:$object_identifier)
             set data(selected_object_index) all
         }
         uwp_cyclic_selection_select $canvas_widget
         if { $data(selected_object_index) eq "all" } {
             uwp_cyclic_selection_notify_selection $data(selected_group)
         } else {
             uwp_cyclic_selection_notify_selection \
                 [lindex $data(selected_group) $data(selected_object_index)]
         }
     }
 }
 proc uwp_cyclic_selection_advance_current_selection {} {
     upvar        \#0 uwp_cyclic_selection_token data
     
     if { $data(selected_object_index) eq "all" } {
         set data(selected_object_index) 0
     } elseif { [incr data(selected_object_index)] == [llength $data(selected_group)] } {
         set data(selected_object_index) all
         return $data(selected_group)
     }
     lindex $data(selected_group) $data(selected_object_index)
 }
 #page
 ## ------------------------------------------------------------
 ## Cyclic selection hangling procedures.
 ## ------------------------------------------------------------
 
 # This is invoked to draw the selected object/group in with the
 # "selected" appearance.
 alias uwp_cyclic_selection_select \
     uwp_cyclic_selection_handling uwp_cyclic_selection_draw_selected_object 
 
 # This is invoked to draw the selected object/group in with the
 # "deselected" appearance.
 alias uwp_cyclic_selection_deselect \
     uwp_cyclic_selection_handling uwp_cyclic_selection_draw_deselected_object
 
 proc uwp_cyclic_selection_handling { draw_command canvas_widget } {
     upvar        \#0 uwp_cyclic_selection_token data
 
     if { $data(selected_object_index) eq "all" } {
         foreach object_identifier $data(selected_group) \
             { $draw_command $object_identifier }
     } else {
         $draw_command [lindex $data(selected_group) $data(selected_object_index)]
     }
 }
 #page
 ## ------------------------------------------------------------
 ## Let's go.
 ## ------------------------------------------------------------
 
 main
 
 ### end of file
 # Local Variables:
 # mode: tcl
 # End:
======

<<categories>> GUI