WindowSensor.st
author Claus Gittinger <cg@exept.de>
Sat, 08 Feb 1997 20:34:37 +0100
changeset 1318 5810dfc3137a
parent 1317 e1bd3b4aee72
child 1320 478840db1666
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
     1
"
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
     2
 COPYRIGHT (c) 1993 by Claus Gittinger
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
     3
	      All Rights Reserved
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
     4
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
     5
 This software is furnished under a license and may be used
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
     6
 only in accordance with the terms of that license and with the
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
     8
 be provided or otherwise made available to, or used by, any
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
     9
 other person.  No title to or ownership of the software is
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
    10
 hereby transferred.
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
    11
"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    12
48194c26a46c Initial revision
claus
parents:
diff changeset
    13
Object subclass:#WindowSensor
326
f04810e0425a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 322
diff changeset
    14
	instanceVariableNames:'eventSemaphore damage mouseAndKeyboard compressMotionEvents
260
Claus Gittinger <cg@exept.de>
parents: 251
diff changeset
    15
		ignoreUserInput exposeEventSemaphore catchExpose gotExpose
Claus Gittinger <cg@exept.de>
parents: 251
diff changeset
    16
		gotOtherEvent translateKeyboardEvents shiftDown ctrlDown metaDown
Claus Gittinger <cg@exept.de>
parents: 251
diff changeset
    17
		altDown leftButtonDown middleButtonDown rightButtonDown
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
    18
		eventListener keyboardListener ignoreExposeEvents accessLock'
326
f04810e0425a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 322
diff changeset
    19
	classVariableNames:'ControlCEnabled EventListener ComposeTable GotCompose Compose1'
f04810e0425a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 322
diff changeset
    20
	poolDictionaries:''
f04810e0425a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 322
diff changeset
    21
	category:'Interface-Support'
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    22
!
48194c26a46c Initial revision
claus
parents:
diff changeset
    23
1082
44d671491f5e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1063
diff changeset
    24
!WindowSensor class methodsFor:'documentation'!
46
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    25
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    26
copyright
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    27
"
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    28
 COPYRIGHT (c) 1993 by Claus Gittinger
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
    29
	      All Rights Reserved
46
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    30
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    31
 This software is furnished under a license and may be used
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    32
 only in accordance with the terms of that license and with the
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    33
 inclusion of the above copyright notice.   This software may not
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    34
 be provided or otherwise made available to, or used by, any
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    35
 other person.  No title to or ownership of the software is
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    36
 hereby transferred.
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    37
"
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    38
!
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    39
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    40
documentation
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    41
"
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
    42
    Instances of this class keep track of events and damage areas for a group of 
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
    43
    views. All incoming expose rectangles and events (from Workstation) are 
144
claus
parents: 140
diff changeset
    44
    collected here, until someone (usually the windowGroup process)
claus
parents: 140
diff changeset
    45
    gets a chance to handle them. 
claus
parents: 140
diff changeset
    46
    In contrast to ST-80 (which has one windowSensor per window), ST/X usually
claus
parents: 140
diff changeset
    47
    only assigns one sensor per windowGroup.
157
claus
parents: 154
diff changeset
    48
    (however, you could manually arrange for per view private sensors
claus
parents: 154
diff changeset
    49
     - at least, theoretically)
144
claus
parents: 140
diff changeset
    50
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
    51
    When adding an expose rectangle, WindowSensor tries to merge the rectangle 
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
    52
    with the list of existing damages to minimize redrawing.
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
    53
158
claus
parents: 157
diff changeset
    54
    Processing of compose key sequences is done here; if a Compose
claus
parents: 157
diff changeset
    55
    key event arrives, the following 2 characters are used to search an
claus
parents: 157
diff changeset
    56
    entry in the composeTable, and are replaced by the character found there.
