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 Chriss Miller 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
Joined
Apr 13, 2005
Messages
9
Location
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