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} { 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 $::patch_menubar # we have to wait until $mytoplevel exists before we can generate # a <> 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 <> wm geometry $mytoplevel $geometry wm minsize $mytoplevel $::canvas_minwidth $::canvas_minheight 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 # let the scrollbar logic determine if it should make things scrollable set ::xscrollable($tkcanvas) 0 set ::yscrollable($tkcanvas) 0 # 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 } proc pdtk_canvas_saveas {name initialfile initialdir} { if { ! [file isdirectory $initialdir]} {set initialdir $::env(HOME)} set filename [tk_getSaveFile -initialfile $initialfile -initialdir $initialdir \ -defaultextension .pd -filetypes $::filetypes] if {$filename eq ""} return; # they clicked cancel set extension [file extension $filename] set oldfilename $filename set filename [regsub -- "$extension$" $filename [string tolower $extension]] if { ! [regexp -- "\.(pd|pat|mxt)$" $filename]} { # we need the file extention even on Mac OS X set filename $filename.pd } # test again after downcasing and maybe adding a ".pd" on the end if {$filename ne $oldfilename && [file exists $filename]} { set answer [tk_messageBox -type okcancel -icon question -default cancel\ -message [_ "\"$filename\" already exists. Do you want to replace it?"]] if {$answer eq "cancel"} return; # they clicked cancel } set dirname [file dirname $filename] set basename [file tail $filename] pdsend "$name savetofile [enquote_path $basename] [enquote_path $dirname]" set ::filenewdir $dirname # add to recentfiles ::pd_guiprefs::update_recentfiles $filename } ##### 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 # 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 {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 {tkcanvas x y b} { set mytoplevel [winfo toplevel $tkcanvas] pdsend "$mytoplevel mouseup [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b" } 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 {tkcanvas x y b} { pdtk_canvas_mouse $tkcanvas $x $y $b 0 pdtk_canvas_mouseup $tkcanvas $x $y $b if { [catch {set pdtk_pastebuffer [selection get]}] } { # no selection... do nothing } else { for {set i 0} {$i < [string length $pdtk_pastebuffer]} {incr i 1} { set cha [string index $pdtk_pastebuffer $i] scan $cha %c keynum pdsend "pd key 1 $keynum 0" } } } #------------------------------------------------------------------------------# # canvas popup menu # since there is one popup that is used for all canvas windows, the menu # -commands use {} quotes so that $::focused_window is interpreted when the # menu item is called, not when the command is mapped to the menu item. This # is the same as the menubar in pd_menus.tcl but the opposite of the 'bind' # commands in pd_bindings.tcl proc ::pdtk_canvas::create_popup {} { if { ! [winfo exists .popup]} { # the popup menu for the canvas menu .popup -tearoff false .popup add command -label [_ "Properties"] \ -command {::pdtk_canvas::done_popup $::focused_window 0} .popup add command -label [_ "Open"] \ -command {::pdtk_canvas::done_popup $::focused_window 1} .popup add command -label [_ "Help"] \ -command {::pdtk_canvas::done_popup $::focused_window 2} } } proc ::pdtk_canvas::done_popup {mytoplevel action} { pdsend "$mytoplevel done-popup $action $::popup_xcanvas $::popup_ycanvas" } 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 { .popup entryconfigure [_ "Properties"] -state disabled } if {$hasopen} { .popup entryconfigure [_ "Open"] -state normal } else { .popup entryconfigure [_ "Open"] -state disabled } 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 <> } #------------------------------------------------------------------------------# # procs for canvas events # check or uncheck the "edit" menu item proc ::pdtk_canvas::pdtk_canvas_editmode {mytoplevel state} { set ::editmode_button $state set ::editmode($mytoplevel) $state event generate $mytoplevel <> } # 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" } }