"
 COPYRIGHT (c) 1993 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.
"

Object subclass:#WindowSensor
	 instanceVariableNames:'eventSemaphore damage mouseAndKeyboard 
				compressMotionEvents ignoreUserInput
				buttonState exposeEventSemaphore 
				catchExpose gotExpose gotOtherEvent
				translateKeyboardEvents'
	 classVariableNames:'ControlCEnabled'
	 poolDictionaries:''
	 category:'Interface-Support'
!

WindowSensor comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.18 1995-02-28 21:51:15 claus Exp $
'!

!WindowSensor class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1993 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/WindowSensor.st,v 1.18 1995-02-28 21:51:15 claus Exp $
"
!

documentation
"
    Instances of this class keep track of events and damage areas for a group of 
    views. All incoming expose rectangles and events (from Workstation) are 
    collected here, until someone gets a chance to handle them. 
    When adding an expose rectangle, WindowSensor tries to merge the rectangle 
    with the list of existing damages to minimize redrawing.

    instance variables:
	eventSemaphore          <Semaphore>     the semaphore to be signalled when an event
						(or damage) arrives

	damage                  <Collection>    collection of damage events

	mouseAndKeyboard        <Collection>    collection of user events

	compressMotionEvents    <Boolean>       if true, multiple motion events are
						compressed to one event. If false, each
						event is handled individual.
						(should be set to false when doing free-hand drawing)

	ignoreUserInput         <Boolean>       if true, key & button events are ignored
						(usually set to true by WindowGroup, while a
						 modalbox covers a view)

	buttonState                             the current state (currently unused)

	exposeEventSemaphore    <Semaphore>     X-special: semaphore to be signalled when
						expose event arrives after a copyArea.

	catchExpose             <Boolean>       true, while waiting for an expose event 
						(after a copyArea)

	gotExpose               <Boolean>       set to true, when an expose event arrives
						(after a copyarea)

	gotOtherEvent           <Boolean>       set to true if other events arrive while
						waiting for expose (after a copyarea).

	translateKeyboardEvents <Boolean>       if true, keyboard events are translated via
						the devices leyboardMap; if false, they
						are reported as raw-keys. Default is true.

    class variables:
	ControlCEnabled         <Boolean>       if true (which is the default) Control-C
						will interrupt the process handling the
						view.
						For secure stand-alone applications,
						this can be set to false, in which case 
						Control-C does NOT interrupt the process.
"
! !

!WindowSensor class methodsFor:'initialization'!

initialize
    ControlCEnabled := true.

!

disableControlC
    "disable Control-C processing. If enabled,
     pressing CNTL-C in a view will interrupt it and bring
     its process into the debugger (actually raising signal).
     Otherwise, CNTL-C is sent to the view like any other key.
    "

    ControlCEnabled := false
!

enableControlC
    "enable Control-C processing. If enabled,
     pressing CNTL-C in a view will interrupt it and bring
     its process into the debugger (actually raising signal).
     Otherwise, CNTL-C is sent to the view like any other key.
    "

    ControlCEnabled := true
! !

!WindowSensor class methodsFor:'instance creation'!

new
    ^ self basicNew initialize
! !

!WindowSensor methodsFor:'damage'!

addDamage: aRectangle view:aView
    "Add aRectangle to the damage list.
     We try to merge incoming rectangles with the existing damage by discarding
     incoming rectangles which are contained in the existing damage or replacing
     any existing damage rectangle with incoming rectangles that completely contain it.
     There could be much more optimization here (for example joining rectangles)..."

    |count temp index newEvent 
     sz "{ Class: SmallInteger }" |

    sz := damage size.
    sz == 0 ifTrue: [
	newEvent := WindowEvent damageFor:aView rectangle:aRectangle.
	damage := OrderedCollection with:newEvent.
	^ self
    ].

    "
     first look, if this rectangle is already in the expose list;
     if so, dont add to queue
    "
    damage do: [:aDamage | 
	aDamage notNil ifTrue:[
	    aDamage isDamage ifTrue:[
		aDamage view == aView ifTrue:[
		    ((aDamage rectangle) contains:aRectangle) ifTrue: [^self]
		]
	    ]
	].
    ].

    "
     then look, if new rectangle contains any in the expose list;
     if so, remove the old damage
    "
    count := 0.
    1 to:sz do:[:i |
	|aDamage|

	aDamage := damage at:i.
	aDamage notNil ifTrue:[
	    aDamage isDamage ifTrue:[
		(aDamage view) == aView ifTrue:[
		    (aRectangle contains:(aDamage rectangle)) ifTrue: [ 
			damage at:i put:nil.
			count := count + 1
		    ]
		]
	    ]
	]
    ].

    count > 10 ifTrue: [
	temp := OrderedCollection new:(sz - count + 1).
	index := 1.
	damage do:[:aDamage |
	    aDamage notNil ifTrue: [
		temp add: aDamage.
	    ]
	].
	damage := temp
    ].
    newEvent := WindowEvent damageFor:aView rectangle:aRectangle.
    damage add:newEvent.
!

nextDamage
    "retrieve the next damage rectangle or nil, if there is none"

    |d|

    [d isNil] whileTrue:[
	damage size == 0 ifTrue:[^ nil].
	d := damage removeFirst.
    ].
    ^ d
!

nextEvent
    "retrieve the next event or nil, if there is none"

    |e|

    [e isNil] whileTrue:[
	mouseAndKeyboard size == 0 ifTrue:[^ nil].
	e := mouseAndKeyboard removeFirst.
    ].
    ^ e
! !

!WindowSensor methodsFor:'special'!

catchExpose
    "start catching noExpose events (must be done BEFORE a bitblt,
     to prepare for the exposeEventSemaphore to be signalled when 
     the noExpose event arrives)."

    gotExpose := false.
    gotOtherEvent := false.
    catchExpose := true.
    exposeEventSemaphore := Semaphore new.
!

waitForExposeFor:aView
    "wait until a noExpose arrives (after a bitblt)"

    Processor activeProcessIsSystemProcess ifTrue:[
	"
	 cannot really suspend, if its a systemProcess
	"
	[gotExpose] whileFalse:[
	    aView device dispatchExposeEventFor:aView id.
	    Processor yield.
	]
    ] ifFalse:[
	[gotExpose] whileFalse:[
	    "
	     just in case we have a (network or software) problem ...
	     explanation: it may happen, that an expose event is totally
	     lost - for example, if the network breaks down.
	     To not block forever, we wait with a timeout, to get out of here
	     if the event does not arrive after 15 seconds.
	    "
	    (exposeEventSemaphore waitWithTimeout:5) ifFalse:[
		aView device synchronizeOutput.
		'WSENSOR: late expose event' errorPrintNL.
		(exposeEventSemaphore waitWithTimeout:10) ifFalse:[
		    'WSENSOR: lost expose event again - ignore' errorPrintNL.
		].
		"
		 you can put a comment around the following line, if you dont
		 like the message ...
		"
		gotExpose := true.
		^ self
	    ]
	].

	"
	 other incoming events have been ignored during the wait.
	 Now handle those ...
	"
	gotOtherEvent ifTrue:[
	    eventSemaphore signal
	].
    ].
    catchExpose := false
!

flushUserEvents
    "throw away all pending user events"

    (mouseAndKeyboard isNil or:[mouseAndKeyboard size > 0]) ifTrue:[
	mouseAndKeyboard := OrderedCollection new
    ].
!

flushExposeEvents
    "throw away all pending expose events; this
     can be done after a full redraw (or in views, which are
     doing full redraws anly)"

    (damage isNil or:[damage size > 0]) ifTrue:[
	damage := OrderedCollection new
    ].
!

flushExposeEventsFor:aView
    "throw away all pending expose events for aView; 
     this can be done after a full redraw 
     (or in views, which are always doing full redraws -
      instead of drawing the clip-area only)"

    damage notNil ifTrue:[
	1 to:damage size do:[:index |
	    |aDamage|

	    aDamage := damage at:index.
	    aDamage notNil ifTrue:[
		aDamage view == aView ifTrue:[
		    damage at:index put:nil
		]
	    ]
	]
    ].
!

