From 21c068f1916330e90f814bed461fe0821d1665ec Mon Sep 17 00:00:00 2001
From: Hans-Christoph Steiner <eighthave@users.sourceforge.net>
Date: Sun, 9 Oct 2011 16:36:37 +0000
Subject: checked in pd-0.43-0.src.tar.gz

svn path=/trunk/; revision=15557
---
 pd/tcl/pdtk_canvas.tcl | 333 +++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 264 insertions(+), 69 deletions(-)

(limited to 'pd/tcl/pdtk_canvas.tcl')

diff --git a/pd/tcl/pdtk_canvas.tcl b/pd/tcl/pdtk_canvas.tcl
index 31505cec..c1a85420 100644
--- a/pd/tcl/pdtk_canvas.tcl
+++ b/pd/tcl/pdtk_canvas.tcl
@@ -4,38 +4,103 @@ package provide pdtk_canvas 0.1
 package require pd_bindings
 
 namespace eval ::pdtk_canvas:: {
+    namespace export pdtk_canvas_popup
+    namespace export pdtk_canvas_editmode
+    namespace export pdtk_canvas_getscroll
+    namespace export pdtk_canvas_setparents
+    namespace export pdtk_canvas_reflecttitle
+    namespace export pdtk_canvas_menuclose
 }
 
+# One thing that is tricky to understand is the difference between a Tk
+# 'canvas' and a 'canvas' in terms of Pd's implementation.  They are similar,
+# but not the same thing.  In Pd code, a 'canvas' is basically a patch, while
+# the Tk 'canvas' is the backdrop for drawing everything that is in a patch.
+# The Tk 'canvas' is contained in a 'toplevel' window. That window has a Tk
+# class of 'PatchWindow'.
+
 # TODO figure out weird frameless window when you open a graph
 
