Ignore:
Timestamp:
Mar 18, 2009, 2:59:21 PM (16 years ago)
Author:
gah
Message:

preliminary HQ output from molvisviewer; unexpand tabs; all jpeg generation at 100%

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/service.tcl

    r115 r1342  
    4545itcl::body Rappture::Service::constructor {owner path args} {
    4646    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
    47         error "bad object \"$owner\": should be Rappture::ControlOwner"
     47        error "bad object \"$owner\": should be Rappture::ControlOwner"
    4848    }
    4949    set _owner $owner
    … …  
    5555    set intf [$_owner xml get $path.interface]
    5656    if {"" == $intf} {
    57         puts "can't find <interface> description for tool at $path"
     57        puts "can't find <interface> description for tool at $path"
    5858    } else {
    59         set installdir [[$_owner tool] installdir]
    60         regsub -all @tool $intf $installdir intf
    61 
    62         set xmlobj [Rappture::library $intf]
    63         set installdir [file dirname $intf]
    64         set _tool [Rappture::Tool ::#auto $xmlobj $installdir]
    65         set _control [$_tool xml get tool.control]
    66 
    67         #
    68         # Scan through the <tool> and establish all of the
    69         # relationships:
    70         #
    71         #   <show> ... Add to list of "input" for this service.
    72         #              Caller will add controls to the interface.
    73         #
    74         #   <link> ... Link this value to another input/output
    75         #              that exists in the containing tool.
    76         #
    77         #   <set> .... Hard-code the value for this input/output.
    78         #
    79         foreach dir {input output} {
    80             set _show($dir) ""
    81             foreach cname [$_owner xml children $path.$dir] {
    82                 set ppath $path.$dir.$cname
    83 
    84                 set spath [$_owner xml get $ppath.path]
    85                 if {"" == $spath} {
    86                     error "missing <path> at $ppath"
    87                 }
    88 
    89                 set type [$_owner xml element -as type $ppath]
    90                 switch -- $type {
    91                   show {
     59        set installdir [[$_owner tool] installdir]
     60        regsub -all @tool $intf $installdir intf
     61
     62        set xmlobj [Rappture::library $intf]
     63        set installdir [file dirname $intf]
     64        set _tool [Rappture::Tool ::#auto $xmlobj $installdir]
     65        set _control [$_tool xml get tool.control]
     66
     67        #
     68        # Scan through the <tool> and establish all of the
     69        # relationships:
     70        #
     71        #   <show> ... Add to list of "input" for this service.
     72        #              Caller will add controls to the interface.
     73        #
     74        #   <link> ... Link this value to another input/output
     75        #              that exists in the containing tool.
     76        #
     77        #   <set> .... Hard-code the value for this input/output.
     78        #
     79        foreach dir {input output} {
     80            set _show($dir) ""
     81            foreach cname [$_owner xml children $path.$dir] {
     82                set ppath $path.$dir.$cname
     83
     84                set spath [$_owner xml get $ppath.path]
     85                if {"" == $spath} {
     86                    error "missing <path> at $ppath"
     87                }
     88
     89                set type [$_owner xml element -as type $ppath]
     90                switch -- $type {
     91                  show {
    9292puts "show: $spath"
    93                     set tpath [$_owner xml get $ppath.to]
    94                     if {"" == $tpath && $dir == "input"} {
    95                         error "missing <to> at $ppath"
    96                     }
    97                     set obj [$_tool xml element -as object $spath]
     93                    set tpath [$_owner xml get $ppath.to]
     94                    if {"" == $tpath && $dir == "input"} {
     95                        error "missing <to> at $ppath"
     96                    }
     97                    set obj [$_tool xml element -as object $spath]
    9898puts " => $obj"
    99                     lappend _show($dir) $obj
    100                     set _obj2path($obj) $spath
    101 
    102                     if {$dir == "input"} {
     99                    lappend _show($dir) $obj
     100                    set _obj2path($obj) $spath
     101
     102                    if {$dir == "input"} {
    103103puts "link: $tpath => $spath"
    104                         $_owner notify add $this $tpath \
    105                             [itcl::code $this _link $tpath $spath]
    106                     }
    107                   }
    108                   link {
    109                     set tpath [$_owner xml get $ppath.to]
    110                     if {"" == $tpath} {
    111                         error "missing <to> at $ppath"
    112                     }
    113                     if {"" == [$_owner xml element $tpath]} {
    114                         error "bad <to> path \"$tpath\" at $ppath"
    115                     }
    116                     if {$dir == "input"} {
     104                        $_owner notify add $this $tpath \
     105                            [itcl::code $this _link $tpath $spath]
     106                    }
     107                  }
     108                  link {
     109                    set tpath [$_owner xml get $ppath.to]
     110                    if {"" == $tpath} {
     111                        error "missing <to> at $ppath"
     112                    }
     113                    if {"" == [$_owner xml element $tpath]} {
     114                        error "bad <to> path \"$tpath\" at $ppath"
     115                    }
     116                    if {$dir == "input"} {
    117117puts "link: $tpath => $spath"
    118                         $_owner notify add $this $tpath \
    119                             [itcl::code $this _link $tpath $spath]
    120                     } else {
     118                        $_owner notify add $this $tpath \
     119                            [itcl::code $this _link $tpath $spath]
     120                    } else {
    121121puts "path2path: $spath => $tpath"
    122                         set _path2path($spath) $tpath
    123                     }
    124                   }
    125                   set {
    126                     if {"" == [$_owner xml element $ppath.value]} {
    127                         error "missing <value> at $ppath"
    128                     }
     122                        set _path2path($spath) $tpath
     123                    }
     124                  }
     125                  set {
     126                    if {"" == [$_owner xml element $ppath.value]} {
     127                        error "missing <value> at $ppath"
     128                    }
    129129puts "set: $spath from $ppath.value"
    130                     $_tool xml copy $spath from \
    131                         [$_owner xml object] $ppath.value
    132                   }
    133                 }
    134             }
    135         }
    136 
    137         if {$_control != "auto"} {
    138             set _show(control) [$_tool xml element -as object tool.control]
    139         } else {
    140             set _show(control) ""
    141         }
     130                    $_tool xml copy $spath from \
     131                        [$_owner xml object] $ppath.value
     132                  }
     133                }
     134            }
     135        }
     136
     137        if {$_control != "auto"} {
     138            set _show(control) [$_tool xml element -as object tool.control]
     139        } else {
     140            set _show(control) ""
     141        }
    142142    }
    143143
    … …  
    150150itcl::body Rappture::Service::destructor {} {
    151151    foreach dir [array names _show] {
    152         foreach obj $_show($dir) {
    153             itcl::delete object $obj
    154         }
     152        foreach obj $_show($dir) {
     153            itcl::delete object $obj
     154        }
    155155    }
    156156}
    … …  
    194194itcl::body Rappture::Service::output {args} {
    195195    if {[llength $args] == 0} {
    196         return $_show(output)
     196        return $_show(output)
    197197    }
    198198    set option [lindex $args 0]
    199199    switch -- $option {
    200         for {
    201             if {[llength $args] != 3} {
    202                 error "wrong # args: should be \"output for object widget\""
    203             }
    204             set obj [lindex $args 1]
    205             set win [lindex $args 2]
    206             if {[info exists _obj2path($obj)]} {
    207                 set path $_obj2path($obj)
     200        for {
     201            if {[llength $args] != 3} {
     202                error "wrong # args: should be \"output for object widget\""
     203            }
     204            set obj [lindex $args 1]
     205            set win [lindex $args 2]
     206            if {[info exists _obj2path($obj)]} {
     207                set path $_obj2path($obj)
    208208puts "OUTPUT $path => $win"
    209                 set _path2widget($path) $win
    210             } else {
    211                 puts "error: don't recognize output object $obj"
    212             }
    213         }
    214         default {
    215             error "bad option \"$option\": should be for"
    216         }
     209                set _path2widget($path) $win
     210            } else {
     211                puts "error: don't recognize output object $obj"
     212            }
     213        }
     214        default {
     215            error "bad option \"$option\": should be for"
     216        }
    217217    }
    218218}
    … …  
    235235
    236236    if {$status == 0 && $result != "ABORT"} {
    237         if {[regexp {=RAPPTURE-RUN=>([^\n]+)} $result match file]} {
    238             set xmlobj [Rappture::library $file]
    239             #
    240             # Scan through all outputs and copy them to the final output
    241             # for the tool.  If they have widgets associated with them,
    242             # set the value for the widget.
    243             #
     237        if {[regexp {=RAPPTURE-RUN=>([^\n]+)} $result match file]} {
     238            set xmlobj [Rappture::library $file]
     239            #
     240            # Scan through all outputs and copy them to the final output
     241            # for the tool.  If they have widgets associated with them,
     242            # set the value for the widget.
     243            #
    244244puts "showing output..."
    245             foreach cname [$xmlobj children output] {
    246                 set path output.$cname
     245            foreach cname [$xmlobj children output] {
     246                set path output.$cname
    247247puts " for $path"
    248                 $_owner xml copy $path from $xmlobj $path
    249 
    250                 if {[info exists _path2widget($path)]} {
    251                     set obj [$xmlobj element -as object $path]
     248                $_owner xml copy $path from $xmlobj $path
     249
     250                if {[info exists _path2widget($path)]} {
     251                    set obj [$xmlobj element -as object $path]
    252252puts " sending $obj to $_path2widget($path)"
    253                     $_path2widget($path) value $obj
    254                 }
    255                 if {[info exists _path2path($path)]} {
     253                    $_path2widget($path) value $obj
     254                }
     255                if {[info exists _path2path($path)]} {
    256256puts " sending $path to $_path2path($path)"
    257                     $_owner xml copy $_path2path($path) from $xmlobj $path
    258                     set w [$_owner widgetfor $_path2path($path)]
    259                     if {$w != ""} {
    260                         set obj [$_owner xml element -as object $_path2path($path)]
    261                         $w value $obj
    262                     }
    263                 }
    264             }
    265             set _result $xmlobj
    266         } else {
    267             set status 1
    268             set result "Can't find result file in output:\n\n$result"
    269         }
     257                    $_owner xml copy $_path2path($path) from $xmlobj $path
     258                    set w [$_owner widgetfor $_path2path($path)]
     259                    if {$w != ""} {
     260                        set obj [$_owner xml element -as object $_path2path($path)]
     261                        $w value $obj
     262                    }
     263                }
     264            }
     265            set _result $xmlobj
     266        } else {
     267            set status 1
     268            set result "Can't find result file in output:\n\n$result"
     269        }
    270270    }
    271271}
    … …  
    288288itcl::body Rappture::Service::clear {} {
    289289    if {"" != $_result} {
    290         foreach cname [$_result children output] {
    291             set path output.$cname
    292 
    293             if {[info exists _path2widget($path)]} {
    294                 $_path2widget($path) value ""
    295             }
    296         }
    297         itcl::delete object $_result
    298         set _result ""
     290        foreach cname [$_result children output] {
     291            set path output.$cname
     292
     293            if {[info exists _path2widget($path)]} {
     294                $_path2widget($path) value ""
     295            }
     296        }
     297        itcl::delete object $_result
     298        set _result ""
    299299    }
    300300}
    … …  
    312312
    313313    if {$_control == "auto" && [regexp -nocase {^input\.} $to]} {
    314         after cancel [itcl::code $this run]
    315         after idle [itcl::code $this run]
    316     }
    317 }
     314        after cancel [itcl::code $this run]
     315        after idle [itcl::code $this run]
     316    }
     317}
Note: See TracChangeset for help on using the changeset viewer.