Pd-cvs December 2008

pd-cvs@lists.iem.at

20 participants
129 discussions

SF.net SVN: pure-data:[10460] branches/pd-devel/0.41.4/src/pd.tk
by eighthave＠users.sourceforge.net 25 Dec '08

25 Dec '08

Revision: 10460 http://pure-data.svn.sourceforge.net/pure-data/?rev=10460&view=rev Author: eighthave Date: 2008-12-25 00:06:06 +0000 (Thu, 25 Dec 2008) Log Message: ----------- - tried making one single menubar that is modified whenever the focus changes, but I wonder if this makes sense since it might create more work to be done on every focus shift - finished File and Put menus Modified Paths: -------------- branches/pd-devel/0.41.4/src/pd.tk Modified: branches/pd-devel/0.41.4/src/pd.tk =================================================================== --- branches/pd-devel/0.41.4/src/pd.tk 2008-12-24 14:50:28 UTC (rev 10459) +++ branches/pd-devel/0.41.4/src/pd.tk 2008-12-25 00:06:06 UTC (rev 10460) @@ -6,89 +6,271 @@ ## replace Tk widgets with Ttk widgets on 8.5 #namespace import -force ttk::* + +# TODO switch back to creating a menubar for each window +# TODO figure out Edit Mode Checkbox menu item on Aqua +# TODO figure out Undo/Redo/Cut/Copy/Paste state changes for menus +# TODO figure out parent window/window list for Window menu + # ------------------------------------------------------------------------------ -# init functions +# global variables -proc init_x11 {} { +# for displaying on menus +set accelerator "Ctrl" +# for key bindings +set modifier "Control" + +# ------------------------------------------------------------------------------ +# PLACEHOLDERS + +proc pd {} { } -proc init_aqua {} { +proc menu_doc_open {docdir doc} { +# PLACEHOLDER } -proc init_win32 {} { - font create menufont -family Tahoma -size -11 +proc menu_helpbrowser {dir} { +# PLACEHOLDER } +proc menu_new {} { +# PLACEHOLDER + pdtk_canvas_new [format .flarg%d [expr round(rand()*1000)]] 30 10 +} + +proc menu_quit {} { +# PLACEHOLDER + exit +} + + +# ------------------------------------------------------------------------------ +# init functions + proc init {} { - if { [tk windowingsystem] eq "x11" } { - } elseif { [tk windowingsystem] eq "aqua" } { - } elseif { [tk windowingsystem] eq "win32" } { + switch -- [tk windowingsystem] { + "x11" { + } + "aqua" { + global accelerator modifier + set accelerator "Meta" + set modifier "Mod1" + } + "win32" { + font create menufont -family Tahoma -size -11 + } } } # ------------------------------------------------------------------------------ # Mac OS X specific functions +proc menu_bringalltofront {} { + #use [winfo children .] here to get windows that are minimized + foreach item [winfo children .] { + #get all toplevel windows, exclude menubar windows + if { [string equal [winfo toplevel $item] $item] && [catch {$item cget -tearoff}]} { + wm deiconify $item + } + } + #be sure to deiconify ., since the above command only gets the child toplevels + wm deiconify . +} + + # ------------------------------------------------------------------------------ # functions called from menu items -proc accel_munge {thingy} { + +proc menu_minimize {} { + set windowlist [wm stackorder .] + if {$windowlist != {}} { + set topwindow [lindex $windowlist end] + wm iconify $topwindow + } } -proc menu_doc_open {docdir doc} { +proc menu_maximize {window} { + wm state $window zoomed } -proc menu_doc_browser {dir} { +# ------------------------------------------------------------------------------ +# menu building functions for Mac OS X/aqua + +proc menu_create_file_aqua {rootmenu} { + global accelerator + $rootmenu add command -label "New" -accelerator "$accelerator+N" + $rootmenu add command -label "Open" -accelerator "$accelerator+O" + $rootmenu add cascade -label "Open Recent" + $rootmenu add separator + $rootmenu add command -label "Close" -accelerator "$accelerator+W" + $rootmenu add command -label "Save" -accelerator "$accelerator+S" + $rootmenu add command -label "Save As..." -accelerator "$accelerator+Shift+S" +# $rootmenu add command -label "Save All" + $rootmenu add command -label "Revert to Saved" + $rootmenu add separator + $rootmenu add command -label "Message" + $rootmenu add separator + $rootmenu add command -label "Print..." -accelerator "$accelerator+P" } +proc menu_create_edit_aqua {rootmenu} { +} + +# the "Put" and "Find" menus do not have cross-platform differences + +proc menu_create_media_aqua {rootmenu} { +} + +proc menu_create_window_aqua {rootmenu} { +} + +proc menu_create_help_aqua {rootmenu} { +} + # ------------------------------------------------------------------------------ -# menu building functions -proc menu_create_file {rootmenu} { -# $rootmenu add command -label New -command {menu_new} - $rootmenu add command -label New -command {pdtk_canvas_new .flarg 30 10} \ - -accelerator [accel_munge "Ctrl+n"] - $rootmenu add command -label Open -command {menu_open} \ - -accelerator [accel_munge "Ctrl+o"] +# menu building functions for UNIX/X11 + +proc menu_create_file_x11 {rootmenu} { + global accelerator + $rootmenu add command -label "New" -accelerator "$accelerator+N" + $rootmenu add command -label "Open" -accelerator "$accelerator+O" $rootmenu add separator - $rootmenu 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 {[tk windowingsystem] ne "aqua"} { - $rootmenu add command -label Path... \ - -command {pd pd start-path-dialog \;} - $rootmenu add command -label Startup... \ - -command {pd pd start-startup-dialog \;} - } + $rootmenu add command -label "Save" -accelerator "$accelerator+S" + $rootmenu add command -label "Save As..." -accelerator "Shift+$accelerator+S" + $rootmenu add command -label "Revert" $rootmenu add separator - $rootmenu add command -label Quit -command {menu_quit} \ - -accelerator [accel_munge "Ctrl+q"] + $rootmenu add command -label "Message" -accelerator "$accelerator+M" + $rootmenu add command -label "Print..." -accelerator "$accelerator+P" + $rootmenu add separator + $rootmenu add command -label "Close" -accelerator "$accelerator+W" + $rootmenu add command -label "Quit" -command {menu_quit} \ + -accelerator "$accelerator+Q" } -proc menu_create_edit {rootmenu} { +proc menu_create_edit_x11 {rootmenu} { } -proc menu_create_put {rootmenu} { +# the "Put" and "Find" menus do not have cross-platform differences + +proc menu_create_media_x11 {rootmenu} { } -proc menu_create_media {rootmenu} { +proc menu_create_window_x11 {rootmenu} { } -proc menu_create_window {rootmenu} { +proc menu_create_help_x11 {rootmenu} { } -proc menu_create_help {rootmenu} { +# ------------------------------------------------------------------------------ +# menu building functions for Windows/Win32 + +proc menu_create_file_win32 {rootmenu} { + global accelerator + $rootmenu add command -label "New" -accelerator "$accelerator+N" + $rootmenu add command -label "Open" -accelerator "$accelerator+O" + $rootmenu add separator + $rootmenu add command -label "Save" -accelerator "$accelerator+S" + $rootmenu add command -label "Save As..." -accelerator "Shift+$accelerator+S" + $rootmenu add command -label "Revert" + $rootmenu add separator + $rootmenu add command -label "Message" -accelerator "$accelerator+M" + $rootmenu add command -label "Print..." -accelerator "$accelerator+P" + $rootmenu add separator + $rootmenu add command -label "Close" -accelerator "$accelerator+W" + $rootmenu add command -label "Quit" -command {menu_quit} \ + -accelerator "$accelerator+Q" +} + +proc menu_create_edit_win32 {rootmenu} { +} + +# the "Put" and "Find" menus do not have cross-platform differences + +proc menu_create_media_win32 {rootmenu} { +} + +proc menu_create_window_win32 {rootmenu} { +} + +proc menu_create_help_win32 {rootmenu} { +} + + +# ------------------------------------------------------------------------------ +# menu building functions +proc menu_create_file {rootmenu name} { + [format menu_create_file_%s [tk windowingsystem]] $rootmenu + $rootmenu entryconfigure "New" -command {menu_new} + $rootmenu entryconfigure "Open" -command {menu_open} + $rootmenu entryconfigure "Save" -command {menu_save $name} + $rootmenu entryconfigure "Save As..." -command {menu_saveas $name} + $rootmenu entryconfigure "Revert*" -command {menu_revert $name} + $rootmenu entryconfigure "Close" -command {menu_close $name} + $rootmenu entryconfigure "Message" -command {menu_send} + $rootmenu entryconfigure "Print..." -command {menu_print $name} +} + +proc menu_create_edit {rootmenu name} { +# [format menu_create_edit_%s [tk windowingsystem]] $rootmenu +# $rootmenu entryconfigure "New" -command {menu_new} +} + +proc menu_create_put {rootmenu name} { + global accelerator + $rootmenu add command -label "Object" -accelerator "$accelerator+1" \ + -command {menu_object $name 0} + $rootmenu add command -label "Message" -accelerator "$accelerator+2" \ + -command {menu_message $name 0} + $rootmenu add command -label "Number" -accelerator "$accelerator+3" \ + -command {menu_floatatom $name 0} + $rootmenu add command -label "Symbol" -accelerator "$accelerator+4" \ + -command {menu_symbolatom $name 0} + $rootmenu add command -label "Comment" -accelerator "$accelerator+5" \ + -command {menu_comment $name 0} + $rootmenu add separator + $rootmenu add command -label "Bang" -accelerator "Shift+$accelerator+B" \ + -command {menu_bng $name 0} + $rootmenu add command -label "Toggle" -accelerator "Shift+$accelerator+T" \ + -command {menu_toggle $name 0} + $rootmenu add command -label "Number2" -accelerator "Shift+$accelerator+N" \ + -command {menu_numbox $name 0} + $rootmenu add command -label "Vslider" -accelerator "Shift+$accelerator+V" \ + -command {menu_vslider $name 0} + $rootmenu add command -label "Hslider" -accelerator "Shift+$accelerator+H" \ + -command {menu_hslider $name 0} + $rootmenu add command -label "Vradio" -accelerator "Shift+$accelerator+D" \ + -command {menu_vradio $name 0} + $rootmenu add command -label "Hradio" -accelerator "Shift+$accelerator+I" \ + -command {menu_hradio $name 0} + $rootmenu add command -label "VU" -accelerator "Shift+$accelerator+U" \ + -command {menu_vumeter $name 0} + $rootmenu add command -label "Canvas" -accelerator "Shift+$accelerator+C"\ + -command {menu_mycnv $name 0} + $rootmenu add separator + $rootmenu add command -label Graph -command {menu_graph $name} + $rootmenu add command -label Array -command {menu_array $name} +} + +proc menu_create_media {rootmenu name} { +} + +proc menu_create_window {rootmenu name} { +} + +proc menu_create_help {rootmenu name} { if {[tk windowingsystem] ne "aqua"} { $rootmenu add command -label {About Pd} \ -command {menu_doc_open doc/1.manual 1.introduction.txt} } - $rootmenu add command -label {Html ...} \ + $rootmenu add command -label {HTML ...} \ -command {menu_doc_open doc/1.manual index.htm} $rootmenu add command -label {Browser ...} \ - -command {menu_doc_browser $help_top_directory} + -command {menu_helpbrowser $help_top_directory} } -proc menu_create_apple {rootmenu} { +proc menu_create_apple {rootmenu name} { $rootmenu add command -label "About Pd..." -command \ {menu_doc_open doc/1.manual 1.introduction.txt} menu $rootmenu.preferences -tearoff 0 @@ -112,35 +294,66 @@ menu $rootmenu.$menuitem -tearoff 0 $rootmenu add cascade -label [string totitle $menuitem] \ -menu $rootmenu.$menuitem - [concat menu_create_$menuitem] $rootmenu.$menuitem + [format menu_create_%s $menuitem] $rootmenu.$menuitem PLACEHOLDER if {[tk windowingsystem] eq "win32"} { + # fix menu font size on Windows with tk scaling = 1 $rootmenu.$menuitem configure -font menufont } } } +proc menu_entryconfigure {menuname itemname} { + set itemindex [$menuname ] + $menuname entryconfigure +} +proc menu_configure {menubar window} { + puts "menu_configure $window" + set file_items_to_disable {"Save" "Save As..." "Revert" "Print..." "Close"} + if {$window eq "."} { + # these are meaningless for the Pd window, so disable them + foreach item $file_items_to_disable { + $menubar.file entryconfigure $item -state disabled + } + for {set i 0} {$i <= [$menubar.put index end]} {incr i} { + # catch errors by trying to disable separators + catch {$menubar.put entryconfigure $i -state disabled } + } + } else { + foreach item $file_items_to_disable { + $menubar.file entryconfigure $item -state normal + } + for {set i 0} {$i <= [$menubar.put index end]} {incr i} { + # catch errors by trying to disable separators + catch {$menubar.put entryconfigure $i -state normal } + } + # TODO re-enable menu items + # TODO configure "parent on Window menu + } +} + # ------------------------------------------------------------------------------ # canvas support functions proc pdtk_canvas_new {canvas_name width height} { - if {$width < 200} {set width 200} - if {$height < 50} {set height 50} - toplevel $canvas_name -menu $canvas_name.menubar -width $width -height $height - menu $canvas_name.menubar -tearoff 0 - menu_create $canvas_name.menubar + if {$width < 300} {set width 300} + if {$height < 150} {set height 150} + toplevel $canvas_name -menu .menubar -width $width -height $height + bind $canvas_name <FocusIn> {menu_configure .menubar %W} } # ------------------------------------------------------------------------------ # main proc main {} { + init -menu .menubar -menu_create .menubar - -wm title . "Pd-devel" -#wm protocol . WM_DELETE_WINDOW menu_quit -. configure -menu .menubar -width 400 -height 250 - + menu .menubar + menu_create .menubar + + wm title . "Pd-devel" + #wm protocol . WM_DELETE_WINDOW menu_quit + . configure -menu .menubar -width 400 -height 250 + menu_configure .menubar . + bind . <FocusIn> {menu_configure .menubar %W} } main This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

1 0

SF.net SVN: pure-data:[10459] trunk/abstractions/jmmmp/jmmmp-ext.txt
by jmmmp＠users.sourceforge.net 24 Dec '08

24 Dec '08

Revision: 10459 http://pure-data.svn.sourceforge.net/pure-data/?rev=10459&view=rev Author: jmmmp Date: 2008-12-24 14:50:28 +0000 (Wed, 24 Dec 2008) Log Message: ----------- Modified Paths: -------------- trunk/abstractions/jmmmp/jmmmp-ext.txt Modified: trunk/abstractions/jmmmp/jmmmp-ext.txt =================================================================== --- trunk/abstractions/jmmmp/jmmmp-ext.txt 2008-12-23 08:18:58 UTC (rev 10458) +++ trunk/abstractions/jmmmp/jmmmp-ext.txt 2008-12-24 14:50:28 UTC (rev 10459) @@ -12,13 +12,11 @@ datei-r - Sends the message "read ../../" datei-w - Sends the message "write ../../" dsp01 - DSP switch -farben30 - PD GUI color scheme -farben-data-s - Data structures' color scheme f+ - Counter with variable increment gui-edit - edit standard GUI objects fast lbang - loadbang which can be triggered more often liner~ - practical implementation of [line~] -liner~ - practical implementation of signal envelopping +liner+~ - practical implementation of signal envelopping mat~ - Level meter with amplitude control maat~ - Level meter with amplitude control, stereo met~ - Level meter with amplitude control (with VU, too CPU expensive for me) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

1 0

autobuild: pd-extended debian-stable-powerpc 2008-12-24 06.27.50
by pd＠debian-stable-powerpc.idmi.poly.edu 24 Dec '08

24 Dec '08

/bin/sh: -c: line 1: syntax error: unexpected end of file GEMglColor3ui.cpp:55: internal compiler error: Segmentation fault ERROR: module is write only rsync error: syntax or usage error (code 1) at main.c(641) [sender=2.6.9] rsync error: error in rsync protocol data stream (code 12) at io.c(453) [receiver=2.6.9] the full logfile - if it has been succesfully uploaded - can be viewed at: http://autobuild.puredata.info/auto-build/2008-12-24/logs/2008-12-24_06.27.…

1 0

SF.net SVN: pure-data:[10458] branches/pd-devel/0.41.4/src/pd.tk
by eighthave＠users.sourceforge.net 23 Dec '08

23 Dec '08