claus
parents: 157
diff changeset
    57
    For example, pressing Compose-a-` gives the french a-accent-grave character;
claus
parents: 157
diff changeset
    58
    pressing Compose-a-e gives the ae ligature.
claus
parents: 157
diff changeset
    59
144
claus
parents: 140
diff changeset
    60
    Beside the above, windowSensors provide facilities (hooks) to allow
157
claus
parents: 154
diff changeset
    61
    a so-called 'eventListener' to get the event before it is entered into
144
claus
parents: 140
diff changeset
    62
    the queue. There are 3 possible listening hooks available:
claus
parents: 140
diff changeset
    63
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
    64
	a global EventListener - gets keybd/mouse events for all views
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
    65
	a per-sensor eventListener - gets only keybd/mouse events for this sensors wGroup
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
    66
	a per-sensor keyboardListener - only gets keyboard events for this sensors wGroup
144
claus
parents: 140
diff changeset
    67
172
claus
parents: 158
diff changeset
    68
    (actually, there are two more mechanisms, event delegation which allows
claus
parents: 158
diff changeset
    69
     delegation of key- and buttonEvents of a specific view,
claus
parents: 158
diff changeset
    70
     and per-windowGroup eventHooks)
144
claus
parents: 140
diff changeset
    71
claus
parents: 140
diff changeset
    72
    The global eventListener is installed via a class method (eventListener:) to
claus
parents: 140
diff changeset
    73
    the WindowSensor class; local listeners are installed via instance methods.
claus
parents: 140
diff changeset
    74
    Each listener should return true, if it handled the event and that event should
claus
parents: 140
diff changeset
    75
    therefore NOT be enqueued. Likewise, if it returns false, the event is
157
claus
parents: 154
diff changeset
    76
    processed as usual (i.e. enqueued and forwarded to the views controller).
claus
parents: 154
diff changeset
    77
144
claus
parents: 140
diff changeset
    78
    The global listener is called before the local listener, which is called
claus
parents: 140
diff changeset
    79
    before the keyboard listener. If any returns true, later listeners wont get
claus
parents: 140
diff changeset
    80
    the event.
claus
parents: 140
diff changeset
    81
    EventListeners were added to allow the implementation of event recorders
157
claus
parents: 154
diff changeset
    82
    or other spy functionality. They also allow hooking up views which otherwise
claus
parents: 154
diff changeset
    83
    insist on doing things themself.
144
claus
parents: 140
diff changeset
    84
claus
parents: 140
diff changeset
    85
    Notice, that beside event listening, you can also define a delegate for
claus
parents: 140
diff changeset
    86
    a views keyboard and button events. 
claus
parents: 140
diff changeset
    87
    Read the documentation in WindowEvent for more info.
claus
parents: 140
diff changeset
    88
claus
parents: 140
diff changeset
    89
598
1a2339e902d4 commentary
Claus Gittinger <cg@exept.de>
parents: 581
diff changeset
    90
    [instance variables:]
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
    91
	eventSemaphore          <Semaphore>     the semaphore to be signalled when an event
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
    92
						(or damage) arrives
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
    93
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
    94
	damage                  <Collection>    collection of damage events
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
    95
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
    96
	mouseAndKeyboard        <Collection>    collection of user events
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
    97
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
    98
	compressMotionEvents    <Boolean>       if true, multiple motion events are
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
    99
						compressed to one event. If false, each
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   100
						event is handled individual.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   101
						(should be set to false when doing free-hand drawing)
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   102
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   103
	ignoreUserInput         <Boolean>       if true, key & button events are ignored
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   104
						(usually set to true by WindowGroup, while a
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   105
						 modalbox covers a view)
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   106
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   107
	shiftDown               <Boolean>       true while shift/meta/control-key is pressed
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   108
	metaDown                                (to support ST-80 style query: sensor shiftDown)
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   109
	ctrlDown
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   110
	altDown                                 (notice, that on most systems, alt and meta key is
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   111
						 the same, both reported as #Alt)
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   112
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   113
	exposeEventSemaphore    <Semaphore>     X-special: semaphore to be signalled when
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   114
						expose event arrives after a copyArea.
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   115
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   116
	catchExpose             <SetOfView>     if nonEMpty, the drawables which wait for
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   117
						an expose/noExpose event.  (after a copyArea)
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   118
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   119
	gotExpose               <SetOfView>     the set of drawables which got an expose/noExpose
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   120
						event.  (after a copyarea)
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   121
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   122
	gotOtherEvent           <SetOfView>     set of drawables which received if other events,
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   123
						while waiting for expose (after a copyarea).
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   124
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   125
	translateKeyboardEvents <Boolean>       if true, keyboard events are translated via
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   126
						the devices leyboardMap; if false, they
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   127
						are reported as raw-keys. Default is true.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   128
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   129
	eventListener           <Object>        if non nil, this one will get all pointer
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   130
						and keyboard events for this sensors views first.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   131
						If it returns true, the event is supposed to
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   132
						be already handled by the listener and not sent to
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   133
						the view. If false, the event is handled as usual.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   134
						This allows applications to catch events for any of
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   135
						its views.
140
claus
parents: 133
diff changeset
   136
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   137
	keyboardListener        <Object>        if non nil, this one will get all keyboard events 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   138
						for this sensors views first (but after the eventListener,
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   139
						if any).
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   140
						If it returns true, the event is supposed to
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   141
						be already handled by the listener and not sent to
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   142
						the view. If false, the event is handled as usual.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   143
						This allows applications to catch events for any of
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   144
						its views.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   145
						ApplicationModels can catch keyboard input with:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   146
						    postOpenWith:aBuilder
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   147
							aBuilder window sensor keyboardListener:self
140
claus
parents: 133
diff changeset
   148
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   149
	accessLock              <Semaphore>     controls access to the event queues
140
claus
parents: 133
diff changeset
   150
598
1a2339e902d4 commentary
Claus Gittinger <cg@exept.de>
parents: 581
diff changeset
   151
    [class variables:]
140
claus
parents: 133
diff changeset
   152
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   153
	ControlCEnabled         <Boolean>       if true (which is the default) Control-C
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   154
						will interrupt the process handling the
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   155
						view.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   156
						For secure stand-alone applications,
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   157
						this can be set to false, in which case 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   158
						Control-C does NOT interrupt the process.
124
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   159
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   160
	EventListener           <Object>        if non nil, this one will get all pointer
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   161
						and keyboard events for ALL views first.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   162
						If it returns true, the event is supposed to
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   163
						be already handled by the listener and not enqueued. 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   164
						If false, the event is handled as usual.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   165
						This allows overall event catchers to be
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   166
						installed for example to implement event
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   167
						recorders, active help managers etc.
157
claus
parents: 154
diff changeset
   168
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   169
	ComposeTable            <Array>         compose-key translation table
598
1a2339e902d4 commentary
Claus Gittinger <cg@exept.de>
parents: 581
diff changeset
   170
1a2339e902d4 commentary
Claus Gittinger <cg@exept.de>
parents: 581
diff changeset
   171
612
8758d0c9933e documentation
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   172
    [author:]
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   173
	Claus Gittinger
612
8758d0c9933e documentation
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   174
598
1a2339e902d4 commentary
Claus Gittinger <cg@exept.de>
parents: 581
diff changeset
   175
    [see also:]
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   176
	WindowGroup 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   177
	WindowEvent KeyboardMap KeyboardForwarder EventListener
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   178
	DeviceWorkstation View
46
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
   179
"
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
   180
! !
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
   181
1082
44d671491f5e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1063
diff changeset
   182
!WindowSensor class methodsFor:'initialization'!
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   183
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   184
initialize
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   185
    "initialize the classes constants"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   186
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   187
    ControlCEnabled := true.
158
claus
parents: 157
diff changeset
   188
386
f9a80cac659e only init once
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   189
    ComposeTable isNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   190
	self initializeComposeKeyTable
386
f9a80cac659e only init once
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   191
    ]
157
claus
parents: 154
diff changeset
   192
claus
parents: 154
diff changeset
   193
    "
claus
parents: 154
diff changeset
   194
     WindowSensor initialize
claus
parents: 154
diff changeset
   195
    "
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   196
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   197
    "Modified: 22.4.1996 / 16:19:24 / cg"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   198
!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   199
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   200
initializeComposeKeyTable
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   201
    "setup the composeKey table"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   202
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   203
    ComposeTable := #(
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   204
	"/ format is:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   205
	"/ ( key1 key2 <character or asciiValue> )
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   206
	"/
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   207
	($+ $+ $#)         "/ number-sign
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   208
	($A $A $@)         "/ at-sign
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   209
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   210
	($( $- ${)         "/ left brace
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   211
	($) $- $})         "/ right brace
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   212
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   213
	($| $c 16rA2)      "/ cent-sign 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   214
	($| $S $$)         "/ dollar-sign
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   215
	($= $L 16rA3)      "/ pound-sign     
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   216
	($= $Y 16rA5)      "/ yen-sign        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   217
	($!! $s 16rA7)      "/ section-sign    
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   218
	($O $C 16rA9)      "/ copyright        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   219
	($< $< 16rAB)      "/ french <<-quotes 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   220
	($O $R 16rAE)      "/ registered       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   221
	($/ $u 16rB5)      "/ greek mu         
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   222
	($!! $p 16rB6)      "/ paragraph sign   
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   223
	($> $> 16rBB)      "/ french >> quotes 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   224
	($^ $0 16rB0)      "/ degree sign      
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   225
	($+ $- 16rB1)      "/ plus-minus       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   226
	($^ $2 16rB2)      "/ superscript-2    
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   227
	($^ $3 16rB3)      "/ superscript-3    
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   228
	($^ $. 16rB7)      "/ middle dot       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   229
	($^ $1 16rB9)      "/ superscript-1    
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   230
	($1 $4 16rBC)      "/ 1/4              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   231
	($1 $2 16rBD)      "/ 1/2              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   232
	($3 $4 16rBE)      "/ 3/4              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   233
	($? $? 16rBF)      "/ ?-inverted       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   234
	($- $: 16rF7)      "/ divide           
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   235
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   236
	"/ diacriticals: Compose diacrit character
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   237
	"/ grave
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   238
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   239
	($A $` 16rC0)      "/ A-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   240
	($a $` 16rE0)      "/ a-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   241
	($E $` 16rC8)      "/ E-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   242
	($e $` 16rE8)      "/ e-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   243
	($I $` 16rCC)      "/ I-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   244
	($i $` 16rEC)      "/ i-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   245
	($O $` 16rD2)      "/ O-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   246
	($o $` 16rF2)      "/ o-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   247
	($U $` 16rD9)      "/ U-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   248
	($u $` 16rF9)      "/ u-`              
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   249
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   250
	"/ acute
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   251
	($A $' 16rC1)      "/ A-'             
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   252
	($a $' 16rE1)      "/ a-'             
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   253
	($E $' 16rC9)      "/ E-'            
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   254
	($e $' 16rE9)      "/ e-'           
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   255
	($I $' 16rCD)      "/ I-'          
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   256
	($i $' 16rED)      "/ i-'         
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   257
	($O $' 16rD3)      "/ O-'        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   258
	($o $' 16rF3)      "/ o-'       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   259
	($U $' 16rDA)      "/ U-'      
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   260
	($u $' 16rFA)      "/ u-'     
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   261
	($Y $' 16rDD)      "/ Y-'    
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   262
	($y $' 16rFD)      "/ y-'   
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   263
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   264
	"/ circumflex
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   265
	($A $^ 16rC2)      "/ A-^              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   266
	($a $^ 16rE2)      "/ a-^             
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   267
	($E $^ 16rCA)      "/ E-^            
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   268
	($e $^ 16rEA)      "/ e-^           
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   269
	($I $^ 16rCE)      "/ I-^          
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   270
	($i $^ 16rEE)      "/ i-^         
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   271
	($O $^ 16rD4)      "/ O-^        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   272
	($o $^ 16rF4)      "/ o-^       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   273
	($U $^ 16rDB)      "/ U-^      
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   274
	($u $^ 16rFB)      "/ u-^     
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   275
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   276
	"/ tilde
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   277
	($A $~ 16rC3)      "/ A-~              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   278
	($a $~ 16rE3)      "/ a-~             
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   279
	($O $~ 16rD5)      "/ O-~            
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   280
	($o $~ 16rF5)      "/ o-~           
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   281
	($N $~ 16rD1)      "/ N-tilde      
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   282
	($n $~ 16rF1)      "/ n-~         
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   283
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   284
	"/ ring above
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   285
	($a $* 16rE5)      "/ a-*              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   286
	($A $* 16rC5)      "/ A-*             
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   287
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   288
	"/ cedille
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   289
	($C $, 16rC7)      "/ C-,              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   290
	($c $, 16rE7)      "/ c-,             
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   291
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   292
	"/ dieresis
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   293
	($A $" 16rC4)      "/ A-"              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   294
	($a $" 16rE4)      "/ a-"             
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   295
	($E $" 16rCB)      "/ E-"            
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   296
	($e $" 16rEB)      "/ e-"           
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   297
	($I $" 16rCF)      "/ I-"          
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   298
	($i $" 16rEF)      "/ i-"         
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   299
	($O $" 16rD6)      "/ O-"        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   300
	($o $" 16rF6)      "/ o-"       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   301
	($U $" 16rDC)      "/ U-"      
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   302
	($u $" 16rFC)      "/ u-"     
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   303
	($y $" 16rFF)      "/ y-"    
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   304
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   305
	"/ slashed
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   306
	($o $/ 16rF8)      "/ o-/        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   307
	($O $/ 16rD8)      "/ O-/    
608
3370e1f983d4 o-slash compose sequence
Claus Gittinger <cg@exept.de>
parents: 598
diff changeset
   308
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   309
	"/ ligatures
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   310
	($s $s 16rDF)      "/ german sz        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   311
	($a $e 16rE6)      "/ (french) ae     
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   312
	($A $E 16rC6)      "/ (french) AE    
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   313
    ).
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   314
608
3370e1f983d4 o-slash compose sequence
Claus Gittinger <cg@exept.de>
parents: 598
diff changeset
   315
    "              
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   316
     WindowSensor initializeComposeKeyTable
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   317
    "
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   318
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   319
    "Created: 22.4.1996 / 14:06:43 / cg"
608
3370e1f983d4 o-slash compose sequence
Claus Gittinger <cg@exept.de>
parents: 598
diff changeset
   320
    "Modified: 24.4.1996 / 16:37:08 / cg"
140
claus
parents: 133
diff changeset
   321
! !
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   322
1082
44d671491f5e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1063
diff changeset
   323
!WindowSensor class methodsFor:'instance creation'!
140
claus
parents: 133
diff changeset
   324
claus
parents: 133
diff changeset
   325
new
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   326
    "return a new initialized instance"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   327
140
claus
parents: 133
diff changeset
   328
    ^ self basicNew initialize
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   329
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   330
    "Modified: 22.4.1996 / 16:19:40 / cg"
124
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   331
! !
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   332
1082
44d671491f5e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1063
diff changeset
   333
!WindowSensor class methodsFor:'accessing'!
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   334
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   335
composeTable
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   336
    "return the compose-key table.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   337
     Entries consist of 3-element arrays each, where
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   338
     the first two entries (of each entry) are the raw characters,
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   339
     and the third is the resulting composed-key"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   340
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   341
    ^ ComposeTable
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   342
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   343
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   344
composeTable:aTable
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   345
    "set the compose-key table.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   346
     Entries consist of 3-element arrays each, where
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   347
     the first two entries (of each entry) are the raw characters,
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   348
     and the third is the resulting composed-key"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   349
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   350
    ComposeTable := aTable
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   351
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   352
144
claus
parents: 140
diff changeset
   353
controlCEnabled:aBoolean
claus
parents: 140
diff changeset
   354
    "enable/disable Control-C processing. 
claus
parents: 140
diff changeset
   355
     If enabled, pressing CNTL-C in a view will interrupt it and bring
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   356
     its process into the debugger (actually raising signal).
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   357
     Otherwise, CNTL-C is sent to the view like any other key.
144
claus
parents: 140
diff changeset
   358
     The default is true (enabled).
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   359
    "
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   360
144
claus
parents: 140
diff changeset
   361
    ControlCEnabled := aBoolean
124
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   362
!
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   363
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   364
eventListener
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   365
    "return the eventListener 
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   366
     - see documentation for what this can be used for"
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   367
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   368
    ^ EventListener
157
claus
parents: 154
diff changeset
   369
!
claus
parents: 154
diff changeset
   370
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   371
eventListener:aListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   372
    "set the eventListener 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   373
     - see documentation for what this can be used for"
157
claus
parents: 154
diff changeset
   374
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   375
    EventListener := aListener
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   376
! !
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   377
1082
44d671491f5e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1063
diff changeset
   378
!WindowSensor class methodsFor:'queries'!
133
claus
parents: 124
diff changeset
   379
claus
parents: 124
diff changeset
   380
cursorPoint
140
claus
parents: 133
diff changeset
   381
    "ST-80 compatibility: 
157
claus
parents: 154
diff changeset
   382
     return the position of the cursor on the current display"
133
claus
parents: 124
diff changeset
   383
153
claus
parents: 152
diff changeset
   384
    ^ Screen current pointerPosition
133
claus
parents: 124
diff changeset
   385
claus
parents: 124
diff changeset
   386
    "
claus
parents: 124
diff changeset
   387
     WindowSensor cursorPoint
claus
parents: 124
diff changeset
   388
    "
claus
parents: 124
diff changeset
   389
! !
claus
parents: 124
diff changeset
   390
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   391
!WindowSensor methodsFor:'accessing'!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   392
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   393
compressMotionEvents:aBoolean
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   394
    "turn on/off motion event compression"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   395
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   396
    compressMotionEvents := aBoolean
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   397
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   398
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   399
eventListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   400
    "return the eventListener 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   401
     - see documentation for what this can be used for"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   402
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   403
    ^ eventListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   404
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   405
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   406
eventListener:aListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   407
    "set the eventListener 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   408
     - see documentation for what this can be used for"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   409
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   410
    eventListener := aListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   411
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   412
!
140
claus
parents: 133
diff changeset
   413
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   414
eventSemaphore
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   415
    "return the semaphore used to signal event arrival"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   416
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   417
    ^ eventSemaphore
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   418
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   419
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   420
eventSemaphore:aSemaphore
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   421
    "set the semaphore used to signal event arrival"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   422
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   423
    eventSemaphore := aSemaphore
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   424
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   425
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   426
ignoreExposeEvents:aBoolean
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   427
    ignoreExposeEvents := aBoolean
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   428
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   429
    "Created: 21.5.1996 / 18:21:18 / cg"
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   430
!
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   431
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   432
ignoreUserInput
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   433
    "return true, if Ctrl-C processing is currently turned off"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   434
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   435
    ^ ignoreUserInput
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   436
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   437
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   438
ignoreUserInput:aBoolean
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   439
    "turn on/off ignoring of Ctrl-C processing"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   440
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   441
    ignoreUserInput := aBoolean
140
claus
parents: 133
diff changeset
   442
!
claus
parents: 133
diff changeset
   443
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   444
keyboardListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   445
    "return the keyboardListener 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   446
     - see documentation for what this can be used for"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   447
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   448
    ^ keyboardListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   449
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   450
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   451
keyboardListener:aListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   452
    "set the keyboardListener 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   453
     - see documentation for what this can be used for"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   454
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   455
    keyboardListener := aListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   456
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   457
! !
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   458
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   459
!WindowSensor methodsFor:'event flushing'!
144
claus
parents: 140
diff changeset
   460
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   461
compressKeyPressEventsWithKey:aKey
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   462
    "count and remove multiple pending keyPress events for the
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   463
     same key, aKey. This is currently used in TextViews to compress
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   464
     multiple cursorUp/cursorDown events and do the scroll in one
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   465
     operation. (to avoid run-after-cursor on slow displays)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   466
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   467
    |n ev|
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   468
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   469
    n := 0.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   470
    ev := self pendingEvent.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   471
    [ev notNil and:[ev isKeyPressEvent]] whileTrue:[
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   472
	((ev arguments at:1) == aKey) ifTrue:[
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   473
	    n := n + 1.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   474
	    self nextEvent.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   475
	    ev := self pendingEvent.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   476
	] ifFalse:[
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   477
	    ev := nil
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   478
	]
144
claus
parents: 140
diff changeset
   479
    ].
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   480
    ^ n
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   481
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   482
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   483
flushEventsFor:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   484
    "throw away all events for aView, 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   485
     or any view, if the argument is nil."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   486
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   487
    self flushExposeEventsFor:aView.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   488
    self flushUserEventsFor:aView.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   489
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   490
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   491
flushExposeEvents
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   492
    "throw away all pending expose events; this
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   493
     can be done after a full redraw (or in views, which are
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   494
     doing full redraws anly)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   495
1317
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   496
    self flushExposeEventsFor:nil.
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   497
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   498
"/    (damage isNil or:[damage size > 0]) ifTrue:[
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   499
"/        damage := OrderedCollection new
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   500
"/    ].
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   501
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   502
    "Modified: 8.2.1997 / 15:13:21 / cg"
144
claus
parents: 140
diff changeset
   503
!
claus
parents: 140
diff changeset
   504
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   505
flushExposeEventsFor:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   506
    "throw away all pending expose events for aView, 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   507
     or any view, if the argument is nil. 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   508
     This can be done after a full redraw 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   509
     (or in views, which are always doing full redraws -
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   510
      instead of drawing the clip-area only)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   511
1317
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   512
    |nEvent "{ Class: SmallInteger }"
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   513
     anEvent|
157
claus
parents: 154
diff changeset
   514
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   515
    accessLock critical:[
1317
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   516
        damage notNil ifTrue:[
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   517
            nEvent := damage size.
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   518
            1 to:nEvent do:[:index |
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   519
                anEvent := damage at:index.
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   520
                anEvent notNil ifTrue:[
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   521
                    anEvent isDamage ifTrue:[
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   522
                        (aView isNil or:[anEvent view == aView]) ifTrue:[
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   523
                            damage at:index put:nil
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   524
                        ]
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   525
                    ]
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   526
                ]
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   527
            ]
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   528
        ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   529
    ]
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   530
1317
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
   531
    "Modified: 8.2.1997 / 15:10:37 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   532
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   533
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   534
flushKeyboard
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   535
    "ST-80 compatibility: throw away all pending keyboard events"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   536
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   537
    self flushKeyboardFor:nil
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   538
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   539
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   540
flushKeyboardFor:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   541
    "throw away all pending keyboard events for aView, 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   542
     or any view, if the argument is nil." 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   543
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   544
    |nEvent "{ Class: SmallInteger }"|
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   545
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   546
    accessLock critical:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   547
	mouseAndKeyboard notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   548
	    nEvent := mouseAndKeyboard size.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   549
	    1 to:nEvent do:[:i |
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   550
		|anEvent|
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   551
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   552
		anEvent := mouseAndKeyboard at:i.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   553
		(anEvent notNil and:[anEvent isKeyEvent]) ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   554
		    (aView isNil or:[anEvent view == aView]) ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   555
			mouseAndKeyboard at:i put:nil
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   556
		    ]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   557
		]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   558
	    ]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   559
	].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   560
    ]
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   561
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   562
    "Modified: 18.1.1997 / 14:01:04 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   563
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   564
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   565
flushUserEvents
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   566
    "throw away all pending user events"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   567
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   568
    (mouseAndKeyboard isNil or:[mouseAndKeyboard size > 0]) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   569
	self flushUserEventsFor:nil
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   570
    ].
1159
e5247f8a48f3 do not flush synthetic events in #flushUserEvents
Claus Gittinger <cg@exept.de>
parents: 1155
diff changeset
   571
e5247f8a48f3 do not flush synthetic events in #flushUserEvents
Claus Gittinger <cg@exept.de>
parents: 1155
diff changeset
   572
    "Modified: 8.1.1997 / 11:23:11 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   573
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   574
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   575
flushUserEventsFor:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   576
    "throw away all pending user events for aView, 
1159
e5247f8a48f3 do not flush synthetic events in #flushUserEvents
Claus Gittinger <cg@exept.de>
parents: 1155
diff changeset
   577
     or for any view, if the argument is nil." 
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   578
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   579
    |nEvent "{ Class: SmallInteger }"|
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   580
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   581
    accessLock critical:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   582
	mouseAndKeyboard notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   583
	    nEvent := mouseAndKeyboard size.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   584
	    1 to:nEvent do:[:i |
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   585
		|anEvent|
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   586
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   587
		anEvent := mouseAndKeyboard at:i.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   588
		anEvent notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   589
		    (aView isNil or:[anEvent view == aView]) ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   590
			anEvent isUserEvent ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   591
			    mouseAndKeyboard at:i put:nil
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   592
			]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   593
		    ]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   594
		]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   595
	    ]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   596
	].
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   597
    ].
1159
e5247f8a48f3 do not flush synthetic events in #flushUserEvents
Claus Gittinger <cg@exept.de>
parents: 1155
diff changeset
   598
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   599
    "Modified: 18.1.1997 / 14:01:17 / cg"
157
claus
parents: 154
diff changeset
   600
! !
claus
parents: 154
diff changeset
   601
claus
parents: 154
diff changeset
   602
!WindowSensor methodsFor:'event processing'!
claus
parents: 154
diff changeset
   603
140
claus
parents: 133
diff changeset
   604
buttonMotion:state x:x y:y view:aView
claus
parents: 133
diff changeset
   605
    "mouse was moved - this is sent from the device (Display)"
claus
parents: 133
diff changeset
   606
claus
parents: 133
diff changeset
   607
    |args|
claus
parents: 133
diff changeset
   608
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
   609
    "/ update my idea of shift/alt/ctrl pressed information
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
   610
    self updateModifierStateFrom:state device:(aView graphicsDevice).
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
   611
140
claus
parents: 133
diff changeset
   612
    EventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   613
	(EventListener buttonMotion:state x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   614
    ].
claus
parents: 133
diff changeset
   615
    eventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   616
	(eventListener buttonMotion:state x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   617
    ].
claus
parents: 133
diff changeset
   618
claus
parents: 133
diff changeset
   619
    ignoreUserInput == true ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   620
	^ self
140
claus
parents: 133
diff changeset
   621
    ].
claus
parents: 133
diff changeset
   622
    args := Array with:state with:x with:y.
claus
parents: 133
diff changeset
   623
claus
parents: 133
diff changeset
   624
    compressMotionEvents ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   625
	"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   626
	 merge with last motion
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   627
	"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   628
	accessLock critical:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   629
	    mouseAndKeyboard reverseDo:[:ev |
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   630
		ev notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   631
		    ((ev type == #buttonMotion:x:y:) 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   632
		    and:[(ev view == aView)
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   633
		    and:[(ev arguments at:1) == state]]) ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   634
			ev arguments:args.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   635
			^ self
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   636
		    ]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   637
		]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   638
	    ]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   639
	]
140
claus
parents: 133
diff changeset
   640
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   641
    self pushEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   642
			 for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   643
			 type:#buttonMotion:x:y:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   644
			 arguments:args).
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
   645
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   646
    "Modified: 18.1.1997 / 14:06:07 / cg"
140
claus
parents: 133
diff changeset
   647
!
claus
parents: 133
diff changeset
   648
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   649
buttonMultiPress:button x:x y:y view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   650
    "mouse button was pressed - this is sent from the device (Display)"
140
claus
parents: 133
diff changeset
   651
1083
6e947cc67324 fixed #anyButtonPressed & setting of buttonDown-flags
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   652
    self button:button inView:aView state:true.
6e947cc67324 fixed #anyButtonPressed & setting of buttonDown-flags
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   653
140
claus
parents: 133
diff changeset
   654
    EventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   655
	(EventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   656
    ].
claus
parents: 133
diff changeset
   657
    eventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   658
	(eventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   659
    ].
claus
parents: 133
diff changeset
   660
claus
parents: 133
diff changeset
   661
    ignoreUserInput == true ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   662
	^ self
140
claus
parents: 133
diff changeset
   663
    ].
1083
6e947cc67324 fixed #anyButtonPressed & setting of buttonDown-flags
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   664
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   665
    self pushEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   666
			  for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   667
			  type:#buttonMultiPress:x:y:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   668
			  arguments:(Array with:button with:x with:y)).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   669
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   670
    "Modified: 18.1.1997 / 14:06:22 / cg"
140
claus
parents: 133
diff changeset
   671
!
claus
parents: 133
diff changeset
   672
claus
parents: 133
diff changeset
   673
buttonPress:button x:x y:y view:aView
claus
parents: 133
diff changeset
   674
    "mouse button was pressed - this is sent from the device (Display)"
claus
parents: 133
diff changeset
   675
157
claus
parents: 154
diff changeset
   676
    self button:button inView:aView state:true.
claus
parents: 154
diff changeset
   677
140
claus
parents: 133
diff changeset
   678
    EventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   679
	(EventListener buttonPress:button x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   680
    ].
claus
parents: 133
diff changeset
   681
    eventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   682
	(eventListener buttonPress:button x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   683
    ].
claus
parents: 133
diff changeset
   684
claus
parents: 133
diff changeset
   685
    ignoreUserInput == true ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   686
	^ self
140
claus
parents: 133
diff changeset
   687
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   688
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   689
    self pushEvent:(WindowEvent 
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   690
		     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   691
		     type:#buttonPress:x:y:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   692
		     arguments:(Array with:button with:x with:y)).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   693
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   694
    "Modified: 18.1.1997 / 14:06:33 / cg"
140
claus
parents: 133
diff changeset
   695
!
claus
parents: 133
diff changeset
   696
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   697
buttonRelease:button x:x y:y view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   698
    "mouse button was released- this is sent from the device (Display)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   699
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   700
    self button:button inView:aView state:false.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   701
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   702
    EventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   703
	(EventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   704
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   705
    eventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   706
	(eventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   707
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   708
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   709
    ignoreUserInput == true ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   710
	^ self
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   711
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   712
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   713
    self pushEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   714
		     for:aView 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   715
		     type:#buttonRelease:x:y:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   716
		     arguments:(Array with:button with:x with:y)).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   717
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   718
    "Modified: 18.1.1997 / 14:06:46 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   719
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   720
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   721
configureX:x y:y width:w height:h view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   722
    "a views size or position has changed - this is sent from the device (Display)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   723
1108
748f9e5c5b1e ignore configureEvents for subviews.
Claus Gittinger <cg@exept.de>
parents: 1100
diff changeset
   724
    aView superView notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   725
	"/ this is a configure event for a subView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   726
	"/ I guess, this resulted from a resize of
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   727
	"/ myself (are there any windowManagers which resize sibviews ?)
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   728
	"/ Therefore, ignore it here.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   729
	"/ This also fixed problems due to late-arriving configure events,
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   730
	"/ in case of a resized view, which was resized before.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   731
	"/ Without the return below, we need a flushConfigureEvents entry here,
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   732
	"/ to be invoked whenever a subview is resized / repositioned.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   733
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   734
	^ self
1108
748f9e5c5b1e ignore configureEvents for subviews.
Claus Gittinger <cg@exept.de>
parents: 1100
diff changeset
   735
    ].
748f9e5c5b1e ignore configureEvents for subviews.
Claus Gittinger <cg@exept.de>
parents: 1100
diff changeset
   736
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   737
    self pushDamageEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   738
			     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   739
			     type:#configureX:y:width:height:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   740
			     arguments:(Array with:x with:y with:w with:h)).
1108
748f9e5c5b1e ignore configureEvents for subviews.
Claus Gittinger <cg@exept.de>
parents: 1100
diff changeset
   741
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   742
    "Modified: 18.1.1997 / 14:18:56 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   743
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   744
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   745
coveredBy:sibling view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   746
    "aView was covered by one of its siblings - this is sent from the device (Display)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   747
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   748
    self pushDamageEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   749
			     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   750
			     type:#coveredBy:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   751
			     arguments:(Array with:sibling)).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   752
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   753
    "Modified: 18.1.1997 / 14:18:32 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   754
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   755
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   756
destroyedView:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   757
    "view was destroyed (from window manager) - this is sent from the device (Display)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   758
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   759
    "at this time, the view is already gone; remove
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   760
     all pending events for this one ..."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   761
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   762
    self flushEventsFor:aView.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   763
    self pushDamageEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   764
			     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   765
			     type:#destroyed).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   766
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   767
    "Modified: 18.1.1997 / 14:18:19 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   768
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   769
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   770
exposeX:left y:top width:width height:height view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   771
    "an expose event arrived - this is sent from the device (Display)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   772
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   773
    ignoreExposeEvents ~~ true ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   774
	self addDamage:(Rectangle left:left top:top width:width height:height) 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   775
		  view:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   776
		wakeup:true
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   777
    ]
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   778
1268
612204a36c38 no, regular expose events should not trigger the exposeSema
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
   779
    "Modified: 23.1.1997 / 22:32:32 / cg"
140
claus
parents: 133
diff changeset
   780
!
claus
parents: 133
diff changeset
   781
claus
parents: 133
diff changeset
   782
focusInView:aView
claus
parents: 133
diff changeset
   783
    "view got input focus - this is sent from the device (Display)"
claus
parents: 133
diff changeset
   784
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   785
    self pushEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   786
		     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   787
		     type:#focusIn).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   788
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   789
    "Modified: 18.1.1997 / 14:07:01 / cg"
140
claus
parents: 133
diff changeset
   790
!
claus
parents: 133
diff changeset
   791
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   792
focusOutView:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   793
    "view lost input focus - this is sent from the device (Display)"
140
claus
parents: 133
diff changeset
   794
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   795
    self pushEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   796
		     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   797
		     type:#focusOut).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   798
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   799
    "Modified: 18.1.1997 / 14:07:09 / cg"
140
claus
parents: 133
diff changeset
   800
!
claus
parents: 133
diff changeset
   801
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   802
graphicsExposeX:left y:top width:width height:height final:final view:aView
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   803
    "a graphic expose event arrived - this is sent from the device (Display)"
140
claus
parents: 133
diff changeset
   804
1243
0c33cb7f8458 hopefully fixed the 'lost expose' bug
Claus Gittinger <cg@exept.de>
parents: 1242
diff changeset
   805
    "/ this is also a possible response to a scroll operation
0c33cb7f8458 hopefully fixed the 'lost expose' bug
Claus Gittinger <cg@exept.de>
parents: 1242
diff changeset
   806
    "/ (if an expose is pending)
0c33cb7f8458 hopefully fixed the 'lost expose' bug
Claus Gittinger <cg@exept.de>
parents: 1242
diff changeset
   807
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   808
    final ifTrue:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   809
        (catchExpose includes:aView) ifTrue:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   810
	    gotExpose add:aView.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   811
	    exposeEventSemaphore signalForAll
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   812
	] ifFalse:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   813
	    'WSensor [warning]: got exposeEvent for non-catching view:' infoPrint. aView infoPrintCR
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   814
	]
1243
0c33cb7f8458 hopefully fixed the 'lost expose' bug
Claus Gittinger <cg@exept.de>
parents: 1242
diff changeset
   815
    ].
0c33cb7f8458 hopefully fixed the 'lost expose' bug
Claus Gittinger <cg@exept.de>
parents: 1242
diff changeset
   816
751
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
   817
    self addDamage:(left @ top extent:width @ height) view:aView wakeup:false.
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
   818
1268
612204a36c38 no, regular expose events should not trigger the exposeSema
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
   819
    "Modified: 23.1.1997 / 22:15:53 / cg"
140
claus
parents: 133
diff changeset
   820
!
claus
parents: 133
diff changeset
   821
claus
parents: 133
diff changeset
   822
keyPress:key x:x y:y view:aView
claus
parents: 133
diff changeset
   823
    "key was pressed - this is sent from the device (Display).
claus
parents: 133
diff changeset
   824
     beside the keyboard translation, CntlC processing is done here."
claus
parents: 133
diff changeset
   825
510
c0c7a04317a9 resources
Claus Gittinger <cg@exept.de>
parents: 488
diff changeset
   826
    <resource: #keyboard ( #Compose #DestroyView #DestroyTopView #FlushInput
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   827
			   #UserInterrupt ) >
510
c0c7a04317a9 resources
Claus Gittinger <cg@exept.de>
parents: 488
diff changeset
   828
140
claus
parents: 133
diff changeset
   829
    |xlatedKey group process|
claus
parents: 133
diff changeset
   830
144
claus
parents: 140
diff changeset
   831
    self key:key state:true. 
claus
parents: 140
diff changeset
   832
140
claus
parents: 133
diff changeset
   833
    EventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   834
	(EventListener keyPress:key x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   835
    ].
claus
parents: 133
diff changeset
   836
    eventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   837
	(eventListener keyPress:key x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   838
    ].
claus
parents: 133
diff changeset
   839
    keyboardListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   840
	(keyboardListener keyPress:key x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   841
    ].
claus
parents: 133
diff changeset
   842
claus
parents: 133
diff changeset
   843
    translateKeyboardEvents ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   844
	xlatedKey := aView graphicsDevice translateKey:key.
140
claus
parents: 133
diff changeset
   845
    ] ifFalse:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   846
	xlatedKey := key.
140
claus
parents: 133
diff changeset
   847
    ].
