#!/usr/bin/wish # set pd_nt (bad name) 0 for unix, 1 for microsoft, and 2 for Mac OSX. if { $tcl_platform(platform) == "windows" } { set pd_nt 1 } elseif { $tcl_platform(os) == "Darwin" } { set pd_nt 2 } else { set pd_nt 0 } # Copyright (c) 1997-1999 Miller Puckette. # For information on usage and redistribution, and for a DISCLAIMER OF ALL # WARRANTIES, see the file, "LICENSE.txt," in this distribution. # changed by Thomas Musil 09.2001 # between "pdtk_graph_dialog -- dialog window for graphs" # and "pdtk_array_dialog -- dialog window for arrays" # a new dialogbox was inserted, named: # "pdtk_iemgui_dialog -- dialog window for iem guis" # # all this changes are labeled with #######iemlib########## # Tearoff is set to true by default: set pd_tearoff 1 # jsarlo set pd_array_listview_pagesize 1000 set pd_array_listview_id(0) 0 set pd_array_listview_entry(0) 0 set pd_array_listview_page(0) 0 # end jsarlo if {$pd_nt == 1} { global pd_guidir global pd_tearoff set pd_gui2 [string range $argv0 0 [expr [string last \\ $argv0 ] - 1]] regsub -all \\\\ $pd_gui2 / pd_gui3 set pd_guidir $pd_gui3/.. load $pd_guidir/bin/pdtcl.dll set pd_tearoff 1 } if {$pd_nt == 2} { # turn on James Tittle II's fast drawing set tk::mac::useCGDrawing 1 # set minimum line size for anti-aliasing. If set to 1 or 0, then every # line will be anti-aliased. While this makes connections and circles in # [bng] and such look really good, it makes boxes and messages look out of # focus. Setting this to 2 makes it so the thick audio rate connections # are anti-aliased. 2005-06-09 set tk::mac::CGAntialiasLimit 2 global pd_guidir global pd_tearoff set pd_gui2 [string range $argv0 0 [expr [string last / $argv0 ] - 1]] set pd_guidir $pd_gui2/.. load $pd_guidir/bin/libPdTcl.dylib set pd_tearoff 0 global pd_macready set pd_macready 0 global pd_macdropped set pd_macdropped "" # 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} { global pd_macready pd_macdropped foreach file $args { if {$pd_macready != 0} { pd [concat pd open [pdtk_enquote [file tail $file]] \ [pdtk_enquote [file dirname $file]] \;] menu_doc_open [file dirname $file] [file tail $file] } else { set pd_macdropped $args } } } } # hack so you can easily test-run this script in linux... define pd_guidir # (which is normally defined at startup in pd under linux...) if {$pd_nt == 0} { if {! [info exists pd_guidir]} { global pd_guidir puts stderr {setting pd_guidir to '.'} set pd_guidir . } } set pd_deffont {courier 12 bold} set help_top_directory $pd_guidir/doc # it's unfortunate but we seem to have to turn off global bindings # for Text objects to get control-s and control-t to do what we want for # "text" dialogs below. Also we have to get rid of tab's changing the focus. bind all "" bind all <> "" bind Text {} bind Text {} # 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 frame .controls pack .controls .dummy -side top -fill x menu .mbar.file -tearoff $pd_tearoff .mbar add cascade -label "File" -menu .mbar.file menu .mbar.find -tearoff $pd_tearoff .mbar add cascade -label "Find" -menu .mbar.find menu .mbar.windows -postcommand [concat pdtk_fixwindowmenu] -tearoff $pd_tearoff 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 menu .mbar.help -tearoff $pd_tearoff .mbar add cascade -label "Help" -menu .mbar.help } else { 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 "Window" -menu .mbar.windows menu .mbar.help -tearoff $pd_tearoff .mbar add cascade -label "Help" -menu .mbar.help } set ctrls_audio_on 0 set ctrls_meter_on 0 set ctrls_inlevel 0 set ctrls_outlevel 0 frame .controls.switches checkbutton .controls.switches.audiobutton -text {compute audio} \ -variable ctrls_audio_on \ -anchor w \ -command {pd [concat pd dsp $ctrls_audio_on \;]} checkbutton .controls.switches.meterbutton -text {peak meters} \ -variable ctrls_meter_on \ -anchor w \ -command {pd [concat pd meters $ctrls_meter_on \;]} pack .controls.switches.audiobutton .controls.switches.meterbutton -side top frame .controls.inout frame .controls.inout.in label .controls.inout.in.label -text IN entry .controls.inout.in.level -textvariable ctrls_inlevel -width 3 button .controls.inout.in.clip -text {CLIP} -state disabled pack .controls.inout.in.label .controls.inout.in.level \ .controls.inout.in.clip -side top -pady 2 frame .controls.inout.out label .controls.inout.out.label -text OUT entry .controls.inout.out.level -textvariable ctrls_outlevel -width 3 button .controls.inout.out.clip -text {CLIP} -state disabled pack .controls.inout.out.label .controls.inout.out.level \ .controls.inout.out.clip -side top -pady 2 button .controls.dio -text "DIO\nerrors" \ -command {pd [concat pd audiostatus \;]} pack .controls.inout.in .controls.inout.out -side left -padx 6 pack .controls.inout -side left -padx 14 pack .controls.switches -side right pack .controls.dio -side right -padx 20 frame .printout text .printout.text -relief raised -bd 2 -font -*-courier-bold--normal--12-* \ -yscrollcommand ".printout.scroll set" -width 80 # .printout.text insert end "\n\n\n\n\n\n\n\n\n\n" scrollbar .printout.scroll -command ".printout.text yview" pack .printout.scroll -side right -fill y pack .printout.text -side left -fill both -expand 1 pack .printout -side bottom -fill both -expand 1 proc pdtk_post {stuff} { .printout.text insert end $stuff .printout.text yview end-2char } proc pdtk_standardkeybindings {id} { global pd_nt bind $id {pdtk_pd_ctrlkey %W %K 0} bind $id {pdtk_pd_ctrlkey %W %K 1} if {$pd_nt == 2} { bind $id {pdtk_canvas_ctrlkey %W %K 0} bind $id {pdtk_canvas_ctrlkey %W %K 1} } } pdtk_standardkeybindings . wm title . "Pd" . configure -menu .mbar -width 200 -height 150 # Intercept closing the main pd window: MP 20060413: wm protocol . WM_DELETE_WINDOW menu_quit ############### set up global variables ################################ set untitled_number 1 set untitled_directory [pwd] set saveas_client doggy set pd_opendir $untitled_directory set pd_savedir $untitled_directory set pd_undoaction no set pd_redoaction no set pd_undocanvas no ################ utility functions ######################### # enquote a string to send it to a tcl function proc pdtk_enquote {x} { set foo [string map {"," "" ";" "" \" ""} $x] set foo2 [string map {" " "\\ "} $foo] concat $foo2 } #enquote a string to send it to Pd. Blow off semi and comma; alias spaces #we also blow off "{", "}", "\" because they'll just cause bad trouble later. proc pdtk_unspace {x} { set y [string map {" " "_" ";" "" "," "" "{" "" "}" "" "\\" ""} $x] if {$y == ""} {set y "empty"} concat $y } #enquote a string for preferences (command strings etc.) proc pdtk_encodedialog {x} { concat +[string map {" " "+_" "$" "+d" ";" "+s" "," "+c" "+" "++"} $x] } proc pdtk_debug {x} { tk_messageBox -message $x -type ok } proc pdtk_watchdog {} { pd [concat pd watchdog \;] after 2000 {pdtk_watchdog} } proc pdtk_ping {} { pd [concat pd ping \;] } ##### routine to ask user if OK and, if so, send a message on to Pd ###### proc pdtk_check {x message default} { set answer [tk_messageBox \-message $x \-type yesno -default $default \ -icon question] if {! [string compare $answer yes]} {pd $message} } set menu_windowlist {} proc pdtk_fixwindowmenu {} { global menu_windowlist .mbar.windows delete 0 end foreach i $menu_windowlist { .mbar.windows add command -label [lindex $i 0] \ -command [concat menu_domenuwindow [lindex $i 1]] menu_fixwindowmenu [lindex $i 1] } } ####### Odd little function to make better Mac accelerators ##### proc accel_munge {acc} { global pd_nt if {$pd_nt == 2} { if [string is upper [string index $acc end]] { return [format "%s%s" "Shift+" \ [string toupper [string map {Ctrl Meta} $acc] end]] } else { return [string toupper [string map {Ctrl Meta} $acc] end] } } else { return $acc } } ############### the "New" menu command ######################## proc menu_new {} { global untitled_number global untitled_directory pd [concat pd filename Untitled-$untitled_number $untitled_directory \;] pd { #N canvas; #X pop 1; } set untitled_number [expr $untitled_number + 1] } ################## the "Open" menu command ######################### 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} } 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] ;" } } catch { package require tkdnd dnd bindtarget . text/uri-list { foreach file %D {open_file $file} } } ################## the "Message" menu command ######################### proc menu_send {} { toplevel .sendpanel entry .sendpanel.entry -textvariable send_textvariable pack .sendpanel.entry -side bottom -fill both -ipadx 100 .sendpanel.entry select from 0 .sendpanel.entry select adjust end bind .sendpanel.entry { pd [concat $send_textvariable \;] } pdtk_standardkeybindings .sendpanel.entry focus .sendpanel.entry } ################## the "Quit" menu command ######################### proc menu_really_quit {} {pd {pd quit;}} proc menu_quit {} {pd {pd verifyquit;}} ######### the "Pd" menu command, which puts the Pd window on top ######## proc menu_pop_pd {} {raise .} ######### the "audio" menu command ############### proc menu_audio {flag} {pd [concat pd dsp $flag \;]} ######### the "documentation" menu command ############### set doc_number 1 # open text docs in a Pd window proc menu_opentext {filename} { global doc_number global pd_guidir global pd_myversion set name [format ".help%d" $doc_number] toplevel $name text $name.text -relief raised -bd 2 -font -*-times-regular--normal--14-* \ -yscrollcommand "$name.scroll set" -background white scrollbar $name.scroll -command "$name.text yview" pack $name.scroll -side right -fill y pack $name.text -side left -fill both -expand 1 set f [open $filename] while {![eof $f]} { set bigstring [read $f 1000] regsub -all PD_BASEDIR $bigstring $pd_guidir bigstring2 regsub -all PD_VERSION $bigstring2 $pd_myversion bigstring3 $name.text insert end $bigstring3 } close $f 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 " \ $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] & } } proc menu_doc_open {subdir basename} { global pd_guidir set dirname $pd_guidir/$subdir 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] \;] } } ################## help browser and support functions ######################### proc menu_doc_browser {dir} { global .mbar if {![file isdirectory $dir]} { puts stderr "menu_doc_browser non-directory $dir\n" } if { [winfo exists .help_browser.frame] } { raise .help_browser } else { toplevel .help_browser -menu .mbar wm title .help_browser "Pd Documentation Browser" frame .help_browser.frame pack .help_browser.frame -side top -fill both doc_make_listbox .help_browser.frame $dir 0 } } proc doc_make_listbox {base dir count} { # check for [file readable]? #if { [info tclversion] >= 8.5 } { # requires Tcl 8.5 but probably deals with special chars better # destroy {expand}[lrange [winfo children $base] [expr {2 * $count}] end] #} else { if { [catch { eval destroy [lrange [winfo children $base] \ [expr { 2 * $count }] end] } \ errorMessage] } { puts stderr "doc_make_listbox: error listing $dir\n" } #} # exportselection 0 looks good, but selection gets easily out-of-sync set current_listbox [listbox "[set b "$base.listbox$count"]-list" -yscrollcommand \ [list "$b-scroll" set] -height 20 -exportselection 0] pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \ -side left -expand 1 -fill y -anchor w foreach item [concat [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] \ [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- *]]] { $current_listbox insert end "[file tail $item][expr {[file isdirectory $item] ? {/} : {}}]" } bind $current_listbox [list doc_navigate $dir $count %W %x %y] bind $current_listbox [list doc_double_button $dir $count %W %x %y] } proc doc_navigate {dir count width x y} { if {[set newdir [$width get [$width index "@$x,$y"]]] eq {}} { return } set dir_to_open [file join $dir $newdir] if {[file isdirectory $dir_to_open]} { doc_make_listbox [winfo parent $width] $dir_to_open [incr count] } } proc doc_double_button {dir count width x y} { global pd_guidir if {[set newdir [$width get [$width index "@$x,$y"]]] eq {}} { return } set dir_to_open [file join $dir $newdir] if {[file isdirectory $dir_to_open]} { doc_navigate $dir $count $width $x $y } else { regsub -- $pd_guidir [file dirname $dir_to_open] "" subdir set file [file tail $dir_to_open] if { [catch {menu_doc_open $subdir $file} fid] } { puts stderr "Could not open $pd_guidir/$subdir/$file\n" } return; } } ############# routine to add media, help, and apple menu items ############### proc menu_addstd {mbar} { global pd_apilist pd_midiapilist pd_nt pd_tearoff # the "Audio" menu $mbar.audio add command -label {audio ON} -accelerator [accel_munge "Ctrl+/"] \ -command {menu_audio 1} $mbar.audio add command -label {audio OFF} -accelerator [accel_munge "Ctrl+."] \ -command {menu_audio 0} for {set x 0} {$x<[llength $pd_apilist]} {incr x} { $mbar.audio add radiobutton -label [lindex [lindex $pd_apilist $x] 0] \ -command {menu_audio 0} -variable pd_whichapi \ -value [lindex [lindex $pd_apilist $x] 1]\ -command {pd [concat pd audio-setapi $pd_whichapi \;]} } for {set x 0} {$x<[llength $pd_midiapilist]} {incr x} { $mbar.audio add radiobutton -label [lindex [lindex $pd_midiapilist $x] 0] \ -command {menu_midi 0} -variable pd_whichmidiapi \ -value [lindex [lindex $pd_midiapilist $x] 1]\ -command {pd [concat pd midi-setapi $pd_whichmidiapi \;]} } 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. # 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} { $mbar.help add command -label {About Pd} \ -command {menu_doc_open doc/1.manual 1.introduction.txt} } $mbar.help add command -label {Html ...} \ -command {menu_doc_open doc/1.manual index.htm} $mbar.help add command -label {Browser ...} \ -command {menu_doc_browser $help_top_directory} } #################### the "File" menu for the Pd window ############## .mbar.file add command -label New -command {menu_new} \ -accelerator [accel_munge "Ctrl+n"] .mbar.file add command -label Open -command {menu_open} \ -accelerator [accel_munge "Ctrl+o"] .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 {Find last error} -command {menu_finderror} ########### functions for menu functions on document windows ######## proc menu_save {name} { pdtk_canvas_checkgeometry $name pd [concat $name menusave \;] } proc menu_saveas {name} { pdtk_canvas_checkgeometry $name pd [concat $name menusaveas \;] } proc menu_print {name} { set filename [tk_getSaveFile -initialfile pd.ps \ -defaultextension .ps \ -filetypes { {{postscript} {.ps}} }] if {$filename != ""} { $name.c postscript -file $filename } } proc menu_close {name} { pdtk_canvas_checkgeometry $name pd [concat $name menuclose 0 \;] } proc menu_really_close {name} { pdtk_canvas_checkgeometry $name pd [concat $name menuclose 1 \;] } proc menu_undo {name} { global pd_undoaction global pd_redoaction global pd_undocanvas if {$name == $pd_undocanvas && $pd_undoaction != "no"} { pd [concat $name undo \;] } } proc menu_redo {name} { global pd_undoaction global pd_redoaction global pd_undocanvas if {$name == $pd_undocanvas && $pd_redoaction != "no"} { pd [concat $name redo \;] } } proc menu_cut {name} { pd [concat $name cut \;] } proc menu_copy {name} { pd [concat $name copy \;] } proc menu_paste {name} { pd [concat $name paste \;] } proc menu_duplicate {name} { pd [concat $name duplicate \;] } proc menu_selectall {name} { pd [concat $name selectall \;] } proc menu_texteditor {name} { pd [concat $name texteditor \;] } proc menu_font {name} { pd [concat $name menufont \;] } proc menu_tidyup {name} { pd [concat $name tidy \;] } proc menu_editmode {name} { pd [concat $name editmode 0 \;] } proc menu_object {name accel} { pd [concat $name obj $accel \;] } proc menu_message {name accel} { pd [concat $name msg $accel \;] } proc menu_floatatom {name accel} { pd [concat $name floatatom $accel \;] } proc menu_symbolatom {name accel} { pd [concat $name symbolatom $accel \;] } proc menu_comment {name accel} { pd [concat $name text $accel \;] } proc menu_graph {name} { pd [concat $name graph \;] } proc menu_array {name} { pd [concat $name menuarray \;] } ############iemlib################## proc menu_bng {name accel} { pd [concat $name bng $accel \;] } proc menu_toggle {name accel} { pd [concat $name toggle $accel \;] } proc menu_numbox {name accel} { pd [concat $name numbox $accel \;] } proc menu_vslider {name accel} { pd [concat $name vslider $accel \;] } proc menu_hslider {name accel} { pd [concat $name hslider $accel \;] } proc menu_hradio {name accel} { pd [concat $name hradio $accel \;] } proc menu_vradio {name accel} { pd [concat $name vradio $accel \;] } proc menu_vumeter {name accel} { pd [concat $name vumeter $accel \;] } proc menu_mycnv {name accel} { pd [concat $name mycnv $accel \;] } ############iemlib################## # correct edit menu, enabling or disabling undo/redo # LATER also cut/copy/paste proc menu_fixeditmenu {name} { global pd_undoaction global pd_redoaction global pd_undocanvas # puts stderr [concat menu_fixeditmenu $name $pd_undocanvas $pd_undoaction] if {$name == $pd_undocanvas && $pd_undoaction != "no"} { $name.m.edit entryconfigure "Undo*" -state normal \ -label [concat "Undo " $pd_undoaction] } else { $name.m.edit entryconfigure "Undo*" -state disabled -label "Undo" } if {$name == $pd_undocanvas && $pd_redoaction != "no"} { $name.m.edit entryconfigure "Redo*" -state normal\ -label [concat "Redo " $pd_redoaction] } else { $name.m.edit entryconfigure "Redo*" -state disabled } } # message from Pd to update the currently available undo/redo action proc pdtk_undomenu {name undoaction redoaction} { global pd_undoaction global pd_redoaction global pd_undocanvas # puts stderr [concat pdtk_undomenu $name $undoaction $redoaction] set pd_undocanvas $name set pd_undoaction $undoaction set pd_redoaction $redoaction if {$name != "nobody"} { # unpleasant way of avoiding a more unpleasant bug situation --atl 2002.11.25 menu_fixeditmenu $name } } proc menu_windowparent {name} { pd [concat $name findparent \;] } proc menu_findagain {name} { pd [concat $name findagain \;] } proc menu_finderror {} { pd [concat pd finderror \;] } proc menu_domenuwindow {i} { raise $i } proc menu_fixwindowmenu {name} { global menu_windowlist global pd_tearoff $name.m.windows add command if $pd_tearoff { $name.m.windows delete 4 end } else { $name.m.windows delete 3 end } foreach i $menu_windowlist { $name.m.windows add command -label [lindex $i 0] \ -command [concat menu_domenuwindow [lindex $i 1]] } } ################## the "find" menu item ################### set find_canvas nobody set find_string "" set find_count 1 proc find_apply {name} { global find_string global find_canvas regsub -all \; $find_string " _semi_ " find_string2 regsub -all \, $find_string2 " _comma_ " find_string3 # puts stderr [concat $find_canvas find $find_string3 \ # \;] pd [concat $find_canvas find $find_string3 \ \;] after 50 destroy $name } proc find_cancel {name} { after 50 destroy $name } proc menu_findobject {canvas} { global find_string global find_canvas global find_count set name [format ".find%d" $find_count] set find_count [expr $find_count + 1] set find_canvas $canvas toplevel $name label $name.label -text {find...} pack $name.label -side top entry $name.entry -textvariable find_string pack $name.entry -side top frame $name.buttonframe pack $name.buttonframe -side bottom -fill x -pady 2m button $name.buttonframe.cancel -text {Cancel}\ -command "find_cancel $name" button $name.buttonframe.ok -text {OK}\ -command "find_apply $name" pack $name.buttonframe.cancel -side left -expand 1 pack $name.buttonframe.ok -side left -expand 1 $name.entry select from 0 $name.entry select adjust end bind $name.entry [ concat find_apply $name] pdtk_standardkeybindings $name.entry focus $name.entry } ############# pdtk_canvas_new -- create a new canvas ############### proc pdtk_canvas_new {name width height geometry editable} { global pd_opendir global pd_tearoff global pd_nt global tcl_version toplevel $name -menu $name.m # slide offscreen windows into view if {$tcl_version >= 8.4} { 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" \ -scrollregion [concat 0 0 $width $height] scrollbar $name.scrollvert -command "$name.c yview" scrollbar $name.scrollhort -command "$name.c xview" \ -orient horizontal pack $name.scrollhort -side bottom -fill x pack $name.scrollvert -side right -fill y pack $name.c -side left -expand 1 -fill both wm minsize $name 1 1 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 $name.m.file add command -label New -command {menu_new} \ -accelerator [accel_munge "Ctrl+n"] $name.m.file add command -label Open -command {menu_open} \ -accelerator [accel_munge "Ctrl+o"] $name.m.file add separator $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 \ -command [concat menu_close $name] \ -accelerator [accel_munge "Ctrl+w"] $name.m.file add command -label Save -command [concat menu_save $name] \ -accelerator [accel_munge "Ctrl+s"] $name.m.file add command -label "Save as..." \ -command [concat menu_saveas $name] \ -accelerator [accel_munge "Ctrl+S"] $name.m.file add command -label Print -command [concat menu_print $name] \ -accelerator [accel_munge "Ctrl+p"] $name.m.file add separator $name.m.file add command -label Quit -command {menu_quit} \ -accelerator [accel_munge "Ctrl+q"] # the edit menu menu $name.m.edit -postcommand [concat menu_fixeditmenu $name] -tearoff $pd_tearoff $name.m add cascade -label Edit -menu $name.m.edit $name.m.edit add command -label Undo -command [concat menu_undo $name] \ -accelerator [accel_munge "Ctrl+z"] $name.m.edit add command -label Redo -command [concat menu_redo $name] \ -accelerator [accel_munge "Ctrl+Z"] $name.m.edit add separator $name.m.edit add command -label Cut -command [concat menu_cut $name] \ -accelerator [accel_munge "Ctrl+x"] $name.m.edit add command -label Copy -command [concat menu_copy $name] \ -accelerator [accel_munge "Ctrl+c"] $name.m.edit add command -label Paste \ -command [concat menu_paste $name] \ -accelerator [accel_munge "Ctrl+v"] $name.m.edit add command -label Duplicate \ -command [concat menu_duplicate $name] \ -accelerator [accel_munge "Ctrl+d"] $name.m.edit add command -label {Select all} \ -command [concat menu_selectall $name] \ -accelerator [accel_munge "Ctrl+a"] $name.m.edit add separator $name.m.edit add command -label {Text Editor} \ -command [concat menu_texteditor $name] \ -accelerator [accel_munge "Ctrl+t"] $name.m.edit add command -label Font \ -command [concat menu_font $name] $name.m.edit add command -label {Tidy Up} \ -command [concat menu_tidyup $name] $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. $name.m.edit add checkbutton -label "Edit mode" \ -indicatoron true -selectcolor grey85 \ -command [concat menu_editmode $name] \ -accelerator [accel_munge "Ctrl+e"] 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); # 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 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