Revision: 10458 http://pure-data.svn.sourceforge.net/pure-data/?rev=10458&view=rev Author: eighthave Date: 2008-12-23 08:18:58 +0000 (Tue, 23 Dec 2008) Log Message: ----------- - replaced copy of u_main.tk with a start from scratch - outlined init and main functions - outlined building menus Modified Paths: -------------- branches/pd-devel/0.41.4/src/pd.tk Modified: branches/pd-devel/0.41.4/src/pd.tk =================================================================== --- branches/pd-devel/0.41.4/src/pd.tk 2008-12-23 06:27:37 UTC (rev 10457) +++ branches/pd-devel/0.41.4/src/pd.tk 2008-12-23 08:18:58 UTC (rev 10458) @@ -1,4397 +1,152 @@ #!/usr/bin/wish -# 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########## +package require Tk +#package require tile -# 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 - set defaultFontFamily {Bitstream Vera Sans Mono} - set defaultFontWeight normal - font create menuFont -family Tahoma -size -11 -} elseif { $tcl_platform(os) == "Darwin" } { - set pd_nt 2 - set defaultFontFamily Monaco - set defaultFontWeight normal -} else { - set pd_nt 0 - set defaultFontFamily Courier - set defaultFontWeight bold -} +## replace Tk widgets with Ttk widgets on 8.5 +#namespace import -force ttk::* -# start Pd-extended font hacks ----------------------------- +# ------------------------------------------------------------------------------ +# init functions -# Pd-0.39.2-extended hacks to make font/box sizes the same across platform -# puts stderr "tk scaling is [tk scaling]" -# tk scaling 1 - -# this font is for the Pd Window console text -font create console_font -family $defaultFontFamily -size -12 \ - -weight $defaultFontWeight -# this font is for text in Pd windows -font create text_font -family {Times} -size -14 -weight normal -# for text in Properties Panels and other panes -font create highlight_font -family $defaultFontFamily -size -14 -weight bold - -# end Pd-extended font hacks ----------------------------- - - -# 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 +proc init_x11 {} { } -if {$pd_nt == 2} { -# turn on James Tittle II's fast drawing - set tk::mac::useCGDrawing 1 -# anti-alias all lines that need it - 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 - } - } - } +proc init_aqua {} { } -# 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 . - } +proc init_win32 {} { + font create menufont -family Tahoma -size -11 } -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 <Key-Tab> "" -bind all <<PrevWindow>> "" -bind Text <Control-t> {} -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 - -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 +proc init {} { + if { [tk windowingsystem] eq "x11" } { + } elseif { [tk windowingsystem] eq "aqua" } { + } elseif { [tk windowingsystem] eq "win32" } { + } } -# fix menu font size on Windows with tk scaling = 1 -if {$pd_nt == 1} { - .mbar.file configure -font menuFont - .mbar.find configure -font menuFont - .mbar.windows configure -font menuFont - .mbar.audio configure -font menuFont - .mbar.help configure -font menuFont -} +# ------------------------------------------------------------------------------ +# Mac OS X specific functions -set ctrls_audio_on 0 -set ctrls_meter_on 0 -set ctrls_inlevel 0 -set ctrls_outlevel 0 +# ------------------------------------------------------------------------------ +# functions called from menu items -frame .controls.switches -checkbutton .controls.switches.audiobutton -text {compute audio} \ - -variable ctrls_audio_on \ - -command {pd [concat pd dsp $ctrls_audio_on \;]} - -checkbutton .controls.switches.meterbutton -text {peak meters} \ - -variable ctrls_meter_on \ - -command {pd [concat pd meters $ctrls_meter_on \;]} - -pack .controls.switches.audiobutton .controls.switches.meterbutton \ - -side top -anchor w - -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 console_font \ - -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 accel_munge {thingy} { } -proc pdtk_standardkeybindings {id} { - global pd_nt - bind $id <Control-Key> {pdtk_pd_ctrlkey %W %K 0} - bind $id <Control-Shift-Key> {pdtk_pd_ctrlkey %W %K 1} - if {$pd_nt == 2} { - bind $id <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0} - bind $id <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1} - } +proc menu_doc_open {docdir doc} { } -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 +proc menu_doc_browser {dir} { } -#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 +# ------------------------------------------------------------------------------ +# menu building functions +proc menu_create_file {rootmenu} { +# $rootmenu add command -label New -command {menu_new} + $rootmenu add command -label New -command {pdtk_canvas_new .flarg 30 10} \ + -accelerator [accel_munge "Ctrl+n"] + $rootmenu add command -label Open -command {menu_open} \ + -accelerator [accel_munge "Ctrl+o"] + $rootmenu add separator + $rootmenu 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 {[tk windowingsystem] ne "aqua"} { + $rootmenu add command -label Path... \ + -command {pd pd start-path-dialog \;} + $rootmenu add command -label Startup... \ + -command {pd pd start-startup-dialog \;} + } + $rootmenu add separator + $rootmenu add command -label Quit -command {menu_quit} \ + -accelerator [accel_munge "Ctrl+q"] } -#enquote a string for preferences (command strings etc.) -proc pdtk_encodedialog {x} { - concat +[string map {" " "+_" "$" "+d" ";" "+s" "," "+c" "+" "++"} $x] +proc menu_create_edit {rootmenu} { } -proc pdtk_debug {x} { - tk_messageBox -message $x -type ok +proc menu_create_put {rootmenu} { } -proc pdtk_watchdog {} { - pd [concat pd watchdog \;] - after 2000 {pdtk_watchdog} +proc menu_create_media {rootmenu} { } -proc pdtk_ping {} { - pd [concat pd ping \;] +proc menu_create_window {rootmenu} { } -##### 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 <Drop> { - 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 <KeyPress-Return> { - 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 text_font \ - -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} { - foreach candidate \ - { gnome-open xdg-open sensible-browser iceweasel firefox mozilla \ - galeon konqueror netscape lynx } { - set browser [lindex [auto_execok $candidate] 0] - if {[string length $browser]} { - puts stderr [format "%s %s" $browser $filename] - exec -- sh -c [format "%s %s" $browser $filename] & - break - } - } - } 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 <Button-1> [list doc_navigate $dir $count %W %x %y] - bind $current_listbox <Double-Button-1> [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. <hans(a)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} { - $mbar.help add command -label {About Pd} \ +proc menu_create_help {rootmenu} { + if {[tk windowingsystem] ne "aqua"} { + $rootmenu 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 ...} \ + $rootmenu add command -label {Html ...} \ + -command {menu_doc_open doc/1.manual index.htm} + $rootmenu 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 \;} +proc menu_create_apple {rootmenu} { + $rootmenu add command -label "About Pd..." -command \ + {menu_doc_open doc/1.manual 1.introduction.txt} + menu $rootmenu.preferences -tearoff 0 + $rootmenu add cascade -label "Preferences" -menu $rootmenu.preferences + $rootmenu.preferences add command -label "Path..." \ + -command {pd pd start-path-dialog \;} + $rootmenu.preferences add command -label "Startup..." \ + -command {pd pd start-startup-dialog \;} + $rootmenu.preferences add command -label "Audio Settings..." \ + -command {pd pd audio-properties \;} + $rootmenu.preferences add command -label "MIDI settings..." \ + -command {pd pd midi-properties \;} } -.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_create {rootmenu} { + set menulist "file edit put media window help" + if { [tk windowingsystem] eq "aqua" } { + set menulist "$menulist apple" + } + foreach menuitem $menulist { + menu $rootmenu.$menuitem -tearoff 0 + $rootmenu add cascade -label [string totitle $menuitem] \ + -menu $rootmenu.$menuitem + [concat menu_create_$menuitem] $rootmenu.$menuitem + if {[tk windowingsystem] eq "win32"} { + $rootmenu.$menuitem configure -font menufont + } + } } -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 - } +# ------------------------------------------------------------------------------ +# canvas support functions +proc pdtk_canvas_new {canvas_name width height} { + if {$width < 200} {set width 200} + if {$height < 50} {set height 50} + toplevel $canvas_name -menu $canvas_name.menubar -width $width -height $height + menu $canvas_name.menubar -tearoff 0 + menu_create $canvas_name.menubar } -proc menu_close {name} { - pdtk_canvas_checkgeometry $name - pd [concat $name menuclose 0 \;] -} +# ------------------------------------------------------------------------------ +# main +proc main {} { -proc menu_really_close {name} { - pdtk_canvas_checkgeometry $name - pd [concat $name menuclose 1 \;] -} +menu .menubar +menu_create .menubar -proc menu_undo {name} { - global pd_undoaction - global pd_redoaction - global pd_undocanvas - if {$name == $pd_undocanvas && $pd_undoaction != "no"} { - pd [concat $name undo \;] - } -} +wm title . "Pd-devel" +#wm protocol . WM_DELETE_WINDOW menu_quit +. configure -menu .menubar -width 400 -height 250 -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 \;] -} +main -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 <KeyPress-Return> [ 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 - # if we're a mac, refuse to make window so big you can't get to - # the resizing control - if {$pd_nt == 2} { - if {$width > [winfo screenwidth $name] - 80} { - set width [expr [winfo screenwidth $name] - 80] - } - if {$height > [winfo screenheight $name] - 80} { - set height [expr [winfo screenheight $name] - 80] - } - } - -# 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); -# <hans(a)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 - - 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] - -# fix menu font size on Windows with tk scaling = 1 -if {$pd_nt == 1} { - $name.m.file configure -font menuFont - $name.m.edit configure -font menuFont - $name.m.find configure -font menuFont - $name.m.put configure -font menuFont - $name.m.windows configure -font menuFont - $name.m.audio configure -font menuFont - $name.m.help configure -font menuFont - $name.popup configure -font menuFont -} - -# 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 <Mod1-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 - set pd_array_listview_page($arrayName) $page -} - -proc pdtk_array_listview_changepage {arrayName np} { - global pd_array_listview_page - pdtk_array_listview_setpage \ - $arrayName [expr $pd_array_listview_page($arrayName) + $np] - pdtk_array_listview_fillpage $arrayName -} - -proc pdtk_array_listview_fillpage {arrayName} { - global pd_array_listview_page - global pd_array_listview_id - set windowName [format ".%sArrayWindow" $arrayName] - set topItem [expr [lindex [$windowName.lb yview] 0] * \ - [$windowName.lb size]] - - if {[winfo exists $windowName]} { - set cmd "$pd_array_listview_id($arrayName) \ - arrayviewlistfillpage \ - $pd_array_listview_page($arrayName) \ - $topItem" - - pd [concat $cmd \;] - } -} - -proc pdtk_array_listview_new {id arrayName page} { - global pd_nt - global pd_array_listview_page - global pd_array_listview_id - global fontname fontweight - set pd_array_listview_page($arrayName) $page - set pd_array_listview_id($arrayName) $id - set windowName [format ".%sArrayWindow" $arrayName] - if [winfo exists $windowName] then [destroy $windowName] - toplevel $windowName - wm protocol $windowName WM_DELETE_WINDOW \ - "pdtk_array_listview_close $id $arrayName" - wm title $windowName [concat $arrayName "(list view)"] - # FIXME - set font 12 - set $windowName.lb [listbox $windowName.lb -height 20 -width 25\ - -selectmode extended \ - -relief solid -background white -borderwidth 1 \ - -font [format {{%s} %d %s} $fontname $font $fontweight]\ - -yscrollcommand "$windowName.lb.sb set"] - set $windowName.lb.sb [scrollbar $windowName.lb.sb \ - -command "$windowName.lb yview" -orient vertical] - place configure $windowName.lb.sb -relheight 1 -relx 0.9 -relwidth 0.1 - pack $windowName.lb -expand 1 -fill both - bind $windowName.lb <Double-ButtonPress-1> \ - "pdtk_array_listview_edit $arrayName $page $font" - # handle copy/paste - if {$pd_nt == 0} { - selection handle $windowName.lb \ - "pdtk_array_listview_lbselection $arrayName" - } else { - if {$pd_nt == 1} { - bind $windowName.lb <ButtonPress-3> \ - "pdtk_array_listview_popup $arrayName" - } - } - set $windowName.prevBtn [button $windowName.prevBtn -text "<-" \ - -command "pdtk_array_listview_changepage $arrayName -1"] - set $windowName.nextBtn [button $windowName.nextBtn -text "->" \ - -command "pdtk_array_listview_changepage $arrayName 1"] - pack $windowName.prevBtn -side left -ipadx 20 -pady 10 -anchor s - pack $windowName.nextBtn -side right -ipadx 20 -pady 10 -anchor s - focus $windowName -} - -proc pdtk_array_listview_lbselection {arrayName off size} { - set windowName [format ".%sArrayWindow" $arrayName] - set itemNums [$windowName.lb curselection] - set cbString "" - for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} { - set listItem [$windowName.lb get [lindex $itemNums $i]] - append cbString [string range $listItem \ - [expr [string first ") " $listItem] + 2] \ - end] - append cbString "\n" - } - set listItem [$windowName.lb get [lindex $itemNums $i]] - append cbString [string range $listItem \ - [expr [string first ") " $listItem] + 2] \ - end] - set last $cbString -} - -# Win32 uses a popup menu for copy/paste -proc pdtk_array_listview_popup {arrayName} { - set windowName [format ".%sArrayWindow" $arrayName] - if [winfo exists $windowName.popup] then [destroy $windowName.popup] - menu $windowName.popup -tearoff false - $windowName.popup add command -label {Copy} \ - -command "pdtk_array_listview_copy $arrayName; \ - destroy $windowName.popup" - $windowName.popup add command -label {Paste} \ - -command "pdtk_array_listview_paste $arrayName; \ - destroy $windowName.popup" - tk_popup $windowName.popup [winfo pointerx $windowName] \ - [winfo pointery $windowName] 0 -} - -proc pdtk_array_listview_copy {arrayName} { - set windowName [format ".%sArrayWindow" $arrayName] - set itemNums [$windowName.lb curselection] - set cbString "" - for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} { - set listItem [$windowName.lb get [lindex $itemNums $i]] - append cbString [string range $listItem \ - [expr [string first ") " $listItem] + 2] \ - end] - append cbString "\n" - } - set listItem [$windowName.lb get [lindex $itemNums $i]] - append cbString [string range $listItem \ - [expr [string first ") " $listItem] + 2] \ - end] - clipboard clear - clipboard append $cbString -} - -proc pdtk_array_listview_paste {arrayName} { - global pd_array_listview_page - global pd_array_listview_pagesize - set cbString [selection get -selection CLIPBOARD] - set lbName [format ".%sArrayWindow.lb" $arrayName] - set itemNum [lindex [$lbName curselection] 0] - set splitChars ", \n" - set itemString [split $cbString $splitChars] - set flag 1 - for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} { - if {[lindex $itemString $i] != {}} { - pd [concat $arrayName [expr $itemNum + \ - [expr $counter + \ - [expr $pd_array_listview_pagesize \ - * $pd_array_listview_page($arrayName)]]] \ - [lindex $itemString $i] \;] - incr counter - set flag 0 - } - } -} - -proc pdtk_array_listview_edit {arrayName page font} { - global pd_array_listview_entry - global pd_nt - global fontname fontweight - set lbName [format ".%sArrayWindow.lb" $arrayName] - if {[winfo exists $lbName.entry]} { - pdtk_array_listview_update_entry \ - $arrayName $pd_array_listview_entry($arrayName) - unset pd_array_listview_entry($arrayName) - } - set itemNum [$lbName index active] - set pd_array_listview_entry($arrayName) $itemNum - set bbox [$lbName bbox $itemNum] - set y [expr [lindex $bbox 1] - 4] - set $lbName.entry [entry $lbName.entry \ - -font [format {{%s} %d %s} $fontname $font $fontweight]] - $lbName.entry insert 0 [] - place configure $lbName.entry -relx 0 -y $y -relwidth 1 - lower $lbName.entry - focus $lbName.entry - bind $lbName.entry <Return> \ - "pdtk_array_listview_update_entry $arrayName $itemNum;" -} - -proc pdtk_array_listview_update_entry {arrayName itemNum} { - global pd_array_listview_page - global pd_array_listview_pagesize - set lbName [format ".%sArrayWindow.lb" $arrayName] - set splitChars ", \n" - set itemString [split [$lbName.entry get] $splitChars] - set flag 1 - for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} { - if {[lindex $itemString $i] != {}} { - pd [concat $arrayName [expr $itemNum + \ - [expr $counter + \ - [expr $pd_array_listview_pagesize \ - * $pd_array_listview_page($arrayName)]]] \ - [lindex $itemString $i] \;] - incr counter - set flag 0 - } - } - pdtk_array_listview_fillpage $arrayName - destroy $lbName.entry -} - -proc pdtk_array_listview_closeWindow {arrayName} { - set windowName [format ".%sArrayWindow" $arrayName] - destroy $windowName -} - -proc pdtk_array_listview_close {id arrayName} { - pdtk_array_listview_closeWindow $arrayName - set cmd [concat $id "arrayviewclose" \;] - pd $cmd -} -##### end jsarlo ##### - -#################### event binding procedures ################ - -#get the name of the toplevel window for a canvas; this is also -#the name of the canvas object in Pd. - -proc canvastosym {name} { - string range $name 0 [expr [string length $name] - 3] -} - -set pdtk_lastcanvasconfigured "" -set pdtk_lastcanvasconfiguration "" -set pdtk_lastcanvasconfiguration2 "" - -proc pdtk_canvas_checkgeometry {topname} { - set boo [winfo geometry $topname.c] - set boo2 [wm geometry $topname] - global pdtk_lastcanvasconfigured - global pdtk_lastcanvasconfiguration - global pdtk_lastcanvasconfiguration2 - if {$topname != $pdtk_lastcanvasconfigured || \ - $boo != $pdtk_lastcanvasconfiguration || \ - $boo2 != $pdtk_lastcanvasconfiguration2} { - set pdtk_lastcanvasconfigured $topname - set pdtk_lastcanvasconfiguration $boo - set pdtk_lastcanvasconfiguration2 $boo2 - pd $topname relocate $boo $boo2 \; - } -} - -proc pdtk_canvas_click {name x y b f} { - global pd_nt - if {$pd_nt == 0} {focus $name} - pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b $f \; -} - -proc pdtk_canvas_shiftclick {name x y b} { - pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 1 \; -} - -proc pdtk_canvas_ctrlclick {name x y b} { - pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 2 \; -} - -proc pdtk_canvas_altclick {name x y b} { - pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 3 \; -} - -proc pdtk_canvas_dblclick {name x y b} { - pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 4 \; -} - -set pdtk_canvas_mouseup_name 0 -set pdtk_canvas_mouseup_xminval 0 -set pdtk_canvas_mouseup_xmaxval 0 -set pdtk_canvas_mouseup_yminval 0 -set pdtk_canvas_mouseup_ymaxval 0 - -proc pdtk_canvas_mouseup {name x y b} { - pd [concat [canvastosym $name] mouseup [$name canvasx $x] \ - [$name canvasy $y] $b \;] -} - -proc pdtk_canvas_getscroll {name} { - global pdtk_canvas_mouseup_name - global pdtk_canvas_mouseup_xminval - global pdtk_canvas_mouseup_xmaxval - global pdtk_canvas_mouseup_yminval - global pdtk_canvas_mouseup_ymaxval - - set size [$name bbox all] - if {$size != ""} { - set xminval 0 - set yminval 0 - set xmaxval 100 - set ymaxval 100 - set x1 [lindex $size 0] - set x2 [lindex $size 2] - set y1 [lindex $size 1] - set y2 [lindex $size 3] - - if {$x1 < 0} {set xminval $x1} - if {$y1 < 0} {set yminval $y1} - - if {$x2 > 100} {set xmaxval $x2} - if {$y2 > 100} {set ymaxval $y2} - - if {$pdtk_canvas_mouseup_name != $name || \ - $pdtk_canvas_mouseup_xminval != $xminval || \ - $pdtk_canvas_mouseup_xmaxval != $xmaxval || \ - $pdtk_canvas_mouseup_yminval != $yminval || \ - $pdtk_canvas_mouseup_ymaxval != $ymaxval } { - - set newsize "$xminval $yminval $xmaxval $ymaxval" - $name configure -scrollregion $newsize - set pdtk_canvas_mouseup_name $name - set pdtk_canvas_mouseup_xminval $xminval - set pdtk_canvas_mouseup_xmaxval $xmaxval - set pdtk_canvas_mouseup_yminval $yminval - set pdtk_canvas_mouseup_ymaxval $ymaxval - } - - } - pdtk_canvas_checkgeometry [canvastosym $name] -} - -proc pdtk_canvas_key {name key iso shift} { -# puts stderr [concat down key= $key iso= $iso] -# .controls.switches.meterbutton configure -text $key -# HACK for MAC OSX -- backspace seems different; I don't understand why. -# invesigate this LATER... - global pd_nt - if {$pd_nt == 2} { - if {$key == "BackSpace"} { - set key 8 - set keynum 8 - } - if {$key == "Delete"} { - set key 8 - set keynum 8 - } - } - if {$key == "KP_Delete"} { - set key 127 - set keynum 127 - } - if {$iso != ""} { - scan $iso %c keynum - pd [canvastosym $name] key 1 $keynum $shift\; - } else { - pd [canvastosym $name] key 1 $key $shift\; - } -} - -proc pdtk_canvas_keyup {name key iso} { -# puts stderr [concat up key= $key iso= $iso] - if {$iso != ""} { - scan $iso %c keynum - pd [canvastosym $name] key 0 $keynum 0 \; - } else { - pd [canvastosym $name] key 0 $key 0 \; - } -} - -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 == "1"} {menu_object $topname 1} - if {$key == "2"} {menu_message $topname 1} - if {$key == "3"} {menu_floatatom $topname 1} - if {$key == "4"} {menu_symbolatom $topname 1} - if {$key == "5"} {menu_comment $topname 1} - if {$key == "slash"} {menu_audio 1} - if {$key == "period"} {menu_audio 0} - if {$shift == 1} { - if {$key == "q" || $key == "Q"} {menu_really_quit} - if {$key == "w" || $key == "W"} {menu_really_close $topname} - 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} { -# puts stderr [concat [canvastosym $name] $name $x $y] - pd [canvastosym $name] motion [$name canvasx $x] [$name canvasy $y] $mods \; -} - -# "map" event tells us when the canvas becomes visible (arg is "0") or -# invisible (arg is ""). Invisibility means the Window Manager has minimized -# us. We don't get a final "unmap" event when we destroy the window. -proc pdtk_canvas_map {name} { -# puts stderr [concat map $name] - pd [canvastosym $name] map 1 \; -} - -proc pdtk_canvas_unmap {name} { -# puts stderr [concat 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 ############## - -proc pdtk_canvas_saveas {name initfile initdir} { - global pd_nt - set filename [tk_getSaveFile -initialfile $initfile \ - -initialdir $initdir -defaultextension .pd \ - -filetypes { {{pd files} {.pd}} {{max files} {.pat}} }] - - if {$filename != ""} { -# yes, we need the extent even if we're on a mac. - if {$pd_nt == 2} { - if {[string last .pd $filename] < 0 && \ - [string last .PD $filename] < 0 && \ - [string last .pat $filename] < 0 && \ - [string last .PAT $filename] < 0} { - set filename $filename.pd - if {[file exists $filename]} { - set answer [tk_messageBox \ - \-message [concat overwrite $filename "?"] \ - \-type yesno \-icon question] - if {! [string compare $answer no]} {return} - } - } - } - - set directory [string range $filename 0 \ - [expr [string last / $filename ] - 1]] - set basename [string range $filename \ - [expr [string last / $filename ] + 1] end] - pd [concat $name savetofile [pdtk_enquote $basename] \ - [pdtk_enquote $directory] \;] -# pd [concat $name savetofile $basename $directory \;] - } -} - -############ pdtk_canvas_dofont -- run a font and resize dialog ######### - -set fontsize 0 -set stretchval 0 -set whichstretch 0 - -proc dofont_apply {name} { - global fontsize - global stretchval - global whichstretch - set cmd [concat $name font $fontsize $stretchval $whichstretch \;] -# puts stderr $cmd - pd $cmd -} - -proc dofont_cancel {name} { - set cmd [concat $name cancel \;] -# puts stderr $cmd - pd $cmd -} - -proc pdtk_canvas_dofont {name initsize} { - - global fontsize - set fontsize $initsize - - global stretchval - set stretchval 100 - - global whichstretch - set whichstretch 1 - - toplevel $name - wm title $name {FONT BOMB} - wm protocol $name WM_DELETE_WINDOW [concat dofont_cancel $name] - - frame $name.buttonframe - pack $name.buttonframe -side bottom -fill x -pady 2m - button $name.buttonframe.cancel -text {Cancel}\ - -command "dofont_cancel $name" - button $name.buttonframe.ok -text {Do it}\ - -command "dofont_apply $name" - pack $name.buttonframe.cancel -side left -expand 1 - pack $name.buttonframe.ok -side left -expand 1 - - frame $name.radiof - pack $name.radiof -side left - - label $name.radiof.label -text {Font Size:} - pack $name.radiof.label -side top - - radiobutton $name.radiof.radio8 -value 8 -variable fontsize -text "8" - radiobutton $name.radiof.radio10 -value 10 -variable fontsize -text "10" - radiobutton $name.radiof.radio12 -value 12 -variable fontsize -text "12" - radiobutton $name.radiof.radio16 -value 16 -variable fontsize -text "16" - radiobutton $name.radiof.radio24 -value 24 -variable fontsize -text "24" - radiobutton $name.radiof.radio36 -value 36 -variable fontsize -text "36" - pack $name.radiof.radio8 -side top -anchor w - pack $name.radiof.radio10 -side top -anchor w - pack $name.radiof.radio12 -side top -anchor w - pack $name.radiof.radio16 -side top -anchor w - pack $name.radiof.radio24 -side top -anchor w - pack $name.radiof.radio36 -side top -anchor w - - frame $name.stretchf - pack $name.stretchf -side left - - label $name.stretchf.label -text {Stretch:} - pack $name.stretchf.label -side top - - entry $name.stretchf.entry -textvariable stretchval -width 5 - pack $name.stretchf.entry -side left - - radiobutton $name.stretchf.radio1 \ - -value 1 -variable whichstretch -text "X and Y" - radiobutton $name.stretchf.radio2 \ - -value 2 -variable whichstretch -text "X only" - radiobutton $name.stretchf.radio3 \ - -value 3 -variable whichstretch -text "Y only" - - pack $name.stretchf.radio1 -side top -anchor w - pack $name.stretchf.radio2 -side top -anchor w - pack $name.stretchf.radio3 -side top -anchor w - -} - -############ pdtk_gatom_dialog -- run a gatom dialog ######### - -# dialogs like this one can come up in many copies; but in TK the easiest -# way to get data from an "entry", etc., is to set an associated variable -# name. This is especially true for grouped "radio buttons". So we have -# to synthesize variable names for each instance of the dialog. The dialog -# gets a TK pathname $id, from which it strips the leading "." to make a -# variable suffix $vid. Then you can get the actual value out by asking for -# [eval concat $$variablename]. There should be an easier way but I don't see -# it yet. - -proc gatom_escape {sym} { - if {[string length $sym] == 0} { - set ret "-" -# puts stderr [concat escape1 $sym $ret] - } else { - if {[string equal -length 1 $sym "-"]} { - set ret [string replace $sym 0 0 "--"] -# puts stderr [concat escape $sym $ret] - } else { - set ret [string map {"$" "#"} $sym] -# puts stderr [concat unescape $sym $ret] - } - } - pdtk_unspace $ret -} - -proc gatom_unescape {sym} { - if {[string equal -length 1 $sym "-"]} { - set ret [string replace $sym 0 0 ""] -# puts stderr [concat unescape $sym $ret] - } else { - set ret [string map {"#" "$"} $sym] -# puts stderr [concat unescape $sym $ret] - } - concat $ret -} - -proc dogatom_apply {id} { - set vid [string trimleft $id .] - - set var_gatomwidth [concat gatomwidth_$vid] - global $var_gatomwidth - set var_gatomlo [concat gatomlo_$vid] - global $var_gatomlo - set var_gatomhi [concat gatomhi_$vid] - global $var_gatomhi - set var_gatomwherelabel [concat gatomwherelabel_$vid] - global $var_gatomwherelabel - set var_gatomlabel [concat gatomlabel_$vid] - global $var_gatomlabel - set var_gatomsymfrom [concat gatomsymfrom_$vid] - global $var_gatomsymfrom - set var_gatomsymto [concat gatomsymto_$vid] - global $var_gatomsymto - -# set cmd [concat $id param $gatomwidth $gatomlo $gatomhi \;] - - set cmd [concat $id param \ - [eval concat $$var_gatomwidth] \ - [eval concat $$var_gatomlo] \ - [eval concat $$var_gatomhi] \ - [eval gatom_escape $$var_gatomlabel] \ - [eval concat $$var_gatomwherelabel] \ - [eval gatom_escape $$var_gatomsymfrom] \ - [eval gatom_escape $$var_gatomsymto] \ - \;] - -# puts stderr $cmd - pd $cmd -} - -proc dogatom_cancel {name} { - set cmd [concat $name cancel \;] -# puts stderr $cmd - pd $cmd -} - -proc dogatom_ok {name} { - dogatom_apply $name - dogatom_cancel $name -} - -proc pdtk_gatom_dialog {id initwidth initlo inithi \ - wherelabel label symfrom symto} { - - set vid [string trimleft $id .] - - global pd_nt - - set var_gatomwidth [concat gatomwidth_$vid] - global $var_gatomwidth - set var_gatomlo [concat gatomlo_$vid] - global $var_gatomlo - set var_gatomhi [concat gatomhi_$vid] - global $var_gatomhi - set var_gatomwherelabel [concat gatomwherelabel_$vid] - global $var_gatomwherelabel - set var_gatomlabel [concat gatomlabel_$vid] - global $var_gatomlabel - set var_gatomsymfrom [concat gatomsymfrom_$vid] - global $var_gatomsymfrom - set var_gatomsymto [concat gatomsymto_$vid] - global $var_gatomsymto - - set $var_gatomwidth $initwidth - set $var_gatomlo $initlo - set $var_gatomhi $inithi - set $var_gatomwherelabel $wherelabel - set $var_gatomlabel [gatom_unescape $label] - set $var_gatomsymfrom [gatom_unescape $symfrom] - set $var_gatomsymto [gatom_unescape $symto] - - toplevel $id - wm title $id "atom box properties" - wm resizable $id 0 0 - wm protocol $id WM_DELETE_WINDOW [concat dogatom_cancel $id] - - frame $id.params -height 7 - pack $id.params -side top - label $id.params.entryname -text "width" - entry $id.params.entry -textvariable $var_gatomwidth -width 4 - pack $id.params.entryname $id.params.entry -side left - - labelframe $id.limits -text "limits" -padx 15 -pady 4 -borderwidth 1 \ - -font highlight_font - pack $id.limits -side top -fill x - frame $id.limits.lower - pack $id.limits.lower -side left - label $id.limits.lower.entryname -text "lower" - entry $id.limits.lower.entry -textvariable $var_gatomlo -width 8 - pack $id.limits.lower.entryname $id.limits.lower.entry -side left - frame $id.limits.upper - pack $id.limits.upper -side left - frame $id.limits.upper.spacer -width 20 - label $id.limits.upper.entryname -text "upper" - entry $id.limits.upper.entry -textvariable $var_gatomhi -width 8 - pack $id.limits.upper.spacer $id.limits.upper.entryname \ - $id.limits.upper.entry -side left - - frame $id.spacer1 -height 7 - pack $id.spacer1 -side top - - labelframe $id.label -text "label" -padx 5 -pady 4 -borderwidth 1 \ - -font highlight_font - pack $id.label -side top -fill x - frame $id.label.name - pack $id.label.name -side top - entry $id.label.name.entry -textvariable $var_gatomlabel -width 33 - pack $id.label.name.entry -side left - frame $id.label.radio - pack $id.label.radio -side top - radiobutton $id.label.radio.left -value 0 \ - -variable $var_gatomwherelabel \ - -text "left " -justify left - radiobutton $id.label.radio.right -value 1 \ - -variable $var_gatomwherelabel \ - -text "right" -justify left - radiobutton $id.label.radio.top -value 2 \ - -variable $var_gatomwherelabel \ - -text "top" -justify left - radiobutton $id.label.radio.bottom -value 3 \ - -variable $var_gatomwherelabel \ - -text "bottom" -justify left - pack $id.label.radio.left -side left -anchor w - pack $id.label.radio.right -side right -anchor w - pack $id.label.radio.top -side top -anchor w - pack $id.label.radio.bottom -side bottom -anchor w - - frame $id.spacer2 -height 7 - pack $id.spacer2 -side top - - labelframe $id.s_r -text "messages" -padx 5 -pady 4 -borderwidth 1 \ - -font highlight_font - pack $id.s_r -side top -fill x - frame $id.s_r.paramsymto - pack $id.s_r.paramsymto -side top -anchor e - label $id.s_r.paramsymto.entryname -text "send symbol" - entry $id.s_r.paramsymto.entry -textvariable $var_gatomsymto -width 21 - pack $id.s_r.paramsymto.entry $id.s_r.paramsymto.entryname -side right - - frame $id.s_r.paramsymfrom - pack $id.s_r.paramsymfrom -side top -anchor e - label $id.s_r.paramsymfrom.entryname -text "receive symbol" - entry $id.s_r.paramsymfrom.entry -textvariable $var_gatomsymfrom -width 21 - pack $id.s_r.paramsymfrom.entry $id.s_r.paramsymfrom.entryname -side right - - frame $id.buttonframe -pady 5 - pack $id.buttonframe -side top -fill x -pady 2m - button $id.buttonframe.cancel -text {Cancel}\ - -command "dogatom_cancel $id" - pack $id.buttonframe.cancel -side left -expand 1 - button $id.buttonframe.apply -text {Apply}\ - -command "dogatom_apply $id" - pack $id.buttonframe.apply -side left -expand 1 - button $id.buttonframe.ok -text {OK}\ - -command "dogatom_ok $id" - pack $id.buttonframe.ok -side left -expand 1 - - bind $id.limits.upper.entry <KeyPress-Return> [concat dogatom_ok $id] - bind $id.limits.lower.entry <KeyPress-Return> [concat dogatom_ok $id] - bind $id.params.entry <KeyPress-Return> [concat dogatom_ok $id] - pdtk_standardkeybindings $id.limits.upper.entry - pdtk_standardkeybindings $id.limits.lower.entry - pdtk_standardkeybindings $id.params.entry - $id.params.entry select from 0 - $id.params.entry select adjust end - focus $id.params.entry -} - -############ pdtk_canvas_popup -- popup menu for canvas ######### - -set popup_xpix 0 -set popup_ypix 0 - -proc popup_action {name action} { - global popup_xpix popup_ypix - set cmd [concat $name done-popup $action $popup_xpix $popup_ypix \;] -# puts stderr $cmd - pd $cmd -} - -proc pdtk_canvas_popup {name xpix ypix canprop canopen} { - global popup_xpix popup_ypix - set popup_xpix $xpix - set popup_ypix $ypix - if {$canprop == 0} {$name.popup entryconfigure 0 -state disabled} - if {$canprop == 1} {$name.popup entryconfigure 0 -state active} - if {$canopen == 0} {$name.popup entryconfigure 1 -state disabled} - if {$canopen == 1} {$name.popup entryconfigure 1 -state active} - tk_popup $name.popup [expr $xpix + [winfo rootx $name.c]] \ - [expr $ypix + [winfo rooty $name.c]] 0 -} - - -# begin of change "iemlib" -############ pdtk_iemgui_dialog -- dialog window for iem guis ######### - -set iemgui_define_min_flashhold 50 -set iemgui_define_min_flashbreak 10 -set iemgui_define_min_fontsize 4 - -proc iemgui_clip_dim {id} { - set vid [string trimleft $id .] - - set var_iemgui_wdt [concat iemgui_wdt_$vid] - global $var_iemgui_wdt - set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] - global $var_iemgui_min_wdt - set var_iemgui_hgt [concat iemgui_hgt_$vid] - global $var_iemgui_hgt - set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] - global $var_iemgui_min_hgt - - if {[eval concat $$var_iemgui_wdt] < [eval concat $$var_iemgui_min_wdt]} { - set $var_iemgui_wdt [eval concat $$var_iemgui_min_wdt] - $id.dim.w_ent configure -textvariable $var_iemgui_wdt - } - if {[eval concat $$var_iemgui_hgt] < [eval concat $$var_iemgui_min_hgt]} { - set $var_iemgui_hgt [eval concat $$var_iemgui_min_hgt] - $id.dim.h_ent configure -textvariable $var_iemgui_hgt - } -} - -proc iemgui_clip_num {id} { - set vid [string trimleft $id .] - - set var_iemgui_num [concat iemgui_num_$vid] - global $var_iemgui_num - - if {[eval concat $$var_iemgui_num] > 2000} { - set $var_iemgui_num 2000 - $id.para.num_ent configure -textvariable $var_iemgui_num - } - if {[eval concat $$var_iemgui_num] < 1} { - set $var_iemgui_num 1 - $id.para.num_ent configure -textvariable $var_iemgui_num - } -} - -proc iemgui_sched_rng {id} { - set vid [string trimleft $id .] - - set var_iemgui_min_rng [concat iemgui_min_rng_$vid] - global $var_iemgui_min_rng - set var_iemgui_max_rng [concat iemgui_max_rng_$vid] - global $var_iemgui_max_rng - set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid] - global $var_iemgui_rng_sch - - global iemgui_define_min_flashhold - global iemgui_define_min_flashbreak - - if {[eval concat $$var_iemgui_rng_sch] == 2} { - if {[eval concat $$var_iemgui_max_rng] < [eval concat $$var_iemgui_min_rng]} { - set hhh [eval concat $$var_iemgui_min_rng] - set $var_iemgui_min_rng [eval concat $$var_iemgui_max_rng] - set $var_iemgui_max_rng $hhh - $id.rng.max_ent configure -textvariable $var_iemgui_max_rng - $id.rng.min_ent configure -textvariable $var_iemgui_min_rng } - if {[eval concat $$var_iemgui_max_rng] < $iemgui_define_min_flashhold} { - set $var_iemgui_max_rng $iemgui_define_min_flashhold - $id.rng.max_ent configure -textvariable $var_iemgui_max_rng - } - if {[eval concat $$var_iemgui_min_rng] < $iemgui_define_min_flashbreak} { - set $var_iemgui_min_rng $iemgui_define_min_flashbreak - $id.rng.min_ent configure -textvariable $var_iemgui_min_rng - } - } - if {[eval concat $$var_iemgui_rng_sch] == 1} { - if {[eval concat $$var_iemgui_min_rng] == 0.0} { - set $var_iemgui_min_rng 1.0 - $id.rng.min_ent configure -textvariable $var_iemgui_min_rng - } - } -} - -proc iemgui_verify_rng {id} { - set vid [string trimleft $id .] - - set var_iemgui_min_rng [concat iemgui_min_rng_$vid] - global $var_iemgui_min_rng - set var_iemgui_max_rng [concat iemgui_max_rng_$vid] - global $var_iemgui_max_rng - set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] - global $var_iemgui_lin0_log1 - - if {[eval concat $$var_iemgui_lin0_log1] == 1} { - if {[eval concat $$var_iemgui_max_rng] == 0.0 && [eval concat $$var_iemgui_min_rng] == 0.0} { - set $var_iemgui_max_rng 1.0 - $id.rng.max_ent configure -textvariable $var_iemgui_max_rng - } - if {[eval concat $$var_iemgui_max_rng] > 0} { - if {[eval concat $$var_iemgui_min_rng] <= 0} { - set $var_iemgui_min_rng [expr [eval concat $$var_iemgui_max_rng] * 0.01] - $id.rng.min_ent configure -textvariable $var_iemgui_min_rng - } - } else { - if {[eval concat $$var_iemgui_min_rng] > 0} { - set $var_iemgui_max_rng [expr [eval concat $$var_iemgui_min_rng] * 0.01] - $id.rng.max_ent configure -textvariable $var_iemgui_max_rng - } - } - } -} - -proc iemgui_clip_fontsize {id} { - set vid [string trimleft $id .] - - set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] - global $var_iemgui_gn_fs - - global iemgui_define_min_fontsize - - if {[eval concat $$var_iemgui_gn_fs] < $iemgui_define_min_fontsize} { - set $var_iemgui_gn_fs $iemgui_define_min_fontsize - $id.label.fs_ent configure -textvariable $var_iemgui_gn_fs - } -} - -proc iemgui_set_col_example {id} { - set vid [string trimleft $id .] - - set var_iemgui_bcol [concat iemgui_bcol_$vid] - global $var_iemgui_bcol - set var_iemgui_fcol [concat iemgui_fcol_$vid] - global $var_iemgui_fcol - set var_iemgui_lcol [concat iemgui_lcol_$vid] - global $var_iemgui_lcol - - $id.colors.sections.lb_bk configure \ - -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \ - -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] - - if { [eval concat $$var_iemgui_fcol] >= 0 } { - $id.colors.sections.fr_bk configure \ - -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \ - -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] - } else { - $id.colors.sections.fr_bk configure \ - -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]]} -} - -proc iemgui_preset_col {id presetcol} { - set vid [string trimleft $id .] - - set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] - global $var_iemgui_l2_f1_b0 - set var_iemgui_bcol [concat iemgui_bcol_$vid] - global $var_iemgui_bcol - set var_iemgui_fcol [concat iemgui_fcol_$vid] - global $var_iemgui_fcol - set var_iemgui_lcol [concat iemgui_lcol_$vid] - global $var_iemgui_lcol - - if { [eval concat $$var_iemgui_l2_f1_b0] == 0 } { set $var_iemgui_bcol $presetcol } - if { [eval concat $$var_iemgui_l2_f1_b0] == 1 } { set $var_iemgui_fcol $presetcol } - if { [eval concat $$var_iemgui_l2_f1_b0] == 2 } { set $var_iemgui_lcol $presetcol } - iemgui_set_col_example $id -} - -proc iemgui_choose_col_bkfrlb {id} { - set vid [string trimleft $id .] - - set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] - global $var_iemgui_l2_f1_b0 - set var_iemgui_bcol [concat iemgui_bcol_$vid] - global $var_iemgui_bcol - set var_iemgui_fcol [concat iemgui_fcol_$vid] - global $var_iemgui_fcol - set var_iemgui_lcol [concat iemgui_lcol_$vid] - global $var_iemgui_lcol - - if {[eval concat $$var_iemgui_l2_f1_b0] == 0} { - set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] - set helpstring [tk_chooseColor -title "Background-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_bcol]]] - if { $helpstring != "" } { - set $var_iemgui_bcol [string replace $helpstring 0 0 "0x"] - set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] } - } - if {[eval concat $$var_iemgui_l2_f1_b0] == 1} { - set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] - set helpstring [tk_chooseColor -title "Front-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_fcol]]] - if { $helpstring != "" } { - set $var_iemgui_fcol [string replace $helpstring 0 0 "0x"] - set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] } - } - if {[eval concat $$var_iemgui_l2_f1_b0] == 2} { - set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] - set helpstring [tk_chooseColor -title "Label-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_lcol]]] - if { $helpstring != "" } { - set $var_iemgui_lcol [string replace $helpstring 0 0 "0x"] - set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] } - } - iemgui_set_col_example $id -} - -proc iemgui_lilo {id} { - set vid [string trimleft $id .] - - set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] - global $var_iemgui_lin0_log1 - set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] - global $var_iemgui_lilo0 - set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] - global $var_iemgui_lilo1 - - iemgui_sched_rng $id - - if {[eval concat $$var_iemgui_lin0_log1] == 0} { - set $var_iemgui_lin0_log1 1 - $id.para.lilo configure -text [eval concat $$var_iemgui_lilo1] - iemgui_verify_rng $id - iemgui_sched_rng $id - } else { - set $var_iemgui_lin0_log1 0 - $id.para.lilo configure -text [eval concat $$var_iemgui_lilo0] - } -} - -proc iemgui_toggle_font {id gn_f} { - set vid [string trimleft $id .] - - set var_iemgui_gn_f [concat iemgui_gn_f_$vid] - global $var_iemgui_gn_f - global fontname fontweight - - set $var_iemgui_gn_f $gn_f - - switch -- $gn_f { - 0 { set current_font $fontname} - 1 { set current_font "Helvetica" } - 2 { set current_font "Times" } - } - set current_font_spec "{$current_font} 12 $fontweight" - - $id.label.fontpopup_label configure -text $current_font \ - -font $current_font_spec - $id.label.name_entry configure -font $current_font_spec - $id.colors.sections.fr_bk configure -font $current_font_spec - $id.colors.sections.lb_bk configure -font $current_font_spec -} - -proc iemgui_lb {id} { - set vid [string trimleft $id .] - - set var_iemgui_loadbang [concat iemgui_loadbang_$vid] - global $var_iemgui_loadbang - - if {[eval concat $$var_iemgui_loadbang] == 0} { - set $var_iemgui_loadbang 1 - $id.para.lb configure -text "init" - } else { - set $var_iemgui_loadbang 0 - $id.para.lb configure -text "no init" - } -} - -proc iemgui_stdy_jmp {id} { - set vid [string trimleft $id .] - - set var_iemgui_steady [concat iemgui_steady_$vid] - global $var_iemgui_steady - - if {[eval concat $$var_iemgui_steady]} { - set $var_iemgui_steady 0 - $id.para.stdy_jmp configure -text "jump on click" - } else { - set $var_iemgui_steady 1 - $id.para.stdy_jmp configure -text "steady on click" - } -} - -proc iemgui_apply {id} { - set vid [string trimleft $id .] - - set var_iemgui_wdt [concat iemgui_wdt_$vid] - global $var_iemgui_wdt - set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] - global $var_iemgui_min_wdt - set var_iemgui_hgt [concat iemgui_hgt_$vid] - global $var_iemgui_hgt - set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] - global $var_iemgui_min_hgt - set var_iemgui_min_rng [concat iemgui_min_rng_$vid] - global $var_iemgui_min_rng - set var_iemgui_max_rng [concat iemgui_max_rng_$vid] - global $var_iemgui_max_rng - set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] - global $var_iemgui_lin0_log1 - set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] - global $var_iemgui_lilo0 - set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] - global $var_iemgui_lilo1 - set var_iemgui_loadbang [concat iemgui_loadbang_$vid] - global $var_iemgui_loadbang - set var_iemgui_num [concat iemgui_num_$vid] - global $var_iemgui_num - set var_iemgui_steady [concat iemgui_steady_$vid] - global $var_iemgui_steady - set var_iemgui_snd [concat iemgui_snd_$vid] - global $var_iemgui_snd - set var_iemgui_rcv [concat iemgui_rcv_$vid] - global $var_iemgui_rcv - set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid] - global $var_iemgui_gui_nam - set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid] - global $var_iemgui_gn_dx - set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid] - global $var_iemgui_gn_dy - set var_iemgui_gn_f [concat iemgui_gn_f_$vid] - global $var_iemgui_gn_f - set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] - global $var_iemgui_gn_fs - set var_iemgui_bcol [concat iemgui_bcol_$vid] - global $var_iemgui_bcol - set var_iemgui_fcol [concat iemgui_fcol_$vid] - global $var_iemgui_fcol - set var_iemgui_lcol [concat iemgui_lcol_$vid] - global $var_iemgui_lcol - - iemgui_clip_dim $id - iemgui_clip_num $id - iemgui_sched_rng $id - iemgui_verify_rng $id - iemgui_sched_rng $id - iemgui_clip_fontsize $id - - if {[eval concat $$var_iemgui_snd] == ""} {set hhhsnd "empty"} else {set hhhsnd [eval concat $$var_iemgui_snd]} - if {[eval concat $$var_iemgui_rcv] == ""} {set hhhrcv "empty"} else {set hhhrcv [eval concat $$var_iemgui_rcv]} - if {[eval concat $$var_iemgui_gui_nam] == ""} {set hhhgui_nam "empty" - } else { - set hhhgui_nam [eval concat $$var_iemgui_gui_nam]} - - if {[string index $hhhsnd 0] == "$"} { - set hhhsnd [string replace $hhhsnd 0 0 #] } - if {[string index $hhhrcv 0] == "$"} { - set hhhrcv [string replace $hhhrcv 0 0 #] } - if {[string index $hhhgui_nam 0] == "$"} { - set hhhgui_nam [string replace $hhhgui_nam 0 0 #] } - - set hhhsnd [pdtk_unspace $hhhsnd] - set hhhrcv [pdtk_unspace $hhhrcv] - set hhhgui_nam [pdtk_unspace $hhhgui_nam] - - pd [concat $id dialog \ - [eval concat $$var_iemgui_wdt] \ - [eval concat $$var_iemgui_hgt] \ - [eval concat $$var_iemgui_min_rng] \ - [eval concat $$var_iemgui_max_rng] \ - [eval concat $$var_iemgui_lin0_log1] \ - [eval concat $$var_iemgui_loadbang] \ - [eval concat $$var_iemgui_num] \ - $hhhsnd \ - $hhhrcv \ - $hhhgui_nam \ - [eval concat $$var_iemgui_gn_dx] \ - [eval concat $$var_iemgui_gn_dy] \ - [eval concat $$var_iemgui_gn_f] \ - [eval concat $$var_iemgui_gn_fs] \ - [eval concat $$var_iemgui_bcol] \ - [eval concat $$var_iemgui_fcol] \ - [eval concat $$var_iemgui_lcol] \ - [eval concat $$var_iemgui_steady] \ - \;] -} - -proc iemgui_cancel {id} {pd [concat $id cancel \;]} - -proc iemgui_ok {id} { - iemgui_apply $id - iemgui_cancel $id -} - -proc pdtk_iemgui_dialog {id mainheader \ - dim_header wdt min_wdt wdt_label hgt min_hgt hgt_label \ - rng_header min_rng min_rng_label max_rng max_rng_label rng_sched \ - lin0_log1 lilo0_label lilo1_label loadbang steady num_label num \ - snd rcv \ - gui_name \ - gn_dx gn_dy \ - gn_f gn_fs \ - bcol fcol lcol} { - - set vid [string trimleft $id .] - - global pd_nt - global fontname fontweight - - set var_iemgui_wdt [concat iemgui_wdt_$vid] - global $var_iemgui_wdt - set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] - global $var_iemgui_min_wdt - set var_iemgui_hgt [concat iemgui_hgt_$vid] - global $var_iemgui_hgt - set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] - global $var_iemgui_min_hgt - set var_iemgui_min_rng [concat iemgui_min_rng_$vid] - global $var_iemgui_min_rng - set var_iemgui_max_rng [concat iemgui_max_rng_$vid] - global $var_iemgui_max_rng - set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid] - global $var_iemgui_rng_sch - set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] - global $var_iemgui_lin0_log1 - set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] - global $var_iemgui_lilo0 - set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] - global $var_iemgui_lilo1 - set var_iemgui_loadbang [concat iemgui_loadbang_$vid] - global $var_iemgui_loadbang - set var_iemgui_num [concat iemgui_num_$vid] - global $var_iemgui_num - set var_iemgui_steady [concat iemgui_steady_$vid] - global $var_iemgui_steady - set var_iemgui_snd [concat iemgui_snd_$vid] - global $var_iemgui_snd - set var_iemgui_rcv [concat iemgui_rcv_$vid] - global $var_iemgui_rcv - set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid] - global $var_iemgui_gui_nam - set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid] - global $var_iemgui_gn_dx - set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid] - global $var_iemgui_gn_dy - set var_iemgui_gn_f [concat iemgui_gn_f_$vid] - global $var_iemgui_gn_f - set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] - global $var_iemgui_gn_fs - set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] - global $var_iemgui_l2_f1_b0 - set var_iemgui_bcol [concat iemgui_bcol_$vid] - global $var_iemgui_bcol - set var_iemgui_fcol [concat iemgui_fcol_$vid] - global $var_iemgui_fcol - set var_iemgui_lcol [concat iemgui_lcol_$vid] - global $var_iemgui_lcol - - set $var_iemgui_wdt $wdt - set $var_iemgui_min_wdt $min_wdt - set $var_iemgui_hgt $hgt - set $var_iemgui_min_hgt $min_hgt - set $var_iemgui_min_rng $min_rng - set $var_iemgui_max_rng $max_rng - set $var_iemgui_rng_sch $rng_sched - set $var_iemgui_lin0_log1 $lin0_log1 - set $var_iemgui_lilo0 $lilo0_label - set $var_iemgui_lilo1 $lilo1_label - set $var_iemgui_loadbang $loadbang - set $var_iemgui_num $num - set $var_iemgui_steady $steady - if {$snd == "empty"} {set $var_iemgui_snd [format ""] - } else {set $var_iemgui_snd [format "%s" $snd]} - if {$rcv == "empty"} {set $var_iemgui_rcv [format ""] - } else {set $var_iemgui_rcv [format "%s" $rcv]} - if {$gui_name == "empty"} {set $var_iemgui_gui_nam [format ""] - } else {set $var_iemgui_gui_nam [format "%s" $gui_name]} - - if {[string index [eval concat $$var_iemgui_snd] 0] == "#"} { - set $var_iemgui_snd [string replace [eval concat $$var_iemgui_snd] 0 0 $] } - if {[string index [eval concat $$var_iemgui_rcv] 0] == "#"} { - set $var_iemgui_rcv [string replace [eval concat $$var_iemgui_rcv] 0 0 $] } - if {[string index [eval concat $$var_iemgui_gui_nam] 0] == "#"} { - set $var_iemgui_gui_nam [string replace [eval concat $$var_iemgui_gui_nam] 0 0 $] } - set $var_iemgui_gn_dx $gn_dx - set $var_iemgui_gn_dy $gn_dy - set $var_iemgui_gn_f $gn_f - set $var_iemgui_gn_fs $gn_fs - - set $var_iemgui_bcol $bcol - set $var_iemgui_fcol $fcol - set $var_iemgui_lcol $lcol - - set $var_iemgui_l2_f1_b0 0 - - toplevel $id - wm title $id [format "%s Properties" $mainheader] - wm resizable $id 0 0 - wm protocol $id WM_DELETE_WINDOW [concat iemgui_cancel $id] - - frame $id.dim - pack $id.dim -side top - label $id.dim.head -text $dim_header - label $id.dim.w_lab -text $wdt_label -width 6 - entry $id.dim.w_ent -textvariable $var_iemgui_wdt -width 5 - label $id.dim.dummy1 -text " " -width 10 - label $id.dim.h_lab -text $hgt_label -width 6 - entry $id.dim.h_ent -textvariable $var_iemgui_hgt -width 5 - pack $id.dim.head -side top - pack $id.dim.w_lab $id.dim.w_ent $id.dim.dummy1 -side left - if { $hgt_label != "empty" } { - pack $id.dim.h_lab $id.dim.h_ent -side left} - - frame $id.rng - pack $id.rng -side top - label $id.rng.head -text $rng_header - label $id.rng.min_lab -text $min_rng_label -width 6 - entry $id.rng.min_ent -textvariable $var_iemgui_min_rng -width 9 - label $id.rng.dummy1 -text " " -width 1 - label $id.rng.max_lab -text $max_rng_label -width 8 - entry $id.rng.max_ent -textvariable $var_iemgui_max_rng -width 9 - if { $rng_header != "empty" } { - pack $id.rng.head -side top - if { $min_rng_label != "empty" } { - pack $id.rng.min_lab $id.rng.min_ent -side left} - if { $max_rng_label != "empty" } { - pack $id.rng.dummy1 \ - $id.rng.max_lab $id.rng.max_ent -side left} } - - if { [eval concat $$var_iemgui_lin0_log1] >= 0 || [eval concat $$var_iemgui_loadbang] >= 0 || [eval concat $$var_iemgui_num] > 0 || [eval concat $$var_iemgui_steady] >= 0 } { - label $id.space1 -text "" - pack $id.space1 -side top } - - frame $id.para - pack $id.para -side top - label $id.para.dummy2 -text "" -width 1 - label $id.para.dummy3 -text "" -width 1 - if {[eval concat $$var_iemgui_lin0_log1] == 0} { - button $id.para.lilo -text [eval concat $$var_iemgui_lilo0] -width 5 -command "iemgui_lilo $id" } - if {[eval concat $$var_iemgui_lin0_log1] == 1} { - button $id.para.lilo -text [eval concat $$var_iemgui_lilo1] -width 5 -command "iemgui_lilo $id" } - if {[eval concat $$var_iemgui_loadbang] == 0} { - button $id.para.lb -text "no init" -width 5 -command "iemgui_lb $id" } - if {[eval concat $$var_iemgui_loadbang] == 1} { - button $id.para.lb -text "init" -width 5 -command "iemgui_lb $id" } - label $id.para.num_lab -text $num_label -width 9 - entry $id.para.num_ent -textvariable $var_iemgui_num -width 4 - if {[eval concat $$var_iemgui_steady] == 0} { - button $id.para.stdy_jmp -text "jump on click" -width 11 -command "iemgui_stdy_jmp $id" } - if {[eval concat $$var_iemgui_steady] == 1} { - button $id.para.stdy_jmp -text "steady on click" -width 11 -command "iemgui_stdy_jmp $id" } - if {[eval concat $$var_iemgui_lin0_log1] >= 0} { - pack $id.para.lilo -side left -expand 1} - if {[eval concat $$var_iemgui_loadbang] >= 0} { - pack $id.para.dummy2 $id.para.lb -side left -expand 1} - if {[eval concat $$var_iemgui_num] > 0} { - pack $id.para.dummy3 $id.para.num_lab $id.para.num_ent -side left -expand 1} - if {[eval concat $$var_iemgui_steady] >= 0} { - pack $id.para.dummy3 $id.para.stdy_jmp -side left -expand 1} - - frame $id.spacer0 -height 4 - pack $id.spacer0 -side top - - labelframe $id.s_r -borderwidth 1 -pady 4 -text "messages" \ - -font highlight_font - pack $id.s_r -side top -fill x -ipadx 5 - frame $id.s_r.send - pack $id.s_r.send -side top - label $id.s_r.send.lab -text " send-symbol:" -width 12 -justify right - entry $id.s_r.send.ent -textvariable $var_iemgui_snd -width 22 - if { $snd != "nosndno" } { - pack $id.s_r.send.lab $id.s_r.send.ent -side left} - - frame $id.s_r.receive - pack $id.s_r.receive -side top - label $id.s_r.receive.lab -text "receive-symbol:" -width 12 -justify right - entry $id.s_r.receive.ent -textvariable $var_iemgui_rcv -width 22 - if { $rcv != "norcvno" } { - pack $id.s_r.receive.lab $id.s_r.receive.ent -side left} - -# get the current font name from the int given from C-space (gn_f) - set current_font $fontname - if {[eval concat $$var_iemgui_gn_f] == 1} \ - { set current_font "Helvetica" } - if {[eval concat $$var_iemgui_gn_f] == 2} \ - { set current_font "Times" } - - frame $id.spacer1 -height 7 - pack $id.spacer1 -side top - - labelframe $id.label -borderwidth 1 -text "label" -pady 4 \ - -font highlight_font - pack $id.label -side top -fill x - entry $id.label.name_entry -textvariable $var_iemgui_gui_nam -width 30 \ - -font [list $current_font 12 $fontweight] - pack $id.label.name_entry -side top -expand yes -fill both -padx 5 - - frame $id.label.xy -padx 27 -pady 1 - pack $id.label.xy -side top - label $id.label.xy.x_lab -text "x offset" -width 6 - entry $id.label.xy.x_entry -textvariable $var_iemgui_gn_dx -width 5 - label $id.label.xy.dummy1 -text " " -width 2 - label $id.label.xy.y_lab -text "y offset" -width 6 - entry $id.label.xy.y_entry -textvariable $var_iemgui_gn_dy -width 5 - pack $id.label.xy.x_lab $id.label.xy.x_entry $id.label.xy.dummy1 \ - $id.label.xy.y_lab $id.label.xy.y_entry -side left -anchor e - - label $id.label.fontpopup_label -text $current_font \ - -relief groove -font [list $current_font 12 $fontweight] -padx 5 - pack $id.label.fontpopup_label -side left -anchor w -expand yes -fill x - label $id.label.fontsize_label -text "size" -width 4 - entry $id.label.fontsize_entry -textvariable $var_iemgui_gn_fs -width 5 - pack $id.label.fontsize_entry $id.label.fontsize_label \ - -side right -anchor e -padx 5 -pady 5 - menu $id.popup - $id.popup add command \ - -label $fontname \ - -font [format {{%s} 12 %s} $fontname $fontweight] \ - -command "iemgui_toggle_font $id 0" - $id.popup add command \ - -label "Helvetica" \ - -font [format {Helvetica 12 %s} $fontweight] \ - -command "iemgui_toggle_font $id 1" - $id.popup add command \ - -label "Times" \ - -font [format {Times 12 %s} $fontweight] \ - -command "iemgui_toggle_font $id 2" - bind $id.label.fontpopup_label <Button> \ - [list tk_popup $id.popup %X %Y] - - frame $id.spacer2 -height 7 - pack $id.spacer2 -side top - - labelframe $id.colors -borderwidth 1 -text "colors" -font highlight_font @@ Diff output truncated at 100000 characters. @@ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

