Revision: 54035
http://brlcad.svn.sourceforge.net/brlcad/?rev=54035&view=rev
Author: bob1961
Date: 2012-12-10 21:50:12 +0000 (Mon, 10 Dec 2012)
Log Message:
-----------
More updates for Archer's sketch editor. This adds functionality to delete
points and segments.
Modified Paths:
--------------
brlcad/trunk/src/tclscripts/archer/SketchEditFrame.tcl
Modified: brlcad/trunk/src/tclscripts/archer/SketchEditFrame.tcl
===================================================================
--- brlcad/trunk/src/tclscripts/archer/SketchEditFrame.tcl 2012-12-10
17:53:36 UTC (rev 54034)
+++ brlcad/trunk/src/tclscripts/archer/SketchEditFrame.tcl 2012-12-10
21:50:12 UTC (rev 54035)
@@ -151,10 +151,12 @@
method continue_move {_state _sx _sy}
method create_line {}
method end_arc_radius_adjust {_segment _mx _my}
+ method fix_vertex_references {_unused_vindices}
method item_pick_highlight {_sx _sy}
method pick_arbitrary {_sx _sy}
method pick_segment {_sx _sy}
method pick_vertex {_sx _sy}
+ method seg_delete {_sx _sy _vflag}
method seg_pick_highlight {_sx _sy}
method setup_move_arbitrary {}
method setup_move_point {}
@@ -172,6 +174,8 @@
method start_vert_pick {}
method tag_selected_verts {}
method unhighlight_selected {}
+ method vert_delete {_sx _sy}
+ method vert_is_used {_vindex}
method vert_pick_highlight {_sx _sy}
method write_sketch_to_db {}
}
@@ -548,7 +552,7 @@
set seg [lrange $seg 1 end]
switch $type {
line {
- lappend segments [SketchLine \#auto $this
$itk_component(canvas) $seg]
+ lappend segments ::SketchEditFrame::[SketchLine \#auto $this
$itk_component(canvas) $seg]
}
carc {
set index [lsearch -exact $seg R]
@@ -558,10 +562,10 @@
set tmp_radius [expr {$tolocal * $tmp_radius}]
set seg [lreplace $seg $index $index $tmp_radius]
}
- lappend segments [SketchCArc \#auto $this
$itk_component(canvas) $seg]
+ lappend segments ::SketchEditFrame::[SketchCArc \#auto $this
$itk_component(canvas) $seg]
}
bezier {
- lappend segments [SketchBezier \#auto $this
$itk_component(canvas) $seg]
+ lappend segments ::SketchEditFrame::[SketchBezier \#auto $this
$itk_component(canvas) $seg]
}
default {
$::ArcherCore::application putString "Curve segments of type
'$type' are not yet handled"
@@ -925,6 +929,14 @@
}
+::itcl::body SketchEditFrame::fix_vertex_references {_unused_vindices} {
+ foreach seg $segments {
+ $seg fix_vertex_reference $_unused_vindices
+ }
+ drawVertices
+}
+
+
::itcl::body SketchEditFrame::item_pick_highlight {_sx _sy} {
set item [pick_arbitrary $_sx $_sy]
if {$item == -1} return
@@ -988,6 +1000,7 @@
if {[lsearch -exact $tags segs] == -1} {
return -1
}
+
return [lindex $tags 0]
}
@@ -1009,6 +1022,30 @@
}
+::itcl::body SketchEditFrame::seg_delete {_sx _sy _vflag} {
+ set item [pick_segment $_sx $_sy]
+ if {$item == -1} return
+
+ set index [lsearch $segments $item]
+ set segments [lreplace $segments $index $index]
+ $itk_component(canvas) delete $item
+
+ if {$_vflag} {
+ set unused_vindices {}
+ foreach vindex [lsort -integer -decreasing [$item get_verts]] {
+ if {![vert_is_used $vindex]} {
+ set VL [lreplace $VL $vindex $vindex]
+ lappend unused_vindices $vindex
+ }
+ }
+ fix_vertex_references $unused_vindices
+ }
+
+ ::destroy $item
+ write_sketch_to_db
+}
+
+
::itcl::body SketchEditFrame::seg_pick_highlight {_sx _sy} {
set item [pick_segment $_sx $_sy]
if {$item == -1} return
@@ -1229,6 +1266,8 @@
bind $itk_component(canvas) <B1-Motion> {}
bind $itk_component(canvas) <ButtonRelease-1> {}
bind $itk_component(canvas) <ButtonPress-1> [code $this seg_pick_highlight
%x %y]
+ bind $itk_component(canvas) <Shift-ButtonPress-1> [code $this seg_delete
%x %y 0]
+ bind $itk_component(canvas) <Control-Shift-ButtonPress-1> [code $this
seg_delete %x %y 1]
}
@@ -1239,6 +1278,7 @@
bind $itk_component(canvas) <B1-Motion> {}
bind $itk_component(canvas) <ButtonRelease-1> {}
bind $itk_component(canvas) <ButtonPress-1> [::itcl::code $this
vert_pick_highlight %x %y]
+ bind $itk_component(canvas) <Shift-ButtonPress-1> [code $this vert_delete
%x %y]
}
@@ -1277,6 +1317,32 @@
}
+::itcl::body SketchEditFrame::vert_delete {_sx _sy} {
+ set index [pick_vertex $_sx $_sy]
+ if {$index == -1} return
+
+ if {[vert_is_used $index]} {
+ $::ArcherCore::application putString \
+ "Cannot delete a vertex being used by a segment."
+ $itk_component(canvas) dtag p$index selected
+ $itk_component(canvas) itemconfigure p$index -outline black -fill black
+ } else {
+ set VL [lreplace $VL $index $index]
+ fix_vertex_references $index
+ }
+}
+
+
+::itcl::body SketchEditFrame::vert_is_used {_vindex} {
+ foreach seg $segments {
+ if {[$seg is_vertex_used $_vindex]} {
+ return 1
+ }
+ }
+ return 0
+}
+
+
::itcl::body SketchEditFrame::vert_pick_highlight {_sx _sy} {
set item [pick_vertex $_sx $_sy]
if {$item == -1} return
@@ -1310,28 +1376,8 @@
set command "adjust $itk_option(-geometryObject)"
if {[catch "$::ArcherCore::application $command $out" ret]} {
- $::ArcherCore::application putString "ERROR Saving Sketch!!!!, $ret"
+ $::ArcherCore::application putString "ERROR Saving
$itk_option(-geometryObject)!!!!, $ret"
}
-
- if {0} {
- set out "V { [expr {$tobase * $V(0)}] [expr {$tobase * $V(1)}] [expr
{$tobase * $V(2)}] }"
- set out "$out A { [expr {$tobase * $A(0)}] [expr {$tobase * $A(1)}] [expr
{$tobase * $A(2)}] }"
- set out "$out B { [expr {$tobase * $B(0)}] [expr {$tobase * $B(1)}] [expr
{$tobase * $B(2)}] } VL {"
- foreach vert $VL {
- set out "$out { [expr {$tobase * [lindex $vert 0]}] [expr {$tobase *
[lindex $vert 1]}] }"
- }
- set out "$out } SL {"
- foreach seg $segments {
- set out "$out [$seg serialize $tobase] "
- }
- set out "$out }"
-
- set command "adjust $itk_option(-geometryObject)"
-
- if {[catch "db $command $out" ret]} {
- $::ArcherCore::application putString "ERROR Saving Sketch!!!!, $ret"
- }
- }
}
This was sent by the SourceForge.net collaborative development platform, the
world's largest Open Source development site.
------------------------------------------------------------------------------
LogMeIn Rescue: Anywhere, Anytime Remote support for IT. Free Trial
Remotely access PCs and mobile devices and provide instant support
Improve your efficiency, and focus on delivering more value-add services
Discover what IT Professionals Know. Rescue delivers
http://p.sf.net/sfu/logmein_12329d2d
_______________________________________________
BRL-CAD Source Commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/brlcad-commits
