basicBindings

$canvaseditor basicBindings on
installs presence bindings
$canvaseditor basicBindings off
removes bindings

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