157
claus
parents: 154
diff changeset
   848
140
claus
parents: 133
diff changeset
   849
    xlatedKey isNil ifTrue:[^ self].
claus
parents: 133
diff changeset
   850
157
claus
parents: 154
diff changeset
   851
    (xlatedKey == #Compose) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   852
	GotCompose := true. Compose1 := nil.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   853
	^ self
157
claus
parents: 154
diff changeset
   854
    ].
claus
parents: 154
diff changeset
   855
    GotCompose == true ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   856
	Compose1 isNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   857
	    (self isModifierKey:xlatedKey) ifFalse:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   858
		Compose1 := xlatedKey. 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   859
	    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   860
	    ^ self
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   861
	].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   862
	(self isModifierKey:xlatedKey) ifFalse:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   863
	    xlatedKey  := self compose:Compose1 with:xlatedKey.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   864
	    Compose1 := nil. GotCompose := false.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   865
	]
157
claus
parents: 154
diff changeset
   866
    ].
claus
parents: 154
diff changeset
   867
claus
parents: 154
diff changeset
   868
    (xlatedKey == #CmdCtrlV) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   869
	'Smalltalk/X ' errorPrint. 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   870
	Smalltalk versionString errorPrint. ' of ' errorPrint.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   871
	Smalltalk versionDate errorPrintCR.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   872
	Smalltalk copyrightString errorPrintCR.
140
claus
parents: 133
diff changeset
   873
    ].
