"
 COPYRIGHT (c) 1990 by Claus Gittinger
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

StandardSystemView subclass:#ModalBox
       instanceVariableNames:'haveControl shadowView exclusiveKeyboard '
       classVariableNames:'PopShadow'
       poolDictionaries:''
       category:'Views-Basic'
!

ModalBox comment:'
COPYRIGHT (c) 1990 by Claus Gittinger
              All Rights Reserved

$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.11 1994-08-22 13:17:08 claus Exp $
'!

!ModalBox class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1990 by Claus Gittinger
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

version
"
$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.11 1994-08-22 13:17:08 claus Exp $
"
!

documentation
"
    this class implements modal boxes; ModalBoxes are different from
    others, in that they take complete control over the display, until 
    all processing is done (i.e. other views will not get any events
    while the box is active).

    class variables:

    PopShadow       <Boolean>       if true, modalBoxes will show a shadow
"
! !

!ModalBox class methodsFor:'initialization'!

initialize
    super initialize.
    Display notNil ifTrue:[
        PopShadow := self classResources name:'POPUP_SHADOW' default:false
    ]
! !

!ModalBox methodsFor:'initialize / release'!

initialize
    super initialize.

    haveControl := false.
    exclusiveKeyboard := false.

    PopShadow ifTrue:[
        shadowView := (ShadowView on:device) for:self
    ]
!

initStyle
    super initStyle.
    ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
        borderWidth := 0.
        self level:2
    ]
!

addToCurrentProject
    "ignored here"

    ^ self
!

destroy
    shadowView notNil ifTrue:[
        shadowView destroy.
        shadowView := nil
    ].
    self leaveControl. "just to make sure"
    super destroy.
!

create
    super create.
    PopShadow ifFalse:[
        self saveUnder:true
    ]
!

createOnTop
    ^ true
! !

!ModalBox methodsFor:'accessing'!

exclusiveKeyboard:aBoolean
    "set/clear exclusive locking of the keyboard;
     If set, the box will take total control over the
     keyboard, not allowing input to other views/boxes
     while active.
     Danger: only use this for very very urgent boxes, since
     no interaction with any view on the screen is possible then."

    exclusiveKeyboard := aBoolean
! !

!ModalBox methodsFor:'show / hide'!

mapped
    "wait till visible for grabbing"

    super mapped.

    "take it away from any popup menu possibly still active"

    ActiveGrab notNil ifTrue:[
        device ungrabKeyboard.
        ActiveGrab := nil.
    ].

    "
     if I am a super-modal box, take the keyboard
    "
    exclusiveKeyboard ifTrue:[
        device grabKeyboardIn:drawableId.
    ].

    "
     get the focus
    "
    device setInputFocusTo:drawableId.
    self enableEnterLeaveEvents
!

fixPosition:aPoint
    "make sure, that the box is visible by shifting it
     into the visible screen area if nescessary"

    self origin:aPoint.
    self makeFullyVisible
!

positionOffset
    "return the delta, by which the box should be
     displaced from the mouse pointer. Usually redefined in
     subclasses to have some ok-button appear under
     the pointer."

    ^ (width // 2) @ (height // 2)
!

open
    "default for modalboxes is to come up modal"

    ^ self openModal
!

openModal
    "open the box modal;
     In addition to the basic (inherited) modalloop, change
     the current maingroups cursors to the busy-stop cursor, show
     a shadow, and raise the box."

    |g|

    g := WindowGroup activeGroup.
    g notNil ifTrue:[
        g := g mainGroup.
        g notNil ifTrue:[
            g showCursor:(Cursor stop)
        ]
    ].
    shadowView notNil ifTrue:[shadowView realize].
    self raise.
    haveControl := true.
    super openModal.
!

show
    "make myself visible (at the last position) and take control"

    self fixSize.
    self openModal
!

showAt:aPoint
    "make myself visible at aPoint.
     Fix position to make box fully visible"

    self fixSize.
    self fixPosition:aPoint.
    self openModal
!

showAtCenter
    "make myself visible at the screen center."

    self fixSize.
    self fixPosition:(device center - (self extent / 2)).
    self openModal
!

showAtPointer
    "make myself visible at mouse pointer shifted to have
     convenient button under cursor. self positionOffset should
     return that offset (usually redefined, since we dont know here,
     which button should be under cursor)."

    self fixSize.
    self fixPosition:(device pointerPosition - self positionOffset).
    self openModal
!

showAtPointerNotCovering:aView
    "make myself visible at mouse pointer shifted to have
     convenient button under cursor.
     Fix position to make box fully visible and to make sure that
     aView is not covered."

    |pos newX|

    pos := device pointerPosition - self positionOffset.

    ((Rectangle origin:pos extent:self extent) 
        intersects: (aView origin corner: aView corner)) 
    ifTrue:[
        "
         try to the right of the untouchable view
        "
        newX := (aView origin x + aView width).
        newX + width > device width ifTrue:[
            newX := device width - width
        ].
        pos x:newX.


        ((Rectangle origin:pos extent:self extent) 
            intersects: (aView origin corner: aView corner)) 
        ifTrue:[
            "
             try to the left of the untouchable view
            "
            newX := aView origin x - width.
            "
             should look for vertical possibilities too ...
            "
            pos x:newX.
        ]

    ].
    self showAt:pos
!

hide
    "make the receiver invisible and leave control"

    |p|

    shadowView notNil ifTrue:[shadowView unrealize].
    self unrealize.
    device synchronizeOutput. 

    (windowGroup notNil and:[(p := windowGroup previousGroup) notNil]) ifTrue:[
        "
         this is a kludge for IRIS which does not provide backingstore:
         when we hide a modalbox (such as a searchbox) which covered
         a scrollbar, the scrollbars bitblt-method will copy from the
         not-yet redrawn area - effectively clearing the scroller
        "
        (Delay forSeconds:0.1) wait.
        p processExposeEvents   
    ].
    self leaveControl.
!

autoHideAfter:seconds with:anAction
    "install a background process, which hides the box
     after some time. Also, if non-nil, anAction will be
     evaluated then."

    [
        (Delay forSeconds:seconds) wait.
        self shown ifTrue:[
            self hide. 
            anAction notNil ifTrue:[anAction value]
        ]
    ] forkAt:4.

    "
     |b|

     b := InfoBox title:'hello there'.
     b autoHideAfter:5 with:[].
     b showAtCenter.
    "
! !

!ModalBox methodsFor:'events'!

pointerEnter:state x:x y:y
    "
     mhmh: this seems to be a special X kludge;
     without the following, we will not regain input focus after
     pointer is reentered"

    device setInputFocusTo:drawableId.
    super pointerEnter:state x:x y:y
! !

!ModalBox methodsFor:'private'!

leaveControl
    |g|

    windowGroup notNil ifTrue:[
        g := windowGroup mainGroup.
        g notNil ifTrue:[
            g restoreCursors
        ]
    ].
    haveControl := false.
    exclusiveKeyboard ifTrue:[
        device ungrabKeyboard
    ]
! !