flushUserEventsFor:aView
    "throw away all pending user events for aView" 

    mouseAndKeyboard notNil ifTrue:[
	1 to:mouseAndKeyboard size do:[:i |
	    |anEvent|

	    anEvent := mouseAndKeyboard at:i.
	    anEvent notNil ifTrue:[
		anEvent view == aView ifTrue:[
		    mouseAndKeyboard at:i put:nil
		]
	    ]
	]
    ].
!

flushEventsFor:aView
    "throw away all events for aView"

    self flushExposeEventsFor:aView.
    self flushUserEventsFor:aView.
!

pushUserEvent:anEvent
    "manually put an event into the queue - this allows
     simulation of events (implementation of recorders & playback)."

    mouseAndKeyboard addLast:anEvent.
    self notifyEventArrival
!

pushUserEvent:aSelector for:aView withArguments:arguments
    "manually put an event into the queue - this allows
     simulation of events (implementation of recorders & playback)."

    self pushEvent:(WindowEvent 
		     for:aView
		     type:aSelector
		     arguments:arguments).

    "
     |b|
     b := Button label:'test'.
     b open.
     (Delay forSeconds:5) wait.
     b sensor pushEvent:#pointerEnter:x:y: for:b withArguments:#(0 1 1).
     (Delay forSeconds:1) wait.
     b sensor pushEvent:#buttonPress:x:y: for:b withArguments:#(1 1 1).
     (Delay forSeconds:2) wait.
     b sensor pushEvent:#buttonRelease:x:y: for:b withArguments:#(1 1 1).
     (Delay forSeconds:1) wait.
     b sensor pushEvent:#pointerLeave: for:b withArguments:#(0).
    "
!

forwardKeyEventsTo:aView
    "remove all keyboard events and send them to aSensor instead"

"/ 'fwd' printNL.
    1 to:mouseAndKeyboard size do:[:i |
	|anEvent|

	anEvent := mouseAndKeyboard at:i.
	anEvent notNil ifTrue:[
	    anEvent isKeyEvent ifTrue:[
		anEvent view:aView.
		aView sensor pushUserEvent:anEvent.
"/ anEvent type printNL.
		mouseAndKeyboard at:i put:nil
	    ]
	]
    ].
! !

!WindowSensor methodsFor:'queries '!

hasDamageFor:aView 
    "return true, if any exposure events are pending for aView"

    damage size ~~ 0 ifTrue:[
	damage do:[:aDamage |
	    aDamage notNil ifTrue:[
		aDamage view == aView ifTrue:[^ true].
	    ].
	]
    ].
    ^ false
!

hasDamage 
    "return true, if any exposure events are pending"

    ^ damage size ~~ 0
!

hasEvents 
    "return true, if any mouse/keyboard events are pending"

    ^ mouseAndKeyboard size ~~ 0
!

eventPending
    "return true, if either damage or events are pending"

    mouseAndKeyboard size ~~ 0 ifTrue:[^ true].
    ^ damage size ~~ 0
!

hasButtonMotionEventsFor:aView 
    "return true, if any buttonMotion events are pending"

    mouseAndKeyboard size ~~ 0 ifTrue:[
	mouseAndKeyboard do:[:anEvent |
	    anEvent notNil ifTrue:[
		anEvent view == aView ifTrue:[
		    anEvent type == #buttonMotion:x:y: ifTrue:[^ true].
		]
	    ].
	]
    ].
    ^ aView device eventPending:#buttonMotion for:aView id
! !

!WindowSensor methodsFor:'event processing'!

notifyEventArrival
    "an event arrived - if there is an eventSemaphore,
     signal it, to wake up any controller process"

    catchExpose == true ifTrue:[
	"
	 dont wake up, if we are currently waiting for an expose
	 but remember arrival of something.
	"
	gotOtherEvent := true.
	^ self
    ].
    eventSemaphore notNil ifTrue:[
	eventSemaphore signal
    ]
!

exposeX:left y:top width:width height:height view:aView
    "an expose event arrived - this is sent from the device (Display)"

    self addDamage:(Rectangle left:left top:top width:width height:height) view:aView.
    self notifyEventArrival
!

noExposeView:aView
    "an noexpose event arrived - this is sent from the device (Display)"

    gotExpose := true.
    exposeEventSemaphore notNil ifTrue:[
	exposeEventSemaphore signal
    ]
