"{ Package: 'stx:libtool2' }"

"{ NameSpace: Tools }"

ValueModel subclass:#ViewTreeModel

	instanceVariableNames:'lockSema selectedSuperItems selection hiddenLevel listOfItems

		inputEventAction mappedViewAction beforeSelectionChangedAction

		icons timedUpdateTask selectOnClickHolder testModeChannel

		hasTargetWidgetChannel'

	classVariableNames:''

	poolDictionaries:''

	category:'A-Views-Support'

!

HierarchicalList subclass:#ItemList

	instanceVariableNames:'treeModel eventHook eventHookInitialized showWidgetNames'

	classVariableNames:''

	poolDictionaries:''

	privateIn:ViewTreeModel

!

!ViewTreeModel class methodsFor:'documentation'!

documentation

"

    Instances of ViewTreeModel can be used as model on a View and all

    it contained subviews for a HierarchicalListView.

    The model keeps two values, the hierarchical representation of the views

    and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.

    It shows the selected items highlighted.

    [Instance variables:]

        lockSema            <Semaphore>         lock selection notifications and redraws

        testModeChannel     <ValueHolder>       true, than running in test mode.

        hasTargetWidgetChannel <ValueHolder>    true, than any target view is grapped

        selection           <Sequence or nil>   selected items or nil

        hiddenLevel         <Integer>           internal use; redrawing the selection

                                                only is done if the counter is 0.

        listOfItems         <HierarchicalList>  hiearchical list build from existing items.

        selectedSuperItems  <Sequence>          list of selected super items; items selected

                                                but not contained in another selected item.

        inputEventAction    <Action>            called for each InputEvent

        mappedViewAction    <Action>            called for a new mapped view which

                                                can not be found in the current item list.

        beforeSelectionChangedAction <Action>   called before the selection changed

    [author:]

        Claus Atzkern

    [see also:]

        ViewTreeItem

"

!

examples