1 0

SF.net SVN: pure-data:[10457] branches/pd-devel/0.41.4/src/pd.tk
by chunlee＠users.sourceforge.net 23 Dec '08

23 Dec '08

Revision: 10457 http://pure-data.svn.sourceforge.net/pure-data/?rev=10457&view=rev Author: chunlee Date: 2008-12-23 06:27:37 +0000 (Tue, 23 Dec 2008) Log Message: ----------- initial commit of pd.tk, copied from u_main.tk Added Paths: ----------- branches/pd-devel/0.41.4/src/pd.tk Added: branches/pd-devel/0.41.4/src/pd.tk =================================================================== --- branches/pd-devel/0.41.4/src/pd.tk (rev 0) +++ branches/pd-devel/0.41.4/src/pd.tk 2008-12-23 06:27:37 UTC (rev 10457) @@ -0,0 +1,4397 @@ +#!/usr/bin/wish +# 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########## + +# 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 + set defaultFontFamily {Bitstream Vera Sans Mono} + set defaultFontWeight normal + font create menuFont -family Tahoma -size -11 +} elseif { $tcl_platform(os) == "Darwin" } { + set pd_nt 2 + set defaultFontFamily Monaco + set defaultFontWeight normal +} else { + set pd_nt 0 + set defaultFontFamily Courier + set defaultFontWeight bold +} + +# start Pd-extended font hacks ----------------------------- + +# Pd-0.39.2-extended hacks to make font/box sizes the same across platform +# puts stderr "tk scaling is [tk scaling]" +# tk scaling 1 + +# this font is for the Pd Window console text +font create console_font -family $defaultFontFamily -size -12 \ + -weight $defaultFontWeight +# this font is for text in Pd windows +font create text_font -family {Times} -size -14 -weight normal +# for text in Properties Panels and other panes +font create highlight_font -family $defaultFontFamily -size -14 -weight bold + +# end Pd-extended font hacks ----------------------------- + + +# 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 +# anti-alias all lines that need it + 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 <Key-Tab> "" +bind all <<PrevWindow>> "" +bind Text <Control-t> {} +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 + +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 +} + +# fix menu font size on Windows with tk scaling = 1 +if {$pd_nt == 1} { + .mbar.file configure -font menuFont + .mbar.find configure -font menuFont + .mbar.windows configure -font menuFont + .mbar.audio configure -font menuFont + .mbar.help configure -font menuFont +} + +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 \ + -command {pd [concat pd dsp $ctrls_audio_on \;]} + +checkbutton .controls.switches.meterbutton -text {peak meters} \ + -variable ctrls_meter_on \ + -command {pd [concat pd meters $ctrls_meter_on \;]} + +pack .controls.switches.audiobutton .controls.switches.meterbutton \ + -side top -anchor w + +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 console_font \ + -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 <Control-Key> {pdtk_pd_ctrlkey %W %K 0} + bind $id <Control-Shift-Key> {pdtk_pd_ctrlkey %W %K 1} + if {$pd_nt == 2} { + bind $id <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0} + bind $id <Mod1-Shift-Key> {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 <Drop> { + 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 <KeyPress-Return> { + 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 text_font \ + -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} { + foreach candidate \ + { gnome-open xdg-open sensible-browser iceweasel firefox mozilla \ + galeon konqueror netscape lynx } { + set browser [lindex [auto_execok $candidate] 0] + if {[string length $browser]} { + puts stderr [format "%s %s" $browser $filename] + exec -- sh -c [format "%s %s" $browser $filename] & + break + } + } + } 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 <Button-1> [list doc_navigate $dir $count %W %x %y] + bind $current_listbox <Double-Button-1> [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. <hans(a)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} { + $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 <KeyPress-Return> [ 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 + # if we're a mac, refuse to make window so big you can't get to + # the resizing control + if {$pd_nt == 2} { + if {$width > [winfo screenwidth $name] - 80} { + set width [expr [winfo screenwidth $name] - 80] + } + if {$height > [winfo screenheight $name] - 80} { + set height [expr [winfo screenheight $name] - 80] + } + } + +# 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); +# <hans(a)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 + + 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] + +# fix menu font size on Windows with tk scaling = 1 +if {$pd_nt == 1} { + $name.m.file configure -font menuFont + $name.m.edit configure -font menuFont + $name.m.find configure -font menuFont + $name.m.put configure -font menuFont + $name.m.windows configure -font menuFont + $name.m.audio configure -font menuFont + $name.m.help configure -font menuFont + $name.popup configure -font menuFont +} + +# 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 <Mod1-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 + set pd_array_listview_page($arrayName) $page +} + +proc pdtk_array_listview_changepage {arrayName np} { + global pd_array_listview_page + pdtk_array_listview_setpage \ + $arrayName [expr $pd_array_listview_page($arrayName) + $np] + pdtk_array_listview_fillpage $arrayName +} + +proc pdtk_array_listview_fillpage {arrayName} { + global pd_array_listview_page + global pd_array_listview_id + set windowName [format ".%sArrayWindow" $arrayName] + set topItem [expr [lindex [$windowName.lb yview] 0] * \ + [$windowName.lb size]] + + if {[winfo exists $windowName]} { + set cmd "$pd_array_listview_id($arrayName) \ + arrayviewlistfillpage \ + $pd_array_listview_page($arrayName) \ + $topItem" + + pd [concat $cmd \;] + } +} + +proc pdtk_array_listview_new {id arrayName page} { + global pd_nt + global pd_array_listview_page + global pd_array_listview_id + global fontname fontweight + set pd_array_listview_page($arrayName) $page + set pd_array_listview_id($arrayName) $id + set windowName [format ".%sArrayWindow" $arrayName] + if [winfo exists $windowName] then [destroy $windowName] + toplevel $windowName + wm protocol $windowName WM_DELETE_WINDOW \ + "pdtk_array_listview_close $id $arrayName" + wm title $windowName [concat $arrayName "(list view)"] + # FIXME + set font 12 + set $windowName.lb [listbox $windowName.lb -height 20 -width 25\ + -selectmode extended \ + -relief solid -background white -borderwidth 1 \ + -font [format {{%s} %d %s} $fontname $font $fontweight]\ + -yscrollcommand "$windowName.lb.sb set"] + set $windowName.lb.sb [scrollbar $windowName.lb.sb \ + -command "$windowName.lb yview" -orient vertical] + place configure $windowName.lb.sb -relheight 1 -relx 0.9 -relwidth 0.1 + pack $windowName.lb -expand 1 -fill both + bind $windowName.lb <Double-ButtonPress-1> \ + "pdtk_array_listview_edit $arrayName $page $font" + # handle copy/paste + if {$pd_nt == 0} { + selection handle $windowName.lb \ + "pdtk_array_listview_lbselection $arrayName" + } else { + if {$pd_nt == 1} { + bind $windowName.lb <ButtonPress-3> \ + "pdtk_array_listview_popup $arrayName" + } + } + set $windowName.prevBtn [button $windowName.prevBtn -text "<-" \ + -command "pdtk_array_listview_changepage $arrayName -1"] + set $windowName.nextBtn [button $windowName.nextBtn -text "->" \ + -command "pdtk_array_listview_changepage $arrayName 1"] + pack $windowName.prevBtn -side left -ipadx 20 -pady 10 -anchor s + pack $windowName.nextBtn -side right -ipadx 20 -pady 10 -anchor s + focus $windowName +} + +proc pdtk_array_listview_lbselection {arrayName off size} { + set windowName [format ".%sArrayWindow" $arrayName] + set itemNums [$windowName.lb curselection] + set cbString "" + for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} { + set listItem [$windowName.lb get [lindex $itemNums $i]] + append cbString [string range $listItem \ + [expr [string first ") " $listItem] + 2] \ + end] + append cbString "\n" + } + set listItem [$windowName.lb get [lindex $itemNums $i]] + append cbString [string range $listItem \ + [expr [string first ") " $listItem] + 2] \ + end] + set last $cbString +} + +# Win32 uses a popup menu for copy/paste +proc pdtk_array_listview_popup {arrayName} { + set windowName [format ".%sArrayWindow" $arrayName] + if [winfo exists $windowName.popup] then [destroy $windowName.popup] + menu $windowName.popup -tearoff false + $windowName.popup add command -label {Copy} \ + -command "pdtk_array_listview_copy $arrayName; \ + destroy $windowName.popup" + $windowName.popup add command -label {Paste} \ + -command "pdtk_array_listview_paste $arrayName; \ + destroy $windowName.popup" + tk_popup $windowName.popup [winfo pointerx $windowName] \ + [winfo pointery $windowName] 0 +} + +proc pdtk_array_listview_copy {arrayName} { + set windowName [format ".%sArrayWindow" $arrayName] + set itemNums [$windowName.lb curselection] + set cbString "" + for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} { + set listItem [$windowName.lb get [lindex $itemNums $i]] + append cbString [string range $listItem \ + [expr [string first ") " $listItem] + 2] \ + end] + append cbString "\n" + } + set listItem [$windowName.lb get [lindex $itemNums $i]] + append cbString [string range $listItem \ + [expr [string first ") " $listItem] + 2] \ + end] + clipboard clear + clipboard append $cbString +} + +proc pdtk_array_listview_paste {arrayName} { + global pd_array_listview_page + global pd_array_listview_pagesize + set cbString [selection get -selection CLIPBOARD] + set lbName [format ".%sArrayWindow.lb" $arrayName] + set itemNum [lindex [$lbName curselection] 0] + set splitChars ", \n" + set itemString [split $cbString $splitChars] + set flag 1 + for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} { + if {[lindex $itemString $i] != {}} { + pd [concat $arrayName [expr $itemNum + \ + [expr $counter + \ + [expr $pd_array_listview_pagesize \ + * $pd_array_listview_page($arrayName)]]] \ + [lindex $itemString $i] \;] + incr counter + set flag 0 + } + } +} + +proc pdtk_array_listview_edit {arrayName page font} { + global pd_array_listview_entry + global pd_nt + global fontname fontweight + set lbName [format ".%sArrayWindow.lb" $arrayName] + if {[winfo exists $lbName.entry]} { + pdtk_array_listview_update_entry \ + $arrayName $pd_array_listview_entry($arrayName) + unset pd_array_listview_entry($arrayName) + } + set itemNum [$lbName index active] + set pd_array_listview_entry($arrayName) $itemNum + set bbox [$lbName bbox $itemNum] + set y [expr [lindex $bbox 1] - 4] + set $lbName.entry [entry $lbName.entry \ + -font [format {{%s} %d %s} $fontname $font $fontweight]] + $lbName.entry insert 0 [] + place configure $lbName.entry -relx 0 -y $y -relwidth 1 + lower $lbName.entry + focus $lbName.entry + bind $lbName.entry <Return> \ + "pdtk_array_listview_update_entry $arrayName $itemNum;" +} + +proc pdtk_array_listview_update_entry {arrayName itemNum} { + global pd_array_listview_page + global pd_array_listview_pagesize + set lbName [format ".%sArrayWindow.lb" $arrayName] + set splitChars ", \n" + set itemString [split [$lbName.entry get] $splitChars] + set flag 1 + for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} { + if {[lindex $itemString $i] != {}} { + pd [concat $arrayName [expr $itemNum + \ + [expr $counter + \ + [expr $pd_array_listview_pagesize \ + * $pd_array_listview_page($arrayName)]]] \ + [lindex $itemString $i] \;] + incr counter + set flag 0 + } + } + pdtk_array_listview_fillpage $arrayName + destroy $lbName.entry +} + +proc pdtk_array_listview_closeWindow {arrayName} { + set windowName [format ".%sArrayWindow" $arrayName] + destroy $windowName +} + +proc pdtk_array_listview_close {id arrayName} { + pdtk_array_listview_closeWindow $arrayName + set cmd [concat $id "arrayviewclose" \;] + pd $cmd +} +##### end jsarlo ##### + +#################### event binding procedures ################ + +#get the name of the toplevel window for a canvas; this is also +#the name of the canvas object in Pd. + +proc canvastosym {name} { + string range $name 0 [expr [string length $name] - 3] +} + +set pdtk_lastcanvasconfigured "" +set pdtk_lastcanvasconfiguration "" +set pdtk_lastcanvasconfiguration2 "" + +proc pdtk_canvas_checkgeometry {topname} { + set boo [winfo geometry $topname.c] + set boo2 [wm geometry $topname] + global pdtk_lastcanvasconfigured + global pdtk_lastcanvasconfiguration + global pdtk_lastcanvasconfiguration2 + if {$topname != $pdtk_lastcanvasconfigured || \ + $boo != $pdtk_lastcanvasconfiguration || \ + $boo2 != $pdtk_lastcanvasconfiguration2} { + set pdtk_lastcanvasconfigured $topname + set pdtk_lastcanvasconfiguration $boo + set pdtk_lastcanvasconfiguration2 $boo2 + pd $topname relocate $boo $boo2 \; + } +} + +proc pdtk_canvas_click {name x y b f} { + global pd_nt + if {$pd_nt == 0} {focus $name} + pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b $f \; +} + +proc pdtk_canvas_shiftclick {name x y b} { + pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 1 \; +} + +proc pdtk_canvas_ctrlclick {name x y b} { + pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 2 \; +} + +proc pdtk_canvas_altclick {name x y b} { + pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 3 \; +} + +proc pdtk_canvas_dblclick {name x y b} { + pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 4 \; +} + +set pdtk_canvas_mouseup_name 0 +set pdtk_canvas_mouseup_xminval 0 +set pdtk_canvas_mouseup_xmaxval 0 +set pdtk_canvas_mouseup_yminval 0 +set pdtk_canvas_mouseup_ymaxval 0 + +proc pdtk_canvas_mouseup {name x y b} { + pd [concat [canvastosym $name] mouseup [$name canvasx $x] \ + [$name canvasy $y] $b \;] +} + +proc pdtk_canvas_getscroll {name} { + global pdtk_canvas_mouseup_name + global pdtk_canvas_mouseup_xminval + global pdtk_canvas_mouseup_xmaxval + global pdtk_canvas_mouseup_yminval + global pdtk_canvas_mouseup_ymaxval + + set size [$name bbox all] + if {$size != ""} { + set xminval 0 + set yminval 0 + set xmaxval 100 + set ymaxval 100 + set x1 [lindex $size 0] + set x2 [lindex $size 2] + set y1 [lindex $size 1] + set y2 [lindex $size 3] + + if {$x1 < 0} {set xminval $x1} + if {$y1 < 0} {set yminval $y1} + + if {$x2 > 100} {set xmaxval $x2} + if {$y2 > 100} {set ymaxval $y2} + + if {$pdtk_canvas_mouseup_name != $name || \ + $pdtk_canvas_mouseup_xminval != $xminval || \ + $pdtk_canvas_mouseup_xmaxval != $xmaxval || \ + $pdtk_canvas_mouseup_yminval != $yminval || \ + $pdtk_canvas_mouseup_ymaxval != $ymaxval } { + + set newsize "$xminval $yminval $xmaxval $ymaxval" + $name configure -scrollregion $newsize + set pdtk_canvas_mouseup_name $name + set pdtk_canvas_mouseup_xminval $xminval + set pdtk_canvas_mouseup_xmaxval $xmaxval + set pdtk_canvas_mouseup_yminval $yminval + set pdtk_canvas_mouseup_ymaxval $ymaxval + } + + } + pdtk_canvas_checkgeometry [canvastosym $name] +} + +proc pdtk_canvas_key {name key iso shift} { +# puts stderr [concat down key= $key iso= $iso] +# .controls.switches.meterbutton configure -text $key +# HACK for MAC OSX -- backspace seems different; I don't understand why. +# invesigate this LATER... + global pd_nt + if {$pd_nt == 2} { + if {$key == "BackSpace"} { + set key 8 + set keynum 8 + } + if {$key == "Delete"} { + set key 8 + set keynum 8 + } + } + if {$key == "KP_Delete"} { + set key 127 + set keynum 127 + } + if {$iso != ""} { + scan $iso %c keynum + pd [canvastosym $name] key 1 $keynum $shift\; + } else { + pd [canvastosym $name] key 1 $key $shift\; + } +} + +proc pdtk_canvas_keyup {name key iso} { +# puts stderr [concat up key= $key iso= $iso] + if {$iso != ""} { + scan $iso %c keynum + pd [canvastosym $name] key 0 $keynum 0 \; + } else { + pd [canvastosym $name] key 0 $key 0 \; + } +} + +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 == "1"} {menu_object $topname 1} + if {$key == "2"} {menu_message $topname 1} + if {$key == "3"} {menu_floatatom $topname 1} + if {$key == "4"} {menu_symbolatom $topname 1} + if {$key == "5"} {menu_comment $topname 1} + if {$key == "slash"} {menu_audio 1} + if {$key == "period"} {menu_audio 0} + if {$shift == 1} { + if {$key == "q" || $key == "Q"} {menu_really_quit} + if {$key == "w" || $key == "W"} {menu_really_close $topname} + 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} { +# puts stderr [concat [canvastosym $name] $name $x $y] + pd [canvastosym $name] motion [$name canvasx $x] [$name canvasy $y] $mods \; +} + +# "map" event tells us when the canvas becomes visible (arg is "0") or +# invisible (arg is ""). Invisibility means the Window Manager has minimized +# us. We don't get a final "unmap" event when we destroy the window. +proc pdtk_canvas_map {name} { +# puts stderr [concat map $name] + pd [canvastosym $name] map 1 \; +} + +proc pdtk_canvas_unmap {name} { +# puts stderr [concat 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 ############## + +proc pdtk_canvas_saveas {name initfile initdir} { + global pd_nt + set filename [tk_getSaveFile -initialfile $initfile \ + -initialdir $initdir -defaultextension .pd \ + -filetypes { {{pd files} {.pd}} {{max files} {.pat}} }] + + if {$filename != ""} { +# yes, we need the extent even if we're on a mac. + if {$pd_nt == 2} { + if {[string last .pd $filename] < 0 && \ + [string last .PD $filename] < 0 && \ + [string last .pat $filename] < 0 && \ + [string last .PAT $filename] < 0} { + set filename $filename.pd + if {[file exists $filename]} { + set answer [tk_messageBox \ + \-message [concat overwrite $filename "?"] \ + \-type yesno \-icon question] + if {! [string compare $answer no]} {return} + } + } + } + + set directory [string range $filename 0 \ + [expr [string last / $filename ] - 1]] + set basename [string range $filename \ + [expr [string last / $filename ] + 1] end] + pd [concat $name savetofile [pdtk_enquote $basename] \ + [pdtk_enquote $directory] \;] +# pd [concat $name savetofile $basename $directory \;] + } +} + +############ pdtk_canvas_dofont -- run a font and resize dialog ######### + +set fontsize 0 +set stretchval 0 +set whichstretch 0 + +proc dofont_apply {name} { + global fontsize + global stretchval + global whichstretch + set cmd [concat $name font $fontsize $stretchval $whichstretch \;] +# puts stderr $cmd + pd $cmd +} + +proc dofont_cancel {name} { + set cmd [concat $name cancel \;] +# puts stderr $cmd + pd $cmd +} + +proc pdtk_canvas_dofont {name initsize} { + + global fontsize + set fontsize $initsize + + global stretchval + set stretchval 100 + + global whichstretch + set whichstretch 1 + + toplevel $name + wm title $name {FONT BOMB} + wm protocol $name WM_DELETE_WINDOW [concat dofont_cancel $name] + + frame $name.buttonframe + pack $name.buttonframe -side bottom -fill x -pady 2m + button $name.buttonframe.cancel -text {Cancel}\ + -command "dofont_cancel $name" + button $name.buttonframe.ok -text {Do it}\ + -command "dofont_apply $name" + pack $name.buttonframe.cancel -side left -expand 1 + pack $name.buttonframe.ok -side left -expand 1 + + frame $name.radiof + pack $name.radiof -side left + + label $name.radiof.label -text {Font Size:} + pack $name.radiof.label -side top + + radiobutton $name.radiof.radio8 -value 8 -variable fontsize -text "8" + radiobutton $name.radiof.radio10 -value 10 -variable fontsize -text "10" + radiobutton $name.radiof.radio12 -value 12 -variable fontsize -text "12" + radiobutton $name.radiof.radio16 -value 16 -variable fontsize -text "16" + radiobutton $name.radiof.radio24 -value 24 -variable fontsize -text "24" + radiobutton $name.radiof.radio36 -value 36 -variable fontsize -text "36" + pack $name.radiof.radio8 -side top -anchor w + pack $name.radiof.radio10 -side top -anchor w + pack $name.radiof.radio12 -side top -anchor w + pack $name.radiof.radio16 -side top -anchor w + pack $name.radiof.radio24 -side top -anchor w + pack $name.radiof.radio36 -side top -anchor w + + frame $name.stretchf + pack $name.stretchf -side left + + label $name.stretchf.label -text {Stretch:} + pack $name.stretchf.label -side top + + entry $name.stretchf.entry -textvariable stretchval -width 5 + pack $name.stretchf.entry -side left + + radiobutton $name.stretchf.radio1 \ + -value 1 -variable whichstretch -text "X and Y" + radiobutton $name.stretchf.radio2 \ + -value 2 -variable whichstretch -text "X only" + radiobutton $name.stretchf.radio3 \ + -value 3 -variable whichstretch -text "Y only" + + pack $name.stretchf.radio1 -side top -anchor w + pack $name.stretchf.radio2 -side top -anchor w + pack $name.stretchf.radio3 -side top -anchor w + +} + +############ pdtk_gatom_dialog -- run a gatom dialog ######### + +# dialogs like this one can come up in many copies; but in TK the easiest +# way to get data from an "entry", etc., is to set an associated variable +# name. This is especially true for grouped "radio buttons". So we have +# to synthesize variable names for each instance of the dialog. The dialog +# gets a TK pathname $id, from which it strips the leading "." to make a +# variable suffix $vid. Then you can get the actual value out by asking for +# [eval concat $$variablename]. There should be an easier way but I don't see +# it yet. + +proc gatom_escape {sym} { + if {[string length $sym] == 0} { + set ret "-" +# puts stderr [concat escape1 $sym $ret] + } else { + if {[string equal -length 1 $sym "-"]} { + set ret [string replace $sym 0 0 "--"] +# puts stderr [concat escape $sym $ret] + } else { + set ret [string map {"$" "#"} $sym] +# puts stderr [concat unescape $sym $ret] + } + } + pdtk_unspace $ret +} + +proc gatom_unescape {sym} { + if {[string equal -length 1 $sym "-"]} { + set ret [string replace $sym 0 0 ""] +# puts stderr [concat unescape $sym $ret] + } else { + set ret [string map {"#" "$"} $sym] +# puts stderr [concat unescape $sym $ret] + } + concat $ret +} + +proc dogatom_apply {id} { + set vid [string trimleft $id .] + + set var_gatomwidth [concat gatomwidth_$vid] + global $var_gatomwidth + set var_gatomlo [concat gatomlo_$vid] + global $var_gatomlo + set var_gatomhi [concat gatomhi_$vid] + global $var_gatomhi + set var_gatomwherelabel [concat gatomwherelabel_$vid] + global $var_gatomwherelabel + set var_gatomlabel [concat gatomlabel_$vid] + global $var_gatomlabel + set var_gatomsymfrom [concat gatomsymfrom_$vid] + global $var_gatomsymfrom + set var_gatomsymto [concat gatomsymto_$vid] + global $var_gatomsymto + +# set cmd [concat $id param $gatomwidth $gatomlo $gatomhi \;] + + set cmd [concat $id param \ + [eval concat $$var_gatomwidth] \ + [eval concat $$var_gatomlo] \ + [eval concat $$var_gatomhi] \ + [eval gatom_escape $$var_gatomlabel] \ + [eval concat $$var_gatomwherelabel] \ + [eval gatom_escape $$var_gatomsymfrom] \ + [eval gatom_escape $$var_gatomsymto] \ + \;] + +# puts stderr $cmd + pd $cmd +} + +proc dogatom_cancel {name} { + set cmd [concat $name cancel \;] +# puts stderr $cmd + pd $cmd +} + +proc dogatom_ok {name} { + dogatom_apply $name + dogatom_cancel $name +} + +proc pdtk_gatom_dialog {id initwidth initlo inithi \ + wherelabel label symfrom symto} { + + set vid [string trimleft $id .] + + global pd_nt + + set var_gatomwidth [concat gatomwidth_$vid] + global $var_gatomwidth + set var_gatomlo [concat gatomlo_$vid] + global $var_gatomlo + set var_gatomhi [concat gatomhi_$vid] + global $var_gatomhi + set var_gatomwherelabel [concat gatomwherelabel_$vid] + global $var_gatomwherelabel + set var_gatomlabel [concat gatomlabel_$vid] + global $var_gatomlabel + set var_gatomsymfrom [concat gatomsymfrom_$vid] + global $var_gatomsymfrom + set var_gatomsymto [concat gatomsymto_$vid] + global $var_gatomsymto + + set $var_gatomwidth $initwidth + set $var_gatomlo $initlo + set $var_gatomhi $inithi + set $var_gatomwherelabel $wherelabel + set $var_gatomlabel [gatom_unescape $label] + set $var_gatomsymfrom [gatom_unescape $symfrom] + set $var_gatomsymto [gatom_unescape $symto] + + toplevel $id + wm title $id "atom box properties" + wm resizable $id 0 0 + wm protocol $id WM_DELETE_WINDOW [concat dogatom_cancel $id] + + frame $id.params -height 7 + pack $id.params -side top + label $id.params.entryname -text "width" + entry $id.params.entry -textvariable $var_gatomwidth -width 4 + pack $id.params.entryname $id.params.entry -side left + + labelframe $id.limits -text "limits" -padx 15 -pady 4 -borderwidth 1 \ + -font highlight_font + pack $id.limits -side top -fill x + frame $id.limits.lower + pack $id.limits.lower -side left + label $id.limits.lower.entryname -text "lower" + entry $id.limits.lower.entry -textvariable $var_gatomlo -width 8 + pack $id.limits.lower.entryname $id.limits.lower.entry -side left + frame $id.limits.upper + pack $id.limits.upper -side left + frame $id.limits.upper.spacer -width 20 + label $id.limits.upper.entryname -text "upper" + entry $id.limits.upper.entry -textvariable $var_gatomhi -width 8 + pack $id.limits.upper.spacer $id.limits.upper.entryname \ + $id.limits.upper.entry -side left + + frame $id.spacer1 -height 7 + pack $id.spacer1 -side top + + labelframe $id.label -text "label" -padx 5 -pady 4 -borderwidth 1 \ + -font highlight_font + pack $id.label -side top -fill x + frame $id.label.name + pack $id.label.name -side top + entry $id.label.name.entry -textvariable $var_gatomlabel -width 33 + pack $id.label.name.entry -side left + frame $id.label.radio + pack $id.label.radio -side top + radiobutton $id.label.radio.left -value 0 \ + -variable $var_gatomwherelabel \ + -text "left " -justify left + radiobutton $id.label.radio.right -value 1 \ + -variable $var_gatomwherelabel \ + -text "right" -justify left + radiobutton $id.label.radio.top -value 2 \ + -variable $var_gatomwherelabel \ + -text "top" -justify left + radiobutton $id.label.radio.bottom -value 3 \ + -variable $var_gatomwherelabel \ + -text "bottom" -justify left + pack $id.label.radio.left -side left -anchor w + pack $id.label.radio.right -side right -anchor w + pack $id.label.radio.top -side top -anchor w + pack $id.label.radio.bottom -side bottom -anchor w + + frame $id.spacer2 -height 7 + pack $id.spacer2 -side top + + labelframe $id.s_r -text "messages" -padx 5 -pady 4 -borderwidth 1 \ + -font highlight_font + pack $id.s_r -side top -fill x + frame $id.s_r.paramsymto + pack $id.s_r.paramsymto -side top -anchor e + label $id.s_r.paramsymto.entryname -text "send symbol" + entry $id.s_r.paramsymto.entry -textvariable $var_gatomsymto -width 21 + pack $id.s_r.paramsymto.entry $id.s_r.paramsymto.entryname -side right + + frame $id.s_r.paramsymfrom + pack $id.s_r.paramsymfrom -side top -anchor e + label $id.s_r.paramsymfrom.entryname -text "receive symbol" + entry $id.s_r.paramsymfrom.entry -textvariable $var_gatomsymfrom -width 21 + pack $id.s_r.paramsymfrom.entry $id.s_r.paramsymfrom.entryname -side right + + frame $id.buttonframe -pady 5 + pack $id.buttonframe -side top -fill x -pady 2m + button $id.buttonframe.cancel -text {Cancel}\ + -command "dogatom_cancel $id" + pack $id.buttonframe.cancel -side left -expand 1 + button $id.buttonframe.apply -text {Apply}\ + -command "dogatom_apply $id" + pack $id.buttonframe.apply -side left -expand 1 + button $id.buttonframe.ok -text {OK}\ + -command "dogatom_ok $id" + pack $id.buttonframe.ok -side left -expand 1 + + bind $id.limits.upper.entry <KeyPress-Return> [concat dogatom_ok $id] + bind $id.limits.lower.entry <KeyPress-Return> [concat dogatom_ok $id] + bind $id.params.entry <KeyPress-Return> [concat dogatom_ok $id] + pdtk_standardkeybindings $id.limits.upper.entry + pdtk_standardkeybindings $id.limits.lower.entry + pdtk_standardkeybindings $id.params.entry + $id.params.entry select from 0 + $id.params.entry select adjust end + focus $id.params.entry +} + +############ pdtk_canvas_popup -- popup menu for canvas ######### + +set popup_xpix 0 +set popup_ypix 0 + +proc popup_action {name action} { + global popup_xpix popup_ypix + set cmd [concat $name done-popup $action $popup_xpix $popup_ypix \;] +# puts stderr $cmd + pd $cmd +} + +proc pdtk_canvas_popup {name xpix ypix canprop canopen} { + global popup_xpix popup_ypix + set popup_xpix $xpix + set popup_ypix $ypix + if {$canprop == 0} {$name.popup entryconfigure 0 -state disabled} + if {$canprop == 1} {$name.popup entryconfigure 0 -state active} + if {$canopen == 0} {$name.popup entryconfigure 1 -state disabled} + if {$canopen == 1} {$name.popup entryconfigure 1 -state active} + tk_popup $name.popup [expr $xpix + [winfo rootx $name.c]] \ + [expr $ypix + [winfo rooty $name.c]] 0 +} + + +# begin of change "iemlib" +############ pdtk_iemgui_dialog -- dialog window for iem guis ######### + +set iemgui_define_min_flashhold 50 +set iemgui_define_min_flashbreak 10 +set iemgui_define_min_fontsize 4 + +proc iemgui_clip_dim {id} { + set vid [string trimleft $id .] + + set var_iemgui_wdt [concat iemgui_wdt_$vid] + global $var_iemgui_wdt + set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] + global $var_iemgui_min_wdt + set var_iemgui_hgt [concat iemgui_hgt_$vid] + global $var_iemgui_hgt + set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] + global $var_iemgui_min_hgt + + if {[eval concat $$var_iemgui_wdt] < [eval concat $$var_iemgui_min_wdt]} { + set $var_iemgui_wdt [eval concat $$var_iemgui_min_wdt] + $id.dim.w_ent configure -textvariable $var_iemgui_wdt + } + if {[eval concat $$var_iemgui_hgt] < [eval concat $$var_iemgui_min_hgt]} { + set $var_iemgui_hgt [eval concat $$var_iemgui_min_hgt] + $id.dim.h_ent configure -textvariable $var_iemgui_hgt + } +} + +proc iemgui_clip_num {id} { + set vid [string trimleft $id .] + + set var_iemgui_num [concat iemgui_num_$vid] + global $var_iemgui_num + + if {[eval concat $$var_iemgui_num] > 2000} { + set $var_iemgui_num 2000 + $id.para.num_ent configure -textvariable $var_iemgui_num + } + if {[eval concat $$var_iemgui_num] < 1} { + set $var_iemgui_num 1 + $id.para.num_ent configure -textvariable $var_iemgui_num + } +} + +proc iemgui_sched_rng {id} { + set vid [string trimleft $id .] + + set var_iemgui_min_rng [concat iemgui_min_rng_$vid] + global $var_iemgui_min_rng + set var_iemgui_max_rng [concat iemgui_max_rng_$vid] + global $var_iemgui_max_rng + set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid] + global $var_iemgui_rng_sch + + global iemgui_define_min_flashhold + global iemgui_define_min_flashbreak + + if {[eval concat $$var_iemgui_rng_sch] == 2} { + if {[eval concat $$var_iemgui_max_rng] < [eval concat $$var_iemgui_min_rng]} { + set hhh [eval concat $$var_iemgui_min_rng] + set $var_iemgui_min_rng [eval concat $$var_iemgui_max_rng] + set $var_iemgui_max_rng $hhh + $id.rng.max_ent configure -textvariable $var_iemgui_max_rng + $id.rng.min_ent configure -textvariable $var_iemgui_min_rng } + if {[eval concat $$var_iemgui_max_rng] < $iemgui_define_min_flashhold} { + set $var_iemgui_max_rng $iemgui_define_min_flashhold + $id.rng.max_ent configure -textvariable $var_iemgui_max_rng + } + if {[eval concat $$var_iemgui_min_rng] < $iemgui_define_min_flashbreak} { + set $var_iemgui_min_rng $iemgui_define_min_flashbreak + $id.rng.min_ent configure -textvariable $var_iemgui_min_rng + } + } + if {[eval concat $$var_iemgui_rng_sch] == 1} { + if {[eval concat $$var_iemgui_min_rng] == 0.0} { + set $var_iemgui_min_rng 1.0 + $id.rng.min_ent configure -textvariable $var_iemgui_min_rng + } + } +} + +proc iemgui_verify_rng {id} { + set vid [string trimleft $id .] + + set var_iemgui_min_rng [concat iemgui_min_rng_$vid] + global $var_iemgui_min_rng + set var_iemgui_max_rng [concat iemgui_max_rng_$vid] + global $var_iemgui_max_rng + set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] + global $var_iemgui_lin0_log1 + + if {[eval concat $$var_iemgui_lin0_log1] == 1} { + if {[eval concat $$var_iemgui_max_rng] == 0.0 && [eval concat $$var_iemgui_min_rng] == 0.0} { + set $var_iemgui_max_rng 1.0 + $id.rng.max_ent configure -textvariable $var_iemgui_max_rng + } + if {[eval concat $$var_iemgui_max_rng] > 0} { + if {[eval concat $$var_iemgui_min_rng] <= 0} { + set $var_iemgui_min_rng [expr [eval concat $$var_iemgui_max_rng] * 0.01] + $id.rng.min_ent configure -textvariable $var_iemgui_min_rng + } + } else { + if {[eval concat $$var_iemgui_min_rng] > 0} { + set $var_iemgui_max_rng [expr [eval concat $$var_iemgui_min_rng] * 0.01] + $id.rng.max_ent configure -textvariable $var_iemgui_max_rng + } + } + } +} + +proc iemgui_clip_fontsize {id} { + set vid [string trimleft $id .] + + set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] + global $var_iemgui_gn_fs + + global iemgui_define_min_fontsize + + if {[eval concat $$var_iemgui_gn_fs] < $iemgui_define_min_fontsize} { + set $var_iemgui_gn_fs $iemgui_define_min_fontsize + $id.label.fs_ent configure -textvariable $var_iemgui_gn_fs + } +} + +proc iemgui_set_col_example {id} { + set vid [string trimleft $id .] + + set var_iemgui_bcol [concat iemgui_bcol_$vid] + global $var_iemgui_bcol + set var_iemgui_fcol [concat iemgui_fcol_$vid] + global $var_iemgui_fcol + set var_iemgui_lcol [concat iemgui_lcol_$vid] + global $var_iemgui_lcol + + $id.colors.sections.lb_bk configure \ + -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \ + -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] + + if { [eval concat $$var_iemgui_fcol] >= 0 } { + $id.colors.sections.fr_bk configure \ + -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \ + -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] + } else { + $id.colors.sections.fr_bk configure \ + -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]]} +} + +proc iemgui_preset_col {id presetcol} { + set vid [string trimleft $id .] + + set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] + global $var_iemgui_l2_f1_b0 + set var_iemgui_bcol [concat iemgui_bcol_$vid] + global $var_iemgui_bcol + set var_iemgui_fcol [concat iemgui_fcol_$vid] + global $var_iemgui_fcol + set var_iemgui_lcol [concat iemgui_lcol_$vid] + global $var_iemgui_lcol + + if { [eval concat $$var_iemgui_l2_f1_b0] == 0 } { set $var_iemgui_bcol $presetcol } + if { [eval concat $$var_iemgui_l2_f1_b0] == 1 } { set $var_iemgui_fcol $presetcol } + if { [eval concat $$var_iemgui_l2_f1_b0] == 2 } { set $var_iemgui_lcol $presetcol } + iemgui_set_col_example $id +} + +proc iemgui_choose_col_bkfrlb {id} { + set vid [string trimleft $id .] + + set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] + global $var_iemgui_l2_f1_b0 + set var_iemgui_bcol [concat iemgui_bcol_$vid] + global $var_iemgui_bcol + set var_iemgui_fcol [concat iemgui_fcol_$vid] + global $var_iemgui_fcol + set var_iemgui_lcol [concat iemgui_lcol_$vid] + global $var_iemgui_lcol + + if {[eval concat $$var_iemgui_l2_f1_b0] == 0} { + set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] + set helpstring [tk_chooseColor -title "Background-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_bcol]]] + if { $helpstring != "" } { + set $var_iemgui_bcol [string replace $helpstring 0 0 "0x"] + set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] } + } + if {[eval concat $$var_iemgui_l2_f1_b0] == 1} { + set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] + set helpstring [tk_chooseColor -title "Front-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_fcol]]] + if { $helpstring != "" } { + set $var_iemgui_fcol [string replace $helpstring 0 0 "0x"] + set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] } + } + if {[eval concat $$var_iemgui_l2_f1_b0] == 2} { + set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] + set helpstring [tk_chooseColor -title "Label-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_lcol]]] + if { $helpstring != "" } { + set $var_iemgui_lcol [string replace $helpstring 0 0 "0x"] + set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] } + } + iemgui_set_col_example $id +} + +proc iemgui_lilo {id} { + set vid [string trimleft $id .] + + set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] + global $var_iemgui_lin0_log1 + set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] + global $var_iemgui_lilo0 + set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] + global $var_iemgui_lilo1 + + iemgui_sched_rng $id + + if {[eval concat $$var_iemgui_lin0_log1] == 0} { + set $var_iemgui_lin0_log1 1 + $id.para.lilo configure -text [eval concat $$var_iemgui_lilo1] + iemgui_verify_rng $id + iemgui_sched_rng $id + } else { + set $var_iemgui_lin0_log1 0 + $id.para.lilo configure -text [eval concat $$var_iemgui_lilo0] + } +} + +proc iemgui_toggle_font {id gn_f} { + set vid [string trimleft $id .] + + set var_iemgui_gn_f [concat iemgui_gn_f_$vid] + global $var_iemgui_gn_f + global fontname fontweight + + set $var_iemgui_gn_f $gn_f + + switch -- $gn_f { + 0 { set current_font $fontname} + 1 { set current_font "Helvetica" } + 2 { set current_font "Times" } + } + set current_font_spec "{$current_font} 12 $fontweight" + + $id.label.fontpopup_label configure -text $current_font \ + -font $current_font_spec + $id.label.name_entry configure -font $current_font_spec + $id.colors.sections.fr_bk configure -font $current_font_spec + $id.colors.sections.lb_bk configure -font $current_font_spec +} + +proc iemgui_lb {id} { + set vid [string trimleft $id .] + + set var_iemgui_loadbang [concat iemgui_loadbang_$vid] + global $var_iemgui_loadbang + + if {[eval concat $$var_iemgui_loadbang] == 0} { + set $var_iemgui_loadbang 1 + $id.para.lb configure -text "init" + } else { + set $var_iemgui_loadbang 0 + $id.para.lb configure -text "no init" + } +} + +proc iemgui_stdy_jmp {id} { + set vid [string trimleft $id .] + + set var_iemgui_steady [concat iemgui_steady_$vid] + global $var_iemgui_steady + + if {[eval concat $$var_iemgui_steady]} { + set $var_iemgui_steady 0 + $id.para.stdy_jmp configure -text "jump on click" + } else { + set $var_iemgui_steady 1 + $id.para.stdy_jmp configure -text "steady on click" + } +} + +proc iemgui_apply {id} { + set vid [string trimleft $id .] + + set var_iemgui_wdt [concat iemgui_wdt_$vid] + global $var_iemgui_wdt + set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] + global $var_iemgui_min_wdt + set var_iemgui_hgt [concat iemgui_hgt_$vid] + global $var_iemgui_hgt + set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] + global $var_iemgui_min_hgt + set var_iemgui_min_rng [concat iemgui_min_rng_$vid] + global $var_iemgui_min_rng + set var_iemgui_max_rng [concat iemgui_max_rng_$vid] + global $var_iemgui_max_rng + set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] + global $var_iemgui_lin0_log1 + set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] + global $var_iemgui_lilo0 + set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] + global $var_iemgui_lilo1 + set var_iemgui_loadbang [concat iemgui_loadbang_$vid] + global $var_iemgui_loadbang + set var_iemgui_num [concat iemgui_num_$vid] + global $var_iemgui_num + set var_iemgui_steady [concat iemgui_steady_$vid] + global $var_iemgui_steady + set var_iemgui_snd [concat iemgui_snd_$vid] + global $var_iemgui_snd + set var_iemgui_rcv [concat iemgui_rcv_$vid] + global $var_iemgui_rcv + set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid] + global $var_iemgui_gui_nam + set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid] + global $var_iemgui_gn_dx + set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid] + global $var_iemgui_gn_dy + set var_iemgui_gn_f [concat iemgui_gn_f_$vid] + global $var_iemgui_gn_f + set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] + global $var_iemgui_gn_fs + set var_iemgui_bcol [concat iemgui_bcol_$vid] + global $var_iemgui_bcol + set var_iemgui_fcol [concat iemgui_fcol_$vid] + global $var_iemgui_fcol + set var_iemgui_lcol [concat iemgui_lcol_$vid] + global $var_iemgui_lcol + + iemgui_clip_dim $id + iemgui_clip_num $id + iemgui_sched_rng $id + iemgui_verify_rng $id + iemgui_sched_rng $id + iemgui_clip_fontsize $id + + if {[eval concat $$var_iemgui_snd] == ""} {set hhhsnd "empty"} else {set hhhsnd [eval concat $$var_iemgui_snd]} + if {[eval concat $$var_iemgui_rcv] == ""} {set hhhrcv "empty"} else {set hhhrcv [eval concat $$var_iemgui_rcv]} + if {[eval concat $$var_iemgui_gui_nam] == ""} {set hhhgui_nam "empty" + } else { + set hhhgui_nam [eval concat $$var_iemgui_gui_nam]} + + if {[string index $hhhsnd 0] == "$"} { + set hhhsnd [string replace $hhhsnd 0 0 #] } + if {[string index $hhhrcv 0] == "$"} { + set hhhrcv [string replace $hhhrcv 0 0 #] } + if {[string index $hhhgui_nam 0] == "$"} { + set hhhgui_nam [string replace $hhhgui_nam 0 0 #] } + + set hhhsnd [pdtk_unspace $hhhsnd] + set hhhrcv [pdtk_unspace $hhhrcv] + set hhhgui_nam [pdtk_unspace $hhhgui_nam] + + pd [concat $id dialog \ + [eval concat $$var_iemgui_wdt] \ + [eval concat $$var_iemgui_hgt] \ + [eval concat $$var_iemgui_min_rng] \ + [eval concat $$var_iemgui_max_rng] \ + [eval concat $$var_iemgui_lin0_log1] \ + [eval concat $$var_iemgui_loadbang] \ + [eval concat $$var_iemgui_num] \ + $hhhsnd \ + $hhhrcv \ + $hhhgui_nam \ + [eval concat $$var_iemgui_gn_dx] \ + [eval concat $$var_iemgui_gn_dy] \ + [eval concat $$var_iemgui_gn_f] \ + [eval concat $$var_iemgui_gn_fs] \ + [eval concat $$var_iemgui_bcol] \ + [eval concat $$var_iemgui_fcol] \ + [eval concat $$var_iemgui_lcol] \ + [eval concat $$var_iemgui_steady] \ + \;] +} + +proc iemgui_cancel {id} {pd [concat $id cancel \;]} + +proc iemgui_ok {id} { + iemgui_apply $id + iemgui_cancel $id +} + +proc pdtk_iemgui_dialog {id mainheader \ + dim_header wdt min_wdt wdt_label hgt min_hgt hgt_label \ + rng_header min_rng min_rng_label max_rng max_rng_label rng_sched \ + lin0_log1 lilo0_label lilo1_label loadbang steady num_label num \ + snd rcv \ + gui_name \ + gn_dx gn_dy \ + gn_f gn_fs \ + bcol fcol lcol} { + + set vid [string trimleft $id .] + + global pd_nt + global fontname fontweight + + set var_iemgui_wdt [concat iemgui_wdt_$vid] + global $var_iemgui_wdt + set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] + global $var_iemgui_min_wdt + set var_iemgui_hgt [concat iemgui_hgt_$vid] + global $var_iemgui_hgt + set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] + global $var_iemgui_min_hgt + set var_iemgui_min_rng [concat iemgui_min_rng_$vid] + global $var_iemgui_min_rng + set var_iemgui_max_rng [concat iemgui_max_rng_$vid] + global $var_iemgui_max_rng + set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid] + global $var_iemgui_rng_sch + set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] + global $var_iemgui_lin0_log1 + set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] + global $var_iemgui_lilo0 + set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] + global $var_iemgui_lilo1 + set var_iemgui_loadbang [concat iemgui_loadbang_$vid] + global $var_iemgui_loadbang + set var_iemgui_num [concat iemgui_num_$vid] + global $var_iemgui_num + set var_iemgui_steady [concat iemgui_steady_$vid] + global $var_iemgui_steady + set var_iemgui_snd [concat iemgui_snd_$vid] + global $var_iemgui_snd + set var_iemgui_rcv [concat iemgui_rcv_$vid] + global $var_iemgui_rcv + set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid] + global $var_iemgui_gui_nam + set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid] + global $var_iemgui_gn_dx + set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid] + global $var_iemgui_gn_dy + set var_iemgui_gn_f [concat iemgui_gn_f_$vid] + global $var_iemgui_gn_f + set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] + global $var_iemgui_gn_fs + set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] + global $var_iemgui_l2_f1_b0 + set var_iemgui_bcol [concat iemgui_bcol_$vid] + global $var_iemgui_bcol + set var_iemgui_fcol [concat iemgui_fcol_$vid] + global $var_iemgui_fcol + set var_iemgui_lcol [concat iemgui_lcol_$vid] + global $var_iemgui_lcol + + set $var_iemgui_wdt $wdt + set $var_iemgui_min_wdt $min_wdt + set $var_iemgui_hgt $hgt + set $var_iemgui_min_hgt $min_hgt + set $var_iemgui_min_rng $min_rng + set $var_iemgui_max_rng $max_rng + set $var_iemgui_rng_sch $rng_sched + set $var_iemgui_lin0_log1 $lin0_log1 + set $var_iemgui_lilo0 $lilo0_label + set $var_iemgui_lilo1 $lilo1_label + set $var_iemgui_loadbang $loadbang + set $var_iemgui_num $num + set $var_iemgui_steady $steady + if {$snd == "empty"} {set $var_iemgui_snd [format ""] + } else {set $var_iemgui_snd [format "%s" $snd]} + if {$rcv == "empty"} {set $var_iemgui_rcv [format ""] + } else {set $var_iemgui_rcv [format "%s" $rcv]} + if {$gui_name == "empty"} {set $var_iemgui_gui_nam [format ""] + } else {set $var_iemgui_gui_nam [format "%s" $gui_name]} + + if {[string index [eval concat $$var_iemgui_snd] 0] == "#"} { + set $var_iemgui_snd [string replace [eval concat $$var_iemgui_snd] 0 0 $] } + if {[string index [eval concat $$var_iemgui_rcv] 0] == "#"} { + set $var_iemgui_rcv [string replace [eval concat $$var_iemgui_rcv] 0 0 $] } + if {[string index [eval concat $$var_iemgui_gui_nam] 0] == "#"} { + set $var_iemgui_gui_nam [string replace [eval concat $$var_iemgui_gui_nam] 0 0 $] } + set $var_iemgui_gn_dx $gn_dx + set $var_iemgui_gn_dy $gn_dy + set $var_iemgui_gn_f $gn_f + set $var_iemgui_gn_fs $gn_fs + + set $var_iemgui_bcol $bcol + set $var_iemgui_fcol $fcol + set $var_iemgui_lcol $lcol + + set $var_iemgui_l2_f1_b0 0 + + toplevel $id + wm title $id [format "%s Properties" $mainheader] + wm resizable $id 0 0 + wm protocol $id WM_DELETE_WINDOW [concat iemgui_cancel $id] + + frame $id.dim + pack $id.dim -side top + label $id.dim.head -text $dim_header + label $id.dim.w_lab -text $wdt_label -width 6 + entry $id.dim.w_ent -textvariable $var_iemgui_wdt -width 5 + label $id.dim.dummy1 -text " " -width 10 + label $id.dim.h_lab -text $hgt_label -width 6 + entry $id.dim.h_ent -textvariable $var_iemgui_hgt -width 5 + pack $id.dim.head -side top + pack $id.dim.w_lab $id.dim.w_ent $id.dim.dummy1 -side left + if { $hgt_label != "empty" } { + pack $id.dim.h_lab $id.dim.h_ent -side left} + + frame $id.rng + pack $id.rng -side top + label $id.rng.head -text $rng_header + label $id.rng.min_lab -text $min_rng_label -width 6 + entry $id.rng.min_ent -textvariable $var_iemgui_min_rng -width 9 + label $id.rng.dummy1 -text " " -width 1 + label $id.rng.max_lab -text $max_rng_label -width 8 + entry $id.rng.max_ent -textvariable $var_iemgui_max_rng -width 9 + if { $rng_header != "empty" } { + pack $id.rng.head -side top + if { $min_rng_label != "empty" } { + pack $id.rng.min_lab $id.rng.min_ent -side left} + if { $max_rng_label != "empty" } { + pack $id.rng.dummy1 \ + $id.rng.max_lab $id.rng.max_ent -side left} } + + if { [eval concat $$var_iemgui_lin0_log1] >= 0 || [eval concat $$var_iemgui_loadbang] >= 0 || [eval concat $$var_iemgui_num] > 0 || [eval concat $$var_iemgui_steady] >= 0 } { + label $id.space1 -text "" + pack $id.space1 -side top } + + frame $id.para + pack $id.para -side top + label $id.para.dummy2 -text "" -width 1 + label $id.para.dummy3 -text "" -width 1 + if {[eval concat $$var_iemgui_lin0_log1] == 0} { + button $id.para.lilo -text [eval concat $$var_iemgui_lilo0] -width 5 -command "iemgui_lilo $id" } + if {[eval concat $$var_iemgui_lin0_log1] == 1} { + button $id.para.lilo -text [eval concat $$var_iemgui_lilo1] -width 5 -command "iemgui_lilo $id" } + if {[eval concat $$var_iemgui_loadbang] == 0} { + button $id.para.lb -text "no init" -width 5 -command "iemgui_lb $id" } + if {[eval concat $$var_iemgui_loadbang] == 1} { + button $id.para.lb -text "init" -width 5 -command "iemgui_lb $id" } + label $id.para.num_lab -text $num_label -width 9 + entry $id.para.num_ent -textvariable $var_iemgui_num -width 4 + if {[eval concat $$var_iemgui_steady] == 0} { + button $id.para.stdy_jmp -text "jump on click" -width 11 -command "iemgui_stdy_jmp $id" } + if {[eval concat $$var_iemgui_steady] == 1} { + button $id.para.stdy_jmp -text "steady on click" -width 11 -command "iemgui_stdy_jmp $id" } + if {[eval concat $$var_iemgui_lin0_log1] >= 0} { + pack $id.para.lilo -side left -expand 1} + if {[eval concat $$var_iemgui_loadbang] >= 0} { + pack $id.para.dummy2 $id.para.lb -side left -expand 1} + if {[eval concat $$var_iemgui_num] > 0} { + pack $id.para.dummy3 $id.para.num_lab $id.para.num_ent -side left -expand 1} + if {[eval concat $$var_iemgui_steady] >= 0} { + pack $id.para.dummy3 $id.para.stdy_jmp -side left -expand 1} + + frame $id.spacer0 -height 4 + pack $id.spacer0 -side top + + labelframe $id.s_r -borderwidth 1 -pady 4 -text "messages" \ + -font highlight_font + pack $id.s_r -side top -fill x -ipadx 5 + frame $id.s_r.send + pack $id.s_r.send -side top + label $id.s_r.send.lab -text " send-symbol:" -width 12 -justify right + entry $id.s_r.send.ent -textvariable $var_iemgui_snd -width 22 + if { $snd != "nosndno" } { + pack $id.s_r.send.lab $id.s_r.send.ent -side left} + + frame $id.s_r.receive + pack $id.s_r.receive -side top + label $id.s_r.receive.lab -text "receive-symbol:" -width 12 -justify right + entry $id.s_r.receive.ent -textvariable $var_iemgui_rcv -width 22 + if { $rcv != "norcvno" } { + pack $id.s_r.receive.lab $id.s_r.receive.ent -side left} + +# get the current font name from the int given from C-space (gn_f) + set current_font $fontname + if {[eval concat $$var_iemgui_gn_f] == 1} \ + { set current_font "Helvetica" } + if {[eval concat $$var_iemgui_gn_f] == 2} \ + { set current_font "Times" } + + frame $id.spacer1 -height 7 + pack $id.spacer1 -side top + + labelframe $id.label -borderwidth 1 -text "label" -pady 4 \ + -font highlight_font + pack $id.label -side top -fill x + entry $id.label.name_entry -textvariable $var_iemgui_gui_nam -width 30 \ + -font [list $current_font 12 $fontweight] + pack $id.label.name_entry -side top -expand yes -fill both -padx 5 + + frame $id.label.xy -padx 27 -pady 1 + pack $id.label.xy -side top + label $id.label.xy.x_lab -text "x offset" -width 6 + entry $id.label.xy.x_entry -textvariable $var_iemgui_gn_dx -width 5 + label $id.label.xy.dummy1 -text " " -width 2 + label $id.label.xy.y_lab -text "y offset" -width 6 + entry $id.label.xy.y_entry -textvariable $var_iemgui_gn_dy -width 5 + pack $id.label.xy.x_lab $id.label.xy.x_entry $id.label.xy.dummy1 \ + $id.label.xy.y_lab $id.label.xy.y_entry -side left -anchor e + + label $id.label.fontpopup_label -text $current_font \ + -relief groove -font [list $current_font 12 $fontweight] -padx 5 + pack $id.label.fontpopup_label -side left -anchor w -expand yes -fill x + label $id.label.fontsize_label -text "size" -width 4 + entry $id.label.fontsize_entry -textvariable $var_iemgui_gn_fs -width 5 + pack $id.label.fontsize_entry $id.label.fontsize_label \ + -side right -anchor e -padx 5 -pady 5 + menu $id.popup + $id.popup add command \ + -label $fontname \ + -font [format {{%s} 12 %s} $fontname $fontweight] \ + -command "iemgui_toggle_font $id 0" + $id.popup add command \ + -label "Helvetica" \ + -font [format {Helvetica 12 %s} $fontweight] \ + -command "iemgui_toggle_font $id 1" + $id.popup add command \ + -label "Times" \ + -font [format {Times 12 %s} $fontweight] \ + -command "iemgui_toggle_font $id 2" + bind $id.label.fontpopup_label <Button> \ + [list tk_popup $id.popup %X %Y] + + frame $id.spacer2 -height 7 + pack $id.spacer2 -side top + + labelframe $id.colors -borderwidth 1 -text "colors" -font highlight_font + pack $id.colors -fill x -ipadx 5 -ipady 4 + + frame $id.colors.select + pack $id.colors.select -side top + radiobutton $id.colors.select.radio0 -value 0 -variable \ + $var_iemgui_l2_f1_b0 -text "background" -width 10 -justify left + radiobutton $id.colors.select.radio1 -value 1 -variable \ + $var_iemgui_l2_f1_b0 -text "front" -width 5 -justify left + radiobutton $id.colors.select.radio2 -value 2 -variable \ + $var_iemgui_l2_f1_b0 -text "label" -width 5 -justify left + if { [eval concat $$var_iemgui_fcol] >= 0 } { + pack $id.colors.select.radio0 $id.colors.select.radio1 \ + $id.colors.select.radio2 -side left + } else { + pack $id.colors.select.radio0 $id.colors.select.radio2 -side left \ + } + + frame $id.colors.sections + pack $id.colors.sections -side top + button $id.colors.sections.but -text "compose color" -width 12 \ + -command "iemgui_choose_col_bkfrlb $id" + pack $id.colors.sections.but -side left -anchor w -padx 10 -pady 5 \ + -expand yes -fill x + if { [eval concat $$var_iemgui_fcol] >= 0 } { + label $id.colors.sections.fr_bk -text "o=||=o" -width 6 \ + -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \ + -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \ + -font [list $current_font 12 $fontweight] -padx 2 -pady 2 -relief ridge + } else { + label $id.colors.sections.fr_bk -text "o=||=o" -width 6 \ + -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -font [list $current_font 12 $fontweight] -padx 2 -pady 2 -relief ridge + } + label $id.colors.sections.lb_bk -text "testlabel" -width 9 \ + -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ + -foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \ + -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \ + -font [list $current_font 12 $fontweight] -padx 2 -pady 2 -relief ridge + pack $id.colors.sections.lb_bk $id.colors.sections.fr_bk \ + -side right -anchor e -expand yes -fill both -pady 7 + +# color scheme by Mary Ann Benedetto http://piR2.org + frame $id.colors.r1 + pack $id.colors.r1 -side top + foreach i { 0 1 2 3 4 5 6 7 8 9} \ + hexcol { 0xFFFFFF 0xDFDFDF 0xBBBBBB 0xFFC7C6 0xFFE3C6 \ + 0xFEFFC6 0xC6FFC7 0xc6FEFF 0xC7C6FF 0xE3C6FF } \ + { + label $id.colors.r1.c$i -background [format "#%6.6x" $hexcol] \ + -activebackground [format "#%6.6x" $hexcol] -relief ridge \ + -padx 7 -pady 0 + bind $id.colors.r1.c$i <Button> [format "iemgui_preset_col %s %d" $id $hexcol] + } + pack $id.colors.r1.c0 $id.colors.r1.c1 $id.colors.r1.c2 $id.colors.r1.c3 \ + $id.colors.r1.c4 $id.colors.r1.c5 $id.colors.r1.c6 $id.colors.r1.c7 \ + $id.colors.r1.c8 $id.colors.r1.c9 -side left + + frame $id.colors.r2 + pack $id.colors.r2 -side top + foreach i { 0 1 2 3 4 5 6 7 8 9 } \ + hexcol { 0x9F9F9F 0x7C7C7C 0x606060 0xFF0400 0xFF8300 \ + 0xFAFF00 0x00FF04 0x00FAFF 0x0400FF 0x9C00FF } \ + { + label $id.colors.r2.c$i -background [format "#%6.6x" $hexcol] \ + -activebackground [format "#%6.6x" $hexcol] -relief ridge \ + -padx 7 -pady 0 + bind $id.colors.r2.c$i <Button> \ @@ Diff output truncated at 100000 characters. @@ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