claus
parents: 133
diff changeset
   874
157
claus
parents: 154
diff changeset
   875
    (xlatedKey == #DestroyView) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   876
	aView closeRequest.
157
claus
parents: 154
diff changeset
   877
    ].
claus
parents: 154
diff changeset
   878
    (xlatedKey == #DestroyTopView) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   879
	aView topView closeRequest.
157
claus
parents: 154
diff changeset
   880
    ].
claus
parents: 154
diff changeset
   881
152
claus
parents: 144
diff changeset
   882
    (xlatedKey == #FlushInput) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   883
	"this removes any enqueued user events -
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   884
	 helps, if you pressed DoIt too often, and want to flush those
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   885
	"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   886
	self flushUserEvents.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   887
	^ self
152
claus
parents: 144
diff changeset
   888
    ].
claus
parents: 144
diff changeset
   889
140
claus
parents: 133
diff changeset
   890
    ((xlatedKey == #UserInterrupt) and:[ControlCEnabled]) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   891
	"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   892
	 Special handling for Ctrl-C: interrupt the underlying process.
140
claus
parents: 133
diff changeset
   893
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   894
	 cannot halt here (this would stop the event-dispatcher),
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   895
	 but instead interrupt the underlying process and have it
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   896
	 perform the userInterrupt in the interrupt-method.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   897
	"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   898
	group := aView windowGroup.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   899
	group notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   900
	    process := group process.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   901
	    process notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   902
		process interruptWith:[:where | process userInterruptIn:where]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   903
	    ]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   904
	].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   905
	^ self
140
claus
parents: 133
diff changeset
   906
    ].
claus
parents: 133
diff changeset
   907
claus
parents: 133
diff changeset
   908
    ignoreUserInput == true ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   909
	^ self
140
claus
parents: 133
diff changeset
   910
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   911
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   912
    self pushEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   913
		     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   914
		     type:#keyPress:x:y:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   915
		     arguments:(Array with:xlatedKey with:x with:y)).
510
c0c7a04317a9 resources
Claus Gittinger <cg@exept.de>
parents: 488
diff changeset
   916
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   917
    "Modified: 18.1.1997 / 14:07:25 / cg"
140
claus
parents: 133
diff changeset
   918
!
claus
parents: 133
diff changeset
   919
claus
parents: 133
diff changeset
   920
keyRelease:key x:x y:y view:aView
claus
parents: 133
diff changeset
   921
    "key was released - this is sent from the device (Display)."
claus
parents: 133
diff changeset
   922
claus
parents: 133
diff changeset
   923
    |xlatedKey|
claus
parents: 133
diff changeset
   924
144
claus
parents: 140
diff changeset
   925
    self key:key state:false. 
claus
parents: 140
diff changeset
   926
140
claus
parents: 133
diff changeset
   927
    EventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   928
	(EventListener keyRelease:key x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   929
    ].
claus
parents: 133
diff changeset
   930
    eventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   931
	(eventListener keyRelease:key x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   932
    ].
claus
parents: 133
diff changeset
   933
    keyboardListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   934
	(keyboardListener keyRelease:key x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   935
    ].
claus
parents: 133
diff changeset
   936
claus
parents: 133
diff changeset
   937
    ignoreUserInput == true ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   938
	^ self
140
claus
parents: 133
diff changeset
   939
    ].
claus
parents: 133
diff changeset
   940
    translateKeyboardEvents ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   941
	xlatedKey := aView graphicsDevice translateKey:key.
140
claus
parents: 133
diff changeset
   942
    ] ifFalse:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   943
	xlatedKey := key.
140
claus
parents: 133
diff changeset
   944
    ].
claus
parents: 133
diff changeset
   945
    xlatedKey isNil ifTrue:[^ self].
claus
parents: 133
diff changeset
   946
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   947
    self pushEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   948
		     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   949
		     type:#keyRelease:x:y:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   950
		     arguments:(Array with:xlatedKey with:x with:y)).
743
64c9b71b3cc4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 708
diff changeset
   951
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   952
    "Modified: 18.1.1997 / 14:07:36 / cg"
140
claus
parents: 133
diff changeset
   953
!
claus
parents: 133
diff changeset
   954
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   955
mappedView:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   956
    "view was mapped (from window manager) - this is sent from the device (Display)"
140
claus
parents: 133
diff changeset
   957
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   958
    self pushDamageEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   959
			     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   960
			     type:#mapped).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   961
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   962
    "Modified: 18.1.1997 / 14:17:58 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   963
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   964
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   965
noExposeView:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   966
    "an noexpose event arrived - this is sent from the device (Display)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   967
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   968
    (catchExpose includes:aView) ifTrue:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   969
        gotExpose add:aView.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   970
        exposeEventSemaphore signalForAll
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   971
    ] ifFalse:[
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
   972
        'WSensor [warning]: got noExpose for non-catching view:' infoPrint. aView infoPrintCR
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   973
    ]
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   974
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   975
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   976
pointerEnter:state x:x y:y view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   977
    "mouse cursor was moved into the view - this is sent from the device (Display)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   978
470
c5c227de3443 care for wrong shift/ctrl/alt setting when pointer leaves view and reenters with different keyState
Claus Gittinger <cg@exept.de>
parents: 428
diff changeset
   979
    "/ update my idea of shift/alt/ctrl pressed information
743
64c9b71b3cc4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 708
diff changeset
   980
    self updateModifierStateFrom:state device:(aView graphicsDevice).
470
c5c227de3443 care for wrong shift/ctrl/alt setting when pointer leaves view and reenters with different keyState
Claus Gittinger <cg@exept.de>
parents: 428
diff changeset
   981
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   982
    EventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   983
	(EventListener pointerEnter:state x:x y:y view:aView) ifTrue:[^ self]
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   984
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   985
    eventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   986
	(eventListener pointerEnter:state x:x y:y view:aView) ifTrue:[^ self]
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   987
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   988
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   989
    self pushEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   990
		       for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   991
		       type:#pointerEnter:x:y:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   992
		       arguments:(Array with:state with:x with:y)).
470
c5c227de3443 care for wrong shift/ctrl/alt setting when pointer leaves view and reenters with different keyState
Claus Gittinger <cg@exept.de>
parents: 428
diff changeset
   993
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   994
    "Modified: 18.1.1997 / 14:07:58 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   995
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   996
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   997
pointerLeave:state view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   998
    "mouse cursor was moved out of the view - this is sent from the device (Display)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   999
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1000
    "/ update my idea of shift/alt/ctrl pressed information
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1001
    self updateModifierStateFrom:state device:(aView graphicsDevice).
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1002
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1003
    EventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1004
	(EventListener pointerLeave:state view:aView) ifTrue:[^ self]
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1005
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1006
    eventListener notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1007
	(eventListener pointerLeave:state view:aView) ifTrue:[^ self]
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1008
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1009
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1010
    self pushEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1011
		     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1012
		     type:#pointerLeave: 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1013
		     arguments:(Array with:state)).
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1014
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1015
    "Modified: 18.1.1997 / 14:08:07 / cg"
140
claus
parents: 133
diff changeset
  1016
!
claus
parents: 133
diff changeset
  1017
claus
parents: 133
diff changeset
  1018
saveAndTerminateView:aView
claus
parents: 133
diff changeset
  1019
    "view should save & terminate (from window manager) - this is sent from the device (Display)"
claus
parents: 133
diff changeset
  1020
