1# ---------------------------------------------------------------------------- 2# font.tcl 3# This file is part of Unifix BWidget Toolkit 4# ---------------------------------------------------------------------------- 5# Index of commands: 6# - SelectFont::create 7# - SelectFont::configure 8# - SelectFont::cget 9# - SelectFont::_draw 10# - SelectFont::_destroy 11# - SelectFont::_modstyle 12# - SelectFont::_update 13# - SelectFont::_getfont 14# - SelectFont::_init 15# ---------------------------------------------------------------------------- 16 17namespace eval SelectFont { 18 Widget::define SelectFont font Dialog LabelFrame ScrolledWindow 19 20 Widget::declare SelectFont { 21 {-title String "Font selection" 0} 22 {-parent String "" 0} 23 {-background TkResource "" 0 frame} 24 25 {-type Enum dialog 0 {dialog toolbar}} 26 {-font TkResource "" 0 label} 27 {-families String "all" 1} 28 {-querysystem Boolean 1 0} 29 {-styles String "bold italic underline overstrike" 1} 30 {-command String "" 0} 31 {-sampletext String "Sample Text" 0} 32 {-bg Synonym -background} 33 } 34 35 variable _families 36 variable _styleOff 37 array set _styleOff [list bold normal italic roman] 38 variable _sizes {4 5 6 7 8 9 10 11 12 13 14 15 16 \ 39 17 18 19 20 21 22 23 24} 40 41 # Set up preset lists of fonts, so the user can avoid the painfully slow 42 # loadfont process if desired. 43 if { [string equal $::tcl_platform(platform) "windows"] } { 44 set presetVariable [list \ 45 7x14 \ 46 Arial \ 47 {Arial Narrow} \ 48 {Lucida Sans} \ 49 {MS Sans Serif} \ 50 {MS Serif} \ 51 {Times New Roman} \ 52 ] 53 set presetFixed [list \ 54 6x13 \ 55 {Courier New} \ 56 FixedSys \ 57 Terminal \ 58 ] 59 set presetAll [list \ 60 6x13 \ 61 7x14 \ 62 Arial \ 63 {Arial Narrow} \ 64 {Courier New} \ 65 FixedSys \ 66 {Lucida Sans} \ 67 {MS Sans Serif} \ 68 {MS Serif} \ 69 Terminal \ 70 {Times New Roman} \ 71 ] 72 } else { 73 set presetVariable [list \ 74 helvetica \ 75 lucida \ 76 lucidabright \ 77 {times new roman} \ 78 ] 79 set presetFixed [list \ 80 courier \ 81 fixed \ 82 {lucida typewriter} \ 83 screen \ 84 serif \ 85 terminal \ 86 ] 87 set presetAll [list \ 88 courier \ 89 fixed \ 90 helvetica \ 91 lucida \ 92 lucidabright \ 93 {lucida typewriter} \ 94 screen \ 95 serif \ 96 terminal \ 97 {times new roman} \ 98 ] 99 } 100 array set _families [list \ 101 presetvariable $presetVariable \ 102 presetfixed $presetFixed \ 103 presetall $presetAll \ 104 ] 105 106 variable _widget 107} 108 109 110# ---------------------------------------------------------------------------- 111# Command SelectFont::create 112# ---------------------------------------------------------------------------- 113proc SelectFont::create { path args } { 114 variable _families 115 variable _sizes 116 variable $path 117 upvar 0 $path data 118 119 # Initialize the internal rep of the widget options 120 Widget::init SelectFont "$path#SelectFont" $args 121 122 if { [Widget::getoption "$path#SelectFont" -querysystem] } { 123 loadfont [Widget::getoption "$path#SelectFont" -families] 124 } 125 126 set bg [Widget::getoption "$path#SelectFont" -background] 127 set _styles [Widget::getoption "$path#SelectFont" -styles] 128 if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } { 129 Dialog::create $path -modal local -default 0 -cancel 1 -background $bg \ 130 -title [Widget::getoption "$path#SelectFont" -title] \ 131 -parent [Widget::getoption "$path#SelectFont" -parent] 132 133 set frame [Dialog::getframe $path] 134 set topf [frame $frame.topf -relief flat -borderwidth 0 -background $bg] 135 136 set labf1 [LabelFrame::create $topf.labf1 -text "Font" -name font \ 137 -side top -anchor w -relief flat -background $bg] 138 set sw [ScrolledWindow::create [LabelFrame::getframe $labf1].sw \ 139 -background $bg] 140 set lbf [listbox $sw.lb \ 141 -height 5 -width 25 -exportselection false -selectmode browse] 142 ScrolledWindow::setwidget $sw $lbf 143 LabelFrame::configure $labf1 -focus $lbf 144 if { [Widget::getoption "$path#SelectFont" -querysystem] } { 145 set fam [Widget::getoption "$path#SelectFont" -families] 146 } else { 147 set fam "preset" 148 append fam [Widget::getoption "$path#SelectFont" -families] 149 } 150 eval [list $lbf insert end] $_families($fam) 151 set script "set [list SelectFont::${path}(family)] \[%W curselection\];\ 152 SelectFont::_update [list $path]" 153 bind $lbf <ButtonRelease-1> $script 154 bind $lbf <space> $script 155 bind $lbf <1> [list focus %W] 156 pack $sw -fill both -expand yes 157 158 set labf2 [LabelFrame::create $topf.labf2 -text "Size" -name size \ 159 -side top -anchor w -relief flat -background $bg] 160 set sw [ScrolledWindow::create [LabelFrame::getframe $labf2].sw \ 161 -scrollbar vertical -background $bg] 162 set lbs [listbox $sw.lb \ 163 -height 5 -width 6 -exportselection false -selectmode browse] 164 ScrolledWindow::setwidget $sw $lbs 165 LabelFrame::configure $labf2 -focus $lbs 166 eval [list $lbs insert end] $_sizes 167 set script "set [list SelectFont::${path}(size)] \[%W curselection\];\ 168 SelectFont::_update [list $path]" 169 bind $lbs <ButtonRelease-1> $script 170 bind $lbs <space> $script 171 bind $lbs <1> [list focus %W] 172 pack $sw -fill both -expand yes 173 174 set labf3 [LabelFrame::create $topf.labf3 -text "Style" -name style \ 175 -side top -anchor w -relief sunken -bd 1 -background $bg] 176 set subf [LabelFrame::getframe $labf3] 177 foreach st $_styles { 178 set name [lindex [BWidget::getname $st] 0] 179 if { $name == "" } { 180 set name [string toupper $name 0] 181 } 182 checkbutton $subf.$st -text $name \ 183 -variable SelectFont::$path\($st\) \ 184 -background $bg \ 185 -command [list SelectFont::_update $path] 186 bind $subf.$st <Return> break 187 pack $subf.$st -anchor w 188 } 189 LabelFrame::configure $labf3 -focus $subf.[lindex $_styles 0] 190 191 pack $labf1 -side left -anchor n -fill both -expand yes 192 pack $labf2 -side left -anchor n -fill both -expand yes -padx 8 193 pack $labf3 -side left -anchor n -fill both -expand yes 194 195 set botf [frame $frame.botf -width 100 -height 50 \ 196 -bg white -bd 0 -relief flat \ 197 -highlightthickness 1 -takefocus 0 \ 198 -highlightbackground black \ 199 -highlightcolor black] 200 201 set lab [label $botf.label \ 202 -background white -foreground black \ 203 -borderwidth 0 -takefocus 0 -highlightthickness 0 \ 204 -text [Widget::getoption "$path#SelectFont" -sampletext]] 205 place $lab -relx 0.5 -rely 0.5 -anchor c 206 207 pack $topf -pady 4 -fill both -expand yes 208 pack $botf -pady 4 -fill x 209 210 Dialog::add $path -name ok 211 Dialog::add $path -name cancel 212 213 set data(label) $lab 214 set data(lbf) $lbf 215 set data(lbs) $lbs 216 217 _getfont $path 218 219 Widget::create SelectFont $path 0 220 221 return [_draw $path] 222 } else { 223 if { [Widget::getoption "$path#SelectFont" -querysystem] } { 224 set fams [Widget::getoption "$path#SelectFont" -families] 225 } else { 226 set fams "preset" 227 append fams [Widget::getoption "$path#SelectFont" -families] 228 } 229 frame $path -relief flat -borderwidth 0 -background $bg 230 bind $path <Destroy> [list SelectFont::_destroy $path] 231 set lbf [ComboBox::create $path.font \ 232 -highlightthickness 0 -takefocus 0 -background $bg \ 233 -values $_families($fams) \ 234 -textvariable SelectFont::$path\(family\) \ 235 -editable 0 \ 236 -modifycmd [list SelectFont::_update $path]] 237 set lbs [ComboBox::create $path.size \ 238 -highlightthickness 0 -takefocus 0 -background $bg \ 239 -width 4 \ 240 -values $_sizes \ 241 -textvariable SelectFont::$path\(size\) \ 242 -editable 0 \ 243 -modifycmd [list SelectFont::_update $path]] 244 pack $lbf -side left -anchor w 245 pack $lbs -side left -anchor w -padx 4 246 foreach st $_styles { 247 button $path.$st \ 248 -highlightthickness 0 -takefocus 0 -padx 0 -pady 0 -bd 2 \ 249 -background $bg \ 250 -image [Bitmap::get $st] \ 251 -command [list SelectFont::_modstyle $path $st] 252 pack $path.$st -side left -anchor w 253 } 254 set data(label) "" 255 set data(lbf) $lbf 256 set data(lbs) $lbs 257 _getfont $path 258 259 return [Widget::create SelectFont $path] 260 } 261 262 return $path 263} 264 265 266# ---------------------------------------------------------------------------- 267# Command SelectFont::configure 268# ---------------------------------------------------------------------------- 269proc SelectFont::configure { path args } { 270 set _styles [Widget::getoption "$path#SelectFont" -styles] 271 272 set res [Widget::configure "$path#SelectFont" $args] 273 274 if { [Widget::hasChanged "$path#SelectFont" -font font] } { 275 _getfont $path 276 } 277 if { [Widget::hasChanged "$path#SelectFont" -background bg] } { 278 switch -- [Widget::getoption "$path#SelectFont" -type] { 279 dialog { 280 Dialog::configure $path -background $bg 281 set topf [Dialog::getframe $path].topf 282 $topf configure -background $bg 283 foreach labf {labf1 labf2} { 284 LabelFrame::configure $topf.$labf -background $bg 285 set subf [LabelFrame::getframe $topf.$labf] 286 ScrolledWindow::configure $subf.sw -background $bg 287 $subf.sw.lb configure -background $bg 288 } 289 LabelFrame::configure $topf.labf3 -background $bg 290 set subf [LabelFrame::getframe $topf.labf3] 291 foreach w [winfo children $subf] { 292 $w configure -background $bg 293 } 294 } 295 toolbar { 296 $path configure -background $bg 297 ComboBox::configure $path.font -background $bg 298 ComboBox::configure $path.size -background $bg 299 foreach st $_styles { 300 $path.$st configure -background $bg 301 } 302 } 303 } 304 } 305 return $res 306} 307 308 309# ---------------------------------------------------------------------------- 310# Command SelectFont::cget 311# ---------------------------------------------------------------------------- 312proc SelectFont::cget { path option } { 313 return [Widget::cget "$path#SelectFont" $option] 314} 315 316 317# ---------------------------------------------------------------------------- 318# Command SelectFont::loadfont 319# ---------------------------------------------------------------------------- 320proc SelectFont::loadfont {{which all}} { 321 variable _families 322 323 # initialize families 324 if {![info exists _families(all)]} { 325 set _families(all) [lsort -dictionary [font families]] 326 } 327 if {[regexp {fixed|variable} $which] \ 328 && ![info exists _families($which)]} { 329 # initialize families 330 set _families(fixed) {} 331 set _families(variable) {} 332 foreach family $_families(all) { 333 if { [font metrics [list $family] -fixed] } { 334 lappend _families(fixed) $family 335 } else { 336 lappend _families(variable) $family 337 } 338 } 339 } 340 return 341} 342 343 344# ---------------------------------------------------------------------------- 345# Command SelectFont::_draw 346# ---------------------------------------------------------------------------- 347proc SelectFont::_draw { path } { 348 variable $path 349 upvar 0 $path data 350 351 $data(lbf) selection clear 0 end 352 $data(lbf) selection set $data(family) 353 $data(lbf) activate $data(family) 354 $data(lbf) see $data(family) 355 $data(lbs) selection clear 0 end 356 $data(lbs) selection set $data(size) 357 $data(lbs) activate $data(size) 358 $data(lbs) see $data(size) 359 _update $path 360 361 if { [Dialog::draw $path] == 0 } { 362 set result [Widget::getoption "$path#SelectFont" -font] 363 } else { 364 set result "" 365 } 366 unset data 367 Widget::destroy "$path#SelectFont" 368 destroy $path 369 return $result 370} 371 372 373# ---------------------------------------------------------------------------- 374# Command SelectFont::_modstyle 375# ---------------------------------------------------------------------------- 376proc SelectFont::_modstyle { path style } { 377 variable $path 378 upvar 0 $path data 379 380 if { $data($style) == 1 } { 381 $path.$style configure -relief raised 382 set data($style) 0 383 } else { 384 $path.$style configure -relief sunken 385 set data($style) 1 386 } 387 _update $path 388} 389 390 391# ---------------------------------------------------------------------------- 392# Command SelectFont::_update 393# ---------------------------------------------------------------------------- 394proc SelectFont::_update { path } { 395 variable _families 396 variable _sizes 397 variable _styleOff 398 variable $path 399 upvar 0 $path data 400 401 set type [Widget::getoption "$path#SelectFont" -type] 402 set _styles [Widget::getoption "$path#SelectFont" -styles] 403 if { [Widget::getoption "$path#SelectFont" -querysystem] } { 404 set fams [Widget::getoption "$path#SelectFont" -families] 405 } else { 406 set fams "preset" 407 append fams [Widget::getoption "$path#SelectFont" -families] 408 } 409 if { $type == "dialog" } { 410 set curs [$path:cmd cget -cursor] 411 $path:cmd configure -cursor watch 412 } 413 if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } { 414 set font [list [lindex $_families($fams) $data(family)] \ 415 [lindex $_sizes $data(size)]] 416 } else { 417 set font [list $data(family) $data(size)] 418 } 419 foreach st $_styles { 420 if { $data($st) } { 421 lappend font $st 422 } elseif {[info exists _styleOff($st)]} { 423 # This adds the default bold/italic value to a font 424 #lappend font $_styleOff($st) 425 } 426 } 427 Widget::setoption "$path#SelectFont" -font $font 428 if { $type == "dialog" } { 429 $data(label) configure -font $font 430 $path:cmd configure -cursor $curs 431 } elseif { [set cmd [Widget::getoption "$path#SelectFont" -command]] != "" } { 432 uplevel \#0 $cmd 433 } 434} 435 436 437# ---------------------------------------------------------------------------- 438# Command SelectFont::_getfont 439# ---------------------------------------------------------------------------- 440proc SelectFont::_getfont { path } { 441 variable _families 442 variable _sizes 443 variable $path 444 upvar 0 $path data 445 446 array set font [font actual [Widget::getoption "$path#SelectFont" -font]] 447 set data(bold) [expr {![string equal $font(-weight) "normal"]}] 448 set data(italic) [expr {![string equal $font(-slant) "roman"]}] 449 set data(underline) $font(-underline) 450 set data(overstrike) $font(-overstrike) 451 set _styles [Widget::getoption "$path#SelectFont" -styles] 452 if { [Widget::getoption "$path#SelectFont" -querysystem] } { 453 set fams [Widget::getoption "$path#SelectFont" -families] 454 } else { 455 set fams "preset" 456 append fams [Widget::getoption "$path#SelectFont" -families] 457 } 458 if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } { 459 set idxf [lsearch $_families($fams) $font(-family)] 460 set idxs [lsearch $_sizes $font(-size)] 461 set data(family) [expr {$idxf >= 0 ? $idxf : 0}] 462 set data(size) [expr {$idxs >= 0 ? $idxs : 0}] 463 } else { 464 set data(family) $font(-family) 465 set data(size) $font(-size) 466 foreach st $_styles { 467 $path.$st configure -relief [expr {$data($st) ? "sunken":"raised"}] 468 } 469 } 470} 471 472 473# ---------------------------------------------------------------------------- 474# Command SelectFont::_destroy 475# ---------------------------------------------------------------------------- 476proc SelectFont::_destroy { path } { 477 variable $path 478 upvar 0 $path data 479 unset data 480 Widget::destroy "$path#SelectFont" 481} 482