obj method canvaseditor basicBindings {{onoff on}} {
set canvas [my canvas]
variable level
if {$onoff} then {
#
# action of despair
$canvas delete dot
#
bind $canvas <Control-Down> "$canvas yview scroll 1 unit"
bind $canvas <Control-Up> "$canvas yview scroll -1 unit"
bind $canvas <Control-Right> "$canvas xview scroll 1 unit"
bind $canvas <Control-Left> "$canvas xview scroll -1 unit"
#
if {[::tk windowingsystem] eq "x11"} then {
bind $canvas <5> "$canvas yview scroll 1 unit"
bind $canvas <4> "$canvas yview scroll -1 unit"
bind $canvas <Shift-5> "$canvas xview scroll 1 unit"
bind $canvas <Shift-4> "$canvas xview scroll -1 unit"
} else {
# Achtung Instrumentenflug!
# Unter Windows kontrollieren, ob die Richtung stimmt!
bind $canvas <MouseWheel> [subst -nocommand {
$canvas yview scroll [expr {-%D/abs(%D)}] unit
}]
bind $canvas <Shift-MouseWheel> [subst -nocommand {
$canvas xview scroll [expr {-%D/abs(%D)}] unit
}]
}
bind $canvas <Motion> ""
bind $canvas <<Click>> [subst -nocommand {
$self select {*}[$self tagCurrentToObject]
}]
bind $canvas <<ControlClick>> ""
# bind $canvas <<ShiftControlClick>> ""
bind $canvas <<DoubleClick>> [list apply {
self {
set canvas [$self private canvas]
set obj [$self tagCurrentToObject]
if {$obj eq ""} then {
event generate $canvas <Escape>
} else {
$self select
$self select $obj
$canvas.context.sel invoke Edit
}
}
} $self]
bind $canvas <Enter> "
focus %W
$self zoom
obj common dot canvas %W
obj common line canvas %W
obj common fill canvas %W
obj common group canvas %W
"
bind $canvas <3> [list apply [list {self menu} {
proc pointerXY {} {
list %x %y
}
for {set i 0} {$i < [$menu.sel index end]} {incr i} {
# look for changed entry label
if {[$menu.sel type $i] eq "command"} then {
set group [$menu.sel entrycget $i -label]
if {$group in {Group Ungroup Intersect Split}} break
}
}
set selection [$self private selection]
lassign $selection obj
if {[llength $selection] > 1} then {
$menu.sel entryconfigure $group -label Group -accelerator ^g\
-command "$self createGroup" -state normal
$menu.sel.constraint entryconfigure Inspect -state disabled
} elseif {[llength $selection] == 1} {
# nur ein Objekt selektiert
$menu.sel.constraint entryconfigure Inspect -state normal
if {[$obj isa group]} then {
$menu.sel entryconfigure $group -label Ungroup -accelerator ^u\
-command "$self splitGroup" -state normal
} elseif {[$obj isa line]} then {
$menu.sel entryconfigure $group -label Intersect -accelerator ""\
-command "$self intersectLine" -state normal
} else {
$menu.sel entryconfigure $group -label Split -accelerator ""\
-command "$self withUndo selected empty" -state normal
}
}
if {[llength [$self private selection]] == 0} then {
tk_popup $menu.nosel %X %Y
} else {
tk_popup $menu.sel %X %Y
}
} [namespace current]] $self $canvas.context]
$self canvas configure -cursor ""
bind $canvas <<Undo>> "$self undo"
bind $canvas <<Redo>> "$self redo"
bind $canvas <Delete> "$self deleteSelection"
bind $canvas <<Cut>> "
$self copyToClipboard
$self deleteSelection
"
bind $canvas <<Copy>> "$self copyToClipboard"
bind $canvas <<Paste>> "$self pasteFromClipboard"
bind $canvas <1> ""
#
bind $canvas <Control-a> [list apply {
self {
$self select {*}[$self elements]
}
} $self]
bind $canvas <Control-e> "$canvas.context.sel invoke Edit"
bind $canvas <Control-g> "$self withUndo createGroup"
bind $canvas <Control-u> "$self withUndo splitGroup"
#
if {$level($canvas) > 1} then {
bind $canvas <Escape> [subst -nocommand {
if {[$self selected] eq {}} then {
$canvas.context.nosel invoke Done
} else {
$self select
}
}]
} else {
bind $canvas <Escape> "$self select"
}
bind $canvas <<ZoomIn>> "$canvas.context.nosel.zoom invoke In"
bind $canvas <<ZoomOut>> "$canvas.context.nosel.zoom invoke Out"
bind $canvas <<ZoomOriginal>> "$canvas.context.nosel.zoom invoke Original"
$self statusLine [my defaultmessage]
} else {
foreach ev {
<Control-Down> <Control-Up> <Control-Right> <Control-Left>
<MouseWheel> <Shift-MouseWheel>
<4> <5> <Control-4> <Control-5>
<<Click>> <<DoubleClick>>
<Enter>
<1> <3>
<Control-a> <Control-e> <Control-g> <Congrol-u>
<Delete>
<<Undo>> <<Redo>>
<<Cut>> <<Copy>> <<Paste>>
<Escape>
<<ZoomIn>> <<ZoomOut>> <<ZoomOriginal>>
} {
bind $canvas $ev ""
}
$self statusLine
}
}
© Wolf-Dieter Busch | Home | Sitemap | Urheber | A-Z