Changeset 785


Ignore:
Timestamp:
Jul 19, 2007, 5:21:51 AM (17 years ago)
Author:
mmc
Message:

Added support for a <note> on the output side of an <image> object.
This was needed for app-nsopticsjr. We should experiement a little
more with this, design it properly, and apply the same idea to all
output items.

Location:
trunk/gui/scripts
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/htmlviewer.tcl

    r773 r785  
    9898
    9999# ----------------------------------------------------------------------
    100 # USAGE: load <htmlText> ?-file <fileName>?
     100# USAGE: load <htmlText> ?-in <fileName>?
    101101#
    102102# Clients use this to clear the contents and load a new string of
    … …  
    106106itcl::body Rappture::HTMLviewer::load {htmlText args} {
    107107    Rappture::getopts args params {
    108         value -file ""
     108        value -in ""
    109109    }
    110110    if {[llength $args] > 0} {
    111         error "wrong # args: should be \"load text ?-file name?\""
     111        error "wrong # args: should be \"load text ?-in name?\""
    112112    }
    113113
    … …  
    118118    $itk_component(html) parse $htmlText
    119119
    120     if {"" != $params(-file) && [file exists $params(-file)]} {
    121         lappend _dirlist [file dirname $params(-file)]
    122     }
    123 }
    124 
    125 # ----------------------------------------------------------------------
    126 # USAGE: add <htmlText> ?-file <fileName>?
     120    if {"" != $params(-in) && [file exists $params(-in)]} {
     121        if {[file isdirectory $params(-in)]} {
     122            lappend _dirlist $params(-in)
     123        } else {
     124            lappend _dirlist [file dirname $params(-in)]
     125        }
     126    }
     127    $_dispatcher event -now !config
     128}
     129
     130# ----------------------------------------------------------------------
     131# USAGE: add <htmlText> ?-in <fileName>?
    127132#
    128133# Clients use this to add the <htmlText> to the bottom of the contents
    … …  
    131136itcl::body Rappture::HTMLviewer::add {htmlText args} {
    132137    Rappture::getopts args params {
    133         value -file ""
     138        value -in ""
    134139    }
    135140    if {[llength $args] > 0} {
    136         error "wrong # args: should be \"add text ?-file name?\""
     141        error "wrong # args: should be \"add text ?-in name?\""
    137142    }
    138143
    139144    $itk_component(html) parse $htmlText
    140145
    141     if {"" != $params(-file) && [file exists $params(-file)]} {
    142         lappend _dirlist [file dirname $params(-file)]
    143     }
     146    if {"" != $params(-in) && [file exists $params(-in)]} {
     147        if {[file isdirectory $params(-in)]} {
     148            lappend _dirlist $params(-in)
     149        } else {
     150            lappend _dirlist [file dirname $params(-in)]
     151        }
     152    }
     153    $_dispatcher event -now !config
    144154}
    145155
    … …  
    151161# to pop up further information.  If the <url> starts with http://
    152162# or https://, then it is used directly.  Otherwise, it is treated
    153 # as a relative file path and resolved with respect to the -file
     163# as a relative file path and resolved with respect to the -in
    154164# options passed into load/add.
    155165# ----------------------------------------------------------------------
    … …  
    305315# Used internally to convert a <fileName> to its corresponding image
    306316# handle.  If the <fileName> is relative, then it is loaded with
    307 # respect to the paths given by the -file option for the load/add
     317# respect to the paths given by the -in option for the load/add
    308318# methods.  Returns an image handle for the image within the file,
    309319# or the broken image icon if anything goes wrong.

  • trunk/gui/scripts/image.tcl

    r127 r785  
    2424    public method hints {{keyword ""}}
    2525
    26     private variable _xmlobj ""  ;# ref to lib obj with curve data
     26    private variable _xmlobj ""  ;# ref to lib obj with image data
     27    private variable _path ""    ;# path in _xmlobj where data sits
    2728    private variable _image ""   ;# underlying image data
     29    private variable _hints
    2830}
    2931
    … …  
    3638    }
    3739    set _xmlobj $xmlobj
     40    set _path $path
    3841    set data [string trim [$xmlobj get $path.current]]
    3942    if {[string length $data] == 0} {
    … …  
    4245        set _image [image create photo -data $data]
    4346    }
     47
     48    set _hints(note) [string trim [$_xmlobj get $_path.note.contents]]
     49    set _hints(tooldir) [$_xmlobj get tool.version.application.directory(tool)]
    4450}
    4551
    … …  
    5965# ----------------------------------------------------------------------
    6066itcl::body Rappture::Image::hints {{keyword ""}} {
    61     return ""
     67    if {$keyword != ""} {
     68        if {[info exists _hints($keyword)]} {
     69            return $_hints($keyword)
     70        }
     71        return ""
     72    }
     73    return [array get _hints]
    6274}

  • trunk/gui/scripts/imageresult.tcl

    r767 r785  
    3636
    3737    protected method _rebuild {args}
    38     protected method _topimage {}
     38    protected method _top {what}
    3939    protected method _zoom {option args}
    4040    protected method _move {option args}
    … …  
    6363        max 1.0
    6464        current 1.0
     65        default 1
    6566        x 0
    6667        y 0
    … …  
    7071    pack propagate $itk_component(hull) no
    7172
     73    Rappture::Panes $itk_interior.panes -sashwidth 1 -sashrelief solid -sashpadding 2
     74    pack $itk_interior.panes -expand yes -fill both
     75    set main [$itk_interior.panes pane 0]
     76    $itk_interior.panes fraction 0 1
     77
    7278    itk_component add controls {
    73         frame $itk_interior.cntls
     79        frame $main.cntls
    7480    } {
    7581        usual
    … …  
    122128
    123129    itk_component add image {
    124         label $itk_interior.image -image $_image(final)
     130        label $main.image -image $_image(final)
    125131    } {
    126132        keep -background -foreground -cursor -font
    … …  
    140146    bind $itk_component(image) <ButtonRelease-1> \
    141147        [itcl::code $this _move release %x %y]
     148
     149    #
     150    # Add area at the bottom for notes.
     151    #
     152    set notes [$itk_interior.panes insert end -fraction 0.15]
     153    $itk_interior.panes visibility 1 off
     154    Rappture::Scroller $notes.scr -xscrollmode auto -yscrollmode auto
     155    pack $notes.scr -expand yes -fill both
     156    itk_component add notes {
     157        Rappture::HTMLviewer $notes.scr.html
     158    }
     159    $notes.scr contents $notes.scr.html
    142160
    143161    eval itk_initialize $args
    … …  
    287305        }
    288306        now {
    289             set top [_topimage]
     307            set top [_top image]
    290308            if {$top == ""} {
    291309                return ""
    … …  
    331349        }
    332350    }
    333     if {$_scale(current) == "?"} {
    334         _zoom reset
     351    if {$_scale(current) == "?" || $_scale(default)} {
     352        set _scale(current) $_scale(max)
     353        set _scale(x) 0
     354        set _scale(y) 0
    335355    }
    336356
    … …  
    343363    $_image(final) put $bg -to 0 0 $w $h
    344364
    345     set imh [_topimage]
     365    set imh [_top image]
    346366    if {$imh != ""} {
    347367        if {$_scale(current) <= 1.0} {
    … …  
    369389        }
    370390    }
    371 }
    372 
    373 # ----------------------------------------------------------------------
    374 # USAGE: _topimage
     391
     392    set note [_top note]
     393    if {[string length $note] > 0} {
     394        if {[regexp {^html://} $note]} {
     395            set note [string range $note 7 end]
     396        } else {
     397            regexp {&} $note {\007} note
     398            regexp {<} $note {\&lt;} note
     399            regexp {>} $note {\&gt;} note
     400            regexp {\007} $note {\&amp;} note
     401            regexp "\n\n" $note {<br/>} note
     402            set note "<html><body>$note</body></html>"
     403        }
     404        set notes [$itk_interior.panes pane 1]
     405        $itk_component(notes) load $note -in [file join [_top tooldir] docs]
     406        $itk_interior.panes visibility 1 on
     407    } else {
     408        $itk_interior.panes visibility 1 off
     409    }
     410}
     411
     412# ----------------------------------------------------------------------
     413# USAGE: _top image|note|tooldir
    375414#
    376415# Used internally to get the topmost image currently being displayed.
    377416# ----------------------------------------------------------------------
    378 itcl::body Rappture::ImageResult::_topimage {} {
     417itcl::body Rappture::ImageResult::_top {option} {
    379418    set top $_topmost
    380419    if {"" == $top} {
    … …  
    382421    }
    383422    if {"" != $top} {
    384         return [$top tkimage]
     423        switch -- $option {
     424            image   { return [$top tkimage] }
     425            note    { return [$top hints note] }
     426            tooldir { return [$top hints tooldir] }
     427            default { error "bad option \"$option\": should be image, note, tooldir" }
     428        }
    385429    }
    386430    return ""
    … …  
    418462        reset {
    419463            set _scale(current) $_scale(max)
     464            set _scale(default) 1
    420465            set _scale(x) 0
    421466            set _scale(y) 0
    … …  
    423468        in {
    424469            set _scale(current) [expr {$_scale(current)*0.5}]
     470            set _scale(default) 0
    425471        }
    426472        out {
    … …  
    442488                }
    443489            }
     490            set _scale(default) 0
    444491        }
    445492    }

  • trunk/gui/scripts/note.tcl

    r761 r785  
    150150                set html "<html><body><p>[_escapeChars $html]</p></body></html>"
    151151            }
    152             $itk_component(html) load $html -file $file
     152            $itk_component(html) load $html -in $file
    153153        }
    154154        default {

  • trunk/gui/scripts/panes.tcl

    r428 r785  
    3333    public method insert {pos args}
    3434    public method pane {pos}
     35    public method visibility {pos {newval ""}}
    3536    public method fraction {pos {newval ""}}
    3637    public method hilite {state sash}
    … …  
    4445    private variable _dispatcher ""  ;# dispatcher for !events
    4546    private variable _panes ""       ;# list of pane frames
     47    private variable _visibility ""  ;# list of visibilities for panes
    4648    private variable _counter 0      ;# counter for auto-generated names
    47     private variable _frac 1.0       ;# list of fractions
     49    private variable _frac 0.0       ;# list of fractions
    4850}
    4951
    … …  
    7476
    7577    lappend _panes $pname
     78    lappend _visibility 1
     79    set _frac 0.5
    7680
    7781    eval itk_initialize $args
    … …  
    128132        frame $itk_interior.$pname
    129133    }
    130     lappend _panes $pname
    131 
    132     # fix the fractional sizes
    133     set f $params(-fraction)
    134     set _frac [list [expr {1-$f}] $f]
     134    set _panes [linsert $_panes $pos $pname]
     135    set _visibility [linsert $_visibility $pos 1]
     136    set _frac [linsert $_frac $pos $params(-fraction)]
    135137
    136138    # fix sash characteristics
    … …  
    157159
    158160# ----------------------------------------------------------------------
     161# USAGE: visibility <pos> ?<newval>?
     162#
     163# Clients use this to get/set the visibility of the pane at position
     164# <pos>.
     165# ----------------------------------------------------------------------
     166itcl::body Rappture::Panes::visibility {pos {newval ""}} {
     167    if {"" == $newval} {
     168        return [lindex $_visibility $pos]
     169    }
     170    if {![string is boolean $newval]} {
     171        error "bad value \"$newval\": should be boolean"
     172    }
     173    if {$pos == "end" || ($pos >= 0 && $pos < [llength $_visibility])} {
     174        set _visibility [lreplace $_visibility $pos $pos [expr {$newval}]]
     175        $_dispatcher event -idle !layout
     176    } else {
     177        error "bad index \"$pos\": out of range"
     178    }
     179}
     180
     181# ----------------------------------------------------------------------
    159182# USAGE: fraction <pos> ?<newval>?
    160183#
    … …  
    170193    }
    171194    if {$pos == "end" || ($pos >= 0 && $pos < [llength $_frac])} {
    172         # if there are other panes, adjust their size according to this
    173         if {[llength $_frac] > 1} {
    174             set oldval [lindex $_frac $pos]
    175             set delta [expr {double($oldval-$newval)/([llength $_frac]-1)}]
    176             for {set i 0} {$i < [llength $_frac]} {incr i} {
    177                 set v [lindex $_frac $i]
    178                 set _frac [lreplace $_frac $i $i [expr {$v+$delta}]]
    179             }
    180         }
    181         set _frac [lreplace $_frac $pos $pos $newval]
     195        set len [llength $_frac]
     196        set _frac [lreplace $_frac $pos $pos xxx]
     197        set total 0
     198        foreach f $_frac {
     199            if {"xxx" != $f} {
     200                set total [expr {$total+$f}]
     201            }
     202        }
     203        for {set i 0} {$i < $len} {incr i} {
     204            set f [lindex $_frac $i]
     205            if {"xxx" == $f} {
     206                set f $newval
     207            } else {
     208                set f [expr {$f/$total - $newval/double($len-1)}]
     209            }
     210            set _frac [lreplace $_frac $i $i $f]
     211        }
    182212        $_dispatcher event -idle !layout
    183213    } else {
    … …  
    243273        set frac 0.95
    244274    }
    245 
    246     set _frac [list $frac [expr {1-$frac}]]
     275    if {[llength $_frac] == 2} {
     276        set _frac [list $frac [expr {1-$frac}]]
     277    } else {
     278        set i [expr {[lsearch $_panes $pname]-1}]
     279        if {$i >= 0} {
     280            set _frac [lreplace $_frac $i $i $frac]
     281        }
     282    }
    247283    _fixLayout
    248284
    … …  
    267303itcl::body Rappture::Panes::_fixLayout {args} {
    268304    set h [winfo height $itk_component(hull)]
    269     foreach p [lrange $_panes 1 end] {
    270         set h [expr {$h - [winfo height $itk_component(${p}sash)]}]
    271     }
    272 
     305
     306    set plist ""
     307    set flist ""
     308    foreach p $_panes f $_frac v $_visibility {
     309        set sash ${p}sash
     310        if {$v} {
     311            # this pane is visible -- make room for it
     312            lappend plist $p
     313            lappend flist $f
     314            if {[info exists itk_component($sash)]} {
     315                set h [expr {$h - [winfo height $itk_component($sash)]}]
     316            }
     317        } else {
     318            # this pane is not visible -- remove sash
     319            if {[info exists itk_component($sash)]} {
     320                place forget $itk_component($sash)
     321            }
     322            place forget $itk_component($p)
     323        }
     324    }
     325
     326    # normalize the fractions so they add up to 1
     327    set total 0
     328    foreach f $flist { set total [expr {$total+$f}] }
     329    set newflist ""
     330    foreach f $flist {
     331        lappend newflist [expr {double($f)/$total}]
     332    }
     333    set flist $newflist
     334
     335    # lay out the various panes
    273336    set y 0
    274     foreach p $_panes f $_frac {
     337    foreach p $plist f $flist {
    275338        set sash ${p}sash
    276339        if {[info exists itk_component($sash)]} {
Note: See TracChangeset for help on using the changeset viewer.