1 0

SF.net SVN: pure-data:[10456] branches/pd-devel/0.41.4
by chunlee＠users.sourceforge.net 22 Dec '08

22 Dec '08

Revision: 10456 http://pure-data.svn.sourceforge.net/pure-data/?rev=10456&view=rev Author: chunlee Date: 2008-12-22 17:30:46 +0000 (Mon, 22 Dec 2008) Log Message: ----------- test commit Added Paths: ----------- branches/pd-devel/0.41.4/devel_doc/ branches/pd-devel/0.41.4/devel_doc/TODO Added: branches/pd-devel/0.41.4/devel_doc/TODO =================================================================== --- branches/pd-devel/0.41.4/devel_doc/TODO (rev 0) +++ branches/pd-devel/0.41.4/devel_doc/TODO 2008-12-22 17:30:46 UTC (rev 10456) @@ -0,0 +1 @@ +Test commit... This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

1 0

SF.net SVN: pure-data:[10455] trunk/externals/iem/iemguts/README.txt
by zmoelnig＠users.sourceforge.net 22 Dec '08

22 Dec '08

Revision: 10455 http://pure-data.svn.sourceforge.net/pure-data/?rev=10455&view=rev Author: zmoelnig Date: 2008-12-22 08:38:19 +0000 (Mon, 22 Dec 2008) Log Message: ----------- fixed typo and apparent nonsense Modified Paths: -------------- trunk/externals/iem/iemguts/README.txt Modified: trunk/externals/iem/iemguts/README.txt =================================================================== --- trunk/externals/iem/iemguts/README.txt 2008-12-22 08:10:38 UTC (rev 10454) +++ trunk/externals/iem/iemguts/README.txt 2008-12-22 08:38:19 UTC (rev 10455) @@ -26,11 +26,11 @@ #2> make #3> make install -note: iemuts depends on some internal headers of Pd. +note: IEMguts depends on some internal headers of Pd. therefore you might have to specify the full path to your Pd-sources using the PDROOT environment variable. something like -#2> PDROOT=/home/me/src/pd-0.41-2/ +#2> PDROOT=/home/me/src/pd-0.41-2/ make should do the trick (PDROOT should point to a directory wherein there is a src/-subdirectory containing the sources of the Pd you are running) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

