e85d191b46
- merge v0.01 --> Añadido fileselector - Añadidas fuentes de Gem y Pure Data - pix2jpg incluído en Gem. Archivos de construcción de Gem modificados. - Añadido fichero ompiling.txt con instrucciones de compilación
384 lines
15 KiB
Tcl
384 lines
15 KiB
Tcl
|
|
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
|
|
|
|
|
|
# this proc is split out on its own to make it easy to override. This makes it
|
|
# easy for people to customize these calculations based on their Window
|
|
# Manager, desires, etc.
|
|
proc pdtk_canvas_place_window {width height geometry} {
|
|
set screenwidth [lindex [wm maxsize .] 0]
|
|
set screenheight [lindex [wm maxsize .] 1]
|
|
|
|
# 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
|
|
}
|
|
return [list $width $height ${width}x$height+$x+$y]
|
|
}
|
|
|
|
|
|
#------------------------------------------------------------------------------#
|
|
# canvas new/saveas
|
|
|
|
proc pdtk_canvas_new {mytoplevel width height geometry editable} {
|
|
set l [pdtk_canvas_place_window $width $height $geometry]
|
|
set width [lindex $l 0]
|
|
set height [lindex $l 1]
|
|
set geometry [lindex $l 2]
|
|
|
|
# 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 <<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>>
|
|
|
|
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
|
|
|
|
# for some crazy reason, win32 mousewheel scrolling is in units of
|
|
# 120, and this forces Tk to interpret 120 to mean 1 scroll unit
|
|
if {$::windowingsystem eq "win32"} {
|
|
$tkcanvas configure -xscrollincrement 1 -yscrollincrement 1
|
|
}
|
|
|
|
::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 <<Loaded>>
|
|
}
|
|
|
|
#------------------------------------------------------------------------------#
|
|
# 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 <<EditMode>>
|
|
}
|
|
|
|
# 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"
|
|
}
|
|
}
|