claus
parents: 133
diff changeset
  1021
    self flushEventsFor:aView.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1022
    self pushDamageEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1023
			     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1024
			     type:#saveAndTerminate).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1025
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1026
    "Modified: 18.1.1997 / 14:17:37 / cg"
140
claus
parents: 133
diff changeset
  1027
!
claus
parents: 133
diff changeset
  1028
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1029
terminateView:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1030
    "view should terminate (from window manager) - this is sent from the device (Display)"
140
claus
parents: 133
diff changeset
  1031
claus
parents: 133
diff changeset
  1032
    self flushEventsFor:aView.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1033
    self pushDamageEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1034
			     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1035
			     type:#terminate).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1036
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1037
    "Modified: 18.1.1997 / 14:17:24 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1038
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1039
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1040
unmappedView:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1041
    "view was unmapped (from window manager) - this is sent from the device (Display)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1042
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1043
    self pushDamageEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1044
			     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1045
			     type:#unmapped).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1046
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1047
    "Modified: 18.1.1997 / 14:17:01 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1048
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1049
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1050
!WindowSensor methodsFor:'event processing - private'!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1051
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1052
button:button inView:aView state:onOrOff
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1053
    "update the state of the xxxButtonDown flags"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1054
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1055
    |physicalButton|
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1056
743
64c9b71b3cc4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 708
diff changeset
  1057
    physicalButton := aView graphicsDevice buttonTranslation keyAtValue:button ifAbsent:button.
1084
9c433066e960 oops - leftover debugPrint
Claus Gittinger <cg@exept.de>
parents: 1083
diff changeset
  1058
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1059
    (physicalButton == 1) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1060
	leftButtonDown := onOrOff.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1061
	^ self
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1062
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1063
    (physicalButton == 2) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1064
	middleButtonDown := onOrOff.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1065
	^ self
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1066
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1067
    (physicalButton == 3) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1068
	rightButtonDown := onOrOff.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1069
	^ self
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1070
    ].
743
64c9b71b3cc4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 708
diff changeset
  1071
