source: trunk/gui/scripts/mainwin.tcl @ 1

Last change on this file since 1 was 1, checked in by mmc, 17 years ago

initial import

File size: 8.7 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: mainwin - main application window for Rappture
3#
4#  This widget acts as the main window for a Rappture application.
5#  It can be configured to run in two modes:  1) normal desktop
6#  application, and 2) web-based application.  In web-based mode,
7#  the application window runs inside a VNC window, and it takes
8#  the full screen and blends in with the web page.
9# ======================================================================
10#  AUTHOR:  Michael McLennan, Purdue University
11#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
12# ======================================================================
13package require Itk
14
15option add *MainWin.mode desktop widgetDefault
16option add *MainWin.borderWidth 0 widgetDefault
17option add *MainWin.relief raised widgetDefault
18option add *MainWin.anchor center widgetDefault
19option add *MainWin.titleFont \
20    -*-helvetica-bold-o-normal-*-*-140-* widgetDefault
21
22itcl::class Rappture::MainWin {
23    inherit itk::Toplevel
24
25    itk_option define -mode mode Mode ""
26    itk_option define -anchor anchor Anchor "center"
27    itk_option define -bgscript bgScript BgScript ""
28
29    constructor {args} { # defined below }
30
31    public method draw {option args}
32
33    protected method _redraw {}
34
35    private variable _contents ""  ;# frame containing app
36    private variable _bgscript ""  ;# script of background drawing cmds
37    private variable _bgparser ""  ;# parser for bgscript
38}
39                                                                               
40itk::usual MainWin {
41    keep -background -cursor foreground -font
42}
43
44# ----------------------------------------------------------------------
45# CONSTRUCTOR
46# ----------------------------------------------------------------------
47itcl::body Rappture::MainWin::constructor {args} {
48    itk_component add area {
49        canvas $itk_interior.area
50    } {
51        usual
52        rename -background -bgcolor bgColor Background
53    }
54    pack $itk_component(area) -expand yes -fill both
55    bind $itk_component(area) <Configure> [itcl::code $this _redraw]
56
57    itk_component add app {
58        frame $itk_component(area).app
59    } {
60        usual
61        keep -borderwidth -relief
62    }
63    bind $itk_component(app) <Configure> "
64        after cancel [itcl::code $this _redraw]
65        after idle [itcl::code $this _redraw]
66    "
67
68    itk_component add menu {
69        menu $itk_interior.menu
70    }
71    itk_component add filemenu {
72        menu $itk_component(menu).file
73    }
74    $itk_component(menu) add cascade -label "File" -underline 0 \
75        -menu $itk_component(filemenu)
76    $itk_component(filemenu) add command -label "Exit" -underline 1 \
77        -command exit
78
79    #
80    # Create a parser for the -bgscript option that can
81    # execute drawing commands on the canvas.  This allows
82    # us to draw a background that blends in with web pages.
83    #
84    set _bgparser [interp create -safe]
85    $_bgparser alias rectangle [itcl::code $this draw rectangle]
86    $_bgparser alias oval [itcl::code $this draw oval]
87    $_bgparser alias line [itcl::code $this draw line]
88    $_bgparser alias polygon [itcl::code $this draw polygon]
89    $_bgparser alias text [itcl::code $this draw text]
90    $_bgparser alias image [itcl::code $this draw image]
91
92    eval itk_initialize $args
93
94    bind RapptureMainWin <Destroy> { exit }
95    set btags [bindtags $itk_component(hull)]
96    bindtags $itk_component(hull) [lappend btags RapptureMainWin]
97}
98
99# ----------------------------------------------------------------------
100# USAGE: draw <option> ?<arg> <arg>...?
101#
102# Used by the -bgscript to draw items in the background area behind
103# the app when "-mode web" is active.  This allows an application
104# to create a background that blends seamlessly with the underlying
105# web page.
106# ----------------------------------------------------------------------
107itcl::body Rappture::MainWin::draw {option args} {
108    set w $itk_component(hull)
109    regsub -all {<w>} $args [winfo screenwidth $w] args
110    regsub -all {<h>} $args [winfo screenheight $w] args
111    eval $itk_component(area) create $option $args
112}
113
114# ----------------------------------------------------------------------
115# USAGE: _redraw
116#
117# Used internally to redraw the widget whenever it changes size.
118# This matters only when "-mode web" is active, when the background
119# area is actually visible.
120# ----------------------------------------------------------------------
121itcl::body Rappture::MainWin::_redraw {} {
122    $itk_component(area) delete all
123    if {$itk_option(-mode) == "web"} {
124        if {[catch {$_bgparser eval $itk_option(-bgscript)} result]} {
125            bgerror "$result\n    (while redrawing application background)"
126        }
127
128        set sw [winfo width $itk_component(area)]
129        set sh [winfo height $itk_component(area)]
130
131        set clip 0
132        set w [winfo reqwidth $itk_component(app)]
133        set h [winfo reqheight $itk_component(app)]
134        if {$w > $sw} {
135            set $w $sw
136            set clip 1
137        }
138
139        set titleh 0
140        set fnt [option get $itk_component(hull) titleFont Font]
141        if {$itk_option(-title) != "" && $fnt != ""} {
142            set titleh [expr {[font metrics $fnt -linespace]+2}]
143        }
144        if {$h+$titleh > $sh} {
145            set $h [expr {$sh-$titleh}]
146            set clip 1
147        }
148
149        switch -- $itk_option(-anchor) {
150            n {
151                set x [expr {$sw/2}]
152                set y $titleh
153                set tx [expr {$x-$w/2}]
154                set ty $titleh
155            }
156            s {
157                set x [expr {$sw/2}]
158                set y $sh
159                set tx [expr {$x-$w/2}]
160                set ty [expr {$sh-$h}]
161            }
162            center {
163                set x [expr {$sw/2}]
164                set y [expr {$sh/2}]
165                set tx [expr {$x-$w/2}]
166                set ty [expr {$y-$h/2}]
167            }
168            w {
169                set x 0
170                set y [expr {$sh/2}]
171                set tx 0
172                set ty [expr {$y-$h/2}]
173            }
174            e {
175                set x $sw
176                set y [expr {$sh/2}]
177                set tx [expr {$sw-$w}]
178                set ty [expr {$y-$h/2}]
179            }
180            nw {
181                set x 0
182                set y $titleh
183                set tx 0
184                set ty $titleh
185            }
186            ne {
187                set x $sw
188                set y $titleh
189                set tx [expr {$sw-$w}]
190                set ty $titleh
191            }
192            sw {
193                set x 0
194                set y $sh
195                set tx 0
196                set ty [expr {$sh-$h}]
197            }
198            se {
199                set x $sw
200                set y $sh
201                set tx [expr {$sw-$w}]
202                set ty [expr {$sh-$h}]
203            }
204        }
205
206        # if the app is too big, use w/h. otherwise, 0,0 for default size
207        if {!$clip} {
208            set w 0
209            set h 0
210        }
211
212        $itk_component(area) create window $x $y \
213            -anchor $itk_option(-anchor) -window $itk_component(app) \
214            -width $w -height $h
215
216        if {$itk_option(-title) != "" && $fnt != ""} {
217            $itk_component(area) create text $tx [expr {$ty-2}] \
218                -anchor sw -text $itk_option(-title) -font $fnt
219        }
220    }
221}
222
223# ----------------------------------------------------------------------
224# OPTION: -mode
225# ----------------------------------------------------------------------
226itcl::configbody Rappture::MainWin::mode {
227    switch -- $itk_option(-mode) {
228        desktop {
229            component hull configure -menu $itk_component(hull).menu
230            pack $itk_component(app) -expand yes -fill both
231            wm geometry $itk_component(hull) ""
232        }
233        web {
234            component hull configure -menu ""
235            pack forget $itk_component(app)
236            set wx [winfo screenwidth $itk_component(hull)]
237            set wy [winfo screenheight $itk_component(hull)]
238            wm geometry $itk_component(hull) ${wx}x${wy}+0+0
239            _redraw
240        }
241        default {
242            error "bad value \"$itk_option(-mode)\": should be desktop or web"
243        }
244    }
245}
246
247# ----------------------------------------------------------------------
248# OPTION: -bgscript
249# ----------------------------------------------------------------------
250itcl::configbody Rappture::MainWin::bgscript {
251    _redraw
252}
253
254# ----------------------------------------------------------------------
255# OPTION: -anchor
256# ----------------------------------------------------------------------
257itcl::configbody Rappture::MainWin::anchor {
258    if {[lsearch {n s e w ne nw se sw center} $itk_option(-anchor)] < 0} {
259        error "bad anchor \"$itk_option(-anchor)\""
260    }
261    _redraw
262}
Note: See TracBrowser for help on using the repository browser.