# -*- mode: tcl; indent-tabs-mode: nil -*-
# ----------------------------------------------------------------------
# COMPONENT: page - single page of widgets
#
# This widget is a smart frame. It takes the XML description for
# a Rappture or an and decides how to lay
# out the widgets for the controls within it. It uses various
# heuristics to achieve a decent layout under a variety of
# circumstances.
# ======================================================================
# AUTHOR: Michael McLennan, Purdue University
# Copyright (c) 2004-2012 HUBzero Foundation, LLC
#
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# ======================================================================
package require Itk
itcl::class Rappture::Page {
inherit itk::Widget
constructor {owner path args} { # defined below }
protected method _buildGroup {frame xmlobj path}
protected method _link {xmlobj path widget path2}
private variable _owner "" ;# thing managing this page
}
itk::usual Page {
}
# ----------------------------------------------------------------------
# CONSTRUCTOR
# ----------------------------------------------------------------------
itcl::body Rappture::Page::constructor {owner path args} {
if {[catch {$owner isa Rappture::ControlOwner} valid] || !$valid} {
error "object \"$owner\" is not a Rappture::ControlOwner"
}
set _owner $owner
set xmlobj [$owner xml object]
set type [$xmlobj element -as type $path]
if {$type != "input" && $type != "phase"} {
error "bad path \"$path\" in $xmlobj: should be or "
}
eval itk_initialize $args
# build all of the controls for this page
_buildGroup $itk_interior $xmlobj $path
}
# ----------------------------------------------------------------------
# USAGE: _buildGroup
#
# Used internally when this page is being constructed to build the
# controls within the group at the specified in the .
# The controls are added to the given .
# ----------------------------------------------------------------------
itcl::body Rappture::Page::_buildGroup {frame xmlobj path} {
frame $frame.results
pack $frame.results -side right -fill y
set deveditor ""
#
# Scan through all remaining input elements. If there is an
# ambient group, then add its children to the device editor,
# if there is one.
#
set num 0
set clist [$xmlobj children $path]
while {[llength $clist] > 0} {
set cname [lindex $clist 0]
set clist [lrange $clist 1 end]
set type [$xmlobj element -as type $path.$cname]
if {$type == "about"} {
continue
}
if {$type == "loader"} {
#
# Add 's at the top of the page.
#
if {![winfo exists $frame.loaders]} {
frame $frame.loaders
pack $frame.loaders -side top -fill x
frame $frame.loaders.sep -height 2 \
-borderwidth 1 -relief sunken
pack $frame.loaders.sep -side bottom -fill x -pady 4
}
set w "$frame.loaders.l[incr num]"
Rappture::Controls $w $_owner
pack $w -fill x
$w insert end $path.$cname
} elseif {$type == "structure"} {
#
# Add 's as the central element of the page.
#
set w "$frame.device[incr num]"
Rappture::DeviceEditor ::$w $_owner@$path.$cname.current
pack $w -expand yes -fill both
$_owner widgetfor $path.$cname $w
bind $w <> [list $_owner changed $path.$cname]
if {"" == $deveditor} {
set deveditor $w
}
# if there's a default value, load it now
if {"" != [$xmlobj element -as type $path.$cname.current]} {
set elem $path.$cname.current
} else {
set elem $path.$cname.default
}
if {"" != [$xmlobj element -as type $elem]} {
set val [$xmlobj get $elem]
if {[string length $val] > 0} {
$w value $val
$xmlobj put $path.$cname.current $val
} else {
set obj [$xmlobj element -as object $elem]
$w value $obj
$xmlobj put $path.$cname.current $obj
}
}
# if there's a link, then set up a callback to load from it
set link [$xmlobj get $path.$cname.link]
if {"" != $link} {
$_owner notify add $this $link \
[itcl::code $this _link $xmlobj $link $w $path.$cname]
}
} elseif {$type == "tool"} {
set service [Rappture::Service ::#auto $_owner $path.$cname]
#
# Scan through all extra inputs associated with this subtool
# and create corresponding inputs in the top-level tool.
# Then, add the input names to the list being processed here,
# so that we'll create the controls during subsequent passes
# through the loop.
#
set extra ""
foreach obj [$service input] {
set cname [$obj element]
$xmlobj copy $path.$cname from $obj ""
lappend extra $cname
}
#
# If there's a control for this service, then add it
# to the end of the extra controls added above.
#
foreach obj [$service control] {
set cname [$obj element]
$xmlobj copy $path.$cname from $obj ""
$xmlobj put $path.$cname.service $service
lappend extra $cname
}
if {[llength $extra] > 0} {
set clist [eval linsert [list $clist] 0 $extra]
}
#
# Scan through all outputs associated with this subtool
# and create any corresponding feedback widgets.
#
foreach obj [$service output] {
set cname [$obj element]
$xmlobj copy $cname from $obj ""
# pick a good size based on output type
set w $frame.results.result[incr num]
set type [$obj element -as type]
switch -- $type {
number - integer - boolean - choice {
Rappture::ResultViewer $w -width 0 -height 0
pack $w -fill x -padx 4 -pady 4
}
default {
Rappture::ResultViewer $w -width 4i -height 4i
pack $w -expand yes -fill both -padx 4 -pady 4
}
}
$service output for $obj $w
}
} elseif {$type == "current"} {
# Don't do anything.
} else {
# create a control panel, if necessary
if {![winfo exists $frame.cntls]} {
Rappture::Controls $frame.cntls $_owner \
-layout [$xmlobj get $path.about.layout]
pack $frame.cntls -expand yes -fill both -pady 4
}
# if this is a group, then build that group
if {[$xmlobj element -as type $path.$cname] eq "group"} {
if {[$xmlobj element -as id $path.$cname] eq "ambient"
&& $deveditor != ""} {
set w [$deveditor component top]
} else {
if {[$_owner widgetfor $path.$cname] ne ""} {
# widget already created -- skip this
} elseif {[catch {$frame.cntls insert end $path.$cname} c]} {
global errorInfo
error $c "$c\n$errorInfo\n (while building control for $path.$cname)"
} else {
set gentry [$frame.cntls control $c]
set w [$gentry component inner]
}
}
_buildGroup $w $xmlobj $path.$cname
} else {
if {[$_owner widgetfor $path.$cname] ne ""} {
# widget already created -- skip this
} elseif {[catch {$frame.cntls insert end $path.$cname} c]} {
global errorInfo
error $c "$c\n$errorInfo\n (while building control for $path.$cname)"
}
}
}
}
}
itcl::body Rappture::Page::_link {xmlobj path w path2} {
if {"" != [$xmlobj element -as type $path.current]} {
set val [$xmlobj get $path.current]
if {[string length $val] > 0} {
$w value $val
$xmlobj put $path.current $val
} else {
set obj [$xmlobj element -as object $path.current]
$w value $obj
$xmlobj put $path.current $obj
}
}
$_owner changed $path2
}