# gui/implementation/TreeBox.tcl

    @implementation TreeBox {
      - init {} {
          $super@ Tree init
          $super@ CanvasBox init

          set defaults(font) [$label cget -font]
          set defaults(status) closed
          set defaults(type) child
          set defaults(fill) #a0a0a0

          set bg [[entry $path._e] cget -selectbackground]
          set defaults(selectionBackground) $bg
          destroy $path._e

          set icons(empty) [@imageCopy empty]
          set icons(plus) [@imageCopy plus]
          $icons(plus) configure -background [$canvas cget -bg]
          set icons(minus) [@imageCopy minus]
          $icons(minus) configure -background [$canvas cget -bg]

          set icons(child) [@imageCopy white_sphere]
          set icons(opened) [@imageCopy sphere]
          set icons(closed) [@imageCopy sphere]

          set buildData(lastY) 0
          set buildData(selectionItem) {}

          $self property: status of: $root to: $defaults(status)
          $self draw: $root

          set callbacks(Selection) {}
        }

      - root: rootNode {
          $super@ Tree root: $rootNode
          $self redraw
        }

      - toggle: aNode {
          set aNode [$self format: $aNode]
          if [$self contains: $aNode] {
            if [string length [$self childsOf: $aNode]] {
              if {"[$self property: status of: $aNode]" == "opened"} {
                $self property: status of: $aNode to: closed
              } else {
                $self property: status of: $aNode to: opened
              }
              $self redraw
            }
          }
        }

      - open: aNode {
          set aNode [$self format: $aNode]
          if [$self contains: $aNode] {
            $self property: status of: $aNode to: opened
            $self redraw
          }
        }

      - close: aNode {
          set aNode [$self format: $aNode]
          if [$self contains: $aNode] {
            $self property: status of: $aNode to: closed
            $self redraw
          }
        }

      - add: aNode {
          set aNode [$self format: $aNode]
          $super add: $aNode
          $self property: status of: $aNode to: opened
          $self redraw
        }

      - addWithoutUpdate: aNode {
          set aNode [$self format: $aNode]
          $super add: $aNode
          $self property: status of: $aNode to: opened
        }

      - remove: aNode {
          set aNode [$self format: $aNode]
          $super remove: $aNode
          foreach field [array names icons $aNode,*] {
            unset icons($field)
          }
          $self redraw
        }

      - redraw {} {
          #- clearing current canvas content
          foreach item [$canvas find all] {
            if [string length [set c [bind $item]]] {
              @debug "$c"
            }
            $canvas delete $item
          }
          set buildData(lastY) 0
          $self draw: [$self root]
          $canvas configure -scrollregion [$canvas bbox all]
          if [string length $selection] {
            $self updateSelection
          }
          $self zoomSync
        }

      - draw: aNode {
          if {"$aNode" == "[$self root]"} {
            $canvas create image 0 0 -image $icons(empty)
          }

          if [$self contains: $aNode] {
            #- setting x,y for the drawing
            set x0 [expr ([$self levelOf: $aNode] * 20) + 40]
            set y0 $buildData(lastY)
            set x1 $x0
            set y1 [expr $y0 + 20]
            set x2 [expr $x0 + 20]
            set y2 $y1
            set x3 [expr $x2 + 10]
            set y3 $y2

            #- expanding branch if previous node of the same level is opened
            if {"$aNode" != "[$self root]"} {
              set childrenOfParent [$self childsOf: [$self parentOf: $aNode]]
              set i [childrenOfParent indexOf: $aNode]
              if {$i > 0} {
                incr i -1
                set previousNode [lindex $childrenOfParent $i]
                if {"[$self property: status of: $previousNode]" == "opened"} {
                  #- getting Y
                  set item [$canvas find withtag "node:$previousNode"]
                  set y [expr round([lindex [$canvas coord $item] end])]
                  $canvas lower [$canvas create line \
                    $x0 $y $x0 $buildData(lastY) -fill $defaults(fill)]
                }
              }
            }

            #- setting icon following the current type and status of the node
            set _childs [$self childsOf: $aNode]
            set parent [$self parentOf: $aNode]

            if {![string length $_childs]} {
              if [info exists icons($aNode,child)] {
                set icon $icons($aNode,child)
              } else {
                set icon $icons(child)
              }
              set expandIcon $icons(empty)
            } elseif {"[$self property: status of: $aNode]" == "opened"} {
              if [info exists icons($aNode,opened)] {
                set icon $icons($aNode,opened)
              } else {
                set icon $icons(opened)
              }
              if [string length $_childs] {
                set expandIcon $icons(minus)
              } else {
                set expandIcon $icons(empty)
              }
            } else {
              if [info exists icons($aNode,closed)] {
                set icon icons($aNode,closed)
              } else {
                set icon $icons(closed)
              }
              if [string length $_childs] {
                set expandIcon $icons(plus)
              } else {
                set expandIcon $icons(empty)
              }
            }

            set item1 [$canvas create poly $x0 $y0 $x1 $y1 $x2 $y2 $x1 $y1 \
              -outline $defaults(fill)]
            set item2 [$canvas create image $x1 $y2 -image $expandIcon \
              -tag [list icon "expandIconOf:$aNode"]]
            set item3 [$canvas create image $x2 $y2 -image $icon \
              -tag "iconOf:$aNode" \
              -anchor c]
            set item4 [$canvas create text $x3 $y3 \
              -text [$self nodeNameOf: $aNode] -font $defaults(font) \
              -anchor w -tag [list parent:$parent node:$aNode]]

            $canvas bind $item4 <Double-1> "$self toggle: \"$aNode\""
            $canvas bind $item4 <ButtonPress-1> "$self selection: \"$aNode\""
            if {[string length $_childs]} {
              foreach i {1 2 3} {
                $canvas bind [set item$i] <ButtonPress-1> "$self toggle: \"$aNode\""
              }
            }
            $canvas lower $item1
            $canvas raise $item2
            $canvas raise $item3

            set buildData(lastY) [expr $buildData(lastY) + 20]
            if {[string length $_childs] \
              && "[$self property: status of: $aNode]" == "opened"} {
              foreach child $_childs {
                $self draw: $child
              }
            }
          }
        }

      - clear {} {
          foreach item [$canvas find all] {
            $canvas delete $item
          }
          $self selection: {}
          $self clear
        }

      - selection: aNode {
          set aNode [$self format: $aNode]
          #- removing root name if in the path
          if [regexp [join [list [$self root] (.*)] [$self separator]] $aNode -> node] {
            if {![string length $node]} {
              set aNode $node
            }
          }

          if {"$selection" == "$aNode"} { $self selection: {} ; return $self }
          if {[string length $aNode] && ![$self contains: $aNode]} {
            return [error "$self doesn't contain \"$aNode\""]
          }
          #- clearing current selection
          if [string length [set i $buildData(selectionItem)]] {
            $canvas delete $i
            set buildData(selectionItem) {}
          }
          set previousSelectionNode $selection
          set selection {}
          if {![string length $aNode]} { return $self }
          set selection $aNode
          $self updateSelection
          $self selectionChange
        }

      - updateSelection {} {
          if {![string length $selection]} { return $self }
          set bbox [$canvas bbox [$canvas find withtag node:$selection]]
           if {[llength $bbox] == 4} {
            foreach {x1 y1 x2 y2} $bbox {
              set i [$canvas create rectangle $x1 $y1 $x2 $y2 \
                -fill $defaults(selectionBackground) \
                -outline $defaults(selectionBackground)]
              #set i [$canvas create rectangle $x1 $y1 $x2 $y2 \
              #  -fill $defaults(selectionBackground) \
              #  -outline black]
              $canvas lower $i
              set buildData(selectionItem) $i
            }
          }
        }

      - selection {} {
          return $selection
        }

      - onSelection: aCallback {
           set callbacks(Selection) $aCallback
        }

      - onSelection {} {
          return $callbacks(Selection)
        }

      - selectionChange {} {
          catch {eval $callbacks(Selection)}
        }

      - itemOfNode: aNode {
          set aNode [$self format: $aNode]
          return [$canvas find withtag node:$aNode]
        }

      - openedIcon: aBitmap {
          set aNode [$self format: $aNode]
          set icons(opened) $aBitmap
          $self redraw
        }

      - closedIcon: aBitmap {
          set icons(closed) $aBitmap
          $self redraw
        }

      - childIcon: aBitmap {
          set icons(child) $aBitmap
          $self redraw
        }

      - openedIcon {} {
          return $icons(opened)
        }

      - closedIcon {} {
          return $icons(closed)
        }

      - childIcon {} {
          return $icons(child)
        }

      - openedIconOfNode:to: {aNode aBitmap} {
          set aNode [$self format: $aNode]
          set icons($aNode,opened) $aBitmap
          $self redraw
        }

      - closedIconOfNode:to: {aNode aBitmap} {
          set aNode [$self format: $aNode]
          set icons($aNode,closed) $aBitmap
          $self redraw
        }

      - childIconOfNode:to: {aNode aBitmap} {
          set aNode [$self format: $aNode]
          set icons($aNode,child) $aBitmap
          $self redraw
        }

      - iconOfNode:to: {aNode aBitmap} {
          set aNode [$self format: $aNode]
          set icons($aNode,opened) $aBitmap
          set icons($aNode,closed) $aBitmap
          set icons($aNode,child) $aBitmap
          $self redraw
        }

      - openedIconOfNode: aNode {
          set aNode [$self format: $aNode]
          if [info exists icons($aNode,opened)] {
            return $icons($aNode,opened)
          } else {
            return $icons(opened)
          }
        }

      - closedIconOfNode: aNode {
          set aNode [$self format: $aNode]
          if [info exists icons($aNode,closed)] {
            return $icons($aNode,closed)
          } else {
            return $icons(closed)
          }
        }

      - childIconOfNode: aNode {
          set aNode [$self format: $aNode]
          if [info exists icons($aNode,child)] {
            return $icons($aNode,child)
          } else {
            return $icons(child)
          }
        }

      - saveToFile: aFile {
          set f [open $aFile w]
          foreach node [lsort [$self allChilds]] {
            puts $f "$node"
          }
          close $f
        }

      - onLeftClick: aCallback {
          bind $canvas <ButtonRelease-1> "$self doLeftClick"
          set callbacks(LeftClick) $aCallback
        }

      - doLeftClick {} {
          catch {eval $callbacks(LeftClick)}
        }

      - onMiddleClick: aCallback {
          bind $canvas <ButtonRelease-2> "$self doMiddleClick"
          set callbacks(MiddleClick) $aCallback
        }
      - doMiddleClick {} {
          catch {eval $callbacks(MiddleClick)}
        }

      - onRightClick: aCallback {
          bind $canvas <ButtonRelease-3> "$self doRightClick"
          set callbacks(RightClick) $aCallback
        }

      - doRightClick {} {
          catch {eval $callbacks(RightClick)}
        }

      - add: aNode {
          set aNode [$self format: $aNode]
          $super add: $aNode
          $self property: status of: $aNode to: opened
          $self redraw
        }

      - seeEnd {} {
          $canvas yview moveto [lindex [$canvas yview] end]
          $canvas xview moveto [lindex [$canvas xview] end]
        }

      - forwardInvocation: anInvocation {
          if [$self respondsTo: [@selector $anInvocation]] {
            if [catch {set result [eval $self $anInvocation]} err] {
              return [error $err]
            }
            $self redraw
            if {"$result" != "$self"} {
              return $result
            }
          } else {
            return [eval $super $anInvocation]
          }
        }

      - dealloc {} {
          $self release
          return [$super dealloc]
        }

      - loadFromFile: aFile {
          $super@ Tree loadFromFile: $aFile
          foreach child [$self allChilds] {
            $self property: status of: $child to: closed
          }
          $self redraw
        }

      - loadFromDirectory: aDirectory {
          $super@ Tree loadFromDirectory: $aDirectory
          foreach child [$self allChilds] {
            $self property: status of: $child to: opened
          }
          $self redraw
        }

      - canvasBackground: aColor {
          $canvas configure -background $aColor
          $icons(plus) configure -background $aColor
          $icons(minus) configure -background $aColor
        }

    }