"

    example 1: pick any window and show views and contained views

                                                                                [exBegin]

    |top sel model panel|

    model := ViewTreeModel new.

    top   := StandardSystemView new; extent:440@400.

    sel   := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.

    sel bottomInset:24.

    panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.

    panel topInset:-24.

    panel horizontalLayout:#fitSpace.

    Button label:'Exit'       action:[model rootItem:nil. top destroy] in:panel.

    Button label:'Pick Views' action:[  |win|

                                        (     (win := Screen current viewFromUser) notNil

                                         and:[(win := win topView) ~~ Screen current rootView

                                         and:[win ~~ top]]

                                        ) ifTrue:[

                                            model rootItem:(ViewTreeItem buildViewsFrom:win)

                                        ] ifFalse:[

                                            model rootItem:nil

                                        ]

                                     ] in:panel.

    sel  multipleSelectOk:true.

    sel              list:model listOfItems.

    sel             model:model.

    sel          useIndex:false.

    sel doubleClickAction:[:i| |el|

        el := model listOfItems at:i.

        el spec notNil ifTrue:[ el spec   inspect ] ifFalse:[ el widget inspect ]

    ].

    sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].

    model inputEventAction:[:anEvent| |item|

        anEvent isButtonEvent ifTrue:[

            anEvent isButtonPressEvent ifTrue:[

                model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).

            ] ifFalse:[

                anEvent type == #'buttonMultiPress:x:y:' ifTrue:[

                    (item := model selectedItem) notNil ifTrue:[item widget inspect]

                ]

            ]

        ]

    ].

    top openAndWait.

    [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8

                                                                                [exEnd]

"

! !

!ViewTreeModel methodsFor:'accessing'!

application:anApplication

    listOfItems application:anApplication.

!

rootItem

    "get the rootItem the event viewer is established on

    "

    ^ listOfItems root

!

rootItem:anItem

    "set the rootItem the event viewer is established on

    "

    |expanded|

    timedUpdateTask := nil.

    self deselect.

    lockSema critical:[

        anItem notNil ifTrue:[ expanded := anItem isExpanded ]

                     ifFalse:[ expanded := false ].

        self value:nil.

        listOfItems root:anItem.

        anItem notNil ifTrue:[

            timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.

            timedUpdateTask name:'Update'.

            timedUpdateTask resume.

        ].

    ].

    (expanded and:[anItem notNil]) ifTrue:[

        anItem expand

    ].

    ^ anItem

!

rootView

    "get the top widget the event viewer is established on, a View

    "

    ^ listOfItems rootView

! !

!ViewTreeModel methodsFor:'accessing actions'!

beforeSelectionChangedAction

    "none argument action which is called before

     the selection changed

    "

    ^ beforeSelectionChangedAction

!

beforeSelectionChangedAction:aNoneArgBlock

    "none argument action which is called before

     the selection changed

    "

    beforeSelectionChangedAction := aNoneArgBlock.

!

inputEventAction

    "called for each input event; the argument to the action is the WindowEvent

    "

    ^ inputEventAction

!

inputEventAction:aOneArgActionTheEvent

    "called for each input event; the argument to the action is the WindowEvent

    "

    inputEventAction := aOneArgActionTheEvent.

!

mappedViewAction

    "called for a new mapped view which can not be found

     in the current item list

    "

    ^ mappedViewAction

!

mappedViewAction:aOneArgBlockTheMappedView

    "called for a new mapped view which can not be found

     in the current item list

    "

    mappedViewAction := aOneArgBlockTheMappedView

! !

!ViewTreeModel methodsFor:'accessing look'!

iconAt:aKey ifNonePut:aNoneArgBlock

    |icon view|

    icon := icons at:aKey ifAbsent:nil.

    icon notNil ifTrue:[^ icon].

    icon := aNoneArgBlock value.

    icon isNil ifTrue:[^ nil].

    view := self rootView.

    view isNil ifTrue:[^ icon].

    icon := icon copy onDevice:(view device).

    icon isImage ifTrue:[

        icon clearMaskedPixels.

    ].

    icons at:aKey put:icon.

    ^ icon

! !

!ViewTreeModel methodsFor:'accessing visibility'!

signalHiddenLevel

    "show the selection if signaled; increments hiddenLevel

     see: #waitHiddenLevel

    "

    (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[

        hiddenLevel := 0.

        self invalidateSelection.

    ].

!

waitHiddenLevel

    "hide the selection until signaled; increments hiddenLevel

     see: #signalHiddenLevel

    "

    self redrawUnselected:selection andLock:true

!

withSelectionHiddenDo:aNoneArgumentBlock

    "apply block with selection hidden

    "

    [   self waitHiddenLevel.

        aNoneArgumentBlock value

    ] valueNowOrOnUnwindDo:[

        self signalHiddenLevel.

    ].

! !

!ViewTreeModel methodsFor:'aspects'!

hasTargetWidgetChannel

    "answer the channel which is set to true if a target widget exists"

    ^ hasTargetWidgetChannel

!

listOfItems

    "hiearchical list build from existing items"

    ^ listOfItems

!

selectOnClickHolder

    "boolean holder, which indicates whether the selection will change on click

    "

    ^ selectOnClickHolder

!

testModeChannel

    "answer a boolean channel which describes the behaviour how to process

     events on the target view.

     false: all input events are eaten and the selection is shown on the target view.

     true:  no  input events are eaten and no  selection is shown on the target view."

    ^ testModeChannel

! !

!ViewTreeModel methodsFor:'change & update'!

targetWidgetChanged

    hasTargetWidgetChannel value:(self rootItem notNil).

!

timedUpdateTaskCycle

    |view myTaskId|

    myTaskId := timedUpdateTask.

    listOfItems root notNil ifTrue:[

        view := listOfItems root widget.

    ].

    [ view notNil ] whileTrue:[

        Delay waitForSeconds:0.5.

        (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[

            view := nil.

        ] ifTrue:[

            (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[

                view sensor pushUserEvent:#updateChildren for:self.

            ].

        ].

    ].

    timedUpdateTask == myTaskId ifTrue:[

        timedUpdateTask := nil.

        listOfItems root:nil.

    ].

!

update:something with:someArgument from:aModel

    aModel == testModeChannel ifTrue:[

        (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[

            testModeChannel value ifTrue:[

                self redrawUnselected:selection andLock:false checkTestMode:false.

            ] ifFalse:[

                self invalidateSelection.

            ].

        ].

        ^ self

    ].

    super update:something with:someArgument from:aModel.

!

updateChildren

    |rootItem|

    rootItem := listOfItems root.

    rootItem isNil ifTrue:[^ self].

    rootItem exists ifFalse:[

        listOfItems root:nil.

    ] ifTrue:[

        rootItem updateChildren.

    ].

! !

!ViewTreeModel methodsFor:'event processing'!

processEvent:anEvent

    "catch and process all WindowEvents for the rootComponent and its contained

     widgets; redraw selection in case of damage ....

    "

    |evView item rootView testMode|

    evView := anEvent view.

    evView isNil ifTrue:[

        (anEvent isMessageSendEvent and:[anEvent receiver == self]) ifFalse:[

            ^ false

        ].

        anEvent value.

        ^ true.

    ].

    rootView := listOfItems rootView.

    rootView isNil ifTrue:[ ^ false ].

    anEvent isConfigureEvent ifTrue:[

        hiddenLevel == 0 ifTrue:[

            self redrawUnselected:selection andLock:false.

        ].

        ^ false

    ].

    "/ check whether view is contained within the rootView

    (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[

        ^ false

    ].

    anEvent isInputEvent ifFalse:[

        anEvent isDamage ifTrue:[

            hiddenLevel == 0 ifTrue:[self invalidateSelection].

            ^ false

        ].

        anEvent isMapEvent ifTrue:[

            mappedViewAction notNil ifTrue:[

                item := listOfItems recursiveDetect:[:el| el widget == evView].

                item isNil ifTrue:[ mappedViewAction value:evView ]

            ].

            ^ false

        ].

        anEvent type == #terminate ifTrue:[

            item := listOfItems recursiveDetect:[:el| el widget == evView].

            item notNil ifTrue:[ self processTerminateForItem:item ].

            ^ false

        ].

        ^ false

    ].

    testMode := testModeChannel value.

    anEvent isFocusEvent ifTrue:[

        evView == rootView ifTrue:[

            self invalidateSelection

        ].

        ^ testMode not.

    ].

    anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ].

    testMode ifFalse:[

        inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ].

    ] ifTrue:[

        anEvent isButtonPressEvent ifTrue:[

            selectOnClickHolder value ifTrue:[

                self selectItem:(listOfItems detectItemRespondsToView:evView).

            ].

        ]

    ].

    (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[

        hiddenLevel := 1.

        self signalHiddenLevel.

    ].

    ^ testMode not

!

processTerminateForItem:anItem

    "received terminate for an item

    "

    anItem remove.

! !

!ViewTreeModel methodsFor:'initialization'!

initialize

    "setup the default attributes

    "

    super initialize.

    hiddenLevel           := 0.

    lockSema              := RecursionLock new.

    listOfItems           := ItemList new on:self.

    selectedSuperItems    := #().

    icons                 := IdentityDictionary new.

    hasTargetWidgetChannel := false asValue.

    selectOnClickHolder    := true asValue.

    testModeChannel := false asValue.

    testModeChannel addDependent:self.

! !

!ViewTreeModel methodsFor:'private selection'!

invalidateSelection

    "invalidate the current selection

    "

    |topView|

    testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode

    (     hiddenLevel == 0

     and:[selection notNil

     and:[(topView := listOfItems rootView) notNil

     and:[topView shown]]]

    ) ifTrue:[

        topView sensor pushUserEvent:#redrawSelection for:self withArguments:#()

    ]

!

recursiveRepair:theDamages startIn:aView relativeTo:aRootView

    "repair all views and contained views, which intersects the damage.

     !!!! all damages repaired are removed from the list of damages !!!!

    "

    |color relOrg damage subViews repaired

     bwWidth    "{ Class:SmallInteger }"

     x          "{ Class:SmallInteger }"

     y          "{ Class:SmallInteger }"

     w          "{ Class:SmallInteger }"

     h          "{ Class:SmallInteger }"

     relOrgX    "{ Class:SmallInteger }"

     relOrgY    "{ Class:SmallInteger }"

     width      "{ Class:SmallInteger }"

     height     "{ Class:SmallInteger }"

     size       "{ Class:SmallInteger }"

    |

    (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ].

    subViews := aView subViews.

    subViews size ~~ 0 ifTrue:[

        subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ].

        theDamages isEmpty ifTrue:[ ^ self ].

    ].

    relOrg  := aView originRelativeTo:aRootView.

    bwWidth := aView borderWidth.

    size    := theDamages size.

    "/ compute relative origin starting from border left@top

    relOrgX := relOrg x - bwWidth.

    relOrgY := relOrg y - bwWidth.

    width   := aView width  + bwWidth + bwWidth.

    height  := aView height + bwWidth + bwWidth.

    size to:1 by:-1 do:[:anIndex|

        repaired := damage := theDamages at:anIndex.

        "/ compute the rectangle into the view

        y := damage top  - relOrgY.

        x := damage left - relOrgX.

        w := damage width.

        h := damage height.

        x     < 0      ifTrue:[ w := w + x. x := 0. repaired := nil ].