blob: 656dd32780e789be3f278ef0e4441ad81d0be927 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
package provide pdtk_canvas 0.1
package require pd_bindings
namespace eval ::pdtk_canvas:: {
}
# keep track of the location of the popup
set popup_xpix 0
set popup_ypix 0
#------------------------------------------------------------------------------#
# 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
::pd_menus::create_menubar $mytoplevel.menubar $mytoplevel
$mytoplevel configure -menu $mytoplevel.menubar
# 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 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
::pd_bindings::canvas_bindings $mytoplevel
# the popup menu for the canvas
menu $mytoplevel.popup -tearoff false
$mytoplevel.popup add command -label [_ "Properties"] \
-command "popup_action $mytoplevel 0"
$mytoplevel.popup add command -label [_ "Open"] \
-command "popup_action $mytoplevel 1"
$mytoplevel.popup add command -label [_ "Help"] \
-command "popup_action $mytoplevel 2"
# give focus to the canvas so it gets the events rather than the window
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 ::pd_menucommands::menu_new_dir $dirname
}
#------------------------------------------------------------------------------#
# 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"
}
proc pdtk_canvas_mouse {mycanvas x y b f} {
# TODO perhaps the Tcl/C function names should match "mouse" message
# rather than "mousedown" function
set mytoplevel [winfo toplevel $mycanvas]
pdsend "$mytoplevel mouse [$mycanvas canvasx $x] [$mycanvas 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_rightclick {mycanvas x y b} {
set mytoplevel [winfo toplevel $mycanvas]
pdsend "$mytoplevel mouse [$mycanvas canvasx $x] [$mycanvas 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
pdtk_pastetext
}
#------------------------------------------------------------------------------#
# canvas popup menu
proc popup_action {mytoplevel action} {
pdsend "$mytoplevel done-popup $action $::popup_xpix $::popup_ypix"
}
proc pdtk_canvas_popup {mytoplevel xpix ypix hasproperties hasopen} {
set ::popup_xpix $xpix
set ::popup_ypix $ypix
if {$hasproperties} {
$mytoplevel.popup entryconfigure 0 -state normal
} else {
$mytoplevel.popup entryconfigure 0 -state disabled
}
if {$hasopen} {
$mytoplevel.popup entryconfigure 1 -state normal
} else {
$mytoplevel.popup entryconfigure 1 -state disabled
}
set mycanvas "$mytoplevel.c"
tk_popup $mytoplevel.popup [expr $xpix + [winfo rootx $mycanvas]] \
[expr $ypix + [winfo rooty $mycanvas]] 0
}
#------------------------------------------------------------------------------#
# procs for canvas events
# check or uncheck the "edit" menu item
proc pdtk_canvas_editval {mytoplevel value} {
$mytoplevel.menubar.edit invoke [_ "Edit Mode"]
# $mytoplevel.menubar.edit entryconfigure "Edit Mode" -indicatoron $value
# TODO make this work
}
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_undomenu {args} {
# TODO make this work
puts "pdtk_undomenu $args"
}
|
