Thread: [brlcad-commits] SF.net SVN: brlcad:[34366] brlcad/trunk/src/tclscripts/archer/Archer.tcl
Open Source Solid Modeling CAD
Brought to you by:
brlcad
From: <bo...@us...> - 2009-04-29 20:17:45
|
Revision: 34366 http://brlcad.svn.sourceforge.net/brlcad/?rev=34366&view=rev Author: bob1961 Date: 2009-04-29 20:17:25 +0000 (Wed, 29 Apr 2009) Log Message: ----------- Override the kill command in ArcherCore in order to remove any edit panels associated with the object(s) being killed/deleted. Will need to look at other commands that kill/delete objects from the database. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-04-29 20:10:33 UTC (rev 34365) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-04-29 20:17:25 UTC (rev 34366) @@ -142,6 +142,7 @@ # ArcherCore Override Section method Load {_target} method updateTheme {} + method kill {args} } protected { @@ -769,7 +770,19 @@ } } +::itcl::body Archer::kill {args} { + eval gedWrapper kill 1 0 1 1 $args + if {$mSelectedObj != "" && [lsearch $args $mSelectedObj] != -1} { + set tops [$itk_component(ged) tops] + if {[llength $tops]} { + set obj [lindex $tops 0] + set obj [regsub -all {/} $obj ""] + selectNode [$itk_component(tree) find $obj] 0 + } + } +} + ::itcl::body Archer::Load {_target} { SetWaitCursor $this if {$mNeedSave} { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-06-23 15:25:54
|
Revision: 34853 http://brlcad.svn.sourceforge.net/brlcad/?rev=34853&view=rev Author: bob1961 Date: 2009-06-23 15:25:47 +0000 (Tue, 23 Jun 2009) Log Message: ----------- Now using inmem database for the ledger. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-06-23 15:19:32 UTC (rev 34852) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-06-23 15:25:47 UTC (rev 34853) @@ -435,7 +435,6 @@ if {$mTargetLedger != ""} { catch {rename $mLedger ""} - catch {file delete -force $mTargetLedger} } } @@ -6708,7 +6707,6 @@ # Delete previous ledger if {$mTargetLedger != ""} { catch {rename $mLedger ""} - catch {file delete -force $mTargetLedger} } set mTargetLedger "$mTarget\.ledger" @@ -6720,7 +6718,7 @@ set mLedgerGID 0 set mLedger "ledger" - go_open $mLedger db $mTargetLedger + go_open $mLedger inmem 0 } ::itcl::body Archer::global_undo {} { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-07-09 16:39:01
|
Revision: 35035 http://brlcad.svn.sourceforge.net/brlcad/?rev=35035&view=rev Author: bob1961 Date: 2009-07-09 16:38:56 +0000 (Thu, 09 Jul 2009) Log Message: ----------- Added a wrapper for attr. Also added a checkpoint_olist method for creating multiple ledger entries for an action. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-09 15:12:03 UTC (rev 35034) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-09 16:38:56 UTC (rev 35035) @@ -146,6 +146,7 @@ # ArcherCore Override Section method 3ptarb {args} + method attr {args} method bo {args} method bot_condense {args} method bot_decimate {args} @@ -211,6 +212,7 @@ # Object Edit Management method checkpoint {_obj} + method checkpoint_olist {_olist} method createTargetLedger {} method global_undo {} method ledger_cleanup {} @@ -873,6 +875,26 @@ eval ArcherCore::gedWrapper 3ptarb 0 0 1 1 $args } +::itcl::body Archer::attr {args} { + set len [llength $args] + if {$len < 4} { + return [eval gedWrapper2 attr 1 0 0 0 0 0 $args] + } + + set cmd [lindex $args 0] + switch -- $cmd { + "append" - + "rm" - + "set" { + return [eval gedWrapper2 attr 1 0 0 0 1 0 $args] + } + "get" - + "show" { + return [eval gedWrapper2 attr 1 0 0 0 0 0 $args] + } + } +} + ::itcl::body Archer::bo {args} { eval ArcherCore::gedWrapper bo 0 0 1 1 $args } @@ -1636,36 +1658,40 @@ set l [lsort -dictionary $l] set le [lindex $l end] - # Assumed to have mods after the command invocation above - $mLedger attr set $le $HAVE_MODS 1 + if {$le == ""} { + puts "No ledger entry found for $obj." + } else { + # Assumed to have mods after the command invocation above + $mLedger attr set $le $HAVE_MODS 1 - set mNeedSave 1 - set mNeedGlobalUndo 1 + set mNeedSave 1 + set mNeedGlobalUndo 1 - if {$obj == $mSelectedObj} { - # Checkpoint again in case the user starts interacting via the mouse - checkpoint $obj - } else { - updateUndoMode 0 - } + if {$obj == $mSelectedObj} { + # Checkpoint again in case the user starts interacting via the mouse + checkpoint $obj + } else { + updateUndoMode 0 + } - updateSaveMode + updateSaveMode - # Possibly draw the updated object - set ditem "" - foreach item [gedCmd report 0] { - set l [split $item /] - set i [lsearch -exact $l $obj] - if {$i != -1} { - for {set j 1} {$j <= $i} {incr j} { - append ditem / [lindex $l $j] + # Possibly draw the updated object + set ditem "" + foreach item [gedCmd report 0] { + set l [split $item /] + set i [lsearch -exact $l $obj] + if {$i != -1} { + for {set j 1} {$j <= $i} {incr j} { + append ditem / [lindex $l $j] + } + break } - break } - } - if {$ditem != ""} { - redrawObj $ditem + if {$ditem != ""} { + redrawObj $ditem + } } } @@ -6935,37 +6961,21 @@ ################################### Begin Object Edit Management ################################### -# Create toolbar buttons for the following -# Global Undo -# Undo the latest entry -# Copy the entries attributes to its corresponding object -# Kill/remove the entry from the ledger -# Undo -# Undo the latest entry for the selected object -# Copy the entries attributes to its corresponding object -# Kill/remove the entry from the ledger -# Apply/Checkpoint -# Create ledger entry for the selected object -# (i.e. GGGG_OOOO_object, GGGG - global number, OOOO - object number) -# Simple Revert -# Go back to the state of the original file -# Clear out the ledger -# Reset the save button -# -# When opening a database -# Destroy the ledger.g for the previous db -# Create a unique ledger.g -# -# When saving a database -# Destroy the ledger and recreate an empty one -# Reset all toolbar buttons associated with object edit management -# - ::itcl::body Archer::checkpoint {_obj} { if {$_obj == "" || $mLedger == ""} { return } + #XXX Need to have a binary copy of an object from one database + # to another. That would take care of the lossiness of get + # and put. It would also handle copying attributes. + + # This "get" fails for objects like _GLOBAL. So until the binary + # copy gets implemented, objects like _GLOBAL cannot be checkpointed. + if {[catch {gedCmd get $_obj} gdata]} { + return + } + # Get all ledger entries related to _obj set l [$mLedger expand *_*_$_obj] set len [llength $l] @@ -7018,7 +7028,6 @@ incr mLedgerGID # Create the ledger entry - set gdata [gedCmd get $_obj] set lname $mLedgerGID\_$oid\_$_obj eval $mLedger put $lname $gdata @@ -7057,6 +7066,88 @@ updateUndoMode $oflag } +## +# This method also needs to use a binary copy +# of objects between databases instead of "get" and "put". +# +::itcl::body Archer::checkpoint_olist {_olist} { + set olen [llength $_olist] + if {$olen == 0 || $mLedger == ""} { + return + } + + incr mLedgerGID + set oid 0 + set ouflag 0 + set foundSelectedObj 0 + + # Create the ledger entries + foreach obj $_olist { + if {[catch {gedCmd get $obj} gdata]} { + continue + } + + if {$obj == $mSelectedObj} { + set foundSelectedObj 1 + + # Get all ledger entries related to mSelectedObj + set l [$mLedger expand *_*_$mSelectedObj] + set len [llength $l] + + if {$len} { + set l [lsort -dictionary $l] + set le [lindex $l end] + + if {![$mLedger attr get $le $HAVE_MODS]} { + $mLedger kill $le + + if {$len > 1} { + set ouflag 1 + } + } + } + } + + set lname $mLedgerGID\_$oid\_$_obj + eval $mLedger put $lname $gdata + + # No mods yet + $mLedger attr set $lname $HAVE_MODS 0 + } + + set l [$mLedger ls -A $HAVE_MODS 1] + set len [llength $l] + if {$len == 0} { + set mNeedGlobalUndo 0 + set mNeedObjUndo 0 + + set mNeedCheckpoint 0 + updateCheckpointMode + + set oflag 1 + } else { + set mNeedGlobalUndo 1 + + if {$foundSelectedObj} { + + if {$ouflag} { + set mNeedObjUndo 1 + } else { + set mNeedObjUndo 0 + } + + set oflag 1 + + set mNeedCheckpoint 0 + updateCheckpointMode + } else { + set oflag 0 + } + } + + updateUndoMode $oflag +} + ::itcl::body Archer::createTargetLedger {} { # This belongs in the openDb and newDb # Delete previous ledger This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-07-17 16:51:09
|
Revision: 35170 http://brlcad.svn.sourceforge.net/brlcad/?rev=35170&view=rev Author: bob1961 Date: 2009-07-17 16:51:08 +0000 (Fri, 17 Jul 2009) Log Message: ----------- Added a few comments. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-17 16:50:36 UTC (rev 35169) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-17 16:51:08 UTC (rev 35170) @@ -7027,6 +7027,7 @@ return } + # Check for the existence of _obj if {[catch {gedCmd attr show $_obj} adata]} { return } @@ -7124,9 +7125,13 @@ } ## -# This method also needs to use a binary copy -# of objects between databases instead of "get" and "put". +# This method creates ledger entries for each object in _olist +# using the same global ID and an object ID of zero. # +# Note - this method is not currently being used. Before using this +# method the undo methods will need to accomodate multiple +# entries having the same global ID. +# ::itcl::body Archer::checkpoint_olist {_olist} { set olen [llength $_olist] if {$olen == 0 || $mLedger == ""} { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-07-21 18:06:05
|
Revision: 35242 http://brlcad.svn.sourceforge.net/brlcad/?rev=35242&view=rev Author: bob1961 Date: 2009-07-21 18:05:50 +0000 (Tue, 21 Jul 2009) Log Message: ----------- Mod the clearTargetLedger method to clear the ledger. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-21 17:28:00 UTC (rev 35241) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-21 18:05:50 UTC (rev 35242) @@ -1803,6 +1803,7 @@ # Possibly draw the updated object set ditem "" foreach item [gedCmd report 0] { + regexp {/([^/]+$)} $item all item set l [split $item /] set i [lsearch -exact $l $obj] if {$i != -1} { @@ -7368,7 +7369,8 @@ ::itcl::body Archer::clearTargetLedger {} { set mLedgerGID 0 - $mLedger + set alist [$mLedger ls] + eval $mLedger kill $alist } ::itcl::body Archer::createTargetLedger {} { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-07-28 17:00:35
|
Revision: 35342 http://brlcad.svn.sourceforge.net/brlcad/?rev=35342&view=rev Author: bob1961 Date: 2009-07-28 17:00:22 +0000 (Tue, 28 Jul 2009) Log Message: ----------- Theses changes make it possible to undo mv and mvall commands in Archer. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-28 16:38:10 UTC (rev 35341) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-28 17:00:22 UTC (rev 35342) @@ -106,8 +106,9 @@ public { # Public Class Variables - common LEDGER_ENTRY_HAVE_MODS_ATTR "Ledger_Entry_Have_Mods" + common LEDGER_ENTRY_OUT_OF_SYNC_ATTR "Ledger_Entry_Out_Of_Sync" common LEDGER_ENTRY_TYPE_ATTR "Ledger_Entry_Type" + common LEDGER_ENTRY_MOVE_COMMAND "Ledger_Entry_Move_Command" common LEDGER_CREATE "Create" common LEDGER_DESTROY "Destroy" common LEDGER_MODIFY "Modify" @@ -255,6 +256,7 @@ method gedWrapper2 {_cmd _oindex _pindex _eflag _hflag _sflag _tflag args} method globalWrapper {_cmd args} method killWrapper {_cmd args} + method moveWrapper {_cmd args} method initDefaultBindings {{_comp ""}} method initGed {} method selectNode {_tags {_rflag 1}} @@ -1040,7 +1042,7 @@ set oflag 1 } - $mLedger attr set $lname $LEDGER_ENTRY_HAVE_MODS_ATTR 1 + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 lappend new_olist $lname continue } @@ -1055,7 +1057,7 @@ set oflag 1 } - $mLedger attr set $lname $LEDGER_ENTRY_HAVE_MODS_ATTR 1 + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 lappend new_olist $lname continue } @@ -1070,7 +1072,7 @@ set oflag 1 } - $mLedger attr set $lname $LEDGER_ENTRY_HAVE_MODS_ATTR 1 + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 lappend new_olist $lname continue } @@ -1085,7 +1087,7 @@ set oflag 1 } - $mLedger attr set $lname $LEDGER_ENTRY_HAVE_MODS_ATTR 1 + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 lappend new_olist $lname continue } @@ -1189,7 +1191,7 @@ } foreach lname $lnames { - $mLedger attr set $lname $LEDGER_ENTRY_HAVE_MODS_ATTR 1 + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 } refreshTree 1 @@ -1220,13 +1222,81 @@ } ::itcl::body Archer::mv {args} { - eval ArcherCore::gedWrapper mv 0 0 1 1 $args + eval moveWrapper mv $args } ::itcl::body Archer::mvall {args} { - eval ArcherCore::gedWrapper mvall 0 0 1 1 $args + eval moveWrapper mvall $args } +::itcl::body Archer::moveWrapper {_cmd args} { + set alen [llength $args] + + # Returns a help message. + if {$alen == 0} { + return [gedCmd $_cmd] + } + + if {$alen == 3} { + # Must be using the -n option. If not, an error message + # containing the usage string will be returned. + return [eval gedCmd $_cmd $args] + } + + # Get the list of potentially modified objects. + if {$_cmd == "mvall"} { + set mlist [eval gedCmd $_cmd -n $args] + } else { + set mlist {} + } + + set mlen [llength $mlist] + + set old_name [lindex $args 0] + set new_name [lindex $args 1] + + SetWaitCursor $this + + # Checkpoint the objects that used to reference + # the soon-to-be renamed objects. + if {$mlen} { + set lnames [checkpoint_olist $mlist $LEDGER_MODIFY] + } else { + set lnames {} + } + + if {[catch {eval gedCmd $_cmd $args} ret]} { + ledger_cleanup + SetNormalCursor $this + return $ret + } + + # Flag these as having mods + foreach lname $lnames { + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 + } + + # Decrement the GID so that the renamed + # object below has the same GID as the + # modified objects above. + if {$mlen} { + incr mLedgerGID -1 + } + + # Checkpoint the renamed object + set lnew_name [checkpoint $new_name $LEDGER_RENAME] + + # Save the command for moving things back + $mLedger attr set $lnew_name $LEDGER_ENTRY_MOVE_COMMAND "$_cmd $new_name $old_name" + + refreshTree 1 + + checkpoint $lnew_name $LEDGER_MODIFY + checkpoint_olist $mlist $LEDGER_MODIFY + updateUndoState + SetNormalCursor $this +} + ::itcl::body Archer::nmg_collapse {args} { eval ArcherCore::gedWrapper nmg_collapse 0 0 1 1 $args } @@ -1835,7 +1905,7 @@ puts "No ledger entry found for $obj." } else { # Assumed to have mods after the command invocation above - $mLedger attr set $le $LEDGER_ENTRY_HAVE_MODS_ATTR 1 + $mLedger attr set $le $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 set mNeedSave 1 set mNeedGlobalUndo 1 @@ -1911,7 +1981,7 @@ return "No ledger entry found for _GLOBAL." } else { # Assumed to have mods after the command invocation above - $mLedger attr set $lname $LEDGER_ENTRY_HAVE_MODS_ATTR 1 + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 $mLedger attr set $lname UNITS $old_units } @@ -1951,7 +2021,7 @@ set alist [eval gedCmd $_cmd -n $expandedArgs] } - # The first sublist is for killed objects. The second is for modified. + # The first sublist is for killed objects. The second is for modified objects. set klist [lindex $alist 0] set mlist [lindex $alist 1] @@ -1978,7 +2048,7 @@ # Need to checkpoint before they're gone checkpoint_olist $klist $LEDGER_DESTROY - # Back up the GID so that the modified + # Decrement the GID so that the modified # objects below have the same GID. incr mLedgerGID -1 @@ -1993,7 +2063,7 @@ } foreach lname $lnames { - $mLedger attr set $lname $LEDGER_ENTRY_HAVE_MODS_ATTR 1 + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 } refreshTree 1 @@ -2268,7 +2338,7 @@ return } - set l [$mLedger ls -A $LEDGER_ENTRY_HAVE_MODS_ATTR 1] + set l [$mLedger ls -A $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1] set len [llength $l] if {$len == 0} { set mNeedSave 0 @@ -2289,7 +2359,7 @@ if {$len > 1} { set mNeedObjUndo 1 } else { - if {[$mLedger attr get $le $LEDGER_ENTRY_HAVE_MODS_ATTR]} { + if {[$mLedger attr get $le $LEDGER_ENTRY_OUT_OF_SYNC_ATTR]} { set mNeedObjUndo 1 } else { set mNeedObjUndo 0 @@ -7322,10 +7392,10 @@ set le [lindex $l end] regexp {([0-9]+)_([0-9]+)_(.+)} $le all gid oid gname - set have_mods [$mLedger attr get $le $LEDGER_ENTRY_HAVE_MODS_ATTR] + set oosync [$mLedger attr get $le $LEDGER_ENTRY_OUT_OF_SYNC_ATTR] # No need to checkpoint again (i.e. no mods since last checkpoint) - if {!$have_mods} { + if {!$oosync} { if {$_obj == $mSelectedObj && $len > 1} { set mNeedGlobalUndo 1 set mNeedObjUndo 1 @@ -7333,7 +7403,7 @@ set mNeedObjUndo 0 # Check for other entries having mods - set l [$mLedger ls -A $LEDGER_ENTRY_HAVE_MODS_ATTR 1] + set l [$mLedger ls -A $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1] set len [llength $l] if {$len == 0} { @@ -7371,14 +7441,14 @@ $LEDGER_CREATE - \ $LEDGER_DESTROY - \ $LEDGER_RENAME { - $mLedger attr set $lname $LEDGER_ENTRY_HAVE_MODS_ATTR 1 + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 } \ $LEDGER_MODIFY - \ default { - $mLedger attr set $lname $LEDGER_ENTRY_HAVE_MODS_ATTR 0 + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 0 } - set l [$mLedger ls -A $LEDGER_ENTRY_HAVE_MODS_ATTR 1] + set l [$mLedger ls -A $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1] set len [llength $l] if {$len == 0} { set mNeedGlobalUndo 0 @@ -7449,7 +7519,7 @@ set l [lsort -dictionary $l] set le [lindex $l end] - if {![$mLedger attr get $le $LEDGER_ENTRY_HAVE_MODS_ATTR]} { + if {![$mLedger attr get $le $LEDGER_ENTRY_OUT_OF_SYNC_ATTR]} { $mLedger kill $le if {$len > 1} { @@ -7470,15 +7540,15 @@ $LEDGER_CREATE - \ $LEDGER_DESTROY - \ $LEDGER_RENAME { - $mLedger attr set $lname $LEDGER_ENTRY_HAVE_MODS_ATTR 1 + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 } \ $LEDGER_MODIFY - \ default { - $mLedger attr set $lname $LEDGER_ENTRY_HAVE_MODS_ATTR 0 + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 0 } } - set l [$mLedger ls -A $LEDGER_ENTRY_HAVE_MODS_ATTR 1] + set l [$mLedger ls -A $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1] set len [llength $l] if {$len == 0} { set mNeedGlobalUndo 0 @@ -7564,6 +7634,8 @@ set mLedgerGID $gid incr mLedgerGID -1 + set gnames {} + # Undo each object associated with this transaction foreach lentry [$mLedger expand $gid\_$oid\_*] { regexp {([0-9]+)_([0-9]+)_(.+)} $lentry all gid oid gname @@ -7574,14 +7646,25 @@ # Nothing yet } \ $LEDGER_RENAME { - # Nothing yet + if {![catch {$mLedger attr get $lentry $LEDGER_ENTRY_MOVE_COMMAND} move_cmd]} { + eval gedCmd $move_cmd + + set curr_name [lindex $move_cmd 1] + set gname [lindex $move_cmd 2] + if {$curr_name == $mSelectedObj} { + set mSelectedObj $gname + } + } else { + puts "No old name found for $lentry" + continue + } } \ $LEDGER_DESTROY - \ $LEDGER_MODIFY - \ default { # Adjust the corresponding object according to the ledger entry gedCmd cp -f $mLedger\:$lentry $gname - gedCmd attr rm $gname $LEDGER_ENTRY_HAVE_MODS_ATTR + gedCmd attr rm $gname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR gedCmd attr rm $gname $LEDGER_ENTRY_TYPE_ATTR } @@ -7592,6 +7675,10 @@ # Remove the ledger entry $mLedger kill $lentry + lappend gnames $gname + } + + foreach gname $gname { if {$gname != "_GLOBAL"} { if {$gname == $mSelectedObj} { set mNeedObjSave 0 @@ -7614,7 +7701,9 @@ } } - set l [$mLedger ls -A $LEDGER_ENTRY_HAVE_MODS_ATTR 1] + refreshTree 1 + + set l [$mLedger ls -A $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1] set len [llength $l] if {$len == 0} { set mNeedCheckpoint 0 @@ -7633,7 +7722,7 @@ return } - foreach le [$mLedger ls -A $LEDGER_ENTRY_HAVE_MODS_ATTR 0] { + foreach le [$mLedger ls -A $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 0] { set le [regsub {/$|/R$} $le ""] $mLedger kill $le } @@ -7660,7 +7749,7 @@ set mNeedObjUndo 0 set mNeedSave 0 - set l [$mLedger ls -A $LEDGER_ENTRY_HAVE_MODS_ATTR 1] + set l [$mLedger ls -A $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1] set len [llength $l] if {$len == 0} { set mNeedGlobalUndo 0 @@ -7680,7 +7769,7 @@ set l [lsort -dictionary $l] set le [lindex $l end] - if {![$mLedger attr get $le $LEDGER_ENTRY_HAVE_MODS_ATTR]} { + if {![$mLedger attr get $le $LEDGER_ENTRY_OUT_OF_SYNC_ATTR]} { # No mods yet return } @@ -7696,13 +7785,6 @@ foreach lentry [$mLedger expand $gid\_$oid\_*] { regexp {([0-9]+)_([0-9]+)_(.+)} $lentry all gid oid gname -# if {$gname == $mSelectedObj && $oid == 0} { -# if {![$mLedger attr get $lentry $LEDGER_ENTRY_HAVE_MODS_ATTR]} { -# # No mods yet -# return -# } -# } - # Undo it (Note - the destroy transaction will never show up here) set type [$mLedger attr get $lentry $LEDGER_ENTRY_TYPE_ATTR] switch $type \ @@ -7710,14 +7792,25 @@ # Nothing yet } \ $LEDGER_RENAME { - # Nothing yet + if {![catch {$mLedger attr get $lentry $LEDGER_ENTRY_MOVE_COMMAND} move_cmd]} { + eval gedCmd $move_cmd + + set curr_name [lindex $move_cmd 1] + set gname [lindex $move_cmd 2] + if {$curr_name == $mSelectedObj} { + set mSelectedObj $gname + } + } else { + puts "No old name found for $lentry" + continue + } } \ $LEDGER_DESTROY - \ $LEDGER_MODIFY - \ default { # Adjust the corresponding object according to the ledger entry gedCmd cp -f $mLedger\:$lentry $gname - gedCmd attr rm $gname $LEDGER_ENTRY_HAVE_MODS_ATTR + gedCmd attr rm $gname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR gedCmd attr rm $gname $LEDGER_ENTRY_TYPE_ATTR } @@ -7733,6 +7826,8 @@ set mNeedCheckpoint 0 updateUndoState + refreshTree 1 + # Make sure the selected object has atleast one checkpoint checkpoint $mSelectedObj $LEDGER_MODIFY @@ -7800,7 +7895,7 @@ set le [lindex $l end] } - $mLedger attr set $le $LEDGER_ENTRY_HAVE_MODS_ATTR 1 + $mLedger attr set $le $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 set mNeedCheckpoint 1 set mNeedGlobalUndo 1 This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-07-28 20:49:09
|
Revision: 35351 http://brlcad.svn.sourceforge.net/brlcad/?rev=35351&view=rev Author: bob1961 Date: 2009-07-28 20:48:56 +0000 (Tue, 28 Jul 2009) Log Message: ----------- Theses changes make it possible to undo the "make" command in Archer. Other minor cleanup of Archer. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-28 20:46:34 UTC (rev 35350) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-28 20:48:56 UTC (rev 35351) @@ -808,7 +808,7 @@ } # Add gmember only if its not already there - set tmembers [regsub -all {(\{[ul] )|([{}]+)} $tree " "] + regsub -all {(\{[ul] )|([{}]+)} $tree " " tmembers if {[lsearch $tmembers $gmember] == -1} { $itk_component(ged) g $gname $gmember } @@ -1206,7 +1206,30 @@ } ::itcl::body Archer::make {args} { - eval ArcherCore::gedWrapper make 0 0 1 1 $args + set alen [llength $args] + + # Returns a help message. + if {$alen != 2} { + return [gedCmd make] + } + + SetWaitCursor $this + + if {[catch {eval gedCmd make $args} ret]} { + SetNormalCursor $this + return $ret + } + + set new_name [lindex $args 0] + + # Checkpoint the created object + set lnew_name [checkpoint $new_name $LEDGER_CREATE] + + refreshTree 1 + + checkpoint $new_name $LEDGER_MODIFY + updateUndoState + SetNormalCursor $this } ::itcl::body Archer::make_bb {args} { @@ -1291,7 +1314,13 @@ refreshTree 1 - checkpoint $lnew_name $LEDGER_MODIFY + if {$old_name == $mSelectedObj} { + set mSelectedObj $new_name + regsub {([^/]+)$} $mSelectedObjPath $new_name mSelectedObjPath + initEdit 0 + } + + checkpoint $new_name $LEDGER_MODIFY checkpoint_olist $mlist $LEDGER_MODIFY updateUndoState SetNormalCursor $this @@ -6143,7 +6172,7 @@ ::itcl::body Archer::invokeWizardDialog {class action wname} { gedCmd make_name -s 1 set name [string tolower $class] - set name [regsub wizard $name ""] + regsub wizard $name "" name #XXX Temporary special case for TankWizardI #if {$class == "TankWizardI"} { #set name "simpleTank" @@ -7634,6 +7663,7 @@ set mLedgerGID $gid incr mLedgerGID -1 + set cflag 0 set gnames {} # Undo each object associated with this transaction @@ -7643,7 +7673,16 @@ set type [$mLedger attr get $lentry $LEDGER_ENTRY_TYPE_ATTR] switch $type \ $LEDGER_CREATE { - # Nothing yet + gedCmd kill $gname + + if {$gname == $mSelectedObj} { + initDbAttrView $mTarget + } + + set mSelectedObj "" + set mSelectedObjPath "" + set mSelectedObjType "" + set cflag 1 } \ $LEDGER_RENAME { if {![catch {$mLedger attr get $lentry $LEDGER_ENTRY_MOVE_COMMAND} move_cmd]} { @@ -7653,6 +7692,7 @@ set gname [lindex $move_cmd 2] if {$curr_name == $mSelectedObj} { set mSelectedObj $gname + regsub {([^/]+)$} $mSelectedObjPath $gname mSelectedObjPath } } else { puts "No old name found for $lentry" @@ -7678,23 +7718,25 @@ lappend gnames $gname } - foreach gname $gname { - if {$gname != "_GLOBAL"} { - if {$gname == $mSelectedObj} { - set mNeedObjSave 0 - redrawObj $mSelectedObjPath - initEdit 0 + if {!$cflag} { + foreach gname $gnames { + if {$gname != "_GLOBAL"} { + if {$gname == $mSelectedObj} { + set mNeedObjSave 0 + redrawObj $mSelectedObjPath + initEdit 0 - # Make sure the selected object has atleast one checkpoint - checkpoint $mSelectedObj $LEDGER_MODIFY - } else { - # Possibly draw the updated object - set stripped_lentry [regsub {[0-9]+_[0-9]+_} $lentry ""] - foreach item [gedCmd report 0] { - regexp {/([^/]+$)} $item all last + # Make sure the selected object has atleast one checkpoint + checkpoint $mSelectedObj $LEDGER_MODIFY + } else { + # Possibly draw the updated object + regsub {[0-9]+_[0-9]+_} $lentry "" stripped_lentry + foreach item [gedCmd report 0] { + regexp {/([^/]+$)} $item all last - if {$last == $stripped_lentry} { - redrawObj $item + if {$last == $stripped_lentry} { + redrawObj $item + } } } } @@ -7723,7 +7765,7 @@ } foreach le [$mLedger ls -A $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 0] { - set le [regsub {/$|/R$} $le ""] + regsub {/$|/R$} $le "" le $mLedger kill $le } } @@ -7781,6 +7823,8 @@ incr mLedgerGID -1 } + set cflag 0 + # Undo each object associated with this transaction foreach lentry [$mLedger expand $gid\_$oid\_*] { regexp {([0-9]+)_([0-9]+)_(.+)} $lentry all gid oid gname @@ -7789,7 +7833,11 @@ set type [$mLedger attr get $lentry $LEDGER_ENTRY_TYPE_ATTR] switch $type \ $LEDGER_CREATE { - # Nothing yet + gedCmd kill $gname + set mSelectedObj "" + set mSelectedObjPath "" + set mSelectedObjType "" + set cflag 1 } \ $LEDGER_RENAME { if {![catch {$mLedger attr get $lentry $LEDGER_ENTRY_MOVE_COMMAND} move_cmd]} { @@ -7799,6 +7847,7 @@ set gname [lindex $move_cmd 2] if {$curr_name == $mSelectedObj} { set mSelectedObj $gname + regsub {([^/]+)$} $mSelectedObjPath $gname mSelectedObjPath } } else { puts "No old name found for $lentry" @@ -7820,9 +7869,14 @@ } set mNeedObjSave 0 - redrawObj $mSelectedObjPath - initEdit 0 + if {!$cflag} { + redrawObj $mSelectedObjPath + initEdit 0 + } else { + initDbAttrView $mTarget + } + set mNeedCheckpoint 0 updateUndoState @@ -7837,19 +7891,9 @@ } ::itcl::body Archer::revert {} { -# Code to capture the display list -# set rlist [gedCmd report 0] -# set rlen [llength $rlist] - set mNeedSave 0 Load $mTarget -# Code to redraw the captured display list -# if {$rlen > 0} { -# set rlist [regsub -all "\n" $rlist " "] -# eval draw $rlist -# } - set mLedgerGID 0 set mNeedCheckpoint 0 This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-07-29 14:16:37
|
Revision: 35368 http://brlcad.svn.sourceforge.net/brlcad/?rev=35368&view=rev Author: bob1961 Date: 2009-07-29 14:16:24 +0000 (Wed, 29 Jul 2009) Log Message: ----------- Added a createWrapper and modified "make" and "cp" to call it. Also brought the "in" command into the undo framework. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-29 14:11:08 UTC (rev 35367) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-29 14:16:24 UTC (rev 35368) @@ -252,6 +252,7 @@ # ArcherCore Override Section method dblClick {_tags} method combWrapper {_cmd _minArgs args} + method createWrapper {_cmd args} method gedWrapper {_cmd _eflag _hflag _sflag _tflag args} method gedWrapper2 {_cmd _oindex _pindex _eflag _hflag _sflag _tflag args} method globalWrapper {_cmd args} @@ -961,7 +962,8 @@ } ::itcl::body Archer::cp {args} { - eval ArcherCore::gedWrapper cp 0 0 1 1 $args + eval createWrapper cp $args +# eval ArcherCore::gedWrapper cp 0 0 1 1 $args } ::itcl::body Archer::cpi {args} { @@ -1136,7 +1138,32 @@ } ::itcl::body Archer::in {args} { - eval ArcherCore::gedWrapper in 0 0 1 1 $args + SetWaitCursor $this + + if {[llength $args] == 0} { + set new_args [handleMoreArgs "Enter name of solid: "] + while {[llength $new_args] == 0} { + set new_args [handleMoreArgs "Enter name of solid: "] + } + + set args $new_args + } + + set new_name [lindex $args 0] + + if {[catch {eval gedCmd in $args} ret]} { + SetNormalCursor $this + return $ret + } + + # Checkpoint the created object + set lnew_name [checkpoint $new_name $LEDGER_CREATE] + + refreshTree 1 + + checkpoint $new_name $LEDGER_MODIFY + updateUndoState + SetNormalCursor $this } ::itcl::body Archer::inside {args} { @@ -1206,30 +1233,7 @@ } ::itcl::body Archer::make {args} { - set alen [llength $args] - - # Returns a help message. - if {$alen != 2} { - return [gedCmd make] - } - - SetWaitCursor $this - - if {[catch {eval gedCmd make $args} ret]} { - SetNormalCursor $this - return $ret - } - - set new_name [lindex $args 0] - - # Checkpoint the created object - set lnew_name [checkpoint $new_name $LEDGER_CREATE] - - refreshTree 1 - - checkpoint $new_name $LEDGER_MODIFY - updateUndoState - SetNormalCursor $this + eval createWrapper make $args } ::itcl::body Archer::make_bb {args} { @@ -1873,6 +1877,54 @@ } } +::itcl::body Archer::createWrapper {_cmd args} { + set optionsAndArgs [eval dbExpand $args] + set options [lindex $optionsAndArgs 0] + set expandedArgs [lindex $optionsAndArgs 1] + + # Returns a help message. + if {[llength $expandedArgs] == 0} { + return [gedCmd $_cmd] + } + + # Get the list of created objects. + switch -- $_cmd { + "cp" { + if {[llength $expandedArgs] != 2} { + return [gedCmd $_cmd] + } + + set clist [lindex $expandedArgs 1] + } + "make" { + if {[llength $expandedArgs] != 2} { + return [gedCmd $_cmd] + } + + set clist [lindex $expandedArgs 0] + } + default { + return "createWrapper: $_cmd not recognized." + } + } + + SetWaitCursor $this + + if {[catch {eval gedCmd $_cmd $options $expandedArgs} ret]} { + SetNormalCursor $this + return $ret + } + + # Checkpoint the created object + checkpoint_olist $clist $LEDGER_CREATE + + refreshTree 1 + + checkpoint_olist $clist $LEDGER_MODIFY + updateUndoState + SetNormalCursor $this +} + ::itcl::body Archer::gedWrapper {cmd eflag hflag sflag tflag args} { eval gedWrapper2 $cmd 0 -1 $eflag $hflag $sflag $tflag $args } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-07-29 19:24:41
|
Revision: 35385 http://brlcad.svn.sourceforge.net/brlcad/?rev=35385&view=rev Author: bob1961 Date: 2009-07-29 19:24:32 +0000 (Wed, 29 Jul 2009) Log Message: ----------- Added mirror to the undo framework. Tweaked killWrapper. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-29 18:51:48 UTC (rev 35384) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-29 19:24:32 UTC (rev 35385) @@ -1245,7 +1245,7 @@ } ::itcl::body Archer::mirror {args} { - eval ArcherCore::gedWrapper mirror 0 0 1 1 $args + eval createWrapper mirror $args } ::itcl::body Archer::mv {args} { @@ -1878,22 +1878,29 @@ } ::itcl::body Archer::createWrapper {_cmd args} { - set optionsAndArgs [eval dbExpand $args] - set options [lindex $optionsAndArgs 0] - set expandedArgs [lindex $optionsAndArgs 1] - # Returns a help message. - if {[llength $expandedArgs] == 0} { + if {[llength $args] < 2} { return [gedCmd $_cmd] } + set options [lrange $args 0 end-2] + set expandedArgs [lrange $args end-1 end] + # Get the list of created objects. switch -- $_cmd { - "cp" { + "cp" - + "mirror" { if {[llength $expandedArgs] != 2} { return [gedCmd $_cmd] } + set old [lindex $expandedArgs 0] + + # Check for the existence of old + if {[catch {gedCmd attr show $old} adata]} { + return [gedCmd $_cmd] + } + set clist [lindex $expandedArgs 1] } "make" { @@ -2108,10 +2115,13 @@ # If an item is in both sublists, remove it from mlist. foreach item $klist { - set i [lsearch $mlist $item] - if {$i != -1} { - # Delete the item (i.e. it no longer exists) - set mlist [lreplace $mlist $i $i] + set l [lsearch -all $mlist $item] + set l [lsort -decreasing $l] + if {$l != -1} { + foreach i $l { + # Delete the item (i.e. it no longer exists) + set mlist [lreplace $mlist $i $i] + } } } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-07-29 21:16:19
|
Revision: 35389 http://brlcad.svn.sourceforge.net/brlcad/?rev=35389&view=rev Author: bob1961 Date: 2009-07-29 21:15:59 +0000 (Wed, 29 Jul 2009) Log Message: ----------- Added clone to Archer's undo framework. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-29 21:13:08 UTC (rev 35388) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-29 21:15:59 UTC (rev 35389) @@ -947,7 +947,7 @@ } ::itcl::body Archer::clone {args} { - eval ArcherCore::gedWrapper clone 0 0 1 1 $args + eval createWrapper clone $args } ::itcl::body Archer::color {args} { @@ -963,7 +963,6 @@ ::itcl::body Archer::cp {args} { eval createWrapper cp $args -# eval ArcherCore::gedWrapper cp 0 0 1 1 $args } ::itcl::body Archer::cpi {args} { @@ -1256,80 +1255,6 @@ eval moveWrapper mvall $args } -::itcl::body Archer::moveWrapper {_cmd args} { - set alen [llength $args] - - # Returns a help message. - if {$alen == 0} { - return [gedCmd $_cmd] - } - - if {$alen == 3} { - # Must be using the -n option. If not, an error message - # containing the usage string will be returned. - return [eval gedCmd $_cmd $args] - } - - # Get the list of potentially modified objects. - if {$_cmd == "mvall"} { - set mlist [eval gedCmd $_cmd -n $args] - } else { - set mlist {} - } - - set mlen [llength $mlist] - - set old_name [lindex $args 0] - set new_name [lindex $args 1] - - SetWaitCursor $this - - # Checkpoint the objects that used to reference - # the soon-to-be renamed objects. - if {$mlen} { - set lnames [checkpoint_olist $mlist $LEDGER_MODIFY] - } else { - set lnames {} - } - - if {[catch {eval gedCmd $_cmd $args} ret]} { - ledger_cleanup - SetNormalCursor $this - return $ret - } - - # Flag these as having mods - foreach lname $lnames { - $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 - } - - # Decrement the GID so that the renamed - # object below has the same GID as the - # modified objects above. - if {$mlen} { - incr mLedgerGID -1 - } - - # Checkpoint the renamed object - set lnew_name [checkpoint $new_name $LEDGER_RENAME] - - # Save the command for moving things back - $mLedger attr set $lnew_name $LEDGER_ENTRY_MOVE_COMMAND "$_cmd $new_name $old_name" - - refreshTree 1 - - if {$old_name == $mSelectedObj} { - set mSelectedObj $new_name - regsub {([^/]+)$} $mSelectedObjPath $new_name mSelectedObjPath - initEdit 0 - } - - checkpoint $new_name $LEDGER_MODIFY - checkpoint_olist $mlist $LEDGER_MODIFY - updateUndoState - SetNormalCursor $this -} - ::itcl::body Archer::nmg_collapse {args} { eval ArcherCore::gedWrapper nmg_collapse 0 0 1 1 $args } @@ -1878,18 +1803,27 @@ } ::itcl::body Archer::createWrapper {_cmd args} { - # Returns a help message. - if {[llength $args] < 2} { - return [gedCmd $_cmd] - } - - set options [lrange $args 0 end-2] - set expandedArgs [lrange $args end-1 end] - # Get the list of created objects. switch -- $_cmd { + "clone" { + # Returns a help message. + if {[llength $args] == 0} { + return [gedCmd $_cmd] + } + + set options [lrange $args 0 end-1] + set expandedArgs [lrange $args end end] + } "cp" - "mirror" { + # Returns a help message. + if {[llength $args] < 2} { + return [gedCmd $_cmd] + } + + set options [lrange $args 0 end-2] + set expandedArgs [lrange $args end-1 end] + if {[llength $expandedArgs] != 2} { return [gedCmd $_cmd] } @@ -1904,6 +1838,14 @@ set clist [lindex $expandedArgs 1] } "make" { + # Returns a help message. + if {[llength $args] < 2} { + return [gedCmd $_cmd] + } + + set options [lrange $args 0 end-2] + set expandedArgs [lrange $args end-1 end] + if {[llength $expandedArgs] != 2} { return [gedCmd $_cmd] } @@ -1922,14 +1864,20 @@ return $ret } + if {$_cmd == "clone"} { + set clist [lindex $ret 1] + set ret [lindex $ret 0] + } + # Checkpoint the created object checkpoint_olist $clist $LEDGER_CREATE refreshTree 1 - checkpoint_olist $clist $LEDGER_MODIFY updateUndoState SetNormalCursor $this + + return $ret } ::itcl::body Archer::gedWrapper {cmd eflag hflag sflag tflag args} { @@ -2159,11 +2107,95 @@ refreshTree 1 - checkpoint_olist $mlist $LEDGER_MODIFY + if {[lsearch $klist $mSelectedObj] != -1} { + set mSelectedObj "" + set mSelectedObjPath "" + set mSelectedObjType "" + } elseif {[lsearch $mlist $mSelectedObj] != -1} { + checkpoint $mSelectedObj $LEDGER_MODIFY + } + updateUndoState SetNormalCursor $this + + return $ret } +::itcl::body Archer::moveWrapper {_cmd args} { + set alen [llength $args] + + # Returns a help message. + if {$alen == 0} { + return [gedCmd $_cmd] + } + + if {$alen == 3} { + # Must be using the -n option. If not, an error message + # containing the usage string will be returned. + return [eval gedCmd $_cmd $args] + } + + # Get the list of potentially modified objects. + if {$_cmd == "mvall"} { + set mlist [eval gedCmd $_cmd -n $args] + } else { + set mlist {} + } + + set mlen [llength $mlist] + + set old_name [lindex $args 0] + set new_name [lindex $args 1] + + SetWaitCursor $this + + # Checkpoint the objects that used to reference + # the soon-to-be renamed objects. + if {$mlen} { + set lnames [checkpoint_olist $mlist $LEDGER_MODIFY] + } else { + set lnames {} + } + + if {[catch {eval gedCmd $_cmd $args} ret]} { + ledger_cleanup + SetNormalCursor $this + return $ret + } + + # Flag these as having mods + foreach lname $lnames { + $mLedger attr set $lname $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 + } + + # Decrement the GID so that the renamed + # object below has the same GID as the + # modified objects above. + if {$mlen} { + incr mLedgerGID -1 + } + + # Checkpoint the renamed object + set lnew_name [checkpoint $new_name $LEDGER_RENAME] + + # Save the command for moving things back + $mLedger attr set $lnew_name $LEDGER_ENTRY_MOVE_COMMAND "$_cmd $new_name $old_name" + + refreshTree 1 + + if {$old_name == $mSelectedObj} { + set mSelectedObj $new_name + regsub {([^/]+)$} $mSelectedObjPath $new_name mSelectedObjPath + initEdit 0 + checkpoint $mSelectedObj $LEDGER_MODIFY + } elseif {[lsearch $mlist $mSelectedObj] != -1} { + checkpoint $mSelectedObj $LEDGER_MODIFY + } + + updateUndoState + SetNormalCursor $this +} + ::itcl::body Archer::initDefaultBindings {{_comp ""}} { if {$_comp == ""} { if {[info exists itk_component(ged)]} { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-07-30 15:57:55
|
Revision: 35402 http://brlcad.svn.sourceforge.net/brlcad/?rev=35402&view=rev Author: bob1961 Date: 2009-07-30 15:57:44 +0000 (Thu, 30 Jul 2009) Log Message: ----------- Update combWrapper to call createWrapper or gedWrapper. Added comb, g and r to Archer's undo framework. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-30 15:19:08 UTC (rev 35401) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-30 15:57:44 UTC (rev 35402) @@ -958,7 +958,7 @@ # Create a combination or modify an existing one. # ::itcl::body Archer::comb {args} { - eval combWrapper g 3 $args + eval combWrapper comb 3 $args } ::itcl::body Archer::cp {args} { @@ -966,7 +966,7 @@ } ::itcl::body Archer::cpi {args} { - eval ArcherCore::gedWrapper cpi 0 0 1 1 $args + eval createWrapper cpi $args } ::itcl::body Archer::copyeval {args} { @@ -1778,27 +1778,18 @@ ::itcl::body Archer::combWrapper {_cmd _minArgs args} { set alen [llength $args] if {$alen < $_minArgs} { - eval ArcherCore::gedWrapper $_cmd 0 0 1 1 $args - return + return [gedCmd $_cmd] } set obj [lindex $args 0] - set l [gedCmd expand $obj*] - set len [llength $l] - if {$len == 0} { + # Check for the existence of obj + if {[catch {gedCmd attr show $obj} adata]} { # Create a new combination - eval ArcherCore::gedWrapper $_cmd 0 0 1 1 $args + eval createWrapper $_cmd $args } else { - set i [lsearch -exact $l $obj] - - if {$i == -1} { - # Create a new combination - eval ArcherCore::gedWrapper $_cmd 0 0 1 1 $args - } else { - # Modifying an existing combination - eval gedWrapper $_cmd 0 0 1 1 $args - } + # Modifying an existing combination + eval gedWrapper $_cmd 0 0 1 1 $args } } @@ -1815,6 +1806,7 @@ set expandedArgs [lrange $args end end] } "cp" - + "cpi" - "mirror" { # Returns a help message. if {[llength $args] < 2} { @@ -1852,6 +1844,18 @@ set clist [lindex $expandedArgs 0] } + "comb" - + "g" - + "r" { + # Returns a help message. + if {[llength $args] < 2} { + return [gedCmd $_cmd] + } + + set options {} + set expandedArgs $args + set clist [lindex $expandedArgs 0] + } default { return "createWrapper: $_cmd not recognized." } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-07-30 16:42:25
|
Revision: 35403 http://brlcad.svn.sourceforge.net/brlcad/?rev=35403&view=rev Author: bob1961 Date: 2009-07-30 16:42:09 +0000 (Thu, 30 Jul 2009) Log Message: ----------- Added the "c" command to Archer's undo framework. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-30 15:57:44 UTC (rev 35402) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-07-30 16:42:09 UTC (rev 35403) @@ -943,7 +943,7 @@ # Create a combination. # ::itcl::body Archer::c {args} { - eval ArcherCore::gedWrapper c 0 0 1 1 $args + eval combWrapper c 2 $args } ::itcl::body Archer::clone {args} { @@ -1794,8 +1794,20 @@ } ::itcl::body Archer::createWrapper {_cmd args} { - # Get the list of created objects. + # Set the list of created objects (i.e. clist) switch -- $_cmd { + "c" { + set optionsAndArgs [eval dbExpand $args] + set options [lindex $optionsAndArgs 0] + set expandedArgs [lindex $optionsAndArgs 1] + + # Returns a help message. + if {[llength $expandedArgs] < 2} { + return [gedCmd $_cmd] + } + + set clist [lindex $expandedArgs 0] + } "clone" { # Returns a help message. if {[llength $args] == 0} { @@ -1804,6 +1816,9 @@ set options [lrange $args 0 end-1] set expandedArgs [lrange $args end end] + + # Clone will return the clist info. Consequently, + # clist is set after invoking clone below. } "cp" - "cpi" - @@ -1824,7 +1839,7 @@ # Check for the existence of old if {[catch {gedCmd attr show $old} adata]} { - return [gedCmd $_cmd] + return [eval gedCmd $_cmd $expanedArgs] } set clist [lindex $expandedArgs 1] This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-08-18 19:59:21
|
Revision: 35607 http://brlcad.svn.sourceforge.net/brlcad/?rev=35607&view=rev Author: bob1961 Date: 2009-08-18 19:59:15 +0000 (Tue, 18 Aug 2009) Log Message: ----------- Use expand instead of ls when clearing the target ledger (.i.e ls adds garnish to regions/combinations). Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-08-18 19:30:25 UTC (rev 35606) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-08-18 19:59:15 UTC (rev 35607) @@ -7747,7 +7747,7 @@ ::itcl::body Archer::clearTargetLedger {} { set mLedgerGID 0 - set alist [$mLedger ls] + set alist [$mLedger expand *] eval $mLedger kill $alist } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-08-24 16:39:35
|
Revision: 35691 http://brlcad.svn.sourceforge.net/brlcad/?rev=35691&view=rev Author: bob1961 Date: 2009-08-24 16:39:25 +0000 (Mon, 24 Aug 2009) Log Message: ----------- Update killWrapper to remove duplicates from the kill list and the modified list. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-08-24 16:11:33 UTC (rev 35690) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-08-24 16:39:25 UTC (rev 35691) @@ -2127,6 +2127,10 @@ return } + # Remove duplicates from both klist and mlist + set klist [lsort -unique $klist] + set mlist [lsort -unique $mlist] + SetWaitCursor $this # Need to checkpoint before they're gone This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-09-02 19:11:43
|
Revision: 35827 http://brlcad.svn.sourceforge.net/brlcad/?rev=35827&view=rev Author: bob1961 Date: 2009-09-02 19:11:36 +0000 (Wed, 02 Sep 2009) Log Message: ----------- Modified killWrapper to set the wait cursor sooner. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-09-02 19:06:08 UTC (rev 35826) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-09-02 19:11:36 UTC (rev 35827) @@ -2095,6 +2095,8 @@ return [gedCmd $_cmd] } + SetWaitCursor $this + # Get the list of killed and modified objects. if {[lsearch $options -a] != -1} { set alist [eval gedCmd $_cmd -a -n $expandedArgs] @@ -2120,10 +2122,12 @@ set nindex [lsearch $options "-n"] if {$nindex == 0 || $nindex == 1} { + SetNormalCursor $this return [list $klist $mlist] } if {[llength $klist] == 0} { + SetNormalCursor $this return } @@ -2131,8 +2135,6 @@ set klist [lsort -unique $klist] set mlist [lsort -unique $mlist] - SetWaitCursor $this - # Need to checkpoint before they're gone checkpoint_olist $klist $LEDGER_DESTROY This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-10-13 15:31:40
|
Revision: 36184 http://brlcad.svn.sourceforge.net/brlcad/?rev=36184&view=rev Author: bob1961 Date: 2009-10-13 15:31:16 +0000 (Tue, 13 Oct 2009) Log Message: ----------- Tweak the attr method. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-10-13 13:21:05 UTC (rev 36183) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-10-13 15:31:16 UTC (rev 36184) @@ -893,17 +893,24 @@ ::itcl::body Archer::attr {args} { set len [llength $args] - if {$len < 4} { - return [eval gedWrapper2 attr 1 0 0 0 0 0 $args] - } set cmd [lindex $args 0] switch -- $cmd { "append" - - "rm" - "set" { + if {$len < 4} { + return [eval gedWrapper2 attr 1 0 0 0 0 0 $args] + } + return [eval gedWrapper2 attr 1 0 0 0 1 0 $args] } + "rm" { + if {$len < 3} { + return [eval gedWrapper2 attr 1 0 0 0 0 0 $args] + } + + return [eval gedWrapper2 attr 1 0 0 0 1 0 $args] + } "get" - "show" { return [eval gedWrapper2 attr 1 0 0 0 0 0 $args] This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-10-29 13:53:49
|
Revision: 36319 http://brlcad.svn.sourceforge.net/brlcad/?rev=36319&view=rev Author: bob1961 Date: 2009-10-29 13:53:41 +0000 (Thu, 29 Oct 2009) Log Message: ----------- Added the following methods to give more flexibility to subclasses when reading/writing preferences: readPreferencesInit, writePreferencesHeader and writePreferencesBody. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-10-29 13:13:49 UTC (rev 36318) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-10-29 13:53:41 UTC (rev 36319) @@ -233,6 +233,7 @@ } protected { + variable mPrefFile "" variable mNeedObjSave 0 variable mNeedGlobalUndo 0 variable mNeedObjUndo 0 @@ -403,7 +404,10 @@ method applyViewAxesPreferencesIfDiff {} method doPreferences {} method readPreferences {} + method readPreferencesInit {} method writePreferences {} + method writePreferencesHeader {_pfile} + method writePreferencesBody {_pfile} # Primitive Creation Section method createObj {_type} @@ -457,7 +461,7 @@ updatePrimaryToolbar } - + eval itk_initialize $args $this configure -background $LABEL_BACKGROUND_COLOR @@ -1608,24 +1612,24 @@ -file [file join $dir primitive_list.png]] # View Toolbar - $itk_component(primaryToolbar) itemconfigure rotate \ - -image [image create photo \ - -file [file join $dir view_rotate.png]] - $itk_component(primaryToolbar) itemconfigure translate \ - -image [image create photo \ - -file [file join $dir view_translate.png]] - $itk_component(primaryToolbar) itemconfigure scale \ - -image [image create photo \ - -file [file join $dir view_scale.png]] - $itk_component(primaryToolbar) itemconfigure center \ - -image [image create photo \ - -file [file join $dir view_select.png]] - $itk_component(primaryToolbar) itemconfigure cpick \ - -image [image create photo \ - -file [file join $dir compSelect.png]] - $itk_component(primaryToolbar) itemconfigure measure \ - -image [image create photo \ - -file [file join $dir measure.png]] +# $itk_component(primaryToolbar) itemconfigure rotate \ +# -image [image create photo \ +# -file [file join $dir view_rotate.png]] +# $itk_component(primaryToolbar) itemconfigure translate \ +# -image [image create photo \ +# -file [file join $dir view_translate.png]] +# $itk_component(primaryToolbar) itemconfigure scale \ +# -image [image create photo \ +# -file [file join $dir view_scale.png]] +# $itk_component(primaryToolbar) itemconfigure center \ +# -image [image create photo \ +# -file [file join $dir view_select.png]] +# $itk_component(primaryToolbar) itemconfigure cpick \ +# -image [image create photo \ +# -file [file join $dir compSelect.png]] +# $itk_component(primaryToolbar) itemconfigure measure \ +# -image [image create photo \ +# -file [file join $dir measure.png]] # We catch this because the item may not exist catch {$itk_component(primaryToolbar) itemconfigure wizards \ @@ -3847,7 +3851,7 @@ set mStatusStr "Set application preferences" } "Quit" { - set mStatusStr "Exit ArcherCore" + set mStatusStr "Exit Archer" } "Reset" { set mStatusStr "Set view to default" @@ -3991,9 +3995,15 @@ -command [::itcl::code $this doPreferences] # half-size spacer - $itk_component(primaryToolbar) insert rotate frame sep2 \ + $itk_component(primaryToolbar) insert rotate frame fill0 \ + -relief flat \ + -width 3 + $itk_component(primaryToolbar) insert rotate frame sep0 \ -relief sunken \ -width 2 + $itk_component(primaryToolbar) insert rotate frame fill1 \ + -relief flat \ + -width 3 $itk_component(primaryToolbar) insert rotate button checkpoint \ -balloonstr "Create checkpoint" \ @@ -4025,18 +4035,28 @@ if {$::Archer::plugins != ""} { - # half-size spacer - $itk_component(primaryToolbar) insert rotate frame sep6 \ + $itk_component(primaryToolbar) insert rotate frame fill2 \ + -relief flat \ + -width 3 + $itk_component(primaryToolbar) insert rotate frame sep1 \ -relief sunken \ -width 2 + $itk_component(primaryToolbar) insert rotate frame fill3 \ + -relief flat \ + -width 3 } buildWizardMenu - # half-size spacer - $itk_component(primaryToolbar) insert rotate frame sep4 \ + $itk_component(primaryToolbar) insert rotate frame fill4 \ + -relief flat \ + -width 3 + $itk_component(primaryToolbar) insert rotate frame sep2 \ -relief sunken \ -width 2 + $itk_component(primaryToolbar) insert rotate frame fill5 \ + -relief flat \ + -width 3 $itk_component(primaryToolbar) insert rotate button arb6 \ -balloonstr "Create an arb6" \ @@ -4086,9 +4106,15 @@ -relief flat # half-size spacer - $itk_component(primaryToolbar) insert rotate frame sep5 \ + $itk_component(primaryToolbar) insert rotate frame fill6 \ + -relief flat \ + -width 3 + $itk_component(primaryToolbar) insert rotate frame sep3 \ -relief sunken \ -width 2 + $itk_component(primaryToolbar) insert rotate frame fill7 \ + -relief flat \ + -width 3 $itk_component(primaryToolbar) insert rotate button comb \ -state disabled \ @@ -4274,26 +4300,26 @@ -command [::itcl::code $this createObj bot] # half-size spacer - $itk_component(primaryToolbar) insert rotate frame fill1 \ + $itk_component(primaryToolbar) insert rotate frame fill8 \ -relief flat \ - -width 5 - $itk_component(primaryToolbar) insert rotate frame sep7 \ + -width 3 + $itk_component(primaryToolbar) insert rotate frame sep4 \ -relief sunken \ -width 2 - $itk_component(primaryToolbar) insert rotate frame fill2 \ + $itk_component(primaryToolbar) insert rotate frame fill9 \ -relief flat \ - -width 5 + -width 3 # add spacer - $itk_component(primaryToolbar) add frame fill3 \ + $itk_component(primaryToolbar) add frame fill10 \ -relief flat \ - -width 5 - $itk_component(primaryToolbar) add frame sep8 \ + -width 3 + $itk_component(primaryToolbar) add frame sep5 \ -relief sunken \ -width 2 - $itk_component(primaryToolbar) add frame fill4 \ + $itk_component(primaryToolbar) add frame fill11 \ -relief flat \ - -width 5 + -width 3 $itk_component(primaryToolbar) add radiobutton edit_rotate \ -balloonstr "Rotate selected object" \ -helpstr "Rotate selected object" \ @@ -4805,8 +4831,8 @@ ################################### Modes Section ################################### -::itcl::body Archer::initMode {{updateFractions 0}} { - if {$updateFractions} { +::itcl::body Archer::initMode {{_updateFractions 0}} { + if {$_updateFractions} { updateHPaneFractions updateVPaneFractions } @@ -7089,8 +7115,10 @@ set home . } + readPreferencesInit + # Read in the preferences file. - if {![catch {open [file join $home .archerrc] r} pfile]} { + if {![catch {open [file join $home $mPrefFile] r} pfile]} { set lines [split [read $pfile] "\n"] close $pfile @@ -7114,6 +7142,9 @@ updateToggleMode } +::itcl::body Archer::readPreferencesInit {} { + set mPrefFile ".archerrc" +} ::itcl::body Archer::writePreferences {} { global env @@ -7132,66 +7163,74 @@ updateVPaneFractions # Write the preferences file. - if {![catch {open [file join $home .archerrc] w} pfile]} { - puts $pfile "# Archer's Preferences File" - puts $pfile "# Version 0.7.5" - puts $pfile "#" - puts $pfile "# DO NOT EDIT THIS FILE" - puts $pfile "#" - puts $pfile "# This file is created and updated by Archer." - puts $pfile "#" - puts $pfile "set mBackground \"$mBackground\"" - puts $pfile "set mBindingMode $mBindingMode" - puts $pfile "set mEnableBigE $mEnableBigE" - puts $pfile "set mMeasuringStickColor \"$mMeasuringStickColor\"" - puts $pfile "set mMeasuringStickMode $mMeasuringStickMode" - puts $pfile "set mPrimitiveLabelColor \"$mPrimitiveLabelColor\"" - puts $pfile "set mScaleColor \"$mScaleColor\"" - puts $pfile "set mViewingParamsColor \"$mViewingParamsColor\"" - puts $pfile "set mTheme \"$mTheme\"" + if {![catch {open [file join $home $mPrefFile] w} pfile]} { + writePreferencesHeader $pfile + writePreferencesBody $pfile + close $pfile + } else { + puts "Failed to write the preferences file:\n$pfile" + } +} - puts $pfile "set mGroundPlaneMajorColor \"$mGroundPlaneMajorColor\"" - puts $pfile "set mGroundPlaneMinorColor \"$mGroundPlaneMinorColor\"" - puts $pfile "set mGroundPlaneInterval \"$mGroundPlaneInterval\"" - puts $pfile "set mGroundPlaneSize \"$mGroundPlaneSize\"" +::itcl::body Archer::writePreferencesHeader {_pfile} { + puts $_pfile "# Archer's Preferences File" + puts $_pfile "# Version 1.0.0" + puts $_pfile "#" + puts $_pfile "# DO NOT EDIT THIS FILE" + puts $_pfile "#" + puts $_pfile "# This file is created and updated by Archer." + puts $_pfile "#" +} - puts $pfile "set mViewAxesSize \"$mViewAxesSize\"" - puts $pfile "set mViewAxesPosition \"$mViewAxesPosition\"" - puts $pfile "set mViewAxesLineWidth $mViewAxesLineWidth" - puts $pfile "set mViewAxesColor \"$mViewAxesColor\"" - puts $pfile "set mViewAxesLabelColor \"$mViewAxesLabelColor\"" +::itcl::body Archer::writePreferencesBody {_pfile} { + puts $_pfile "set mBackground \"$mBackground\"" + puts $_pfile "set mBindingMode $mBindingMode" + puts $_pfile "set mEnableBigE $mEnableBigE" + puts $_pfile "set mMeasuringStickColor \"$mMeasuringStickColor\"" + puts $_pfile "set mMeasuringStickMode $mMeasuringStickMode" + puts $_pfile "set mPrimitiveLabelColor \"$mPrimitiveLabelColor\"" + puts $_pfile "set mScaleColor \"$mScaleColor\"" + puts $_pfile "set mViewingParamsColor \"$mViewingParamsColor\"" + puts $_pfile "set mTheme \"$mTheme\"" - puts $pfile "set mModelAxesSize \"$mModelAxesSize\"" - puts $pfile "set mModelAxesPosition \"$mModelAxesPosition\"" - puts $pfile "set mModelAxesLineWidth $mModelAxesLineWidth" - puts $pfile "set mModelAxesColor \"$mModelAxesColor\"" - puts $pfile "set mModelAxesLabelColor \"$mModelAxesLabelColor\"" + puts $_pfile "set mGroundPlaneMajorColor \"$mGroundPlaneMajorColor\"" + puts $_pfile "set mGroundPlaneMinorColor \"$mGroundPlaneMinorColor\"" + puts $_pfile "set mGroundPlaneInterval \"$mGroundPlaneInterval\"" + puts $_pfile "set mGroundPlaneSize \"$mGroundPlaneSize\"" - puts $pfile "set mModelAxesTickInterval $mModelAxesTickInterval" - puts $pfile "set mModelAxesTicksPerMajor $mModelAxesTicksPerMajor" - puts $pfile "set mModelAxesTickThreshold $mModelAxesTickThreshold" - puts $pfile "set mModelAxesTickLength $mModelAxesTickLength" - puts $pfile "set mModelAxesTickMajorLength $mModelAxesTickMajorLength" - puts $pfile "set mModelAxesTickColor \"$mModelAxesTickColor\"" - puts $pfile "set mModelAxesTickMajorColor \"$mModelAxesTickMajorColor\"" + puts $_pfile "set mViewAxesSize \"$mViewAxesSize\"" + puts $_pfile "set mViewAxesPosition \"$mViewAxesPosition\"" + puts $_pfile "set mViewAxesLineWidth $mViewAxesLineWidth" + puts $_pfile "set mViewAxesColor \"$mViewAxesColor\"" + puts $_pfile "set mViewAxesLabelColor \"$mViewAxesLabelColor\"" - puts $pfile "set mLastSelectedDir \"$mLastSelectedDir\"" - puts $pfile "set mZClipMode $mZClipMode" + puts $_pfile "set mModelAxesSize \"$mModelAxesSize\"" + puts $_pfile "set mModelAxesPosition \"$mModelAxesPosition\"" + puts $_pfile "set mModelAxesLineWidth $mModelAxesLineWidth" + puts $_pfile "set mModelAxesColor \"$mModelAxesColor\"" + puts $_pfile "set mModelAxesLabelColor \"$mModelAxesLabelColor\"" - puts $pfile "set mHPaneFraction1 $mHPaneFraction1" - puts $pfile "set mHPaneFraction2 $mHPaneFraction2" - puts $pfile "set mVPaneFraction1 $mVPaneFraction1" - puts $pfile "set mVPaneFraction2 $mVPaneFraction2" - puts $pfile "set mVPaneFraction3 $mVPaneFraction3" - puts $pfile "set mVPaneFraction4 $mVPaneFraction4" - puts $pfile "set mVPaneFraction5 $mVPaneFraction5" - puts $pfile "set mVPaneToggle1 $mVPaneToggle1" - puts $pfile "set mVPaneToggle3 $mVPaneToggle3" - puts $pfile "set mVPaneToggle5 $mVPaneToggle5" - close $pfile - } else { - puts "Failed to write the preferences file:\n$pfile" - } + puts $_pfile "set mModelAxesTickInterval $mModelAxesTickInterval" + puts $_pfile "set mModelAxesTicksPerMajor $mModelAxesTicksPerMajor" + puts $_pfile "set mModelAxesTickThreshold $mModelAxesTickThreshold" + puts $_pfile "set mModelAxesTickLength $mModelAxesTickLength" + puts $_pfile "set mModelAxesTickMajorLength $mModelAxesTickMajorLength" + puts $_pfile "set mModelAxesTickColor \"$mModelAxesTickColor\"" + puts $_pfile "set mModelAxesTickMajorColor \"$mModelAxesTickMajorColor\"" + + puts $_pfile "set mLastSelectedDir \"$mLastSelectedDir\"" + puts $_pfile "set mZClipMode $mZClipMode" + + puts $_pfile "set mHPaneFraction1 $mHPaneFraction1" + puts $_pfile "set mHPaneFraction2 $mHPaneFraction2" + puts $_pfile "set mVPaneFraction1 $mVPaneFraction1" + puts $_pfile "set mVPaneFraction2 $mVPaneFraction2" + puts $_pfile "set mVPaneFraction3 $mVPaneFraction3" + puts $_pfile "set mVPaneFraction4 $mVPaneFraction4" + puts $_pfile "set mVPaneFraction5 $mVPaneFraction5" + puts $_pfile "set mVPaneToggle1 $mVPaneToggle1" + puts $_pfile "set mVPaneToggle3 $mVPaneToggle3" + puts $_pfile "set mVPaneToggle5 $mVPaneToggle5" } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2009-11-24 17:30:52
|
Revision: 36613 http://brlcad.svn.sourceforge.net/brlcad/?rev=36613&view=rev Author: bob1961 Date: 2009-11-24 17:30:42 +0000 (Tue, 24 Nov 2009) Log Message: ----------- Minor mod. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-11-24 17:17:41 UTC (rev 36612) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2009-11-24 17:30:42 UTC (rev 36613) @@ -4650,7 +4650,7 @@ -state disabled $itk_component(menubar) menuconfigure .modes.light \ -offvalue 0 \ - -onvalue 1 \ + -onvalue 2 \ -variable [::itcl::scope mLighting] \ -command [::itcl::code $this doLighting] \ -state disabled This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2010-01-11 21:03:12
|
Revision: 37228 http://brlcad.svn.sourceforge.net/brlcad/?rev=37228&view=rev Author: bob1961 Date: 2010-01-11 21:03:04 +0000 (Mon, 11 Jan 2010) Log Message: ----------- Added global_undo_callback, modesMenuStatusCB, rtCheckMenuStatusCB, rtEdgeMenuStatusCB and rtMenuStatusCB Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-01-11 20:49:32 UTC (rev 37227) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-01-11 21:03:04 UTC (rev 37228) @@ -224,6 +224,7 @@ method clearTargetLedger {} method createTargetLedger {} method global_undo {} + method global_undo_callback {_gname} method ledger_cleanup {} method object_checkpoint {} method object_undo {} @@ -286,7 +287,14 @@ method doArcherHelp {} method launchDisplayMenuBegin {_dm _m _x _y} method launchDisplayMenuEnd {} + + #XXX Need to split up menuStatusCB into one method per menu method menuStatusCB {_w} + method modesMenuStatusCB {_w} + method rtCheckMenuStatusCB {_w} + method rtEdgeMenuStatusCB {_w} + method rtMenuStatusCB {_w} + method updateCreationButtons {_on} method updatePrimaryToolbar {} @@ -638,6 +646,7 @@ # bind $dialog <FocusOut> "raise $dialog" $dialog center $w + ::update $dialog activate } @@ -1750,6 +1759,7 @@ } $itk_component(revertDialog) center [namespace tail $this] + ::update if {[$itk_component(revertDialog) activate]} { revert return 1 @@ -2000,7 +2010,7 @@ set le [lindex $l end] if {$le == ""} { - puts "No ledger entry found for $obj." + putString "No ledger entry found for $obj." } else { # Assumed to have mods after the command invocation above $mLedger attr set $le $LEDGER_ENTRY_OUT_OF_SYNC_ATTR 1 @@ -2277,24 +2287,24 @@ foreach dname {ul ur ll lr} { set dm [$_comp component $dname] - set win [$dm component dm] + set win $dm if {$mViewOnly} { bind $win <Control-ButtonPress-1> \ - "[::itcl::code $this launchDisplayMenuBegin $dm [$itk_component(canvas_menu) component view-menu] %X %Y]; break" + "[::itcl::code $this launchDisplayMenuBegin $dname [$itk_component(canvas_menu) component view-menu] %X %Y]; break" bind $win <3> \ - "[::itcl::code $this launchDisplayMenuBegin $dm [$itk_component(canvas_menu) component view-menu] %X %Y]; break" + "[::itcl::code $this launchDisplayMenuBegin $dname [$itk_component(canvas_menu) component view-menu] %X %Y]; break" } else { if {$ArcherCore::inheritFromToplevel} { bind $win <Control-ButtonPress-1> \ - "[::itcl::code $this launchDisplayMenuBegin $dm $itk_component(displaymenu) %X %Y]; break" + "[::itcl::code $this launchDisplayMenuBegin $dname $itk_component(displaymenu) %X %Y]; break" bind $win <3> \ - "[::itcl::code $this launchDisplayMenuBegin $dm $itk_component(displaymenu) %X %Y]; break" + "[::itcl::code $this launchDisplayMenuBegin $dname $itk_component(displaymenu) %X %Y]; break" } else { bind $win <Control-ButtonPress-1> \ - "[::itcl::code $this launchDisplayMenuBegin $dm [$itk_component(menubar) component display-menu] %X %Y]; break" + "[::itcl::code $this launchDisplayMenuBegin $dname [$itk_component(menubar) component display-menu] %X %Y]; break" bind $win <3> \ - "[::itcl::code $this launchDisplayMenuBegin $dm [$itk_component(menubar) component display-menu] %X %Y]; break" + "[::itcl::code $this launchDisplayMenuBegin $dname [$itk_component(menubar) component display-menu] %X %Y]; break" } } } @@ -2362,6 +2372,7 @@ } ::itcl::body Archer::selectNode {tags {rflag 1}} { + set mLastTags $tags set tags [split $tags ":"] if {[llength $tags] > 1} { set element [lindex $tags 1] @@ -2421,15 +2432,23 @@ # label the object if it's being drawn set mRenderMode [gedCmd how $node] - if {$mShowPrimitiveLabels && 0 <= $mRenderMode} { - gedCmd configure -primitiveLabels $node - } else { - gedCmd configure -primitiveLabels {} + if {$mShowPrimitiveLabels} { + if {0 <= $mRenderMode} { + gedCmd configure -primitiveLabels $node + } else { + gedCmd configure -primitiveLabels {} + } } - if {$rflag} { - gedCmd refresh - } +# if {$mShowPrimitiveLabels && 0 <= $mRenderMode} { +# gedCmd configure -primitiveLabels $node +# } else { +# gedCmd configure -primitiveLabels {} +# } +# +# if {$rflag} { +# gedCmd refresh +# } set mPrevSelectedObjPath $mSelectedObjPath set mPrevSelectedObj $mSelectedObj @@ -3576,7 +3595,7 @@ -state disabled $itk_component(displaymenu) add command \ -label "Clear" \ - -command [::itcl::code $this clear] \ + -command [::itcl::code $this zap] \ -state disabled $itk_component(displaymenu) add command \ -label "Refresh" \ @@ -3707,13 +3726,17 @@ # set up bindings for status bind $itk_component(filemenu) <<MenuSelect>> [::itcl::code $this menuStatusCB %W] -# bind $itk_component(importMenu) <<MenuSelect>> [::itcl::code $this menuStatusCB %W] -# bind $itk_component(exportMenu) <<MenuSelect>> [::itcl::code $this menuStatusCB %W] bind $itk_component(displaymenu) <<MenuSelect>> [::itcl::code $this menuStatusCB %W] + bind $itk_component(backgroundmenu) <<MenuSelect>> [::itcl::code $this menuStatusCB %W] bind $itk_component(stdviewsmenu) <<MenuSelect>> [::itcl::code $this menuStatusCB %W] - bind $itk_component(modesmenu) <<MenuSelect>> [::itcl::code $this menuStatusCB %W] + bind $itk_component(modesmenu) <<MenuSelect>> [::itcl::code $this modesMenuStatusCB %W] bind $itk_component(activepanemenu) <<MenuSelect>> [::itcl::code $this menuStatusCB %W] bind $itk_component(helpmenu) <<MenuSelect>> [::itcl::code $this menuStatusCB %W] + + bind $itk_component(raytracemenu) <<MenuSelect>> [::itcl::code $this menuStatusCB %W] + bind $itk_component(rtmenu) <<MenuSelect>> [::itcl::code $this rtMenuStatusCB %W] + bind $itk_component(rtcheckmenu) <<MenuSelect>> [::itcl::code $this rtCheckMenuStatusCB %W] + bind $itk_component(rtedgemenu) <<MenuSelect>> [::itcl::code $this rtEdgeMenuStatusCB %W] } @@ -3790,6 +3813,7 @@ # bind $itk_component(aboutDialog) <FocusOut> "raise $itk_component(aboutDialog)" $itk_component(aboutDialog) center [namespace tail $this] + ::update $itk_component(aboutDialog) activate } @@ -3806,22 +3830,23 @@ ::itcl::body Archer::launchDisplayMenuBegin {_dm _m _x _y} { - set currentDisplay $_dm + set mCurrentPaneName $_dm tk_popup $_m $_x $_y after idle [::itcl::code $this launchDisplayMenuEnd] } ::itcl::body Archer::launchDisplayMenuEnd {} { - set currentDisplay "" +# set mCurrentPaneName "" } -::itcl::body Archer::menuStatusCB {w} { +::itcl::body Archer::menuStatusCB {_w} { if {$mDoStatus} { # entry might not support -label (i.e. tearoffs) - if {[catch {$w entrycget active -label} op]} { + if {[catch {$_w entrycget active -label} op]} { set op "" } + set validOp 1 switch -- $op { "New..." { set mStatusStr "Create a new target description" @@ -3832,21 +3857,12 @@ "Save" { set mStatusStr "Save the current target description" } - "Basic" { - set mStatusStr "Basic user mode" + "Revert" { + set mStatusStr "Discard all edits waiting to be saved" } - "Intermediate" { - set mStatusStr "Intermediate user mode" + "Raytrace Control Panel..." { + set mStatusStr "Launch the raytrace control panel" } - "Advanced" { - set mStatusStr "Advanced user mode" - } - "Fastgen 4 Import..." { - set mStatusStr "Import from a Fastgen 4 file" - } - "Fastgen 4 Export..." { - set mStatusStr "Export to a Fastgen 4 file" - } "Close" { set mStatusStr "Close the current target description" } @@ -3895,14 +3911,14 @@ "View Controls" { set mStatusStr "Toggle on/off view toolbar" } - "Status Bar" { - set mStatusStr "Toggle on/off status bar" + "About Archer..." { + set mStatusStr "Info about Archer" } - "Command Window" { - set mStatusStr "Toggle on/off command window" + "Archer Help..." { + set mStatusStr "Help for Archer" } - "About..." { - set mStatusStr "Info about ArcherCore" + "About Plug-ins..." { + set mStatusStr "Info about Archer's plugins" } "Mouse Mode Overrides..." { set mStatusStr "Mouse mode override definitions" @@ -3919,6 +3935,65 @@ "Lower Right" { set mStatusStr "Set the active pane to the lower right pane" } + "File" { + set mStatusStr "" + } + "View" { + set mStatusStr "" + } + "Modes" { + set mStatusStr "" + } + "Help" { + set mStatusStr "" + } + "Black" { + set mStatusStr "Set the display background color to black" + } + "Grey" { + set mStatusStr "Set the display background color to grey" + } + "White" { + set mStatusStr "Set the display background color to white" + } + "Cyan" { + set mStatusStr "Set the display background color to cyan" + } + "Blue" { + set mStatusStr "Set the display background color to blue" + } + "Clear" { + set mStatusStr "Clear the display" + } + "Refresh" { + set mStatusStr "Refresh the display" + } + "nirt" { + set mStatusStr "Run nirt on the displayed geometry" + } + default { + set validOp 0 + set mStatusStr "" + } + } + + if {!$validOp} { + ArcherCore::menuStatusCB $_w + } + } +} + +::itcl::body Archer::modesMenuStatusCB {_w} { + if {$mDoStatus} { + # entry might not support -label (i.e. tearoffs) + if {[catch {$_w entrycget active -label} op]} { + set op "" + } + + switch -- $op { + "Active Pane" { + set mStatusStr "" + } "Quad View" { set mStatusStr "Toggle between single and multiple geometry pane mode" } @@ -3928,30 +4003,96 @@ "Model Axes" { set mStatusStr "Hide/Show model axes" } - "File" { - set mStatusStr "" + "Ground Plane" { + set mStatusStr "Hide/Show ground plane" } - "View" { + "Primitive Labels" { + set mStatusStr "Hide/Show primitive labels" + } + "Viewing Parameters" { + set mStatusStr "Hide/Show viewing parameters" + } + "Scale" { + set mStatusStr "Hide/Show view scale" + } + "Lighting" { + set mStatusStr "Toggle lighting on/off " + } + default { set mStatusStr "" } - "Modes" { + } + } +} + +::itcl::body Archer::rtCheckMenuStatusCB {_w} { + if {$mDoStatus} { + # entry might not support -label (i.e. tearoffs) + if {[catch {$_w entrycget active -label} op]} { + set op "" + } + + switch -- $op { + "50x50" { + set mStatusStr "Run rtcheck with a size of 50 on the displayed geometry" + } + "100x100" { + set mStatusStr "Run rtcheck with a size of 100 on the displayed geometry" + } + "256x256" { + set mStatusStr "Run rtcheck with a size of 256 on the displayed geometry" + } + "512x512" { + set mStatusStr "Run rtcheck with a size of 512 on the displayed geometry" + } + default { set mStatusStr "" } - "Help" { + } + } +} + +::itcl::body Archer::rtEdgeMenuStatusCB {_w} { + if {$mDoStatus} { + # entry might not support -label (i.e. tearoffs) + if {[catch {$_w entrycget active -label} op]} { + set op "" + } + + switch -- $op { + "512x512" { + set mStatusStr "Run rtedge with a size of 512 on the displayed geometry" + } + "1024x1024" { + set mStatusStr "Run rtedge with a size of 1024 on the displayed geometry" + } + "Window Size" { + set mStatusStr "Run rtedge with a size of \"window size\" on the displayed geometry" + } + default { set mStatusStr "" } - "Wireframe" { - set mStatusStr "Draw object as wireframe" + } + } +} + +::itcl::body Archer::rtMenuStatusCB {_w} { + if {$mDoStatus} { + # entry might not support -label (i.e. tearoffs) + if {[catch {$_w entrycget active -label} op]} { + set op "" + } + + switch -- $op { + "512x512" { + set mStatusStr "Run rt with a size of 512 on the displayed geometry" } - "Shaded (Mode 1)" { - set mStatusStr "Draw object as shaded if a bot or polysolid (unevalutated)" + "1024x1024" { + set mStatusStr "Run rt with a size of 1024 on the displayed geometry" } - "Shaded (Mode 2)" { - set mStatusStr "Draw object as shaded (unevalutated)" + "Window Size" { + set mStatusStr "Run rt with a size of \"window size\" on the displayed geometry" } - "Off" { - set mStatusStr "Erase object" - } default { set mStatusStr "" } @@ -3959,8 +4100,8 @@ } } -::itcl::body Archer::updateCreationButtons {on} { - if {$on} { +::itcl::body Archer::updateCreationButtons {_on} { + if {$_on} { $itk_component(primaryToolbar) itemconfigure arb6 -state normal $itk_component(primaryToolbar) itemconfigure arb8 -state normal $itk_component(primaryToolbar) itemconfigure cone -state normal @@ -4518,7 +4659,7 @@ $itk_component(menubar) menuconfigure .display.standard.45,45 \ -command [::itcl::code $this doAe 45 45] $itk_component(menubar) menuconfigure .display.clear \ - -command [::itcl::code $this clear] \ + -command [::itcl::code $this zap] \ -state disabled $itk_component(menubar) menuconfigure .display.refresh \ -command [::itcl::code $this refreshDisplay] \ @@ -6350,6 +6491,7 @@ # bind $dialog <FocusOut> "raise $dialog" $dialog center $w + ::update $dialog activate } @@ -6412,6 +6554,7 @@ wm protocol $dialog WM_DELETE_WINDOW "$dialog deactivate; ::itcl::delete object $dialog" wm geometry $dialog "400x400" $dialog center [namespace tail $this] + ::update $dialog activate } @@ -7105,6 +7248,7 @@ set mModelAxesTickMajorColorPref $mModelAxesTickMajorColor $itk_component(preferencesDialog) center [namespace tail $this] + ::update if {[$itk_component(preferencesDialog) activate]} { applyPreferencesIfDiff } @@ -7177,7 +7321,7 @@ writePreferencesBody $pfile close $pfile } else { - puts "Failed to write the preferences file:\n$pfile" + putString "Failed to write the preferences file:\n$pfile" } } @@ -7898,7 +8042,7 @@ regsub {([^/]+)$} $mSelectedObjPath $gname mSelectedObjPath } } else { - puts "No old name found for $lentry" + putString "No old name found for $lentry" continue } } \ @@ -7911,9 +8055,10 @@ gedCmd attr rm $gname $LEDGER_ENTRY_TYPE_ATTR } - if {$gname == "_GLOBAL"} { - gedCmd refresh - } +# if {$gname == "_GLOBAL"} { +# global_undo_callback +# } + global_undo_callback $gname # Remove the ledger entry $mLedger kill $lentry @@ -7962,6 +8107,10 @@ } } +::itcl::body Archer::global_undo_callback {_gname} { + gedCmd refresh +} + ::itcl::body Archer::ledger_cleanup {} { if {$mLedger == ""} { return @@ -8053,7 +8202,7 @@ regsub {([^/]+)$} $mSelectedObjPath $gname mSelectedObjPath } } else { - puts "No old name found for $lentry" + putString "No old name found for $lentry" continue } } \ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2010-01-29 22:56:43
|
Revision: 37499 http://brlcad.svn.sourceforge.net/brlcad/?rev=37499&view=rev Author: bob1961 Date: 2010-01-29 22:56:25 +0000 (Fri, 29 Jan 2010) Log Message: ----------- Updated the moveWrapper to bypass the ledger stuff if -f is specified. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-01-29 22:52:11 UTC (rev 37498) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-01-29 22:56:25 UTC (rev 37499) @@ -2207,7 +2207,10 @@ return [gedCmd $_cmd] } - if {$alen == 3} { + set fi [lsearch $args "-f"] + set ni [lsearch $args "-n"] + + if {$fi != -1 || $ni != -1} { # Must be using the -n option. If not, an error message # containing the usage string will be returned. return [eval gedCmd $_cmd $args] @@ -2215,7 +2218,7 @@ # Get the list of potentially modified objects. if {$_cmd == "mvall"} { - set mlist [eval gedCmd $_cmd -n $args] + set mlist [lsort -dictionary -unique [eval gedCmd $_cmd -n $args]] } else { set mlist {} } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2010-03-08 21:32:03
|
Revision: 37937 http://brlcad.svn.sourceforge.net/brlcad/?rev=37937&view=rev Author: bob1961 Date: 2010-03-08 21:31:38 +0000 (Mon, 08 Mar 2010) Log Message: ----------- Added a dedication tab to the "About" dialog. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-03-08 19:56:39 UTC (rev 37936) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-03-08 21:31:38 UTC (rev 37937) @@ -2629,9 +2629,6 @@ } {} # BRL-CAD License Info - set fd [open [file join $brlcadDataPath COPYING] r] - set mBrlcadLicenseInfo [read $fd] - close $fd itk_component add brlcadLicenseInfo { ::iwidgets::scrolledtext $itk_component(aboutDialogTabs).brlcadLicenseInfo \ -wrap word \ @@ -2641,14 +2638,16 @@ -background $SystemButtonFace \ -textbackground $SystemButtonFace } {} - $itk_component(brlcadLicenseInfo) insert 0.0 $mBrlcadLicenseInfo + + set brlcadLicenseFile [file join $brlcadDataPath COPYING] + if {![catch {open $brlcadLicenseFile "r"} fd]} { + set brlcadLicenseInfo [read $fd] + close $fd + $itk_component(brlcadLicenseInfo) insert 0.0 $brlcadLicenseInfo + } $itk_component(brlcadLicenseInfo) configure -state disabled # Acknowledgement Info - # set fd [open [file join $env(ARCHER_HOME) $brlcadDataPath doc archer_ack.txt] r] - set fd [open [file join $brlcadDataPath doc archer_ack.txt] r] - set mAckInfo [read $fd] - close $fd itk_component add ackInfo { ::iwidgets::scrolledtext $itk_component(aboutDialogTabs).info \ -wrap word \ @@ -2658,35 +2657,69 @@ -background $SystemButtonFace \ -textbackground $SystemButtonFace } {} - $itk_component(ackInfo) insert 0.0 $mAckInfo + + set ackFile [file join $brlcadDataPath doc archer_ack.txt] + if {![catch {open $ackFile "r"} fd]} { + set ackInfo [read $fd] + close $fd + $itk_component(ackInfo) insert 0.0 $ackInfo + } $itk_component(ackInfo) configure -state disabled + itk_component add mikeF { + ::frame $itk_component(aboutDialogTabs).mikeInfo + } {} + + set mikeImg [image create photo -file [file join $brlcadDataPath tclscripts mged mike-tux.png]] + itk_component add mikePic { + ::label $itk_component(mikeF).pic \ + -image $mikeImg + } {} + + set row 0 + grid $itk_component(mikePic) -row $row -sticky ew + + itk_component add mikeDates { + label $itk_component(mikeF).dates \ + -text "Michael John Muuss\nOctober 16, 1958 - November 20, 2000" + } {} + + incr row + grid $itk_component(mikeDates) -row $row -sticky ew + + itk_component add mikeInfo { + ::iwidgets::scrolledtext $itk_component(mikeF).info \ + -wrap word \ + -hscrollmode dynamic \ + -vscrollmode dynamic \ + -textfont $mFontText \ + -background $SystemButtonFace \ + -textbackground $SystemButtonFace + } {} + + set mikeInfoFile [file join $brlcadDataPath tclscripts mged mike-dedication.txt] + if {![catch {open $mikeInfoFile "r"} fd]} { + set mikeInfo [read -nonewline $fd] + close $fd + $itk_component(mikeInfo) insert 0.0 $mikeInfo + } + + incr row + grid $itk_component(mikeInfo) -row $row -sticky nsew + + grid columnconfigure $itk_component(mikeF) 0 -weight 1 + grid rowconfigure $itk_component(mikeF) $row -weight 1 + $itk_component(aboutDialogTabs) add $itk_component(aboutInfo) -text "About" -stick ns $itk_component(aboutDialogTabs) add $itk_component(brlcadLicenseInfo) -text "License" $itk_component(aboutDialogTabs) add $itk_component(ackInfo) -text "Acknowledgements" + $itk_component(aboutDialogTabs) add $itk_component(mikeF) -text "Dedication" - # Version Info - itk_component add versionInfo { - ::ttk::label $parent.versionInfo \ - -text "Version: $mArcherVersion" \ - -padding 0 \ - -font $mFontText \ - -anchor se - } {} - $itk_component(aboutDialog) configure -background $LABEL_BACKGROUND_COLOR - pack $itk_component(versionInfo) \ - -expand yes \ - -fill x \ - -side bottom \ - -pady 0 \ - -ipady 0 \ - -anchor se - pack $itk_component(aboutDialogTabs) -expand yes -fill both - wm geometry $itk_component(aboutDialog) "600x540" + wm geometry $itk_component(aboutDialog) "600x600" } ::itcl::body Archer::buildBackgroundColor {parent} { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2010-03-10 22:54:46
|
Revision: 37996 http://brlcad.svn.sourceforge.net/brlcad/?rev=37996&view=rev Author: bob1961 Date: 2010-03-10 22:54:40 +0000 (Wed, 10 Mar 2010) Log Message: ----------- Updated the writePreferencesBody method to write out settings for the grid. Updated the handleObjCenter and endObjTranslate methods to snap the view points to the grid. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-03-10 22:51:50 UTC (rev 37995) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-03-10 22:54:40 UTC (rev 37996) @@ -319,11 +319,11 @@ method beginObjScale {} method beginObjTranslate {} method beginObjCenter {} - method endObjCenter {_dm _obj} + method endObjCenter {_obj} method endObjRotate {_dm _obj} method endObjScale {_dm _obj} - method endObjTranslate {_dm _obj} - method handleObjCenter {_obj _x _y} + method endObjTranslate {_dm _obj _mx _my} + method handleObjCenter {_dm _obj _mx _my} # Object Views Section @@ -5547,7 +5547,7 @@ bind $win <1> "$itk_component(ged) pane_otranslate_mode $dname $obj %x %y; break" } - bind $win <ButtonRelease-1> "[::itcl::code $this endObjTranslate $dname $obj]; break" + bind $win <ButtonRelease-1> "[::itcl::code $this endObjTranslate $dname $obj %x %y]; break" } } @@ -5572,12 +5572,12 @@ foreach dname {ul ur ll lr} { set win [$itk_component(ged) component $dname] - bind $win <1> "[::itcl::code $this handleObjCenter $obj %x %y]; break" - bind $win <ButtonRelease-1> "[::itcl::code $this endObjCenter $dname $obj]; break" + bind $win <1> "[::itcl::code $this handleObjCenter $dname $obj %x %y]; break" + bind $win <ButtonRelease-1> "[::itcl::code $this endObjCenter $obj]; break" } } -::itcl::body Archer::endObjCenter {dname obj} { +::itcl::body Archer::endObjCenter {_obj} { if {![info exists itk_component(ged)]} { return } @@ -5585,8 +5585,8 @@ updateObjSave initEdit 0 - set center [$itk_component(ged) ocenter $obj] - addHistory "ocenter $center" + set center [$itk_component(ged) ocenter $_obj] + addHistory "ocenter $_obj $center" } ::itcl::body Archer::endObjRotate {dname obj} { @@ -5619,37 +5619,47 @@ } } -::itcl::body Archer::endObjTranslate {dname obj} { +::itcl::body Archer::endObjTranslate {_dm _obj _mx _my} { if {![info exists itk_component(ged)]} { return } - $itk_component(ged) pane_idle_mode $dname - updateObjSave - initEdit 0 + $itk_component(ged) pane_idle_mode $_dm + handleObjCenter $_dm $_obj $_mx $_my + endObjCenter $_obj - #XXX Need code to track overall transformation - #addHistory "otranslate obj dx dy dz" +# $itk_component(ged) pane_idle_mode $_dm +# updateObjSave +# initEdit 0 + } -::itcl::body Archer::handleObjCenter {obj x y} { - set ocenter [gedCmd ocenter $obj] +::itcl::body Archer::handleObjCenter {_dm _obj _mx _my} { + set ocenter [gedCmd ocenter $_obj] set ocenter [vscale $ocenter [gedCmd local2base]] - set ovcenter [eval gedCmd m2v_point $ocenter] + set ovcenter [eval gedCmd pane_m2v_point $_dm $ocenter] # This is the updated view center (i.e. we keep the original view Z) - set vcenter [gedCmd screen2view $x $y] - set vcenter [list [lindex $vcenter 0] [lindex $vcenter 1] [lindex $ovcenter 2]] + set vcenter [gedCmd pane_screen2view $_dm $_mx $_my] - set ocenter [vscale [eval gedCmd v2m_point $vcenter] [gedCmd base2local]] + set vx [lindex $vcenter 0] + set vy [lindex $vcenter 1] + set vl [gedCmd pane_snap_view $_dm $vx $vy] + set vx [lindex $vl 0] + set vy [lindex $vl 1] + set vcenter [list $vx $vy [lindex $ovcenter 2]] +# set vcenter [list [lindex $vcenter 0] [lindex $vcenter 1] [lindex $ovcenter 2]] + + set ocenter [vscale [eval gedCmd pane_v2m_point $_dm $vcenter] [gedCmd base2local]] + if {$GeometryEditFrame::mEditCommand != ""} { - gedCmd $GeometryEditFrame::mEditCommand $obj $GeometryEditFrame::mEditParam1 $ocenter + gedCmd $GeometryEditFrame::mEditCommand $_obj $GeometryEditFrame::mEditParam1 $ocenter } else { - eval gedCmd ocenter $obj $ocenter + eval gedCmd ocenter $_obj $ocenter } - redrawObj $obj 0 + redrawObj $_obj 0 initEdit 0 } @@ -7671,6 +7681,13 @@ puts $_pfile "set mViewingParamsColor \"$mViewingParamsColor\"" puts $_pfile "set mTheme \"$mTheme\"" + puts $_pfile "set mGridAnchor \"$mGridAnchor\"" + puts $_pfile "set mGridColor \"$mGridColor\"" + puts $_pfile "set mGridMrh \"$mGridMrh\"" + puts $_pfile "set mGridMrv \"$mGridMrv\"" + puts $_pfile "set mGridRh \"$mGridRh\"" + puts $_pfile "set mGridRv \"$mGridRv\"" + puts $_pfile "set mGroundPlaneMajorColor \"$mGroundPlaneMajorColor\"" puts $_pfile "set mGroundPlaneMinorColor \"$mGroundPlaneMinorColor\"" puts $_pfile "set mGroundPlaneInterval \"$mGroundPlaneInterval\"" This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2010-03-15 14:42:23
|
Revision: 38056 http://brlcad.svn.sourceforge.net/brlcad/?rev=38056&view=rev Author: bob1961 Date: 2010-03-15 14:42:16 +0000 (Mon, 15 Mar 2010) Log Message: ----------- Added toolbar buttons for the framebuffer and raytracing. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-03-15 14:40:25 UTC (rev 38055) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-03-15 14:42:16 UTC (rev 38056) @@ -298,6 +298,7 @@ method updateCreationButtons {_on} method updatePrimaryToolbar {} + method updateRaytraceButtons {_on} method buildEmbeddedMenubar {} method buildEmbeddedFileMenu {} @@ -494,6 +495,7 @@ readPreferences updateCreationButtons 0 + updateRaytraceButtons 0 updateCheckpointMode updateSaveMode updateUndoMode @@ -1487,6 +1489,7 @@ # createTargetLedger updateCreationButtons 1 + updateRaytraceButtons 1 buildGroundPlane showGroundPlane @@ -1740,6 +1743,19 @@ -image [image create photo \ -file [file join $dir option_tree.png]] } + + $itk_component(primaryToolbar) itemconfigure toggle_fb \ + -image [image create photo \ + -file [file join $dir framebuffer.png]] + $itk_component(primaryToolbar) itemconfigure raytrace \ + -image [image create photo \ + -file [file join $dir raytrace.png]] + $itk_component(primaryToolbar) itemconfigure abort \ + -image [image create photo \ + -file [file join $dir raytrace_abort.png]] + $itk_component(primaryToolbar) itemconfigure clear_fb \ + -image [image create photo \ + -file [file join $dir framebuffer_clear.png]] } ::itcl::body Archer::setDefaultBindingMode {_mode} { @@ -4355,6 +4371,28 @@ } } +::itcl::body Archer::updateRaytraceButtons {_on} { + if {$_on} { + $itk_component(primaryToolbar) itemconfigure toggle_fb \ + -state normal \ + -command "$itk_component(rtcntrl) toggleFB" + $itk_component(primaryToolbar) itemconfigure raytrace \ + -state normal \ + -command "$itk_component(rtcntrl) raytracePlus" + $itk_component(primaryToolbar) itemconfigure abort \ + -state normal \ + -command "$itk_component(rtcntrl) abort" + $itk_component(primaryToolbar) itemconfigure clear_fb \ + -state normal \ + -command "$itk_component(rtcntrl) clear" + } else { + $itk_component(primaryToolbar) itemconfigure toggle_fb -state disabled + $itk_component(primaryToolbar) itemconfigure raytrace -state disabled + $itk_component(primaryToolbar) itemconfigure abort -state disabled + $itk_component(primaryToolbar) itemconfigure clear_fb -state disabled + } +} + ::itcl::body Archer::updatePrimaryToolbar {} { # Populate the primary toolbar $itk_component(primaryToolbar) insert 0 button new \ @@ -4734,6 +4772,43 @@ $itk_component(primaryToolbar) itemconfigure edit_translate -state disabled $itk_component(primaryToolbar) itemconfigure edit_scale -state disabled $itk_component(primaryToolbar) itemconfigure edit_center -state disabled + + # add spacer + $itk_component(primaryToolbar) add frame fill12 \ + -relief flat \ + -width 3 + $itk_component(primaryToolbar) add frame sep6 \ + -relief sunken \ + -width 2 + $itk_component(primaryToolbar) add frame fill13 \ + -relief flat \ + -width 3 + + $itk_component(primaryToolbar) add button toggle_fb \ + -state disabled \ + -balloonstr "Toggle framebuffer" \ + -helpstr "Toggle framebuffer" \ + -relief flat \ + -overrelief raised + $itk_component(primaryToolbar) add button raytrace \ + -state disabled \ + -balloonstr "Raytrace current view" \ + -helpstr "Raytrace current view" \ + -relief flat \ + -overrelief raised + $itk_component(primaryToolbar) add button abort \ + -state disabled \ + -balloonstr "Abort raytrace" \ + -helpstr "Abort raytrace" \ + -relief flat \ + -overrelief raised + $itk_component(primaryToolbar) add button clear_fb \ + -state disabled \ + -balloonstr "Clear framebuffer" \ + -helpstr "Clear framebuffer" \ + -relief flat \ + -overrelief raised + } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2010-03-16 13:55:35
|
Revision: 38073 http://brlcad.svn.sourceforge.net/brlcad/?rev=38073&view=rev Author: bob1961 Date: 2010-03-16 13:55:23 +0000 (Tue, 16 Mar 2010) Log Message: ----------- Added code to toggle the image of the framebuffer enable button when the state changes. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-03-16 13:51:53 UTC (rev 38072) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-03-16 13:55:23 UTC (rev 38073) @@ -289,6 +289,8 @@ method doArcherHelp {} method launchDisplayMenuBegin {_dm _m _x _y} method launchDisplayMenuEnd {} + method fbEnabledCallback {_on} + method fbToggle {} #XXX Need to split up menuStatusCB into one method per menu method menuStatusCB {_w} @@ -4088,6 +4090,26 @@ # set mCurrentPaneName "" } +::itcl::body Archer::fbEnabledCallback {_on} { + set dir [file join $mImgDir Themes $mTheme] + + if {$_on} { + $itk_component(primaryToolbar) itemconfigure toggle_fb \ + -image [image create photo \ + -file [file join $dir framebuffer_off.png]] + } else { + $itk_component(primaryToolbar) itemconfigure toggle_fb \ + -image [image create photo \ + -file [file join $dir framebuffer.png]] + } +} + +::itcl::body Archer::fbToggle {} { + $itk_component(rtcntrl) toggleFB + set on [$itk_component(rtcntrl) cget -fb_enabled] + fbEnabledCallback $on +} + ::itcl::body Archer::menuStatusCB {_w} { if {$mDoStatus} { # entry might not support -label (i.e. tearoffs) @@ -4375,7 +4397,7 @@ if {$_on} { $itk_component(primaryToolbar) itemconfigure toggle_fb \ -state normal \ - -command "$itk_component(rtcntrl) toggleFB" + -command [::itcl::code $this fbToggle] $itk_component(primaryToolbar) itemconfigure raytrace \ -state normal \ -command "$itk_component(rtcntrl) raytracePlus" @@ -4385,6 +4407,9 @@ $itk_component(primaryToolbar) itemconfigure clear_fb \ -state normal \ -command "$itk_component(rtcntrl) clear" + + $itk_component(rtcntrl) configure \ + -fb_enabled_callback [::itcl::code $this fbEnabledCallback] } else { $itk_component(primaryToolbar) itemconfigure toggle_fb -state disabled $itk_component(primaryToolbar) itemconfigure raytrace -state disabled @@ -4790,6 +4815,12 @@ -helpstr "Toggle framebuffer" \ -relief flat \ -overrelief raised + $itk_component(primaryToolbar) add button clear_fb \ + -state disabled \ + -balloonstr "Clear framebuffer" \ + -helpstr "Clear framebuffer" \ + -relief flat \ + -overrelief raised $itk_component(primaryToolbar) add button raytrace \ -state disabled \ -balloonstr "Raytrace current view" \ @@ -4802,13 +4833,6 @@ -helpstr "Abort raytrace" \ -relief flat \ -overrelief raised - $itk_component(primaryToolbar) add button clear_fb \ - -state disabled \ - -balloonstr "Clear framebuffer" \ - -helpstr "Clear framebuffer" \ - -relief flat \ - -overrelief raised - } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bo...@us...> - 2010-03-16 18:04:59
|
Revision: 38079 http://brlcad.svn.sourceforge.net/brlcad/?rev=38079&view=rev Author: bob1961 Date: 2010-03-16 18:04:52 +0000 (Tue, 16 Mar 2010) Log Message: ----------- Consolidated the raytrace and abort toolbar buttons. Modified Paths: -------------- brlcad/trunk/src/tclscripts/archer/Archer.tcl Modified: brlcad/trunk/src/tclscripts/archer/Archer.tcl =================================================================== --- brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-03-16 18:03:17 UTC (rev 38078) +++ brlcad/trunk/src/tclscripts/archer/Archer.tcl 2010-03-16 18:04:52 UTC (rev 38079) @@ -291,6 +291,8 @@ method launchDisplayMenuEnd {} method fbEnabledCallback {_on} method fbToggle {} + method rtEndCallback {_aborted} + method raytracePlus {} #XXX Need to split up menuStatusCB into one method per menu method menuStatusCB {_w} @@ -1753,9 +1755,6 @@ $itk_component(primaryToolbar) itemconfigure raytrace \ -image [image create photo \ -file [file join $dir raytrace.png]] - $itk_component(primaryToolbar) itemconfigure abort \ - -image [image create photo \ - -file [file join $dir raytrace_abort.png]] $itk_component(primaryToolbar) itemconfigure clear_fb \ -image [image create photo \ -file [file join $dir framebuffer_clear.png]] @@ -4110,6 +4109,23 @@ fbEnabledCallback $on } +::itcl::body Archer::rtEndCallback {_aborted} { + set dir [file join $mImgDir Themes $mTheme] + $itk_component(primaryToolbar) itemconfigure raytrace \ + -image [image create photo \ + -file [file join $dir raytrace.png]] \ + -command [::itcl::code $this raytracePlus] +} + +::itcl::body Archer::raytracePlus {} { + set dir [file join $mImgDir Themes $mTheme] + $itk_component(primaryToolbar) itemconfigure raytrace \ + -image [image create photo \ + -file [file join $dir raytrace_abort.png]] \ + -command "$itk_component(rtcntrl) abort" + $itk_component(rtcntrl) raytracePlus +} + ::itcl::body Archer::menuStatusCB {_w} { if {$mDoStatus} { # entry might not support -label (i.e. tearoffs) @@ -4400,20 +4416,18 @@ -command [::itcl::code $this fbToggle] $itk_component(primaryToolbar) itemconfigure raytrace \ -state normal \ - -command "$itk_component(rtcntrl) raytracePlus" - $itk_component(primaryToolbar) itemconfigure abort \ - -state normal \ - -command "$itk_component(rtcntrl) abort" + -command [::itcl::code $this raytracePlus] $itk_component(primaryToolbar) itemconfigure clear_fb \ -state normal \ -command "$itk_component(rtcntrl) clear" $itk_component(rtcntrl) configure \ -fb_enabled_callback [::itcl::code $this fbEnabledCallback] + + gedCmd rt_end_callback [::itcl::code $this rtEndCallback] } else { $itk_component(primaryToolbar) itemconfigure toggle_fb -state disabled $itk_component(primaryToolbar) itemconfigure raytrace -state disabled - $itk_component(primaryToolbar) itemconfigure abort -state disabled $itk_component(primaryToolbar) itemconfigure clear_fb -state disabled } } @@ -4827,12 +4841,6 @@ -helpstr "Raytrace current view" \ -relief flat \ -overrelief raised - $itk_component(primaryToolbar) add button abort \ - -state disabled \ - -balloonstr "Abort raytrace" \ - -helpstr "Abort raytrace" \ - -relief flat \ - -overrelief raised } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |