Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

tcl fonts selctor

Status
Not open for further replies.

linuxgyro

Programmer
Apr 13, 2005
9
US
I am making a text editor for a programming class at school. I wish to have a font selection menu for it. The following code is what i have found that shows the list of fonts, but i want to be able to use it rather than just look at the way the fonts look.:
set typeThis "The quick brown fox jumps over the lazy dog."
entry .l -textvariable typeThis -width 30
pack .l
button .go -command "go" -text "Go!" -width 6 -underline 0
bind . <Return> {go}
bind . <Alt-g> {go}
pack .go

proc go {} {
global typeThis fontOver

bind . <Alt-g> {}
bind . <Return> {}
destroy .l
destroy .go

frame .t
pack .t -expand 1 -fill both
text .t.t -yscrollcommand {.t.sb set} -undo 1
pack .t.t -side left -expand 1 -fill both
scrollbar .t.sb -command {.t.t yview}
pack .t.sb -side right -fill y
label .l -textvariable ::fontOver
set fontOver "Loading Fonts. Please Wait..."
pack .l

frame .demo
pack .demo
label .demo.d1 -text "Click a font for a demo"
pack .demo.d1 -side left
label .demo.d2
pack .demo.d2 -side left
label .demo.d3
pack .demo.d3 -side left
label .demo.d4
pack .demo.d4 -side left
update

set i 0
foreach x [lsort [font families]] {
.t.t tag configure tag$i -font [list $x 12 {}]
.t.t insert end "$typeThis\n" tag$i
.t.t tag bind tag$i <Enter> "set ::fontOver [list $x]"
.t.t tag bind tag$i <ButtonPress-1> "demoOf [list $x]"
.t.t tag bind tag$i <Leave> {set ::fontOver ""}
incr i
}

set fontOver ""
};# go

proc demoOf {x} {

.demo.d1 configure -text "Font: $x"
.demo.d2 configure -text "In Bold..." -font [list $x 12 bold]
.demo.d3 configure -text "In Italics..." -font [list $x 12 italic]
.demo.d4 configure -text "In Underline..." -font [list $x 12 underline]

};# demoOf

any clues as to how this is going to be accomplished?
 
I'm not sure what you're asking. If you have a way of choosing the font you want, that is, a proc that returns the font, you can set the font of a widget (text, entry, label) with <name of widget> configure -font {<font characteristics>}.
Let's say you have a text widget:
pack [text .t]
Now, suppose your font chooser returned a font family as the variable, fontF. You can change the font of the text widget with:
.t configure -font {$fontF 12} or whatever.

_________________
Bob Rashkin
rrashkin@csc.com
 
what i really need now is a way to apply the fonts. I got it to come up with the list that is insalled on the mac here. but i need an apply.
this is what I have with the fonts so far:
proc fontBox {} {
proc DropListCreate {
basename text width height variable initial_value } {

upvar #0 $variable var
set var "$initial_value"

# Name of top-level widget to create.
set top $basename.top

#
# Widgets to enter data.
#
frame $basename -bd 0
label $basename.lbl -text $text -anchor e
entry $basename.ent -width $width
$basename.ent insert 0 "$initial_value"
DropButton $basename.drop $basename.top $basename.ent

bind $basename.ent <Return> \
"DropListSetVal $basename.ent $variable"

bind $basename.ent <Key-Escape> "wm withdraw $top"

pack $basename.lbl -side left -fill y
pack $basename.ent -side left -expand 1 -fill y
pack $basename.drop -side left -fill y

#
# Drop-list is a top-level temporary window.
#
toplevel $top -cursor top_left_arrow
wm overrideredirect $top 1
wm withdraw $top

# Create list
set frm $top.frame
frame $frm -bd 4 -relief sunken

listbox $frm.list -height $height -width $width \
-selectmode single \
-yscrollcommand "$frm.scrollbar set"

bind $frm.list <Key-Escape> "wm withdraw $top"

# Create scrollbar
scrollbar $frm.scrollbar \
-command "$frm.list yview"

pack $frm.scrollbar -side right -fill y
pack $frm.list -side left
pack $frm -side top

bind $frm.list <ButtonRelease-1> \
"DropListClick $top $basename.ent $variable"


pack $basename

#
# Return list widget so you can fill it.
#
return $frm.list
}

# Returns selected item for a single-select list.
proc list_selected { listname } {
set indx [$listname curselection]

if { $indx != "" } {
set item [$listname get $indx]

return $item
} else {
return "";
}
}



# Places value in global variable.
proc DropListSetVal { entry variable } {
upvar #0 $variable var

set value [$entry get]

if { $value != "" } {
set var $value
}

}

# Handles click on drop list widget.
proc DropListClick { basename entry variable } {

catch {
set selected [list_selected $basename.frame.list]

if { $selected != "" } {
#
# Put item into entry widget.
#
$entry delete 0 end
$entry insert 0 "$selected"

DropListSetVal $entry $variable
}
}

wm withdraw $basename
}



# Makes drop list visible. Create with DropListCreate.
proc ShowDropList { basename associated_widget } {
set x [winfo rootx $associated_widget]
set y [winfo rooty $associated_widget]
set y [expr $y + [winfo height $associated_widget]]

wm geometry $basename "+$x+$y"

wm deiconify $basename
raise $basename

focus $basename.frame.list
}


# Creates a button with a drop-down bitmap.
proc DropButton { name toplevel entry } {

button $name -image dnarrow \
-command "ShowDropList $toplevel $entry"

return $name
}

#
# Bitmap data for down arrow bitmap.
#
set dnarrow_data "
#define dnarrow2_width 18
#define dnarrow2_height 18
static unsigned char dnarrow2_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x00, 0xf8, 0x7f, 0x00,
0xf8, 0x7f, 0x00, 0xf0, 0x3f, 0x00, 0xf0, 0x3f, 0x00, 0xe0, 0x1f, 0x00,
0xc0, 0x0f, 0x00, 0xc0, 0x0f, 0x00, 0x80, 0x07, 0x00, 0x80, 0x07, 0x00,
0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x00,
0xfc, 0xff, 0x00, 0x00, 0x00, 0x00};
"
image create bitmap dnarrow -data $dnarrow_data


