00001 # Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de> 00002 # 00003 # This file is free software; as a special exception the author gives 00004 # unlimited permission to copy and/or distribute it, with or without 00005 # modifications, as long as this notice is preserved. 00006 # 00007 # This program is distributed in the hope that it will be useful, but 00008 # WITHOUT ANY WARRANTY, to the extent permitted by law; without even the 00009 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00010 00011 ## ---------------------------------------------------------------------------- 00012 ## AllNetworks - manage all constraint networks. 00013 ## 00014 ## 00015 ## \author Michael Daum (see also AUTHORS and THANKS for more) 00016 ## $Id: allnetworks.tcl,v 1.59 2004/10/11 13:50:05 micha Exp $ 00017 # ---------------------------------------------------------------------------- 00018 class AllNetworks { 00019 inherit DataBrowser 00020 00021 # public methods 00022 public method selectIdsOfWg {wgId}; ## \type TclString 00023 public method getAllNetIds {} 00024 00025 ## substitute for getnet 00026 public method getCData {id}; ## \type TclString 00027 00028 public method refreshrow {row net}; ## \type TclNumber, ConstraintNet 00029 00030 # protected methods 00031 protected method init_data {} 00032 00033 constructor {args} {}; ## \type TclList 00034 00035 # private methods 00036 private method detailsbutton_action {} 00037 private method deletebutton_action {} 00038 private method netsearchbutton_action {} 00039 private method frobbutton_action {} 00040 private method glsbutton_action {} 00041 00042 # private variables 00043 private variable network; ## \type TclArray 00044 }; 00045 00046 ## ---------------------------------------------------------------------------- 00047 ## constructor 00048 ## ---------------------------------------------------------------------------- 00049 body AllNetworks::constructor {args} { 00050 set _idColumnIndex 0 00051 set table $itk_component(table) 00052 $table configure -cols 10 00053 00054 00055 itk_component add detailsbutton { 00056 button $itk_component(childsite).details\ 00057 -anchor w \ 00058 -text "Details" \ 00059 -command [code $this detailsbutton_action] 00060 } { } 00061 00062 itk_component add deletebutton { 00063 button $itk_component(childsite).delete\ 00064 -anchor w \ 00065 -text "Delete" \ 00066 -command [code $this deletebutton_action] 00067 } { } 00068 00069 itk_component add netsearchbutton { 00070 button $itk_component(childsite).netsearchbutton\ 00071 -anchor w \ 00072 -text "Search" \ 00073 -command [code $this netsearchbutton_action] 00074 } { } 00075 00076 itk_component add frobbutton { 00077 button $itk_component(childsite).frob\ 00078 -anchor w \ 00079 -text "Frobbing" \ 00080 -command [code $this frobbutton_action] 00081 } { } 00082 00083 itk_component add glsbutton { 00084 button $itk_component(childsite).gls\ 00085 -anchor w \ 00086 -text "Gls" \ 00087 -command [code $this glsbutton_action] 00088 } { } 00089 00090 00091 itk_component add netsearchdialog { 00092 NetsearchDialog $itk_interior.netsearchdialog \ 00093 -master . \ 00094 -title "Xcdg: Netsearch" \ 00095 -modality application 00096 } { } 00097 00098 # packing 00099 pack \ 00100 $itk_component(deletebutton) \ 00101 $itk_component(netsearchbutton) \ 00102 $itk_component(frobbutton) \ 00103 $itk_component(glsbutton) \ 00104 -side left -padx 3 00105 # (detailsbutton remains unpacked) 00106 00107 # get the initial data 00108 init_data 00109 00110 # register the helpmessages 00111 .cdgmain help sethelpstr \ 00112 $itk_component(table) "Click to select" 00113 00114 eval itk_initialize $args 00115 } 00116 00117 00118 ## ---------------------------------------------------------------------------- 00119 ## get the data from the cdg-tool. 00120 ## ---------------------------------------------------------------------------- 00121 body AllNetworks::init_data {} { 00122 00123 set table $itk_component(table) 00124 $table configure -state normal 00125 $table clear all 00126 $table delete rows 1 [$table cget -rows] 00127 $table tag config default 00128 $table tag config colored -bg gray80 00129 $table width 0 10 1 20 00130 00131 foreach id [array names network] { 00132 unset network($id) 00133 } 00134 set nets [cdgNets_get] 00135 _setCount [hashSize $nets] 00136 set hi [hashIteratorNew $nets] 00137 set net [hashIteratorNextValue $hi] 00138 while { $net != "NULL" } { 00139 set net_id [ConstraintNetStruct_id_get $net] 00140 set network($net_id) $net 00141 set net [hashIteratorNextValue $hi] 00142 } 00143 hashIteratorDelete $hi 00144 00145 $table setCell row 0,0 { "" "Wordgraph" "Nodes" "Edges" \ 00146 "Values" "Parses" "Score" "Unaries" "Binaries" \ 00147 "Statistics" } 00148 00149 set r 1 00150 foreach net_id [lsort -command ::smartCompare [array names network]] { 00151 set net $network($net_id) 00152 refreshrow $r $net 00153 incr r 00154 } 00155 00156 setSelection 00157 $table configure -state disabled 00158 } 00159 00160 00161 ## ---------------------------------------------------------------------------- 00162 ## fill a row with the values from a specific net 00163 ## ---------------------------------------------------------------------------- 00164 body AllNetworks::refreshrow {row net} { 00165 set table $itk_component(table) 00166 00167 set net_id [ConstraintNetStruct_id_get $net] 00168 set nodes [ConstraintNetStruct_nodes_get $net] 00169 set edges [ConstraintNetStruct_edges_get $net] 00170 set values [ConstraintNetStruct_values_get $net] 00171 set lattice [cnGetLattice $net] 00172 set lattice_id [LatticeStruct_id_get $lattice] 00173 set parses [ConstraintNetStruct_parses_get $net] 00174 set unaries [ConstraintNetStruct_evalUnary_get $net] 00175 set binaries [ConstraintNetStruct_evalBinary_get $net] 00176 set staties [ConstraintNetStruct_statUnary_get $net] 00177 set nonodes 0 00178 set noedges 0 00179 set novalues 0 00180 set noparses 0 00181 set agendasize 0 00182 set score 0 00183 00184 if {$nodes != "NULL" } { set nonodes [vectorSize $nodes] } 00185 if {$edges != "NULL" } { set noedges [vectorSize $edges]} 00186 if {$values != "NULL" } { set novalues [vectorSize $values]} 00187 if {$parses != "NULL"} { 00188 set noparses [listSize $parses] 00189 set parse [listElement $parses] 00190 set score [format "%4.3e" [ParseStruct_score_get $parse]] 00191 } 00192 00193 $itk_component(table) setCell row $row,0 [list \ 00194 $net_id $lattice_id $nonodes $noedges \ 00195 $novalues $noparses $score $unaries \ 00196 $binaries $staties ] 00197 00198 } 00199 00200 00201 00202 ## ---------------------------------------------------------------------------- 00203 ## action taking place when the searchforparsebutton is pressed 00204 ## ---------------------------------------------------------------------------- 00205 body AllNetworks::netsearchbutton_action {} { 00206 if {"$_selection" != ""} { 00207 $itk_component(netsearchdialog) activate $_selection 00208 } 00209 } 00210 00211 ## ---------------------------------------------------------------------------- 00212 ## action taking place when the frobbutton is pressed 00213 ## ---------------------------------------------------------------------------- 00214 body AllNetworks::frobbutton_action {} { 00215 00216 foreach id $_selection { 00217 ::cmd::Frobbing $id method=combined pressure=0.0 batch=yes 00218 } 00219 00220 } 00221 00222 ## ---------------------------------------------------------------------------- 00223 ## action taking place when the glsbutton is pressed. 00224 ## ---------------------------------------------------------------------------- 00225 body AllNetworks::glsbutton_action {} { 00226 00227 if {$_selection == ""} { 00228 return 00229 } 00230 00231 foreach id $_selection { 00232 ::cmd::Gls $id 00233 } 00234 } 00235 00236 ## ---------------------------------------------------------------------------- 00237 ## action taking place when the deletebutton is pressed. 00238 ## ---------------------------------------------------------------------------- 00239 body AllNetworks::deletebutton_action {} { 00240 00241 foreach id $_selection { 00242 commandEval "netdelete $id" 00243 puts "Delete $id" 00244 } 00245 init_data 00246 } 00247 00248 ## ---------------------------------------------------------------------------- 00249 ## action taking place when the detailsbutton is pressed. 00250 ## ---------------------------------------------------------------------------- 00251 body AllNetworks::detailsbutton_action {} { 00252 00253 .cdgmain not_yet 00254 } 00255 00256 00257 ## ---------------------------------------------------------------------------- 00258 ## get pointer to a net_id, cache it in array network. 00259 ## ---------------------------------------------------------------------------- 00260 body AllNetworks::getCData {id} { 00261 00262 if {![info exists network($id)]} { 00263 set net [cnFindNet $id] 00264 if {$net == "NULL"} { 00265 return "NULL" 00266 } 00267 set network($id) $net 00268 #_setCount [hashSize [cdgNets_get]] 00269 } 00270 return $network($id) 00271 } 00272 00273 00274 ## ---------------------------------------------------------------------------- 00275 ## select nets based on a specified wordgraph. 00276 ## previous selections are cleared 00277 ## ---------------------------------------------------------------------------- 00278 body AllNetworks::selectIdsOfWg {wgId} { 00279 00280 set table $itk_component(table) 00281 00282 set rmax [$table cget -rows] 00283 $table selection clear 0,0 end 00284 00285 set newselection "" 00286 for {set row 0} {$row < $rmax} {incr row} { 00287 if {[$table getCell $row,1] == $wgId} { 00288 set id [$table getCell $row,0 ] 00289 lappend newselection $id 00290 $table selection set $row,0 00291 } 00292 } 00293 00294 set _selection $newselection 00295 } 00296 00297 00298 ## ---------------------------------------------------------------------------- 00299 ## Return list of all nets' names 00300 ## ---------------------------------------------------------------------------- 00301 body AllNetworks::getAllNetIds {} { 00302 init_data 00303 return [array names network] 00304 }