1084
9c433066e960 oops - leftover debugPrint
Claus Gittinger <cg@exept.de>
parents: 1083
diff changeset
  1072
    "Modified: 21.10.1996 / 11:47:35 / cg"
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1073
!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1074
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1075
compose:key1 with:key2
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1076
    "compose a 2-character sequence into a composed key"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1077
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1078
    ComposeTable do:[:entry |
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1079
	|v|
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1080
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1081
	((key1 == (entry at:1)) and:[key2 == (entry at:2)]) ifTrue:[
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1082
	    v := entry at:3.
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1083
	    v isCharacter ifFalse:[v := Character value:v].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1084
	    ^ v
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1085
	]
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1086
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1087
    "/
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1088
    "/ for illegal sequence, return 2nd key
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1089
    "/
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1090
"/ key1 print. ' ' print. key2 printNL.
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1091
    ^ key2
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1092
!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1093
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1094
isModifierKey:key
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1095
    "return true if key is a modifier (Alt, Shift, Ctrl or Meta)"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1096
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1097
    (key == #Shift
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1098
    or:[key == #'Shift_R' 
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1099
    or:[key == #'Shift_L']]) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1100
	^ true
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1101
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1102
    (key == #Alt
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1103
    or:[key == #'Alt_R' or:[key == #'Alt_L']])  ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1104
	^ true
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1105
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1106
    (key == #Meta
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1107
    or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1108
	^ true
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1109
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1110
    (key == #Control
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1111
    or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1112
	^ true
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1113
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1114
    ^ false
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1115
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1116
    "Modified: 22.4.1996 / 16:22:16 / cg"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1117
!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1118
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1119
key:key state:onOrOff
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1120
    "update the state of the shiftDown/metaDown and ctrlDown
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1121
     flags"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1122
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1123
    (key = #Shift
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1124
    or:[key = #'Shift_R' 
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1125
    or:[key = #'Shift_L']]) ifTrue:[
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1126
	shiftDown := onOrOff.
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1127
	^ self
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1128
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1129
    (key = #Alt
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1130
    or:[key = #'Alt_R' or:[key = #'Alt_L']])  ifTrue:[
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1131
	altDown := onOrOff.
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1132
	^ self
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1133
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1134
    (key = #Meta
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1135
    or:[key = #'Meta_R' or:[key = #'Meta_L']]) ifTrue:[
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1136
	metaDown := onOrOff.
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1137
	^ self
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1138
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1139
    (key = #Control
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1140
    or:[key = #'Control_R' or:[key = #'Control_L']]) ifTrue:[
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1141
	ctrlDown := onOrOff.
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1142
	^ self
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1143
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1144
!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1145
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1146
notifyEventArrival:aView
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1147
    "an event arrived - if there is an eventSemaphore,
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1148
     signal it, to wake up any windowGroup process"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1149
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1150
    (catchExpose includesIdentical:aView) ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1151
        "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1152
         dont wake up, if we are currently waiting for an expose
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1153
         but remember arrival of something.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1154
        "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1155
        gotOtherEvent add:aView.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1156
        ^ self
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1157
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1158
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1159
    eventSemaphore notNil ifTrue:[
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1160
"/        eventSemaphore signal
1184
1372bad824af single trigger on the eventSemaphore is ok
Claus Gittinger <cg@exept.de>
parents: 1179
diff changeset
  1161
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1162
        "/ can get along with a single trigger;
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1163
        "/ because processEvents will read all events
1184
1372bad824af single trigger on the eventSemaphore is ok
Claus Gittinger <cg@exept.de>
parents: 1179
diff changeset
  1164
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1165
        eventSemaphore signalOnce
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1166
    ]
1184
1372bad824af single trigger on the eventSemaphore is ok
Claus Gittinger <cg@exept.de>
parents: 1179
diff changeset
  1167
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1168
    "Modified: 8.2.1997 / 12:01:48 / cg"
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1169
!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1170
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1171
updateModifierStateFrom:state device:aDevice
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1172
    "this refetches the modifier key-states.
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1173
     Called privately when pointer enters a view."
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1174
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1175
    "/ Prevents wrong behavior in the following scenario:
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1176
    "/    ctrl is pressed in a view
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1177
    "/    pointer is moved out of view
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1178
    "/    ctrl is released
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1179
    "/    pointer moved back into view
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1180
    "/    popup-menu still thinks that ctrl is pressed"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1181
        
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1182
    shiftDown := "state bitAnd:(aDevice shiftMask)       " aDevice shiftDown.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1183
    ctrlDown := "state bitAnd:(aDevice controlMask)      " aDevice ctrlDown.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1184
    metaDown := "state bitAnd:(aDevice metaModifierMask) " aDevice metaDown.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1185
    altDown := "state bitAnd:(aDevice altModifierMask)   " aDevice altDown.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1186
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1187
    leftButtonDown := "state bitAnd:(aDevice leftButtonStateMask) " aDevice leftButtonPressed.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1188
    middleButtonDown := "state bitAnd:(aDevice middleButtonStateMask)" aDevice middleButtonPressed.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1189
    rightButtonDown := "state bitAnd:(aDevice rightButtonStateMask)" aDevice rightButtonPressed.
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1190
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1191
    "Created: 27.2.1996 / 14:54:38 / cg"
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1192
    "Modified: 1.11.1996 / 16:51:47 / cg"
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1193
! !
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1194
140
claus
parents: 133
diff changeset
  1195
!WindowSensor methodsFor:'event queue'!
claus
parents: 133
diff changeset
  1196
144
claus
parents: 140
diff changeset
  1197
addDamage:aRectangle view:aView
1318
5810dfc3137a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1317
diff changeset
  1198
    "{ Pragma: +optSpeed }"
5810dfc3137a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1317
diff changeset
  1199
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1200
    "Add aRectangle to the damage list.
144
claus
parents: 140
diff changeset
  1201
     Try to merge incoming rectangles with the existing damage rectangles.
claus
parents: 140
diff changeset
  1202
     Incoming rectangles which are completely contained in any existing damage rect are ignored,
claus
parents: 140
diff changeset
  1203
     any existing damage rectangle which is completely contained in the incoming rectangle
152
claus
parents: 144
diff changeset
  1204
     is replaced. Also, rectangles are merged into bigger ones, if they join exactly.
144
claus
parents: 140
diff changeset
  1205
     Except for special cases (moveOpaque of a view over one of my views),
claus
parents: 140
diff changeset
  1206
     these optimizations are not noticable."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1207
751
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1208
    ^ self addDamage:aRectangle view:aView wakeup:true
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1209
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1210
    "Modified: 28.5.1996 / 21:52:47 / cg"
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1211
!
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1212
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1213
addDamage:aRectangle view:aView wakeup:doWakeup
1317
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
  1214
    "{ Pragma: +optSpeed }"
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
  1215
751
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1216
    "Add aRectangle to the damage list.
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1217
     Try to merge incoming rectangles with the existing damage rectangles.
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1218
     Incoming rectangles which are completely contained in any existing damage rect are ignored,
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1219
     any existing damage rectangle which is completely contained in the incoming rectangle
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1220
     is replaced. Also, rectangles are merged into bigger ones, if they join exactly.
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1221
     Except for special cases (moveOpaque of a view over one of my views),
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1222
     these optimizations are not noticable.
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1223
     Returns true, if a new event has been added to the queue, false if it
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1224
     was optimized away."
751
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1225
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1226
    |wakeup|
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1227
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1228
    accessLock critical:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1229
        (self basicAddDamage:aRectangle view:aView)
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1230
        ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1231
            doWakeup ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1232
                self notifyEventArrival:aView.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1233
                ^ true
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1234
            ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1235
        ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1236
    ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1237
    ^ false
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1238
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1239
    "Created: 28.5.1996 / 21:51:16 / cg"
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1240
    "Modified: 8.2.1997 / 12:10:35 / cg"
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1241
!
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1242
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1243
basicAddDamage:aRectangle view:aView
1317
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
  1244
    "{ Pragma: +optSpeed }"
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
  1245
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1246
    "Add aRectangle to the damage list.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1247
     Try to merge incoming rectangles with the existing damage rectangles.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1248
     Incoming rectangles which are completely contained in any existing damage rect are ignored,
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1249
     any existing damage rectangle which is completely contained in the incoming rectangle
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1250
     is replaced. Also, rectangles are merged into bigger ones, if they join exactly.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1251
     Except for special cases (moveOpaque of a view over one of my views),
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1252
     these optimizations are not noticable.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1253
     Returns true, if a new event has been added to the queue, false if it
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1254
     was optimized away."
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1255
154
claus
parents: 153
diff changeset
  1256
    |temp index newEvent r rL rT rB rR
152
claus
parents: 144
diff changeset
  1257
     count             "{ Class: SmallInteger }" 
claus
parents: 144
diff changeset
  1258
     sz                "{ Class: SmallInteger }" 
322
bf5230ae7aab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 313
diff changeset
  1259
     firstInteresting  "{ Class: SmallInteger }"
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1260
     lastInteresting   "{ Class: SmallInteger }"
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1261
     aDamage dRect dL dR dT dB fullRedraw|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1262
152
claus
parents: 144
diff changeset
  1263
    r := aRectangle.
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1264
    (fullRedraw := aView redrawsFull) ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1265
        r := 0@0 corner:9999@9999.
488
97f384f5e2aa views which always redraw full may say so in #redrawsFull
Claus Gittinger <cg@exept.de>
parents: 476
diff changeset
  1266
    ].
97f384f5e2aa views which always redraw full may say so in #redrawsFull
Claus Gittinger <cg@exept.de>
parents: 476
diff changeset
  1267
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1268
    sz := damage size.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1269
    sz == 0 ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1270
        damage := OrderedCollection new:10.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1271
    ] ifFalse:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1272
        "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1273
         first look, if this rectangle is already in the expose list;
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1274
         if so, dont add to queue
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1275
         On the fly, count the number of damages for this view
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1276
        "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1277
        fullRedraw ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1278
            firstInteresting := 1.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1279
            lastInteresting := sz.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1280
        ] ifFalse:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1281
            count := firstInteresting := 0.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1282
            1 to:sz do:[:i |
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1283
                aDamage := damage at:i.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1284
                aDamage notNil ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1285
                    aDamage isDamage ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1286
                        aDamage view == aView ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1287
                            ((aDamage rectangle) contains:r) ifTrue: [^ false].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1288
                            count := count + 1.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1289
                            lastInteresting := i.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1290
                            firstInteresting == 0 ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1291
                                firstInteresting := i
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1292
                            ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1293
                        ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1294
                    ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1295
                ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1296
            ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1297
        ].
46
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
  1298
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1299
        "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1300
         are there any damages for this view in the queue ?
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1301
        "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1302
        firstInteresting ~~ 0 ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1303
            "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1304
             if there are already many damages for this view,
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1305
             remove them all, and replace by a full expose
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1306
             This limits the runtime spent here, which may become big
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1307
             due to the square runtime behavior (stupid algorithm ...)
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1308
            "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1309
            (fullRedraw or:[count > 30]) ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1310
                r := 0@0 corner:99999@99999.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1311
                firstInteresting to:lastInteresting do:[:i |
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1312
                    aDamage := damage at:i.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1313
                    aDamage notNil ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1314
                        aDamage isDamage ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1315
                            (aDamage view) == aView ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1316
                                damage at:i put:nil.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1317
                            ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1318
                        ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1319
                    ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1320
                ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1321
                newEvent := WindowEvent damageFor:aView rectangle:r.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1322
                damage add:newEvent.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1323
                ^ true
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1324
            ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1325
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1326
            "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1327
             then look, if the new rectangle contains any in the expose list;
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1328
             if so, remove the old damage (here, by nilling it in the queue).
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1329
             Or, merge it with existing rectangles if possible.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1330
            "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1331
            count := 0.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1332
            rR := r right.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1333
            rL := r left.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1334
            rT := r top.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1335
            rB := r bottom.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1336
            firstInteresting to:lastInteresting do:[:i |
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1337
                aDamage := damage at:i.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1338
                aDamage notNil ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1339
                    aDamage isDamage ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1340
                        (aDamage view) == aView ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1341
                            dRect := aDamage rectangle.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1342
                            (r contains:dRect) ifTrue: [ 
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1343
                                damage at:i put:nil.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1344
                                count := count + 1
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1345
                            ] ifFalse:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1346
                                dL := dRect left.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1347
                                dT := dRect top.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1348
                                dR := dRect right.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1349
                                dB := dRect bottom.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1350
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1351
                                (rT == dT
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1352
                                and:[rB == dB]) ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1353
                                    (rR > dR) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1354
                                        (rL <= (dR + 1)) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1355
                                            dRect right:rR.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1356
                                            ^ false
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1357
                                        ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1358
                                    ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1359
                                    (rL < dL) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1360
                                        (rR >= (dL  - 1)) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1361
                                            dRect left:rL.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1362
                                            ^ false
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1363
                                        ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1364
                                    ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1365
                                ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1366
                                (rR == dR
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1367
                                and:[rL == dL]) ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1368
                                    (rB > dB) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1369
                                        (rT <= (dB + 1)) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1370
                                            dRect bottom:rB.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1371
                                            ^ false
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1372
                                        ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1373
                                    ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1374
                                    (rT < dT) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1375
                                        (rB >= (dT - 1)) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1376
                                            dRect top:rT.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1377
                                            ^ false
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1378
                                        ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1379
                                    ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1380
                                ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1381
                            ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1382
                        ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1383
                    ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1384
                ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1385
            ].
152
claus
parents: 144
diff changeset
  1386
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1387
"/            "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1388
"/             if we nilled more then 20 events, reorganize the queue
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1389
"/             (doing this for every 20 removes only avoids excessive 
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1390
"/              reorganization of the input queue)
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1391
"/            "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1392
"/            count > 20 ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1393
"/                temp := OrderedCollection new:(sz - count + 1).
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1394
"/                index := 1.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1395
"/                1 to:sz do:[:idx |
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1396
"/                    aDamage := damage at:idx.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1397
"/                    aDamage notNil ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1398
"/                        temp add:aDamage.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1399
"/                    ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1400
"/                ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1401
"/                damage := temp
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1402
"/            ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1403
        ].
46
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
  1404
    ].
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
  1405
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1406
    newEvent := WindowEvent damageFor:aView rectangle:r.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1407
    damage add:newEvent.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1408
144
claus
parents: 140
diff changeset
  1409
    ^ true
488
97f384f5e2aa views which always redraw full may say so in #redrawsFull
Claus Gittinger <cg@exept.de>
parents: 476
diff changeset
  1410
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1411
    "Created: 8.2.1997 / 12:07:06 / cg"
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1412
    "Modified: 8.2.1997 / 12:21:30 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1413
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1414
428
33156201125b added #hasConfigureEvent
werner
parents: 386
diff changeset
  1415
damage
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1416
    "return the damage event list"
428
33156201125b added #hasConfigureEvent
werner
parents: 386
diff changeset
  1417
33156201125b added #hasConfigureEvent
werner
parents: 386
diff changeset
  1418
    ^ damage.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1419
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1420
    "Modified: 18.1.1997 / 14:11:08 / cg"
428
33156201125b added #hasConfigureEvent
werner
parents: 386
diff changeset
  1421
!
33156201125b added #hasConfigureEvent
werner
parents: 386
diff changeset
  1422
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1423
nextDamage
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1424
    "retrieve the next damage (either expose or resize event)
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1425
     or nil, if there is none. Remove it from the queue."
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1426
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1427
    |d|
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1428
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1429
    damage size == 0 ifTrue:[^ nil].
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1430
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1431
    [d isNil] whileTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1432
	"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1433
	 be careful: events are inserted at higher prio ...
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1434
	"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1435
	accessLock critical:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1436
	    damage size == 0 ifTrue:[^ nil].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1437
	    d := damage removeFirst.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1438
	]
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1439
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1440
    ^ d
476
cc4848695a66 care to reenable interrupts
Claus Gittinger <cg@exept.de>
parents: 470
diff changeset
  1441
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1442
    "Modified: 18.1.1997 / 14:13:50 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1443
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1444
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1445
nextEvent
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1446
    "retrieve the next event or nil, if there is none.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1447
     Remove it from the queue."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1448
1063
ba1bf8091bc1 unused variable cleanup
Claus Gittinger <cg@exept.de>
parents: 1027
diff changeset
  1449
    |e|
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1450
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1451
    mouseAndKeyboard size == 0 ifTrue:[^ nil].
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1452
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1453
    [e isNil] whileTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1454
	"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1455
	 be careful: events are inserted at higher prio ...
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1456
	"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1457
	accessLock critical:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1458
	    mouseAndKeyboard size == 0 ifTrue:[^ nil].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1459
	    e := mouseAndKeyboard removeFirst.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1460
	]
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1461
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1462
    ^ e
476
cc4848695a66 care to reenable interrupts
Claus Gittinger <cg@exept.de>
parents: 470
diff changeset
  1463
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1464
    "Modified: 18.1.1997 / 14:13:39 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1465
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1466
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1467
nextExposeEventFor:aView
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1468
    "retrieve the next expose event for aView, or nil, if there is none.
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1469
     Remove it from the queue."
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1470
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1471
    damage size == 0 ifTrue:[^ nil].
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1472
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1473
    "
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1474
     be careful: events are inserted at higher prio ...
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1475
    "
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1476
    accessLock critical:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1477
	damage keysAndValuesDo:[:idx :aDamage |
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1478
	    aDamage notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1479
		aDamage view == aView ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1480
		    damage at:idx put:nil.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1481
		    ^ aDamage
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1482
		].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1483
	    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1484
	]
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1485
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1486
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1487
    ^ nil
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1488
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1489
    "Created: 21.5.1996 / 17:20:54 / cg"
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1490
    "Modified: 18.1.1997 / 14:14:59 / cg"
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1491
!
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1492
140
claus
parents: 133
diff changeset
  1493
pendingEvent
152
claus
parents: 144
diff changeset
  1494
    "retrieve the next pending user (i.e. non-damage) event.
claus
parents: 144
diff changeset
  1495
     Return nil, if there is none pending.
140
claus
parents: 133
diff changeset
  1496
     Do not remove it from the queue."
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
  1497
1063
ba1bf8091bc1 unused variable cleanup
Claus Gittinger <cg@exept.de>
parents: 1027
diff changeset
  1498
    |e|
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
  1499
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1500
    mouseAndKeyboard size == 0 ifTrue:[^ nil].
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1501
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
  1502
    [e isNil] whileTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1503
	"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1504
	 be careful: events are inserted at higher prio ...
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1505
	"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1506
	accessLock critical:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1507
	    mouseAndKeyboard size == 0 ifTrue:[^ nil].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1508
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1509
	    e := mouseAndKeyboard first.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1510
	    e isNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1511
		mouseAndKeyboard removeFirst
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1512
	    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1513
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1514
    ].
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
  1515
    ^ e
476
cc4848695a66 care to reenable interrupts
Claus Gittinger <cg@exept.de>
parents: 470
diff changeset
  1516
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1517
    "Modified: 18.1.1997 / 14:13:04 / cg"
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1518
!
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1519
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1520
pushDamageEvent:anEvent
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1521
    "put an event into the damage queue
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1522
     - this is not meant for public use"
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1523
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1524
    accessLock critical:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1525
	damage addLast:anEvent.
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1526
	self notifyEventArrival:anEvent view
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1527
    ].
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1528
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1529
    "Modified: 18.1.1997 / 14:04:39 / cg"
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1530
    "Created: 18.1.1997 / 14:16:45 / cg"
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1531
!
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1532
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1533
pushEvent:anEvent
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1534
    "put an event into the queue - this can also be sent by
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1535
     applications and allows simulation of events 
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1536
     (implementation of recorders & playback)
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1537
     or asynchronous communication between view applications
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1538
     (by sending arbitrary events, which leads to a message sent,
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1539
      when the target windowGroups process is rescheduled)."
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1540
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1541
    accessLock critical:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1542
	mouseAndKeyboard addLast:anEvent.
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1543
	self notifyEventArrival:anEvent view
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1544
    ].
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1545
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1546
    "Created: 18.9.1995 / 22:37:57 / claus"
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1547
    "Modified: 18.1.1997 / 14:04:39 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1548
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1549
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1550
!WindowSensor methodsFor:'event simulation'!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1551
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1552
forwardKeyEventsTo:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1553
    "remove all keyboard events and send them to aViews sensor instead"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1554
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1555
    1 to:mouseAndKeyboard size do:[:i |
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1556
	|anEvent|
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1557
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1558
	anEvent := mouseAndKeyboard at:i.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1559
	anEvent notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1560
	    anEvent isKeyEvent ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1561
		anEvent view:aView.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1562
		aView sensor pushEvent:anEvent.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1563
		mouseAndKeyboard at:i put:nil
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1564
	    ]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1565
	]
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1566
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1567
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1568
    "Modified: 18.1.1997 / 14:05:02 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1569
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1570
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1571
pushUserEvent:aSelector for:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1572
    "manually put an event into the queue - this allows
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1573
     simulation of events (implementation of recorders & playback)
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1574
     or asynchronous communication between view applications.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1575
     The view will perform a method as specified by aSelector,
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1576
     when it performs event processing; this is different than sending
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1577
     this message directly, since the execution is done by the views process,
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1578
     not by the current process (which is especially worthwhile, if that method 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1579
     shows a modal box or similar)."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1580
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1581
     self pushUserEvent:aSelector for:aView withArguments:#() 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1582
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1583
    "Modified: 18.9.1995 / 22:40:12 / claus"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1584
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1585
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1586
pushUserEvent:aSelector for:aView withArguments:arguments
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1587
    "manually put an event into the queue - this allows
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1588
     simulation of events (implementation of recorders & playback)
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1589
     or asynchronous communication between view applications.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1590
     The view will perform a method as specified by aSelector,
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1591
     when it performs event processing; this is different than sending
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1592
     this message directly, since the execution is done by the views process,
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1593
     not by the current process (which is especially worthwhile, if that method 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1594
     shows a modal box or similar)."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1595
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1596
    self pushEvent:(WindowEvent 
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1597
		     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1598
		     type:aSelector
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1599
		     arguments:arguments).
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1600
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1601
    "
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1602
     |b|
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1603
     b := Button label:'test'.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1604
     b open.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1605
     (Delay forSeconds:5) wait.
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1606
     b sensor pushUserEvent:#pointerEnter:x:y: for:b withArguments:#(0 1 1).
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1607
     (Delay forSeconds:1) wait.
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1608
     b sensor pushUserEvent:#buttonPress:x:y: for:b withArguments:#(1 1 1).
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1609
     (Delay forSeconds:2) wait.
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1610
     b sensor pushUserEvent:#buttonRelease:x:y: for:b withArguments:#(1 1 1).
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1611
     (Delay forSeconds:1) wait.
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1612
     b sensor pushUserEvent:#pointerLeave: for:b withArguments:#(0).
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1613
    "
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1614
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1615
    "
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1616
     |b|
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1617
     b := Button label:'test'.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1618
     b open.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1619
     (Delay forSeconds:5) wait.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1620
     b sensor pushUserEvent:#fooBar for:b withArguments:#().
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1621
    "
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1622
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1623
    "
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1624
     |b|
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1625
     b := Button label:'test'.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1626
     b open.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1627
     (Delay forSeconds:3) wait.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1628
     b sensor pushUserEvent:#disable for:b withArguments:#().
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1629
    "
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1630
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1631
    "Modified: 4.1.1997 / 13:53:01 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1632
! !
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1633
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1634
!WindowSensor methodsFor:'initialization'!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1635
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1636
initialize
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1637
    "initialize the event queues to empty"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1638
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1639
    accessLock := Semaphore forMutualExclusion name:'WSensor ev-q accessLock'.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1640
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1641
    damage := OrderedCollection new.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1642
    mouseAndKeyboard := OrderedCollection new.
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1643
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1644
    gotExpose := IdentitySet new.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1645
    catchExpose := IdentitySet new.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1646
    gotOtherEvent := IdentitySet new.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1647
    exposeEventSemaphore := Semaphore new name:'WSensor exposeSema'.
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1648
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1649
    compressMotionEvents := translateKeyboardEvents := true.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1650
    ignoreUserInput := false.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1651
    shiftDown := ctrlDown := altDown := metaDown := false.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1652
    leftButtonDown := middleButtonDown := rightButtonDown := false.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1653
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1654
    "Modified: 18.1.1997 / 15:30:20 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1655
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1656
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1657
reinitialize
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1658
    "called when an image is restarted;
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1659
     reinitialize the event queues to empty; leave other setup as-is"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1660
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1661
    self flushUserEvents.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1662
    self flushExposeEvents.
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1663
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1664
    gotExpose := IdentitySet new.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1665
    catchExpose := IdentitySet new.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1666
    gotOtherEvent := IdentitySet new.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1667
    exposeEventSemaphore := Semaphore new name:'WSensor exposeSema'.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1668
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1669
    shiftDown := ctrlDown := altDown := metaDown := false.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1670
    leftButtonDown := middleButtonDown := rightButtonDown := false.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1671
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1672
    "Modified: 18.1.1997 / 15:30:23 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1673
! !
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1674
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1675
!WindowSensor methodsFor:'queries - event queue'!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1676
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1677
eventPending
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1678
    "return true, if either damage or events are pending"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1679
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1680
    mouseAndKeyboard size ~~ 0 ifTrue:[^ true].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1681
    ^ damage size ~~ 0
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1682
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1683
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1684
hasButtonEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1685
    "return true, if any button events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1686
     If the argument, aView is nil, the information is regarding any
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1687
     view (i.e. is there a button event for any of my views);
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1688
     otherwise, the information is regrding that specific view."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1689
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1690
    (self hasButtonMotionEventFor:aView) ifTrue:[^ true].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1691
    (self hasButtonPressEventFor:aView) ifTrue:[^ true].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1692
    ^ (self hasButtonReleaseEventFor:aView)
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1693
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1694
    "Created: 1.11.1996 / 17:02:23 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1695
    "Modified: 1.11.1996 / 17:12:03 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1696
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1697
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1698
hasButtonMotionEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1699
    "return true, if any buttonMotion events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1700
     If the argument, aView is nil, the information is regarding any
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1701
     view (i.e. is there a motion event for any of my views);
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1702
     otherwise, the information is regrding that specific view."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1703
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1704
    ^ self hasEvent:#buttonMotion:x:y: orPendingDeviceEvent:#buttonMotion for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1705
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1706
    "Created: 1.11.1996 / 17:04:01 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1707
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1708
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1709
hasButtonPressEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1710
    "return true, if any buttonPress events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1711
     If the argument, aView is nil, the information is regarding any
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1712
     view (i.e. is there a buttonPress event for any of my views);
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1713
     otherwise, the information is regrding that specific view."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1714
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1715
    ^ self hasEvent:#buttonPress:x:y: orPendingDeviceEvent:#buttonPress for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1716
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1717
    "Created: 1.11.1996 / 17:05:10 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1718
    "Modified: 1.11.1996 / 17:11:09 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1719
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1720
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1721
hasButtonReleaseEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1722
    "return true, if any buttonRelease events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1723
     If the argument, aView is nil, the information is regarding any
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1724
     view (i.e. is there a buttonrelease event for any of my views);
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1725
     otherwise, the information is regrding that specific view."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1726
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1727
    ^ self hasEvent:#buttonRelease:x:y: orPendingDeviceEvent:#buttonRelease for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1728
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1729
    "Created: 1.11.1996 / 17:05:26 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1730
    "Modified: 1.11.1996 / 17:11:18 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1731
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1732
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1733
hasConfigureEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1734
    "return true, if any resize/position events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1735
     If the argument, aView is nil, the information is regarding any
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1736
     view (i.e. is there a configure event for any of my views);
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1737
     otherwise, the information is regrding that specific view."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1738
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1739
    ^ self hasEvent:#configureX:y:width:height: orPendingDeviceEvent:#structureNotify for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1740
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1741
    "Modified: 1.11.1996 / 17:11:27 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1742
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1743
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1744
hasDamage 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1745
    "return true, if any damage events (i.e. expose or resize) are pending"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1746
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1747
    ^ damage size ~~ 0
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1748
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1749
    "Modified: 21.5.1996 / 17:20:31 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1750
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1751
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1752
hasDamageFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1753
    "return true, if any damage events (i.e. expose or resize)
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1754
     are pending for aView"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1755
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1756
    damage size ~~ 0 ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1757
	damage do:[:aDamage |
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1758
	    aDamage notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1759
		aDamage view == aView ifTrue:[^ true].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1760
	    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1761
	]
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1762
    ].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1763
    ^ false
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1764
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1765
    "Modified: 21.5.1996 / 17:15:09 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1766
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1767
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1768
hasEvent:type for:aView withArguments:args 
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1769
    "return true, if a specific event is pending in my queues.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1770
     Type is the type of event, args are the arguments.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1771
     If the argument, aView is nil, the information is regarding any
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1772
     view (i.e. is there an event for any of my views);
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1773
     otherwise, the information is regarding to that specific view."
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1774
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1775
    mouseAndKeyboard size ~~ 0 ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1776
	mouseAndKeyboard do:[:anEvent |
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1777
	    anEvent notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1778
		(aView isNil or:[anEvent view == aView]) ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1779
		    anEvent type == type ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1780
			(args isNil or:[anEvent arguments = args]) ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1781
			    ^ true
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1782
			].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1783
		    ]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1784
		]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1785
	    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1786
	]
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1787
    ].
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1788
    damage size ~~ 0 ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1789
	damage do:[:anEvent |
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1790
	    anEvent notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1791
		(aView isNil or:[anEvent view == aView]) ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1792
		    anEvent type == type ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1793
			(args isNil or:[anEvent arguments = args]) ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1794
			    ^ true
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1795
			]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1796
		    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1797
		]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1798
	    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1799
	]
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1800
    ].
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1801
    ^ false
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1802
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1803
    "Modified: 1.11.1996 / 17:11:47 / cg"
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1804
    "Created: 4.1.1997 / 14:00:29 / cg"
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1805
!
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  1806
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1807
hasEvent:type orPendingDeviceEvent:dType for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1808
    "return true, if a specific event is pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1809
     Type is the type of event, dType the corresponding device event.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1810
     If the argument, aView is nil, the information is regarding any
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1811
     view (i.e. is there an event for any of my views);
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1812
     otherwise, the information is regarding to that specific view."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1813
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1814
    mouseAndKeyboard size ~~ 0 ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1815
	mouseAndKeyboard do:[:anEvent |
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1816
	    anEvent notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1817
		(aView isNil or:[anEvent view == aView]) ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1818
		    anEvent type == type ifTrue:[^ true].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1819
		]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1820
	    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1821
	]
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1822
    ].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1823
    damage size ~~ 0 ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1824
	damage do:[:anEvent |
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1825
	    anEvent notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1826
		(aView isNil or:[anEvent view == aView]) ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1827
		    anEvent type == type ifTrue:[^ true].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1828
		]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1829
	    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1830
	]
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1831
    ].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1832
    aView notNil ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1833
	^ aView graphicsDevice eventPending:dType for:aView id
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1834
    ].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1835
    ^ false
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1836
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1837
    "Modified: 1.11.1996 / 17:11:47 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1838
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1839
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1840
hasEvents 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1841
    "return true, if any mouse/keyboard events are pending"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1842
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1843
    ^ mouseAndKeyboard size ~~ 0
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1844
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1845
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1846
hasExposeEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1847
    "return true, if any exposure events are pending for aView"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1848
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1849
    damage size ~~ 0 ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1850
	damage do:[:aDamage |
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1851
	    aDamage notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1852
		aDamage isDamage ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1853
		    (aView isNil
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1854
		     or:[aDamage view == aView]) ifTrue:[^ true].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1855
		]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1856
	    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1857
	]
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1858
    ].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1859
    ^ false
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1860
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1861
    "Modified: 21.5.1996 / 17:13:09 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1862
    "Created: 1.11.1996 / 17:05:41 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1863
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1864
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1865
hasKeyEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1866
    "return true, if any key (press or release) events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1867
     If the argument, aView is nil, the information is regarding any
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1868
     view (i.e. is there a key event for any of my views);
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1869
     otherwise, the information is regrding that specific view."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1870
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1871
    (self hasKeyPressEventFor:aView) ifTrue:[^ true].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1872
    ^ self hasKeyReleaseEventFor:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1873
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1874
    "Created: 1.11.1996 / 17:08:03 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1875
    "Modified: 1.11.1996 / 17:11:55 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1876
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1877
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1878
hasKeyPressEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1879
    "return true, if any keyPress events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1880
     If the argument, aView is nil, the information is regarding any
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1881
     view (i.e. is there a keyPress event for any of my views);
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1882
     otherwise, the information is regrding that specific view."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1883
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1884
    ^ self hasEvent:#keyPress:x:y: orPendingDeviceEvent:#keyPress for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1885
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1886
    "Created: 1.11.1996 / 17:05:58 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1887
    "Modified: 1.11.1996 / 17:12:10 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1888
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1889
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1890
hasKeyReleaseEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1891
    "return true, if any keyRelease events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1892
     If the argument, aView is nil, the information is regarding any
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1893
     view (i.e. is there a keyRelease event for any of my views);
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1894
     otherwise, the information is regrding that specific view."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1895
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1896
    ^ self hasEvent:#keyRelease:x:y: orPendingDeviceEvent:#keyRelease for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1897
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1898
    "Created: 1.11.1996 / 17:06:34 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1899
    "Modified: 1.11.1996 / 17:12:15 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1900
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1901
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1902
hasUserEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1903
    "return true, if any user event (i.e. key or button events) are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1904
     If the argument, aView is nil, the information is regarding any
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1905
     view (i.e. is there a user event for any of my views);
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1906
     otherwise, the information is regrding that specific view."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1907
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1908
    (self hasKeyEventFor:aView) ifTrue:[^ true].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1909
    ^ (self hasButtonEventFor:aView)
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1910
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1911
    "Created: 1.11.1996 / 17:08:50 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1912
    "Modified: 1.11.1996 / 17:12:21 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1913
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1914
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1915
motionEventPending 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1916
    "return true, if any buttonMotion events are pending."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1917
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1918
    ^ self hasButtonMotionEventFor:nil
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1919
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1920
    "Created: 24.3.1996 / 20:09:55 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1921
    "Modified: 1.11.1996 / 17:04:43 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1922
