1# ------------------------------------------------------------------------------
2#  titleframe.tcl
3#  This file is part of Unifix BWidget Toolkit
4# ------------------------------------------------------------------------------
5#  Index of commands:
6#     - TitleFrame::create
7#     - TitleFrame::configure
8#     - TitleFrame::cget
9#     - TitleFrame::getframe
10#     - TitleFrame::_place
11# ------------------------------------------------------------------------------
12
13namespace eval TitleFrame {
14    Widget::define TitleFrame titleframe
15
16    Widget::declare TitleFrame {
17        {-relief      TkResource groove 0 frame}
18        {-borderwidth TkResource 2      0 frame}
19        {-font        TkResource ""     0 label}
20        {-foreground  TkResource ""     0 label}
21        {-state       TkResource ""     0 label}
22        {-background  TkResource ""     0 frame}
23        {-text        String     ""     0}
24        {-ipad        Int        4      0 "%d >=0"}
25        {-side        Enum       left   0 {left center right}}
26        {-baseline    Enum       center 0 {top center bottom}}
27        {-fg          Synonym    -foreground}
28        {-bg          Synonym    -background}
29        {-bd          Synonym    -borderwidth}
30    }
31
32    Widget::addmap TitleFrame "" :cmd {-background {}}
33    Widget::addmap TitleFrame "" .l   {
34    	-background {} -foreground {} -text {} -font {}
35    }
36    Widget::addmap TitleFrame "" .l   {-state {}}
37    Widget::addmap TitleFrame "" .p   {-background {}}
38    Widget::addmap TitleFrame "" .b   {
39    	-background {} -relief {} -borderwidth {}
40    }
41    Widget::addmap TitleFrame "" .b.p {-background {}}
42    Widget::addmap TitleFrame "" .f   {-background {}}
43}
44
45
46# ------------------------------------------------------------------------------
47#  Command TitleFrame::create
48# ------------------------------------------------------------------------------
49proc TitleFrame::create { path args } {
50    Widget::init TitleFrame $path $args
51
52    set frame  [eval [list frame $path] [Widget::subcget $path :cmd] \
53	    -class TitleFrame -relief flat -bd 0 -highlightthickness 0]
54
55    set padtop [eval [list frame $path.p] [Widget::subcget $path :cmd] \
56	    -relief flat -borderwidth 0]
57    set border [eval [list frame $path.b] [Widget::subcget $path .b] -highlightthickness 0]
58    set label  [eval [list label $path.l] [Widget::subcget $path .l] \
59                    -highlightthickness 0 \
60                    -relief flat \
61                    -bd     0 -padx 2 -pady 0]
62    set padbot [eval [list frame $border.p] [Widget::subcget $path .p] \
63	    -relief flat -bd 0 -highlightthickness 0]
64    set frame  [eval [list frame $path.f] [Widget::subcget $path .f] \
65	    -relief flat -bd 0 -highlightthickness 0]
66    set height [winfo reqheight $label]
67
68    switch [Widget::getoption $path -side] {
69        left   { set relx 0.0; set x 5;  set anchor nw }
70        center { set relx 0.5; set x 0;  set anchor n  }
71        right  { set relx 1.0; set x -5; set anchor ne }
72    }
73    set bd [Widget::getoption $path -borderwidth]
74    switch [Widget::getoption $path -baseline] {
75        top    {
76	    set y    0
77	    set htop $height
78	    set hbot 1
79	}
80        center {
81	    set y    0
82	    set htop [expr {$height/2}]
83	    set hbot [expr {$height/2+$height%2+1}]
84	}
85        bottom {
86	    set y    [expr {$bd+1}]
87	    set htop 1
88	    set hbot $height
89	}
90    }
91    $padtop configure -height $htop
92    $padbot configure -height $hbot
93
94    set pad [Widget::getoption $path -ipad]
95    pack $padbot -side top -fill x
96    pack $frame  -in $border -fill both -expand yes -padx $pad -pady $pad
97
98    pack $padtop -side top -fill x
99    pack $border -fill both -expand yes
100
101    place $label -relx $relx -x $x -anchor $anchor -y $y
102
103    bind $label <Configure> [list TitleFrame::_place $path]
104    bind $path  <Destroy>   [list Widget::destroy %W]
105
106    return [Widget::create TitleFrame $path]
107}
108
109
110# ------------------------------------------------------------------------------
111#  Command TitleFrame::configure
112# ------------------------------------------------------------------------------
113proc TitleFrame::configure { path args } {
114    set res [Widget::configure $path $args]
115
116    if { [Widget::hasChanged $path -ipad pad] } {
117        pack configure $path.f -padx $pad -pady $pad
118    }
119    if { [Widget::hasChanged $path -borderwidth val] |
120         [Widget::hasChanged $path -font        val] |
121         [Widget::hasChanged $path -side        val] |
122         [Widget::hasChanged $path -baseline    val] } {
123        _place $path
124    }
125
126    return $res
127}
128
129
130# ------------------------------------------------------------------------------
131#  Command TitleFrame::cget
132# ------------------------------------------------------------------------------
133proc TitleFrame::cget { path option } {
134    return [Widget::cget $path $option]
135}
136
137
138# ------------------------------------------------------------------------------
139#  Command TitleFrame::getframe
140# ------------------------------------------------------------------------------
141proc TitleFrame::getframe { path } {
142    return $path.f
143}
144
145
146# ------------------------------------------------------------------------------
147#  Command TitleFrame::_place
148# ------------------------------------------------------------------------------
149proc TitleFrame::_place { path } {
150    set height [winfo height $path.l]
151    switch [Widget::getoption $path -side] {
152        left    { set relx 0.0; set x 10;  set anchor nw }
153        center  { set relx 0.5; set x 0;   set anchor n  }
154        right   { set relx 1.0; set x -10; set anchor ne }
155    }
156    set bd [Widget::getoption $path -borderwidth]
157    switch [Widget::getoption $path -baseline] {
158        top    { set htop $height; set hbot 1; set y 0 }
159        center { set htop [expr {$height/2}]; set hbot [expr {$height/2+$height%2+1}]; set y 0 }
160        bottom { set htop 1; set hbot $height; set y [expr {$bd+1}] }
161    }
162    $path.p   configure -height $htop
163    $path.b.p configure -height $hbot
164
165    place $path.l -relx $relx -x $x -anchor $anchor -y $y
166}
167
168
169
170
171