SF.net SVN: pure-data:[10525] branches/pd-devel/0.41.4/src - Pd-cvs

13 Jan 2009

Revision: 10525
          http://pure-data.svn.sourceforge.net/pure-data/?rev=10525&view=rev
Author:   eighthave
Date:     2009-01-13 04:18:07 +0000 (Tue, 13 Jan 2009)
Log Message:
-----------
- w00t! I can load patch, see it, and make sound!
- I forgot to 'pack' the canvas, so it wasn't showing up
- I had to reintroduce "canvastosym" as "to_top" and bind mouse events to the
  canvas rather than the toplevel because otherwise bind's %W would give
  .x246570 for toplevel events and .x246570.c for canvas events
- converted mouse binding functions to use to_top
- moved the ::pd_bindings::canvas_bindings to after the canvas is created,
  since  ::pd_bindings::canvas_bindings needs to bind events to the canvas
- added menu_audio and bindings
- added Ctrl-click binding for Mac OS X and Button-2 for X11
Modified Paths:
--------------
    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/pdtk_canvas.tcl
Modified: branches/pd-devel/0.41.4/src/pd.tk
===================================================================

--- branches/pd-devel/0.41.4/src/pd.tk	2009-01-13 01:19:49 UTC (rev 10524)
+++ branches/pd-devel/0.41.4/src/pd.tk	2009-01-13 04:18:07 UTC (rev 10525)
@@ -1,8 +1,12 @@
-#!/usr/bin/env wish
+#!/bin/sh
+# This line continues for Tcl, but is a single line for 'sh' \
+	exec wish "$0" -- ${1+"$@"}
 # For information on usage and redistribution, and for a DISCLAIMER OF ALL
 # WARRANTIES, see the file, "LICENSE.txt," in this distribution.
 # Copyright (c) 1997-2009 Miller Puckette.
+puts -------------------------------pd.tk-----------------------------------
+
 package require Tcl 8.3
 package require Tk
@@ -47,9 +51,10 @@
#------------------------------------------------------------------------------#
 # global variables
-# command line options
+set filetypes ""
+
 # for the sake of clarity, I think there should not be any inline code,
 # everything should be in a procedure that is ultimately triggered from main()
 # -hans@eds.org
@@ -85,6 +90,7 @@
 # init functions
proc init {} {
+	global filetypes
    switch -- [tk windowingsystem] {
    	"x11" {
    		# add control to show/hide hidden files in the open panel (load
@@ -148,19 +154,23 @@
    puts stderr "Running pdtk_fixwindowmenu"
 }
+# TODO rename "name" to "topname" to be clear
 proc pdtk_canvas_new {name width height geometry editable} {
    # TODO check size of window
    toplevel $name -width $width -height $height
    ::pd_menus::create_menubar $name.menubar
    $name configure -menu $name.menubar
-	::pd_bindings::canvas_bindings $name
# TODO slide off screen windows into view
    wm geometry $name $geometry
    wm minsize $name 50 20
    canvas $name.c -width $width -height $height -background white \
    	-highlightthickness 0
+	# TODO add scrollbars here
+    pack $name.c -side left -expand 1 -fill both
+	::pd_bindings::canvas_bindings $name
+
    # the popup menu for the canvas
     menu $name.popup -tearoff false
     $name.popup add command -label "Properties" -command "popup_action $name 0"
@@ -168,7 +178,6 @@
     $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]
 }
Modified: branches/pd-devel/0.41.4/src/pd_bindings.tcl
===================================================================
--- branches/pd-devel/0.41.4/src/pd_bindings.tcl	2009-01-13 01:19:49 UTC (rev 10524)
+++ branches/pd-devel/0.41.4/src/pd_bindings.tcl	2009-01-13 04:18:07 UTC (rev 10525)
@@ -88,6 +88,8 @@
    bind $name <$modifier-Key-v>        "menu_paste $name"
    bind $name <$modifier-Key-x>        "menu_cut $name"
    bind $name <$modifier-Key-z>        "menu_undo $name"
+	bind $name <$modifier-Key-slash>    "menu_audio 1"
+	bind $name <$modifier-Key-period>   "menu_audio 0"
# annoying, but Tk's bind needs uppercase letter to get the Shift
    bind $name <$modifier-Shift-Key-B>  "menu_bang"
@@ -112,11 +114,22 @@
    }
