[47388e]: tcl / pd-gui.tcl Maximize Restore History

Download this file

pd-gui.tcl    498 lines (439 with data), 17.4 kB

  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
 71
 72
 73
 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
155
156
157
158
159
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
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
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
295
296
297
298
299
300
301
302
303
304
305
306
307
308
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
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
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
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
#!/bin/sh
# This line continues for Tcl, but is a single line for 'sh' \
exec wish "$0" -- ${1+"$@"}
# For information on usage and redistribution, and for a DISCLAIMER OF ALL
# WARRANTIES, see the file, "LICENSE.txt," in this distribution.
# Copyright (c) 1997-2009 Miller Puckette.
# "." automatically gets a window, we don't want it. Withdraw it before doing
# anything else, so that we don't get the automatic window flashing for a
# second while pd loads.
wm withdraw .
puts -------------------------------pd-gui.tcl-----------------------------------
package require Tcl 8.3
package require Tk
package require msgcat
# Pd's packages are stored in the same directory as the main script (pd-gui.tcl)
set auto_path [linsert $auto_path 0 [file dirname [info script]]]
package require pd_connect
package require pd_menus
package require pd_bindings
package require pdwindow
package require dialog_array
package require dialog_audio
package require dialog_canvas
package require dialog_font
package require dialog_gatom
package require dialog_iemgui
package require dialog_midi
package require pdtk_canvas
package require pdtk_text
# TODO eliminate this kludge:
package require wheredoesthisgo
# import into the global namespace for backwards compatibility
namespace import ::pd_connect::pdsend
namespace import ::pdwindow::pdtk_post
namespace import ::dialog_array::pdtk_array_dialog
namespace import ::dialog_audio::pdtk_audio_dialog
namespace import ::dialog_canvas::pdtk_canvas_dialog
namespace import ::dialog_font::pdtk_canvas_dofont
namespace import ::dialog_gatom::pdtk_gatom_dialog
namespace import ::dialog_iemgui::pdtk_iemgui_dialog
namespace import ::dialog_midi::pdtk_midi_dialog
namespace import ::dialog_midi::pdtk_alsa_midi_dialog
# hack - these should be better handled in the C code
namespace import ::dialog_array::pdtk_array_listview_new
namespace import ::dialog_array::pdtk_array_listview_fillpage
namespace import ::dialog_array::pdtk_array_listview_setpage
namespace import ::dialog_array::pdtk_array_listview_closeWindow
#------------------------------------------------------------------------------#
# global variables
set PD_MAJOR_VERSION 0
set PD_MINOR_VERSION 0
set PD_BUGFIX_VERSION 0
set PD_TEST_VERSION ""
set TCL_MAJOR_VERSION 0
set TCL_MINOR_VERSION 0
set TCL_BUGFIX_VERSION 0
# for testing which platform we are running on ("aqua", "win32", or "x11")
set windowingsystem ""
# variable for vwait so that 'pd-gui' will timeout if 'pd' never shows up
set wait4pd "init"
# canvas font, received from pd in pdtk_pd_startup, set in s_main.c
set font_family "courier"
set font_weight "normal"
# sizes of chars for each of the Pd fixed font sizes:
# fontsize width(pixels) height(pixels)
set font_fixed_metrics {
8 5 10
9 6 11
10 6 13
12 7 15
14 8 17
16 10 20
18 11 22
24 14 30
30 18 37
36 22 45
}
# root path to lib of Pd's files, see s_main.c for more info
set sys_libdir {}
# root path where the pd-gui.tcl GUI script is located
set sys_guidir {}
set audioapi_list {}
set midiapi_list {}
set pd_whichapi 0
set pd_whichmidiapi 0
# current state of the DSP
set dsp 0
# the toplevel window that currently is on top and has focus
set focused_window .
# TODO figure out how to get all windows into the menu_windowlist
# store list of parent windows for Window menu
set menu_windowlist {}
# store that last 10 files that were opened
set recentfiles_list {}
set total_recentfiles 10
# keep track of the location of popup menu for CanvasWindows
set popup_xpix 0
set popup_ypix 0
## per toplevel/patch data
# store editmode for each open canvas, starting with a blank array
array set editmode {}
#------------------------------------------------------------------------------#
# coding style
#
# these are preliminary ideas, we'll change them as we work things out:
# - when possible use "" doublequotes to delimit messages
# - use '$::myvar' instead of 'global myvar'
# - for the sake of clarity, there should not be any inline code, everything
# should be in a proc that is ultimately triggered from main()
# - if a menu_* proc opens a dialog panel, that proc is called menu_*_dialog
# - use "eq/ne" for string comparison, NOT "==/!=" (http://wiki.tcl.tk/15323)
#
## Names for Common Variables
#----------------------------
#
# variables named after the Tk widgets they represent
# $mytoplevel = a window id made by a 'toplevel' command
# $mygfxstub = a window id made by a 'toplevel' command via gfxstub/x_gui.c
# $menubar = the 'menu' attached to each 'toplevel'
# $mymenu = 'menu' attached to the menubar
# $menuitem = 'menu' item
# $mycanvas = 'canvas'
# $canvasitem = 'canvas' item
#
#
## Prefix Names for procs
#----------------------------
# pdtk_ pd -> pd-gui API (i.e. called from 'pd')
# pdsend pd-gui -> pd API (sends a message to 'pd' using pdsend)
# ------------------------------------------------------------------------------
# init functions
proc set_pd_version {versionstring} {
global pd_myversion
set pd_myversion $versionstring
regexp -- {.*([0-9])\.([0-9]+)[\.\-]([0-9]+)([^0-9]?.*)} $versionstring \
wholematch \
::PD_MAJOR_VERSION ::PD_MINOR_VERSION ::PD_BUGFIX_VERSION ::PD_TEST_VERSION
}
proc set_tcl_version {} {
regexp {([0-9])\.([0-9])\.([0-9]+)} [info patchlevel] \
wholematch \
::TCL_MAJOR_VERSION ::TCL_MINOR_VERSION ::TCL_BUGFIX_VERSION
}
# root paths to find Pd's files where they are installed
proc set_pd_paths {} {
set ::sys_guidir [file normalize [file dirname [info script]]]
set ::sys_libdir [file normalize [file join $::sys_guidir ".."]]
}
proc init_for_platform {} {
# we are not using Tk scaling, so fix it to 1 on all platforms. This
# guarantees that patches will be pixel-exact on every platform
tk scaling 1
switch -- $::windowingsystem {
"x11" {
# add control to show/hide hidden files in the open panel (load
# the tk_getOpenFile dialog once, otherwise it will not work)
catch {tk_getOpenFile -with-invalid-argument}
set ::tk::dialog::file::showHiddenBtn 1
set ::tk::dialog::file::showHiddenVar 0
# set file types that open/save recognize
set ::filetypes \
[list \
[list [_ "Associated Files"] {.pd .pat .mxt} ] \
[list [_ "Pd Files"] {.pd} ] \
[list [_ "Max Patch Files"] {.pat} ] \
[list [_ "Max Text Files"] {.mxt} ] \
]
}
"aqua" {
# set file types that open/save recognize
set ::filetypes \
[list \
[list [_ "Associated Files"] {.pd .pat .mxt} ] \
[list [_ "Pd Files"] {.pd} ] \
[list [_ "Max Patch Files (.pat)"] {.pat} ] \
[list [_ "Max Text Files (.mxt)"] {.mxt} ] \
]
}
"win32" {
font create menufont -family Tahoma -size -11
# set file types that open/save recognize
set ::filetypes \
[list \
[list [_ "Associated Files"] {.pd .pat .mxt} ] \
[list [_ "Pd Files"] {.pd} ] \
[list [_ "Max Patch Files"] {.pat} ] \
[list [_ "Max Text Files"] {.mxt} ] \
]
}
}
}
# ------------------------------------------------------------------------------
# locale handling
# official GNU gettext msgcat shortcut
proc _ {s} {return [::msgcat::mc $s]}
proc load_locale {} {
::msgcat::mcload [file join [file dirname [info script]] .. po]
# for Windows
#set locale "en" ;# Use whatever is right for your app
#if {[catch {package require registry}]} {
# tk_messageBox -icon error -message "Could not get locale from registry"
#} else {
# set locale [string tolower \
# [string range \
# [registry get {HKEY_CURRENT_USER\Control Panel\International} sLanguage] 0 1] ]
#}
##--moo: force default system and stdio encoding to UTF-8
encoding system utf-8
fconfigure stderr -encoding utf-8
fconfigure stdout -encoding utf-8
##--/moo
}
# ------------------------------------------------------------------------------
# font handling
# this proc gets the internal font name associated with each size
proc get_font_for_size {size} {
return "::pd_font_${size}"
}
# searches for a font to use as the default. Tk automatically assigns a
# monospace font to the name "Courier" (see Tk 'font' docs), but it doesn't
# always do a good job of choosing in respect to Pd's needs. So this chooses
# from a list of fonts that are known to work well with Pd.
proc find_default_font {} {
set testfonts {Inconsolata "Courier 10 pitch" "Courier New" "Liberation Mono" FreeMono \
"DejaVu Sans Mono" "Bitstream Vera Sans Mono"}
foreach family $testfonts {
if {[lsearch -exact -nocase [font families] $family] > -1} {
set ::font_family $family
break
}
}
puts "DEFAULT FONT: $::font_family"
}
proc set_base_font {family weight} {
if {[lsearch -exact [font families] $family] > -1} {
set ::font_family $family
} else {
pdtk_post [format \
[_ "WARNING: Font family '%s' not found, using default (%s)"] \
$family $::font_family]
}
if {[lsearch -exact {bold normal} $weight] > -1} {
set ::font_weight $weight
set using_defaults 0
} else {
pdtk_post [format \
[_ "WARNING: Font weight '%s' not found, using default (%s)"] \
$weight $::font_weight]
}
}
# creates all the base fonts (i.e. pd_font_8 thru pd_font_36) so that they fit
# into the metrics given by $::font_fixed_metrics for any given font/weight
proc fit_font_into_metrics {} {
# TODO the fonts picked seem too small, probably on fixed width
foreach {size width height} $::font_fixed_metrics {
set myfont [get_font_for_size $size]
font create $myfont -family $::font_family -weight $::font_weight \
-size [expr {-$height}]
set height2 $height
set giveup 0
while {[font measure $myfont M] > $width} {
incr height2 -1
font configure $myfont -size [expr {-$height2}]
if {$height2 * 2 <= $height} {
set giveup 1
break
}
}
if {$giveup} {
pdtk_post [format \
[_ "ERROR: %s failed to find font size (%s) that fits into %sx%s!"]\
[lindex [info level 0] 0] $size $width $height]
continue
}
}
}
# ------------------------------------------------------------------------------
# procs called directly by pd
# this is only called when 'pd' starts 'pd-gui', not the other way around
proc pdtk_pd_startup {versionstring audio_apis midi_apis sys_font sys_fontweight} {
# pdtk_post "-------------- pdtk_pd_startup ----------------"
# pdtk_post "version: $versionstring"
# pdtk_post "audio_apis: $audio_apis"
# pdtk_post "midi_apis: $midi_apis"
# pdtk_post "sys_font: $sys_font"
# pdtk_post "sys_fontweight: $sys_fontweight"
set oldtclversion 0
pdsend "pd init [enquote_path [pwd]] $oldtclversion $::font_fixed_metrics"
set_pd_version $versionstring
set ::audioapi_list $audio_apis
set ::midiapi_list $midi_apis
if {$::tcl_version >= 8.5} {find_default_font}
set_base_font $sys_font $sys_fontweight
fit_font_into_metrics
# TODO what else is needed from the original?
set ::wait4pd "started"
}
##### routine to ask user if OK and, if so, send a message on to Pd ######
# TODO add 'mytoplevel' once merged to 0.43, with -parent
proc pdtk_check {message reply_to_pd default} {
# TODO this should use -parent and -title, but the hard part is figuring
# out how to get the values for those without changing g_editor.c
set answer [tk_messageBox -type yesno -icon question -default $default \
-message [_ $message]]
if {$answer eq "yes"} {
pdsend $reply_to_pd
}
}
proc pdtk_fixwindowmenu {} {
# TODO canvas_updatewindowlist() sets up the menu_windowlist with all of
# the parent CanvasWindows, we should then use [wm stackorder .] to get
# the rest of the CanvasWindows to make sure that all CanvasWindows are in
# the menu. This would probably be better handled on the C side of
# things, since then, the menu_windowlist could be built with the proper
# parent/child relationships.
# pdtk_post "Running pdtk_fixwindowmenu"
}
# ------------------------------------------------------------------------------
# X11 procs for handling singleton state and getting args from other instances
# first instance
proc singleton {key} {
if {![catch { selection get -selection $key }]} {
return 0
}
selection handle -selection $key . "singleton_request"
selection own -command first_lost -selection $key .
return 1
}
proc singleton_request {offset maxbytes} {
wm deiconify .pdwindow
raise .pdwindow
return [tk appname]
}
proc first_lost {} {
receive_args [selection get -selection PUREDATA]
selection own -command first_lost -selection PUREDATA .
}
# all other instances
proc send_args {offset maxChars} {
return [string range $::argv $offset [expr {$offset+$maxChars}]]
}
proc others_lost {} {
set ::singleton_state "exit"
destroy .
exit
}
# ------------------------------------------------------------------------------
# various startup related procs
proc check_for_running_instances {argc argv} {
# pdtk_post "check_for_running_instances $argc $argv"
switch -- $::windowingsystem {
"aqua" {
# handled by ::tk::mac::OpenDocument in apple_events.tcl
} "x11" {
# http://wiki.tcl.tk/1558
if {![singleton PUREDATA_MANAGER]} {
# other instances called by wish/pd-gui (exempt 'pd' by 5400 arg)
if {$argc == 1 && [string is int $argv] && $argv >= 5400} {return}
selection handle -selection PUREDATA . "send_args"
selection own -command others_lost -selection PUREDATA .
after 5000 set ::singleton_state "timeout"
vwait ::singleton_state
exit
} else {
# first instance
selection own -command first_lost -selection PUREDATA .
}
} "win32" {
## http://wiki.tcl.tk/1558
# TODO on Win: http://tcl.tk/man/tcl8.4/TclCmd/dde.htm
}
}
}
# this command will open files received from a 2nd instance of Pd
proc receive_args args {
# pdtk_post "receive_files $args"
raise .
foreach filename $args {
open_file $filename
}
}
proc load_startup {} {
global errorInfo
# TODO search all paths for startup.tcl
set startupdir [file normalize "$::sys_libdir/startup"]
# pdtk_post "load_startup $startupdir"
puts stderr "load_startup $startupdir"
if { ! [file isdirectory $startupdir]} { return }
foreach filename [glob -directory $startupdir -nocomplain -types {f} -- *.tcl] {
puts "Loading $filename"
set tclfile [open $filename]
set tclcode [read $tclfile]
close $tclfile
if {[catch {uplevel #0 $tclcode} errorname]} {
puts stderr "------------------------------------------------------"
puts stderr "UNHANDLED ERROR: $errorInfo"
puts stderr "FAILED TO LOAD $filename"
puts stderr "------------------------------------------------------"
}
}
}
# ------------------------------------------------------------------------------
# main
proc main {argc argv} {
# TODO Tcl/Tk 8.3 doesn't have [tk windowingsystem]
set ::windowingsystem [tk windowingsystem]
tk appname pd-gui
load_locale
check_for_running_instances $argc $argv
set_pd_paths
init_for_platform
# post_tclinfo
# set a timeout for how long 'pd-gui' should wait for 'pd' to start
after 20000 set ::wait4pd "timeout"
# TODO check args for -stderr and set pdtk_post accordingly
if {$argc == 1 && [string is int $argv] && $argv >= 5400} {
# 'pd' started first and launched us, so get the port to connect to
::pd_connect::to_pd [lindex $argv 0]
} else {
# the GUI is starting first, so create socket and exec 'pd'
set portnumber [::pd_connect::create_socket]
set pd_exec [file join [file dirname [info script]] ../bin/pd]
exec -- $pd_exec -guiport $portnumber &
}
# wait for 'pd' to call pdtk_pd_startup, or exit on timeout
vwait ::wait4pd
if {$::wait4pd eq "timeout"} {
puts stderr [_ "ERROR: 'pd' never showed up, 'pd-gui' quitting!"]
exit 2
}
::pd_bindings::class_bindings
::pd_menus::create_menubar
::pdtk_canvas::create_popup
::pdwindow::create_window
::pd_menus::configure_for_pdwindow
load_startup
# pdtk_post "------------------ done with main ----------------------"
}
main $::argc $::argv