aboutsummaryrefslogtreecommitdiff
path: root/pd/src/u_main.tk
diff options
context:
space:
mode:
authorMiller Puckette <millerpuckette@users.sourceforge.net>2005-05-18 04:28:51 +0000
committerMiller Puckette <millerpuckette@users.sourceforge.net>2005-05-18 04:28:51 +0000
commit388f7a1df37afeed0dd120f8091614a7f6dd91ab (patch)
tree8a439951a1c190b1fc786abc4f69b23181c54168 /pd/src/u_main.tk
parentbb13717ae41bfa317e7b84625201279a5a2a09d9 (diff)
Damn, edited this before and lost the update. More data features.
Took about 12 patches. svn path=/trunk/; revision=3006
Diffstat (limited to 'pd/src/u_main.tk')
-rw-r--r--pd/src/u_main.tk806
1 files changed, 507 insertions, 299 deletions
diff --git a/pd/src/u_main.tk b/pd/src/u_main.tk
index dcb1e31b..7e11b5f3 100644
--- a/pd/src/u_main.tk
+++ b/pd/src/u_main.tk
@@ -50,6 +50,18 @@ if {$pd_nt == 2} {
set pd_guidir $pd_gui2/..
load $pd_guidir/bin/pdtcl
set pd_tearoff 0
+
+ # tk::mac::OpenDocument is called with the filenames put into the
+ # var args whenever docs are either dropped on the Pd.app icon or
+ # opened from the Finder.
+ # It uses menu_doc_open so it can handles numerous file types.
+ proc tk::mac::OpenDocument {args} {
+ foreach file $args {
+ pd [concat pd open [pdtk_enquote [file tail $file]] \
+ [pdtk_enquote [file dirname $file]] \;]
+ menu_doc_open [file dirname $file] [file tail $file]
+ }
+ }
}
# hack so you can easily test-run this script in linux... define pd_guidir
@@ -74,6 +86,8 @@ bind Text <Control-s> {}
# puts stderr [bind all]
################## set up main window #########################
+# the menus are instantiated here for the main window
+# for the patch windows, they are created by pdtk_canvas_new
menu .mbar
canvas .dummy -height 2p -width 6c
@@ -88,13 +102,25 @@ menu .mbar.audio -tearoff $pd_tearoff
if {$pd_nt != 2} {
.mbar add cascade -label "Windows" -menu .mbar.windows
.mbar add cascade -label "Media" -menu .mbar.audio
+# a menu on the main menubar named $whatever.help while be treated
+# as a special menu with specific behaviors on different platforms.
+# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm
+ menu .mbar.help -tearoff $pd_tearoff
+ .mbar add cascade -label "Help" -menu .mbar.help
} else {
-# Perhaps this is silly, but Mac HIG want "Window Help" as the last menus
+ menu .mbar.apple -tearoff 0
+ .mbar add cascade -label "Apple" -menu .mbar.apple
+# arrange menus according to Apple HIG
.mbar add cascade -label "Media" -menu .mbar.audio
- .mbar add cascade -label "Windows" -menu .mbar.windows
+ .mbar add cascade -label "Window" -menu .mbar.windows
+# a menu on the main menubar named "$whatever.help" while be treated
+# as a special menu with specific behaviors on different platforms.
+# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm
+# Apple doesn't allow cascading menus in their Help so I had to call this
+# one $mbar.docs # <hans@at.or.at>
+ menu .mbar.docs -tearoff $pd_tearoff
+ .mbar add cascade -label "Help" -menu .mbar.docs
}
-menu .mbar.help -tearoff $pd_tearoff
-.mbar add cascade -label "Help" -menu .mbar.help
set ctrls_audio_on 0
set ctrls_meter_on 0
@@ -263,22 +289,26 @@ proc menu_new {} {
proc menu_open {} {
global pd_opendir
-
set filename [tk_getOpenFile -defaultextension .pd \
-filetypes { {{pd files} {.pd}} {{max files} {.pat}}} \
-initialdir $pd_opendir]
+ if {$filename != ""} {open_file $filename}
+}
- if {$filename != ""} {
- set directory [string range $filename 0 \
- [expr [string last / $filename ] - 1]]
- set pd_opendir $directory
- set basename [string range $filename \
- [expr [string last / $filename ] + 1] end]
-
-# pd_debug [concat file $filename base $basename dir $directory]
+proc open_file {filename} {
+ global pd_opendir
+ set directory [string range $filename 0 [expr [string last / $filename] - 1]]
+ set pd_opendir $directory
+ set basename [string range $filename [expr [string last / $filename] + 1] end]
+ if {[string last .pd $filename] >= 0} {
+ pd "pd open [pdtk_enquote $basename] [pdtk_enquote $directory] ;"
+ }
+}
- pd [concat pd open [pdtk_enquote $basename] \
- [pdtk_enquote $directory]\;]
+catch {
+ package require tkdnd
+ dnd bindtarget . text/uri-list <Drop> {
+ foreach file %D {open_file $file}
}
}
@@ -311,13 +341,15 @@ proc menu_audio {flag} {pd [concat pd dsp $flag \;]}
set doc_number 1
+# open text docs in a Pd window
proc menu_opentext {filename} {
global doc_number
global pd_guidir
global pd_myversion
+ global pd_font3
set name [format ".help%d" $doc_number]
toplevel $name
- text $name.text -relief raised -bd 2 -font -*-courier-bold--normal--12-* \
+ text $name.text -relief raised -bd 2 -font $pd_font3 \
-yscrollcommand "$name.scroll set" -background white
scrollbar $name.scroll -command "$name.text yview"
pack $name.scroll -side right -fill y
@@ -334,15 +366,34 @@ proc menu_opentext {filename} {
set doc_number [expr $doc_number + 1]
}
+# open HTML docs from the menu using the OS-default HTML viewer
+proc menu_openhtml {filename} {
+ global pd_nt
+
+ if {$pd_nt == 0} {
+ exec sh -c \
+ [format "firefox file:%s || mozilla file:%s &\n" \
+ $filename $filename]
+ } elseif {$pd_nt == 2} {
+ puts stderr [format "open %s" $filename]
+ exec sh -c [format "open %s" $filename]
+ } else {
+ exec rundll32 url.dll,FileProtocolHandler \
+ [format "file:%s" $filename] &
+ }
+}
+
set help_directory $pd_guidir/doc
+set help_top_directory $pd_guidir/doc
proc menu_documentation {} {
global help_directory
global pd_nt
+ global pd_guidir
if {$pd_nt == 2} {
exec rm -rf /tmp/pd-documentation
- exec cp -pr $help_directory /tmp/pd-documentation
+ exec cp -pr $pd_guidir/doc /tmp/pd-documentation
set filename [tk_getOpenFile -defaultextension .pd \
-filetypes { {{documentation} {.pd .txt .htm}} } \
-initialdir /tmp/pd-documentation]
@@ -355,18 +406,7 @@ proc menu_documentation {} {
if {[string first .txt $filename] >= 0} {
menu_opentext $filename
} elseif {[string first .htm $filename] >= 0} {
- if {$pd_nt == 0} {
- exec sh -c \
- [format "mozilla file:%s || netscape file:%s &\n" \
- $filename $filename]
- } elseif {$pd_nt == 2} {
- puts stderr [format "open %s" $filename]
- exec sh -c \
- [format "open %s" $filename]
- } else {
- exec rundll32 url.dll,FileProtocolHandler \
- [format "file:%s" $filename] &
- }
+ menu_openhtml $filename
} else {
set help_directory [string range $filename 0 \
[expr [string last / $filename ] - 1]]
@@ -383,18 +423,43 @@ proc menu_doc_open {subdir basename} {
set dirname $pd_guidir/$subdir
- if {[string first .txt $basename] >= 0} {
+ if {[regexp ".*\.(txt|c)$" $basename]} {
menu_opentext $dirname/$basename
+ } elseif {[regexp ".*\.html?$" $basename]} {
+ menu_openhtml $dirname/$basename
} else {
pd [concat pd open [pdtk_enquote $basename] \
[pdtk_enquote $dirname] \;]
}
}
-############# routine to add audio and help menus ###############
+proc doc_submenu {helpmenu subdir} {
+ global help_top_directory pd_tearoff
+
+ set menudir $help_top_directory/$subdir
+
+ regsub -all "\\\." $subdir "" submenu
+
+ menu $helpmenu.$submenu -tearoff $pd_tearoff
+ regsub -all "\\\." $subdir " " submenuname
+ $helpmenu add cascade -label $submenuname \
+ -menu $helpmenu.$submenu
+ catch {
+# use this glob pattern to exclude the supporting files
+# foreach file [ lsort [ glob -dir $menudir {*[0-9][0-9]*} ] ]
+ foreach file [ lsort [ glob -dir $menudir * ] ] {
+ set filename ""
+ regsub {.*/(.*\..+$)} $file {\1} filename
+ $helpmenu.$submenu add command -label $filename \
+ -command "menu_doc_open doc/$subdir $filename"
+ }
+ }
+}
+
+############# routine to add media, help, and apple menu items ###############
proc menu_addstd {mbar} {
- global pd_apilist
+ global pd_apilist pd_nt pd_tearoff
# the "Audio" menu
$mbar.audio add command -label {audio ON} -accelerator [accel_munge "Ctrl+/"] \
-command {menu_audio 1}
@@ -406,21 +471,66 @@ proc menu_addstd {mbar} {
-value [lindex [lindex $pd_apilist $x] 1]\
-command {pd [concat pd audio-setapi $pd_whichapi \;]}
}
+ if {$pd_nt != 2} {
$mbar.audio add command -label {Audio settings...} \
-command {pd pd audio-properties \;}
-
$mbar.audio add command -label {MIDI settings...} \
-command {pd pd midi-properties \;}
+ }
+
$mbar.audio add command -label {Test Audio and MIDI} \
-command {menu_doc_open doc/7.stuff/tools testtone.pd}
$mbar.audio add command -label {Load Meter} \
-command {menu_doc_open doc/7.stuff/tools load-meter.pd}
+# the MacOS X app menu
+
+# The menu on the main menubar named $whatever.apple while be treated
+# as a special menu on MacOS X. Tcl/Tk assigns the $whatever.apple menu
+# to the app-specific menu in MacOS X that is named after the app,
+# so in our case, the Pd menu. <hans@at.or.at>
+# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm
+ if {$pd_nt == 2} {
+ $mbar.apple add command -label "About Pd..." -command \
+ {menu_doc_open doc/1.manual 1.introduction.txt}
+ menu $mbar.apple.preferences -tearoff 0
+ $mbar.apple add cascade -label "Preferences" -menu $mbar.apple.preferences
+ $mbar.apple.preferences add command -label "Path..." \
+ -command {pd pd start-path-dialog \;}
+ $mbar.apple.preferences add command -label "Startup..." \
+ -command {pd pd start-startup-dialog \;}
+ $mbar.apple.preferences add command -label "Audio Settings..." \
+ -command {pd pd audio-properties \;}
+ $mbar.apple.preferences add command -label "MIDI settings..." \
+ -command {pd pd midi-properties \;}
+ }
+
+
# the "Help" menu
+ if {$pd_nt != 2} {
+# a menu on the main menubar named "$whatever.help" while be treated
+# as a special menu with specific behaviors on different platforms.
+# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm
$mbar.help add command -label {About Pd} \
-command {menu_doc_open doc/1.manual 1.introduction.txt}
$mbar.help add command -label {Pure Documentation...} \
-command {menu_documentation}
+ # add menu items for each section instead of using Pd patches
+ $mbar.help add separator
+ set helpmenuname help
+ } else {
+# Apple doesn't allow cascading menus in their Help so I had to call this
+# one "docs" <hans@at.or.at>
+ set helpmenuname docs
+ }
+
+ $mbar.$helpmenuname add command -label {1 manual...} \
+ -command {menu_doc_open doc/1.manual index.htm}
+ doc_submenu $mbar.$helpmenuname 2.control.examples
+ doc_submenu $mbar.$helpmenuname 3.audio.examples
+ doc_submenu $mbar.$helpmenuname 4.fft.examples
+ doc_submenu $mbar.$helpmenuname 5.reference
+ doc_submenu $mbar.$helpmenuname 6.externs
}
#################### the "File" menu for the Pd window ##############
@@ -432,16 +542,20 @@ proc menu_addstd {mbar} {
.mbar.file add separator
.mbar.file add command -label Message -command {menu_send} \
-accelerator [accel_munge "Ctrl+m"]
+# On MacOS X, these are in the standard HIG locations
+# i.e. the Preferences menu under "Pd"
+if {$pd_nt != 2} {
.mbar.file add command -label Path... \
-command {pd pd start-path-dialog \;}
.mbar.file add command -label Startup... \
-command {pd pd start-startup-dialog \;}
+}
.mbar.file add separator
.mbar.file add command -label Quit -command {menu_quit} \
-accelerator [accel_munge "Ctrl+q"]
#################### the "Find" menu for the Pd window ##############
-.mbar.find add command -label {last error?} -command {menu_finderror}
+.mbar.find add command -label {Find last error} -command {menu_finderror}
########### functions for menu functions on document windows ########
@@ -466,6 +580,7 @@ proc menu_print {name} {
}
proc menu_close {name} {
+ pdtk_canvas_checkgeometry $name
pd [concat $name menuclose \;]
}
@@ -721,8 +836,22 @@ proc pdtk_canvas_new {name width height geometry editable} {
global pd_nt
toplevel $name -menu $name.m
-# puts stderr [concat geometry: $geometry]
- wm geometry $name $geometry
+
+# slide offscreen windows into view
+ set geometry [split $geometry +]
+ set i 1
+ foreach geo {width height} {
+ set screen($geo) [winfo screen$geo .]
+ if {[expr [lindex $geometry $i] + [set $geo]] > $screen($geo)} {
+ set pos($geo) [expr $screen($geo) - [set $geo]]
+ if {$pos($geo) < 0} {set pos($geo) 0}
+ lset geometry $i $pos($geo)
+ }
+ incr i
+ }
+ set geometry [join $geometry +]
+
+ wm geometry $name $geometry
canvas $name.c -width $width -height $height -background white \
-yscrollcommand "$name.scrollvert set" \
-xscrollcommand "$name.scrollhort set" \
@@ -739,6 +868,9 @@ proc pdtk_canvas_new {name width height geometry editable} {
wm geometry $name $geometry
# the file menu
+# The menus are instantiated here for the patch windows.
+# For the main window, they are created on load, at the
+# top of this file.
menu $name.m
menu $name.m.file -tearoff $pd_tearoff
$name.m add cascade -label File -menu $name.m.file
@@ -753,11 +885,15 @@ proc pdtk_canvas_new {name width height geometry editable} {
$name.m.file add command -label Message -command {menu_send} \
-accelerator [accel_munge "Ctrl+m"]
+ # arrange menus according to Apple HIG
+ # these are now part of Preferences...
+ if {$pd_nt != 2 } {
$name.m.file add command -label Path... \
-command {pd pd start-path-dialog \;}
$name.m.file add command -label Startup... \
-command {pd pd start-startup-dialog \;}
+ }
$name.m.file add separator
$name.m.file add command -label Close \
@@ -823,6 +959,18 @@ proc pdtk_canvas_new {name width height geometry editable} {
$name.m.edit add separator
+# Apple, Microsoft, and others put find functions in the Edit menu.
+ $name.m.edit add command -label {Find...} \
+ -accelerator [accel_munge "Ctrl+f"] \
+ -command [concat menu_findobject $name]
+ $name.m.edit add command -label {Find Again} \
+ -accelerator [accel_munge "Ctrl+g"] \
+ -command [concat menu_findagain $name]
+ $name.m.edit add command -label {Find last error} \
+ -command [concat menu_finderror]
+
+ $name.m.edit add separator
+
############iemlib##################
# instead of "red = #BC3C60" we take "grey85", so there is no difference,
# if widget is selected or not.
@@ -834,9 +982,242 @@ proc pdtk_canvas_new {name width height geometry editable} {
if { $editable == 0 } {
$name.m.edit entryconfigure "Edit mode" -indicatoron false }
+
############iemlib##################
+
+# the put menu
+ menu $name.m.put -tearoff $pd_tearoff
+ $name.m add cascade -label Put -menu $name.m.put
+
+ $name.m.put add command -label Object \
+ -command [concat menu_object $name 0] \
+ -accelerator [accel_munge "Ctrl+1"]
+
+ $name.m.put add command -label Message \
+ -command [concat menu_message $name 0] \
+ -accelerator [accel_munge "Ctrl+2"]
+
+ $name.m.put add command -label Number \
+ -command [concat menu_floatatom $name 0] \
+ -accelerator [accel_munge "Ctrl+3"]
+
+ $name.m.put add command -label Symbol \
+ -command [concat menu_symbolatom $name 0] \
+ -accelerator [accel_munge "Ctrl+4"]
+
+ $name.m.put add command -label Comment \
+ -command [concat menu_comment $name 0] \
+ -accelerator [accel_munge "Ctrl+5"]
+
+ $name.m.put add separator
+
+############iemlib##################
+
+ $name.m.put add command -label Bang \
+ -command [concat menu_bng $name 0] \
+ -accelerator [accel_munge "Shift+Ctrl+b"]
+
+ $name.m.put add command -label Toggle \
+ -command [concat menu_toggle $name 0] \
+ -accelerator [accel_munge "Shift+Ctrl+t"]
+
+ $name.m.put add command -label Number2 \
+ -command [concat menu_numbox $name 0] \
+ -accelerator [accel_munge "Shift+Ctrl+n"]
+
+ $name.m.put add command -label Vslider \
+ -command [concat menu_vslider $name 0] \
+ -accelerator [accel_munge "Shift+Ctrl+v"]
+
+ $name.m.put add command -label Hslider \
+ -command [concat menu_hslider $name 0] \
+ -accelerator [accel_munge "Shift+Ctrl+h"]
+
+ $name.m.put add command -label Vradio \
+ -command [concat menu_vradio $name 0] \
+ -accelerator [accel_munge "Shift+Ctrl+d"]
+
+ $name.m.put add command -label Hradio \
+ -command [concat menu_hradio $name 0] \
+ -accelerator [accel_munge "Shift+Ctrl+i"]
+
+ $name.m.put add command -label VU \
+ -command [concat menu_vumeter $name 0] \
+ -accelerator [accel_munge "Shift+Ctrl+u"]
+
+ $name.m.put add command -label Canvas \
+ -command [concat menu_mycnv $name 0] \
+ -accelerator [accel_munge "Shift+Ctrl+c"]
+
+############iemlib##################
+
+ $name.m.put add separator
+
+ $name.m.put add command -label Graph \
+ -command [concat menu_graph $name]
+
+ $name.m.put add command -label Array \
+ -command [concat menu_array $name]
+
+# the find menu
+# Apple, Microsoft, and others put find functions in the Edit menu.
+# But in order to move these items to the Edit menu, the Find menu
+# handling needs to be dealt with, including this line in g_canvas.c:
+# sys_vgui(".mbar.find delete %d\n", i);
+# <hans@at.or.at>
+ menu $name.m.find -tearoff $pd_tearoff
+ $name.m add cascade -label Find -menu $name.m.find
+
+ $name.m.find add command -label {Find...} \
+ -accelerator [accel_munge "Ctrl+f"] \
+ -command [concat menu_findobject $name]
+ $name.m.find add command -label {Find Again} \
+ -accelerator [accel_munge "Ctrl+g"] \
+ -command [concat menu_findagain $name]
+ $name.m.find add command -label {Find last error} \
+ -command [concat menu_finderror]
+
+# the window menu
+ menu $name.m.windows -postcommand [concat menu_fixwindowmenu $name] \
+ -tearoff $pd_tearoff
+
+ $name.m.windows add command -label {parent window}\
+ -command [concat menu_windowparent $name]
+ $name.m.windows add command -label {Pd window} -command menu_pop_pd
+ $name.m.windows add separator
+
+# the audio menu
+ menu $name.m.audio -tearoff $pd_tearoff
+
+ if {$pd_nt != 2} {
+ $name.m add cascade -label Windows -menu $name.m.windows
+ $name.m add cascade -label Media -menu $name.m.audio
+ } else {
+ $name.m add cascade -label Media -menu $name.m.audio
+ $name.m add cascade -label Window -menu $name.m.windows
+# the MacOS X app menu
+ menu $name.m.apple -tearoff $pd_tearoff
+ $name.m add cascade -label "Apple" -menu $name.m.apple
+ }
+
+# the help menu
+
+# a menu on the main menubar named "$whatever.help" while be treated
+# as a special menu with specific behaviors on different platforms.
+# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm
+ if {$pd_nt != 2} {
+ menu $name.m.help -tearoff $pd_tearoff
+ $name.m add cascade -label Help -menu $name.m.help
+ } else {
+ # Apple doesn't allow cascading menus in their Help
+ # so I had to call this one "docs". <hans@at.or.at>
+ menu $name.m.docs -tearoff $pd_tearoff
+ $name.m add cascade -label Help -menu $name.m.docs
+ }
+
+ menu_addstd $name.m
+
+# the popup menu
+ menu $name.popup -tearoff false
+ $name.popup add command -label {Properties} \
+ -command [concat popup_action $name 0]
+ $name.popup add command -label {Open} \
+ -command [concat popup_action $name 1]
+ $name.popup add command -label {Help} \
+ -command [concat popup_action $name 2]
+
+# WM protocol
+ wm protocol $name WM_DELETE_WINDOW [concat menu_close $name]
+
+# bindings.
+# this is idiotic -- how do you just sense what mod keys are down and
+# pass them on? I can't find it anywhere.
+# Here we encode shift as 1, control 2, alt 4, in agreement
+# with definitions in g_canvas.c. The third button gets "8" but we don't
+# bother with modifiers there.
+# We don't handle multiple clicks yet.
+
+ bind $name.c <Button> {pdtk_canvas_click %W %x %y %b 0}
+ bind $name.c <Shift-Button> {pdtk_canvas_click %W %x %y %b 1}
+ bind $name.c <Control-Shift-Button> {pdtk_canvas_click %W %x %y %b 3}
+ # Alt key is called Option on the Mac
+ if {$pd_nt == 2} {
+ bind $name.c <Option-Button> {pdtk_canvas_click %W %x %y %b 4}
+ bind $name.c <Option-Shift-Button> {pdtk_canvas_click %W %x %y %b 5}
+ bind $name.c <Option-Control-Button> {pdtk_canvas_click %W %x %y %b 6}
+ bind $name.c <Option-Control-Shift-Button> \
+ {pdtk_canvas_click %W %x %y %b 7}
+ } else {
+ bind $name.c <Alt-Button> {pdtk_canvas_click %W %x %y %b 4}
+ bind $name.c <Alt-Shift-Button> {pdtk_canvas_click %W %x %y %b 5}
+ bind $name.c <Alt-Control-Button> {pdtk_canvas_click %W %x %y %b 6}
+ bind $name.c <Alt-Control-Shift-Button> \
+ {pdtk_canvas_click %W %x %y %b 7}
+ }
+ global pd_nt
+# button 2 is the right button on Mac; on other platforms it's button 3.
+ if {$pd_nt == 2} {
+ bind $name.c <Button-2> {pdtk_canvas_click %W %x %y %b 8}
+ bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 8}
+ } else {
+ bind $name.c <Button-3> {pdtk_canvas_click %W %x %y %b 8}
+ bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 2}
+ }
+#on linux, button 2 "pastes" from the X windows clipboard
+ if {$pd_nt == 0} {
+ bind $name.c <Button-2> {\
+ pdtk_canvas_click %W %x %y %b 0;\
+ pdtk_canvas_mouseup %W %x %y %b;\
+ pdtk_pastetext}
+ }
+
+ bind $name.c <ButtonRelease> {pdtk_canvas_mouseup %W %x %y %b}
+ bind $name.c <Control-Key> {pdtk_canvas_ctrlkey %W %K 0}
+ bind $name.c <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
+# bind $name.c <Mod1-Key> {puts stderr [concat mod1 %W %K %A]}
+ if {$pd_nt == 2} {
+ bind $name.c <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0}
+ bind $name.c <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
+ }
+ bind $name.c <Key> {pdtk_canvas_key %W %K %A 0}
+ bind $name.c <Shift-Key> {pdtk_canvas_key %W %K %A 1}
+ bind $name.c <KeyRelease> {pdtk_canvas_keyup %W %K %A}
+ bind $name.c <Motion> {pdtk_canvas_motion %W %x %y 0}
+ bind $name.c <Control-Motion> {pdtk_canvas_motion %W %x %y 2}
+ if {$pd_nt == 2} {
+ bind $name.c <Option-Motion> {pdtk_canvas_motion %W %x %y 4}
+ } else {
+ bind $name.c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4}
+ }
+ bind $name.c <Map> {pdtk_canvas_map %W}
+ bind $name.c <Unmap> {pdtk_canvas_unmap %W}
+ focus $name.c
+
+ switch $pd_nt { 0 {
+ bind $name.c <Button-4> "pdtk_canvas_scroll $name.c y -1"
+ bind $name.c <Button-5> "pdtk_canvas_scroll $name.c y +1"
+ bind $name.c <Shift-Button-4> "pdtk_canvas_scroll $name.c x -1"
+ bind $name.c <Shift-Button-5> "pdtk_canvas_scroll $name.c x +1"
+ } default {
+ bind $name.c <MouseWheel> \
+ "pdtk_canvas_scroll $name.c y \[expr -abs(%D)/%D\]"
+ bind $name.c <Shift-MouseWheel> \
+ "pdtk_canvas_scroll $name.c x \[expr -abs(%D)/%D\]"
+ }}
+
+ catch {
+ dnd bindtarget $name.c text/uri-list <Drop> \
+ "pdtk_canvas_makeobjs $name %D %x %y"
+ }
+
+# puts stderr "all done"
+# after 1 [concat raise $name]
+ global pdtk_canvas_mouseup_name
+ set pdtk_canvas_mouseup_name ""
+}
+
#### jsarlo #####
proc pdtk_array_listview_setpage {arrayName page} {
global pd_array_listview_page
@@ -1041,203 +1422,6 @@ proc pdtk_array_listview_close {id arrayName} {
}
##### end jsarlo #####
-# the put menu
- menu $name.m.put -tearoff $pd_tearoff
- $name.m add cascade -label Put -menu $name.m.put
-
- $name.m.put add command -label Object \
- -command [concat menu_object $name 0] \
- -accelerator [accel_munge "Ctrl+1"]
-
- $name.m.put add command -label Message \
- -command [concat menu_message $name 0] \
- -accelerator [accel_munge "Ctrl+2"]
-
- $name.m.put add command -label Number \
- -command [concat menu_floatatom $name 0] \
- -accelerator [accel_munge "Ctrl+3"]
-
- $name.m.put add command -label Symbol \
- -command [concat menu_symbolatom $name 0] \
- -accelerator [accel_munge "Ctrl+4"]
-
- $name.m.put add command -label Comment \
- -command [concat menu_comment $name 0] \
- -accelerator [accel_munge "Ctrl+5"]
-
- $name.m.put add separator
-
-############iemlib##################
-
- $name.m.put add command -label Bang \
- -command [concat menu_bng $name 0] \
- -accelerator [accel_munge "Alt+b"]
-
- $name.m.put add command -label Toggle \
- -command [concat menu_toggle $name 0] \
- -accelerator [accel_munge "Alt+t"]
-
- $name.m.put add command -label Number2 \
- -command [concat menu_numbox $name 0] \
- -accelerator [accel_munge "Alt+n"]
-
- $name.m.put add command -label Vslider \
- -command [concat menu_vslider $name 0] \
- -accelerator [accel_munge "Alt+v"]
-
- $name.m.put add command -label Hslider \
- -command [concat menu_hslider $name 0] \
- -accelerator [accel_munge "Alt+h"]
-
- $name.m.put add command -label Vradio \
- -command [concat menu_vradio $name 0] \
- -accelerator [accel_munge "Alt+d"]
-
- $name.m.put add command -label Hradio \
- -command [concat menu_hradio $name 0] \
- -accelerator [accel_munge "Alt+i"]
-
- $name.m.put add command -label VU \
- -command [concat menu_vumeter $name 0] \
- -accelerator [accel_munge "Alt+u"]
-
- $name.m.put add command -label Canvas \
- -command [concat menu_mycnv $name 0] \
- -accelerator [accel_munge "Alt+c"]
-
-############iemlib##################
-
- $name.m.put add separator
-
- $name.m.put add command -label Graph \
- -command [concat menu_graph $name]
-
- $name.m.put add command -label Array \
- -command [concat menu_array $name]
-
-# the find menu
- menu $name.m.find -tearoff $pd_tearoff
- $name.m add cascade -label Find -menu $name.m.find
-
- $name.m.find add command -label {Find...} \
- -accelerator [accel_munge "Ctrl+f"] \
- -command [concat menu_findobject $name]
- $name.m.find add command -label {Find Again} \
- -accelerator [accel_munge "Ctrl+g"] \
- -command [concat menu_findagain $name]
- $name.m.find add command -label {Find last error} \
- -command [concat menu_finderror]
-
-# the window menu
- menu $name.m.windows -postcommand [concat menu_fixwindowmenu $name] \
- -tearoff $pd_tearoff
-
- $name.m.windows add command -label {parent window}\
- -command [concat menu_windowparent $name]
- $name.m.windows add command -label {Pd window} -command menu_pop_pd
- $name.m.windows add separator
-
-# the audio menu
- menu $name.m.audio -tearoff $pd_tearoff
-
- if {$pd_nt != 2} {
- $name.m add cascade -label Windows -menu $name.m.windows
- $name.m add cascade -label Media -menu $name.m.audio
- } else {
- $name.m add cascade -label Media -menu $name.m.audio
- $name.m add cascade -label Window -menu $name.m.windows
- }
-
-# the help menu
- menu $name.m.help -tearoff $pd_tearoff
- $name.m add cascade -label Help -menu $name.m.help
-
- menu_addstd $name.m
-
-# the popup menu
- menu $name.popup -tearoff false
- $name.popup add command -label {Properties} \
- -command [concat popup_action $name 0]
- $name.popup add command -label {Open} \
- -command [concat popup_action $name 1]
- $name.popup add command -label {Help} \
- -command [concat popup_action $name 2]
-
-# WM protocol
- wm protocol $name WM_DELETE_WINDOW [concat menu_close $name]
-
-# bindings.
-# this is idiotic -- how do you just sense what mod keys are down and
-# pass them on? I can't find it anywhere.
-# Here we encode shift as 1, control 2, alt 4, in agreement
-# with definitions in g_canvas.c. The third button gets "8" but we don't
-# bother with modifiers there.
-# We don't handle multiple clicks yet.
-
- bind $name.c <Button> {pdtk_canvas_click %W %x %y %b 0}
- bind $name.c <Shift-Button> {pdtk_canvas_click %W %x %y %b 1}
- bind $name.c <Control-Shift-Button> {pdtk_canvas_click %W %x %y %b 3}
- # Alt key is called Option on the Mac
- if {$pd_nt == 2} {
- bind $name.c <Option-Button> {pdtk_canvas_click %W %x %y %b 4}
- bind $name.c <Option-Shift-Button> {pdtk_canvas_click %W %x %y %b 5}
- bind $name.c <Option-Control-Button> {pdtk_canvas_click %W %x %y %b 6}
- bind $name.c <Option-Control-Shift-Button> \
- {pdtk_canvas_click %W %x %y %b 7}
- } else {
- bind $name.c <Alt-Button> {pdtk_canvas_click %W %x %y %b 4}
- bind $name.c <Alt-Shift-Button> {pdtk_canvas_click %W %x %y %b 5}
- bind $name.c <Alt-Control-Button> {pdtk_canvas_click %W %x %y %b 6}
- bind $name.c <Alt-Control-Shift-Button> \
- {pdtk_canvas_click %W %x %y %b 7}
- }
- global pd_nt
-# button 2 is the right button on Mac; on other platforms it's button 3.
- if {$pd_nt == 2} {
- bind $name.c <Button-2> {pdtk_canvas_click %W %x %y %b 8}
- bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 8}
- } else {
- bind $name.c <Button-3> {pdtk_canvas_click %W %x %y %b 8}
- bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 2}
- }
-#on linux, button 2 "pastes" from the X windows clipboard
- if {$pd_nt == 0} {
- bind $name.c <Button-2> {\
- pdtk_canvas_click %W %x %y %b 0;\
- pdtk_canvas_mouseup %W %x %y %b;\
- pdtk_pastetext}
- }
-
- bind $name.c <ButtonRelease> {pdtk_canvas_mouseup %W %x %y %b}
- bind $name.c <Control-Key> {pdtk_canvas_ctrlkey %W %K 0}
- bind $name.c <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
- if {$pd_nt == 2} {
- bind $name.c <Option-Key> {pdtk_canvas_altkey %W %K %A}
- } else {
- bind $name.c <Alt-Key> {pdtk_canvas_altkey %W %K %A}
- }
-# bind $name.c <Mod1-Key> {puts stderr [concat mod1 %W %K %A]}
- if {$pd_nt == 2} {
- bind $name.c <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0}
- bind $name.c <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
- }
- bind $name.c <Key> {pdtk_canvas_key %W %K %A 0}
- bind $name.c <Shift-Key> {pdtk_canvas_key %W %K %A 1}
- bind $name.c <KeyRelease> {pdtk_canvas_keyup %W %K %A}
- bind $name.c <Motion> {pdtk_canvas_motion %W %x %y 0}
- bind $name.c <Control-Motion> {pdtk_canvas_motion %W %x %y 2}
- if {$pd_nt == 2} {
- bind $name.c <Option-Motion> {pdtk_canvas_motion %W %x %y 4}
- } else {
- bind $name.c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4}
- }
- bind $name.c <Map> {pdtk_canvas_map %W}
- bind $name.c <Unmap> {pdtk_canvas_unmap %W}
- focus $name.c
-# puts stderr "all done"
-# after 1 [concat raise $name]
-}
-
#################### event binding procedures ################
#get the name of the toplevel window for a canvas; this is also
@@ -1376,49 +1560,11 @@ proc pdtk_canvas_keyup {name key iso} {
}
}
-proc pdtk_canvas_altkey {name key iso} {
-# puts stderr [concat alt-key $iso]
-############iemlib##################
- set topname [string trimright $name .c]
- if {$key == "b" || $key == "B"} {menu_bng $topname 1}
- if {$key == "t" || $key == "T"} {menu_toggle $topname 1}
- if {$key == "n" || $key == "N"} {menu_numbox $topname 1}
- if {$key == "v" || $key == "V"} {menu_vslider $topname 1}
- if {$key == "h" || $key == "H"} {menu_hslider $topname 1}
- if {$key == "i" || $key == "I"} {menu_hradio $topname 1}
- if {$key == "d" || $key == "D"} {menu_vradio $topname 1}
- if {$key == "u" || $key == "U"} {menu_vumeter $topname 1}
- if {$key == "c" || $key == "C"} {menu_mycnv $topname 1}
-############iemlib##################
-}
-
proc pdtk_canvas_ctrlkey {name key shift} {
# first get rid of ".c" suffix; we'll refer to the toplevel instead
set topname [string trimright $name .c]
# puts stderr [concat ctrl-key $key $topname]
- if {$key == "n" || $key == "N"} {menu_new}
- if {$key == "o" || $key == "O"} {menu_open}
- if {$key == "m" || $key == "M"} {menu_send}
- if {$key == "q" || $key == "Q"} {
- if {$shift == 1} {menu_really_quit} else {menu_quit}
- }
- if {$key == "s" || $key == "S"} {
- if {$shift == 1} {menu_saveas $topname} else {menu_save $topname}
- }
- if {$key == "z" || $key == "Z"} {
- if {$shift == 1} {menu_redo $topname} else {menu_undo $topname}
- }
- if {$key == "w" || $key == "W"} {menu_close $topname}
- if {$key == "p" || $key == "P"} {menu_print $topname}
- if {$key == "x" || $key == "X"} {menu_cut $topname}
- if {$key == "c" || $key == "C"} {menu_copy $topname}
- if {$key == "v" || $key == "V"} {menu_paste $topname}
- if {$key == "d" || $key == "D"} {menu_duplicate $topname}
- if {$key == "a" || $key == "A"} {menu_selectall $topname}
- if {$key == "t" || $key == "T"} {menu_texteditor $topname}
- if {$key == "f" || $key == "F"} {menu_findobject $topname}
- if {$key == "g" || $key == "G"} {menu_findagain $topname}
if {$key == "1"} {menu_object $topname 1}
if {$key == "2"} {menu_message $topname 1}
if {$key == "3"} {menu_floatatom $topname 1}
@@ -1426,7 +1572,42 @@ proc pdtk_canvas_ctrlkey {name key shift} {
if {$key == "5"} {menu_comment $topname 1}
if {$key == "slash"} {menu_audio 1}
if {$key == "period"} {menu_audio 0}
- if {$key == "e" || $key == "E"} {menu_editmode $topname}
+ if {$shift == 1} {
+ if {$key == "q" || $key == "Q"} {menu_really_quit}
+ if {$key == "s" || $key == "S"} {menu_saveas $topname}
+ if {$key == "z" || $key == "Z"} {menu_redo $topname}
+ if {$key == "b" || $key == "B"} {menu_bng $topname 1}
+ if {$key == "t" || $key == "T"} {menu_toggle $topname 1}
+ if {$key == "n" || $key == "N"} {menu_numbox $topname 1}
+ if {$key == "v" || $key == "V"} {menu_vslider $topname 1}
+ if {$key == "h" || $key == "H"} {menu_hslider $topname 1}
+ if {$key == "i" || $key == "I"} {menu_hradio $topname 1}
+ if {$key == "d" || $key == "D"} {menu_vradio $topname 1}
+ if {$key == "u" || $key == "U"} {menu_vumeter $topname 1}
+ if {$key == "c" || $key == "C"} {menu_mycnv $topname 1}
+ } else {
+ if {$key == "e" || $key == "E"} {menu_editmode $topname}
+ if {$key == "q" || $key == "Q"} {menu_quit}
+ if {$key == "s" || $key == "S"} {menu_save $topname}
+ if {$key == "z" || $key == "Z"} {menu_undo $topname}
+ if {$key == "n" || $key == "N"} {menu_new}
+ if {$key == "o" || $key == "O"} {menu_open}
+ if {$key == "m" || $key == "M"} {menu_send}
+ if {$key == "w" || $key == "W"} {menu_close $topname}
+ if {$key == "p" || $key == "P"} {menu_print $topname}
+ if {$key == "x" || $key == "X"} {menu_cut $topname}
+ if {$key == "c" || $key == "C"} {menu_copy $topname}
+ if {$key == "v" || $key == "V"} {menu_paste $topname}
+ if {$key == "d" || $key == "D"} {menu_duplicate $topname}
+ if {$key == "a" || $key == "A"} {menu_selectall $topname}
+ if {$key == "t" || $key == "T"} {menu_texteditor $topname}
+ if {$key == "f" || $key == "F"} {menu_findobject $topname}
+ if {$key == "g" || $key == "G"} {menu_findagain $topname}
+ }
+}
+
+proc pdtk_canvas_scroll {canvas xy distance} {
+ $canvas [list $xy]view scroll $distance units
}
proc pdtk_canvas_motion {name x y mods} {
@@ -1447,6 +1628,16 @@ proc pdtk_canvas_unmap {name} {
pd [canvastosym $name] map 0 \;
}
+proc pdtk_canvas_makeobjs {name files x y} {
+ set c 0
+ for {set n 0} {$n < [llength $files]} {incr n} {
+ if {[regexp {.*/(.+).pd$} [lindex $files $n] file obj] == 1} {
+ pd $name obj $x [expr $y + ($c * 30)] [pdtk_enquote $obj] \;
+ incr c
+ }
+ }
+}
+
set saveas_dir nowhere
############ pdtk_canvas_saveas -- run a saveas dialog ##############
@@ -2908,7 +3099,7 @@ proc dodata_ok {name} {
}
proc pdtk_data_dialog {name stuff} {
-
+ global pd_font3
toplevel $name
wm title $name {Atom}
wm protocol $name WM_DELETE_WINDOW [concat dodata_cancel $name]
@@ -2923,7 +3114,7 @@ proc pdtk_data_dialog {name stuff} {
pack $name.buttonframe.ok -side left -expand 1
text $name.text -relief raised -bd 2 -height 40 -width 60 \
- -yscrollcommand "$name.scroll set" -font -*-courier-bold--normal--12-*
+ -yscrollcommand "$name.scroll set" -font pd_font3
scrollbar $name.scroll -command "$name.text yview"
pack $name.scroll -side right -fill y
pack $name.text -side left -fill both -expand 1
@@ -2948,8 +3139,20 @@ proc pdtk_canvas_editval {name value} {
proc pdtk_text_new {canvasname myname x y text font color} {
# if {$font < 13} {set fontname [format -*-courier-bold----%d-* $font]}
# if {$font >= 13} {set fontname [format -*-courier-----%d-* $font]}
+
+ global pd_font1 pd_font2 pd_font3 pd_font4 pd_font5 pd_font6 pd_font7
+ switch -- $font {
+ 8 { set typeface $pd_font1 }
+ 10 { set typeface $pd_font2 }
+ 12 { set typeface $pd_font3 }
+ 14 { set typeface $pd_font4 }
+ 16 { set typeface $pd_font5 }
+ 24 { set typeface $pd_font6 }
+ 36 { set typeface $pd_font7 }
+ }
+
$canvasname create text $x $y \
- -font [format -*-courier-bold--normal--%d-* $font] \
+ -font $typeface \
-tags $myname -text $text -fill $color -anchor nw
# pd [concat $myname size [$canvasname bbox $myname] \;]
}
@@ -2980,31 +3183,36 @@ proc pdtk_pd_ctrlkey {name key shift} {
# asked pd to open something. Also, get character width and height for
# font sizes 8, 10, 12, 14, 16, and 24.
-proc pdtk_pd_startup {version apilist} {
+# tb: user defined typefaces
+proc pdtk_pd_startup {version apilist fontname} {
+# puts stderr [concat $version $apilist $fontname]
global pd_myversion pd_apilist
set pd_myversion $version
set pd_apilist $apilist
-
- set width1 [font measure -*-courier-bold--normal--8-* x]
- set height1 [lindex [font metrics -*-courier-bold--normal--8-*] 5]
-
- set width2 [font measure -*-courier-bold--normal--10-* x]
- set height2 [lindex [font metrics -*-courier-bold--normal--10-*] 5]
-
- set width3 [font measure -*-courier-bold--normal--12-* x]
- set height3 [lindex [font metrics -*-courier-bold--normal--12-*] 5]
-
- set width4 [font measure -*-courier-bold--normal--14-* x]
- set height4 [lindex [font metrics -*-courier-bold--normal--14-*] 5]
-
- set width5 [font measure -*-courier-bold--normal--16-* x]
- set height5 [lindex [font metrics -*-courier-bold--normal--16-*] 5]
-
- set width6 [font measure -*-courier-bold--normal--24-* x]
- set height6 [lindex [font metrics -*-courier-bold--normal--24-*] 5]
-
- set width7 [font measure -*-courier-bold--normal--36-* x]
- set height7 [lindex [font metrics -*-courier-bold--normal--36-*] 5]
+ global pd_font1 pd_font2 pd_font3 pd_font4 pd_font5 pd_font6 pd_font7
+
+ set pd_font1 [format -*-%s-bold--normal--8-* $fontname]
+ set pd_font2 [format -*-%s-bold--normal--10-* $fontname]
+ set pd_font3 [format -*-%s-bold--normal--12-* $fontname]
+ set pd_font4 [format -*-%s-bold--normal--14-* $fontname]
+ set pd_font5 [format -*-%s-bold--normal--16-* $fontname]
+ set pd_font6 [format -*-%s-bold--normal--24-* $fontname]
+ set pd_font7 [format -*-%s-bold--normal--36-* $fontname]
+
+ set width1 [font measure $pd_font1 x]
+ set height1 [lindex [font metrics $pd_font1] 5]
+ set width2 [font measure $pd_font2 x]
+ set height2 [lindex [font metrics $pd_font2] 5]
+ set width3 [font measure $pd_font3 x]
+ set height3 [lindex [font metrics $pd_font3] 5]
+ set width4 [font measure $pd_font4 x]
+ set height4 [lindex [font metrics $pd_font4] 5]
+ set width5 [font measure $pd_font5 x]
+ set height5 [lindex [font metrics $pd_font5] 5]
+ set width6 [font measure $pd_font6 x]
+ set height6 [lindex [font metrics $pd_font6] 5]
+ set width7 [font measure $pd_font7 x]
+ set height7 [lindex [font metrics $pd_font7] 5]
set tclpatch [info patchlevel]
if {$tclpatch == "8.3.0" || \
@@ -3088,7 +3296,7 @@ proc texteditor_ok {name} {
proc pdtk_pd_texteditor {stuff} {
- global edit_number
+ global edit_number pd_font3
set name [format ".text%d" $edit_number]
set edit_number [expr $edit_number + 1]
@@ -3105,7 +3313,7 @@ proc pdtk_pd_texteditor {stuff} {
pack $name.buttons.ok -side left -expand 1
text $name.text -relief raised -bd 2 -height 12 -width 60 \
- -yscrollcommand "$name.scroll set" -font -*-courier-bold--normal--12-*
+ -yscrollcommand "$name.scroll set" -font $pd_font3
scrollbar $name.scroll -command "$name.text yview"
pack $name.scroll -side right -fill y
pack $name.text -side left -fill both -expand 1