# 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"
+	# these need to be bound to $name.c because %W will return $name for
+	# events over the window frame and $name.c for events over the canvas
+    bind $name.c <Motion>                 "pdtk_canvas_motion %W %x %y 0"
+    bind $name.c <Button>                 "pdtk_canvas_mouse %W %x %y %b 0"
+    bind $name.c <ButtonRelease>          "pdtk_canvas_mouseup %W %x %y %b"
+	bind $name.c <$modifier-Button>       "pdtk_canvas_mouse %W %x %y %b 0"
+	# TODO look into "virtual events' for a means for getting Shift-Button, etc.
+	switch {[tk windowingsystem]} { 
+		"aqua" {
+			# on Mac OS X, emulate a rightclick with Ctrl-click
+			bind.c $name <Ctrl-Button>    "pdtk_canvas_rightclick %W %x %y %b"
+		} "x11" {
+			# on X11, button 2 "pastes" from the X windows clipboard
+			bind.c $name <Button-2>       "pdtk_canvas_clickpaste %W %x %y %b"
+		}
+	}
    #TODO bind $name <MouseWheel>
# event bindings -----------------------------------------------------------
Modified: branches/pd-devel/0.41.4/src/pdtk_canvas.tcl
===================================================================
--- branches/pd-devel/0.41.4/src/pdtk_canvas.tcl	2009-01-13 01:19:49 UTC (rev 10524)
+++ branches/pd-devel/0.41.4/src/pdtk_canvas.tcl	2009-01-13 04:18:07 UTC (rev 10525)
@@ -1,41 +1,51 @@
package provide pdtk_canvas 0.1
+package require pd_bindings
+
 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
+# get the name of the toplevel window for a canvas; this is also the name of
+# the canvas object in Pd.  It would probably make more sense if bind's %W returned the window name ($name) rather than the canvas name
+proc to_top {canvasname} {
+    string range $canvasname 0 [expr [string length $canvasname] - 3]
 }
-proc pdtk_canvas_getscroll {name} {
-	# TODO make this work
+proc pdtk_canvas_checkgeometry {topname} {
+	# TODO check and relocate window accordingly
 }
#------------------------------------------------------------------------------#
 # 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_motion {canvasname x y mods} {
+    pd "[to_top $canvasname] motion [$canvasname canvasx $x] [$canvasname canvasy $y] $mods;"
 }
-proc pdtk_canvas_mouse {name x y b f} {
+proc pdtk_canvas_mouse {canvasname 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 ;"
+    pd "[to_top $canvasname] mouse [$canvasname canvasx $x] [$canvasname 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_mouseup {canvasname x y b} {
+    pd "[to_top $canvasname] mouseup [$canvasname canvasx $x] [$canvasname canvasy $y] $b;"
 }
-proc pdtk_canvas_rightclick {name x y b} {
-    pd "$name mouse [$name.c canvasx $x] [$name.c canvasy $y] $b 8 ;"
+proc pdtk_canvas_rightclick {canvasname x y b} {
+    pd "[to_top $canvasname] mouse [$canvasname canvasx $x] [$canvasname canvasy $y] $b 8;"
 }
+# on X11, button 2 "pastes" from the X windows clipboard
+proc pdtk_canvas_clickpaste {canvasname x y b} {
+	pdtk_canvas_click $canvasname $x $y $b 0
+	pdtk_canvas_mouseup $canvasname $x $y $b
+	pdtk_pastetext
+}
+
 #------------------------------------------------------------------------------#
 # procs for canvas events
@@ -49,3 +59,12 @@
 proc pdtk_canvas_unmap {name} {
     pd "$name map 0 ;"
 }
+
+# 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
+}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

    