"{ Package: 'stx:libtool2' }"

"{ NameSpace: Tools }"

HierarchicalItem subclass:#ViewTreeItem

	instanceVariableNames:'widget isDrawnShown exists xOffsetApplClass'

	classVariableNames:'HandleExtent'

	poolDictionaries:''

	category:'A-Views-Support'

!

!ViewTreeItem class methodsFor:'documentation'!

documentation

"

    ViewTreeItems represants a pickable object within a ViewTreeModel.

    The class is used to build up the hierarchical tree.

    [Instance variables:]

        widget        <View>            the widget represented by the item

        spec          <UISpecification> the UISpecification or nil

    [Class variables:]

        HandleExtent  <Point>           keeps the extent of a handle

    [author:]

        Claus Atzkern

    [see also:]

        HierarchicalItem

        ViewTreeModel

"

! !

!ViewTreeItem class methodsFor:'initialization'!

initialize

    "set the extent of the Handle

    "

    HandleExtent := 6@6.

! !

!ViewTreeItem class methodsFor:'instance creation'!

forView:aView

    |item|

    item := self basicNew initialize.

    item forView:aView.

  ^ item

!

new

    self error:'not allowed'.

  ^ nil

!

on:aView withSpec:aSpec

    |item|

    item := self basicNew initialize.

    item on:aView withSpec:aSpec.

  ^ item

! !

!ViewTreeItem class methodsFor:'building'!

buildViewsFrom:aView

    "build the items starting from a source view;

     returns the anhor.

    "

    |item subViews subItems|

    aView isNil ifTrue:[^ nil].

    item     := self forView:aView.

    subViews := aView subViews.

    subViews notEmptyOrNil ifTrue:[

        subItems := OrderedCollection new.

        subViews do:[:aSubView|

            subItems add:(self buildViewsFrom:aSubView).

        ].

        item children:subItems.

    ].

    ^ item

! !

!ViewTreeItem methodsFor:'accessing'!

applicationClass

    |appl|

    widget notNil ifTrue:[

        appl := widget application.

        appl notNil ifTrue:[^ appl class ].

    ].

    ^ nil

!

isDrawnShown

    "returns true if the last display operations was done during the widget was shown

    "

    ^ isDrawnShown

!

isDrawnShown:aBoolean

    isDrawnShown := aBoolean.

!

rootView

    "returns the widget assigned to the root or nil

    "

    ^ parent rootView

!

specClass

    "returns the spec-class assigned to the item

    "

    ^ widget specClass

!

treeModel

    "returns the assigned treeModel, an instance of ViewTreeModel

    "

    ^ parent treeModel

!

widget

    "returns the widget assigned to the item

    "

    ^ widget

! !

!ViewTreeItem methodsFor:'accessing layout'!

boundsRelativeToRoot

    "returns the bounds relative to the root widget

    "

    ^ self originRelativeToRoot extent:(widget extent)

!

cornerRelativeToRoot

    "returns the corner relative to the root widget

    "

    ^ self originRelativeToRoot + (widget extent)

!

extent

    "returns the extent of the widget

    "

    ^ widget extent

!