+
+#TODO: http://wiki.tcl.tk/11502
+# MS Windows
+#wm geometry . returns contentswidthxcontentsheight+decorationTop+decorationLeftEdge.
+#and
+#winfo rooty . returns contentsTop
+#winfo rootx . returns contentsLeftEdge
+
+
 #------------------------------------------------------------------------------#
 # canvas new/saveas
 
 proc pdtk_canvas_new {mytoplevel width height geometry editable} {
-    # TODO check size of window
-    toplevel $mytoplevel -width $width -height $height -class CanvasWindow
+    set screenwidth [winfo screenwidth .]
+    set screenheight [winfo screenheight .]
+
+    # read back the current geometry +posx+posy into variables
+    scan $geometry {%[+]%d%[+]%d} - x - y
+    # fit the geometry onto screen
+    set x [ expr $x % $screenwidth - $::windowframex]
+    set y [ expr $y % $screenheight - $::windowframey]
+    if {$width > $screenwidth} {
+        set width $screenwidth
+        set x 0
+    }
+    if {$height > $screenheight} {
+        set height [expr $screenheight - $::menubarsize - 30] ;# 30 for window framing
+        set y $::menubarsize
+    }
+    set geometry ${width}x$height+$x+$y
+
+    # release the window grab here so that the new window will
+    # properly get the Map and FocusIn events when its created
+    ::pdwindow::busyrelease
+    # set the loaded array for this new window so things can track state
+    set ::loaded($mytoplevel) 0
+    toplevel $mytoplevel -width $width -height $height -class PatchWindow
     wm group $mytoplevel .
-    $mytoplevel configure -menu .menubar
+    $mytoplevel configure -menu $::patch_menubar
+
+    # we have to wait until $mytoplevel exists before we can generate
+    # a <<Loading>> event for it, that's why this is here and not in the
+    # started_loading_file proc.  Perhaps this doesn't make sense tho
+    event generate $mytoplevel <<Loading>>
 
-    # TODO slide off screen windows into view
     wm geometry $mytoplevel $geometry
-    if {$::windowingsystem eq "aqua"} { # no menubar, it can be small
-        wm minsize $mytoplevel 50 20
-    } else { # leave room for the menubar
-        wm minsize $mytoplevel 310 30
-    }
-    
-    set ::editmode($mytoplevel) $editable
+    wm minsize $mytoplevel $::canvas_minwidth $::canvas_minheight
 
-    set mycanvas $mytoplevel.c
-    canvas $mycanvas -width $width -height $height -background white \
-        -highlightthickness 0
-    # TODO add scrollbars here
-    pack $mycanvas -side left -expand 1 -fill both
+    set tkcanvas [tkcanvas_name $mytoplevel]
+    canvas $tkcanvas -width $width -height $height \
+        -highlightthickness 0 -scrollregion [list 0 0 $width $height] \
+        -xscrollcommand "$mytoplevel.xscroll set" \
+        -yscrollcommand "$mytoplevel.yscroll set"
+    scrollbar $mytoplevel.xscroll -orient horizontal -command "$tkcanvas xview"
+    scrollbar $mytoplevel.yscroll -orient vertical -command "$tkcanvas yview"
+    pack $tkcanvas -side left -expand 1 -fill both
+
+    ::pd_bindings::patch_bindings $mytoplevel
+
+    # give focus to the canvas so it gets the events rather than the window 	 
+    focus $tkcanvas
 
-    ::pd_bindings::canvas_bindings $mytoplevel
+    # let the scrollbar logic determine if it should make things scrollable
+    set ::xscrollable($tkcanvas) 0
+    set ::yscrollable($tkcanvas) 0
 
-    # give focus to the canvas so it gets the events rather than the window
+    # init patch properties arrays
+    set ::editingtext($mytoplevel) 0
+    set ::childwindows($mytoplevel) {}
+
+    # this should be at the end so that the window and canvas are all ready
+    # before this variable changes.
+    set ::editmode($mytoplevel) $editable
+}
+
+# if the patch canvas window already exists, then make it come to the front
+proc pdtk_canvas_raise {mytoplevel} {
+    wm deiconify $mytoplevel
+    raise $mytoplevel
+    set mycanvas $mytoplevel.c
     focus $mycanvas
 }
 
@@ -61,36 +126,60 @@ proc pdtk_canvas_saveas {name initialfile initialdir} {
     set dirname [file dirname $filename]
     set basename [file tail $filename]
     pdsend "$name savetofile [enquote_path $basename] [enquote_path $dirname]"
-    set ::pd_menucommands::menu_new_dir $dirname
+    set ::filenewdir $dirname
+}
+
+##### ask user Save? Discard? Cancel?, and if so, send a message on to Pd ######
+proc ::pdtk_canvas::pdtk_canvas_menuclose {mytoplevel reply_to_pd} {
+    raise $mytoplevel
+    set filename [wm title $mytoplevel]
+    set message [format {Do you want to save the changes you made in "%s"?} $filename]
+    set answer [tk_messageBox -message $message -type yesnocancel -default "yes" \
+                    -parent $mytoplevel -icon question]
+    switch -- $answer {
+        yes { 
+            pdsend "$mytoplevel menusave"
+            if {[regexp {Untitled-[0-9]+} $filename]} {
+                # wait until pdtk_canvas_saveas finishes and writes to
+                # this var, otherwise the close command will be sent
+                # immediately and the file won't get saved
+                vwait ::filenewdir
+            }
+            pdsend $reply_to_pd
+        }
+        no {pdsend $reply_to_pd}
+        cancel {}
+    }
 }
 
 #------------------------------------------------------------------------------#
 # mouse usage
 
