00001 00002 package require image
00003 package require display
00004 package require jmath
00005 package require sams
00006
00007 namespace eval sams {
00008 namespace eval model {
00009 variable model00010 variable modelImg00011
00012 proc show { md } {
00013 variable model
00014 variable modelImg
00015 set model $md
00016 set currentView [$model first]
00017 set modelImg [$currentView img]
00018 ::display::show $modelImg
00019 frame .$modelImg.control
00020 button .$modelImg.control.prev -text "Previous view" -command {sams::model::previousView} -state disabled
00021 grid configure .$modelImg.control.prev -column 1 -row 0
00022 button .$modelImg.control.next -text "next view" -command {sams::model::nextView} -state disabled
00023 grid configure .$modelImg.control.next -column 2 -row 0
00024 label .$modelImg.control.modelView -text "No Model Loaded"
00025 grid configure .$modelImg.control.modelView -column 0 -row 0
00026 label .$modelImg.control.modelparts -text "0 parts"
00027 grid configure .$modelImg.control.modelparts -column 3 -row 0
00028 checkbutton .$modelImg.control.showparts -text "Show parts" \
00029 -command {sams::model::showParts} -state disabled
00030 grid configure .$modelImg.control.showparts -column 4 -row 0
00031 .$modelImg.control.modelparts configure -text "[::sams::ModelView_nbParts $currentView] parts"
00032 .$modelImg.control.modelView configure -text "View [::sams::ModelView_id $currentView]"
00033 if {[::sams::Model_hasNext $model]} {
00034 .$modelImg.control.next configure -state normal
00035 }
00036 .$modelImg.control.showparts configure -state normal
00037 pack .$modelImg.control -side left
00038 return $modelImg;
00039 }00040
00041 proc nextView { } {
00042 variable model
00043 variable modelImg
00044 set currentView [$model next]
00045 .$modelImg.control.modelparts configure -text "[::sams::ModelView_nbParts $currentView] parts"
00046 .$modelImg.control.modelView configure -text "View [sams::ModelView_id $currentView]"
00047 set tmp [$currentView img]
00048 ::image::Image_copy $tmp $modelImg
00049 ::display::refresh $modelImg
00050 if {![$model hasNext]} {
00051 .$modelImg.control.next configure -state disabled
00052 }
00053 .$modelImg.control.prev configure -state normal
00054 ::sams::model::showParts
00055 }00056
00057 proc previousView { } {
00058 variable model
00059 variable modelImg
00060 set currentView [$model previous]
00061 .$modelImg.control.modelparts configure -text "[::sams::ModelView_nbParts $currentView] parts"
00062 .$modelImg.control.modelView configure -text "View [sams::ModelView_id $currentView]"
00063 set tmp [$currentView img]
00064 ::image::Image_copy $tmp $modelImg
00065 ::display::refresh $modelImg
00066 if {![$model hasPrevious]} {
00067 .$modelImg.control.prev configure -state disabled
00068 }
00069 .$modelImg.control.next configure -state normal
00070 ::sams::model::showParts
00071 }00072
00073 proc showParts {} {
00074 variable model
00075 variable modelImg
00076 global showparts
00077 ::display::clearOverlay $modelImg "parts"
00078 if {$showparts} {
00079 set currentView [$model current]
00080 set part [$currentView first]
00081 set o [$part o]
00082 set u [$part x]
00083 set v [$part y]
00084 set s [$part s]
00085 if { [::sams::ModelPart_confidence [$part part]] > 0.25 } {
00086 ::display::drawCircle $modelImg $u $v $s 1 "red" "parts"
00087 } else {
00088 ::display::drawCircle $modelImg $u $v $s 1 "yellow" "parts"
00089 }
00090 while {[$currentView hasNext]} {
00091 set part [$currentView next]
00092 set o [$part o]
00093 set u [$part x]
00094 set v [$part y]
00095 set s [$part s]
00096 if { [::sams::ModelPart_confidence [$part part]] > 0.25 } {
00097 ::display::drawCircle $modelImg $u $v $s 1 "red" "parts"
00098 } else {
00099 ::display::drawCircle $modelImg $u $v $s 1 "yellow" "parts"
00100 }
00101 }
00102 }
00103 }00104
00105 }00106 }00107
00108 package provide sams 1.0