Revision: 10522 http://pure-data.svn.sourceforge.net/pure-data/?rev=10522&view=rev Author: eighthave Date: 2009-01-12 23:01:33 +0000 (Mon, 12 Jan 2009)
Log Message: ----------- - wrote code for pd-gui to start first, create the socket, then start pd
- set up Map/Unmap bindings for vis 1/0
- set up mouse button/motion bindings
- added in pdtk_text and pdtk_canvas to start getting things to show up, these mostly just have code straight from u_main.tk
- some minor reformatting
Modified Paths: -------------- branches/pd-devel/0.41.4/src/AppMain.tcl branches/pd-devel/0.41.4/src/g_editor.c 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_menucommands.tcl branches/pd-devel/0.41.4/src/pd_menus.tcl branches/pd-devel/0.41.4/src/pkgIndex.tcl branches/pd-devel/0.41.4/src/wheredoesthisgo.tcl
Added Paths: ----------- branches/pd-devel/0.41.4/src/pdtk_canvas.tcl branches/pd-devel/0.41.4/src/pdtk_text.tcl
Modified: branches/pd-devel/0.41.4/src/AppMain.tcl =================================================================== --- branches/pd-devel/0.41.4/src/AppMain.tcl 2009-01-12 19:29:07 UTC (rev 10521) +++ branches/pd-devel/0.41.4/src/AppMain.tcl 2009-01-12 23:01:33 UTC (rev 10522) @@ -1,8 +1,19 @@ - # this file is for the Wish.app on Mac OS X
-if {[string first "-psn" [lindex $argv 0]] == 0} { set argv [lrange $argv 1 end]} +catch {console show}
-console show +puts "AppMain.tcl" +puts "argv0: $argv0" +puts "executable: [info nameofexecutable]" +puts "argc: $argc argv: $argv"
+# TODO is there anything useful to do with the psn (Process Serial Number)? +if {[string first "-psn" [lindex $argv 0]] == 0} { + set argv [lrange $argv 1 end] + set argc [expr $argc - 1] +} + # launch pd.tk here +if [catch {source [file join [file dirname [info script]] pd.tk]}] { + puts stderr $errorInfo +}
Modified: branches/pd-devel/0.41.4/src/g_editor.c =================================================================== --- branches/pd-devel/0.41.4/src/g_editor.c 2009-01-12 19:29:07 UTC (rev 10521) +++ branches/pd-devel/0.41.4/src/g_editor.c 2009-01-12 23:01:33 UTC (rev 10522) @@ -1247,7 +1247,7 @@ } }
-void canvas_mousedown(t_canvas *x, t_floatarg xpos, t_floatarg ypos, +void canvas_mouse(t_canvas *x, t_floatarg xpos, t_floatarg ypos, t_floatarg which, t_floatarg mod) { canvas_doclick(x, xpos, ypos, which, mod, 1); @@ -2435,7 +2435,7 @@ void g_editor_setup(void) { /* ------------------------ events ---------------------------------- */ - class_addmethod(canvas_class, (t_method)canvas_mousedown, gensym("mouse"), + class_addmethod(canvas_class, (t_method)canvas_mouse, gensym("mouse"), A_FLOAT, A_FLOAT, A_FLOAT, A_FLOAT, A_NULL); class_addmethod(canvas_class, (t_method)canvas_mouseup, gensym("mouseup"), A_FLOAT, A_FLOAT, A_FLOAT, A_NULL);
Modified: branches/pd-devel/0.41.4/src/pd.tk =================================================================== --- branches/pd-devel/0.41.4/src/pd.tk 2009-01-12 19:29:07 UTC (rev 10521) +++ branches/pd-devel/0.41.4/src/pd.tk 2009-01-12 23:01:33 UTC (rev 10522) @@ -18,6 +18,8 @@ package require pd_menus package require pd_bindings package require pd_post +package require pdtk_canvas +package require pdtk_text # TODO eliminate this kludge: package require wheredoesthisgo
@@ -25,7 +27,25 @@ namespace import ::pd_post::pdtk_post namespace import ::pd_connect::pd
-# ------------------------------------------------------------------------------ + +#------------------------------------------------------------------------------# +# coding style +# + +# +# * when possible use "" doublequotes to delimit messages +# +# +# +# +## Names for Common Variables +#---------------------------- +# $name == window name +# $canvasname == $name.c == canvas name + + + +#------------------------------------------------------------------------------# # global variables # command line options
@@ -67,13 +87,11 @@ proc init {} { switch -- [tk windowingsystem] { "x11" { - # load the dialog once, otherwise setting the vars will not work + # add control to show/hide hidden files in the open panel (load + # the tk_getOpenFile dialog once, otherwise it will not work) catch {tk_getOpenFile -with-invalid-argument} - # add control to show/hide hidden files - namespace eval ::tk::dialog::file { - variable showHiddenBtn 1 - variable showHiddenVar 0 - } + set ::tk::dialog::file::showHiddenBtn 1 + set ::tk::dialog::file::showHiddenVar 0 } "aqua" { } @@ -117,7 +135,9 @@
# TODO slide off screen windows into view wm geometry $name $geometry - canvas $name.c -width $width -height $height -background white + wm minsize $name 50 20 + canvas $name.c -width $width -height $height -background white \ + -highlightthickness 0
# the popup menu for the canvas menu $name.popup -tearoff false @@ -126,30 +146,51 @@ $name.popup add command -label "Help" -command "popup_action $name 2" }
+ +proc check_font {$fontname} { + # TODO check to see if the requested font exists using [font families] +} + + # ------------------------------------------------------------------------------ # main proc main {argc argv} { # Not all platforms have the console command catch {console show} post_tclinfo - puts stderr "ARGV: $argv" pdtk_post "Starting pd.tk with main($argc $argv)" init + # 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::window_bindings .
+ # TODO move this to its own proc for clarity wm title . "Pd-devel" frame .placeholder label .placeholder.label -text "Pd window placeholder" -width 80 -height 15 pack .placeholder.label .placeholder -side top -expand yes -fill both
- ::pd_connect::connect_to_pd [lindex $argv 0] + if {$argc == 1} { + # 'pd' is starting first, so get the port to connect to + set portnumber [lindex $argv 0] + if { ! [string is int $portnumber]} { + puts stderr "ERROR: port $portnumber is not an int, exiting!" + exit 2 + } + ::pd_connect::to_pd $portnumber + } else { + # the GUI is starting first, so create socket and exec 'pd' + set portnumber [::pd_connect::create_socket] + set pd_exec [file join [file dirname [info script]] ../bin/pd] + exec -- $pd_exec -guiport $portnumber & + #TODO add vwait so that pd-gui will exit if pd never shows up + } }
-main $argc $argv +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-12 19:29:07 UTC (rev 10521) +++ branches/pd-devel/0.41.4/src/pd_bindings.tcl 2009-01-12 23:01:33 UTC (rev 10522) @@ -52,7 +52,7 @@ wm protocol . WM_DELETE_WINDOW "menu_quit"
# do window maintenance when entering the Pd window (Window menu, scrollbars, etc) - #bind $name <Enter> {pdtk_pdwindowmaintenance} + #bind $name <FocusIn> {pdtk_pdwindowmaintenance} }
proc ::pd_bindings::panel_bindings {name} { @@ -72,6 +72,7 @@
window_bindings $name
+ # key bindings ------------------------------------------------------------- bind $name <$modifier-Key-1> "menu_object $name 1" bind $name <$modifier-Key-2> "menu_message $name 1" bind $name <$modifier-Key-3> "menu_floatatom $name 1" @@ -100,21 +101,34 @@ bind $name <$modifier-Shift-Key-U> "menu_vumeter" bind $name <$modifier-Shift-Key-V> "menu_vslider" bind $name <$modifier-Shift-Key-Z> "menu_redo $name" - + if {[tk windowingsystem] eq "aqua"} { - bind $name <Mod1-Key-m> "menu_minimize $name" - bind $name <Mod1-Key-t> "menu_font $name" + bind $name <$modifier-Key-m> "menu_minimize $name" + bind $name <$modifier-Key-t> "menu_font $name" + bind $name <$modifier-quoteleft> "menu_raisenextwindow" } else { - bind $name <Control-Key-m> "menu_send $name" - bind $name <Control-Key-t> "menu_texteditor $name" + bind $name <$modifier-Key-m> "menu_send $name" + bind $name <$modifier-Key-t> "menu_texteditor $name" }
+ # mouse bindings ----------------------------------------------------------- # TODO add mouse button bindings + bind $name <Motion> "pdtk_canvas_motion %W %x %y 0" + bind $name <Button> "pdtk_canvas_mouse %W %x %y %b 0" + bind $name <ButtonRelease> "pdtk_canvas_mouseup %W %x %y %b" + bind $name <$modifier-Button> "pdtk_canvas_rightclick %W %x %y %b" + #TODO bind $name <MouseWheel>
- # do window maintenance when entering a window (Window menu, scrollbars, etc) - #bind $name <Enter> {pdtk_canvaswindowmaintenance} + # event bindings ----------------------------------------------------------- + bind $name <Map> "pdtk_canvas_map %W" + bind $name <Unmap> "pdtk_canvas_unmap %W" + #TODO bind $name <Configure> "pdtk_canvas_getscroll %W"
- # Tcl event bindings + # do window maintenance when entering a window (Window menu, scrollbars...) + # maybe use WM_TAKE_FOCUS for this? + #bind $name <FocusIn> {pdtk_canvaswindowmaintenance} + + # window protocol bindings wm protocol $name WM_DELETE_WINDOW "menu_close $name" }
Modified: branches/pd-devel/0.41.4/src/pd_connect.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_connect.tcl 2009-01-12 19:29:07 UTC (rev 10521) +++ branches/pd-devel/0.41.4/src/pd_connect.tcl 2009-01-12 23:01:33 UTC (rev 10522) @@ -4,28 +4,51 @@ namespace eval ::pd_connect:: { variable pd_socket
- namespace export connect_to_pd + namespace export to_pd + namespace export create_socket namespace export pd }
-proc ::pd_connect::connect_to_pd {portnumber} { +proc ::pd_connect::configure_socket {sock} { + fconfigure $sock -blocking 1 -buffering line + fileevent $sock readable {::pd_connect::pd_readsocket ""} +} + +# if pd opens first, it starts pd-gui, then pd-gui connects to port 5400 +proc ::pd_connect::to_pd {port} { variable pd_socket - puts stderr "Connecting to localhost $portnumber ..." - if {[catch {set pd_socket [socket localhost $portnumber]}]} { - puts stderr "WARNING: connect to pd failed, retrying port $portnumber." - after 1000 ::pd_connect::connect_to_pd $portnumber + puts stderr "Connecting to localhost $port ..." + if {[catch {set pd_socket [socket localhost $port]}]} { + puts stderr "WARNING: connect to pd failed, retrying port $port." + after 1000 ::pd_connect::to_pd $port return } - puts stderr "Connected to pd on port $portnumber" - fconfigure $pd_socket -blocking 1 -buffering line - fileevent $pd_socket readable {::pd_connect::pd_readsocket ""} + ::pd_connect::configure_socket $pd_socket }
+# if pd-gui opens first, it creates socket, and pd connects to port 5600. If +# it can't create, then it keeps adding 1 to the port and tries again +proc ::pd_connect::create_socket {} { + if {[catch {set sock [socket -server ::pd_connect::from_pd -myaddr localhost 0]}]} { + puts stderr "ERROR: failed to allocate port, exiting!" + exit 3 + } + puts "sock $sock" + return [lindex [fconfigure $sock -sockname] 2] +} + +proc ::pd_connect::from_pd {channel clientaddr clientport} { + variable pd_socket $channel + puts "Connection from $clientaddr:$clientport registered" + ::pd_connect::configure_socket $pd_socket +} + # send a message from Tcl to Pd proc ::pd_connect::pd {message} { variable pd_socket - if {$pd_socket == ""} {error "Not connected to 'pd' process"} - puts $pd_socket $message + if {[catch {puts $pd_socket $message}]} { + error "Not connected to 'pd' process" + } }
# figure out which namespace the eval is using... this probably needs to be
Modified: branches/pd-devel/0.41.4/src/pd_menucommands.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_menucommands.tcl 2009-01-12 19:29:07 UTC (rev 10521) +++ branches/pd-devel/0.41.4/src/pd_menucommands.tcl 2009-01-12 23:01:33 UTC (rev 10522) @@ -34,10 +34,8 @@ variable untitled_number variable untitled_directory pd [concat pd filename Untitled-$untitled_number $untitled_directory ;] - pd { - #N canvas; - #X pop 1; - } + pd "#N canvas ;" + pd "#X pop 1 ;" set untitled_number [expr $untitled_number + 1] }
@@ -56,12 +54,118 @@ # ------------------------------------------------------------------------------ # functions called from Edit menu
+proc ::pd_menucommands::menu_cut {name} { + pd [concat $name cut ;] +} + +proc ::pd_menucommands::menu_copy {name} { + pd [concat $name copy ;] +} + +proc ::pd_menucommands::menu_paste {name} { + pd [concat $name paste ;] +} + +proc ::pd_menucommands::menu_duplicate {name} { + pd [concat $name duplicate ;] +} + +proc ::pd_menucommands::menu_selectall {name} { + pd [concat $name selectall ;] +} + +proc ::pd_menucommands::menu_texteditor {name} { + pd [concat $name texteditor ;] +} + +proc ::pd_menucommands::menu_font {name} { + pd [concat $name menufont ;] +} + +proc ::pd_menucommands::menu_tidyup {name} { + pd [concat $name tidy ;] +} + +proc ::pd_menucommands::menu_editmode {name} { + pd [concat $name editmode 0 ;] +} + proc ::pd_menucommands::menu_preferences {args} { toplevel .preferences wm title .preferences "Preferences" + # TODO insert real preference panel here }
+ # ------------------------------------------------------------------------------ +# functions called from Put menu + +proc ::pd_menucommands::menu_object {name accel} { + pd [concat $name obj $accel ;] +} + +proc ::pd_menucommands::menu_message {name accel} { + pd [concat $name msg $accel ;] +} + +proc ::pd_menucommands::menu_floatatom {name accel} { + pd [concat $name floatatom $accel ;] +} + +proc ::pd_menucommands::menu_symbolatom {name accel} { + pd [concat $name symbolatom $accel ;] +} + +proc ::pd_menucommands::menu_comment {name accel} { + pd [concat $name text $accel ;] +} + +proc ::pd_menucommands::menu_graph {name} { + pd [concat $name graph ;] +} + +proc ::pd_menucommands::menu_array {name} { + pd [concat $name menuarray ;] +} + +############iemlib################## +proc ::pd_menucommands::menu_bng {name accel} { + pd [concat $name bng $accel ;] +} + +proc ::pd_menucommands::menu_toggle {name accel} { + pd [concat $name toggle $accel ;] +} + +proc ::pd_menucommands::menu_numbox {name accel} { + pd [concat $name numbox $accel ;] +} + +proc ::pd_menucommands::menu_vslider {name accel} { + pd [concat $name vslider $accel ;] +} + +proc ::pd_menucommands::menu_hslider {name accel} { + pd [concat $name hslider $accel ;] +} + +proc ::pd_menucommands::menu_hradio {name accel} { + pd [concat $name hradio $accel ;] +} + +proc ::pd_menucommands::menu_vradio {name accel} { + pd [concat $name vradio $accel ;] +} + +proc ::pd_menucommands::menu_vumeter {name accel} { + pd [concat $name vumeter $accel ;] +} + +proc ::pd_menucommands::menu_mycnv {name accel} { + pd [concat $name mycnv $accel ;] +} + +# ------------------------------------------------------------------------------ # window management functions
Modified: branches/pd-devel/0.41.4/src/pd_menus.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_menus.tcl 2009-01-12 19:29:07 UTC (rev 10521) +++ branches/pd-devel/0.41.4/src/pd_menus.tcl 2009-01-12 23:01:33 UTC (rev 10522) @@ -103,18 +103,18 @@
proc ::pd_menus::create_file_menu_win32 {rootmenu} { variable accelerator - $rootmenu add command -label [say "new_file"] -accelerator "$accelerator+N" - $rootmenu add command -label [say "Open"] -accelerator "$accelerator+O" + $rootmenu add command -label [say "new_file"] -accelerator "$accelerator+N" + $rootmenu add command -label [say "Open"] -accelerator "$accelerator+O" $rootmenu add separator - $rootmenu add command -label [say "Save"] -accelerator "$accelerator+S" + $rootmenu add command -label [say "Save"] -accelerator "$accelerator+S" $rootmenu add command -label [say "Save As..."] -accelerator "Shift+$accelerator+S" # $rootmenu add command -label "Revert" $rootmenu add separator - $rootmenu add command -label [say "Message"] -accelerator "$accelerator+M" - $rootmenu add command -label [say "Print..."] -accelerator "$accelerator+P" + $rootmenu add command -label [say "Message"] -accelerator "$accelerator+M" + $rootmenu add command -label [say "Print..."] -accelerator "$accelerator+P" $rootmenu add separator - $rootmenu add command -label [say "Close"] -accelerator "$accelerator+W" - $rootmenu add command -label [say "Quit"] -accelerator "$accelerator+Q" \ + $rootmenu add command -label [say "Close"] -accelerator "$accelerator+W" + $rootmenu add command -label [say "Quit"] -accelerator "$accelerator+Q"\ -command "menu_quit" }
@@ -195,13 +195,13 @@
proc ::pd_menus::create_put_menu {rootmenu name} { variable accelerator - $rootmenu add command -label [say "Object"] -accelerator "$accelerator+1" \ + $rootmenu add command -label [say "Object"] -accelerator "$accelerator+1" \ -command "menu_object $name 0" $rootmenu add command -label [say "Message"] -accelerator "$accelerator+2" \ -command "menu_message $name 0" - $rootmenu add command -label [say "Number"] -accelerator "$accelerator+3" \ + $rootmenu add command -label [say "Number"] -accelerator "$accelerator+3" \ -command "menu_floatatom $name 0" - $rootmenu add command -label [say "Symbol"] -accelerator "$accelerator+4" \ + $rootmenu add command -label [say "Symbol"] -accelerator "$accelerator+4" \ -command "menu_symbolatom $name 0" $rootmenu add command -label [say "Comment"] -accelerator "$accelerator+5" \ -command "menu_comment $name 0"
Added: branches/pd-devel/0.41.4/src/pdtk_canvas.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pdtk_canvas.tcl (rev 0) +++ branches/pd-devel/0.41.4/src/pdtk_canvas.tcl 2009-01-12 23:01:33 UTC (rev 10522) @@ -0,0 +1,51 @@ + +package provide pdtk_canvas 0.1 + +namespace eval ::pdtk_canvas:: { +} + + +# check or uncheck the "edit" menu item +proc pdtk_canvas_editval {name value} { + $name.m.edit entryconfigure "Edit mode" -indicatoron $value +} + +proc pdtk_canvas_getscroll {name} { + # TODO make this work +} + + +#------------------------------------------------------------------------------# +# mouse usage + +proc pdtk_canvas_motion {name x y mods} { + pd "$name motion [$name.c canvasx $x] [$name.c canvasy $y] $mods ;" +} + +proc pdtk_canvas_mouse {name x y b f} { + # TODO perhaps the Tcl/C function names should match "mouse" message + # rather than "mousedown" function + pd "$name mouse [$name.c canvasx $x] [$name.c canvasy $y] $b $f ;" +} + +proc pdtk_canvas_mouseup {name x y b} { + pd "$name mouseup [$name.c canvasx $x] [$name.c canvasy $y] $b ;" +} + +proc pdtk_canvas_rightclick {name x y b} { + pd "$name mouse [$name.c canvasx $x] [$name.c canvasy $y] $b 8 ;" +} + +#------------------------------------------------------------------------------# +# procs for canvas events + +# "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} { + pd "$name map 1 ;" +} + +proc pdtk_canvas_unmap {name} { + pd "$name map 0 ;" +}
Added: branches/pd-devel/0.41.4/src/pdtk_text.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pdtk_text.tcl (rev 0) +++ branches/pd-devel/0.41.4/src/pdtk_text.tcl 2009-01-12 23:01:33 UTC (rev 10522) @@ -0,0 +1,27 @@ + +package provide pdtk_text 0.1 + +set font_family "Monaco" +set font_weight "normal" +#set default_font_family "Bitstream Vera Sans Mono" + +# TODO use a Tk 'font' as the main font + +############ pdtk_text_new -- create a new text object #2########### +proc pdtk_text_new {canvasname itemname x y text font_size color} { + global font_family font_weight + $canvasname create text $x $y -font "$font_family $font_size $font_weight" \ + -tags $itemname -text $text -fill $color -anchor nw + $canvasname bind $itemname <Home> "$canvasname icursor $itemname 0" + $canvasname bind $itemname <End> "$canvasname icursor $itemname end" + if {[tk windowingsystem] eq "aqua"} { # emacs bindings for Mac OS X + $canvasname bind $itemname <Control-a> "$canvasname icursor $itemname 0" + $canvasname bind $itemname <Control-e> "$canvasname icursor $itemname end" + } +} + +################ pdtk_text_set -- change the text ################## +proc pdtk_text_set {canvasname itemname text} { + $canvasname itemconfig $itemname -text $text +} +
Modified: branches/pd-devel/0.41.4/src/pkgIndex.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pkgIndex.tcl 2009-01-12 19:29:07 UTC (rev 10521) +++ branches/pd-devel/0.41.4/src/pkgIndex.tcl 2009-01-12 23:01:33 UTC (rev 10522) @@ -15,4 +15,6 @@ package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus.tcl]] package ifneeded pd_post 0.1 [list source [file join $dir pd_post.tcl]] package ifneeded pd_say 0.1 [list source [file join $dir pd_say.tcl]] +package ifneeded pdtk_canvas 0.1 [list source [file join $dir pdtk_canvas.tcl]] +package ifneeded pdtk_text 0.1 [list source [file join $dir pdtk_text.tcl]] package ifneeded wheredoesthisgo 0.1 [list source [file join $dir wheredoesthisgo.tcl]]
Modified: branches/pd-devel/0.41.4/src/wheredoesthisgo.tcl =================================================================== --- branches/pd-devel/0.41.4/src/wheredoesthisgo.tcl 2009-01-12 19:29:07 UTC (rev 10521) +++ branches/pd-devel/0.41.4/src/wheredoesthisgo.tcl 2009-01-12 23:01:33 UTC (rev 10522) @@ -7,11 +7,11 @@
proc post_tclinfo {} { - pdtk_post [concat Tcl library: [info library]] - pdtk_post [concat executable: [info nameofexecutable]] - pdtk_post [concat tclversion: [info tclversion]] - pdtk_post [concat patchlevel: [info patchlevel]] - pdtk_post [concat sharedlibextension: [info sharedlibextension]] + pdtk_post "Tcl library: [info library]" + pdtk_post "executable: [info nameofexecutable]" + pdtk_post "tclversion: [info tclversion]" + pdtk_post "patchlevel: [info patchlevel]" + pdtk_post "sharedlibextension: [info sharedlibextension]" }
@@ -32,7 +32,10 @@ } }
+# ------------------------------------------------------------------------------ +# lost pdtk functions...
+ # ------------------------------------------------------------------------------ # kludges to avoid changing C code
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
-
eighthaveï¼ users.sourceforge.net