1 0

SF.net SVN: pure-data:[10454] trunk/externals/iem/iemguts/README.txt
by zmoelnig＠users.sourceforge.net 22 Dec '08

22 Dec '08

Revision: 10454 http://pure-data.svn.sourceforge.net/pure-data/?rev=10454&view=rev Author: zmoelnig Date: 2008-12-22 08:10:38 +0000 (Mon, 22 Dec 2008) Log Message: ----------- explain the use of PDROOT Modified Paths: -------------- trunk/externals/iem/iemguts/README.txt Modified: trunk/externals/iem/iemguts/README.txt =================================================================== --- trunk/externals/iem/iemguts/README.txt 2008-12-20 21:48:16 UTC (rev 10453) +++ trunk/externals/iem/iemguts/README.txt 2008-12-22 08:10:38 UTC (rev 10454) @@ -26,6 +26,14 @@ #2> make #3> make install +note: iemuts depends on some internal headers of Pd. +therefore you might have to specify the full path to your Pd-sources +using the PDROOT environment variable. +something like +#2> PDROOT=/home/me/src/pd-0.41-2/ +should do the trick +(PDROOT should point to a directory wherein there is a src/-subdirectory +containing the sources of the Pd you are running) license:: --------- This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

1 0

SF.net SVN: pure-data:[10453] trunk/externals/ffext/tracker/makefile
by federico__＠users.sourceforge.net 20 Dec '08

