开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 图形图像 > 3D图形编程 > 查看源码
registration.tcl
资源名称：scanalyze-1.0.3_source_code.rar　[点击查看]
上传用户：kellyonhid
上传日期：2013-10-12
资源大小：932k
文件大小：37k
源码类别：

3D图形编程

开发平台：

Visual C++

registration.tcl：源码内容
  1. ######################################################################
  2. #
  3. # Global registration UI
  4. #
  5. ######################################################################
  8. proc globalRegistrationDialog {} {
  9.     if {[window_Activate .globalReg]} { return }
  11.     plv_globalreg init_import
  13.     # create UI window
  14.     set gr [toplevel .globalReg]
  15.     wm title $gr "Global registration"
  16.     window_Register $gr
  18.     frame $gr.file -relief groove -border 2
  19.     label $gr.file.l -text "File options" -anchor w
  20.     frame $gr.file.b
  21.     button $gr.file.b.force_reload -text "Reload" 
  22. -command "plv_globalreg re_import"
  23.     button $gr.file.b.delete -text "Delete..." 
  24. -command globalRegDeleteDialog
  25.     packchildren $gr.file.b -side left -fill x -expand true
  26.     packchildren $gr.file -side top -fill x -expand true
  28.     frame $gr.opts -relief groove -border 2
  29.     label $gr.opts.l -text "Render options" -anchor w
  30.     frame $gr.opts.b
  31.     button $gr.opts.b.showpartners -text "Show only partners" 
  32. -command {hideRegistrationNonPartners $theMesh}
  33.     button $gr.opts.b.showgroup -text "Show only group" 
  34. -command {hideRegistrationNonPartners $theMesh transitive}
  35.     packchildren $gr.opts.b -side left -fill x -expand true
  36.     frame $gr.opts.c
  37.     label $gr.opts.c.colorL -text "Color:"
  38.     tk_optionMenu $gr.opts.c.color 
  39. theColorMode gray false registration
  40.     packchildren $gr.opts.c -side left
  41.     packchildren $gr.opts -side top -fill x -expand true
  43.     frame $gr.show -relief groove -border 2
  44.     label $gr.show.l -text "Dump registered pairs" -anchor w
  45.     frame $gr.show.pairwise
  46.     button $gr.show.pairwise.point_point 
  47. -text "Pairwise (point-point)" 
  48. -command { 
  49.     badAlignDialog [plv_globalreg dumpallpairs 0 [.globalReg.show.thresh.entry get]]
  50. }
  51.     button $gr.show.pairwise.point_plane 
  52. -text "Pairwise (point-plane)" 
  53. -command { 
  54.     badAlignDialog [plv_globalreg dumpallpairs 1 [.globalReg.show.thresh.entry get]]
  55. }
  56.     packchildren $gr.show.pairwise -side left -fill x -expand true
  57.     frame $gr.show.dump
  58.     button $gr.show.dump.globalreg -text "Globalreg Error" 
  59. -command { 
  60.     badAlignDialog [plv_globalreg dumpallpairs 2 [.globalReg.show.thresh.entry get]]
  61. }
  62.     button $gr.show.dump.partners -text "Partners" 
  63. -command {dumpRegistrationPartners $theMesh}
  64.     packchildren $gr.show.dump -side left -fill x -expand true
  66. #     frame $gr.show.select
  67. #     button $gr.show.select.gr -text "Worst global to ICP" 
  68. #  -command { puts "Howdy" }
  69. #     button $gr.show.select.pw -text "Worst pairwise to ICP" 
  70. #  -command { 
  71. #      puts "Doody"
  72. #      ICPdialog
  73. #  }
  74. #     packchildren $gr.show.select -side left -fill x -expand true
  76.     frame $gr.show.thresh
  77.     label $gr.show.thresh.l -text "Show offenders threshold (mm):"
  78.     entry  $gr.show.thresh.entry 
  79.   -relief sunken -width 6
  80.     $gr.show.thresh.entry insert end 5
  81.     packchildren $gr.show.thresh -side left
  83.     frame $gr.show.npairs
  84.     label $gr.show.npairs.l -text "Pointpair counts"
  85.     button $gr.show.npairs.curr -text "Current" 
  86. -command {plv_globalreg point_pair_count $theMesh *}
  87.     button $gr.show.npairs.icp  -text "ICP dlg" 
  88. -command {plv_globalreg point_pair_count 
  89.       [globalset regICPFrom] [globalset regICPTo]}
  90.     packchildren $gr.show.npairs -side left -fill x -expand true
  92.     set p [frame $gr.show.part]
  93.     button $p.list -text "List" -command "listFewPartners $p.val"
  94.     label $p.l1 -text "meshes with fewer than"
  95.     entry $p.val -width 3
  96.     $p.val insert end 3
  97.     label $p.l2 -text "partners"
  98.     packchildren $p -side left
  100.     button $gr.show.groups -text "List connected subgroups" 
  101. -command listGroups
  103.     packchildren $gr.show -side top -fill x -expand true
  105.     frame $gr.auto -relief groove -border 2
  107.     set p [frame $gr.auto.choices]
  108.     label $p.lf -text "Auto add pairs: from" -anchor w
  109.     tk_optionMenu $gr.auto.choices.from autoFrom visible current
  110.     label $p.lt -text "to" -anchor w
  111.     tk_optionMenu $p.to autoTo visible all
  112.     packchildren $p -side left -fill x -expand 1
  114.     set f [frame $gr.auto.errorThresh]
  115.     label $f.l -text "Error threshold (mm):"
  116.     entry  $f.entry -relief sunken -width 6
  117.     $f.entry insert end 5
  118.     packchildren $f -side left -pady 2
  120.     set f [frame $gr.auto.nPairs]
  121.     label $f.l -text "Target number of pairs to calculate:"
  122.     entry $f.entry -relief sunken -width 6
  123.     $f.entry insert end 2000
  124.     packchildren $f -side left
  125.     checkbutton $gr.auto.preserve 
  126. -text "Preserve existing mesh pairs (don't recalculate)" 
  127. -variable preserveExistingInAutoAlign -anchor w
  129.     frame $gr.auto.b
  130.     button $gr.auto.b.go 
  131. -text "Go" 
  132. -command {
  133.     scz_auto_register $autoFrom $autoTo $theMesh 
  134. [.globalReg.auto.errorThresh.entry get] 
  135. [.globalReg.auto.nPairs.entry get] 
  136. $preserveExistingInAutoAlign
  137. }
  139.     packchildren $gr.auto.b -side top -anchor c
  141.     packchildren $gr.auto -side top -anchor w -fill x
  143.     frame $gr.reg -relief groove -border 2
  145.     label $gr.reg.l -text "Register:" -anchor w
  147.     frame $gr.reg.b
  148.     button $gr.reg.b.register -text "All<->All" 
  149. -command {doGlobalRegister}
  150.     button $gr.reg.b.register1 -text "Selected->all" 
  151. -command {doGlobalRegister $theMesh}
  152.     button $gr.reg.b.register12 -text "ICP 1->2" 
  153. -command {if {[winfo exists .regICP]} {
  154.     if {[_reg_check2meshes $regICPFrom $regICPTo]} {
  155. doGlobalRegister $regICPFrom $regICPTo
  156.     }
  157. } else {
  158.     tk_messageBox -title "scanalyze" -icon error 
  159. -parent .globalReg 
  160. -message "ICP dialog must be visible."
  161. }}
  162.     packchildren $gr.reg.b -side left -fill x -expand 1
  164.     frame $gr.reg.convTol
  165.     label $gr.reg.convTol.l -text "Convergence Tolerance:"
  166.     entry  $gr.reg.convTol.entry -relief sunken -width 6
  167.     $gr.reg.convTol.entry insert end .01
  168.     packchildren $gr.reg.convTol -side left -pady 2
  170.     packchildren $gr.reg -side top -fill x
  172.     packchildren $gr -side top -fill x -expand true 
  173. -pady 3 -padx 3
  174. }
  177. proc doGlobalRegister {args} {
  178.     eval plv_globalreg register [.globalReg.reg.convTol.entry get] $args
  179.     redraw 1
  180.     update idletasks
  181. }
  184. proc hideRegistrationNonPartners {mesh {trans ""}} {
  185.     if {$trans == ""} {
  186. set vis [plv_globalreg listpairsfor $mesh]
  187.     } else {
  188. set vis [plv_globalreg listpairsfor $mesh transitive]
  189.     }
  191.     eval showOnlyMesh $vis $mesh
  192. }
  195. proc dumpRegistrationPartners {mesh} {
  196.     set partner [plv_globalreg listpairsfor $mesh]
  197.     set trans [plv_globalreg listpairsfor $mesh transitive]
  199.     puts "$mesh is registered to:"
  200.     puts "directly:     $partner"
  201.     puts "transitively: $trans"
  202. }
  205. proc listFewPartners {widget} {
  206.     set min [$widget get]
  208.     foreach mesh [lsort -dictionary [getVisibleMeshes]] {
  209. set part [plv_globalreg getpaircount $mesh]
  210. if {$part < $min} {
  211.     puts "$mesh: $part partners"
  212. }
  213.     }
  214. }
  217. proc listGroups {} {
  218.     plv_globalreg groupstatus
  220.     foreach mesh [lsort -dictionary [getVisibleMeshes]] {
  221. if {![plv_globalreg getpaircount $mesh]} {
  222.     lappend missing $mesh
  223. }
  224.     }
  225.     
  226.     if {[info exists missing]} {
  227. puts "nnot registered at all ([llength $missing]): $missing"
  228.     }
  229. }
  233. ######################################################################
  234. #
  235. # Drag registration UI
  236. #
  237. ######################################################################
  240. proc dragRegistrationDialog {} {
  241.     global dragMeshesLeft
  242.     set dragMeshesLeft [getVisibleMeshes]
  244.     if {[llength $dragMeshesLeft] < 2} {
  245. tk_dialog .err "scanalyze" 
  246.     "You must have at least two meshes visible
  247.              to perform drag registration." "" 0 Ok
  248. return
  249.     }
  251.     set dr [toplevel .dragreg]
  252.     wm title $dr "Drag registration"
  253.     window_Register $dr
  255.     global meshVisible
  256.     foreach mesh $dragMeshesLeft {
  257. changeVis $mesh 0
  258.     }
  260.     frame $dr.cur
  261.     label $dr.cur.curlab -text "Current mesh:"
  262.     label $dr.cur.current -textvariable theMesh
  263.     pack $dr.cur.curlab $dr.cur.current -side left
  264.     pack $dr.cur -side top
  266.     label $dr.instruct 
  267. -text "Drag mesh to correct position, then click Next."
  268.     pack $dr.instruct -side top
  270.     frame $dr.method
  271.     radiobutton $dr.method.ptPt    -text "Point-to-point"
  272. -variable dragRegMethod -value horn
  273.     radiobutton $dr.method.ptPlane -text "Point-to-plane"
  274. -variable dragRegMethod -value chen
  275.     pack $dr.method.ptPt $dr.method.ptPlane -side left
  277.     button $dr.next -text Next -command dragRegNext
  278.     pack $dr.method $dr.next -side top -fill x -expand true
  280.     frame $dr.left
  281.     label $dr.left.leftlab -text "Remaining meshes:"
  282.     label $dr.left.remain -textvariable dragMeshesLeft
  283.     pack $dr.left.leftlab $dr.left.remain -side left
  284.     pack $dr.left -side top
  286.     bind $dr <Destroy> "+destroyDragRegUI %W"
  288.     selectScan ""
  289.     globalset theMover mesh
  290.     dragRegNext
  291. }
  294. proc dragRegNext {} {
  295.     global theMesh
  296.     global dragMeshesLeft
  297.     global meshVisible
  299.     # read z-buffer to get correspondence points, invoke algorithm
  300.     if {0 != [string compare $theMesh ""]} {
  301. if {[llength [getVisibleMeshes]] > 1} {
  302.     DragRegister $theMesh [globalset dragRegMethod]
  303. }
  304.     }
  306.     # on to next mesh:
  307.     # move first element of dragMeshesLeft to theMesh
  308.     selectScan [lindex $dragMeshesLeft 0]
  309.     set dragMeshesLeft [lrange $dragMeshesLeft 1 end]
  311.     # and if there IS a next mesh, make it visible
  312.     if {0 == [string compare $theMesh ""]} {
  313. # done!
  314. destroy .dragreg
  315.     } else {
  316. # make next mesh visible
  317. changeVis $theMesh 1
  318.     }
  319. }
  322. proc destroyDragRegUI {window} {
  323.     if {0 != [string compare $window .dragreg]} {
  324. return
  325.     }
  327.     globalset theMover viewer
  328.     global dragMeshesLeft
  329.     unset dragMeshesLeft
  330. }
  333. ######################################################################
  334. #
  335. # Correspondence registration UI
  336. #
  337. ######################################################################
  340. proc renderParamsChanged {} {
  341.     global correspRegWindows
  342.     if {[array exists correspRegWindows]} {
  343. refreshCorrespRegWindows *
  344.     }
  345. }
  348. proc correspRegistrationDialog {} {
  349.     global meshVisible
  350.     global uniqueInt
  351.     global toglPane
  352.     
  353.     if {[array size meshVisible] < 2} {
  354. tk_dialog .err "scanalyze" 
  355.     "You must have at least two meshes loaded
  356.              to perform registration." "" 0 Ok
  357. return
  358.     }
  360.     toplevel .reg
  362.     set which [frame .reg.which]
  363.     set meshFrom [eval tk_optionMenu $which.mFrom regCorrespFrom bogus]
  364.     set meshTo [eval tk_optionMenu $which.mTo regCorrespTo bogus]
  365.     $which.mFrom config -pady 4
  366.     $which.mTo config -pady 4
  368.     set winid 1
  369.     foreach meshMenu "$meshFrom $meshTo" {
  370. listRegMeshes $meshMenu
  371. bindCorrespRegMeshSelector $meshMenu $uniqueInt
  373. set winId$winid $uniqueInt
  374. incr winid
  375. incr uniqueInt
  377. bind $meshMenu <Shift-ButtonRelease> {
  378.     set chosenMesh [eval %W entrycget active -value]
  379.     createAlignmentView $uniqueInt $chosenMesh ""
  380.     incr uniqueInt
  381.     tkMenuUnpost {}
  382.     break
  383. }
  384.     }
  386.     label $which.lFrom -text Align
  387.     button $which.swap -text "<->" -padx 3 
  388. -command "swap regCorrespFrom regCorrespTo"
  389.     button $which.sync -text "Sync" 
  390. -command {
  391.     refreshCorrespMeshList $meshFrom $winId1 $meshTo $winId2
  392.     syncRegMeshes $meshFrom $meshTo
  393. } -pady 1
  394.     checkbutton $which.vis -text "Only visible" 
  395. -variable correspRegHideInvisible 
  396. -command "refreshCorrespMeshList $meshFrom $winId1 $meshTo $winId2"
  397.     button $which.help -text "Help..." 
  398. -command correspRegHelp -pady 1
  400.     pack $which.lFrom $which.mFrom $which.swap $which.mTo -side left
  401.     pack $which.help $which.vis $which.sync -side right
  402.     
  403.     frame .reg.lines
  404.     listbox .reg.lines.list -height 6 -borderwidth 2
  405.               -yscrollcommand ".reg.lines.scroll set"
  406.     scrollbar .reg.lines.scroll -command ".reg.lines.list yview"
  407.     pack .reg.lines.list -side left -fill both -expand true
  408.     pack .reg.lines.scroll -side right -fill y
  410.     # I want to just add some script to the existing Listbox binding,
  411.     # but this doesn't seem to be possible given the Tcl difference
  412.     # between substitutions inside "" and {} -- bind needs "" to work
  413.     # with %W, but the rest of the script needs {} to work with the
  414.     # temporary variables.  ARGH.
  416.     bind .reg.lines.list <ButtonRelease-1> {
  417. set oldSel [extractMeshesInCorrespondence .reg.lines.list]
  418. # eval [bind Listbox <ButtonRelease-1>]
  419. tkCancelRepeat
  420. %W activate @%x,%y
  421. set newSel [extractMeshesInCorrespondence .reg.lines.list]
  423.         refreshMeshesInCorrespondences [concat $oldSel $newSel]
  424.     }
  426. #    set listboxScript [bind Listbox <ButtonRelease-1>]
  427. #    bind .reg.lines.list <ButtonRelease-1> "
  428. # set oldSel [extractMeshesInCorrespondence %W]
  429. #        $listboxScript
  430. #        set newSel [extractMeshesInCorrespondence %W]
  432. #        refreshMeshesInCorrespondences [concat $oldSel $newSel]
  433. #    "
  435.     frame .reg.do
  436.     button .reg.do.reg -text "Register meshes:" 
  437. -command {
  438.     plv_registerCorresp .regLayout.togl $correspRegMode 
  439. $regCorrespFrom $regCorrespTo
  440.     redraw 1
  441.     .regLayout.togl render
  442. } -pady 0
  443.     globalset correspRegMode from2to
  444.     radiobutton .reg.do.from2to -text "From to To" 
  445. -variable correspRegMode -value from2to
  446.     radiobutton .reg.do.from2all -text "From to All" 
  447. -variable correspRegMode -value from2all
  448.     radiobutton .reg.do.all2all -text "All to all" 
  449. -variable correspRegMode -value all2all
  451.     pack .reg.do.reg .reg.do.from2to .reg.do.from2all .reg.do.all2all 
  452. -side left -fill x
  454.     frame .reg.sel
  455.     button .reg.sel.delete -text "Delete selected" 
  456. -command {
  457.     if {[string compare [.reg.lines.list cursel] ""] != 0} {
  458. DeleteRegCorrespondence .regLayout.togl 
  459.     [.reg.lines.list get active]
  460. refreshMeshesInCorrespondence 
  461.     [extractMeshesInCorrespondence .reg.lines.list]
  462. .reg.lines.list delete active
  463.     }
  464. } -pady 0
  466.     button .reg.sel.deselect -text "Deselect" 
  467. -command { deselectSelectedCorrespondence } -pady 0
  468.     checkbutton .reg.sel.colorPts -text "Color points" 
  469. -variable correspRegColorPoints 
  470. -command { plv_correspRegParms .regLayout.togl 
  471.        colorpoints $correspRegColorPoints
  472.     refreshCorrespRegWindows * }
  474.     pack .reg.sel.delete .reg.sel.deselect .reg.sel.colorPts 
  475. -side left -anchor w -padx 4
  477.     text .reg.halfDone -wrap none -height 1 -exportselection false 
  478. -foreground ForestGreen
  479.     .reg.halfDone config -state disabled
  481.     pack .reg.which -side top -fill x
  482.     pack .reg.lines -side top -anchor w -fill both -expand true
  483.     pack .reg.sel -side top -anchor w -fill x
  484.     pack .reg.do -side top -anchor w -fill x
  485.     pack .reg.halfDone -side right -anchor e
  487.     wm title .reg "Interactive mesh registration -- correspondences"
  488.     wm geometry .reg 500x300+0+0
  489.     window_Register .reg
  491.     createAlignmentOverview 500x300+524+0
  493.     createAlignmentView $winId1 "" 500x450+0+372
  494.     createAlignmentView $winId2 "" 500x450+524+372
  496.     bind .reg <Unmap>    { showCorrespRegWindows 0 }
  497.     bind .reg <Map>      { showCorrespRegWindows 1 }
  498.     wm protocol .reg WM_DELETE_WINDOW destroyCorrespRegUI
  500.     syncRegMeshes $meshFrom $meshTo 0 0
  501. }
  504. proc refreshCorrespMeshList {meshFrom winId1 meshTo winId2} {
  505.     global correspRegHideInvisible
  506.     listRegMeshes [list $meshFrom $meshTo] $correspRegHideInvisible
  507.     bindCorrespRegMeshSelector $meshFrom $winId1
  508.     bindCorrespRegMeshSelector $meshTo   $winId2
  509. }
  512. proc bindCorrespRegMeshSelector {meshlist windowid} {
  513.     set len [$meshlist index end]
  514.     for {set i 3} {$i <= $len} {incr i} {
  515. set mesh [$meshlist entrycget $i -label]
  516. $meshlist entryconfigure $i 
  517.     -command "resetAlignmentView $windowid $mesh"
  518.     }
  519. }
  522. proc invokeActiveMesh {meshlist} {
  523.     menuInvokeByName $meshlist [globalset theMesh]
  524. }
  527. proc activateMeshFromVariable {var} {
  528.     globalset theMesh [globalset $var]
  529. }
  532. proc listRegMeshes {meshlistlist {onlyvis 0}} {
  533.     set names [getSortedMeshList $onlyvis]
  535.     foreach meshlist $meshlistlist {
  536. set var [lindex [$meshlist entryconfig 3 -variable] 4]
  537. $meshlist delete 0 end
  539. $meshlist add command -label "Select active mesh" 
  540.     -command "invokeActiveMesh $meshlist"
  541. $meshlist add command -label "Activate selected mesh" 
  542.     -command "activateMeshFromVariable $var"
  543. $meshlist add separator
  545. set count 3
  546. set max 35
  548. foreach name $names {
  549.     set color [GetMeshFalseColor $name]
  550.     if {[expr $count % $max] == 0} {
  551. set cb 1
  552.     } else {
  553. set cb 0
  554.     }
  555.     incr count
  557.     $meshlist add radiobutton -label $name 
  558. -variable $var -value $name 
  559. -foreground $color -activebackground $color 
  560. -columnbreak $cb
  561. }
  563. if {[llength $names] == 0} {
  564.     $meshlist add radiobutton -label "No eligible meshes!" 
  565. -variable $var -state disabled
  566. }
  567.     }
  568. }
  571. proc syncRegMeshes {meshFrom meshTo {relist 0} {warn 1}} {
  572.     if {$relist != 0} {
  573. # refresh mesh list
  574. listRegMeshes "$meshFrom $meshTo" [expr $relist - 1]
  575.     }
  577.     # now try to select the 2 visible meshes
  578.     set vis [getVisibleMeshes]
  579.     if {[llength $vis] != 2} {
  580. if {$warn} {
  581.     tk_messageBox -type ok -icon error 
  582. -message "Must have exactly 2 meshes visible to sync"
  583. -parent $meshFrom
  584. } else {
  585.     # instead of failing, we're supposed to silently do our best.
  586.     # so select theMesh as first mesh, and anything else as second
  587.     set ind [menuInvokeByName $meshFrom [globalset theMesh]]
  588.          
  589.     if {$ind == 3} {
  590. $meshTo invoke 4
  591.     } else {
  592. $meshTo invoke 3
  593.     }
  594. }
  595. return 0
  596.     }
  598.     # if either is the current mesh, make it the "from" mesh
  599.     if {[globalset theMesh] == [lindex $vis 1]} {
  600. set vis [list [lindex $vis 1] [lindex $vis 0]]
  601.     }
  603.     set loop {{meshFrom 0} {meshTo 1}}
  604.     foreach entry $loop {
  605. set meshMenu [set [lindex $entry 0]]
  606. set ind [lindex $entry 1]
  608. set name [lindex $vis $ind]
  609. menuInvokeByName $meshMenu $name
  610.     }
  612.     return 1
  613. }
  616. proc correspRegHelp {} {
  617.     toplevel .help
  618.     text .help.instruct -wrap word -exportselection false
  619.     .help.instruct insert end "Choose two meshes from the dropdown menus.
  620.                If you want more than two mesh views, hold shift as you
  621.                select a mesh name.nn
  622.                Left-click a point in each mesh view to begin a correspondence;
  623.                middle button completes the correspondence and right button
  624.                cancels it.nn
  625.                Selecting a correspondence from the listbox will highlight it;
  626.                you can now delete it, or modify or delete individual points
  627.                by clicking in individual mesh views.nn
  628.                To manipulate the meshes with a trackball, hold down the
  629.                Alt key."
  630.     .help.instruct config -state disabled
  631.     pack .help.instruct -fill both -expand true
  632. }
  635. proc extractMeshesInCorrespondence {widget {corresp ""}} {
  636.     # if we're passed a widget and no correspondence, extract correspondence
  637.     if {0 == [string compare $corresp ""]} {
  639. # if there is one
  640. if {0 == [string compare "" [$widget cursel]]} {
  641.     return ""
  642. }
  644. set corresp [$widget get active]
  645.     }
  647.     set meshes ""
  648.     for {set i 1} {$i < [llength $corresp]} {set i [expr $i + 2]} {
  649. set mesh [lindex $corresp $i]
  650. set mesh [string range $mesh 0 [expr [string first : $mesh] - 1]]
  652. set meshes [concat $meshes $mesh]
  653.     }
  655.     return $meshes
  656. }
  659. proc refreshMeshesInCorrespondences {meshes} {
  660.     foreach mesh $meshes {
  661. set meshNames($mesh) 1
  662.     }
  664.     # use names as keys in associative array, then extract names, to
  665.     # discard duplicates
  666.     foreach mesh [array names meshNames] {
  667. if {0 != [string compare $mesh ""]} {
  668.     refreshCorrespRegWindows $mesh
  669. }
  670.     }
  671. }
  674. proc deselectSelectedCorrespondence {} {
  675.     set meshes [getListboxSelection .reg.lines.list]
  676.     .reg.lines.list selection clear 0 end
  677.     if {$meshes != ""} {
  678. refreshMeshesInCorrespondences 
  679.     [extractMeshesInCorrespondence "" $meshes]
  680.     }
  681. }
  684. proc rebuildSelectedCorrespondenceString {} {
  685.     set index [.reg.lines.list cursel]
  686.     if {$index == ""} {
  687. return
  688.     }
  690.     set sel [.reg.lines.list get $index]
  691.     set id [getCorrespondenceIndex $sel]
  692.     set sel [GetCorrespondenceInfo .regLayout.togl $id]
  694.     .reg.lines.list insert $index $sel
  695.     .reg.lines.list delete [expr $index + 1]
  696.     .reg.lines.list selection clear 0 end
  697.     .reg.lines.list selection set $index
  698. }
  701. proc refreshCorrespRegWindows {mesh} {
  702.     global correspRegWindows
  704.     foreach window [array names correspRegWindows] {
  705. set thisMesh $correspRegWindows($window)
  707. if {$mesh == $thisMesh || $mesh == "*"} {
  708.     $window.togl render
  709. }
  710.     }
  712.     if {$mesh == "*"} {
  713. .regLayout.togl render
  714.     }
  715. }
  718. proc showCorrespRegWindows {bShow} {
  719.     global correspRegWindows
  721.     foreach window [concat .regLayout [array names correspRegWindows]] {
  722. if {[string compare $bShow 0] == 0} {
  723.     wm withdraw $window
  724. } else {
  725.     wm deiconify $window
  726. }
  727.     }
  728. }
  731. proc destroyCorrespRegUI {} {
  733.     # delete dependent windows
  735.     global correspRegWindows
  736.     foreach window [array names correspRegWindows] {
  737. destroy $window
  738.     }
  739.     unset correspRegWindows
  741.     # then delete master windows
  742.     wm protocol .reg WM_DELETE_WINDOW {}
  743.     wm protocol .regLayout WM_DELETE_WINDOW {}
  744.     destroy .reg
  745.     destroy .regLayout
  747.     # don't let user accidentally destroy alignment
  748.     globalset theMover viewer
  749. }
  752. proc createAlignmentOverview {geometry} {
  753.     toplevel .regLayout
  754.     togl .regLayout.togl 
  755.         -rgba true -double true -depth true -accum true -overlay false
  756. -ident .regLayout.togl
  758.     pack .regLayout.togl -fill both -expand 1
  759.     wm title .regLayout "Interactive mesh registration -- layout"
  760.     wm geometry .regLayout $geometry
  761.     window_Register .regLayout
  763.     bindToglToAlignmentOverview .regLayout.togl
  764.     wm protocol .regLayout WM_DELETE_WINDOW destroyCorrespRegUI
  765. }
  768. proc createAlignmentView {viewName meshName geometry} {
  769.     set view [toplevel .regMesh$viewName]
  770.     togl $view.togl 
  771.         -rgba true -double true -depth true -accum true 
  772. -ident $view.togl -time 30
  773.     resetAlignmentView $viewName $meshName
  774.     pack $view.togl -fill both -expand 1
  775.     if {$geometry != ""} {
  776. wm geometry $view $geometry
  777.     }
  779.     bind $view.togl <Alt-ButtonPress-1> 
  780. "RegUIMouse $view.togl 1 %x %y %t start"
  781.     bind $view.togl <Alt-B1-Motion> 
  782. "RegUIMouse $view.togl 0 %x %y %t"
  783.     bind $view.togl <Alt-ButtonRelease-1> 
  784. "RegUIMouse $view.togl 1 %x %y %t stop"
  785.     bind $view.togl <Alt-ButtonPress-2> 
  786. "RegUIMouse $view.togl 2 %x %y %t start"
  787.     bind $view.togl <Alt-B2-Motion> 
  788. "RegUIMouse $view.togl 0 %x %y %t"
  789.     bind $view.togl <Alt-ButtonRelease-2> 
  790. "RegUIMouse $view.togl 2 %x %y %t stop"
  792.     global cursor
  793.     $view config -cursor "diamond_cross$cursor(Fore)$cursor(Back)"
  794.     bind $view <KeyPress-Alt_L>    
  795. "%W.togl config -cursor "$cursor(CurvedHand)$cursor(Fore)""
  796.     bind $view <KeyRelease-Alt_L>  
  797. "%W.togl config -cursor "diamond_cross$cursor(Fore)$cursor(Back)""
  798.     # enter bindings, in case you cross window boundary with Alt down
  799.     bind $view <Enter> 
  800. "%W config -cursor "diamond_cross$cursor(Fore)$cursor(Back)""
  801.     bind $view <Alt-Enter> 
  802. "%W config -cursor "$cursor(CurvedHand)$cursor(Fore)""
  804.     bind $view.togl <ButtonPress-1> 
  805. "clickCorrespondence $view.togl .regLayout.togl %x %y"
  806.     bind $view.togl <ButtonPress-2> 
  807. "completeCorrespondence .regLayout.togl"
  808.     bind $view.togl <ButtonPress-3> 
  809. "completeCorrespondence .regLayout.togl delete"
  811.     bind $view <Destroy> {+alignmentViewWentAway %W}
  812. }
  815. proc alignmentViewWentAway {widget} {
  816.     # ignore duplicates -- only the toplevel counts
  817.     if {0 != [string last . $widget]} { return }
  819.     global correspRegWindows
  820.     unset correspRegWindows($widget)
  821. }
  824. proc resetAlignmentView {viewName meshName} {
  825.     global correspRegWindows
  827.     set view ".regMesh$viewName"
  829.     bindToglToAlignmentView $view.togl $meshName
  830.     set correspRegWindows($view) $meshName
  831.     wm title $view "$meshName -- registration (Alt to trackball)"
  833.     bind $view <KeyPress-period> "setMeshResolution $meshName higher"
  834.     bind $view <KeyPress-comma>  "setMeshResolution $meshName lower"
  835. }
  838. proc clickCorrespondence {togl toglOV x y} {
  839.     set mesh [AddPartialRegCorrespondence $togl $toglOV $x $y]
  841.     if {[string compare $mesh ""] == 0} {
  842. beep
  843. puts "clicked on nothing"
  844. return
  845.     }
  847.     .reg.halfDone config -state normal
  848.     set meshPos [.reg.halfDone search $mesh 1.0]
  849.     if {$meshPos == ""} {
  850. # otherwise, it's already in the list
  851. .reg.halfDone insert end "$mesh "
  852. .reg.halfDone xview moveto 1
  853.     } else {
  854. set total [.reg.halfDone index "1.0 lineend"]
  855. set total [string range $total 2 end]
  856. set meshPos [string range $meshPos 2 end]
  857. .reg.halfDone xview moveto [expr $meshPos.0 / $total]
  858.     }
  859.     .reg.halfDone config -state disabled
  860. }
  863. proc getCorrespondenceIndex {corresp} {
  864.     set index [lindex $corresp 0]
  865.     set index [string range $index 
  866.    [expr [string first [ $index] + 1] 
  867.    [expr [string last  ] $index] - 1]]
  869.     return $index
  870. }
  873. proc completeCorrespondence {toglOV {delete ""}} {
  874.     # deselect any selection
  875.     deselectSelectedCorrespondence
  877.     # update C++ data structures
  878.     set corresp [ConfirmRegCorrespondence $toglOV $delete]
  880.     set index [getCorrespondenceIndex $corresp]
  882.     # if it wasn't cancelled
  883.     if {$index != 0} {
  885. # and list it in listbox
  886.      .reg.lines.list insert end $corresp
  887.     }
  889.     # update the views that are affected
  890.     update
  891.     refreshMeshesInCorrespondences 
  892. [extractMeshesInCorrespondence "" $corresp]
  894.     .reg.halfDone config -state normal
  895.     .reg.halfDone delete 1.0 end
  896.     .reg.halfDone config -state disabled
  897. }
  900. ######################################################################
  901. #
  902. # ICP Degistration UI
  903. #
  904. ######################################################################
  907. proc _reg_check2meshes { mfrom mto } {
  909.     if {$mfrom == $mto} {
  910. tk_messageBox -type ok -icon error -parent .regICP
  911. -message "Please select two meshes"
  912. return 0
  913.     }
  915.     global meshVisible
  916.     if {[lsearch [array names meshVisible] $mfrom] < 0 || 
  917.             [lsearch [array names meshVisible] $mto] < 0 || 
  918.             !$meshVisible($mfrom) || !$meshVisible($mto)} {
  919.         set warn "Warning: attempting to register mesh that is not"
  920.         set warn "$warn visible; sync first?"
  921.         set res [tk_messageBox -message $warn -parent .regICP 
  922.                 -type yesnocancel -default yes -icon warning]
  923.         if {$res == "cancel"} {
  924.             return 0
  925.         } elseif {$res == "yes"} {
  926.             .regICP.which.sync invoke
  927.             if {[lsearch [array names meshVisible] $mfrom] < 0 || 
  928.                     [lsearch [array names meshVisible] $mto] < 0 || 
  929.                     !$meshVisible($mfrom) || !$meshVisible($mto)} {
  930.                 return 0
  931.             }
  932.         }
  933.     }
  935.     return 1
  936. }
  939. proc doICP { samp normsamp n culling_percentage no_bdry opt_method 
  940.  mfrom mto thr_kind thr_val save_global gr_max_pairs qual} {
  942.     if {![_reg_check2meshes $mfrom $mto]} {
  943. return
  944.     }
  946.     .regICP config -cursor watch
  947.     cursor watch
  949.     if {$thr_kind == "rel"} {
  950. set thr_val [expr $thr_val / 100.0]
  951.     }
  953.     set err [plv_icpregister $samp $normsamp $n $culling_percentage $no_bdry 
  954.  $opt_method $mfrom $mto $thr_kind $thr_val $save_global 
  955.  $gr_max_pairs $qual]
  957.     redraw 1
  958.     .regICP config -cursor ""
  959.     .regICP.do.lastErr config -text $err
  960.     .regICP.gr_frm.qual config -state active
  961.     cursor restore
  962. }
  964. proc updateFromAndToMeshNames {} {
  966.     if {![window_Activate .regICP]} { return }
  967.     # do nothing if the ICP window is closed
  969.     set names [getMeshList]
  970.     if {[llength $names] == 0} { return }
  971.     # i.e. do nothing if all the meshes have been deleted
  972.     syncRegMeshes .regICP.which.mFrom.menu .regICP.which.mTo.menu 1 0
  973.     # calls syncRegMeshes to refresh the menus so that the current 
  974.     # selections for the from and to mesh are valid choices
  977. }
  979. proc ICPdialog {} {
  981.     global regICPFrom regICPTo
  983.     set names [getMeshList]
  984.     if {[expr [llength $names] < 2]} {
  985. puts "You need at least two meshes to register"
  986. return
  987.     }
  989.     if {[window_Activate .regICP]} { return }
  990.     toplevel .regICP
  992.     # Instruction message
  993.     message .regICP.instruct -aspect 1000 
  994.     -text "Choose two meshes in the menus"
  995.     -justify left
  997.     pack .regICP.instruct -side top -anchor w
  999.     # option menu for mesh names
  1000.     set which [frame .regICP.which]
  1001.     set meshFrom [eval tk_optionMenu $which.mFrom regICPFrom  bogus]
  1002.     set meshTo [eval tk_optionMenu $which.mTo regICPTo bogus]
  1003.     syncRegMeshes $meshFrom $meshTo 1 0
  1004.     $meshFrom config -postcommand "refreshICPRegMeshes $meshFrom"
  1005.     $meshTo config -postcommand "refreshICPRegMeshes $meshTo"
  1006.    
  1007.     label $which.lFrom -text Align -padx 3
  1008.     button $which.swap -text "<->" -padx 3 
  1009. -command "swap regICPFrom regICPTo"
  1010.     button $which.sync -text "Sync" 
  1011. -command "refreshICPRegMeshes {$meshFrom $meshTo} sync"
  1012.     checkbutton $which.vis -text "Only visible" 
  1013. -variable icpRegListsVisOnly -onvalue 1 -offvalue 0
  1015.     pack $which.lFrom $which.mFrom $which.swap $which.mTo -side left
  1016.     pack $which.sync $which.vis -side right
  1017.     pack $which -side top -anchor w
  1019.     # scales
  1020.     set scl_frm [frame .regICP.scl_frm 
  1021.     -borderwidth 4 -relief ridge]
  1022.     # scale for the sampling rate
  1023.     set lbl_wdth 13
  1024.     set samp [frame $scl_frm.samp]
  1025.     label  $samp.scl_label -text "Sampling rate" 
  1026.     -width $lbl_wdth -anchor w -padx 3
  1027.     scale  $samp.scl 
  1028.     -from .01 -to 1 -resolution .01 
  1029.     -variable regSample 
  1030.     -orient horizontal 
  1031.     -length 150
  1032.     $samp.scl set .10
  1033.     pack $samp -side top -expand true -fill x
  1034.     pack $samp.scl_label -side left -anchor sw
  1035.     pack $samp.scl -side right -expand true -fill x
  1037.     # scale for the number of iterations
  1038.     set iter [frame $scl_frm.iter]
  1039.     label  $iter.scl_label -text "Iterations" 
  1040.     -width $lbl_wdth -anchor w -padx 3
  1041.     scale  $iter.scl 
  1042.     -from 0 -to 20 
  1043.     -variable regIterations 
  1044.     -orient horizontal 
  1045.     $iter.scl set 3
  1046.     pack $iter -side top -expand true -fill x
  1047.     pack $iter.scl_label -side left -anchor sw
  1048.     pack $iter.scl -side right -expand true -fill x
  1050.     # scale for the max relative edge length
  1051.     set culling [frame $scl_frm.culling]
  1052.     label  $culling.scl_label -text "Cull Percentage" 
  1053.     -width $lbl_wdth -anchor w -padx 3
  1054.     scale  $culling.scl 
  1055.     -from 0 -to 99 
  1056.     -variable cullingPercentage 
  1057.     -orient horizontal
  1058.     $culling.scl set 3
  1059.     pack $culling -side top -expand true -fill x
  1060.     pack $culling.scl_label -side left -anchor sw
  1061.     pack $culling.scl -side right -expand true -fill x
  1063.     # make a frame for thresholds
  1064.     set thr_frm [frame .regICP.scl_frm.thr_frm]
  1065.     # radio buttons
  1066.     label $thr_frm.l -text "Threshold:"
  1067.     set thr_radiob [frame $thr_frm.thr_radiob]
  1068.     radiobutton $thr_radiob.abs -variable thresh_kind 
  1069.     -value "abs" 
  1070.     -text "Absolute (mm)"
  1071.     radiobutton $thr_radiob.rel -variable thresh_kind 
  1072.     -value "rel" 
  1073.     -text "Relative (% of bbox)"
  1074.     $thr_radiob.abs select
  1075.     packchildren $thr_radiob -side bottom -anchor w
  1076.     # entry field
  1077.     entry  $thr_frm.entry 
  1078.     -textvariable dist_threshold_val 
  1079.     -relief sunken -width 6
  1080.     globalset dist_threshold_val 5.0
  1081.     packchildren $thr_frm -side left -expand true -fill x
  1082.     pack $thr_frm -side top -expand true -fill x
  1084.     pack $scl_frm -side top -expand true -fill x
  1086.     frame .regICP.opt
  1087.     # checkbutton for allowing mesh boundary targets
  1088.     checkbutton .regICP.opt.bdry -variable no_bndr_trgt 
  1089.     -text "Avoid boundary"
  1090.     checkbutton .regICP.opt.normspace -variable norm_space_samp 
  1091.     -text "Normal-space sampling"
  1092.     .regICP.opt.bdry select
  1093.     checkbutton .regICP.opt.lines -text "Show lines"
  1094. -variable regicpShowLines -command {showIcpLines $regicpShowLines}
  1095.     #.regICP.opt.lines select
  1096.     showIcpLines 0
  1097.     packchildren .regICP.opt -side left
  1098.     pack .regICP.opt -side top -anchor w
  1100.     # radiobuttons for choosing optimization method
  1101.     set rad_frm [frame .regICP.rad_frm 
  1102.     -borderwidth 4 -relief ridge]
  1103.     radiobutton $rad_frm.point -variable opt_method 
  1104.     -value "point" 
  1105.     -text "Move points to points"
  1106.     radiobutton $rad_frm.plane -variable opt_method 
  1107.     -value "plane" 
  1108.     -text "Move points to planes"
  1109.     $rad_frm.plane select
  1110.     pack $rad_frm.point $rad_frm.plane -side top -anchor w
  1111.     pack $rad_frm -side top -expand true -fill x
  1113.     # global registration stuff
  1114.     set gr_frm [frame .regICP.gr_frm 
  1115.     -borderwidth 4 -relief ridge]
  1117.     checkbutton $gr_frm.l1 
  1118. -text "Save data for globalreg, but no more than " 
  1119. -variable saveICPForGlobal
  1120.     entry  $gr_frm.entry 
  1121.     -textvariable gr_max_pairs 
  1122.     -relief sunken -width 7
  1123.     globalset gr_max_pairs 200
  1124.     label  $gr_frm.l2 -text " pairs.   " 
  1125.     -width 5 -anchor w -padx 3
  1126.     
  1127.     label $gr_frm.l3 -text "Quality:"
  1128.     set qualMenu [tk_optionMenu $gr_frm.qual regIcpQuality 
  1129.       "0 - Unspecified" "1 - Bad" "2 - Fair" "3 - Good"]
  1130.     bindCommandToAllMenuItems $qualMenu {
  1131. plv_icpreg_markquality $regICPFrom $regICPTo $regIcpQuality
  1132.     }
  1133.     globalset regIcpQuality 0
  1134.     
  1135.     packchildren $gr_frm -side left
  1136.     pack $gr_frm -side top -expand true -fill x
  1138.     # button for doing registration
  1139.     frame .regICP.do
  1140.     
  1141.     button .regICP.do.doIt -text "Register meshes" 
  1142. -command {
  1143.     doICP $regSample $norm_space_samp $regIterations $cullingPercentage 
  1144. $no_bndr_trgt $opt_method $regICPFrom $regICPTo 
  1145. $thresh_kind $dist_threshold_val $saveICPForGlobal 
  1146. $gr_max_pairs $regIcpQuality
  1147. }
  1148.     button .regICP.do.doIt100 -text "Register 1 round, 100%" 
  1149. -command {
  1150.     doICP 1 0 1 $cullingPercentage 
  1151. $no_bndr_trgt $opt_method $regICPFrom $regICPTo 
  1152. $thresh_kind $dist_threshold_val $saveICPForGlobal 
  1153. $gr_max_pairs $regIcpQuality
  1154. }
  1155.     button .regICP.do.histogram -text "Show histogram" 
  1156. -command {
  1157.     plv_error_histogram 
  1158. $regSample $regIterations $cullingPercentage 
  1159. $no_bndr_trgt $opt_method $regICPFrom $regICPTo 
  1160. $thresh_kind $dist_threshold_val
  1161. }
  1162.     
  1163.     label .regICP.do.lastErrl -text "Last err:"
  1164.     label .regICP.do.lastErr -text "(none)"
  1166.     packchildren .regICP.do -side left
  1167.     pack .regICP.do -side top -anchor w
  1169.     wm title .regICP "ICP registration"
  1170.     bind .regICP <Destroy> "+destroyICPDialog %W"
  1171.     bind .regICP <KeyPress-space> {.regICP.do.doIt invoke}
  1172.     window_Register .regICP
  1174.     trace variable regICPFrom w regIcpChangeMesh
  1175.     trace variable regICPTo   w regIcpChangeMesh
  1176.     regIcpChangeMesh ignore this arg
  1177. }
  1180. proc regIcpChangeMesh {var1 var2 op} {
  1181.     # NOTE: should we always set to 0(unknown) when they switch meshes, or 
  1182.     # if those meshes are already aligned, should we set it to their old grade?
  1183.     globalset regIcpQuality 0
  1184.     .regICP.do.lastErr config -text "(none)"
  1186.     set reg [plv_globalreg pairstatus [globalset regICPFrom] 
  1187.  [globalset regICPTo]]
  1188.     if {$reg} {
  1189. .regICP.gr_frm.qual config -state active
  1190.     } else {
  1191. .regICP.gr_frm.qual config -state disabled
  1192.     }
  1193. }
  1196. proc refreshICPRegMeshes {meshLists {sync 0}} {
  1197.     set invis [globalset icpRegListsVisOnly]
  1199.     if {$sync != "0"} {
  1200. if {[llength $meshLists] != 2} {
  1201.     tk_messageBox -message "internal error in arg count!"
  1202.     return
  1203. }
  1204. eval syncRegMeshes $meshLists [expr 1 + $invis]
  1205.     } else {
  1206. listRegMeshes $meshLists $invis
  1207.     }
  1208. }
  1211. proc destroyICPDialog {widget} {
  1212.     if {$widget != ".regICP"} {
  1213. return
  1214.     }
  1216.     global regICPFrom
  1217.     global regICPTo
  1218.     trace vdelete regICPFrom w regIcpChangeMesh
  1219.     trace vdelete regICPTo   w regIcpChangeMesh
  1221.     showIcpLines 0
  1222. }
  1225. proc showIcpLines {show} {
  1226.     plv_showicplines $show
  1227.     redraw 1
  1228. }
  1231. proc globalRegDeleteDialog {} {
  1232.     set grd [toplevel .globalregdel]
  1233.     wm resizable $grd 0 0
  1234.     wm title $grd "Delete from globalreg"
  1236.     button $grd.all -text "Clear all registration pairs!" 
  1237. -command "plv_globalreg reset"
  1238.     button $grd.current -text "Clear all pairs involving current mesh" 
  1239. -command {plv_globalreg killpair [globalset theMesh] *}
  1240.     button $grd.these -text "Clear pair selected in ICP dialog" 
  1241. -command {plv_globalreg killpair 
  1242.     [globalset regICPFrom] [globalset regICPTo]}
  1244.     set f [frame $grd.f1]
  1246.     set fb [frame $f.fb]
  1247.     button $fb.b1 -text "Clear all" 
  1248. -command { plv_globalreg deleteautopairs $auto_del_thrsh }
  1249.     button $fb.b2 
  1250. -text "Clear current mesh's" 
  1251. -command { 
  1252.     plv_globalreg deleteautopairs $auto_del_thrsh $theMesh
  1253. }
  1254.     packchildren $fb -side top -fill x -expand 1
  1256.     label $f.gt -text "auto pairs greater than"
  1257.     entry  $f.entry 
  1258.     -textvariable auto_del_thrsh 
  1259.     -relief sunken -width 6
  1260.     globalset auto_del_thrsh 1.0
  1261.     packchildren $f -side left -fill x -expand 1
  1263.     button $grd.cancel -text "Close" -command "destroy $grd"
  1265.     packchildren $grd -side top -fill x -expand 1
  1266. }
  1268. proc chooseICP {a b} {
  1269.     global regICPTo regICPFrom
  1270.     set regICPFrom $a
  1271.     set regICPTo $b
  1272.     ICPdialog
  1273.     showAllMeshes 0
  1274.     showMesh $a
  1275.     showMesh $b
  1276. }
  1278. proc badAlignDialog {str} {
  1280.     if {[winfo exists .badalign]} {
  1281. destroy .badalign
  1282.     }
  1284.     set bad [toplevel .badalign]
  1286.     wm resizable $bad 0 0
  1287.     wm title $bad "Bad aligns"
  1289.     set l [split $str]
  1290.     for {set i 0} {$i < [llength $l]} {incr i 4} {
  1291. if {[expr $i + 3] < [llength $l]} {
  1292.     button $bad.$i 
  1293. -text [join [lrange $l $i [expr $i + 3]]]
  1294. -command "chooseICP [lindex $l [expr $i + 0]] [lindex $l [expr $i + 1]]"
  1295. }
  1296.     }
  1297.     packchildren $bad -side top -fill x -expand 1
  1298. }