"

 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

'!

!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

"

"

!

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

! !

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

!