Revision: 54463
http://brlcad.svn.sourceforge.net/brlcad/?rev=54463&view=rev
Author: r_weiss
Date: 2013-02-21 20:11:59 +0000 (Thu, 21 Feb 2013)
Log Message:
-----------
Refactored mged grouper (i.e. gr) command to resolve namespace issues.
Modified Paths:
--------------
brlcad/trunk/src/tclscripts/mged/grouper.tcl
Modified: brlcad/trunk/src/tclscripts/mged/grouper.tcl
===================================================================
--- brlcad/trunk/src/tclscripts/mged/grouper.tcl 2013-02-21 19:22:53 UTC
(rev 54462)
+++ brlcad/trunk/src/tclscripts/mged/grouper.tcl 2013-02-21 20:11:59 UTC
(rev 54463)
@@ -39,143 +39,250 @@
# limitation.
#
-namespace eval grouper_v2 {
+namespace eval Grouper {
+ set GroupNameGlobal ""
+ set GrouperRunning 0
+ set draw_orig ""
+ set pos_orig ""
+ set dim_orig ""
+ set fb_orig ""
+ set fb_all_orig ""
+ set listen_orig ""
+ set objs {}
+ set erase_status ""
+ set parent_only 0
+ set center_orig ""
+ set size_orig ""
+ set ae_orig ""
-namespace export gr
-namespace export grouper
-namespace export dg
-namespace export done_grouper
+ proc remdup { GroupName } {
+ set ItemList [search $GroupName -maxdepth 1]
+ set ItemList [lrange $ItemList 1 end]
+ set ItemList [lsort -unique $ItemList]
-set GroupNameGlobal ""
-set GrouperRunning 0
-set draw_orig ""
-set pos_orig ""
-set dim_orig ""
-set fb_orig ""
-set fb_all_orig ""
-set listen_orig ""
-set objs {}
-set erase_status ""
-set parent_only 0
-set center_orig ""
-set size_orig ""
-set ae_orig ""
+ set found_tmp 0
+ while { !$found_tmp } {
+ set tmp_grp [expr rand()]
+ if { [search -name $tmp_grp] == "" } {
+ set found_tmp 1
+ }
+ }
+ eval g $tmp_grp $ItemList
+ kill $GroupName
+ mv $tmp_grp $GroupName
+ }
-proc gr_remdup { GroupName } {
+ proc getObjInRectangle {} {
+ variable parent_only
+ set objs2 {}
+ set size [dm size]
+ set sizeX [lindex $size 0].0
+ set sizeY [lindex $size 1].0
+ set adjX [expr {($sizeX / 2.0) - 1.0}]
+ set adjY [expr {($sizeY / 2.0) - 1.0}]
+ set dim [rset r dim]
+ set dimX [lindex $dim 0].0
+ set dimY [lindex $dim 1].0
- set ItemList [search $GroupName -maxdepth 1]
- set ItemList [lrange $ItemList 1 end]
+ if { $dimX == 0.0 || $dimY == 0.0 } {
+ return "invalid_selection"
+ }
- set ItemList [lsort -unique $ItemList]
+ set pos [rset r pos]
+ set posX [lindex $pos 0].0
+ set posY [lindex $pos 1].0
+ set posX [expr ($posX - $adjX) / $adjX]
+ set posY [expr ($posY - $adjY) / $adjY]
+ set dimX [expr ($dimX / $adjX)]
+ set dimY [expr ($dimY / $adjY)]
- set found_tmp 0
+ if { $dimX > 0 } {
+ # Rectangle was created left-to-right. Select only
+ # objects completely in the rectangle.
+ set objs [select $posX $posY $dimX $dimY]
+ } else {
+ # Rectangle was created right-to-left. Select everything
+ # completely and partly in the rectangle.
+ set objs [select -p $posX $posY $dimX $dimY]
+ }
- while { !$found_tmp } {
- set tmp_grp [expr rand()]
- if { [search -name $tmp_grp] == "" } {
- set found_tmp 1
+ if { $objs == "" } {
+ return "no_result"
}
- }
- eval g $tmp_grp $ItemList
+ if { $parent_only != 1 } {
+ foreach obj $objs {
+ set obj2 [file tail $obj]
+ lappend objs2 $obj2
+ }
+ } else {
+ foreach obj $objs {
+ set obj2 [file tail [file dirname $obj]]
+ # skip objects with no parent
+ if { $obj2 != "" } {
+ lappend objs2 $obj2
+ }
+ }
+ }
- kill $GroupName
+ if { $objs2 == {} } {
+ return "no_result"
+ }
- mv $tmp_grp $GroupName
-}
+ return $objs2
+ }
+ proc do_grouper { GroupName Boolean ListLimit } {
+ variable objs
+ variable GroupNameGlobal
+ variable center_orig
+ variable size_orig
+ variable ae_orig
-proc gr_getObjInRectangle {} {
+ set GroupNameGlobal $GroupName
+ set center_orig [center]
+ set size_orig [size]
+ set ae_orig [ae]
- variable parent_only
- set objs2 {}
+ # Temporarily erase group from display while getting objects in
rectangle"
+ after 1 {
+ if { [search -name $::Grouper::GroupNameGlobal] != "" } {
+ set ::Grouper::erase_status [erase $::Grouper::GroupNameGlobal]
+ } else {
+ set ::Grouper::erase_status 1
+ }
+ }
- set size [dm size]
- set sizeX [lindex $size 0].0
- set sizeY [lindex $size 1].0
- set adjX [expr {($sizeX / 2.0) - 1.0}]
- set adjY [expr {($sizeY / 2.0) - 1.0}]
- set dim [rset r dim]
- set dimX [lindex $dim 0].0
- set dimY [lindex $dim 1].0
+ # Wait for the group to be erased from the display before we continue
+ vwait ::Grouper::erase_status
- if { $dimX == 0.0 || $dimY == 0.0 } {
- return "invalid_selection"
- }
+ after 1 {set ::Grouper::objs [::Grouper::getObjInRectangle]}
- set pos [rset r pos]
- set posX [lindex $pos 0].0
- set posY [lindex $pos 1].0
- set posX [expr ($posX - $adjX) / $adjX]
- set posY [expr ($posY - $adjY) / $adjY]
- set dimX [expr ($dimX / $adjX)]
- set dimY [expr ($dimY / $adjY)]
+ puts stdout "Selection running ..."
+ vwait ::Grouper::objs
- if { $dimX > 0 } {
- # Rectangle was created left-to-right. Select only
- # objects completely in the rectangle.
- set objs [select $posX $posY $dimX $dimY]
- } else {
- # Rectangle was created right-to-left. Select everything
- # completely and partly in the rectangle.
- set objs [select -p $posX $posY $dimX $dimY]
- }
+ if { $objs == "invalid_selection" } {
+ puts stdout "Invalid selection (zero area selection box)."
+ # highlight in yellow current group
+ if { [search -name $GroupName] != "" } {
+ e -C255/255/0 $GroupName
+ center $center_orig
+ size $size_orig
+ ae $ae_orig
+ }
+ return
+ }
- if { $objs == "" } {
- return "no_result"
- }
+ if { $objs == "no_result" } {
+ puts stdout "Nothing selected."
+ # highlight in yellow current group
+ if { [search -name $GroupName] != "" } {
+ e -C255/255/0 $GroupName
+ center $center_orig
+ size $size_orig
+ ae $ae_orig
+ }
+ return
+ }
- if { $parent_only != 1 } {
- foreach obj $objs {
- set obj2 [file tail $obj]
- lappend objs2 $obj2
+ set objs [lsort -unique $objs]
+ set tot_obj_in_rect [llength $objs]
+
+ if { [search -name $GroupName] == "" } {
+ set grp_obj_list_before ""
+ set grp_obj_list_len_before 0
+ } else {
+ set grp_obj_list_before [search $GroupName -maxdepth 1]
+ set grp_obj_list_len_before [expr [llength $grp_obj_list_before] -
1]
}
- } else {
- foreach obj $objs {
- set obj2 [file tail [file dirname $obj]]
- # skip objects with no parent
- if { $obj2 != "" } {
- lappend objs2 $obj2
+
+ if { $Boolean == "+" } {
+ foreach obj $objs {
+ g $GroupName $obj
}
+ } else {
+ foreach obj $objs {
+ catch {rm $GroupName $obj} tmp_msg
+ }
}
- }
- if { $objs2 == {} } {
- return "no_result"
- }
+ if { ([search -name $GroupName] != "") && ($Boolean == "+") } {
+ remdup $GroupName
+ }
- return $objs2
-}
+ if { [search -name $GroupName] == "" } {
+ set grp_obj_list_after ""
+ set grp_obj_list_len_after 0
+ } else {
+ set grp_obj_list_after [search $GroupName -maxdepth 1]
+ set grp_obj_list_len_after [expr [llength $grp_obj_list_after] - 1]
+ }
+ if { $grp_obj_list_len_after > $grp_obj_list_len_before } {
+ set objcnt_chng [expr $grp_obj_list_len_after -
$grp_obj_list_len_before]
+ puts stdout "$objcnt_chng of $tot_obj_in_rect selected objects
added to group '$GroupName'."
+ } elseif { $grp_obj_list_len_after < $grp_obj_list_len_before } {
+ set objcnt_chng [expr $grp_obj_list_len_before -
$grp_obj_list_len_after]
+ puts stdout "$objcnt_chng of $tot_obj_in_rect selected objects
removed from group '$GroupName'."
+ } else {
+ puts stdout "No change to group '$GroupName'."
+ }
+ set objcnt 0
+
+ # hack to prevent script lockup on windows
+ set max_objs_per_line 200
+
+ if { ($ListLimit > 0 && $ListLimit <= $max_objs_per_line) ||
+ ($ListLimit > 0 && $tot_obj_in_rect <= $max_objs_per_line) } {
+ puts stdout "Selected object list\:"
+ foreach obj $objs {
+ incr objcnt
+ if { $objcnt > $ListLimit } {
+ puts -nonewline stdout "\nListed $ListLimit of
$tot_obj_in_rect selected objects."
+ break;
+ }
+ puts -nonewline stdout "$obj "
+ }
+ puts -nonewline stdout "\n"
+ } elseif { $ListLimit > 0 } {
+ puts stdout "Selected object list\:"
+ foreach obj $objs {
+ incr objcnt
+ if { $objcnt > $ListLimit } {
+ puts -nonewline stdout "\nListed $ListLimit of
$tot_obj_in_rect selected objects."
+ break;
+ }
+ puts stdout "$objcnt\t$obj"
+ }
+ }
+
+ # highlight in yellow current group
+ if { [search -name $GroupName] != "" } {
+ e -C255/255/0 $GroupName
+ center $center_orig
+ size $size_orig
+ ae $ae_orig
+ }
+
+ puts stdout "Selection complete."
+ }
+}; # end namespace
+
proc gr { args } {
grouper $args
}
-
proc grouper { args } {
-
global mged_gui mged_default mged_players
- variable GrouperRunning
- variable parent_only
- variable draw_orig
- variable pos_orig
- variable dim_orig
- variable fb_orig
- variable fb_all_orig
- variable listen_orig
- variable center_orig
- variable size_orig
- variable ae_orig
-
set GroupName ""
set Boolean ""
set ListLimit 0
- set parent_only 0
+ set ::Grouper::parent_only 0
set usage_msg "Usage: {GroupName} {+|-} \[ListLimit\] \[-p\]"
- if {$GrouperRunning == 1} {
+ if {$::Grouper::GrouperRunning == 1} {
return "Grouper already running, use the 'dg' command to exit grouper
before restarting."
}
@@ -194,7 +301,7 @@
foreach arg $args {
if { $arg == "-p" } {
- set parent_only 1
+ set ::Grouper::parent_only 1
} elseif { [string is integer $arg] && $arg > 0 } {
incr listlimit_flag_cnt
set ListLimit $arg
@@ -210,12 +317,13 @@
}
}
- if { $groupname_flag_cnt != 1 || $boolean_flag_cnt != 1 ||
$listlimit_flag_cnt > 1 || $invalid_flag_cnt != 0} {
+ if { $groupname_flag_cnt != 1 || $boolean_flag_cnt != 1 ||
+ $listlimit_flag_cnt > 1 || $invalid_flag_cnt != 0} {
puts stdout "$usage_msg"
return
}
- set GrouperRunning 1
+ set ::Grouper::GrouperRunning 1
for {set i 0} {1} {incr i} {
set id [subst $mged_default(id)]_$i
@@ -224,15 +332,15 @@
}
}
- set draw_orig [rset r draw]
- set pos_orig [rset r pos]
- set dim_orig [rset r dim]
- set fb_orig [rset var fb]
- set fb_all_orig [rset var fb_all]
- set listen_orig [rset var listen]
- set center_orig [center]
- set size_orig [size]
- set ae_orig [ae]
+ set ::Grouper::draw_orig [rset r draw]
+ set ::Grouper::pos_orig [rset r pos]
+ set ::Grouper::dim_orig [rset r dim]
+ set ::Grouper::fb_orig [rset var fb]
+ set ::Grouper::fb_all_orig [rset var fb_all]
+ set ::Grouper::listen_orig [rset var listen]
+ set ::Grouper::center_orig [center]
+ set ::Grouper::size_orig [size]
+ set ::Grouper::ae_orig [ae]
set mged_gui($id,mouse_behavior) p
set_mouse_behavior $id
@@ -240,176 +348,26 @@
rset vars fb 0
rset r draw 1
- bind $mged_gui($id,active_dm) <ButtonRelease-2> " winset
$mged_gui($id,active_dm); dm idle; ::grouper_v2::do_grouper $GroupName $Boolean
$ListLimit"
+ bind $mged_gui($id,active_dm) <ButtonRelease-2> " winset
$mged_gui($id,active_dm); dm idle; ::Grouper::do_grouper $GroupName $Boolean
$ListLimit"
bind $mged_gui($id,active_dm) <Control-ButtonRelease-2> " winset
$mged_gui($id,active_dm); dm idle; done_grouper"
# highlight in yellow current group
if { [search -name $GroupName] != "" } {
e -C255/255/0 $GroupName
- center $center_orig
- size $size_orig
- ae $ae_orig
+ center $::Grouper::center_orig
+ size $::Grouper::size_orig
+ ae $::Grouper::ae_orig
}
}
-
-proc do_grouper { GroupName Boolean ListLimit } {
-
- variable objs
- variable GroupNameGlobal
- variable center_orig
- variable size_orig
- variable ae_orig
-
- set GroupNameGlobal $GroupName
- set center_orig [center]
- set size_orig [size]
- set ae_orig [ae]
-
- # Temporarily erase group from display while getting objects in rectangle"
- after 1 {
- if { [search -name $::grouper_v2::GroupNameGlobal] != "" } {
- set ::grouper_v2::erase_status [erase
$::grouper_v2::GroupNameGlobal]
- } else {
- set ::grouper_v2::erase_status 1
- }
- }
-
- # Wait for the group to be erased from the display before we continue
- vwait ::grouper_v2::erase_status
-
- after 1 {set ::grouper_v2::objs [::grouper_v2::gr_getObjInRectangle]}
-
- puts stdout "Selection running ..."
- vwait ::grouper_v2::objs
-
- if { $objs == "invalid_selection" } {
- puts stdout "Invalid selection (zero area selection box)."
- # highlight in yellow current group
- if { [search -name $GroupName] != "" } {
- e -C255/255/0 $GroupName
- center $center_orig
- size $size_orig
- ae $ae_orig
- }
- return
- }
-
- if { $objs == "no_result" } {
- puts stdout "Nothing selected."
- # highlight in yellow current group
- if { [search -name $GroupName] != "" } {
- e -C255/255/0 $GroupName
- center $center_orig
- size $size_orig
- ae $ae_orig
- }
- return
- }
-
- set objs [lsort -unique $objs]
- set tot_obj_in_rect [llength $objs]
-
- if { [search -name $GroupName] == "" } {
- set grp_obj_list_before ""
- set grp_obj_list_len_before 0
- } else {
- set grp_obj_list_before [search $GroupName -maxdepth 1]
- set grp_obj_list_len_before [expr [llength $grp_obj_list_before] - 1]
- }
-
- if { $Boolean == "+" } {
- foreach obj $objs {
- g $GroupName $obj
- }
- } else {
- foreach obj $objs {
- catch {rm $GroupName $obj} tmp_msg
- }
- }
-
- if { ([search -name $GroupName] != "") && ($Boolean == "+") } {
- gr_remdup $GroupName
- }
-
- if { [search -name $GroupName] == "" } {
- set grp_obj_list_after ""
- set grp_obj_list_len_after 0
- } else {
- set grp_obj_list_after [search $GroupName -maxdepth 1]
- set grp_obj_list_len_after [expr [llength $grp_obj_list_after] - 1]
- }
-
-
- if { $grp_obj_list_len_after > $grp_obj_list_len_before } {
- set objcnt_chng [expr $grp_obj_list_len_after -
$grp_obj_list_len_before]
- puts stdout "$objcnt_chng of $tot_obj_in_rect selected objects added to
group '$GroupName'."
- } elseif { $grp_obj_list_len_after < $grp_obj_list_len_before } {
- set objcnt_chng [expr $grp_obj_list_len_before -
$grp_obj_list_len_after]
- puts stdout "$objcnt_chng of $tot_obj_in_rect selected objects removed
from group '$GroupName'."
- } else {
- puts stdout "No change to group '$GroupName'."
- }
-
- set objcnt 0
-
- # hack to prevent script lockup on windows
- set max_objs_per_line 200
-
- if { ($ListLimit > 0 && $ListLimit <= $max_objs_per_line) || ($ListLimit >
0 && $tot_obj_in_rect <= $max_objs_per_line) } {
- puts stdout "Selected object list\:"
- foreach obj $objs {
- incr objcnt
- if { $objcnt > $ListLimit } {
- puts -nonewline stdout "\nListed $ListLimit of $tot_obj_in_rect
selected objects."
- break;
- }
- puts -nonewline stdout "$obj "
- }
- puts -nonewline stdout "\n"
- } elseif { $ListLimit > 0 } {
- puts stdout "Selected object list\:"
- foreach obj $objs {
- incr objcnt
- if { $objcnt > $ListLimit } {
- puts -nonewline stdout "\nListed $ListLimit of $tot_obj_in_rect
selected objects."
- break;
- }
- puts stdout "$objcnt\t$obj"
- }
- }
-
- # highlight in yellow current group
- if { [search -name $GroupName] != "" } {
- e -C255/255/0 $GroupName
- center $center_orig
- size $size_orig
- ae $ae_orig
- }
-
- puts stdout "Selection complete."
-}
-
-
proc dg {} {
done_grouper
}
-
proc done_grouper {} {
-
global mged_gui mged_default mged_players
- variable GroupNameGlobal
- variable GrouperRunning
- variable draw_orig
- variable pos_orig
- variable dim_orig
- variable fb_orig
- variable fb_all_orig
- variable listen_orig
-
- if {$GrouperRunning != 1} {
+ if {$::Grouper::GrouperRunning != 1} {
return "Grouper not running."
}
@@ -427,27 +385,22 @@
bind $mged_gui($id,active_dm) <ButtonRelease-2> ""
# remove yellow highlights from the display
- if { [search -name $GroupNameGlobal] != "" } {
- erase $GroupNameGlobal
+ if { [search -name $::Grouper::GroupNameGlobal] != "" } {
+ erase $::Grouper::GroupNameGlobal
}
- set GrouperRunning 0
+ set ::Grouper::GrouperRunning 0
# return display to state before grouper changed it
- rset r draw $draw_orig
- rset r pos $pos_orig
- rset r dim $dim_orig
- rset var fb $fb_orig
- rset var fb_all $fb_all_orig
- rset var listen $listen_orig
+ rset r draw $::Grouper::draw_orig
+ rset r pos $::Grouper::pos_orig
+ rset r dim $::Grouper::dim_orig
+ rset var fb $::Grouper::fb_orig
+ rset var fb_all $::Grouper::fb_all_orig
+ rset var listen $::Grouper::listen_orig
puts stdout "Grouper done."
}
-}
-
-namespace import ::grouper_v2::*
-
-
# Local Variables:
# mode: Tcl
# tab-width: 8
This was sent by the SourceForge.net collaborative development platform, the
world's largest Open Source development site.
------------------------------------------------------------------------------
Everyone hates slow websites. So do we.
Make your web apps faster with AppDynamics
Download AppDynamics Lite for free today:
http://p.sf.net/sfu/appdyn_d2d_feb
_______________________________________________
BRL-CAD Source Commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/brlcad-commits
