Revision: 10659 http://pure-data.svn.sourceforge.net/pure-data/?rev=10659&view=rev Author: eighthave Date: 2009-01-27 06:11:58 +0000 (Tue, 27 Jan 2009)
Log Message: ----------- - got the canvas popup menu working, with Help, Open, and Properties working
- included iemgui code and got the properties panel to popup correctly
- setup CanvasWindow toplevel class to bind to in order to get events only from the toplevel window, not anything that is in that window. Binding a classname is not recursive, but binding to a toplevel or canvas is.
Modified Paths: -------------- branches/pd-devel/0.41.4/devel_doc/TODO branches/pd-devel/0.41.4/src/pd.tk branches/pd-devel/0.41.4/src/pd_bindings.tcl branches/pd-devel/0.41.4/src/pd_connect.tcl branches/pd-devel/0.41.4/src/pd_iemgui.tcl branches/pd-devel/0.41.4/src/pdtk_canvas.tcl branches/pd-devel/0.41.4/src/wheredoesthisgo.tcl
Modified: branches/pd-devel/0.41.4/devel_doc/TODO =================================================================== --- branches/pd-devel/0.41.4/devel_doc/TODO 2009-01-27 00:21:35 UTC (rev 10658) +++ branches/pd-devel/0.41.4/devel_doc/TODO 2009-01-27 06:11:58 UTC (rev 10659) @@ -4,6 +4,7 @@ [ ] performance testing to make sure the Tcl networking is up to snuff [ ] overall naming/organization scheme for variables, functions, and packages [ ] implement checking to see if another Pd is already running follwoing this code example: http://tcl.tk/man/tcl8.4/TkCmd/send.htm +[ ] search path for startup.tcl and load, this is a file for GUI customizations
gui logic @@ -38,6 +39,7 @@ [ ] streamline pdsend_key and the C side of things, using %N [ ] implement [wm attributes -titlepath] on Mac OS X and change pdsend_map [ ] move sys_font setting from 'pd' to 'pd-gui', probably in pdtk_pd_startup +[ ] switch pdtk_canvas_getscroll to mytoplevel and bind <Configure> to a -class
- switch to using toplevel classes instead of creating the bindings each time bind MyCanvas @@ -64,4 +66,3 @@ [2:12pm] ijchain: <patthoyts> Instead you can do the binding to the class name once in the initialization for the application. [2:13pm] ijchain: <patthoyts> Then any toplevel created with that class will automatically get the correct bindings. [2:14pm] ijchain: <patthoyts> If you look at the code in tk/library/*.tcl where the widget bindings are all setup you can see thats how its done for Tk's own stuff. Mostly anyway. -[2:15pm] hans_: thanks, very helpfuil!
Modified: branches/pd-devel/0.41.4/src/pd.tk =================================================================== --- branches/pd-devel/0.41.4/src/pd.tk 2009-01-27 00:21:35 UTC (rev 10658) +++ branches/pd-devel/0.41.4/src/pd.tk 2009-01-27 06:11:58 UTC (rev 10659) @@ -55,6 +55,7 @@ package require pd_menus package require pd_bindings package require pd_post +package require pd_iemgui package require pdtk_canvas package require pdtk_text # TODO eliminate this kludge: @@ -63,8 +64,8 @@ # import into the global namespace for backwards compatibility namespace import ::pd_post::pdtk_post namespace import ::pd_connect::pdsend +namespace import ::pd_iemgui::pdtk_iemgui_dialog
- #------------------------------------------------------------------------------# # coding style # @@ -159,6 +160,7 @@ } }
+# TODO the fonts picked seem too small foreach {size width height} $::font_fixed_metrics { set myfont [pdtk_font_name $size] font create $myfont -family $::font_family -weight $::font_weight \ @@ -216,7 +218,39 @@ # TODO check to see if the requested font exists using [font families] }
+proc check_for_running_instances {} { +## http://tcl.tk/man/tcl8.4/TkCmd/send.htm +## This script fragment can be used to make an application that only +## runs once on a particular display. +# +#if {[tk appname FoobarApp] ne "FoobarApp"} { +# send -async FoobarApp RemoteStart $argv +# exit +#} +## The command that will be called remotely, which raises +## the application main window and opens the requested files +#proc RemoteStart args { +# raise . +# foreach filename $args { +# OpenFile $filename +# } +#} +}
+proc create_pdwindow {} { + ::pd_menus::create_menubar .menubar + . configure -menu .menubar -width 400 -height 250 + ::pd_menus::configure_pdwindow .menubar + ::pd_bindings::pdwindow_bindings . + + # TODO move this to its own proc for clarity + wm title . "Pd-devel" + wm geometry . +500+50 + frame .placeholder + label .placeholder.label -text "Pd window placeholder" -width 50 -height 15 + pack .placeholder.label .placeholder -side top -expand yes -fill both +} + # ------------------------------------------------------------------------------ # main proc main {argc argv} { @@ -224,28 +258,18 @@ catch {console show} post_tclinfo pdtk_post "Starting pd.tk with main($argc $argv)" + check_for_running_instances init
# no english support yet, so I am commenting this out #if {![info exists cmd_ops(lang)]} {set cmd_ops(lang) "en"} #init_locale
+ create_pdwindow + # TODO check args for -stderr and set pdtk_post accordingly - - ::pd_menus::create_menubar .menubar - . configure -menu .menubar -width 400 -height 250 - ::pd_menus::configure_pdwindow .menubar - ::pd_bindings::pdwindow_bindings . - - # TODO move this to its own proc for clarity - wm title . "Pd-devel" - wm geometry . +500+50 - frame .placeholder - label .placeholder.label -text "Pd window placeholder" -width 50 -height 15 - pack .placeholder.label .placeholder -side top -expand yes -fill both - if { $argc == 1 && [string is int [lindex $argv 0]]} { - # 'pd' started first and launched us, so get the port to connect to + # 'pd' started first and launched us, so get the port to connect to ::pd_connect::to_pd [lindex $argv 0] } else { # the GUI is starting first, so create socket and exec 'pd' @@ -254,6 +278,7 @@ exec -- $pd_exec -guiport $portnumber & #TODO add vwait so that pd-gui will exit if pd never shows up } + ::pd_bindings::class_bindings }
main $::argc $::argv
Modified: branches/pd-devel/0.41.4/src/pd_bindings.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_bindings.tcl 2009-01-27 00:21:35 UTC (rev 10658) +++ branches/pd-devel/0.41.4/src/pd_bindings.tcl 2009-01-27 06:11:58 UTC (rev 10659) @@ -11,6 +11,19 @@ namespace export canvas_bindings }
+proc ::pd_bindings::class_bindings {} { + # binding by class is not recursive, so its useful for certain things + bind CanvasWindow <Map> "pdsend_map %W" + bind CanvasWindow <Unmap> "pdsend_unmap %W" + bind CanvasWindow <Configure> "pdtk_canvas_getscroll %W" + + # event bindings ----------------------------------------------------------- + + # do window maintenance when entering a window (Window menu, scrollbars...) + # maybe use WM_TAKE_FOCUS for this? + #bind CanvasWindow <FocusIn> {pdtk_canvaswindowmaintenance} +} + proc ::pd_bindings::window_bindings {mytoplevel} { variable modifier
@@ -130,13 +143,13 @@ bind $mycanvas <Motion> "pdtk_canvas_motion %W %x %y 0" bind $mycanvas <Button-1> "pdtk_canvas_mouse %W %x %y %b 0" bind $mycanvas <ButtonRelease-1> "pdtk_canvas_mouseup %W %x %y %b" - bind $mycanvas <$modifier-Button-1> "pdtk_canvas_mouse %W %x %y %b 0" + bind $mycanvas <$modifier-Button-1> "pdtk_canvas_mouse %W %x %y %b 2" # TODO look into "virtual events' for a means for getting Shift-Button, etc. - switch {$::windowingsystem} { + switch -- $::windowingsystem { "aqua" { bind $mycanvas <Button-2> "pdtk_canvas_rightclick %W %x %y %b" - # on Mac OS X, emulate a rightclick with Ctrl-click - bind $mycanvas <Ctrl-Button-1> "pdtk_canvas_rightclick %W %x %y %b" + # on Mac OS X, make a rightclick with Ctrl-click for 1 button mice + bind $mycanvas <Control-Button-1> "pdtk_canvas_rightclick %W %x %y %b" # TODO try replacing the above with this #bind all <Control-Button-1> {event generate %W <Button-2> \ # -x %x -y %y -rootx %X -rooty %Y \ @@ -151,15 +164,6 @@ } #TODO bind $mytoplevel <MouseWheel>
- # event bindings ----------------------------------------------------------- - bind $mytoplevel <Map> "pdsend_map %W" - bind $mytoplevel <Unmap> "pdsend_unmap %W" - #TODO bind $mytoplevel <Configure> "pdtk_canvas_getscroll %W" - - # do window maintenance when entering a window (Window menu, scrollbars...) - # maybe use WM_TAKE_FOCUS for this? - #bind $mytoplevel <FocusIn> {pdtk_canvaswindowmaintenance} - # window protocol bindings wm protocol $mytoplevel WM_DELETE_WINDOW "pdsend "$mytoplevel menuclose 0"" }
Modified: branches/pd-devel/0.41.4/src/pd_connect.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_connect.tcl 2009-01-27 00:21:35 UTC (rev 10658) +++ branches/pd-devel/0.41.4/src/pd_connect.tcl 2009-01-27 06:11:58 UTC (rev 10659) @@ -67,7 +67,6 @@ exit } append cmd_from_pd [read $pd_socket] - puts stderr "cmd_from_pd: $cmd_from_pd" if {[catch {uplevel #0 $cmd_from_pd} errorname]} { global errorInfo puts stderr "errorname: >>$errorname<<"
Modified: branches/pd-devel/0.41.4/src/pd_iemgui.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_iemgui.tcl 2009-01-27 00:21:35 UTC (rev 10658) +++ branches/pd-devel/0.41.4/src/pd_iemgui.tcl 2009-01-27 06:11:58 UTC (rev 10659) @@ -3,6 +3,7 @@ # Copyright (c) 1997-2009 Miller Puckette.
package provide pd_iemgui 0.1 + namespace eval ::pd_iemgui:: { variable define_min_flashhold 50 variable define_min_flashbreak 10 @@ -221,21 +222,21 @@ set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] global $var_iemgui_lin0_log1 - set var_::pd_iemgui::lilo0 [concat ::pd_iemgui::lilo0_$vid] - global $var_::pd_iemgui::lilo0 - set var_::pd_iemgui::lilo1 [concat ::pd_iemgui::lilo1_$vid] - global $var_::pd_iemgui::lilo1 + set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] + global $var_iemgui_lilo0 + set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] + global $var_iemgui_lilo1 ::pd_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_::pd_iemgui::lilo1] + $id.para.lilo configure -text [eval concat $$var_iemgui_lilo1] ::pd_iemgui::verify_rng $id ::pd_iemgui::sched_rng $id } else { set $var_iemgui_lin0_log1 0 - $id.para.lilo configure -text [eval concat $$var_::pd_iemgui::lilo0] + $id.para.lilo configure -text [eval concat $$var_iemgui_lilo0] } }
@@ -244,16 +245,15 @@ 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} + 0 { set current_font $::font_family} 1 { set current_font "Helvetica" } 2 { set current_font "Times" } } - set current_font_spec "{$current_font} 12 $fontweight" + set current_font_spec "{$current_font} 12 $::font_weight" $id.label.fontpopup_label configure -text $current_font \ -font $current_font_spec @@ -309,10 +309,10 @@ global $var_iemgui_max_rng set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] global $var_iemgui_lin0_log1 - set var_::pd_iemgui::lilo0 [concat ::pd_iemgui::lilo0_$vid] - global $var_::pd_iemgui::lilo0 - set var_::pd_iemgui::lilo1 [concat ::pd_iemgui::lilo1_$vid] - global $var_::pd_iemgui::lilo1 + 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] @@ -360,9 +360,9 @@ 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] + set hhhsnd [unspace_text $hhhsnd] + set hhhrcv [unspace_text $hhhrcv] + set hhhgui_nam [unspace_text $hhhgui_nam]
pdsend [concat $id dialog \ [eval concat $$var_iemgui_wdt] \ @@ -385,7 +385,9 @@ [eval concat $$var_iemgui_steady]] }
-proc ::pd_iemgui::cancel {id} {pdsend "$id cancel"} +proc ::pd_iemgui::cancel {id} { + pdsend "$id cancel" +}
proc ::pd_iemgui::ok {id} { ::pd_iemgui::apply $id @@ -406,9 +408,6 @@ 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] @@ -425,10 +424,10 @@ global $var_iemgui_rng_sch set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] global $var_iemgui_lin0_log1 - set var_::pd_iemgui::lilo0 [concat ::pd_iemgui::lilo0_$vid] - global $var_::pd_iemgui::lilo0 - set var_::pd_iemgui::lilo1 [concat ::pd_iemgui::lilo1_$vid] - global $var_::pd_iemgui::lilo1 + 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] @@ -466,8 +465,8 @@ set $var_iemgui_max_rng $max_rng set $var_iemgui_rng_sch $rng_sched set $var_iemgui_lin0_log1 $lin0_log1 - set $var_::pd_iemgui::lilo0 $lilo0_label - set $var_::pd_iemgui::lilo1 $lilo1_label + 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 @@ -538,9 +537,9 @@ 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_::pd_iemgui::lilo0] -width 5 -command "::pd_iemgui::lilo $id" } + button $id.para.lilo -text [eval concat $$var_iemgui_lilo0] -width 5 -command "::pd_iemgui::lilo $id" } if {[eval concat $$var_iemgui_lin0_log1] == 1} { - button $id.para.lilo -text [eval concat $$var_::pd_iemgui::lilo1] -width 5 -command "::pd_iemgui::lilo $id" } + button $id.para.lilo -text [eval concat $$var_iemgui_lilo1] -width 5 -command "::pd_iemgui::lilo $id" } if {[eval concat $$var_iemgui_loadbang] == 0} { button $id.para.lb -text "no init" -width 5 -command "::pd_iemgui::lb $id" } if {[eval concat $$var_iemgui_loadbang] == 1} { @@ -581,7 +580,7 @@ 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 + set current_font $::font_family if {[eval concat $$var_iemgui_gn_f] == 1} \ { set current_font "Helvetica" } if {[eval concat $$var_iemgui_gn_f] == 2} \ @@ -594,7 +593,7 @@ -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] + -font [list $current_font 12 $::font_weight] pack $id.label.name_entry -side top -expand yes -fill both -padx 5
frame $id.label.xy -padx 27 -pady 1 @@ -608,7 +607,7 @@ $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 + -relief groove -font [list $current_font 12 $::font_weight] -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 @@ -616,16 +615,16 @@ -side right -anchor e -padx 5 -pady 5 menu $id.popup $id.popup add command \ - -label $fontname \ - -font [format {{%s} 12 %s} $fontname $fontweight] \ + -label $::font_family \ + -font [format {{%s} 12 %s} $::font_family $::font_weight] \ -command "::pd_iemgui::toggle_font $id 0" $id.popup add command \ -label "Helvetica" \ - -font [format {Helvetica 12 %s} $fontweight] \ + -font [format {Helvetica 12 %s} $::font_weight] \ -command "::pd_iemgui::toggle_font $id 1" $id.popup add command \ -label "Times" \ - -font [format {Times 12 %s} $fontweight] \ + -font [format {Times 12 %s} $::font_weight] \ -command "::pd_iemgui::toggle_font $id 2" bind $id.label.fontpopup_label <Button> \ [list tk_popup $id.popup %X %Y] @@ -663,21 +662,21 @@ -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 + -font [list $current_font 12 $::font_weight] -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 + -font [list $current_font 12 $::font_weight] -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 + -font [list $current_font 12 $::font_weight] -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
Modified: branches/pd-devel/0.41.4/src/pdtk_canvas.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pdtk_canvas.tcl 2009-01-27 00:21:35 UTC (rev 10658) +++ branches/pd-devel/0.41.4/src/pdtk_canvas.tcl 2009-01-27 06:11:58 UTC (rev 10659) @@ -5,13 +5,16 @@
namespace eval ::pdtk_canvas:: { } +# keep track of the location of the popup +set popup_xpix 0 +set popup_ypix 0
#------------------------------------------------------------------------------# # canvas new/saveas
proc pdtk_canvas_new {mytoplevel width height geometry editable} { # TODO check size of window - toplevel $mytoplevel -width $width -height $height + toplevel $mytoplevel -width $width -height $height -class CanvasWindow ::pd_menus::create_menubar $mytoplevel.menubar $mytoplevel configure -menu $mytoplevel.menubar
@@ -100,6 +103,32 @@ }
#------------------------------------------------------------------------------# +# canvas popup menu + +proc popup_action {name action} { + pdsend "$name done-popup $action $::popup_xpix $::popup_ypix" +} + +proc pdtk_canvas_popup {mytoplevel xpix ypix hasproperties hasopen} { + set ::popup_xpix $xpix + set ::popup_ypix $ypix + if {$hasproperties} { + $mytoplevel.popup entryconfigure 0 -state normal + } else { + $mytoplevel.popup entryconfigure 0 -state disabled + } + if {$hasopen} { + $mytoplevel.popup entryconfigure 1 -state normal + } else { + $mytoplevel.popup entryconfigure 1 -state disabled + } + set mycanvas "$mytoplevel.c" + tk_popup $mytoplevel.popup [expr $xpix + [winfo rootx $mycanvas]] \ + [expr $ypix + [winfo rooty $mycanvas]] 0 +} + + +#------------------------------------------------------------------------------# # procs for canvas events
# "map" event tells us when the canvas becomes visible (arg is "0") or @@ -120,10 +149,9 @@ # TODO make this work }
-proc pdtk_canvas_getscroll {mytoplevel} { +proc pdtk_canvas_getscroll {mycanvas} { # TODO make this work + # the C code still sends a .c canvas, so get the toplevel + set mytoplevel [winfo toplevel $mycanvas] + puts stderr "pdtk_canvas_getscroll $mycanvas" } - -proc pdtk_canvas_checkgeometry {mytoplevel} { - # TODO check and relocate window accordingly -}
Modified: branches/pd-devel/0.41.4/src/wheredoesthisgo.tcl =================================================================== --- branches/pd-devel/0.41.4/src/wheredoesthisgo.tcl 2009-01-27 00:21:35 UTC (rev 10658) +++ branches/pd-devel/0.41.4/src/wheredoesthisgo.tcl 2009-01-27 06:11:58 UTC (rev 10659) @@ -38,7 +38,15 @@ string map {"," "\," ";" "\;" " " "\ "} $message }
+#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 unspace_text {x} { + set y [string map {" " "_" ";" "" "," "" "{" "" "}" "" "\" ""} $x] + if {$y == ""} {set y "empty"} + concat $y +}
+ #------------------------------------------------------------------------------# # key usage
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.