1# File: font.tcl 2 3# Purpose: the Font Window and related commands 4 5# 6# Copyright (c) 1997-2001 Tim Baker 7# 8# This software may be copied and distributed for educational, research, and 9# not for profit purposes provided that this copyright and statement are 10# included in all such copies. 11# 12 13namespace eval NSFont { 14 15 variable Priv 16 17# namespace eval NSFont 18} 19 20# NSFont::InitModule -- 21# 22# One-time-only-ever initialization. 23# 24# Arguments: 25# arg1 about arg1 26# 27# Results: 28# What happened. 29 30proc NSFont::InitModule {} { 31 32 variable Priv 33 34 set Priv(items) {} 35 lappend Priv(items) autobar 36 lappend Priv(items) choice 37 lappend Priv(items) inventory 38 lappend Priv(items) knowledge 39 lappend Priv(items) magic 40 lappend Priv(items) message 41 lappend Priv(items) messages 42 lappend Priv(items) misc 43 lappend Priv(items) miscPopup 44 lappend Priv(items) monster 45 lappend Priv(items) options 46 lappend Priv(items) recall 47 lappend Priv(items) status 48 lappend Priv(items) statusBar 49 lappend Priv(items) store 50 51 set oop [NSObject::New NSFont] 52 53 # Select the first item 54 [Info $oop win].frameList.list selection set 0 55 ItemSelectionChanged $oop 56 57 return 58} 59 60# NSFont::NSFont -- 61# 62# Object constructor called by NSObject::New(). 63# 64# Arguments: 65# arg1 about arg1 66# 67# Results: 68# What happened. 69 70proc NSFont::NSFont {oop} { 71 72 # Create the toplevel 73 InitWindow $oop 74 75 # Get the toplevel 76 set win [Info $oop win] 77 78 # Register toplevel with NSWindowManager 79 NSWindowManager::RegisterWindow font $win \ 80 "GetDefaultGeometry $win reqwidth reqheight" "" \ 81 "NSFont::DisplayCmd $oop" 82 83 # 84 # Global list of application windows 85 # 86 87 Global font,oop $oop 88 Window font $win 89 90 return 91} 92 93# NSFont::Info -- 94# 95# Query and modify info. 96# 97# Arguments: 98# arg1 about arg1 99# 100# Results: 101# What happened. 102 103proc NSFont::Info {oop info args} { 104 105 global NSFont 106 107 # Verify the object 108 NSObject::CheckObject NSFont $oop 109 110 # Set info 111 if {[llength $args]} { 112 switch -- $info { 113 default { 114 set NSFont($oop,$info) [lindex $args 0] 115 } 116 } 117 118 # Get info 119 } else { 120 switch -- $info { 121 default { 122 return $NSFont($oop,$info) 123 } 124 } 125 } 126 127 return 128} 129 130# NSFont::InitWindow -- 131# 132# Description. 133# 134# Arguments: 135# arg1 about arg1 136# 137# Results: 138# What happened. 139 140proc NSFont::InitWindow {oop} { 141 142 variable Priv 143 144 set win .font$oop 145 toplevel $win 146 wm title $win "Font" 147 148 wm resizable $win no no 149 wm transient $win [Window main] 150 151 # Do stuff when window closes 152 wm protocol $win WM_DELETE_WINDOW "NSFont::Close $oop" 153 154 # Remember the toplevel 155 Info $oop win $win 156 157 # Create the menus 158 InitMenus $oop 159 160 # 161 # Divider 162 # 163 164 MakeDivider $win.divider2 x 165 166 # 167 # List of items 168 # 169 170 set frame $win.frameList 171 frame $frame \ 172 -borderwidth 1 -relief sunken 173 listbox $frame.list \ 174 -height 5 -width 35 -background White -borderwidth 0 \ 175 -yscrollcommand "$frame.yscroll set" -highlightthickness 0 \ 176 -exportselection no -selectmode extended 177 scrollbar $frame.yscroll \ 178 -command "$frame.list yview" 179 180 grid rowconfigure $frame 0 -weight 1 181 grid columnconfigure $frame 0 -weight 1 182 grid columnconfigure $frame 1 -weight 0 183 grid $frame.list \ 184 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news 185 grid $frame.yscroll \ 186 -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky ns 187 188 foreach item $Priv(items) { 189 $frame.list insert end $item 190 } 191 192 # Configure the display when the item changes 193 bind $frame.list <<ListboxSelect>> \ 194 "NSFont::ItemSelectionChanged $oop" 195 196 # 197 # Font face, style, and size 198 # 199 200 frame $win.frameFont \ 201 -borderwidth 0 202 InitListPlusLabel $oop $win.frameFont.face "Font:" 20 203 InitListPlusLabel $oop $win.frameFont.size "Size:" 4 204 205 pack $win.frameFont.face -side left -padx 4 206 pack $win.frameFont.size -side left -padx 4 207 208 foreach family [lsort -dictionary [font families]] { 209 $win.frameFont.face.frameList.list insert end $family 210 } 211 foreach size [list 8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72] { 212 $win.frameFont.size.frameList.list insert end $size 213 } 214 215 # 216 # Style checkbuttons 217 # 218 219 set frame $win.frameFont.frameStyle 220 frame $frame \ 221 -borderwidth 0 222 label $frame.label \ 223 -text "Style:" -anchor w 224 frame $frame.frameCheck \ 225 -borderwidth 2 -relief groove 226 checkbutton $frame.frameCheck.weight \ 227 -text "Bold" -variable NSFont($oop,weight) \ 228 -onvalue bold -offvalue normal \ 229 -command "NSFont::SynchFont $oop" 230 checkbutton $frame.frameCheck.slant \ 231 -text "Italic" -variable NSFont($oop,slant) \ 232 -onvalue italic -offvalue roman \ 233 -command "NSFont::SynchFont $oop" 234 235 pack $frame.label -side top -anchor w 236 pack $frame.frameCheck.weight -side top -anchor w 237 pack $frame.frameCheck.slant -side top -anchor w 238 pack $frame.frameCheck -side top -anchor nw 239 pack $frame -side left -anchor nw -padx 4 240 241 # 242 # Sample text 243 # 244 245 frame $win.frameSample \ 246 -borderwidth 2 -relief sunken -width 200 -height 60 247 text $win.frameSample.text \ 248 -background [Global SystemButtonFace] -borderwidth 0 -wrap word 249 250 pack propagate $win.frameSample no 251 pack $win.frameSample.text 252 253 $win.frameSample.text tag configure FontTag -justify center 254 $win.frameSample.text insert end "The quick brown fox jumped over the lazy dog." FontTag 255 $win.frameSample.text configure -state disabled 256 257 # 258 # Statusbar 259 # 260 261 MakeStatusBar $win.statusBar 262# frame $win.statusBar -relief flat -borderwidth 0 263# label $win.statusBar.label -anchor w -relief sunken -padx 2 264# pack $win.statusBar.label -side left -expand yes -fill both 265 266 # 267 # Geometry 268 # 269 270 grid rowconfig $win 0 -weight 0 271 grid rowconfig $win 1 -weight 1 272 grid rowconfig $win 2 -weight 0 273 grid rowconfig $win 3 -weight 0 274 grid rowconfig $win 4 -weight 0 275 grid columnconfig $win 0 -weight 1 276 277 if {[Platform windows]} { 278 grid $win.divider2 \ 279 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky ew 280 } 281 grid $win.frameList \ 282 -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news -padx 2 -pady 2 283 grid $win.frameFont \ 284 -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky ew 285 grid $win.frameSample \ 286 -row 3 -column 0 -rowspan 1 -columnspan 1 -sticky ew -padx 10 -pady 4 287 grid $win.statusBar \ 288 -row 4 -column 0 -rowspan 1 -columnspan 1 -sticky ew 289 290 # 291 # KeyPress bindings 292 # 293 294 bind $win <KeyPress-Escape> "NSFont::Close $oop" 295 bind $win <Control-KeyPress-w> "NSFont::Close $oop" 296 297 return 298} 299 300# NSFont::InitMenus -- 301# 302# Description. 303# 304# Arguments: 305# arg1 about arg1 306# 307# Results: 308# What happened. 309 310proc NSFont::InitMenus {oop} { 311 312 # Get the toplevel 313 set win [Info $oop win] 314 315 # Default accelerator modifier 316 set mod "Ctrl" 317 318 # 319 # Menu bar 320 # 321 322 Info $oop mbar [NSObject::New NSMenu $win -tearoff 0 \ 323 -postcommand "NSFont::SetupMenus $oop" -identifier MENUBAR] 324 set mbar [Info $oop mbar] 325 326 # Call our command when an entry is invoked 327 NSMenu::Info $mbar invokeCmd "NSFont::MenuInvoke $oop" 328 329 # 330 # Font Menu 331 # 332 333 NSObject::New NSMenu $mbar -tearoff 0 -identifier MENU_FONT 334 NSMenu::MenuInsertEntry $mbar -end MENUBAR -type cascade \ 335 -menu MENU_FONT -label "Font" -underline 0 -identifier M_FONT 336 337 set entries {} 338 lappend entries [list -type command -label "Close" \ 339 -underline 0 -accelerator $mod+W -identifier E_CLOSE] 340 341 NSMenu::MenuInsertEntries $mbar -end MENU_FONT $entries 342 343 return 344} 345 346# NSFont::SetupMenus -- 347# 348# Description 349# 350# Arguments: 351# arg1 about arg1 352# 353# Results: 354# What happened. 355 356proc NSFont::SetupMenus {oop mbarId} { 357 358 lappend identList E_CLOSE 359 360 NSMenu::MenuEnable $mbarId $identList 361 362 return 363} 364 365# NSFont::MenuInvoke -- 366# 367# Called when a menu entry is invoked. 368# 369# Arguments: 370# arg1 about arg1 371# 372# Results: 373# What happened. 374 375proc NSFont::MenuInvoke {oop menuId ident} { 376 377 switch -glob -- $ident { 378 E_CLOSE {Close $oop} 379 } 380 381 return 382} 383 384# NSFont::DisplayCmd -- 385# 386# Called by NSWindowManager::Display(). 387# 388# Arguments: 389# arg1 about arg1 390# 391# Results: 392# What happened. 393 394proc NSFont::DisplayCmd {oop message first args} { 395 396 variable Priv 397 398 switch -- $message { 399 preDisplay - 400 reDisplay { 401 if {[llength $args]} { 402 set listbox [Info $oop win].frameList.list 403 set row [lsearch -exact $Priv(items) [lindex $args 0]] 404 $listbox selection clear 0 end 405 $listbox selection set $row 406 $listbox see $row 407 ItemSelectionChanged $oop 408 } 409 } 410 postDisplay { 411 } 412 } 413 414 return 415} 416 417# NSFont::Close -- 418# 419# Description. 420# 421# Arguments: 422# arg1 about arg1 423# 424# Results: 425# What happened. 426 427proc NSFont::Close {oop} { 428 429 NSWindowManager::Undisplay font 430 431 return 432} 433 434# NSFont::InitListPlusLabel -- 435# 436# Creates a frame with a label, listbox and scrollbar. 437# 438# Arguments: 439# arg1 about arg1 440# 441# Results: 442# What happened. 443 444proc NSFont::InitListPlusLabel {oop parent title width} { 445 446 frame $parent \ 447 -borderwidth 0 448 449 label $parent.title \ 450 -text $title 451 452 set frame $parent.frameList 453 frame $frame \ 454 -borderwidth 1 -relief sunken 455 listbox $frame.list \ 456 -height 7 -width $width -background White -borderwidth 0 \ 457 -yscrollcommand "$frame.yscroll set" -highlightthickness 0 \ 458 -exportselection no 459 scrollbar $frame.yscroll \ 460 -command "$frame.list yview" 461 462 # 463 # List geometry 464 # 465 466 grid rowconfigure $frame 0 -weight 1 467 grid columnconfigure $frame 0 -weight 1 468 grid columnconfigure $frame 1 -weight 0 469 grid $frame.list \ 470 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news 471 grid $frame.yscroll \ 472 -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky ns 473 474 # 475 # Geometry 476 # 477 478 grid rowconfigure $parent 0 -weight 0 479 grid rowconfigure $parent 1 -weight 1 480 grid columnconfigure $frame 0 -weight 1 481 grid $parent.title \ 482 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky w 483 grid $parent.frameList \ 484 -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky w 485 486 # Update the font when the selection changes 487 bind $parent.frameList.list <<ListboxSelect>> \ 488 "NSFont::SynchFont $oop" 489 490 return 491} 492 493# NSFont::ListSelectValue -- 494# 495# Looks for a given value in a listbox, selects it, and scrolls to it. 496# 497# Arguments: 498# arg1 about arg1 499# 500# Results: 501# What happened. 502 503proc NSFont::ListSelectValue {oop parent value} { 504 505 set listbox $parent.frameList.list 506 507 set index 0 508 foreach item [$listbox get 0 end] { 509 if {[string equal $item $value]} { 510 $parent.frameList.list selection clear 0 end 511 $parent.frameList.list selection set $index 512 $parent.frameList.list see $index 513 break 514 } 515 incr index 516 } 517 518 return 519} 520 521# NSFont::SynchFont -- 522# 523# Called when the font face, size, or style changes. Updates the 524# sample text with the new font, and sets the "item" font. 525# 526# Arguments: 527# arg1 about arg1 528# 529# Results: 530# What happened. 531 532proc NSFont::SynchFont {oop} { 533 534 variable Priv 535 536 set win [Info $oop win] 537 538 set selection [$win.frameList.list curselection] 539 set count [llength $selection] 540 if {$count == 0} return 541 542 set row [$win.frameFont.face.frameList.list curselection] 543 if {![string length $row]} return 544 set family [$win.frameFont.face.frameList.list get $row] 545 set row [$win.frameFont.size.frameList.list curselection] 546 if {![string length $row]} return 547 set size [$win.frameFont.size.frameList.list get $row] 548 549 set weight [Info $oop weight] 550 set slant [Info $oop slant] 551 552 # Set the font description 553 set font [list -family $family -size $size -weight $weight -slant $slant] 554 555 # Update the sample text 556 $win.frameSample.text tag configure FontTag -font $font 557 558 # Update each "item" font, if asked 559 if {![Info $oop noconfigure]} { 560 foreach row $selection { 561 set item [lindex $Priv(items) $row] 562 Value font,$item $font 563 } 564 } 565 566 return 567} 568 569# NSFont::ItemSelectionChanged -- 570# 571# Sets the font controls and sample text with the item's font. 572# 573# Arguments: 574# arg1 about arg1 575# 576# Results: 577# What happened. 578 579proc NSFont::ItemSelectionChanged {oop} { 580 581 variable Priv 582 583 set win [Info $oop win] 584 585 set selection [$win.frameList.list curselection] 586 set count [llength $selection] 587 588 set synchFont 1 589 590 $win.frameSample.text configure -state normal 591 $win.frameSample.text delete 1.0 end 592 593 if {$count >= 1} { 594 set row [lindex $selection 0] 595 set item [lindex $Priv(items) $row] 596 set font [fontdesc [Value font,$item]] 597 foreach row [lrange $selection 1 end] { 598 set item [lindex $Priv(items) $row] 599 set font2 [fontdesc [Value font,$item]] 600 if {[string compare $font2 $font]} { 601 set synchFont 0 602 break 603 } 604 } 605 606 } else { 607 set synchFont 0 608 609 $win.frameFont.face.frameList.list selection clear 0 end 610 $win.frameFont.size.frameList.list selection clear 0 end 611 } 612 613 if {$synchFont} { 614 array set attrib [fontdesc $font] 615 ListSelectValue $oop $win.frameFont.size $attrib(-size) 616 ListSelectValue $oop $win.frameFont.face $attrib(-family) 617 Info $oop weight $attrib(-weight) 618 Info $oop slant $attrib(-slant) 619 620 $win.frameSample.text insert end "The quick brown fox jumped over the lazy dog." FontTag 621 622 Info $oop noconfigure 1 623 SynchFont $oop 624 Info $oop noconfigure 0 625 626 } else { 627 $win.frameFont.face.frameList.list selection clear 0 end 628 $win.frameFont.size.frameList.list selection clear 0 end 629 } 630 631 $win.frameSample.text configure -state disabled 632 633 if {$count == 1} { 634 set string "1 item selected" 635 } else { 636 set string [format "%d items selected" $count] 637 } 638 $win.statusBar itemconfigure t1 -text $string 639 640 return 641} 642 643