set pd_nt 0 # (The above is 0 for unix, 1 for microsoft, and 2 for Mac OSX. The first # line is automatically munged by the relevant makefiles.) # 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" # # there are 2 new features: 1.) line-delete-protection in edit-menue # # 2.) there are all iem-guis in a seperated put-gui-menue # # all this changes are labeled with #######iemlib########## if {$pd_nt == 1} { global pd_guidir 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 } if {$pd_nt == 2} { global pd_guidir set pd_gui2 [string range $argv0 0 [expr [string last / $argv0 ] - 1]] set pd_guidir $pd_gui2/.. load $pd_guidir/bin/pdtcl } # 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 ######################### frame .mbar -relief raised -bd 2 canvas .dummy -height 1c -width 1c frame .controls pack .mbar .controls .dummy -side top -fill x menubutton .mbar.file -text File -menu .mbar.file.menu menubutton .mbar.find -text Find -menu .mbar.find.menu menubutton .mbar.windows -text Windows -menu .mbar.windows.menu menubutton .mbar.audio -text Audio -menu .mbar.audio.menu menubutton .mbar.help -text Help -menu .mbar.help.menu pack .mbar.file .mbar.find .mbar.windows .mbar.audio -side left pack .mbar.help -side right menu .mbar.file.menu menu .mbar.find.menu menu .mbar.windows.menu -postcommand [concat pdtk_fixwindowmenu] menu .mbar.audio.menu menu .mbar.help.menu 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.meterbutton .controls.switches.audiobutton -side left frame .controls.in label .controls.in.label -text IN entry .controls.in.level -textvariable ctrls_inlevel -width 3 button .controls.in.clip -text {CLIP} -state disabled pack .controls.in.label .controls.in.level .controls.in.clip -side top frame .controls.out label .controls.out.label -text OUT entry .controls.out.level -textvariable ctrls_outlevel -width 3 button .controls.out.clip -text {CLIP} -state disabled pack .controls.out.label .controls.out.level .controls.out.clip -side top button .controls.dio -text "DIO\nerrors" \ -command {pd [concat pd audiostatus \;]} pack .controls.switches -side bottom pack .controls.in .controls.out -side left pack .controls.dio -side right bind . {pdtk_pd_ctrlkey %W %K 0} bind . {pdtk_pd_ctrlkey %W %K 1} ############### set up global variables ################################ set untitled_number 1 set untitled_directory [pwd] set saveas_client doggy set pd_opendir $untitled_directory ############iemlib################## # need it to know, if new or open file set iem_new_open_flag "open" ############iemlib################## ################ utility functions ######################### proc pdtk_enquote {x} { set foo [string map {"," "" ";" "" \" ""} $x] set foo2 [string map {" " "\\ "} $foo] concat $foo2 } proc pdtk_debug {x} { tk_messageBox -message $x -type ok } proc pdtk_watchdog {} { pd [concat pd ping \;] after 2000 {pdtk_watchdog} } proc pdtk_check {x message} { set answer [tk_messageBox \-message $x \-type yesno \-icon question] switch $answer { yes {pd $message} } # no {tk_messageBox \-message "cancelled" \-type ok} } set menu_windowlist {} proc pdtk_fixwindowmenu {} { global menu_windowlist .mbar.windows.menu delete 0 end foreach i $menu_windowlist { .mbar.windows.menu add command -label [lindex $i 0] \ -command [concat menu_domenuwindow [lindex $i 1]] } } ############### the "New" menu command ######################## proc menu_new {} { global untitled_number global untitled_directory ############iemlib################## global iem_new_open_flag set iem_new_open_flag "new" ############iemlib################## 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 global pd_nt ############iemlib################## global iem_new_open_flag set iem_new_open_flag "open" ############iemlib################## # workaround -- initialdir doesn't work on MACOSX yet --- if {$pd_nt == 2} { cd $pd_opendir set filename [tk_getOpenFile -defaultextension .pd \ -filetypes { {{pd files} {.pd}} {{max files} {.pat}}} ] } else { set filename [tk_getOpenFile -defaultextension .pd \ -filetypes { {{pd files} {.pd}} {{max files} {.pat}}} \ -initialdir $pd_opendir] } # puts stderr $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] pd [concat pd open [pdtk_enquote $basename] \ [pdtk_enquote $directory]\;] } } ################## 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 \;] after 50 {destroy .sendpanel} } focus .sendpanel.entry } ################## the "Quit" menu command ######################### proc menu_really_quit {} {pd {pd quit;}} proc menu_quit {} {pdtk_check {Really quit?} {pd quit;}} ######### 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 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 -*-courier-bold--normal--12-* \ -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] } set help_directory $pd_guidir/doc proc menu_documentation {} { global help_directory global pd_nt ############iemlib################## global iem_new_open_flag set iem_new_open_flag "open" ############iemlib################## if {$pd_nt == 2} { cd $help_directory set filename [tk_getOpenFile -defaultextension .pd \ -filetypes { {{documentation} {.pd .txt .htm}} } ] } else { set filename [tk_getOpenFile -defaultextension .pd \ -filetypes { {{documentation} {.pd .txt .htm}} } \ -initialdir $help_directory] } if {$filename != ""} { if {[string first .txt $filename] >= 0} { menu_opentext $filename } elseif {[string first .htm $filename] >= 0} { if {$pd_nt == 0} { #I wish I could get this to run in the background; the "&" doesn't do it: exec sh -c \ [format "mozilla file:%s || netscape file:%s &\n" \ $filename $filename] } else { tk_messageBox -message \ {sorry -- can't open htm files yet; open this manually} \ -type ok } } else { set help_directory [string range $filename 0 \ [expr [string last / $filename ] - 1]] set basename [string range $filename \ [expr [string last / $filename ] + 1] end] pd [concat pd open [pdtk_enquote $basename] \ [pdtk_enquote $help_directory] \;] } } } proc menu_doc_open {subdir basename} { global pd_guidir ############iemlib################## global iem_new_open_flag set iem_new_open_flag "open" ############iemlib################## set dirname $pd_guidir/$subdir if {[string first .txt $basename] >= 0} { menu_opentext $dirname/$basename } else { pd [concat pd open [pdtk_enquote $basename] \ [pdtk_enquote $dirname] \;] } } #################### the "File" menu for the Pd window ############## .mbar.file.menu add command -label New -command {menu_new} \ -accelerator "Ctrl+n" .mbar.file.menu add command -label Open -command {menu_open} \ -accelerator "Ctrl+o" .mbar.file.menu add command -label Message -command {menu_send} \ -accelerator "Ctrl+m" .mbar.file.menu add separator .mbar.file.menu add command -label Quit -command {menu_quit} \ -accelerator "Ctrl+q" #################### the "Find" menu for the Pd window ############## .mbar.find.menu add command -label {last error?} -command {menu_finderror} #################### the "Audio" menu for the Pd window ############## .mbar.audio.menu add command -label On -accelerator "Ctrl+/" \ -command {menu_audio 1} .mbar.audio.menu add command -label Off -accelerator "Ctrl+." \ -command {menu_audio 0} #################### the "Help" menu for the Pd window ############## .mbar.help.menu add command -label {About Pd} \ -command {menu_doc_open doc/1.manual 1.introduction.txt} .mbar.help.menu add command -label {Test Audio and MIDI} \ -command {menu_doc_open doc/7.stuff/tools testtone.pd} .mbar.help.menu add command -label {Load Meter} \ -command {menu_doc_open doc/7.stuff/tools load-meter.pd} .mbar.help.menu add command -label {Pure Documentation...} \ -command {menu_documentation} ########### 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} { $name.c postscript -file x.ps } proc menu_close {name} { pd [concat $name menuclose \;] } 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_hdial {name accel} { pd [concat $name hdial $accel \;] } proc menu_vdial {name accel} { pd [concat $name vdial $accel \;] } proc menu_vumeter {name accel} { pd [concat $name vumeter $accel \;] } proc menu_mycnv {name accel} { pd [concat $name mycnv $accel \;] } proc menu_protectmode {name} { pd [concat $name protectmode 0 \;] } ############iemlib################## 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 $name.m.windows.m add command $name.m.windows.m delete 4 end foreach i $menu_windowlist { $name.m.windows.m 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] focus $name.entry } ############# pdtk_canvas_new -- create a new canvas ############### proc pdtk_canvas_new {name width height geometry} { global pd_opendir global iem_new_open_flag toplevel $name frame $name.m -relief raised -bd 2 # puts stderr [concat geometry: $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.m -side top -fill x 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 menubutton $name.m.file -text File -menu $name.m.file.m pack $name.m.file -side left menu $name.m.file.m $name.m.file.m add command -label New -command {menu_new} \ -accelerator "Ctrl+n" $name.m.file.m add command -label Open -command {menu_open} \ -accelerator "Ctrl+o" $name.m.file.m add command -label Message -command {menu_send} \ -accelerator "Ctrl+m" $name.m.file.m add separator $name.m.file.m add command -label Save -command [concat menu_save $name] \ -accelerator "Ctrl+s" $name.m.file.m add command -label Close \ -command [concat menu_close $name] \ -accelerator "Ctrl+w" $name.m.file.m add command -label "Save as..." \ -command [concat menu_saveas $name] \ -accelerator "Ctrl+S" $name.m.file.m add command -label Print -command [concat menu_print $name] \ -accelerator "Ctrl+p" $name.m.file.m add separator $name.m.file.m add command -label Quit -command {menu_quit} \ -accelerator "Ctrl+q" # the edit menu menubutton $name.m.edit -text Edit -menu $name.m.edit.m pack $name.m.edit -side left menu $name.m.edit.m $name.m.edit.m add command -label Cut -command [concat menu_cut $name] \ -accelerator "Ctrl+x" $name.m.edit.m add command -label Copy -command [concat menu_copy $name] \ -accelerator "Ctrl+c" $name.m.edit.m add command -label Paste \ -command [concat menu_paste $name] \ -accelerator "Ctrl+v" $name.m.edit.m add command -label Duplicate \ -command [concat menu_duplicate $name] \ -accelerator "Ctrl+d" $name.m.edit.m add command -label {Select all} \ -command [concat menu_selectall $name] \ -accelerator "Ctrl+a" $name.m.edit.m add command -label {Text Editor} \ -command [concat menu_texteditor $name] \ -accelerator "Ctrl+t" $name.m.edit.m add command -label Font \ -command [concat menu_font $name] $name.m.edit.m add command -label {Tidy Up} \ -command [concat menu_tidyup $name] $name.m.edit.m add separator ############iemlib################## # instead of "red = #BC3C60" we take "grey85", so there is no difference, # if widget is selected or not. $name.m.edit.m add checkbutton -label "Edit mode" \ -indicatoron true -selectcolor grey85 \ -command [concat menu_editmode $name] \ -accelerator "Ctrl+e" $name.m.edit.m add checkbutton -label "Protect" \ -indicatoron true -selectcolor grey85 \ -command [concat menu_protectmode $name] \ -accelerator "Ctrl+r" if { $iem_new_open_flag == "open" } { $name.m.edit.m entryconfigure "Edit mode" -indicatoron false } $name.m.edit.m entryconfigure "Protect" -indicatoron false ############iemlib################## # the put menu menubutton $name.m.put -text Put -menu $name.m.put.m pack $name.m.put -side left menu $name.m.put.m $name.m.put.m add command -label Object \ -command [concat menu_object $name 0] \ -accelerator "Ctrl+1" $name.m.put.m add command -label Message \ -command [concat menu_message $name 0] \ -accelerator "Ctrl+2" $name.m.put.m add command -label Number \ -command [concat menu_floatatom $name 0] \ -accelerator "Ctrl+3" $name.m.put.m add command -label Symbol \ -command [concat menu_symbolatom $name 0] \ -accelerator "Ctrl+4" $name.m.put.m add command -label Comment \ -command [concat menu_comment $name 0] \ -accelerator "Ctrl+5" ############iemlib################## $name.m.put.m add command -label Bang \ -command [concat menu_bng $name 0] \ -accelerator "Alt+b" $name.m.put.m add command -label Toggle \ -command [concat menu_toggle $name 0] \ -accelerator "Alt+t" $name.m.put.m add command -label Number2 \ -command [concat menu_numbox $name 0] \ -accelerator "Alt+n" $name.m.put.m add command -label Vslider \ -command [concat menu_vslider $name 0] \ -accelerator "Alt+v" $name.m.put.m add command -label Hslider \ -command [concat menu_hslider $name 0] \ -accelerator "Alt+h" $name.m.put.m add command -label Vdial \ -command [concat menu_vdial $name 0] \ -accelerator "Alt+d" $name.m.put.m add command -label Hdial \ -command [concat menu_hdial $name 0] \ -accelerator "Alt+i" $name.m.put.m add command -label VU \ -command [concat menu_vumeter $name 0] \ -accelerator "Alt+u" $name.m.put.m add command -label Canvas \ -command [concat menu_mycnv $name 0] \ -accelerator "Alt+c" ############iemlib################## $name.m.put.m add command -label Graph \ -command [concat menu_graph $name] $name.m.put.m add command -label Array \ -command [concat menu_array $name] # the find menu menubutton $name.m.find -text Find -menu $name.m.find.m pack $name.m.find -side left menu $name.m.find.m $name.m.find.m add command -label {Find...} -accelerator "Ctrl+f" \ -command [concat menu_findobject $name] $name.m.find.m add command -label {Find Again} -accelerator "Ctrl+g" \ -command [concat menu_findagain $name] $name.m.find.m add command -label {Find last error} \ -command [concat menu_finderror] # the window menu menubutton $name.m.windows -text Windows -menu $name.m.windows.m pack $name.m.windows -side left menu $name.m.windows.m -postcommand [concat menu_fixwindowmenu $name] $name.m.windows.m add command -label {parent window}\ -command [concat menu_windowparent $name] $name.m.windows.m add command -label {Pd window} -command menu_pop_pd $name.m.windows.m add separator # the audio menu menubutton $name.m.audio -text Audio -menu $name.m.audio.m pack $name.m.audio -side left menu $name.m.audio.m $name.m.audio.m add command -label On -accelerator "Ctrl+/" \ -command {menu_audio 1} $name.m.audio.m add command -label Off -accelerator "Ctrl+." \ -command {menu_audio 0} # the help menu menubutton $name.m.help -text Help -menu $name.m.help.m pack $name.m.help -side right menu $name.m.help.m $name.m.help.m add command -label {Getting Started} \ -command {menu_doc_open doc/1.manual 1.introduction.txt} $name.m.help.m add command -label {Test Audio and MIDI} \ -command {menu_doc_open doc/7.stuff/tools testtone.pd} $name.m.help.m add command -label {Load Meter} \ -command {menu_doc_open doc/7.stuff/tools load-meter.pd} $name.m.help.m add command -label {Pure Documentation} \ -command {menu_documentation} # 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