warpMode

$canvaseditor warpMode mode
manages canvas bindings to move selected dot

obj method canvaseditor warpMode {{mode both}} {
  set canvas [my canvas]
  $self statusLine ""
  set dot [$self nearestDot -selected -end]
  $self pointerToDot $dot
  $self memory currentDot $dot
  $self memory transformation "warp $mode"
  #
  $self memory dot $dot
  $self memory found ""
  #
  set x [$dot cget -x]
  set y [$dot cget -y]
  $self canvas configure -cursor crosshair
  $self selected blink off
  foreach obj [my selection] {
    if {$dot in [$obj dots]} then {
      lappend objects $obj
    }
  }
  switch -exact -- $mode {
    horizontal {
      set line [subst -nocommand {
          $dot configure -x [$self canvasx %x]
        }]
    }
    vertical {
      set line [subst -nocommand {
          $dot configure -y [$self canvasy %y]
        }]
    }
    default {
      set line [subst -nocommand {
          $dot configure -x [$self canvasx %x] -y [$self canvasy %y]
        }]
    }
  }
  lappend lines [string trim $line]
  lappend lines "$dot lines draw coords"
  #
  set code [join $lines \n]
  #
  $self memory before [$self dump]
  #
  $self basicBindings off
  $self statusLine Warp $mode
  $self snapMode on
  after idle [list bind $canvas <Motion> $code]
  bind $canvas <<Click>> "$self finishTransform dump"
}

© Wolf-Dieter Busch | Home | Sitemap | Urheber | A-Z