! !
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1923
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1924
!WindowSensor methodsFor:'queries - key & button state'!
140
claus
parents: 133
diff changeset
  1925
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1926
altDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1927
    "return true, if the meta key is currently pressed.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1928
     Notice, that some keyboards dont have an alt key;
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1929
     it is better to use 'sensor metaDown or:[sensor altDown]'."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1930
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1931
    ^ altDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1932
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1933
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1934
anyButtonPressed
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1935
    "ST-80 compatibility: return true, if any mouse button is pressed.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1936
     You should no use it in 'normal' applications.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1937
     Instead, keep track of the buttons state in your views or controllers
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1938
     button-event methods."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1939
1083
6e947cc67324 fixed #anyButtonPressed & setting of buttonDown-flags
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1940
    ^ leftButtonDown or:[middleButtonDown or:[rightButtonDown]]
6e947cc67324 fixed #anyButtonPressed & setting of buttonDown-flags
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1941
6e947cc67324 fixed #anyButtonPressed & setting of buttonDown-flags
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1942
    "Modified: 21.10.1996 / 11:37:31 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1943
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1944
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1945
blueButtonPressed
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1946
    "ST-80 compatibility: return true, if the right mouse button is pressed.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1947
     You should no use it in 'normal' applications.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1948
     Instead, keep track of the buttons state in your views or controllers
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1949
     button-event methods."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1950
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1951
    ^ rightButtonDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1952
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1953
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1954
ctrlDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1955
    "return true, if any CTRL key is currently pressed."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1956
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1957
    ^ ctrlDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1958
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1959
157
claus
parents: 154
diff changeset
  1960