-proc pdtk_canvas_motion {mycanvas x y mods} {
-    set mytoplevel [winfo toplevel $mycanvas]
-    pdsend "$mytoplevel motion [$mycanvas canvasx $x] [$mycanvas canvasy $y] $mods"
+# TODO put these procs into the pdtk_canvas namespace
+proc pdtk_canvas_motion {tkcanvas x y mods} {
+    set mytoplevel [winfo toplevel $tkcanvas]
+    pdsend "$mytoplevel motion [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $mods"
 }
 
-proc pdtk_canvas_mouse {mycanvas x y b f} {
-    set mytoplevel [winfo toplevel $mycanvas]
-    pdsend "$mytoplevel mouse [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b $f"
+proc pdtk_canvas_mouse {tkcanvas x y b f} {
+    set mytoplevel [winfo toplevel $tkcanvas]
+    pdsend "$mytoplevel mouse [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b $f"
 }
 
-proc pdtk_canvas_mouseup {mycanvas x y b} {
-    set mytoplevel [winfo toplevel $mycanvas]
-    pdsend "$mytoplevel mouseup [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b"
+proc pdtk_canvas_mouseup {tkcanvas x y b} {
+    set mytoplevel [winfo toplevel $tkcanvas]
+    pdsend "$mytoplevel mouseup [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b"
 }
 
-proc pdtk_canvas_rightclick {mycanvas x y b} {
-    set mytoplevel [winfo toplevel $mycanvas]
-    pdsend "$mytoplevel mouse [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b 8"
+proc pdtk_canvas_rightclick {tkcanvas x y b} {
+    set mytoplevel [winfo toplevel $tkcanvas]
+    pdsend "$mytoplevel mouse [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b 8"
 }
 
 # on X11, button 2 pastes from X11 clipboard, so simulate normal paste actions
-proc pdtk_canvas_clickpaste {mycanvas x y b} {
-    pdtk_canvas_mouse $mycanvas $x $y $b 0
-    pdtk_canvas_mouseup $mycanvas $x $y $b
+proc pdtk_canvas_clickpaste {tkcanvas x y b} {
+    pdtk_canvas_mouse $tkcanvas $x $y $b 0
+    pdtk_canvas_mouseup $tkcanvas $x $y $b
     pdtk_pastetext
 }
 
@@ -107,21 +196,21 @@ proc ::pdtk_canvas::create_popup {} {
         # the popup menu for the canvas
         menu .popup -tearoff false
         .popup add command -label [_ "Properties"] \
-            -command {popup_action $::focused_window 0}
+            -command {::pdtk_canvas::done_popup $::focused_window 0}
         .popup add command -label [_ "Open"]       \
-            -command {popup_action $::focused_window 1}
+            -command {::pdtk_canvas::done_popup $::focused_window 1}
         .popup add command -label [_ "Help"]       \
-            -command {popup_action $::focused_window 2}
+            -command {::pdtk_canvas::done_popup $::focused_window 2}
     }
 }
 
-proc popup_action {mytoplevel action} {
-    pdsend "$mytoplevel done-popup $action $::popup_xpix $::popup_ypix"
+proc ::pdtk_canvas::done_popup {mytoplevel action} {
+    pdsend "$mytoplevel done-popup $action $::popup_xcanvas $::popup_ycanvas"
 }
 
-proc pdtk_canvas_popup {mytoplevel xpix ypix hasproperties hasopen} {
-    set ::popup_xpix $xpix
-    set ::popup_ypix $ypix
+proc ::pdtk_canvas::pdtk_canvas_popup {mytoplevel xcanvas ycanvas hasproperties hasopen} {
+    set ::popup_xcanvas $xcanvas
+    set ::popup_ycanvas $ycanvas
     if {$hasproperties} {
         .popup entryconfigure [_ "Properties"] -state normal
     } else {
@@ -132,38 +221,144 @@ proc pdtk_canvas_popup {mytoplevel xpix ypix hasproperties hasopen} {
     } else {
         .popup entryconfigure [_ "Open"] -state disabled
     }
-    set mycanvas "$mytoplevel.c"
-    tk_popup .popup [expr $xpix + [winfo rootx $mycanvas]] \
-        [expr $ypix + [winfo rooty $mycanvas]] 0
+    set tkcanvas [tkcanvas_name $mytoplevel]
+    set scrollregion [$tkcanvas cget -scrollregion]
+    # get the canvas location that is currently the top left corner in the window
+    set left_xview_pix [expr [lindex [$tkcanvas xview] 0] * [lindex $scrollregion 2]]
+    set top_yview_pix [expr [lindex [$tkcanvas yview] 0] * [lindex $scrollregion 3]]
+    # take the mouse clicks in canvas coords, add the root of the canvas
+    # window, and subtract the area that is obscured by scrolling
+    set xpopup [expr int($xcanvas + [winfo rootx $tkcanvas] - $left_xview_pix)]
+    set ypopup [expr int($ycanvas + [winfo rooty $tkcanvas] - $top_yview_pix)]
+    tk_popup .popup $xpopup $ypopup 0
 }
 
 
+#------------------------------------------------------------------------------#
+# procs for when file loading starts/finishes
+
+proc ::pdtk_canvas::started_loading_file {patchname} {
+    ::pdwindow::busygrab
+}
+
+# things to run when a patch is finished loading.  This is called when
+# the OS sends the "Map" event for this window.
+proc ::pdtk_canvas::finished_loading_file {mytoplevel} {
+    # ::pdwindow::busyrelease is in pdtk_canvas_new so that the grab
+    # is released before the new toplevel window gets created.
+    # Otherwise the grab blocks the new window from getting the
+    # FocusIn event on creation.
+
+    # set editmode to make sure the menu item is in the right state
+    pdtk_canvas_editmode $mytoplevel $::editmode($mytoplevel)
+    set ::loaded($mytoplevel) 1
+    # send the virtual events now that everything is loaded
+    event generate $mytoplevel <<Loaded>>
+}
+
 #------------------------------------------------------------------------------#
 # procs for canvas events
 
 # check or uncheck the "edit" menu item
-proc pdtk_canvas_editval {mytoplevel value} {
-    set ::editmode($mytoplevel) $value
-# TODO figure how to change Edit Mode/Interact Mode text and have menu
-# enabling and disabling working still in pd_menus.tcl
-#    if {$value == 0} {
-#        $::pd_menus::menubar.edit entryconfigure [_ "Interact Mode"] -label [_ "Edit Mode"]
-#    } else {
-#        $::pd_menus::menubar.edit entryconfigure [_ "Edit Mode"] -label [_ "Interact Mode"]
-#    }
-    #$mytoplevel.menubar.edit entryconfigure [_ "Edit Mode"] -indicatoron $value
-    # TODO make this work, probably with a proc in pd_menus, or maybe the menu
-    # item can track the editmode variable
-}
-
-proc pdtk_undomenu {args} {
-    # TODO make this work, probably with a proc in pd_menus    
-    puts "pdtk_undomenu $args"
-}
-
-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::pdtk_canvas_editmode {mytoplevel state} {
+    set ::editmode_button $state
+    set ::editmode($mytoplevel) $state
+    event generate $mytoplevel <<EditMode>>
+    # can't change the menu background color on Aqua
+    if {$::windowingsystem eq "aqua"} {return}
+    if {$state == 0} {
+        $::pd_menus::menubar.edit entryconfigure [_ "Edit Mode"] -background {}
+    } else {
+        $::pd_menus::menubar.edit entryconfigure [_ "Edit Mode"] -background green
+    }
+}
+
+# message from Pd to update the currently available undo/redo action
+proc pdtk_undomenu {mytoplevel undoaction redoaction} {
+    set ::undo_toplevel $mytoplevel
+    set ::undo_action $undoaction
+    set ::redo_action $redoaction
+    if {$mytoplevel ne "nobody"} {
+        ::pd_menus::update_undo_on_menu $mytoplevel
+    }
+}
+
+# This proc configures the scrollbars whenever anything relevant has
+# been updated.  It should always receive a tkcanvas, which is then
+# used to generate the mytoplevel, needed to address the scrollbars.
+proc ::pdtk_canvas::pdtk_canvas_getscroll {tkcanvas} {
+    set mytoplevel [winfo toplevel $tkcanvas]    
+    set bbox [$tkcanvas bbox all]
+    if {$bbox eq "" || [llength $bbox] != 4} {return}
+    set xupperleft [lindex $bbox 0]
+    set yupperleft [lindex $bbox 1]
+    if {$xupperleft > 0} {set xupperleft 0}
+    if {$yupperleft > 0} {set yupperleft 0}
+    set scrollregion [concat $xupperleft $yupperleft [lindex $bbox 2] [lindex $bbox 3]]
+    $tkcanvas configure -scrollregion $scrollregion
+    # X scrollbar
+    if {[lindex [$tkcanvas xview] 0] == 0.0 && [lindex [$tkcanvas xview] 1] == 1.0} {
+        set ::xscrollable($tkcanvas) 0
+        pack forget $mytoplevel.xscroll
+    } else {
+        set ::xscrollable($tkcanvas) 1
+        pack $mytoplevel.xscroll -side bottom -fill x -before $tkcanvas
+    }
+    # Y scrollbar, it gets touchy at the limit, so say > 0.995
+    if {[lindex [$tkcanvas yview] 0] == 0.0 && [lindex [$tkcanvas yview] 1] > 0.995} {
+        set ::yscrollable($tkcanvas) 0
+        pack forget $mytoplevel.yscroll
+    } else {
+        set ::yscrollable($tkcanvas) 1
+        pack $mytoplevel.yscroll -side right -fill y -before $tkcanvas
+    }
+}
+
+proc ::pdtk_canvas::scroll {tkcanvas axis amount} {
+    if {$axis eq "x" && $::xscrollable($tkcanvas) == 1} {
+        $tkcanvas xview scroll [expr {- ($amount)}] units
+    }
+    if {$axis eq "y" && $::yscrollable($tkcanvas) == 1} {
+        $tkcanvas yview scroll [expr {- ($amount)}] units
+    }
+}
+
+#------------------------------------------------------------------------------#
+# get patch window child/parent relationships
+
+# add a child window ID to the list of children, if it isn't already there
+proc ::pdtk_canvas::addchild {mytoplevel child} {
+    # if either ::childwindows($mytoplevel) does not exist, or $child does not
+    # exist inside of the ::childwindows($mytoplevel list
+    if { [lsearch -exact [array names ::childwindows $mytoplevel]] == -1 \
+             || [lsearch -exact $::childwindows($mytoplevel) $child] == -1} {
+        set ::childwindows($mytoplevel) [lappend ::childwindows($mytoplevel) $child]
+    }
+}
+
+# receive a list of all my parent windows from 'pd'
+proc ::pdtk_canvas::pdtk_canvas_setparents {mytoplevel args} {
+    set ::parentwindows($mytoplevel) $args
+    foreach parent $args {
+        addchild $parent $mytoplevel
+    }
+}
+
+# receive information for setting the info the the title bar of the window
+proc ::pdtk_canvas::pdtk_canvas_reflecttitle {mytoplevel \
+                                              path name arguments dirty} {
+    set ::windowname($mytoplevel) $name ;# TODO add path to this
+    if {$::windowingsystem eq "aqua"} {
+        wm attributes $mytoplevel -modified $dirty
+        if {[file exists "$path/$name"]} {
+            # for some reason -titlepath can still fail so just catch it 
+            if [catch {wm attributes $mytoplevel -titlepath "$path/$name"}] {
+                wm title $mytoplevel "$path/$name"
+            }
+        }
+        wm title $mytoplevel "$name$arguments"
+    } else {
+        if {$dirty} {set dirtychar "*"} else {set dirtychar " "}
+        wm title $mytoplevel "$name$dirtychar$arguments - $path" 
+    }
 }
-- 
cgit v1.2.1