!

graphicExposeX:left y:top width:width height:height view:aView
    self addDamage:(left @ top extent:width @ height) view:aView.
!

buttonMotion:state x:x y:y view:aView
    "mouse was moved - this is sent from the device (Display)"

    |args|

    ignoreUserInput == true ifTrue:[
	^ self
    ].
    args := Array with:state with:x with:y.

    compressMotionEvents ifTrue:[
	"
	 merge with last motion
	"
	mouseAndKeyboard reverseDo:[:ev |
	    ev notNil ifTrue:[
		((ev type == #buttonMotion:x:y:) 
		and:[(ev view == aView)
		and:[(ev arguments at:1) == state]]) ifTrue:[
		    ev arguments:args.
		    ^ self
		]
	    ]
	]
    ].
    mouseAndKeyboard
	addLast:(WindowEvent
		     for:aView
		     type:#buttonMotion:x:y:
		     arguments:args).
    self notifyEventArrival
!

buttonPress:button x:x y:y view:aView
    "mouse button was pressed - this is sent from the device (Display)"

    ignoreUserInput == true ifTrue:[
	^ self
    ].
    mouseAndKeyboard 
	addLast:(WindowEvent 
		     for:aView
		     type:#buttonPress:x:y:
		     arguments:(Array with:button with:x with:y)).
    self notifyEventArrival
!

buttonRelease:button x:x y:y view:aView
    "mouse button was released- this is sent from the device (Display)"

    ignoreUserInput == true ifTrue:[
	^ self
    ].
    mouseAndKeyboard
	addLast:(WindowEvent
		     for:aView 
		     type:#buttonRelease:x:y:
		     arguments:(Array with:button with:x with:y)).
    self notifyEventArrival
!

buttonMultiPress:button x:x y:y view:aView
    "mouse button was pressed - this is sent from the device (Display)"

    ignoreUserInput == true ifTrue:[
	^ self
    ].
    mouseAndKeyboard
	 addLast:(WindowEvent
		      for:aView
		      type:#buttonMultiPress:x:y:
		      arguments:(Array with:button with:x with:y)).
    self notifyEventArrival
!

buttonShiftPress:button x:x y:y view:aView
    "mouse button was pressed - this is sent from the device (Display)"

    ignoreUserInput == true ifTrue:[
	^ self
    ].
    mouseAndKeyboard
	addLast:(WindowEvent
		     for:aView
		     type:#buttonShiftPress:x:y:
		     arguments:(Array with:button with:x with:y)).
    self notifyEventArrival
!

keyPress:key x:x y:y view:aView
    "key was pressed - this is sent from the device (Display).
     beside the keyboard translation, CntlC processing is done here."

    |xlatedKey group process|

    translateKeyboardEvents ifTrue:[
	xlatedKey := aView device translateKey:key.
    ] ifFalse:[
	xlatedKey := key.
    ].

    (xlatedKey == #CtrlV) ifTrue:[
	'Smalltalk/X ' errorPrint. 
	Smalltalk versionString errorPrint. ' of ' errorPrint.
	Smalltalk versionDate errorPrintNL.
	Smalltalk copyrightString errorPrintNL.
    ].

    ((xlatedKey == #UserInterrupt) and:[ControlCEnabled]) ifTrue:[
	"
	 Special handling for Ctrl-C: interrupt the underlying process.

	 cannot halt here (this would stop the event-dispatcher),
	 but instead interrupt the underlying process and have it
	 perform the userInterrupt in the interrupt-method.
	"
	group := aView windowGroup.
	group notNil ifTrue:[
	    process := group process.
	    process notNil ifTrue:[
		process interruptWith:[process userInterrupt]
	    ]
	].
	^ self
    ].

    ignoreUserInput == true ifTrue:[
	^ self
    ].
    mouseAndKeyboard
	addLast:(WindowEvent
		     for:aView
		     type:#keyPress:x:y:
		     arguments:(Array with:xlatedKey with:x with:y)).
    self notifyEventArrival
!

keyRelease:key x:x y:y view:aView
    "key was released - this is sent from the device (Display)."

    |xlatedKey|

    ignoreUserInput == true ifTrue:[
	^ self
    ].
    translateKeyboardEvents ifTrue:[
	xlatedKey := aView device translateKey:key.
    ] ifFalse:[
	xlatedKey := key.
    ].
    mouseAndKeyboard
	addLast:(WindowEvent
		     for:aView
		     type:#keyRelease:x:y:
		     arguments:(Array with:xlatedKey with:x with:y)).
    self notifyEventArrival
!

pointerEnter:state x:x y:y view:aView
    "mouse cursor was moved into the view - this is sent from the device (Display)"

    mouseAndKeyboard
	addLast:(WindowEvent
		  for:aView
		  type:#pointerEnter:x:y:
		  arguments:(Array with:state with:x with:y)).
    self notifyEventArrival
!

pointerLeave:state view:aView
    "mouse cursor was moved out of the view - this is sent from the device (Display)"

    mouseAndKeyboard
	 addLast:(WindowEvent
		     for:aView
		     type:#pointerLeave: 
		     arguments:(Array with:state)).
    self notifyEventArrival
!

configureX:x y:y width:w height:h view:aView
    damage
	addLast:(WindowEvent
		     for:aView
		     type:#configureX:y:width:height:
		     arguments:(Array with:x with:y with:w with:h)).
    self notifyEventArrival
!

coveredBy:sibling view:aView
    "aView was covered by one of its siblings"

    damage
	 addLast:(WindowEvent
		     for:aView
		     type:#coveredBy:
		     arguments:(Array with:sibling)).
    self notifyEventArrival
!

focusInView:aView
    "view got input focus - this is sent from the device (Display)"

    mouseAndKeyboard
	 addLast:(WindowEvent
		     for:aView
		     type:#focusIn).
    self notifyEventArrival
!

focusOutView:aView
    "view lost input focus - this is sent from the device (Display)"

    mouseAndKeyboard
	 addLast:(WindowEvent
		     for:aView
		     type:#focusOut).
    self notifyEventArrival
!

mappedView:aView
    "view was mapped (from window manager)"

    damage
	 addLast:(WindowEvent
		     for:aView
		     type:#mapped).
    self notifyEventArrival
!

unmappedView:aView
    "view was unmapped (from window manager)"

    damage
	 addLast:(WindowEvent
		     for:aView
		     type:#unmapped).
    self notifyEventArrival
!

terminateView:aView
    "view should terminate (from window manager)"

    self flushEventsFor:aView.
    damage
	 addLast:(WindowEvent
		     for:aView
		     type:#terminate).
    self notifyEventArrival
!

saveAndTerminateView:aView
    "view should save & terminate (from window manager)"

    self flushEventsFor:aView.
    damage
	 addLast:(WindowEvent
		     for:aView
		     type:#saveAndTerminate).
    self notifyEventArrival
!

destroyedView:aView
    "view was destroyed (from window manager)"

    "at this time, the view is already gone; remove
     all pending events for this one ..."

    self flushEventsFor:aView.
    damage
	 addLast:(WindowEvent
		     for:aView
		     type:#destroyed).
    self notifyEventArrival
! !

!WindowSensor methodsFor:'initialization'!

initialize
    "initialize the event queues to empty"

    damage := OrderedCollection new.
    mouseAndKeyboard := OrderedCollection new.
    gotExpose := true.
    catchExpose := false.
    compressMotionEvents := true.
    ignoreUserInput := false.
    translateKeyboardEvents := true
!

reinitialize
    "reinitialize the event queues to empty; leave other setup as-is"

    self flushUserEvents.
    self flushExposeEvents.
    gotExpose := true.
    catchExpose := false.
! !

!WindowSensor methodsFor:'accessing'!

ignoreUserInput:aBoolean
    ignoreUserInput := aBoolean
!

ignoreUserInput
    ^ ignoreUserInput
!

eventSemaphore:aSemaphore
    "set the semaphore used to signal event arrival"

    eventSemaphore := aSemaphore
!

eventSemaphore
    "return the semaphore used to signal event arrival"

    ^ eventSemaphore
!

compressMotionEvents:aBoolean
    compressMotionEvents := aBoolean
! !