20 Dec '08

Revision: 10453 http://pure-data.svn.sourceforge.net/pure-data/?rev=10453&view=rev Author: federico__ Date: 2008-12-20 21:48:16 +0000 (Sat, 20 Dec 2008) Log Message: ----------- fix cflags for amd64 Modified Paths: -------------- trunk/externals/ffext/tracker/makefile Modified: trunk/externals/ffext/tracker/makefile =================================================================== --- trunk/externals/ffext/tracker/makefile 2008-12-16 15:49:11 UTC (rev 10452) +++ trunk/externals/ffext/tracker/makefile 2008-12-20 21:48:16 UTC (rev 10453) @@ -35,7 +35,7 @@ LINUXLDFLAGS = -export_dynamic -shared .c.pd_linux: - $(CC) $(LINUXCFLAGS) $(LINUXINCLUDE) -o $*.o -c $*.c + $(CC) $(LINUXCFLAGS) $(CFLAGS) $(LINUXINCLUDE) -fPIC -o $*.o -c $*.c $(LD) $(LINUXLDFLAGS) -o $*.pd_linux $*.o -lc -lm strip --strip-unneeded $*.pd_linux This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

1 0

autobuild: pd-extended planetccrma9-i386 2008-12-17 04.08.26
by pd＠planetccrma9-i386.idmi.poly.edu 17 Dec '08

17 Dec '08

rsync error: syntax or usage error (code 1) at main.c(1216) [receiver=3.0.4] the full logfile - if it has been succesfully uploaded - can be viewed at: http://autobuild.puredata.info/auto-build/2008-12-17/logs/2008-12-17_04.08.…

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

Pd-cvs December 2008