leftButtonPressed
claus
parents: 154
diff changeset
  1961
    "return true, if the left mouse button is pressed.
claus
parents: 154
diff changeset
  1962
     This has been added to support ST-80 style button polling;
claus
parents: 154
diff changeset
  1963
     however, you should no use it in 'normal' applications.
claus
parents: 154
diff changeset
  1964
     Instead, keep track of the buttons state in your views or controllers
claus
parents: 154
diff changeset
  1965
     button-event methods."
claus
parents: 154
diff changeset
  1966
claus
parents: 154
diff changeset
  1967
    ^ leftButtonDown
claus
parents: 154
diff changeset
  1968
!
claus
parents: 154
diff changeset
  1969
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1970
metaDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1971
    "return true, if the meta key is currently pressed.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1972
     Notice, that most keyboards dont have a meta key;
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1973
     it is better to use 'sensor metaDown or:[sensor altDown]'."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1974
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1975
    ^ metaDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1976
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1977
157
claus
parents: 154
diff changeset
  1978
middleButtonPressed
claus
parents: 154
diff changeset
  1979
    "return true, if the middle mouse button is pressed.
claus
parents: 154
diff changeset
  1980
     This has been added to support ST-80 style button polling;
claus
parents: 154
diff changeset
  1981
     however, you should no use it in 'normal' applications.
claus
parents: 154
diff changeset
  1982
     Instead, keep track of the buttons state in your views or controllers
claus
parents: 154
diff changeset
  1983
     button-event methods."
claus
parents: 154
diff changeset
  1984
claus
parents: 154
diff changeset
  1985
    ^ middleButtonDown
claus
parents: 154
diff changeset
  1986
!
claus
parents: 154
diff changeset
  1987
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1988
redButtonPressed
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1989
    "ST-80 compatibility: return true, if the left mouse button is pressed.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1990
     You should no use it in 'normal' applications.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1991
     Instead, keep track of the buttons state in your views or controllers
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1992
     button-event methods."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1993
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1994
    ^ leftButtonDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1995
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1996
157
claus
parents: 154
diff changeset
  1997
rightButtonPressed
claus
parents: 154
diff changeset
  1998
    "return true, if the right mouse button is pressed.
claus
parents: 154
diff changeset
  1999
     This has been added to support ST-80 style button polling;
claus
parents: 154
diff changeset
  2000
     however, you should no use it in 'normal' applications.
claus
parents: 154
diff changeset
  2001
     Instead, keep track of the buttons state in your views or controllers
claus
parents: 154
diff changeset
  2002
     button-event methods."
claus
parents: 154
diff changeset
  2003
claus
parents: 154
diff changeset
  2004
    ^ rightButtonDown
claus
parents: 154
diff changeset
  2005
!
claus
parents: 154
diff changeset
  2006
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2007
shiftDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2008
    "return true, if any shift key is currently pressed."
157
claus
parents: 154
diff changeset
  2009
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2010
    ^ shiftDown
157
claus
parents: 154
diff changeset
  2011
!
claus
parents: 154
diff changeset
  2012
claus
parents: 154
diff changeset
  2013
yellowButtonPressed
claus
parents: 154
diff changeset
  2014
    "ST-80 compatibility: return true, if the middle mouse button is pressed.
claus
parents: 154
diff changeset
  2015
     You should no use it in 'normal' applications.
claus
parents: 154
diff changeset
  2016
     Instead, keep track of the buttons state in your views or controllers
claus
parents: 154
diff changeset
  2017
     button-event methods."
claus
parents: 154
diff changeset
  2018
claus
parents: 154
diff changeset
  2019
    ^ middleButtonDown
140
claus
parents: 133
diff changeset
  2020
! !
claus
parents: 133
diff changeset
  2021
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2022
!WindowSensor methodsFor:'queries - pointer'!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2023
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2024
cursorPoint
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2025
    "ST-80 compatibility: 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2026
     return the position of the mouse pointer on the current display
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2027
     (in screen coordinates)"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2028
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2029
     ^ self class cursorPoint
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2030
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2031
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2032
globalOrigin 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2033
    "ST-80 compatibility: 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2034
     dont know what we should return here ...
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2035
     ... at least the PD program which uses it works when we return 0@0."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2036
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2037
     ^ 0@0
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2038
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2039
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2040
mousePoint
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2041
    "ST-80 compatibility: 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2042
     return the position of the mouse pointer on the current display
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2043
     (in screen coordinates)"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2044
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2045
     ^ self cursorPoint
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2046
! !
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2047
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
  2048
!WindowSensor methodsFor:'special'!
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
  2049
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2050
catchExposeFor:aView
54
29a6b2f8e042 *** empty log message ***
claus
parents: 47
diff changeset
  2051
    "start catching noExpose events (must be done BEFORE a bitblt,
29a6b2f8e042 *** empty log message ***
claus
parents: 47
diff changeset
  2052
     to prepare for the exposeEventSemaphore to be signalled when 
29a6b2f8e042 *** empty log message ***
claus
parents: 47
diff changeset
  2053
     the noExpose event arrives)."
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
  2054
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2055
    "/ this is only needed for X ...
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2056
    aView device scrollsAsynchronous ifFalse:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2057
	^ self
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2058
    ].
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2059
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2060
    (catchExpose includes:aView) ifTrue:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2061
        ('WSensor [warning]: already catching (for ' , aView printString , ')') errorPrintCR.
1274
778fdd997e45 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1271
diff changeset
  2062
        Delay waitForMilliseconds:100.
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2063
        (catchExpose includes:aView) ifTrue:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2064
            ('WSensor [warning]: still catching (for ' , aView printString , ')') errorPrintCR.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2065
	    "/ wake the other one
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2066
	    gotExpose add:aView.
1274
778fdd997e45 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1271
diff changeset
  2067
            exposeEventSemaphore signalForAll.
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2068
	    Delay waitForMilliseconds:100.
1274
778fdd997e45 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1271
diff changeset
  2069
        ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2070
    ].
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2071
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2072
    [
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2073
        gotOtherEvent remove:aView ifAbsent:nil.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2074
        gotExpose remove:aView ifAbsent:nil.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2075
        catchExpose add:aView.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2076
    ] valueUninterruptably.
28
3879ff2138f1 *** empty log message ***
claus
parents: 27
diff changeset
  2077
!
3879ff2138f1 *** empty log message ***
claus
parents: 27
diff changeset
  2078
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2079
waitButton
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2080
    "ST-80 compatibility: wait until any mouse button is pressed.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2081
     Do not use this in your applications; polling the sensor is
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2082
     bad style."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2083
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2084
    [self anyButtonPressed] whileFalse:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2085
	"/ should add a buttonStateChangeSemaphore and wait on this ...
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2086
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2087
	Delay waitForSeconds:0.01.
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2088
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2089
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2090
    "Modified: 18.1.1997 / 14:21:59 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2091
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2092
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
  2093
waitForExposeFor:aView
157
claus
parents: 154
diff changeset
  2094
    "wait until a graphicsExpose or a noExpose arrives (after a bitblt).
claus
parents: 154
diff changeset
  2095
     This may be too X-specific, and things may change in this area
claus
parents: 154
diff changeset
  2096
     in future versions. (or the new device may simulate the arrival of
claus
parents: 154
diff changeset
  2097
     such an event)"
54
29a6b2f8e042 *** empty log message ***
claus
parents: 47
diff changeset
  2098
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2099
    "/ this is only needed for X ...
1027
0ba82862ca8d fixes for synchronous scrolling (WINDOWS)
Claus Gittinger <cg@exept.de>
parents: 1013
diff changeset
  2100
    aView device scrollsAsynchronous ifFalse:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2101
	^ self
1027
0ba82862ca8d fixes for synchronous scrolling (WINDOWS)
Claus Gittinger <cg@exept.de>
parents: 1013
diff changeset
  2102
    ].
0ba82862ca8d fixes for synchronous scrolling (WINDOWS)
Claus Gittinger <cg@exept.de>
parents: 1013
diff changeset
  2103
1013
32d804ff472d cleanup when unwinding from a waitForExpose
Claus Gittinger <cg@exept.de>
parents: 1012
diff changeset
  2104
    [
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2105
	aView flush.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2106
	Processor activeProcessIsSystemProcess ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2107
	    "
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2108
	     cannot really suspend, if its a systemProcess
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2109
	    "
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2110
	    [gotExpose] whileFalse:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2111
		aView graphicsDevice dispatchExposeEventFor:aView id.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2112
		Processor yield.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2113
	    ]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2114
	] ifFalse:[
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2115
	    [ (gotExpose includes:aView) ] whileFalse:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2116
		"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2117
		 just in case we have a (network or software) problem ...
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2118
		 explanation: it may happen, that an expose event is totally
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2119
		 lost - for example, if the network breaks down.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2120
		 To not block forever, we wait with a timeout, to get out of here
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2121
		 if the event does not arrive after 15 seconds.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2122
		"
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2123
		(exposeEventSemaphore waitWithTimeout:5) isNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2124
		    aView graphicsDevice flush.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2125
		    "
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2126
		     you can put a comment around the following line, if you dont
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2127
		     like the message ...
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2128
		    "
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2129
		    ('WindowSensor [info]: late expose event (' , aView printString , ')') infoPrintCR.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2130
		    (exposeEventSemaphore waitWithTimeout:10) isNil ifFalse:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2131
			'WindowSensor [warning]: lost expose event again - ignore' errorPrintCR.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2132
		    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2133
		    "
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2134
		     ok, break out
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2135
		    "
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2136
		    ^ self
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2137
		]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2138
	    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2139
	].
1013
32d804ff472d cleanup when unwinding from a waitForExpose
Claus Gittinger <cg@exept.de>
parents: 1012
diff changeset
  2140
    ] valueNowOrOnUnwindDo:[
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2141
	gotExpose remove:aView ifAbsent:nil.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2142
	catchExpose remove:aView ifAbsent:nil.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2143
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2144
	"/
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2145
	"/ other incoming events have been ignored during the wait.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2146
	"/ Now handle those ...
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2147
	"/
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2148
	(gotOtherEvent includes:aView) ifTrue:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2149
	    gotOtherEvent remove:aView ifAbsent:nil.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2150
	].
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2151
	eventSemaphore signalOnce
1013
32d804ff472d cleanup when unwinding from a waitForExpose
Claus Gittinger <cg@exept.de>
parents: 1012
diff changeset
  2152
    ].
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
  2153
1268
612204a36c38 no, regular expose events should not trigger the exposeSema
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
  2154
    "Modified: 23.1.1997 / 22:29:16 / cg"
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
  2155
!
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
  2156
157
claus
parents: 154
diff changeset
  2157
waitNoButton
claus
parents: 154
diff changeset
  2158
    "ST-80 compatibility: wait until no mouse button is pressed.
claus
parents: 154
diff changeset
  2159
     Do not use this in your applications; polling the sensor is
claus
parents: 154
diff changeset
  2160
     bad style."
claus
parents: 154
diff changeset
  2161
claus
parents: 154
diff changeset
  2162
    [self anyButtonPressed] whileTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2163
	"/ should add a buttonStateChangeSemaphore and wait on this ...
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2164
	Delay waitForSeconds:0.01.
157
claus
parents: 154
diff changeset
  2165
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2166
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2167
    "Modified: 18.1.1997 / 14:21:56 / cg"
157
claus
parents: 154
diff changeset
  2168
! !
claus
parents: 154
diff changeset
  2169
1082
44d671491f5e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1063
diff changeset
  2170
!WindowSensor class methodsFor:'documentation'!
251
915de9a65169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 244
diff changeset
  2171
915de9a65169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 244
diff changeset
  2172
version
1318
5810dfc3137a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1317
diff changeset
  2173
    ^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.86 1997-02-08 19:34:37 cg Exp $'
251
915de9a65169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 244
diff changeset
  2174
! !
140
claus
parents: 133
diff changeset
  2175
WindowSensor initialize!