layoutType

    "returns the type of layout assigned to the wiget; nil if the

     superView cannot resize its sub widgets

    "

    |layout specClass superView|

    (superView := widget superView) isNil ifTrue:[

        ^ #Extent

    ].

    specClass := superView specClass.

    (specClass notNil and:[specClass isLayoutContainer]) ifTrue:[

        ^ specClass canResizeSubComponents ifTrue:[#Extent] ifFalse:[nil]

    ].

    (layout := widget geometryLayout) isNil ifTrue:[

        ^ #Extent

    ].

    layout isLayout ifTrue:[

        layout isLayoutFrame        ifTrue:[ ^ #LayoutFrame ].

        layout isAlignmentOrigin    ifTrue:[ ^ #AlignmentOrigin ].

        layout isLayoutOrigin       ifTrue:[ ^ #LayoutOrigin ].

    ] ifFalse:[

        layout isRectangle          ifTrue:[ ^ #Rectangle ].

        layout isPoint              ifTrue:[ ^ #Point ].

    ].

    Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.

  ^ nil

!

originRelativeToRoot

    "returns the origin relative to the root widget

    "

    ^ widget originRelativeTo:(self rootView)

! !

!ViewTreeItem methodsFor:'accessing optimize'!

children

    "redefined: optimize

    "

    ^ children

!

hasChildren

    |subViews list item|

    children size ~~ 0 ifTrue:[

        ^ true

    ].

    isExpanded := false.

    subViews   := widget subViews.

    subViews size == 0 ifTrue:[^ false].

    list := OrderedCollection new.

    subViews do:[:aSubView|

        item := self class buildViewsFrom:aSubView.

        item parent:self.

        list add:item.

    ].

    children := list.

    ^ true

!

size

    "redefined: returns list of children

    "

    ^ children size

! !

!ViewTreeItem methodsFor:'displaying'!

displayOn:aGC x:x y:y h:h

    |labelHeight paint applName|

    widget id isNil ifTrue:[

        isDrawnShown := false.

        self exists ifFalse:[^ self].

        paint := Color white.

    ] ifFalse:[

        isDrawnShown := widget shown.

        paint := isDrawnShown ifTrue:[Color black] ifFalse:[Color darkGray].

    ].

    aGC paint:paint.

    labelHeight := self heightOn:aGC.

    self displayLabel:(self label) h:labelHeight on:aGC x:x y:y h:h.

    xOffsetApplClass notNil ifTrue:[

        applName := self labelOfApplicationClass.

        applName notNil ifTrue:[

            self displayLabel:applName

                            h:labelHeight on:aGC

                            x:(x + xOffsetApplClass)

                            y:y

                            h:h.

        ].

    ].

!

labelOfApplicationClass

    "answer the name of the underlaying application or nil"

    |applClass|

    self isApplicationClass ifTrue:[

        applClass := self applicationClass.

        applClass notNil ifTrue:[

            ^ ('[ ', applClass name, ' ]')

        ].

    ].

    xOffsetApplClass := nil.

    ^ nil

!

widthOn:aGC

    "return the width of the receiver, if it is to be displayed on aGC

    "

    |applName|

    width isNil ifTrue:[

        width := self widthOf:(self label) on:aGC.

        width := width + 2.

        applName := self labelOfApplicationClass.

        applName notNil ifTrue:[

            xOffsetApplClass := width + 10.

            width := xOffsetApplClass + (self widthOf:applName on:aGC).

            width := width + 2.

        ].

    ].

    ^ width

! !

!ViewTreeItem methodsFor:'enumerating'!

handlesDo:aTwoArgAction

    "evaluate the two arg block on each handle; the arguments to the block is

     the rectangle relative to the rootView and the handle type which is

     set to nil if not resizeable.

     TYPES:     type    position( X - Y )

                -------------------------        

                #LT     Left   - Top

                #LC     Left   - Center

                #LB     Left   - Bottom

                #CT     Center - Top

                #CB     Center - Bottom

                #RT     Right  - Top

                #RC     Right  - Center

                #RB     Right  - Bottom

                nil     ** handle not pickable **

    "

    |type relOrg relCrn maxExt rootView w h

     xL    "{ Class:SmallInteger }"

     xC    "{ Class:SmallInteger }"

     xR    "{ Class:SmallInteger }"

     yT    "{ Class:SmallInteger }"

     yC    "{ Class:SmallInteger }"

     yB    "{ Class:SmallInteger }"

    |

    rootView := self rootView.

    relOrg   := widget originRelativeTo:rootView.

    relOrg isNil ifTrue:[ ^ self ].    "/ widget destroyed

    relOrg   := relOrg - (HandleExtent // 2).

    relCrn   := relOrg + widget extent.

    maxExt   := rootView extent - HandleExtent.

    xL := relOrg x max:0.

    xR := relCrn x min:(maxExt x).

    xC := xR + xL // 2.

    yT := relOrg y max:0.

    yB := relCrn y min:(maxExt y).

    yC := yB + yT // 2.

    type := self layoutType.

    w   := HandleExtent x.

    h   := HandleExtent y.

    (type == #LayoutFrame or:[type == #Rectangle]) ifTrue:[

        aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:#LT.

        aTwoArgAction value:(Rectangle left:xL top:yC width:w height:h) value:#LC.

        aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:#LB.

        aTwoArgAction value:(Rectangle left:xC top:yT width:w height:h) value:#CT.

        aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.

        aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:#RT.

        aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.

        aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.

      ^ self

    ].

    aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:nil.

    aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:nil.

    aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:nil.

    type == #Extent ifTrue:[

        aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.

        aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.

        aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.

      ^ self

    ].

    aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:nil.

!

recursiveEachVisibleItemDo:anOneArgBlock

    "recursive evaluate the block on each child which is visible

    "

    (isExpanded and:[children size > 0]) ifTrue:[

        children do:[:aChild|

            anOneArgBlock value:aChild.

            aChild recursiveEachVisibleItemDo:anOneArgBlock.

        ]

    ].

!

subViewsDo:aOneArgBlock

    "evaluate aBlock for all subviews other than InputView's   

    "

    |subViews|

    subViews := widget subViews.

    subViews notNil ifTrue:[

        subViews do:aOneArgBlock

    ].

! !

!ViewTreeItem methodsFor:'initialization'!

forView:aView

    widget := aView.

!

initialize

    "setup default attributes

    "

    super initialize.

    isDrawnShown := false.

    isExpanded   := false.

    children     := OrderedCollection new.

! !

!ViewTreeItem methodsFor:'operations delete'!

delete

    "delete self and all contained items; the assigned views are destroyed

     in case of rootView, only the children are deleted

    "

    parent isHierarchicalItem ifTrue:[

        self criticalDo:[

            parent remove:self.

            widget destroy.

        ]

    ] ifFalse:[

        self deleteAll

    ].

!

deleteAll

    "delete all contained items; the assigned views are destroyed

    "

    children size == 0 ifTrue:[^ self].

    self criticalDo:[

        self nonCriticalDo:[:el| el widget destroy ].

        self removeAll

    ].

! !

!ViewTreeItem methodsFor:'operations layout'!

asLayoutFrame

    "convert the layout of the widget to a LayoutFrame;

    "

    |extent layout newLyt lftFrc lftOff topFrc topOff|

    layout := widget geometryLayout.

    layout isNil ifTrue:[

        ^ widget bounds asLayout

    ].

    layout isLayout ifFalse:[

        layout isRectangle ifTrue:[

            ^ LayoutFrame leftOffset:(layout left) rightOffset:(layout right)

                           topOffset:(layout top) bottomOffset:(layout bottom)

        ].

        layout isPoint ifTrue:[

            extent := widget extent.

          ^ LayoutFrame leftOffset:(layout x)  rightOffset:(layout x + extent x)

                         topOffset:(layout y) bottomOffset:(layout y + extent y)

        ].

        Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.

      ^ nil

    ].

    layout isLayoutFrame ifTrue:[ ^ layout copy ].    

    lftFrc := layout leftFraction.

    lftOff := layout leftOffset.

    topFrc := layout topFraction.

    topOff := layout topOffset.

    extent := widget extent.

    newLyt := LayoutFrame leftFraction:lftFrc offset:lftOff

                         rightFraction:lftFrc offset:(lftOff + extent x)

                           topFraction:topFrc offset:topOff

                        bottomFraction:topFrc offset:(topOff + extent y).

    (      layout isAlignmentOrigin

     and:[(layout leftAlignmentFraction ~= 0 or:[layout topAlignmentFraction ~= 0])]

    ) ifTrue:[

        |svRc prBd dlta|

        svRc := widget superView viewRectangle.

        prBd := widget preferredBounds.

        dlta := (  ((layout rectangleRelativeTo:svRc preferred:prBd) corner)

                 - ((newLyt rectangleRelativeTo:svRc preferred:prBd) corner)

                ) rounded.

        newLyt   leftOffset:(lftOff + dlta x).

        newLyt  rightOffset:(lftOff + extent x + dlta x).

        newLyt    topOffset:(topOff + dlta y).

        newLyt bottomOffset:(topOff + extent y + dlta y).

    ].

    ^ newLyt

!

moveLeft:l top:t

    "move the widget n pixele left and right

    "

    |layout|

    self isMoveable ifFalse:[ ^ self ].

    (layout := widget geometryLayout) isNil ifTrue:[

        "Extent"

        widget origin:(widget origin + (l@t)).

      ^ self

    ].

    layout := layout copy.

    layout isLayout ifTrue:[

        layout leftOffset:(layout leftOffset + l)

                topOffset:(layout topOffset  + t).

        layout isLayoutFrame ifTrue:[

            layout  rightOffset:(layout rightOffset  + l).

            layout bottomOffset:(layout bottomOffset + t).

        ]

    ] ifFalse:[

        layout isRectangle ifTrue:[

            layout setLeft:(layout left + l).

            layout  setTop:(layout top  + t).

        ] ifFalse:[

            layout isPoint ifFalse:[^ self].

            layout x:(layout x + l) y:(layout y + t).