"
 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
'!

!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.8 1994-06-03 00:53:24 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 class methodsFor:'instance creation'!

new
    ^ super on:ModalDisplay
! !

!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
    ]
!

initEvents
    super initEvents.
    self enableKeyEvents
!

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:'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.
    ].
    device grabPointerIn:drawableId.
    device ungrabPointer.

    exclusiveKeyboard ifTrue:[
        device grabKeyboardIn:drawableId.
    ].

    "this will be changed as soon as I find out, where the
     timing problem is .... close your eyes please"

    ActiveGrab := nil.
    ModalDisplay ungrabPointer.
    ModalDisplay synchronizeOutput.
    Display ungrabPointer.
    Display synchronizeOutput.

    device setInputFocusTo:drawableId.
!

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

    self origin:aPoint.
    ((top + height) > (device height)) ifTrue:[
        self top:(device height - height)
    ].
    ((left + width) > (device width)) ifTrue:[
        self left:(device width - width)
    ].
    (top < 0) ifTrue:[
        self top:0
    ].
    (left < 0) ifTrue:[
        self left:0
    ].
!

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
!

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

    self fixSize.
    self makeVisible
!

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

    self fixSize.
    self fixPosition:aPoint.
    self makeVisible
!

showAtPointer
    "make myself visible at mouse pointer shifted to have
     convenient button under cursor.
     Fix position to make box fully visible"

    self fixSize.
    self showAt:(device pointerPosition - self positionOffset).
!

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

    |pos|

    pos := device pointerPosition - self positionOffset.
    ((Rectangle origin:pos extent:self extent) intersects:
     (aView origin corner: aView corner)) ifTrue:[
        pos x:(aView origin x + aView width)
    ].
    self showAt:pos
!

hide
    "make myself invisible and leave control"

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

!ModalBox methodsFor:'private'!

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

    Display synchronizeOutput.      "show all buffered drawing"
    shadowView notNil ifTrue:[shadowView realize].
    self raise.
    self realize.
    self takeControl
!

takeControl
    haveControl := true.

"
    exclusiveKeyboard ifTrue:[
        device grabKeyboardIn:drawableId.
    ].
    device setInputFocusTo:drawableId.
"

    "this will be changed as soon as I find out, where the
     timing problem is .... close your eyes please"

    ActiveGrab := nil.
    device ungrabKeyboard.
    device grabPointerIn:drawableId.
    device ungrabPointer.


    "this is a kludge - we do not have multiple processes, therefore
     we start another dispatch loop, which exits when control is lost"

    device dispatchModalWhile:[haveControl]
!

leaveControl
    haveControl := false.
    exclusiveKeyboard ifTrue:[
        device ungrabKeyboard
    ]
! !