select

$canvaseditor select object
takes object to private variable selection
$canvaseditor select
deselects all

obj method canvaseditor select args {
  if {$args eq ""} then {
    # Außerhalb Element geklickt -- Selektion aufheben
    foreach element [my selection] {
      $element blink off
    }
    my selection {}
    $self blinking off
  } else {
    # Selektion mit Mausklick
    foreach object $args {
      if {$object ni [my selection]} then {
        # Element war noch nicht selektiert
        foreach dot [$object dots] {
          $dot storeXY
        }
        my selection [list {*}[my selection] $object]
        $object blink on
        $self blinking on
      } else {
        # Element war schon selektiert
        set index [lsearch [my selection] $object]
        my selection [lreplace [my selection] $index $index]
        $object blink off
        if {[my selection] eq {}} then {
          $self blinking off
        }
      }
    }
  }
  switch -exact -- [llength [my selection]] {
    0 {
      $self statusLine [my defaultmessage]
    }
    1 {
      lappend message\
        "Class [$self selected info class]"\
        "Id [namespace tail {*}[my selection]]"
      switch -exact -- [$self selected info class] {
        line {
          lappend message\
            "coords [$self selected xy yes]"\
            "linewidth [$object cget -width]"\
            [list linecolor [$object cget -outline]]
        }
        fill {
          lappend message [list color {*}[$self selected cget -fill]]
          set colList [lunique [$object lines cget -outline]]
          if {[llength $colList] == 1} then {
            lappend message [list linecolor {*}$colList]
          }
          set widthList [lunique [$object lines cget -width]]
          if {[llength $widthList] == 1} then {
            lappend message "linewidth $widthList"
          }
        }
        group {
          set group [$self selected]
          lappend message "elements [llength [$group elements]]"
          set class [lunique [$group elements info class]]
          if {[llength $class] == 1} then {
            lappend message "classes $class"
            switch -exact -- $class {
              line {
                set lineWidth [lunique [$group elements cget -width]]
                if {[llength $lineWidth] == 1} then {
                  lappend message "linewidth $lineWidth"
                }
                set lineColor [lunique [$group elements cget -outline]]
                if {[llength $lineColor] == 1} then {
                  lappend message "linecolor $lineColor"
                }
              }
              fill {
                set fillColor [lunique [$group elements cget -fill]]
                if {[llength $fillColor] == 1} then {
                  lappend message "fillcolor $fillColor"
                }
              }
            }
          }
        }
      }
      lassign [$object bbox] x0 y0 x1 y1
      lappend message\
        "width [- $x1 $x0]" "height [- $y1 $y0]"\
        "diagonale [hypot [- $x1 $x0] [- $y1 $y0]]"\
        "phi [* 180 [/ [atan2 [- $y1 $y0] [- $x1 $x0]] [acos -1]]]"
      $self statusLine [join $message "; "]
    }
    default {
      lassign [$self bbox] x0 y0 x1 y1
      lappend message\
        "[llength [my selection]] objects"
      set classes [lunique [$self selected info class]]
      if {[llength $classes] == 1} then {
        lappend message "Class $classes"
        switch -exact -- $classes {
          fill {
            set fills [lunique [$self selected cget -fill]]
            if {[llength $fills] == 1} then {
              lappend message [list color {*}$fills]
            }
          }
          line {
            set outlines [lunique [$self selected cget -outline]]
            if {[llength $outlines] == 1} then {
              lappend message [list linecolor {*}$outlines]
            }
            set widths [lunique [$self selected cget -width]]
            if {[llength $widths] == 1} then {
              lappend message [list linewidth {*}$widths]
            }
          }
        }
      }
      lappend message "width [- $x1 $x0]"\
        "height [- $y1 $y0]"\
        "diagonale [hypot [- $x1 $x0] [- $y1 $y0]]"
      $self statusLine [join $message "; "]
    }
  }
}

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