Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
# the find dialog panel is a bit unusual in that it is created directly by the
# Tcl 'pd-gui'. Most dialog panels are created by sending a message to 'pd',
# which then sends a message to 'pd-gui' to create the panel.
package provide dialog_prefs 0.1
#package require pd_bindings
#package require dialog_gui
namespace eval ::dialog_prefs:: {
# namespace export pdtk_
}
# mytoplevel isn't used here, but is kept for compatibility with other dialog ok procs
proc ::dialog_prefs::ok {mytoplevel} {
return # hash this out later
variable find_history
if {$findstring eq ""} {
if {$::windowingsystem eq "aqua"} {bell}
return
}
if {$find_in_window eq ".pdwindow"} {
if {$::tcl_version < 8.5} {
# TODO implement in 8.4 style, without -all
set matches [.pdwindow.text search -nocase -- $findstring 0.0]
} else {
set matches [.pdwindow.text search -all -nocase -- $findstring 0.0]
}
.pdwindow.text tag delete sel
if {[llength $matches] > 0} {
foreach match $matches {
.pdwindow.text tag add sel $match "$match wordend"
}
.pdwindow.text see [lindex $matches 0]
lappend find_history $findstring
}
} else {
if {$findstring eq $previous_findstring \
&& $wholeword_button == $previous_wholeword_button} {
pdsend "$find_in_window findagain"
} else {
pdsend [concat $find_in_window find [pdtk_encodedialog $findstring] \
$wholeword_button]
set previous_findstring $findstring
set previous_wholeword_button $wholeword_button
lappend find_history $findstring
}
}
if {$::windowingsystem eq "aqua"} {
# (Mac OS X) hide panel after success, but keep it if unsuccessful by
# having the couldnotfind proc reopen it
cancel $mytoplevel
} else {
# (GNOME/Windows) find panel should retain focus after a find
# (yes, a bit of a kludge)
after 100 "raise .find; focus .find.entry"
}
}
# mytoplevel isn't used here, but is kept for compatibility with other dialog cancel procs
proc ::dialog_prefs::cancel {mytoplevel} {
wm withdraw .prefs
}
# the find panel is opened from the menu and key bindings
proc ::dialog_prefs::open_prefs_dialog {mytoplevel} {
if {[winfo exists .prefs]} {
wm deiconify .prefs
raise .prefs
# obtain last known mouse coords and pop the menu there
global pointer_x_global pointer_y_global
wm geometry .prefs "+$pointer_x_global+$pointer_y_global"
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
} else {
create_dialog $mytoplevel
}
pd [concat pd audio-properties \;]
pd [concat pd midi-properties \;]
::dialog_gui::create_gui_dialog .prefs.nb.gui
# need to think about what should get focus with ttk::notebook
# .prefs.entry selection range 0 end
}
proc ::dialog_prefs::dropdown_set {name value} {
if {$::windowingsystem eq "aqua"} {
set my_var [$name cget -textvariable]
set $my_var $value
} else {
$name set "$value"
}
}
proc ::dialog_prefs::dropdown_by_index {name variable values textvar} {
::dialog_prefs::dropdown $name $variable $values $textvar
}
proc ::dialog_prefs::dropdown {name variable values args} {
set textvar $variable
if {$args ne ""} {set textvar $args}
if {$::windowingsystem eq "aqua"} {
ttk::menubutton $name -menu $name.menu -direction flush \
-textvariable $textvar -cursor boat
menu $name.menu -cursor boat
set i 0
foreach label $values {
set value $label
if {$args ne ""} {set value $i}
$name.menu add radiobutton -value $value -variable $variable \
-label $label -command "set $textvar \"$label\""
incr i
}
} else {
# set combobox width to largest string
set width 0
foreach value $values {
set len [string length $value]
set width [expr $len > $width ? $len : $width]
}
ttk::combobox $name -state readonly -width $width \
-style Prefs.TCombobox -values $values
set command "get"
if {$args ne ""} {
set command "current"
# the following cmd prevents a bug in the alsa midi api
# from throwing an index that's out of range. but once
# that bug gets fixed, this should be removed so that
# it doesn't hide any future bugs
set $variable [expr min([set $variable], [llength $values] - 1)]
}
bind $name <<ComboboxSelected>> "set $variable \
[concat {[} $name $command {]} ]; after 0 {%W selection clear}"
if {$command eq "get"} {set command "set"}
$name $command [set $variable]
}
}
proc ::dialog_prefs::set_color {array key op} {
# not sure if this is necessary, but just in case...
if {$op ne "write"} {return}
set c [set ${array}($key)]
set commands {}
switch $key {
box {set commands [list "itemconfigure \
box&&(!msg)&&(!atom) -fill $c"] }
text { set commands [list "itemconfigure \
(text&&(!box&&!iemgui)) -fill $c"]
lappend commands "itemconfigure \
label&&graph -fill $c"
# lappend commands "itemconfigure \
# (text&&(!label) -fill $c"
if {[winfo exists .search.resultstext]} {
.search.resultstext configure -foreground $c
.search.navtext configure -foreground $c
}
}
text_in_console {
if {[winfo exists .printout.frame.text]} {
.printout.frame.text configure -foreground $c
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
}
canvas_color {set commands [list "configure -bg $c"]
if {[winfo exists .search.resultstext]} {
.search.resultstext configure -bg $c
.search.navtext configure -bg $c
}
if {[winfo exists .printout.frame.text]} {
.printout.frame.text configure -bg $c
}
}
canvas_cursor {set commands [list "configure -insertbackground $c"]}
highlighted_text_bg \
{set commands [list "configure -selectbackground $c"]}
highlighted_text {set commands [list "configure -selectforeground $c"]}
msg_border {set commands [list "itemconfigure \
msg&&box -stroke $c"]}
msg {set commands [list "itemconfigure \
msg&&box -fill $c"]}
control_nlet {set commands [list "itemconfigure \
((inlet||outlet)&&control) -fill $c"]
}
iemgui_nlet {set commands [list "itemconfigure \
(inlet&&iemgui)||(outlet&&iemgui) -stroke $c"]
}
signal_nlet {set commands [list "itemconfigure \
inlet&&signal -fill $c"]
lappend commands "itemconfigure \
outlet&&signal -fill $c"
}
#outlet {set commands [list "itemconfigure outlet -stroke $c"]}
signal_cord {set commands [list "itemconfigure \
all_cords&&signal -stroke $c"]
lappend commands "itemconfigure \
(outlet&&signal)||(inlet&&signal) -stroke $c"
}
control_cord {set commands [list "itemconfigure \
all_cords&&control -stroke $c"]
lappend commands "itemconfigure \
((inlet||outlet)&&control) -stroke $c"
}
selection {
set commands [list "itemconfigure \
selected&&text&&(!box&&!iemgui) -fill $c"]
lappend commands "itemconfigure \
selected&&(border&&(!iemgui)) -fill $c"
lappend commands "itemconfigure \
selected&&border&&iemgui -stroke $c"
}
box_border {set commands [list "itemconfigure \
iemgui_border {
set commands [list "itemconfigure border&&iemgui -stroke $c"]}
atom_box {set commands [list "itemconfigure \
atom&&box -fill $c"]}
atom_box_border {set commands [list "itemconfigure \
atom&&box -stroke $c"]}
graph_border {set commands [list "itemconfigure \
graph&&(!label) -stroke $c"]}
graph {set commands [list "itemconfigure graph&&(!label) -fill $c"]}
pokergaming
committed
dash_fill {
set commands [list "itemconfigure broken&&box -fill $c"]
if {[winfo exists .printout.frame.text]} {
.printout.frame.text tag configure errorlink -background $c
}
}
dash_outline {
set commands [list "itemconfigure broken&&box -stroke $c"]
if {[winfo exists .printout.frame.text]} {
.printout.frame.text tag configure errorlink -foreground $c
}
}
magic_glass_bg {set commands [list "itemconfigure \
magicGlassBg -fill $c"]}
magic_glass_bd {set commands [list "itemconfigure \
magicGlassLine -fill $c"]}
magic_glass_text {set commands [list "itemconfigure \
magicGlassText -fill $c"]}
link {
if {[winfo exists .search.resultstext]} {
.search.resultstext tag configure link -foreground $c
.search.navtext tag configure link -foreground $c
.search.f.advancedlabel configure -foreground $c
}
# return
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
}
default {}
}
if {$commands ne ""} {
foreach w [winfo children .] {
foreach child [winfo children $w] {
if {$child ne "" && [winfo class $child] eq "PathCanvas"} {
if {$key eq "canvas_color" &&
[info exists [format ::%s(%s) $key $w]]} {
continue
}
foreach command $commands {
eval $child $command
}
}
}
}
}
# hack! how do I avoid hard-coding the window names here?
set mytoplevel .prefs.nb.gui.colors
if {[winfo exists $mytoplevel.$key]} {
::dialog_prefs::set_swatchbutton $mytoplevel.$key ${array}($key)
}
}
proc ::dialog_prefs::set_swatchbutton {name variable} {
if {[set $variable] eq ""} {return}
image create photo ::img::swatchbutton::$name
set c [set $variable]
set bd #000000
set stupid_top_and_bottom \
[list $bd $bd $bd $bd $bd $bd $bd $bd $bd $bd $bd $bd]
set dumb \
[list $bd $c $c $c $c $c $c $c $c $c $c $bd]
::img::swatchbutton::$name put [list $stupid_top_and_bottom \
$dumb $dumb $dumb $dumb $dumb $dumb $dumb $dumb \
$dumb $dumb $stupid_top_and_bottom] -to 0 0 12 12
$name configure -image ::img::swatchbutton::$name
}
proc ::dialog_prefs::swatchmenu_nav {w dir} {
set new [expr {[$w index active] + 7 * $dir}]
if {$new > [$w index end] || $new < 0} then return
$w activate $new
}
proc ::dialog_prefs::swatchbutton_colorchooser {name variable} {
set col [tk_chooseColor -parent $name -initialcolor [set $variable]]
if {$col ne ""} {
set $variable $col
# kludge since the dialog has static name for colors, we refer to it here
# with partially modular approach that should hopefully prove universal
set combobox [string trimright $name .link]
::dialog_prefs::dropdown_set $combobox.presets.presets Custom
::pd_guiprefs::write_guipreset
}
}
proc ::dialog_prefs::swatchbutton {name variable} {
ttk::button $name \
-command "::dialog_prefs::swatchbutton_colorchooser $name $variable"
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
}
# These are images used to build the menu for choosing
# colors. The images hang around in memory until you exit
# Pd, but they shouldn't take up too much space to matter
# (and this only gets called once). If there's a simpler
# way to build a _straightforward_ _user-friendly_
# colorchooser that would be nice, but I couldn't figure
# one out.
proc ::dialog_prefs::get_colorswatches {} {
# stolen from the Firefox colorchooser
set colors { \
#ffffff #cfcccc #c0c0c0 #999999 #666666 #333333 #000000 \
#ffcccc #ff6666 #ff0000 #cc0000 #990000 #660000 #330000 \
#ffcc99 #ff9966 #ff9900 #ff6600 #cc6600 #993300 #663300 \
#ffff99 #ffff66 #ffcc66 #ffcc33 #cc9933 #996633 #663333 \
#ffffcc #ffff33 #ffff00 #ffcc00 #999900 #666600 #333300 \
#99ff99 #66ff99 #33ff33 #33cc00 #009900 #006600 #003300 \
#99ffff #33ffff #66cccc #00cccc #339999 #336666 #003333 \
#ccffff #66ffff #33ccff #3366ff #3333ff #000099 #000066 \
#ccccff #9999ff #6666cc #6633ff #6600cc #333399 #330099 \
#ffccff #ff99ff #cc66cc #cc33cc #993399 #663366 #330033 \
}
if {[lsearch [image names] ::img::colorswatches::*] == -1} {
foreach color $colors {
image create photo ::img::colorswatches::$color
::img::colorswatches::$color put $color -to 0 0 16 16
}
}
return $colors
}
proc ::dialog_prefs::help {notebook} {
set pane [$notebook select]
regsub {.*\.(.*)} $pane {\1} topic
set file all_about_${topic}_settings.pd
set dir [file join $::sys_libdir doc 5.reference]
menu_doc_open $dir $file
}
proc ::dialog_prefs::dialog_bindings {mytoplevel dialogname} {
variable modifier
bind $mytoplevel <KeyPress-Escape> "dialog_${dialogname}::cancel $mytoplevel"
bind $mytoplevel <KeyPress-Return> "dialog_${dialogname}::ok $mytoplevel"
bind $mytoplevel <$::modifier-Key-w> "dialog_${dialogname}::cancel $mytoplevel"
# these aren't supported in the dialog, so alert the user, then break so
# that no other key bindings are run
bind $mytoplevel <$::modifier-Key-s> {bell; break}
bind $mytoplevel <$::modifier-Shift-Key-S> {bell; break}
bind $mytoplevel <$::modifier-Key-p> {bell; break}
wm protocol $mytoplevel WM_DELETE_WINDOW "dialog_${dialogname}::cancel $mytoplevel"
}
proc ::dialog_prefs::create_dialog {mytoplevel} {
toplevel .prefs -class [winfo class .]
wm title .prefs [_ "Pure Data Preferences"]
# wm geometry .prefs =475x125+150+150
wm group .prefs .
wm resizable .prefs 0 0
wm transient .prefs
# obtain last known mouse coords and pop the menu there
global pointer_x_global pointer_y_global
if {$pointer_x_global == 0 && $pointer_y_global == 0} {
set pointer_x_global [expr [winfo rootx .]+30]
set pointer_y_global [expr [winfo rooty .]+30]
}
wm geometry .prefs "+$pointer_x_global+$pointer_y_global"
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
# .prefs configure -menu $::dialog_menubar
# todo: check this on the mac and on windows
# .prefs configure -padx 10 -pady 5
::dialog_prefs::dialog_bindings .prefs "prefs"
bind .prefs <$::modifier-Key-f> break
# Ttk style setup
# Common settings
ttk::style configure Prefs.TLabelframe -borderwidth 0
# todo: don't hardcode font here
ttk::style configure Prefs.TLabelframe.Label \
-font "{DejaVu Sans} 9 bold"
# for OSX swatchbutton
if {$::windowingsystem eq "x11"} {
# custom arrow image for ttk::combobox
set ::prefs_arrowimg [image create photo -data \
{R0lGODlhGQAVAMIGACEhIVBQUFpaWl1dXXBwcImJif///////yH+EUNyZWF0ZWQg
d2l0aCBHSU1QACH5BAEKAAcALAAAAAAZABUAAAMleLrc/jDKSau9OOutC/ggUGRE
CBCbAArcEQBBqwxybd94ru9QAgA7
}]
# ttk::style theme use clam
ttk::style element create Prefs.downarrow image $::prefs_arrowimg
ttk::style layout Prefs.TCombobox {
Combobox.focus -sticky nsew -children {
Combobox.field -sticky nswe -children {
Prefs.downarrow -side right -sticky ns
Combobox.padding -expand 1 -sticky nswe -children {
Combobox.textarea -sticky nswe
}
}
}
}
ttk::style layout PrefsColors.TMenubutton {
Menubutton.border -sticky nswe -children {
Menubutton.focus -sticky nswe -children {
Menubutton.padding -expand 1 -sticky we -children {
Menubutton.label -side left -sticky {}
}
}
}
}
ttk::style configure Prefs.TCombobox -padding 3
ttk::style map Prefs.TCombobox \
-fieldbackground {{readonly pressed} #c1c4c7 \
{readonly hover} #fafaf9 \
readonly #f5f5f4} \
-foreground {{readonly focus} black}
# this shouldn't be global, but I can't get it to work for just
# Prefsdialog class
option add *TCombobox*Listbox.selectBackground #4a90d9
option add *TCombobox*Listbox.selectForeground white
}
ttk::notebook .prefs.nb
.prefs.nb add [ttk::frame .prefs.nb.audio -padding 10] \
-text "Audio" -sticky nsew
.prefs.nb add [ttk::frame .prefs.nb.midi -padding 10] \
-text "MIDI" -sticky nsew
.prefs.nb add [ttk::frame .prefs.nb.gui -padding 10] \
-text "GUI" -stick nsew
pack .prefs.nb -fill both -expand 1
ttk::frame .prefs.bottomframe -padding 10
pack .prefs.bottomframe -side bottom -fill both -expand 1
if {$::windowingsystem ne "aqua"} {
ttk::button .prefs.bottomframe.closebutton \
-text "Close" -command "::dialog_prefs::cancel .prefs"
pack .prefs.bottomframe.closebutton -side right
}
ttk::button .prefs.bottomframe.helpbutton \
-text "Help" -command "::dialog_prefs::help .prefs.nb"
pack .prefs.bottomframe.helpbutton -side left
}