package provide dialog_font 0.1
namespace eval ::dialog_font:: {
# fontsize is for detecting whether the user actually requested a change
variable fontsize 0
variable stretchval 100
variable whichstretch 1
variable canvaswindow
variable sizes {8 10 12 16 24 36}
namespace export pdtk_canvas_dofont
}
# TODO this should use the pd_font_$size fonts created in pd-gui.tcl
# TODO change pdtk_canvas_dofont to pdtk_font_dialog here and g_editor.c
# TODO this should really be changed on the C side so that it doesn't have to
# work around gfxstub/x_gui.c. The gfxstub stuff assumes that there are
# multiple panels, for properties panels like this, its much easier to use if
# there is a single properties panel that adjusts based on which PatchWindow
# has focus
# this could probably just be apply, but keep the old one for tcl plugins that
# might use apply for "stretch"
proc ::dialog_font::do_apply {mytoplevel myfontsize stretchval whichstretch} {
if {$mytoplevel eq ".pdwindow"} {
foreach font [font names] {
font configure $font -size $myfontsize
}
if {[winfo exists ${mytoplevel}.text]} {
set font [lindex [${mytoplevel}.text.internal cget -font] 0]
if { ${font} eq {} } {
set font $::font_family
}
${mytoplevel}.text.internal configure -font [list $font $myfontsize]
# try to adjust the width of the Pd-console to 80 chars
catch {
set str80 "This string is exactly 80 characters long...ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
set fnt [${mytoplevel}.text.internal cget -font]
# how much space do we need for 80 chars (need an extra char for whatever reasons...)?
set w [expr [winfo width ${mytoplevel}] - \
[winfo width ${mytoplevel}.text] + \
[font measure $fnt -displayof ${mytoplevel} "${str80} "] \
]
# make sure it's within reasonable bounds
foreach {maxw maxh} [wm maxsize .] {break}
if { $w < 400 } {set w 400}
if { $w > $maxw } {set w $maxw}
# get the current geometry of the .pdwindow
scan [wm geometry $mytoplevel] {%dx%d%[+]%d%[+]%d} width height - x - y
if { "+$x+$y" eq "+0+0" } {
scan [winfo geometry $mytoplevel] {%dx%d%[+]%d%[+]%d} width height - x - y
}
# and fix it
if { $w > $width } {
wm geometry $mytoplevel "${w}x${height}+$x+$y"
}
# scroll down
${mytoplevel}.text.internal yview moveto 1.0
}
#::pdwindow::post "This string is exactly 80 characters long...ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\n"
}
catch {
ttk::style configure Treeview -rowheight [expr {[font metrics TkDefaultFont -linespace] + 2}]
}
# repeat a "pack" command so the font dialog can resize itself
if {[winfo exists .font]} {
pack .font.buttonframe -side bottom -fill x -pady 2m
}
::pd_guiprefs::write menu-fontsize "$myfontsize"
set ::pdwindow::font_size $myfontsize
} else {
pdsend "$mytoplevel font $myfontsize $stretchval $whichstretch"
pdsend "$mytoplevel dirty 1"
}
}
proc ::dialog_font::radio_apply {mytoplevel myfontsize} {
variable fontsize
if {$myfontsize != $fontsize} {
set fontsize $myfontsize
::dialog_font::do_apply $mytoplevel $myfontsize 0 2
}
}
proc ::dialog_font::stretch_apply {gfxstub} {
if {$gfxstub ne ".pdwindow"} {
variable fontsize
variable stretchval
variable whichstretch
if {$stretchval == ""} {
set stretchval 100
}
if {$stretchval == 100} {
return
}
pdsend "$gfxstub font $fontsize $stretchval $whichstretch"
pdsend "$gfxstub dirty 1"
}
}
proc ::dialog_font::apply {mytoplevel myfontsize} {
variable stretchval
variable whichstretch
::dialog_font::do_apply $mytoplevel $myfontsize $stretchval $whichstretch
}
proc ::dialog_font::cancel {gfxstub} {
if {$gfxstub ne ".pdwindow"} {
pdsend "$gfxstub cancel"
}
destroy .font
}
proc ::dialog_font::update_font_dialog {mytoplevel} {
variable canvaswindow $mytoplevel
if {[winfo exists .font]} {
wm title .font [_ "%s Font" [lookup_windowname $mytoplevel]]
}
}
proc ::dialog_font::arrow_fontchange {change} {
variable sizes
variable fontsize
variable canvaswindow
set position [expr [lsearch $sizes $fontsize] + $change]
if {$position < 0} {set position 0}
set max [llength $sizes]
if {$position >= $max} {set position [expr $max-1]}
set fontsize [lindex $sizes $position]
::dialog_font::radio_apply $canvaswindow $fontsize
}
# this should be called pdtk_font_dialog like the rest of the panels, but it
# is called from the C side, so we'll leave it be
proc ::dialog_font::pdtk_canvas_dofont {gfxstub initsize} {
variable fontsize $initsize
variable whichstretch 1
variable stretchval 100
if {$fontsize < 0} {set fontsize [expr -$fontsize]}
if {$fontsize < 8} {set fontsize 12}
if {[winfo exists .font]} {
wm deiconify .font
raise .font
focus .font
# the gfxstub stuff expects multiple font windows, we only have one,
# so kill the new gfxstub requests as the come in. We'll save the
# original gfxstub for when the font panel gets closed
pdsend "$gfxstub cancel"
} else {
create_dialog $gfxstub
}
.font.fontsize.radio$fontsize select
}
proc ::dialog_font::create_dialog {gfxstub} {
toplevel .font -class DialogWindow
.font configure -menu $::dialog_menubar
.font configure -padx 10 -pady 5
wm group .font .
wm title .font [_ "Font"]
wm transient .font $::focused_window
::pd_bindings::dialog_bindings .font "font"
# replace standard bindings to work around the gfxstub stuff and use
# break to prevent the close window command from going to other bindings.
# .font won't exist anymore, so it'll cause errors down the line...
bind .font <KeyPress-Return> "::dialog_font::cancel $gfxstub; break"
bind .font <KeyPress-Escape> "::dialog_font::cancel $gfxstub; break"
bind .font <$::modifier-Key-w> "::dialog_font::cancel $gfxstub; break"
wm protocol .font WM_DELETE_WINDOW "dialog_font::cancel $gfxstub"
bind .font <Up> "::dialog_font::arrow_fontchange -1"
bind .font <Down> "::dialog_font::arrow_fontchange 1"
frame .font.buttonframe
pack .font.buttonframe -side bottom -pady 2m
button .font.buttonframe.ok -text [_ "Close"] \
-command "::dialog_font::cancel $gfxstub" -default active
pack .font.buttonframe.ok -side left -expand 1 -fill x -ipadx 10
labelframe .font.fontsize -text [_ "Font Size"] -padx 5 -pady 4 -borderwidth 1 \
-width [::msgcat::mcmax "Font Size"] -labelanchor n
pack .font.fontsize -side left -padx 5
# this is whacky Tcl at its finest, but I couldn't resist...
foreach size $::dialog_font::sizes {
radiobutton .font.fontsize.radio$size -value $size -text $size \
-command [format {::dialog_font::radio_apply \
$::dialog_font::canvaswindow %s} $size]
pack .font.fontsize.radio$size -side top -anchor w
}
labelframe .font.stretch -text [_ "Stretch"] -padx 5 -pady 5 -borderwidth 1 \
-width [::msgcat::mcmax "Stretch"] -labelanchor n
pack .font.stretch -side left -padx 5 -fill y
entry .font.stretch.entry -textvariable ::dialog_font::stretchval -width 5 \
-validate key -vcmd {string is int %P}
pack .font.stretch.entry -side top -pady 5
radiobutton .font.stretch.radio1 -text [_ "X and Y"] \
-value 1 -variable ::dialog_font::whichstretch
radiobutton .font.stretch.radio2 -text [_ "X only"] \
-value 2 -variable ::dialog_font::whichstretch
radiobutton .font.stretch.radio3 -text [_ "Y only"] \
-value 3 -variable ::dialog_font::whichstretch
pack .font.stretch.radio1 -side top -anchor w
pack .font.stretch.radio2 -side top -anchor w
pack .font.stretch.radio3 -side top -anchor w
button .font.stretch.apply -text [_ "Apply"] \
-command "::dialog_font::stretch_apply $gfxstub" -default active
pack .font.stretch.apply -side left -expand 1 -fill x -ipadx 10 \
-anchor s
# for focus handling on OSX
if {$::windowingsystem eq "aqua"} {
# since we show the active focus, disable the highlight outline
.font.buttonframe.ok config -highlightthickness 0
}
position_over_window .font $::focused_window
# wait a little for creation, then raise so it's on top
after 100 raise .font
}
Codebase Browser
pure-data