set drop_test_var "Unset"

proc test_value { } {
global drop_test_var

set font {Impact 14}
}


# Test procedure creating a drop-down list
proc test_drop_list { } {
global drop_test_var

#
# This drop-list holds font families.
#
set families [font families]
set sorted [lsort $families]

#
# Determine initial value.
# Enclose in quotes because it may
# have spaces in the value.
#
set initial_value [lindex $sorted 0]

# Create drop list.
set list [DropListCreate .font "Font: " \
40 8 drop_test_var "$initial_value"]

# Fill in drop list with font families.
foreach family $sorted {
$list insert end $family
}

button .apply -text "apply" -command test_value
pack .apply -side bottom
}
this makes a section at the bottom of the screen that has a menu to select the font. I need it to apply the font selected when i click "apply". sorry for the confusion.
 
What do you want to apply the font to?

_________________
Bob Rashkin
rrashkin@csc.com
 
I am working on a text editor. this is the source for the text editor:
after 8000 { catch {destroy .welcome} }
proc createEditor {} {
text .editor
pack .editor
}

proc createMenubar {} {
menu .menuBar -tearoff 0
.menuBar add cascade -menu .menuBar.file -label "File" -underline 0
menu .menuBar.file -tearoff 0
.menuBar.file add command -label New -command new -underline 0
.menuBar.file add command -label Open -command openFile -underline 0
.menuBar.file add command -label Save -command saveFile -underline 0
.menuBar.file add command -label SaveAs -command saveAs -underline 4
.menuBar.file add command -label Fonts -command fontBox -underline 0
.menuBar.file add sep
.menuBar.file add command -label Quit -command exit -underline 0
. configure -menu .menuBar
}

proc new {} {
.editor delete 1.0 end
}


proc openFile {} {
setFilename tk_getOpenFile
new
set fp [open $::filename]
.editor insert end [read $fp]
close $fp
}


proc saveFile {} {
if {{} == $::filename} {
tk_messageBox -icon error -type ok -title Message \
-parent . \
-message "You need to choose a valid filename."
return
}
set fp [open $::filename w]
puts $fp [.editor get 1.0 end]
close $fp
}


proc saveAs {} {
setFilename tk_getSaveFile
saveFile
}


proc setFilename proc {
set new [$proc]
if {{} == $new} {
return
}
set ::filename $new
wm title . "Editing file '$new"
}
eval destroy [winfo child .]
wm title . "Text Editor -Kyle Peterman"

set font {Times 14}
set filename {}
createMenubar
createEditor
 
Well then, once you have the font characteristics, you apply them to the text widget with configure. Let's say your font chooser proc returns a list variable, fontList, with the chosen font:
.editor configure -font $fontList

_________________
Bob Rashkin
rrashkin@csc.com
 
thanks. I got the editor to change the font just fine. i added another menu named "Fonts" and added a bunch of the fonts to it and made a few proc to comment them. in the procs i added this line:
.editor configure -font AppleGothic
that got it to change the font. thanks a lot!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top