WSensor.st
author Claus Gittinger <cg@exept.de>
Mon, 08 Feb 1999 15:24:17 +0100
changeset 2441 6925d83b717e
parent 2439 358644786358
child 2469 faf22c6b0746
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
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
    18
		eventListener keyboardListener ignoreExposeEvents
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
    19
		damageEventAccessLock userEventAccessLock'
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
    20
	classVariableNames:'ControlCEnabled ControlYEnabled EventListener ComposeTable
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
    21
		GotCompose Compose1'
326
f04810e0425a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 322
diff changeset
    22
	poolDictionaries:''
f04810e0425a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 322
diff changeset
    23
	category:'Interface-Support'
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    24
!
48194c26a46c Initial revision
claus
parents:
diff changeset
    25
1082
44d671491f5e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1063
diff changeset
    26
!WindowSensor class methodsFor:'documentation'!
46
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    27
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    28
copyright
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    29
"
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    30
 COPYRIGHT (c) 1993 by Claus Gittinger
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
    31
	      All Rights Reserved
46
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    32
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    33
 This software is furnished under a license and may be used
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    34
 only in accordance with the terms of that license and with the
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    35
 inclusion of the above copyright notice.   This software may not
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    36
 be provided or otherwise made available to, or used by, any
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    37
 other person.  No title to or ownership of the software is
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    38
 hereby transferred.
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    39
"
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    40
!
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    41
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    42
documentation
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
    43
"
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
    44
    Instances of this class keep track of events and damage areas for a group of 
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
    45
    views. All incoming expose rectangles and events (from Workstation) are 
144
claus
parents: 140
diff changeset
    46
    collected here, until someone (usually the windowGroup process)
claus
parents: 140
diff changeset
    47
    gets a chance to handle them. 
claus
parents: 140
diff changeset
    48
    In contrast to ST-80 (which has one windowSensor per window), ST/X usually
claus
parents: 140
diff changeset
    49
    only assigns one sensor per windowGroup.
157
claus
parents: 154
diff changeset
    50
    (however, you could manually arrange for per view private sensors
claus
parents: 154
diff changeset
    51
     - at least, theoretically)
144
claus
parents: 140
diff changeset
    52
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
    53
    When adding an expose rectangle, WindowSensor tries to merge the rectangle 
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
    54
    with the list of existing damages to minimize redrawing.
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
    55
158
claus
parents: 157
diff changeset
    56
    Processing of compose key sequences is done here; if a Compose
claus
parents: 157
diff changeset
    57
    key event arrives, the following 2 characters are used to search an
claus
parents: 157
diff changeset
    58
    entry in the composeTable, and are replaced by the character found there.
claus
parents: 157
diff changeset
    59
    For example, pressing Compose-a-` gives the french a-accent-grave character;
claus
parents: 157
diff changeset
    60
    pressing Compose-a-e gives the ae ligature.
claus
parents: 157
diff changeset
    61
144
claus
parents: 140
diff changeset
    62
    Beside the above, windowSensors provide facilities (hooks) to allow
157
claus
parents: 154
diff changeset
    63
    a so-called 'eventListener' to get the event before it is entered into
144
claus
parents: 140
diff changeset
    64
    the queue. There are 3 possible listening hooks available:
claus
parents: 140
diff changeset
    65
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
    66
        a global EventListener - gets keybd/mouse events for all views
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
    67
        a per-sensor eventListener - gets only keybd/mouse events for this sensors wGroup
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
    68
        a per-sensor keyboardListener - only gets keyboard events for this sensors wGroup
144
claus
parents: 140
diff changeset
    69
172
claus
parents: 158
diff changeset
    70
    (actually, there are two more mechanisms, event delegation which allows
claus
parents: 158
diff changeset
    71
     delegation of key- and buttonEvents of a specific view,
claus
parents: 158
diff changeset
    72
     and per-windowGroup eventHooks)
144
claus
parents: 140
diff changeset
    73
claus
parents: 140
diff changeset
    74
    The global eventListener is installed via a class method (eventListener:) to
claus
parents: 140
diff changeset
    75
    the WindowSensor class; local listeners are installed via instance methods.
claus
parents: 140
diff changeset
    76
    Each listener should return true, if it handled the event and that event should
claus
parents: 140
diff changeset
    77
    therefore NOT be enqueued. Likewise, if it returns false, the event is
157
claus
parents: 154
diff changeset
    78
    processed as usual (i.e. enqueued and forwarded to the views controller).
claus
parents: 154
diff changeset
    79
144
claus
parents: 140
diff changeset
    80
    The global listener is called before the local listener, which is called
claus
parents: 140
diff changeset
    81
    before the keyboard listener. If any returns true, later listeners wont get
claus
parents: 140
diff changeset
    82
    the event.
claus
parents: 140
diff changeset
    83
    EventListeners were added to allow the implementation of event recorders
157
claus
parents: 154
diff changeset
    84
    or other spy functionality. They also allow hooking up views which otherwise
claus
parents: 154
diff changeset
    85
    insist on doing things themself.
144
claus
parents: 140
diff changeset
    86
claus
parents: 140
diff changeset
    87
    Notice, that beside event listening, you can also define a delegate for
claus
parents: 140
diff changeset
    88
    a views keyboard and button events. 
claus
parents: 140
diff changeset
    89
    Read the documentation in WindowEvent for more info.
claus
parents: 140
diff changeset
    90
claus
parents: 140
diff changeset
    91
598
1a2339e902d4 commentary
Claus Gittinger <cg@exept.de>
parents: 581
diff changeset
    92
    [instance variables:]
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
    93
        eventSemaphore          <Semaphore>     the semaphore to be signalled when an event
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
    94
                                                (or damage) arrives
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
    95
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
    96
        damage                  <Collection>    collection of damage events
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
    97
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
    98
        mouseAndKeyboard        <Collection>    collection of user events
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
    99
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   100
        compressMotionEvents    <Boolean>       if true, multiple motion events are
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   101
                                                compressed to one event. If false, each
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   102
                                                event is handled individual.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   103
                                                (should be set to false when doing free-hand drawing)
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   104
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   105
        ignoreUserInput         <Boolean>       if true, key & button events are ignored
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   106
                                                (usually set to true by WindowGroup, while a
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   107
                                                 modalbox covers a view)
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   108
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   109
        shiftDown               <Boolean>       true while shift/meta/control-key is pressed
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   110
        metaDown                                (to support ST-80 style query: sensor shiftDown)
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   111
        ctrlDown
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   112
        altDown                                 (notice, that on most systems, alt and meta key is
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   113
                                                 the same, both reported as #Alt)
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   114
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   115
        exposeEventSemaphore    <Semaphore>     X-special: semaphore to be signalled when
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   116
                                                expose event arrives after a copyArea.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   117
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   118
        catchExpose             <SetOfView>     if nonEMpty, the drawables which wait for
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   119
                                                an expose/noExpose event.  (after a copyArea)
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   120
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   121
        gotExpose               <SetOfView>     the set of drawables which got an expose/noExpose
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   122
                                                event.  (after a copyarea)
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   124
        gotOtherEvent           <SetOfView>     set of drawables which received if other events,
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   125
                                                while waiting for expose (after a copyarea).
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   126
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   127
        translateKeyboardEvents <Boolean>       if true, keyboard events are translated via
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   128
                                                the devices leyboardMap; if false, they
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   129
                                                are reported as raw-keys. Default is true.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   130
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   131
        eventListener           <Object>        if non nil, this one will get all pointer
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   132
                                                and keyboard events for this sensors views first.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   133
                                                If it returns true, the event is supposed to
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   134
                                                be already handled by the listener and not sent to
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   135
                                                the view. If false, the event is handled as usual.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   136
                                                This allows applications to catch events for any of
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   137
                                                its views.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   138
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   139
        keyboardListener        <Object>        if non nil, this one will get all keyboard events 
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   140
                                                for this sensors views first (but after the eventListener,
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   141
                                                if any).
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   142
                                                If it returns true, the event is supposed to
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   143
                                                be already handled by the listener and not sent to
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   144
                                                the view. If false, the event is handled as usual.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   145
                                                This allows applications to catch events for any of
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   146
                                                its views.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   147
                                                ApplicationModels can catch keyboard input with:
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   148
                                                    postOpenWith:aBuilder
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   149
                                                        aBuilder window sensor keyboardListener:self
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   150
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   151
        accessLock              <Semaphore>     controls access to the event queues
140
claus
parents: 133
diff changeset
   152
598
1a2339e902d4 commentary
Claus Gittinger <cg@exept.de>
parents: 581
diff changeset
   153
    [class variables:]
140
claus
parents: 133
diff changeset
   154
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   155
        ControlCEnabled         <Boolean>       if true (which is the default) Control-C
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   156
                                                will interrupt the process handling the
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   157
                                                view.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   158
                                                For secure stand-alone applications,
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   159
                                                this can be set to false, in which case 
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   160
                                                Control-C does NOT interrupt the process.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   161
                                                (actually, Control-C is wrong here; the actual
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   162
                                                 key is #UserInterrupt, which may be mapped onto
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   163
                                                 any key)
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   164
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   165
        ControlYEnabled         <Boolean>       if true (which is the default) Control-Y
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   166
                                                will raise the abortSignal in the process 
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   167
                                                handling the view.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   168
                                                This can be used to abort a long operation
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   169
                                                (such as a long fileRead in the fileBrowser)
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   170
                                                without entering the debugger.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   171
                                                (actually, Control-Y is wrong here; the actual
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   172
                                                 key is #UserAbort, which may be mapped onto
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   173
                                                 any key)
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   174
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   175
        EventListener           <Object>        if non nil, this one will get all pointer
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   176
                                                and keyboard events for ALL views first.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   177
                                                If it returns true, the event is supposed to
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   178
                                                be already handled by the listener and not enqueued. 
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   179
                                                If false, the event is handled as usual.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   180
                                                This allows overall event catchers to be
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   181
                                                installed for example to implement event
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   182
                                                recorders, active help managers etc.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   183
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   184
        ComposeTable            <Array>         compose-key translation table
598
1a2339e902d4 commentary
Claus Gittinger <cg@exept.de>
parents: 581
diff changeset
   185
1a2339e902d4 commentary
Claus Gittinger <cg@exept.de>
parents: 581
diff changeset
   186
612
8758d0c9933e documentation
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   187
    [author:]
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   188
        Claus Gittinger
612
8758d0c9933e documentation
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   189
598
1a2339e902d4 commentary
Claus Gittinger <cg@exept.de>
parents: 581
diff changeset
   190
    [see also:]
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   191
        WindowGroup 
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   192
        WindowEvent KeyboardMap KeyboardForwarder EventListener
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   193
        DeviceWorkstation View
46
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
   194
"
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
   195
! !
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
   196
1082
44d671491f5e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1063
diff changeset
   197
!WindowSensor class methodsFor:'initialization'!
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   198
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   199
initialize
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   200
    "initialize the classes constants"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   201
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   202
    ControlCEnabled := true.
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   203
    ControlYEnabled := true.
158
claus
parents: 157
diff changeset
   204
386
f9a80cac659e only init once
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   205
    ComposeTable isNil ifTrue:[
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   206
        self initializeComposeKeyTable
386
f9a80cac659e only init once
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   207
    ]
157
claus
parents: 154
diff changeset
   208
claus
parents: 154
diff changeset
   209
    "
claus
parents: 154
diff changeset
   210
     WindowSensor initialize
claus
parents: 154
diff changeset
   211
    "
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   212
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
   213
    "Modified: / 20.5.1998 / 14:01:52 / cg"
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   214
!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   215
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   216
initializeComposeKeyTable
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   217
    "setup the composeKey table"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   218
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   219
    ComposeTable := #(
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   220
	"/ format is:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   221
	"/ ( key1 key2 <character or asciiValue> )
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   222
	"/
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   223
	($+ $+ $#)         "/ number-sign
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   224
	($A $A $@)         "/ at-sign
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   225
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   226
	($( $- ${)         "/ left brace
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   227
	($) $- $})         "/ right brace
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   228
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   229
	($| $c 16rA2)      "/ cent-sign 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   230
	($| $S $$)         "/ dollar-sign
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   231
	($= $L 16rA3)      "/ pound-sign     
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   232
	($= $Y 16rA5)      "/ yen-sign        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   233
	($!! $s 16rA7)      "/ section-sign    
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   234
	($O $C 16rA9)      "/ copyright        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   235
	($< $< 16rAB)      "/ french <<-quotes 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   236
	($O $R 16rAE)      "/ registered       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   237
	($/ $u 16rB5)      "/ greek mu         
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   238
	($!! $p 16rB6)      "/ paragraph sign   
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   239
	($> $> 16rBB)      "/ french >> quotes 
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   240
	($^ $0 16rB0)      "/ degree sign      
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   241
	($+ $- 16rB1)      "/ plus-minus       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   242
	($^ $2 16rB2)      "/ superscript-2    
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   243
	($^ $3 16rB3)      "/ superscript-3    
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   244
	($^ $. 16rB7)      "/ middle dot       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   245
	($^ $1 16rB9)      "/ superscript-1    
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   246
	($1 $4 16rBC)      "/ 1/4              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   247
	($1 $2 16rBD)      "/ 1/2              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   248
	($3 $4 16rBE)      "/ 3/4              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   249
	($? $? 16rBF)      "/ ?-inverted       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   250
	($- $: 16rF7)      "/ divide           
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   251
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   252
	"/ diacriticals: Compose diacrit character
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   253
	"/ grave
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   254
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   255
	($A $` 16rC0)      "/ A-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   256
	($a $` 16rE0)      "/ a-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   257
	($E $` 16rC8)      "/ E-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   258
	($e $` 16rE8)      "/ e-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   259
	($I $` 16rCC)      "/ I-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   260
	($i $` 16rEC)      "/ i-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   261
	($O $` 16rD2)      "/ O-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   262
	($o $` 16rF2)      "/ o-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   263
	($U $` 16rD9)      "/ U-`              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   264
	($u $` 16rF9)      "/ u-`              
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   265
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   266
	"/ acute
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   267
	($A $' 16rC1)      "/ A-'             
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   268
	($a $' 16rE1)      "/ a-'             
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   269
	($E $' 16rC9)      "/ E-'            
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   270
	($e $' 16rE9)      "/ e-'           
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   271
	($I $' 16rCD)      "/ I-'          
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   272
	($i $' 16rED)      "/ i-'         
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   273
	($O $' 16rD3)      "/ O-'        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   274
	($o $' 16rF3)      "/ o-'       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   275
	($U $' 16rDA)      "/ U-'      
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   276
	($u $' 16rFA)      "/ u-'     
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   277
	($Y $' 16rDD)      "/ Y-'    
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   278
	($y $' 16rFD)      "/ y-'   
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   279
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   280
	"/ circumflex
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   281
	($A $^ 16rC2)      "/ A-^              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   282
	($a $^ 16rE2)      "/ a-^             
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   283
	($E $^ 16rCA)      "/ E-^            
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   284
	($e $^ 16rEA)      "/ e-^           
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   285
	($I $^ 16rCE)      "/ I-^          
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   286
	($i $^ 16rEE)      "/ i-^         
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   287
	($O $^ 16rD4)      "/ O-^        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   288
	($o $^ 16rF4)      "/ o-^       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   289
	($U $^ 16rDB)      "/ U-^      
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   290
	($u $^ 16rFB)      "/ u-^     
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
	"/ tilde
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   293
	($A $~ 16rC3)      "/ A-~              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   294
	($a $~ 16rE3)      "/ a-~             
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   295
	($O $~ 16rD5)      "/ O-~            
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   296
	($o $~ 16rF5)      "/ o-~           
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   297
	($N $~ 16rD1)      "/ N-tilde      
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   298
	($n $~ 16rF1)      "/ n-~         
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   299
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   300
	"/ ring above
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   301
	($a $* 16rE5)      "/ a-*              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   302
	($A $* 16rC5)      "/ A-*             
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   303
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   304
	"/ cedille
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   305
	($C $, 16rC7)      "/ C-,              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   306
	($c $, 16rE7)      "/ c-,             
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   307
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   308
	"/ dieresis
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   309
	($A $" 16rC4)      "/ A-"              
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   310
	($a $" 16rE4)      "/ a-"             
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   311
	($E $" 16rCB)      "/ E-"            
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   312
	($e $" 16rEB)      "/ e-"           
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   313
	($I $" 16rCF)      "/ I-"          
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   314
	($i $" 16rEF)      "/ i-"         
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   315
	($O $" 16rD6)      "/ O-"        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   316
	($o $" 16rF6)      "/ o-"       
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   317
	($U $" 16rDC)      "/ U-"      
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   318
	($u $" 16rFC)      "/ u-"     
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   319
	($y $" 16rFF)      "/ y-"    
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   320
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   321
	"/ slashed
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   322
	($o $/ 16rF8)      "/ o-/        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   323
	($O $/ 16rD8)      "/ O-/    
608
3370e1f983d4 o-slash compose sequence
Claus Gittinger <cg@exept.de>
parents: 598
diff changeset
   324
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   325
	"/ ligatures
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   326
	($s $s 16rDF)      "/ german sz        
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   327
	($a $e 16rE6)      "/ (french) ae     
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   328
	($A $E 16rC6)      "/ (french) AE    
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
608
3370e1f983d4 o-slash compose sequence
Claus Gittinger <cg@exept.de>
parents: 598
diff changeset
   331
    "              
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   332
     WindowSensor initializeComposeKeyTable
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   333
    "
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   334
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   335
    "Created: 22.4.1996 / 14:06:43 / cg"
608
3370e1f983d4 o-slash compose sequence
Claus Gittinger <cg@exept.de>
parents: 598
diff changeset
   336
    "Modified: 24.4.1996 / 16:37:08 / cg"
140
claus
parents: 133
diff changeset
   337
! !
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   338
1082
44d671491f5e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1063
diff changeset
   339
!WindowSensor class methodsFor:'instance creation'!
140
claus
parents: 133
diff changeset
   340
claus
parents: 133
diff changeset
   341
new
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   342
    "return a new initialized instance"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   343
140
claus
parents: 133
diff changeset
   344
    ^ self basicNew initialize
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   345
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
   346
    "Modified: 22.4.1996 / 16:19:40 / cg"
124
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   347
! !
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   348
1082
44d671491f5e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1063
diff changeset
   349
!WindowSensor class methodsFor:'accessing'!
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   350
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   351
composeTable
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   352
    "return the compose-key table.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   353
     Entries consist of 3-element arrays each, where
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   354
     the first two entries (of each entry) are the raw characters,
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   355
     and the third is the resulting composed-key"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   356
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   357
    ^ ComposeTable
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   358
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   359
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   360
composeTable:aTable
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   361
    "set the compose-key table.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   362
     Entries consist of 3-element arrays each, where
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   363
     the first two entries (of each entry) are the raw characters,
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   364
     and the third is the resulting composed-key"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   365
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   366
    ComposeTable := aTable
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   367
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   368
144
claus
parents: 140
diff changeset
   369
controlCEnabled:aBoolean
claus
parents: 140
diff changeset
   370
    "enable/disable Control-C processing. 
claus
parents: 140
diff changeset
   371
     If enabled, pressing CNTL-C in a view will interrupt it and bring
1940
83012f66306a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1873
diff changeset
   372
     its process into the debugger (actually raising a UserInterrupt signal).
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   373
     Otherwise, CNTL-C is sent to the view like any other key.
144
claus
parents: 140
diff changeset
   374
     The default is true (enabled).
1940
83012f66306a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1873
diff changeset
   375
     Be very careful - only disable CNTL-C handling for well-debugged
83012f66306a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1873
diff changeset
   376
     applications ... however, even if disabled, there still is the CNTL-C
83012f66306a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1873
diff changeset
   377
     key on the startup (x)-terminal window (which can also be disabled).
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   378
    "
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   379
144
claus
parents: 140
diff changeset
   380
    ControlCEnabled := aBoolean
1940
83012f66306a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1873
diff changeset
   381
83012f66306a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1873
diff changeset
   382
    "Modified: / 29.10.1997 / 15:48:29 / cg"
124
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   383
!
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   384
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   385
eventListener
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   386
    "return the eventListener 
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   387
     - see documentation for what this can be used for"
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   388
f5b3dd3d38db *** empty log message ***
claus
parents: 118
diff changeset
   389
    ^ EventListener
157
claus
parents: 154
diff changeset
   390
!
claus
parents: 154
diff changeset
   391
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   392
eventListener:aListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   393
    "set the eventListener 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   394
     - see documentation for what this can be used for"
157
claus
parents: 154
diff changeset
   395
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   396
    EventListener := aListener
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   397
! !
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
   398
1082
44d671491f5e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1063
diff changeset
   399
!WindowSensor class methodsFor:'queries'!
133
claus
parents: 124
diff changeset
   400
claus
parents: 124
diff changeset
   401
cursorPoint
140
claus
parents: 133
diff changeset
   402
    "ST-80 compatibility: 
157
claus
parents: 154
diff changeset
   403
     return the position of the cursor on the current display"
133
claus
parents: 124
diff changeset
   404
153
claus
parents: 152
diff changeset
   405
    ^ Screen current pointerPosition
133
claus
parents: 124
diff changeset
   406
claus
parents: 124
diff changeset
   407
    "
claus
parents: 124
diff changeset
   408
     WindowSensor cursorPoint
claus
parents: 124
diff changeset
   409
    "
claus
parents: 124
diff changeset
   410
! !
claus
parents: 124
diff changeset
   411
1412
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   412
!WindowSensor methodsFor:'ST-80 compatibility'!
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   413
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   414
eventQuit:event
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   415
    "ST-80 compatibility:
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   416
     push an event for terminating the topViews application"
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   417
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   418
    ^ self pushEvent:(WindowEvent
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   419
                             for:nil
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   420
                             type:#quit)
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   421
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   422
    "Modified: 3.3.1997 / 20:15:00 / cg"
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   423
! !
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
   424
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   425
!WindowSensor methodsFor:'accessing'!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   426
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   427
compressMotionEvents:aBoolean
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   428
    "turn on/off motion event compression.
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   429
     Normally, motion event compression is enabled; however, 
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   430
     applications which want to follow every motion 
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   431
     (i.e. paint-like applications) may want to get them all)"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   432
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   433
    compressMotionEvents := aBoolean
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   434
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   435
    "Modified: / 6.6.1998 / 21:12:57 / cg"
1847
f449f3009e88 need even more protection against process-interrupts
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   436
!
f449f3009e88 need even more protection against process-interrupts
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   437
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   438
eventListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   439
    "return the eventListener 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   440
     - see documentation for what this can be used for"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   441
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   442
    ^ eventListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   443
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   444
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   445
eventListener:aListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   446
    "set the eventListener 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   447
     - see documentation for what this can be used for"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   448
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   449
    eventListener := aListener
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
!
140
claus
parents: 133
diff changeset
   452
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   453
eventSemaphore
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   454
    "return the semaphore used to signal event arrival"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   455
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   456
    ^ eventSemaphore
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
eventSemaphore:aSemaphore
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   460
    "set the semaphore used to signal event arrival"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   461
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   462
    eventSemaphore := aSemaphore
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   463
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   464
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   465
ignoreExposeEvents:aBoolean
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   466
    "turn on/off expose event ignoring"
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   467
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   468
    ignoreExposeEvents := aBoolean
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   469
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   470
    "Created: / 21.5.1996 / 18:21:18 / cg"
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   471
    "Modified: / 6.6.1998 / 21:13:14 / cg"
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   472
!
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   473
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   474
ignoreUserInput
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   475
    "return true, if user events are currently ignored"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   476
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   477
    ^ ignoreUserInput
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   478
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   479
    "Modified: / 6.6.1998 / 21:13:50 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   480
!
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
ignoreUserInput:aBoolean
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   483
    "turn on/off ignoring of user events processing.
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   484
     This can be used to avoid hacing events queued for a master-view,
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   485
     while a modal dialog is open for it."
244
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
    ignoreUserInput := aBoolean
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   488
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   489
    "Modified: / 6.6.1998 / 21:14:25 / cg"
140
claus
parents: 133
diff changeset
   490
!
claus
parents: 133
diff changeset
   491
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   492
keyboardListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   493
    "return the keyboardListener 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   494
     - see documentation for what this can be used for"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   495
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   496
    ^ keyboardListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   497
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   498
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   499
keyboardListener:aListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   500
    "set the keyboardListener 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   501
     - see documentation for what this can be used for"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   502
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   503
    keyboardListener := aListener
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   504
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   505
! !
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   506
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   507
!WindowSensor methodsFor:'accessing - private'!
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   508
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   509
criticalDamageEventQueueAccess:aBlock
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   510
    "perform some action which needs synchronized (exclusive)
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   511
     access to the damage event queue. 
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   512
     (i.e. protected by a critical region)"
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   513
2391
a8a92e36683c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2312
diff changeset
   514
    |wasBlocked p|
a8a92e36683c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2312
diff changeset
   515
a8a92e36683c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2312
diff changeset
   516
    p := Processor activeProcess.
a8a92e36683c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2312
diff changeset
   517
    wasBlocked := p blockInterrupts.
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   518
    [
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   519
        damageEventAccessLock critical:aBlock
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   520
    ] valueNowOrOnUnwindDo:[
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   521
        wasBlocked ifFalse:[
2391
a8a92e36683c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2312
diff changeset
   522
            p unblockInterrupts.
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   523
        ]
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   524
    ]
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   525
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   526
    "Created: / 6.6.1998 / 21:04:02 / cg"
2391
a8a92e36683c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2312
diff changeset
   527
    "Modified: / 14.10.1998 / 17:17:05 / cg"
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   528
!
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   529
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   530
criticalUserEventQueueAccess:aBlock
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   531
    "perform some action which needs synchronized (exclusive)
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   532
     access to the user event queue. 
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   533
     (i.e. protected by a critical region)"
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   534
2391
a8a92e36683c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2312
diff changeset
   535
    |wasBlocked p|
a8a92e36683c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2312
diff changeset
   536
a8a92e36683c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2312
diff changeset
   537
    p := Processor activeProcess.
a8a92e36683c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2312
diff changeset
   538
    wasBlocked := p blockInterrupts.
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   539
    [
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   540
        userEventAccessLock critical:aBlock
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   541
    ] valueNowOrOnUnwindDo:[
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   542
        wasBlocked ifFalse:[
2391
a8a92e36683c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2312
diff changeset
   543
            p unblockInterrupts.
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   544
        ]
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   545
    ]
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   546
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   547
    "Created: / 6.6.1998 / 21:06:43 / cg"
2391
a8a92e36683c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2312
diff changeset
   548
    "Modified: / 14.10.1998 / 15:56:08 / cg"
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   549
!
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   550
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   551
damageEventAccessLock
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   552
    "return the semaphore which controls access to the damage event queue.
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   553
     This should probably not be exposed to the public,
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   554
     so be prepared that this method may vanish."
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   555
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   556
    ^ damageEventAccessLock
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   557
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   558
    "Created: / 6.6.1998 / 21:06:14 / cg"
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   559
    "Modified: / 6.6.1998 / 21:16:49 / cg"
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   560
!
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   561
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   562
userEventAccessLock
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   563
    "return the semaphore which controls access to the mouse and keyboard event queue.
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   564
     This should probably not be exposed to the public,
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   565
     so be prepared that this method may vanish."
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   566
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   567
    ^ userEventAccessLock
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   568
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   569
    "Created: / 6.6.1998 / 21:05:56 / cg"
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   570
    "Modified: / 6.6.1998 / 21:16:57 / cg"
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   571
! !
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   572
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   573
!WindowSensor methodsFor:'event flushing'!
144
claus
parents: 140
diff changeset
   574
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   575
compressKeyPressEventsWithKey:aKey
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   576
    "count and remove multiple pending keyPress events for the
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   577
     same key, aKey. This is currently used in TextViews to compress
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   578
     multiple cursorUp/cursorDown events and do the scroll in one
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   579
     operation. (to avoid run-after-cursor on slow displays)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   580
2022
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
   581
    |n ev evKey|
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   582
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   583
    n := 0.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   584
    ev := self pendingEvent.
2022
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
   585
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
   586
    [ev notNil and:[ev isKeyEvent]] whileTrue:[
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
   587
        evKey := ev arguments at:1.
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
   588
        (evKey == aKey) ifTrue:[
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   589
            ev isKeyReleaseEvent ifFalse:[
2022
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
   590
                n := n + 1.
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   591
            ].
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   592
            self nextEvent.
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   593
            ev := self pendingEvent.
2022
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
   594
        ] ifFalse:[
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
   595
            ev := nil
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
   596
        ]
144
claus
parents: 140
diff changeset
   597
    ].
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   598
    ^ n
2022
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
   599
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
   600
    "Modified: / 27.1.1998 / 14:15:00 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   601
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   602
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   603
flushEventsFor:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   604
    "throw away all events for aView, 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   605
     or any view, if the argument is nil."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   606
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   607
    self flushExposeEventsFor:aView.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   608
    self flushUserEventsFor:aView.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   609
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   610
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   611
flushEventsFor:aView inQueue:anEventQueue where:aCondition
1790
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   612
    "throw away all pending damage events for aView, 
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   613
     for which aCondition returns true.
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   614
     Or any view for which aCondition returns true, if the argument is nil. 
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   615
     A helper for the various flush entries."
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   616
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   617
    |action|
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   618
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   619
    action := [
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   620
        |nEvent "{ Class: SmallInteger }" 
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   621
         anEvent
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   622
         queue|
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   623
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   624
        queue := anEventQueue.
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   625
        nEvent := queue size.
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   626
        1 to:nEvent do:[:index |
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   627
            anEvent := queue at:index.
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   628
            anEvent notNil ifTrue:[
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   629
                (aView isNil or:[anEvent view == aView]) ifTrue:[
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   630
                    (aCondition value:anEvent) ifTrue:[
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
   631
                        queue at:index put:nil
1790
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   632
                    ]
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   633
                ]
1847
f449f3009e88 need even more protection against process-interrupts
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   634
            ]
1790
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   635
        ].
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   636
    ].
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   637
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   638
    anEventQueue == damage ifTrue:[
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   639
        self criticalDamageEventQueueAccess:action
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   640
    ] ifFalse:[
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   641
        self criticalUserEventQueueAccess:action
1790
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   642
    ]
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   643
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   644
    "Modified: / 6.6.1998 / 21:10:22 / cg"
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   645
    "Created: / 6.6.1998 / 21:17:54 / cg"
1790
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   646
!
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   647
2163
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   648
flushEventsFor:aView withType:type
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   649
    "throw away all events for aView, 
2177
22bc7dd353b4 added #userEventCount query
Claus Gittinger <cg@exept.de>
parents: 2163
diff changeset
   650
     (or any view, if the argument is nil) which have a particular type."
2163
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   651
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   652
    self flushEventsFor:aView inQueue:damage where:[:event | event type==type].
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   653
    self flushEventsFor:aView inQueue:mouseAndKeyboard where:[:event | event type==type].
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   654
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   655
    "Created: / 20.6.1998 / 16:41:35 / cg"
2177
22bc7dd353b4 added #userEventCount query
Claus Gittinger <cg@exept.de>
parents: 2163
diff changeset
   656
    "Modified: / 21.7.1998 / 18:16:11 / cg"
2163
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   657
!
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   658
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   659
flushExposeEvents
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   660
    "throw away all pending expose events; this
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   661
     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
   662
     doing full redraws anly)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   663
1790
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   664
    self
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   665
        flushEventsFor:nil inQueue:damage where:[:event | event isDamage].
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   666
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   667
    "Modified: / 6.6.1998 / 21:18:03 / cg"
144
claus
parents: 140
diff changeset
   668
!
claus
parents: 140
diff changeset
   669
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   670
flushExposeEventsFor:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   671
    "throw away all pending expose events for aView, 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   672
     or any view, if the argument is nil. 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   673
     This can be done after a full redraw 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   674
     (or in views, which are always doing full redraws -
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   675
      instead of drawing the clip-area only)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   676
1790
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   677
    self
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   678
        flushEventsFor:aView inQueue:damage where:[:event | event isDamage].
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   679
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   680
    "Modified: / 6.6.1998 / 21:18:05 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   681
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   682
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   683
flushKeyboard
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   684
    "ST-80 compatibility: throw away all pending keyboard events"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   685
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   686
    self flushKeyboardFor:nil
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   687
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   688
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   689
flushKeyboardFor:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   690
    "throw away all pending keyboard events for aView, 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   691
     or any view, if the argument is nil." 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   692
1790
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   693
    self
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   694
        flushEventsFor:aView inQueue:mouseAndKeyboard 
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   695
        where:[:event | event isKeyEvent]
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   696
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   697
    "Modified: / 6.6.1998 / 21:18:08 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   698
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   699
1731
ca
parents: 1616
diff changeset
   700
flushMotionEventsFor:aView
ca
parents: 1616
diff changeset
   701
    "throw away all pending motion events for aView, 
ca
parents: 1616
diff changeset
   702
     or for any view, if the argument is nil." 
ca
parents: 1616
diff changeset
   703
1790
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   704
    self
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   705
        flushEventsFor:aView inQueue:mouseAndKeyboard 
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   706
        where:[:event | event isButtonMotionEvent]
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   707
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   708
    "Modified: / 6.6.1998 / 21:18:10 / cg"
1731
ca
parents: 1616
diff changeset
   709
!
ca
parents: 1616
diff changeset
   710
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   711
flushUserEvents
2163
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   712
    "throw away all pending user events (i.e. key & button stuff)"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   713
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   714
    (mouseAndKeyboard isNil or:[mouseAndKeyboard size > 0]) ifTrue:[
2163
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   715
        self flushUserEventsFor:nil
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   716
    ].
1159
e5247f8a48f3 do not flush synthetic events in #flushUserEvents
Claus Gittinger <cg@exept.de>
parents: 1155
diff changeset
   717
2163
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   718
    "Modified: / 20.6.1998 / 16:40:02 / 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
flushUserEventsFor:aView
2163
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   722
    "throw away all pending user events for aView (i.e. key & button stuff), 
1159
e5247f8a48f3 do not flush synthetic events in #flushUserEvents
Claus Gittinger <cg@exept.de>
parents: 1155
diff changeset
   723
     or for any view, if the argument is nil." 
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   724
1790
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   725
    self
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
   726
        flushEventsFor:aView inQueue:mouseAndKeyboard 
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   727
        where:[:event | event isUserEvent]
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   728
2163
31383028eec6 more flushing stuff.
Claus Gittinger <cg@exept.de>
parents: 2157
diff changeset
   729
    "Modified: / 20.6.1998 / 16:40:09 / cg"
157
claus
parents: 154
diff changeset
   730
! !
claus
parents: 154
diff changeset
   731
claus
parents: 154
diff changeset
   732
!WindowSensor methodsFor:'event processing'!
claus
parents: 154
diff changeset
   733
140
claus
parents: 133
diff changeset
   734
buttonMotion:state x:x y:y view:aView
claus
parents: 133
diff changeset
   735
    "mouse was moved - this is sent from the device (Display)"
claus
parents: 133
diff changeset
   736
2439
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   737
    |args ev ignoreIt|
140
claus
parents: 133
diff changeset
   738
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
   739
    "/ update my idea of shift/alt/ctrl pressed information
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
   740
    self updateModifierStateFrom:state device:(aView graphicsDevice).
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
   741
140
claus
parents: 133
diff changeset
   742
    EventListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   743
        (EventListener buttonMotion:state x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   744
    ].
claus
parents: 133
diff changeset
   745
    eventListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   746
        (eventListener buttonMotion:state x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   747
    ].
claus
parents: 133
diff changeset
   748
claus
parents: 133
diff changeset
   749
    ignoreUserInput == true ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   750
        ^ self
140
claus
parents: 133
diff changeset
   751
    ].
claus
parents: 133
diff changeset
   752
    args := Array with:state with:x with:y.
claus
parents: 133
diff changeset
   753
claus
parents: 133
diff changeset
   754
    compressMotionEvents ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   755
        "
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   756
         merge with last motion
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   757
        "
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   758
        self criticalUserEventQueueAccess:[
2439
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   759
            |idx|
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   760
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   761
            idx := mouseAndKeyboard size.
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   762
            [idx > 0] whileTrue:[
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   763
                ev := mouseAndKeyboard at:idx.
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   764
                ev notNil ifTrue:[
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   765
                    ((ev type == #buttonMotion:x:y:) 
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   766
                    and:[(ev view == aView)
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   767
                    and:[(ev arguments at:1) == state]]) ifTrue:[
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   768
                        ev arguments:args.
2439
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   769
                        idx := 0.
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   770
                        ignoreIt := true
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   771
                    ]
2439
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   772
                ].
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   773
                idx := idx - 1.
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   774
            ].
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   775
        ].
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   776
        ignoreIt == true ifTrue:[
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   777
            ^ self
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   778
        ]
140
claus
parents: 133
diff changeset
   779
    ].
1861
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   780
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   781
    ev := WindowEvent buttonEvent
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   782
             for:aView
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   783
             type:#buttonMotion:x:y:
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   784
             arguments:args.
1862
e56d9a7389bb also remember buttonStates in keyEvents.
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
   785
    ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
2126
1f108c76dfdb moved event dispatching code to view (where it belongs)
Claus Gittinger <cg@exept.de>
parents: 2123
diff changeset
   786
       button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
1861
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   787
    self pushEvent:ev.
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   788
2439
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
   789
    "Modified: / 5.2.1999 / 21:23:31 / 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
buttonMultiPress:button x:x y:y view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   793
    "mouse button was pressed - this is sent from the device (Display)"
140
claus
parents: 133
diff changeset
   794
1861
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   795
    |ev|
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   796
1083
6e947cc67324 fixed #anyButtonPressed & setting of buttonDown-flags
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   797
    self button:button inView:aView state:true.
6e947cc67324 fixed #anyButtonPressed & setting of buttonDown-flags
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   798
140
claus
parents: 133
diff changeset
   799
    EventListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   800
        (EventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   801
    ].
claus
parents: 133
diff changeset
   802
    eventListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   803
        (eventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   804
    ].
claus
parents: 133
diff changeset
   805
claus
parents: 133
diff changeset
   806
    ignoreUserInput == true ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   807
        ^ self
140
claus
parents: 133
diff changeset
   808
    ].
1083
6e947cc67324 fixed #anyButtonPressed & setting of buttonDown-flags
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   809
1861
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   810
    ev := WindowEvent buttonEvent
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   811
             for:aView
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   812
             type:#buttonMultiPress:x:y:
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   813
             arguments:(Array with:button with:x with:y).
1862
e56d9a7389bb also remember buttonStates in keyEvents.
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
   814
    ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
2126
1f108c76dfdb moved event dispatching code to view (where it belongs)
Claus Gittinger <cg@exept.de>
parents: 2123
diff changeset
   815
       button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
1861
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   816
    self pushEvent:ev.
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   817
2126
1f108c76dfdb moved event dispatching code to view (where it belongs)
Claus Gittinger <cg@exept.de>
parents: 2123
diff changeset
   818
    "Modified: / 21.5.1998 / 00:20:40 / cg"
140
claus
parents: 133
diff changeset
   819
!
claus
parents: 133
diff changeset
   820
claus
parents: 133
diff changeset
   821
buttonPress:button x:x y:y view:aView
claus
parents: 133
diff changeset
   822
    "mouse button was pressed - this is sent from the device (Display)"
claus
parents: 133
diff changeset
   823
1861
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   824
    |ev|
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   825
157
claus
parents: 154
diff changeset
   826
    self button:button inView:aView state:true.
claus
parents: 154
diff changeset
   827
140
claus
parents: 133
diff changeset
   828
    EventListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   829
        (EventListener buttonPress:button x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   830
    ].
claus
parents: 133
diff changeset
   831
    eventListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   832
        (eventListener buttonPress:button x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
   833
    ].
claus
parents: 133
diff changeset
   834
claus
parents: 133
diff changeset
   835
    ignoreUserInput == true ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   836
        ^ self
140
claus
parents: 133
diff changeset
   837
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   838
1861
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   839
    ev := WindowEvent buttonEvent
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   840
             for:aView
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   841
             type:#buttonPress:x:y:
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   842
             arguments:(Array with:button with:x with:y).
1862
e56d9a7389bb also remember buttonStates in keyEvents.
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
   843
    ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
2126
1f108c76dfdb moved event dispatching code to view (where it belongs)
Claus Gittinger <cg@exept.de>
parents: 2123
diff changeset
   844
       button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
1861
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   845
    self pushEvent:ev.
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   846
2126
1f108c76dfdb moved event dispatching code to view (where it belongs)
Claus Gittinger <cg@exept.de>
parents: 2123
diff changeset
   847
    "Modified: / 21.5.1998 / 00:20:44 / cg"
140
claus
parents: 133
diff changeset
   848
!
claus
parents: 133
diff changeset
   849
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   850
buttonRelease:button x:x y:y view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   851
    "mouse button was released- this is sent from the device (Display)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   852
1861
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   853
    |ev|
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   854
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   855
    self button:button inView:aView state:false.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   856
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   857
    EventListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   858
        (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
   859
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   860
    eventListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   861
        (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
   862
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   863
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   864
    ignoreUserInput == true ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
   865
        ^ self
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   866
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   867
1861
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   868
    ev := WindowEvent buttonEvent
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   869
             for:aView
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   870
             type:#buttonRelease:x:y:
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   871
             arguments:(Array with:button with:x with:y).
1862
e56d9a7389bb also remember buttonStates in keyEvents.
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
   872
    ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
2126
1f108c76dfdb moved event dispatching code to view (where it belongs)
Claus Gittinger <cg@exept.de>
parents: 2123
diff changeset
   873
       button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
1861
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   874
    self pushEvent:ev.
1b1e49147380 remember shift,meta,alt & ctrl state in buttonEvents
Claus Gittinger <cg@exept.de>
parents: 1852
diff changeset
   875
2126
1f108c76dfdb moved event dispatching code to view (where it belongs)
Claus Gittinger <cg@exept.de>
parents: 2123
diff changeset
   876
    "Modified: / 21.5.1998 / 00:21:19 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   877
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   878
1545
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   879
clientMessage:type format:format eventData:data view:aView
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   880
    "some other data sent to a view.
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   881
     This is an X-specific event."
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   882
2126
1f108c76dfdb moved event dispatching code to view (where it belongs)
Claus Gittinger <cg@exept.de>
parents: 2123
diff changeset
   883
    self pushEvent:(WindowEvent 
1f108c76dfdb moved event dispatching code to view (where it belongs)
Claus Gittinger <cg@exept.de>
parents: 2123
diff changeset
   884
                        clientEvent
1545
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   885
                             for:aView
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   886
                             type:#clientMessage:format:eventData:
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   887
                             arguments:(Array with:type with:format with:data)).
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   888
2126
1f108c76dfdb moved event dispatching code to view (where it belongs)
Claus Gittinger <cg@exept.de>
parents: 2123
diff changeset
   889
    "Created: / 4.4.1997 / 17:51:08 / cg"
1f108c76dfdb moved event dispatching code to view (where it belongs)
Claus Gittinger <cg@exept.de>
parents: 2123
diff changeset
   890
    "Modified: / 21.5.1998 / 00:20:56 / cg"
1545
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   891
!
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   892
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   893
configureX:x y:y width:w height:h view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   894
    "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
   895
1108
748f9e5c5b1e ignore configureEvents for subviews.
Claus Gittinger <cg@exept.de>
parents: 1100
diff changeset
   896
    aView superView notNil ifTrue:[
1969
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   897
        "/ this is a configure event for a subView
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   898
        "/ I guess, this resulted from a resize of
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   899
        "/ myself (are there any windowManagers which resize subviews ?)
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   900
        "/ Therefore, ignore it here.
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   901
        "/ This also fixed problems due to late-arriving configure events,
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   902
        "/ in case of a resized view, which was resized before.
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   903
        "/ Without the return below, we need a flushConfigureEvents entry here,
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   904
        "/ to be invoked whenever a subview is resized / repositioned.
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   905
2429
c54c8e30fe13 support for external topViews.
Claus Gittinger <cg@exept.de>
parents: 2421
diff changeset
   906
        "/ A kludge-workaround had to be added to children of
c54c8e30fe13 support for external topViews.
Claus Gittinger <cg@exept.de>
parents: 2421
diff changeset
   907
        "/ external top views - since the external view does not get any
c54c8e30fe13 support for external topViews.
Claus Gittinger <cg@exept.de>
parents: 2421
diff changeset
   908
        "/ events delivered, we must react upon changes of the
c54c8e30fe13 support for external topViews.
Claus Gittinger <cg@exept.de>
parents: 2421
diff changeset
   909
        "/ child. (sigh).
c54c8e30fe13 support for external topViews.
Claus Gittinger <cg@exept.de>
parents: 2421
diff changeset
   910
        aView superView isExternalTopView ifFalse:[
c54c8e30fe13 support for external topViews.
Claus Gittinger <cg@exept.de>
parents: 2421
diff changeset
   911
"/            'ignored configure for: ' print. aView class printCR.
c54c8e30fe13 support for external topViews.
Claus Gittinger <cg@exept.de>
parents: 2421
diff changeset
   912
            ^ self
c54c8e30fe13 support for external topViews.
Claus Gittinger <cg@exept.de>
parents: 2421
diff changeset
   913
        ]
1969
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   914
    ].
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   915
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   916
    "/
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   917
    "/ experimental: only queue one confif event (WIN32 speedup)
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   918
    "/
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   919
    damage size ~~ 0 ifTrue:[
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   920
        damage do:[:aDamage |
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   921
            aDamage notNil ifTrue:[
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   922
                aDamage type == #configureX:y:width:height: ifTrue:[
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   923
                    aDamage view == aView ifTrue:[
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   924
                        aDamage
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   925
                            arguments:(Array with:x with:y with:w with:h).
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   926
                        ^ false
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   927
                    ]
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   928
                ]
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   929
            ].
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   930
        ]
1108
748f9e5c5b1e ignore configureEvents for subviews.
Claus Gittinger <cg@exept.de>
parents: 1100
diff changeset
   931
    ].
748f9e5c5b1e ignore configureEvents for subviews.
Claus Gittinger <cg@exept.de>
parents: 1100
diff changeset
   932
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   933
    self pushDamageEvent:(WindowEvent
1969
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   934
                             for:aView
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   935
                             type:#configureX:y:width:height:
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   936
                             arguments:(Array with:x with:y with:w with:h)).
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   937
d2d7073b7c56 experimental: only enqueue last configure event
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   938
    "Modified: / 8.12.1997 / 19:16:12 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   939
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   940
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   941
coveredBy:sibling view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   942
    "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
   943
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   944
    self pushDamageEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   945
			     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   946
			     type:#coveredBy:
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   947
			     arguments:(Array with:sibling)).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   948
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   949
    "Modified: 18.1.1997 / 14:18:32 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   950
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   951
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   952
destroyedView:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   953
    "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
   954
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   955
    "at this time, the view is already gone; remove
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   956
     all pending events for this one ..."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   957
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   958
    self flushEventsFor:aView.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   959
    self pushDamageEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   960
			     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
   961
			     type:#destroyed).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   962
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   963
    "Modified: 18.1.1997 / 14:18:19 / cg"
244
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
1545
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   966
dropMessage:dropType data:dropValue view:aView
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   967
    "a drop sent to a view. The dropType is a symbolic specifier,
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   968
     which may be ignored, since the dropValue has already been
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   969
     converted into an ST/X dropObject."
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   970
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   971
    self pushEvent:(WindowEvent 
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   972
                             for:aView
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   973
                             type:#dropMessage:data:
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   974
                             arguments:(Array with:dropType with:dropValue)).
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   975
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   976
    "Created: 4.4.1997 / 18:13:41 / cg"
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   977
    "Modified: 4.4.1997 / 18:55:25 / cg"
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   978
!
f821b3870502 client- and drop messages
Claus Gittinger <cg@exept.de>
parents: 1529
diff changeset
   979
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   980
exposeX:left y:top width:width height:height view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   981
    "an expose event arrived - this is sent from the device (Display)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   982
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   983
    ignoreExposeEvents ~~ true ifTrue:[
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
   984
        self addDamage:(Rectangle left:left top:top width:width height:height) 
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
   985
                  view:aView
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
   986
                wakeup:true.
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
   987
    ] ifFalse:[
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
   988
        'ignored expose' printCR
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   989
    ]
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
   990
2397
d1f0fda167af checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2391
diff changeset
   991
    "Modified: / 9.11.1998 / 14:23:01 / cg"
140
claus
parents: 133
diff changeset
   992
!
claus
parents: 133
diff changeset
   993
claus
parents: 133
diff changeset
   994
focusInView:aView
claus
parents: 133
diff changeset
   995
    "view got input focus - this is sent from the device (Display)"
claus
parents: 133
diff changeset
   996
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   997
    self pushEvent:(WindowEvent
1331
bc6f96de5305 checkin from browser
ca
parents: 1320
diff changeset
   998
                     for:aView
bc6f96de5305 checkin from browser
ca
parents: 1320
diff changeset
   999
                     type:#focusIn).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1000
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1001
    "Modified: 18.1.1997 / 14:07:01 / cg"
140
claus
parents: 133
diff changeset
  1002
!
claus
parents: 133
diff changeset
  1003
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1004
focusOutView:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1005
    "view lost input focus - this is sent from the device (Display)"
140
claus
parents: 133
diff changeset
  1006
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1007
    self pushEvent:(WindowEvent
1331
bc6f96de5305 checkin from browser
ca
parents: 1320
diff changeset
  1008
                     for:aView
bc6f96de5305 checkin from browser
ca
parents: 1320
diff changeset
  1009
                     type:#focusOut).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1010
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1011
    "Modified: 18.1.1997 / 14:07:09 / cg"
140
claus
parents: 133
diff changeset
  1012
!
claus
parents: 133
diff changeset
  1013
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1014
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
  1015
    "a graphic expose event arrived - this is sent from the device (Display)"
140
claus
parents: 133
diff changeset
  1016
1243
0c33cb7f8458 hopefully fixed the 'lost expose' bug
Claus Gittinger <cg@exept.de>
parents: 1242
diff changeset
  1017
    "/ 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
  1018
    "/ (if an expose is pending)
0c33cb7f8458 hopefully fixed the 'lost expose' bug
Claus Gittinger <cg@exept.de>
parents: 1242
diff changeset
  1019
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1020
    final ifTrue:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1021
        (catchExpose includes:aView) ifTrue:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1022
	    gotExpose add:aView.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1023
	    exposeEventSemaphore signalForAll
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1024
	] ifFalse:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1025
	    '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
  1026
	]
1243
0c33cb7f8458 hopefully fixed the 'lost expose' bug
Claus Gittinger <cg@exept.de>
parents: 1242
diff changeset
  1027
    ].
0c33cb7f8458 hopefully fixed the 'lost expose' bug
Claus Gittinger <cg@exept.de>
parents: 1242
diff changeset
  1028
751
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1029
    self addDamage:(left @ top extent:width @ height) view:aView wakeup:false.
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1030
1268
612204a36c38 no, regular expose events should not trigger the exposeSema
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
  1031
    "Modified: 23.1.1997 / 22:15:53 / cg"
140
claus
parents: 133
diff changeset
  1032
!
claus
parents: 133
diff changeset
  1033
claus
parents: 133
diff changeset
  1034
keyPress:key x:x y:y view:aView
claus
parents: 133
diff changeset
  1035
    "key was pressed - this is sent from the device (Display).
claus
parents: 133
diff changeset
  1036
     beside the keyboard translation, CntlC processing is done here."
claus
parents: 133
diff changeset
  1037
510
c0c7a04317a9 resources
Claus Gittinger <cg@exept.de>
parents: 488
diff changeset
  1038
    <resource: #keyboard ( #Compose #DestroyView #DestroyTopView #FlushInput
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
  1039
                           #UserInterrupt #UserAbort) >
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1040
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1041
    |xlatedKey group process ev|
140
claus
parents: 133
diff changeset
  1042
144
claus
parents: 140
diff changeset
  1043
    self key:key state:true. 
claus
parents: 140
diff changeset
  1044
2413
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1045
    "/ bail out of a popUpView with ctrl-escape
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1046
    "/ (useful to avoid total lock of system with non-functioning grabbing opUpView)
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1047
    (key == #Escape) ifTrue:[
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1048
        aView isPopUpView ifTrue:[
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1049
            ctrlDown ifTrue:[
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1050
                aView device ungrabPointer.
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1051
                aView device ungrabKeyboard.
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1052
                aView destroy.
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1053
                ^ self
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1054
            ]
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1055
        ]
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1056
    ].
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1057
140
claus
parents: 133
diff changeset
  1058
    EventListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1059
        (EventListener keyPress:key x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
  1060
    ].
claus
parents: 133
diff changeset
  1061
    eventListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1062
        (eventListener keyPress:key x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
  1063
    ].
claus
parents: 133
diff changeset
  1064
    keyboardListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1065
        (keyboardListener keyPress:key x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
  1066
    ].
claus
parents: 133
diff changeset
  1067
claus
parents: 133
diff changeset
  1068
    translateKeyboardEvents ifTrue:[
2141
ed587c556c11 ask view for keyboardMap.
Claus Gittinger <cg@exept.de>
parents: 2137
diff changeset
  1069
        xlatedKey := aView graphicsDevice translateKey:key forView:aView.
140
claus
parents: 133
diff changeset
  1070
    ] ifFalse:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1071
        xlatedKey := key.
140
claus
parents: 133
diff changeset
  1072
    ].
157
claus
parents: 154
diff changeset
  1073
140
claus
parents: 133
diff changeset
  1074
    xlatedKey isNil ifTrue:[^ self].
claus
parents: 133
diff changeset
  1075
157
claus
parents: 154
diff changeset
  1076
    (xlatedKey == #Compose) ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1077
        GotCompose := true. Compose1 := nil.
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1078
        ^ self
157
claus
parents: 154
diff changeset
  1079
    ].
claus
parents: 154
diff changeset
  1080
    GotCompose == true ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1081
        Compose1 isNil ifTrue:[
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1082
            (self isModifierKey:xlatedKey) ifFalse:[
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1083
                Compose1 := xlatedKey. 
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1084
            ].
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1085
            ^ self
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1086
        ].
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1087
        (self isModifierKey:xlatedKey) ifFalse:[
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1088
            xlatedKey  := self compose:Compose1 with:xlatedKey.
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1089
            Compose1 := nil. GotCompose := false.
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1090
        ]
157
claus
parents: 154
diff changeset
  1091
    ].
claus
parents: 154
diff changeset
  1092
claus
parents: 154
diff changeset
  1093
    (xlatedKey == #CmdCtrlV) ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1094
        'Smalltalk/X ' errorPrint. 
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1095
        Smalltalk versionString errorPrint. ' of ' errorPrint.
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1096
        Smalltalk versionDate errorPrintCR.
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1097
        Smalltalk copyrightString errorPrintCR.
140
claus
parents: 133
diff changeset
  1098
    ].
claus
parents: 133
diff changeset
  1099
157
claus
parents: 154
diff changeset
  1100
    (xlatedKey == #DestroyView) ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1101
        aView closeRequest.
157
claus
parents: 154
diff changeset
  1102
    ].
claus
parents: 154
diff changeset
  1103
    (xlatedKey == #DestroyTopView) ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1104
        aView topView closeRequest.
157
claus
parents: 154
diff changeset
  1105
    ].
claus
parents: 154
diff changeset
  1106
152
claus
parents: 144
diff changeset
  1107
    (xlatedKey == #FlushInput) ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1108
        "this removes any enqueued user events -
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1109
         helps, if you pressed DoIt too often, and want to flush those
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1110
        "
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1111
        self flushUserEvents.
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1112
        ^ self
152
claus
parents: 144
diff changeset
  1113
    ].
claus
parents: 144
diff changeset
  1114
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
  1115
    (((xlatedKey == #UserInterrupt) and:[ControlCEnabled])
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
  1116
    or:[((xlatedKey == #UserAbort) and:[ControlYEnabled])]) ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1117
        "
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
  1118
         Special handling for 
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
  1119
            Ctrl-C: interrupt the underlying process.
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
  1120
         and:
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
  1121
            Ctrl-Y: raise abortSignal the underlying process.
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1122
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1123
         cannot halt here (this would stop the event-dispatcher),
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1124
         but instead interrupt the underlying process and have it
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1125
         perform the userInterrupt in the interrupt-method.
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1126
        "
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1127
        group := aView windowGroup.
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1128
        group notNil ifTrue:[
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1129
            process := group process.
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1130
            process notNil ifTrue:[
2123
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
  1131
                (xlatedKey == #UserAbort) ifTrue:[
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
  1132
                    process interruptWith:[:where | AbortSignal raise]
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
  1133
                ] ifFalse:[
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
  1134
                    process interruptWith:[:where | process userInterruptIn:where]
b2dae4453526 added additional key: #UserAbort (CTRL-y),
Claus Gittinger <cg@exept.de>
parents: 2090
diff changeset
  1135
                ]
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1136
            ]
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1137
        ].
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1138
        ^ self
140
claus
parents: 133
diff changeset
  1139
    ].
claus
parents: 133
diff changeset
  1140
claus
parents: 133
diff changeset
  1141
    ignoreUserInput == true ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1142
        ^ self
140
claus
parents: 133
diff changeset
  1143
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1144
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1145
    ev := WindowEvent keyboardEvent
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1146
             for:aView
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1147
             type:#keyPress:x:y:
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1148
             arguments:(Array with:xlatedKey with:x with:y).
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1149
    ev rawKey:key.
1862
e56d9a7389bb also remember buttonStates in keyEvents.
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
  1150
    ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
e56d9a7389bb also remember buttonStates in keyEvents.
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
  1151
                          button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1152
    self pushEvent:ev.
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1153
2413
08e6fadff67d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2411
diff changeset
  1154
    "Modified: / 4.12.1998 / 15:35:32 / cg"
140
claus
parents: 133
diff changeset
  1155
!
claus
parents: 133
diff changeset
  1156
claus
parents: 133
diff changeset
  1157
keyRelease:key x:x y:y view:aView
claus
parents: 133
diff changeset
  1158
    "key was released - this is sent from the device (Display)."
claus
parents: 133
diff changeset
  1159
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1160
    |xlatedKey ev|
140
claus
parents: 133
diff changeset
  1161
144
claus
parents: 140
diff changeset
  1162
    self key:key state:false. 
claus
parents: 140
diff changeset
  1163
140
claus
parents: 133
diff changeset
  1164
    EventListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1165
        (EventListener keyRelease:key x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
  1166
    ].
claus
parents: 133
diff changeset
  1167
    eventListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1168
        (eventListener keyRelease:key x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
  1169
    ].
claus
parents: 133
diff changeset
  1170
    keyboardListener notNil ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1171
        (keyboardListener keyRelease:key x:x y:y view:aView) ifTrue:[^ self]
140
claus
parents: 133
diff changeset
  1172
    ].
claus
parents: 133
diff changeset
  1173
claus
parents: 133
diff changeset
  1174
    ignoreUserInput == true ifTrue:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1175
        ^ self
140
claus
parents: 133
diff changeset
  1176
    ].
claus
parents: 133
diff changeset
  1177
    translateKeyboardEvents ifTrue:[
2141
ed587c556c11 ask view for keyboardMap.
Claus Gittinger <cg@exept.de>
parents: 2137
diff changeset
  1178
        xlatedKey := aView graphicsDevice translateKey:key forView:aView.
140
claus
parents: 133
diff changeset
  1179
    ] ifFalse:[
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1180
        xlatedKey := key.
140
claus
parents: 133
diff changeset
  1181
    ].
claus
parents: 133
diff changeset
  1182
    xlatedKey isNil ifTrue:[^ self].
claus
parents: 133
diff changeset
  1183
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1184
    ev := WindowEvent keyboardEvent
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1185
             for:aView
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1186
             type:#keyRelease:x:y:
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1187
             arguments:(Array with:xlatedKey with:x with:y).
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1188
    ev rawKey:key.
1862
e56d9a7389bb also remember buttonStates in keyEvents.
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
  1189
    ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
e56d9a7389bb also remember buttonStates in keyEvents.
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
  1190
                          button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
1528
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1191
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1192
    self pushEvent:ev.
78c64c132593 started to separate into distinct event classes;
Claus Gittinger <cg@exept.de>
parents: 1512
diff changeset
  1193
1862
e56d9a7389bb also remember buttonStates in keyEvents.
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
  1194
    "Modified: 13.8.1997 / 22:19:22 / cg"
140
claus
parents: 133
diff changeset
  1195
!
claus
parents: 133
diff changeset
  1196
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1197
mappedView:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1198
    "view was mapped (from window manager) - this is sent from the device (Display)"
140
claus
parents: 133
diff changeset
  1199
2058
59a52789086a fixed (I hope) redraw bug in debugView
Claus Gittinger <cg@exept.de>
parents: 2052
diff changeset
  1200
    self flushExposeEventsFor:aView.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1201
    self pushDamageEvent:(WindowEvent
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1202
                             for:aView
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1203
                             type:#mapped).
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1204
2058
59a52789086a fixed (I hope) redraw bug in debugView
Claus Gittinger <cg@exept.de>
parents: 2052
diff changeset
  1205
    "Modified: / 16.2.1998 / 13:20:41 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1206
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1207
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1208
noExposeView:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1209
    "an noexpose event arrived - this is sent from the device (Display)"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1210
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1211
    (catchExpose includes:aView) ifTrue:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1212
        gotExpose add:aView.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1213
        exposeEventSemaphore signalForAll
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1214
    ] ifFalse:[
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1215
        '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
  1216
    ]
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1217
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1218
1340
f028f125f606 pasteFromClipBoard: must go through the sensor
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
  1219
pasteFromClipBoard:something view:aView
f028f125f606 pasteFromClipBoard: must go through the sensor
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
  1220
    "a clipboard paste - this is handled like a user event"
f028f125f606 pasteFromClipBoard: must go through the sensor
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
  1221
f028f125f606 pasteFromClipBoard: must go through the sensor
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
  1222
    self pushEvent:(WindowEvent
f028f125f606 pasteFromClipBoard: must go through the sensor
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
  1223
                     for:aView
f028f125f606 pasteFromClipBoard: must go through the sensor
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
  1224
                     type:#pasteFromClipBoard:
f028f125f606 pasteFromClipBoard: must go through the sensor
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
  1225
                     arguments:(Array with:something)).
f028f125f606 pasteFromClipBoard: must go through the sensor
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
  1226
f028f125f606 pasteFromClipBoard: must go through the sensor
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
  1227
    "Modified: 18.1.1997 / 14:07:25 / cg"
f028f125f606 pasteFromClipBoard: must go through the sensor
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
  1228
    "Created: 13.2.1997 / 13:40:24 / cg"
f028f125f606 pasteFromClipBoard: must go through the sensor
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
  1229
!
f028f125f606 pasteFromClipBoard: must go through the sensor
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
  1230
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1231
pointerEnter:state x:x y:y view:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1232
    "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
  1233
1864
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1234
    |ev|
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1235
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1236
    "/ update my idea of shift/alt/ctrl pressed information
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1237
    self updateModifierStateFrom:state device:(aView graphicsDevice).
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  1238
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1239
    EventListener notNil ifTrue:[
1864
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1240
        (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
  1241
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1242
    eventListener notNil ifTrue:[
1864
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1243
        (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
  1244
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1245
1864
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1246
    ev := WindowEvent inputEvent
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1247
             for:aView
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1248
             type:#pointerEnter:x:y:
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1249
             arguments:(Array with:state with:x with:y).
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1250
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1251
    ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1252
                          button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1253
    self pushEvent:ev.
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1254
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1255
    "Modified: 13.8.1997 / 23:04:09 / cg"
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1256
!
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1257
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1258
pointerLeave:state view:aView
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1259
    "mouse cursor was moved out of the view - this is sent from the device (Display)"
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1260
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1261
    |ev|
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1262
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1263
    "/ update my idea of shift/alt/ctrl pressed information
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1264
    self updateModifierStateFrom:state device:(aView graphicsDevice).
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1265
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1266
    EventListener notNil ifTrue:[
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1267
        (EventListener pointerLeave:state view:aView) ifTrue:[^ self]
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1268
    ].
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1269
    eventListener notNil ifTrue:[
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1270
        (eventListener pointerLeave:state view:aView) ifTrue:[^ self]
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1271
    ].
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1272
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1273
    ev := WindowEvent inputEvent
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1274
             for:aView
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1275
             type:#pointerLeave:
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1276
             arguments:(Array with:state).
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1277
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1278
    ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1279
                          button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1280
    self pushEvent:ev.
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1281
4aeff6edaab6 remember modifiers in pointerEnter/Leave events
Claus Gittinger <cg@exept.de>
parents: 1862
diff changeset
  1282
    "Modified: 13.8.1997 / 23:04:13 / cg"
140
claus
parents: 133
diff changeset
  1283
!
claus
parents: 133
diff changeset
  1284
claus
parents: 133
diff changeset
  1285
saveAndTerminateView:aView
claus
parents: 133
diff changeset
  1286
    "view should save & terminate (from window manager) - this is sent from the device (Display)"
claus
parents: 133
diff changeset
  1287
claus
parents: 133
diff changeset
  1288
    self flushEventsFor:aView.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1289
    self pushDamageEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1290
			     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1291
			     type:#saveAndTerminate).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1292
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1293
    "Modified: 18.1.1997 / 14:17:37 / cg"
140
claus
parents: 133
diff changeset
  1294
!
claus
parents: 133
diff changeset
  1295
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1296
terminateView:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1297
    "view should terminate (from window manager) - this is sent from the device (Display)"
140
claus
parents: 133
diff changeset
  1298
claus
parents: 133
diff changeset
  1299
    self flushEventsFor:aView.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1300
    self pushDamageEvent:(WindowEvent
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1301
			     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1302
			     type:#terminate).
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1303
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1304
    "Modified: 18.1.1997 / 14:17:24 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1305
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1306
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1307
unmappedView:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1308
    "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
  1309
2058
59a52789086a fixed (I hope) redraw bug in debugView
Claus Gittinger <cg@exept.de>
parents: 2052
diff changeset
  1310
    self flushExposeEventsFor:aView.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1311
    self pushDamageEvent:(WindowEvent
2058
59a52789086a fixed (I hope) redraw bug in debugView
Claus Gittinger <cg@exept.de>
parents: 2052
diff changeset
  1312
                             for:aView
59a52789086a fixed (I hope) redraw bug in debugView
Claus Gittinger <cg@exept.de>
parents: 2052
diff changeset
  1313
                             type:#unmapped).
59a52789086a fixed (I hope) redraw bug in debugView
Claus Gittinger <cg@exept.de>
parents: 2052
diff changeset
  1314
59a52789086a fixed (I hope) redraw bug in debugView
Claus Gittinger <cg@exept.de>
parents: 2052
diff changeset
  1315
    "Modified: / 16.2.1998 / 13:20:37 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1316
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1317
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1318
!WindowSensor methodsFor:'event processing - private'!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1319
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1320
button:button inView:aView state:onOrOff
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1321
    "update the state of the xxxButtonDown flags"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1322
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1323
    |physicalButton|
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1324
743
64c9b71b3cc4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 708
diff changeset
  1325
    physicalButton := aView graphicsDevice buttonTranslation keyAtValue:button ifAbsent:button.
1084
9c433066e960 oops - leftover debugPrint
Claus Gittinger <cg@exept.de>
parents: 1083
diff changeset
  1326
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1327
    (physicalButton == 1) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1328
	leftButtonDown := onOrOff.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1329
	^ self
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1330
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1331
    (physicalButton == 2) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1332
	middleButtonDown := onOrOff.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1333
	^ self
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1334
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1335
    (physicalButton == 3) ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1336
	rightButtonDown := onOrOff.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1337
	^ self
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1338
    ].
743
64c9b71b3cc4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 708
diff changeset
  1339
1084
9c433066e960 oops - leftover debugPrint
Claus Gittinger <cg@exept.de>
parents: 1083
diff changeset
  1340
    "Modified: 21.10.1996 / 11:47:35 / cg"
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1341
!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1342
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1343
compose:key1 with:key2
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1344
    "compose a 2-character sequence into a composed key"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1345
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1346
    ComposeTable do:[:entry |
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1347
	|v|
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1348
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1349
	((key1 == (entry at:1)) and:[key2 == (entry at:2)]) ifTrue:[
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1350
	    v := entry at:3.
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1351
	    v isCharacter ifFalse:[v := Character value:v].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1352
	    ^ v
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1353
	]
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1354
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1355
    "/
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1356
    "/ for illegal sequence, return 2nd key
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1357
    "/
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1358
"/ key1 print. ' ' print. key2 printNL.
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1359
    ^ key2
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1360
!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1361
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1362
isModifierKey:key
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1363
    "return true if key is a modifier (Alt, Shift, Ctrl or Meta)"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1364
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1365
    (key == #Shift
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1366
    or:[key == #'Shift_R' 
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1367
    or:[key == #'Shift_L']]) ifTrue:[
2262
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1368
        ^ true
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1369
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1370
    (key == #Alt
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1371
    or:[key == #'Alt_R' or:[key == #'Alt_L']])  ifTrue:[
2262
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1372
        ^ true
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1373
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1374
    (key == #Meta
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1375
    or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
2262
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1376
        ^ true
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1377
    ].
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1378
    (key == #Ctrl
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1379
    or:[key == #'Ctrl_R' or:[key == #'Ctrl_L']]) ifTrue:[
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1380
        ^ true
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1381
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1382
    (key == #Control
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1383
    or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
2262
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1384
        ^ true
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1385
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1386
    ^ false
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1387
2262
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1388
    "Modified: / 22.8.1998 / 02:33:46 / cg"
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1389
!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1390
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1391
key:key state:onOrOff
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1392
    "update the state of the shiftDown/metaDown and ctrlDown
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1393
     flags"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1394
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1395
    (key = #Shift
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1396
    or:[key = #'Shift_R' 
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1397
    or:[key = #'Shift_L']]) ifTrue:[
2262
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1398
        shiftDown := onOrOff.
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1399
        ^ self
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1400
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1401
    (key = #Alt
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1402
    or:[key = #'Alt_R' or:[key = #'Alt_L']])  ifTrue:[
2262
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1403
        altDown := onOrOff.
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1404
        ^ self
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1405
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1406
    (key = #Meta
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1407
    or:[key = #'Meta_R' or:[key = #'Meta_L']]) ifTrue:[
2262
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1408
        metaDown := onOrOff.
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1409
        ^ self
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1410
    ].
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1411
    (key = #Ctrl
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1412
    or:[key = #'Ctrl_R' or:[key = #'Ctrl_L']]) ifTrue:[
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1413
        ctrlDown := onOrOff.
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1414
        ^ self
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1415
    ].
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1416
    (key = #Control
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1417
    or:[key = #'Control_R' or:[key = #'Control_L']]) ifTrue:[
2262
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1418
        ctrlDown := onOrOff.
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1419
        ^ self
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1420
    ].
2262
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1421
c97df93c1781 Ctrl is handled like Control (WinWorkstation bug workaround)
Claus Gittinger <cg@exept.de>
parents: 2177
diff changeset
  1422
    "Modified: / 22.8.1998 / 02:33:04 / cg"
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1423
!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1424
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  1425
notifyEventArrival:aView
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1426
    "an event arrived - if there is an eventSemaphore,
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1427
     signal it, to wake up any windowGroup process"
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1428
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1429
    (catchExpose includesIdentical:aView) ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1430
        "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1431
         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
  1432
         but remember arrival of something.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1433
        "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1434
        gotOtherEvent add:aView.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1435
        ^ self
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1436
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1437
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1438
    eventSemaphore notNil ifTrue:[
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1439
"/        eventSemaphore signal
1184
1372bad824af single trigger on the eventSemaphore is ok
Claus Gittinger <cg@exept.de>
parents: 1179
diff changeset
  1440
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1441
        "/ can get along with a single trigger;
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1442
        "/ because processEvents will read all events
1184
1372bad824af single trigger on the eventSemaphore is ok
Claus Gittinger <cg@exept.de>
parents: 1179
diff changeset
  1443
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1444
        eventSemaphore signalOnce
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1445
    ]
1184
1372bad824af single trigger on the eventSemaphore is ok
Claus Gittinger <cg@exept.de>
parents: 1179
diff changeset
  1446
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1447
    "Modified: 8.2.1997 / 12:01:48 / cg"
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1448
!
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1449
2312
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1450
updateModifierStateFrom:stateIn device:aDevice
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1451
    "this updates the modifier key-states.
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1452
     Called privately when pointer enters a view."
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1453
2312
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1454
    |state|
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1455
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1456
    "/ Prevents wrong behavior in the following scenario:
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1457
    "/    ctrl is pressed in a view
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1458
    "/    pointer is moved out of view
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1459
    "/    ctrl is released
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1460
    "/    pointer moved back into view
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1461
    "/    popup-menu still thinks that ctrl is pressed"
2312
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1462
    "/ state := aDevice buttonStates.
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1463
    state := stateIn.
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1464
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1465
    shiftDown := (state bitAnd:(aDevice shiftMask)) ~~ 0.
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1466
    ctrlDown := (state bitAnd:(aDevice controlMask)) ~~ 0.
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1467
    metaDown := (state bitAnd:(aDevice metaModifierMask)) ~~ 0.
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1468
    altDown := (state bitAnd:(aDevice altModifierMask)) ~~ 0.
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1469
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1470
    leftButtonDown := (state bitAnd:(aDevice leftButtonStateMask)) ~~ 0.
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1471
    middleButtonDown := (state bitAnd:(aDevice middleButtonStateMask)) ~~ 0.
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1472
    rightButtonDown := (state bitAnd:(aDevice rightButtonStateMask)) ~~ 0.
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1473
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1474
    "Created: / 27.2.1996 / 14:54:38 / cg"
0ec069be9679 mhmh - allButtonStates query is very slow sometimes;
Claus Gittinger <cg@exept.de>
parents: 2262
diff changeset
  1475
    "Modified: / 8.9.1998 / 15:11:44 / cg"
581
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1476
! !
23dc2352dce9 commentary
Claus Gittinger <cg@exept.de>
parents: 547
diff changeset
  1477
140
claus
parents: 133
diff changeset
  1478
!WindowSensor methodsFor:'event queue'!
claus
parents: 133
diff changeset
  1479
144
claus
parents: 140
diff changeset
  1480
addDamage:aRectangle view:aView
1318
5810dfc3137a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1317
diff changeset
  1481
    "{ Pragma: +optSpeed }"
5810dfc3137a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1317
diff changeset
  1482
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1483
    "Add aRectangle to the damage list.
144
claus
parents: 140
diff changeset
  1484
     Try to merge incoming rectangles with the existing damage rectangles.
claus
parents: 140
diff changeset
  1485
     Incoming rectangles which are completely contained in any existing damage rect are ignored,
claus
parents: 140
diff changeset
  1486
     any existing damage rectangle which is completely contained in the incoming rectangle
152
claus
parents: 144
diff changeset
  1487
     is replaced. Also, rectangles are merged into bigger ones, if they join exactly.
144
claus
parents: 140
diff changeset
  1488
     Except for special cases (moveOpaque of a view over one of my views),
claus
parents: 140
diff changeset
  1489
     these optimizations are not noticable."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1490
751
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1491
    ^ self addDamage:aRectangle view:aView wakeup:true
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1492
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1493
    "Modified: 28.5.1996 / 21:52:47 / cg"
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1494
!
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1495
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1496
addDamage:aRectangle view:aView wakeup:doWakeup
1317
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
  1497
    "{ Pragma: +optSpeed }"
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
  1498
751
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1499
    "Add aRectangle to the damage list.
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1500
     Try to merge incoming rectangles with the existing damage rectangles.
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1501
     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
  1502
     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
  1503
     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
  1504
     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
  1505
     these optimizations are not noticable.
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1506
     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
  1507
     was optimized away."
751
043bbbd431e6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1508
1492
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1509
    |ret|
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1510
1492
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1511
    ret := false.
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1512
    self criticalDamageEventQueueAccess:[
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1513
        (self basicAddDamage:aRectangle view:aView)
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1514
        ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1515
            doWakeup ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1516
                self notifyEventArrival:aView.
1492
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1517
                ret := true
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1518
            ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1519
        ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1520
    ].
1492
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1521
    ^ ret
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1522
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1523
    "Created: / 28.5.1996 / 21:51:16 / cg"
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1524
    "Modified: / 6.6.1998 / 21:09:06 / cg"
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1525
!
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1526
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1527
basicAddDamage:aRectangle view:aView
1317
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
  1528
    "{ Pragma: +optSpeed }"
e1bd3b4aee72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1312
diff changeset
  1529
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1530
    "Add aRectangle to the damage list.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1531
     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
  1532
     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
  1533
     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
  1534
     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
  1535
     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
  1536
     these optimizations are not noticable.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1537
     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
  1538
     was optimized away."
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1539
1616
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1540
    |temp index newEvent r fullRedraw
2035
637bb684af6a fixed ca's damage compression
Claus Gittinger <cg@exept.de>
parents: 2022
diff changeset
  1541
     aDamage ev2 dRect stopSearch
152
claus
parents: 144
diff changeset
  1542
     count             "{ Class: SmallInteger }" 
claus
parents: 144
diff changeset
  1543
     sz                "{ Class: SmallInteger }" 
1852
27b0cefc31a4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1851
diff changeset
  1544
     firstInteresting
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1545
     lastInteresting   "{ Class: SmallInteger }"
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1546
     idx "{ Class: SmallInteger }"
1616
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1547
     rL "{ Class: SmallInteger }"
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1548
     rT "{ Class: SmallInteger }"
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1549
     rB "{ Class: SmallInteger }"
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1550
     rR "{ Class: SmallInteger }"
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1551
     dL "{ Class: SmallInteger }"
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1552
     dR "{ Class: SmallInteger }"
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1553
     dT "{ Class: SmallInteger }"
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1554
     dB "{ Class: SmallInteger }"
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1555
     minX "{ Class: SmallInteger }"
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1556
     minY "{ Class: SmallInteger }"
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1557
     maxX "{ Class: SmallInteger }"
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1558
     maxY "{ Class: SmallInteger }"
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1559
     t    "{ Class: SmallInteger }"|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1560
152
claus
parents: 144
diff changeset
  1561
    r := aRectangle.
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1562
    (fullRedraw := aView redrawsFull) ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1563
        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
  1564
    ].
97f384f5e2aa views which always redraw full may say so in #redrawsFull
Claus Gittinger <cg@exept.de>
parents: 476
diff changeset
  1565
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1566
    sz := damage size.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1567
    sz == 0 ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1568
        damage := OrderedCollection new:10.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1569
    ] ifFalse:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1570
        "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1571
         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
  1572
         if so, dont add to queue
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1573
         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
  1574
        "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1575
        fullRedraw ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1576
            firstInteresting := 1.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1577
            lastInteresting := sz.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1578
        ] ifFalse:[
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1579
            count := 0.
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1580
            firstInteresting := nil.
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1581
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1582
            "/ must search backward, break search with first
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1583
            "/ non-Expose (i.e. mapped/unmapped)
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1584
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1585
            stopSearch := false.
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1586
            idx := sz.
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1587
            [(idx > 0) and:[stopSearch not]] whileTrue:[
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1588
                aDamage := damage at:idx.
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1589
                aDamage notNil ifTrue:[
2035
637bb684af6a fixed ca's damage compression
Claus Gittinger <cg@exept.de>
parents: 2022
diff changeset
  1590
                    aDamage view == aView ifTrue:[
637bb684af6a fixed ca's damage compression
Claus Gittinger <cg@exept.de>
parents: 2022
diff changeset
  1591
                        aDamage isDamage ifTrue:[
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1592
                            ((aDamage rectangle) contains:r) ifTrue:[
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1593
                                ^ false
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1594
                            ].
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1595
                            count := count + 1.
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1596
                            lastInteresting := idx.
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1597
                            firstInteresting isNil ifTrue:[
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1598
                                firstInteresting := idx
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1599
                            ]
2035
637bb684af6a fixed ca's damage compression
Claus Gittinger <cg@exept.de>
parents: 2022
diff changeset
  1600
                        ] ifFalse:[
637bb684af6a fixed ca's damage compression
Claus Gittinger <cg@exept.de>
parents: 2022
diff changeset
  1601
                            "/ if its a map/unmap, we can forget 
637bb684af6a fixed ca's damage compression
Claus Gittinger <cg@exept.de>
parents: 2022
diff changeset
  1602
                            "/ any older damage event for this view ...
637bb684af6a fixed ca's damage compression
Claus Gittinger <cg@exept.de>
parents: 2022
diff changeset
  1603
                            (aDamage isUnmapEvent or:[aDamage isMapEvent]) ifTrue:[
2072
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1604
                                idx := idx - 1.
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1605
                                [idx > 0] whileTrue:[
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1606
                                    ev2 := damage at:idx.
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1607
                                    ev2 notNil ifTrue:[
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1608
                                        ev2 isDamage ifTrue:[
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1609
                                            ev2 view == aView ifTrue:[
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1610
                                                damage at:idx put:nil
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1611
                                            ]
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1612
                                        ]
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1613
                                    ].
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1614
                                    idx := idx - 1.
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1615
                                ].
2035
637bb684af6a fixed ca's damage compression
Claus Gittinger <cg@exept.de>
parents: 2022
diff changeset
  1616
                                stopSearch := true
637bb684af6a fixed ca's damage compression
Claus Gittinger <cg@exept.de>
parents: 2022
diff changeset
  1617
                            ].
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1618
                        ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1619
                    ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1620
                ].
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1621
                idx := idx - 1.
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1622
            ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1623
        ].
46
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
  1624
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1625
        "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1626
         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
  1627
        "
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1628
        firstInteresting notNil ifTrue:[
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1629
            "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1630
             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
  1631
             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
  1632
             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
  1633
             due to the square runtime behavior (stupid algorithm ...)
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1634
            "
2022
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
  1635
            (fullRedraw or:[count > 10]) ifTrue:[
1616
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1636
                minX := r left. minY := r top.
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1637
                maxX := r right. maxY := r bottom.
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1638
                firstInteresting to:lastInteresting by:-1 do:[:i |
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1639
                    aDamage := damage at:i.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1640
                    aDamage notNil ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1641
                        aDamage isDamage ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1642
                            (aDamage view) == aView ifTrue:[
1616
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1643
                                dRect := aDamage rectangle.
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1644
                                (t := dRect left) < minX ifTrue:[minX := t].
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1645
                                (t := dRect top) < minY ifTrue:[minY := t].
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1646
                                (t := dRect right) > maxX ifTrue:[maxX := t].
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1647
                                (t := dRect bottom) > maxY ifTrue:[maxY := t].
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1648
                                damage at:i put:nil.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1649
                            ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1650
                        ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1651
                    ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1652
                ].
1616
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1653
                newEvent := WindowEvent 
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1654
                                damageFor:aView 
4d78d9d9f474 better rectangle merge
Claus Gittinger <cg@exept.de>
parents: 1589
diff changeset
  1655
                                rectangle:(minX@minY corner:maxX@maxY).
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1656
                damage add:newEvent.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1657
                ^ true
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1658
            ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1659
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1660
            "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1661
             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
  1662
             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
  1663
             Or, merge it with existing rectangles if possible.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1664
            "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1665
            count := 0.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1666
            rR := r right.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1667
            rL := r left.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1668
            rT := r top.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1669
            rB := r bottom.
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1670
            firstInteresting to:lastInteresting by:-1 do:[:i |
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1671
                aDamage := damage at:i.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1672
                aDamage notNil ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1673
                    aDamage isDamage ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1674
                        (aDamage view) == aView ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1675
                            dRect := aDamage rectangle.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1676
                            (r contains:dRect) ifTrue: [ 
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1677
                                damage at:i put:nil.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1678
                                count := count + 1
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1679
                            ] ifFalse:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1680
                                dL := dRect left.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1681
                                dT := dRect top.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1682
                                dR := dRect right.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1683
                                dB := dRect bottom.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1684
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1685
                                (rT == dT
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1686
                                and:[rB == dB]) ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1687
                                    (rR > dR) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1688
                                        (rL <= (dR + 1)) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1689
                                            dRect right:rR.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1690
                                            ^ false
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1691
                                        ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1692
                                    ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1693
                                    (rL < dL) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1694
                                        (rR >= (dL  - 1)) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1695
                                            dRect left:rL.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1696
                                            ^ false
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1697
                                        ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1698
                                    ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1699
                                ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1700
                                (rR == dR
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1701
                                and:[rL == dL]) ifTrue:[
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1702
                                    (rB > dB) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1703
                                        (rT <= (dB + 1)) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1704
                                            dRect bottom:rB.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1705
                                            ^ false
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1706
                                        ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1707
                                    ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1708
                                    (rT < dT) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1709
                                        (rB >= (dT - 1)) ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1710
                                            dRect top:rT.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1711
                                            ^ false
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1712
                                        ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1713
                                    ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1714
                                ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1715
                            ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1716
                        ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1717
                    ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1718
                ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1719
            ].
152
claus
parents: 144
diff changeset
  1720
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1721
"/            "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1722
"/             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
  1723
"/             (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
  1724
"/              reorganization of the input queue)
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1725
"/            "
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1726
"/            count > 20 ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1727
"/                temp := OrderedCollection new:(sz - count + 1).
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1728
"/                index := 1.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1729
"/                1 to:sz do:[:idx |
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1730
"/                    aDamage := damage at:idx.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1731
"/                    aDamage notNil ifTrue: [
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1732
"/                        temp add:aDamage.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1733
"/                    ]
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1734
"/                ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1735
"/                damage := temp
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1736
"/            ].
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1737
        ].
46
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
  1738
    ].
7b331e9012fd *** empty log message ***
claus
parents: 28
diff changeset
  1739
1312
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1740
    newEvent := WindowEvent damageFor:aView rectangle:r.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1741
    damage add:newEvent.
92570edec99c try again with single wakeUp (#signalIf);
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1742
144
claus
parents: 140
diff changeset
  1743
    ^ true
488
97f384f5e2aa views which always redraw full may say so in #redrawsFull
Claus Gittinger <cg@exept.de>
parents: 476
diff changeset
  1744
2022
90d1cebc9a92 fixed compressKeyFor:
Claus Gittinger <cg@exept.de>
parents: 1969
diff changeset
  1745
    "Created: / 8.2.1997 / 12:07:06 / cg"
2072
a9770eb53908 reenabled flushing of expose events before map/unmap event.
Claus Gittinger <cg@exept.de>
parents: 2058
diff changeset
  1746
    "Modified: / 27.2.1998 / 01:49:06 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1747
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1748
428
33156201125b added #hasConfigureEvent
werner
parents: 386
diff changeset
  1749
damage
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1750
    "return the damage event list"
428
33156201125b added #hasConfigureEvent
werner
parents: 386
diff changeset
  1751
33156201125b added #hasConfigureEvent
werner
parents: 386
diff changeset
  1752
    ^ damage.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1753
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1754
    "Modified: 18.1.1997 / 14:11:08 / cg"
428
33156201125b added #hasConfigureEvent
werner
parents: 386
diff changeset
  1755
!
33156201125b added #hasConfigureEvent
werner
parents: 386
diff changeset
  1756
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1757
nextDamage
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1758
    "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
  1759
     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
  1760
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1761
    |d|
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1762
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1763
    damage size == 0 ifTrue:[^ nil].
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1764
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1765
    "
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1766
     be careful: events are inserted at higher prio ...
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1767
    "
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1768
    self criticalDamageEventQueueAccess:[
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1769
        |foundOne|
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1770
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1771
        foundOne := false.
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1772
        [foundOne] whileFalse:[
1492
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1773
            damage size == 0 ifTrue:[
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1774
                foundOne := true
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1775
            ] ifFalse:[
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1776
                d := damage removeFirst.
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1777
                foundOne := d notNil.
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1778
            ]
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1779
        ]
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1780
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1781
    ^ d
476
cc4848695a66 care to reenable interrupts
Claus Gittinger <cg@exept.de>
parents: 470
diff changeset
  1782
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1783
    "Modified: / 6.6.1998 / 21:10:27 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1784
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1785
2408
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1786
nextDamageEventFor:aViewOrNil
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1787
    "retrieve the next damage event for aView (or any view if nil).
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1788
     Return if there are no damage events.
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1789
     Remove it from the queue."
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1790
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1791
    |theEvent|
2431
4304b047a42f oops - damage queue grew over time (slowing down event handling)
Claus Gittinger <cg@exept.de>
parents: 2429
diff changeset
  1792
2408
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1793
    damage size == 0 ifTrue:[^ nil].
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1794
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1795
    "
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1796
     be careful: events are inserted at higher prio ...
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1797
    "
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1798
    self criticalDamageEventQueueAccess:[
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1799
        |anEvent idx damageSize firstNonNilIndex|
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1800
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1801
        idx := 1.
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1802
        damageSize := damage size.
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1803
        [idx <= damageSize] whileTrue:[
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1804
            anEvent := damage at:idx.
2408
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1805
            anEvent notNil ifTrue:[
2431
4304b047a42f oops - damage queue grew over time (slowing down event handling)
Claus Gittinger <cg@exept.de>
parents: 2429
diff changeset
  1806
                firstNonNilIndex isNil ifTrue:[
4304b047a42f oops - damage queue grew over time (slowing down event handling)
Claus Gittinger <cg@exept.de>
parents: 2429
diff changeset
  1807
                    firstNonNilIndex := idx
4304b047a42f oops - damage queue grew over time (slowing down event handling)
Claus Gittinger <cg@exept.de>
parents: 2429
diff changeset
  1808
                ].
2408
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1809
                (aViewOrNil isNil or:[anEvent view == aViewOrNil]) ifTrue:[
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1810
                    damage at:idx put:nil.
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1811
                    theEvent := anEvent.
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1812
                    idx := damageSize.
2408
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1813
                ].
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1814
            ].
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1815
            idx := idx + 1.
2431
4304b047a42f oops - damage queue grew over time (slowing down event handling)
Claus Gittinger <cg@exept.de>
parents: 2429
diff changeset
  1816
        ].
2439
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
  1817
        firstNonNilIndex isNil ifTrue:[
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
  1818
            damage removeAll
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
  1819
        ] ifFalse:[
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
  1820
            firstNonNilIndex ~~ 1 ifTrue:[
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
  1821
                damage removeFromIndex:1 toIndex:firstNonNilIndex
2431
4304b047a42f oops - damage queue grew over time (slowing down event handling)
Claus Gittinger <cg@exept.de>
parents: 2429
diff changeset
  1822
            ]
2408
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1823
        ]
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1824
    ].
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1825
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1826
    ^ theEvent
2408
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1827
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1828
    "Created: / 3.12.1998 / 13:41:49 / cg"
2439
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
  1829
    "Modified: / 5.2.1999 / 20:58:20 / cg"
2408
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1830
!
dd4371ba92e1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
  1831
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1832
nextEvent
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1833
    "retrieve the next event or nil, if there is none.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1834
     Remove it from the queue."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1835
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1836
    |e|
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1837
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1838
    mouseAndKeyboard size == 0 ifTrue:[^ nil].
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1839
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1840
    "
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1841
     be careful: events are inserted at higher prio ...
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1842
    "
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1843
    self criticalUserEventQueueAccess:[
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1844
        |foundOne|
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1845
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1846
        foundOne := false.
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1847
        [foundOne] whileFalse:[
1492
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1848
            mouseAndKeyboard size == 0 ifTrue:[
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1849
                foundOne := true
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1850
            ] ifFalse:[
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1851
                e := mouseAndKeyboard removeFirst.
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1852
                foundOne := e notNil.
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1853
            ]
cb0118ee73e3 avoid returning from critical-blocks (avoid mkrealcontext calls)
Claus Gittinger <cg@exept.de>
parents: 1412
diff changeset
  1854
        ]
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1855
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1856
    ^ e
476
cc4848695a66 care to reenable interrupts
Claus Gittinger <cg@exept.de>
parents: 470
diff changeset
  1857
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1858
    "Modified: / 6.6.1998 / 21:10:39 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1859
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1860
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1861
nextExposeEventFor:aView
1806
16c958be35d8 fixed no-deviceID error with destroy arriving while waiting for
Claus Gittinger <cg@exept.de>
parents: 1791
diff changeset
  1862
    "retrieve the next expose event for aView (or any view if nil).
16c958be35d8 fixed no-deviceID error with destroy arriving while waiting for
Claus Gittinger <cg@exept.de>
parents: 1791
diff changeset
  1863
     Return if there are no expose events.
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1864
     Remove it from the queue."
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1865
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1866
    |theEvent|
2432
d4daad924fbf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
  1867
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1868
    damage size == 0 ifTrue:[^ nil].
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1869
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1870
    "
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1871
     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
  1872
    "
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1873
    self criticalDamageEventQueueAccess:[
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1874
        |firstNonNilIndex anEvent idx damageSize|
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1875
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1876
        idx := 1.
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1877
        damageSize := damage size.
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1878
        [idx <= damageSize] whileTrue:[
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1879
            anEvent := damage at:idx.
1806
16c958be35d8 fixed no-deviceID error with destroy arriving while waiting for
Claus Gittinger <cg@exept.de>
parents: 1791
diff changeset
  1880
            anEvent notNil ifTrue:[
2432
d4daad924fbf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
  1881
                firstNonNilIndex isNil ifTrue:[
d4daad924fbf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
  1882
                    firstNonNilIndex := idx
d4daad924fbf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
  1883
                ].
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1884
                
1806
16c958be35d8 fixed no-deviceID error with destroy arriving while waiting for
Claus Gittinger <cg@exept.de>
parents: 1791
diff changeset
  1885
                anEvent isDamage ifTrue:[
16c958be35d8 fixed no-deviceID error with destroy arriving while waiting for
Claus Gittinger <cg@exept.de>
parents: 1791
diff changeset
  1886
                    (aView isNil or:[anEvent view == aView]) ifTrue:[
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1887
                        theEvent := anEvent.
1806
16c958be35d8 fixed no-deviceID error with destroy arriving while waiting for
Claus Gittinger <cg@exept.de>
parents: 1791
diff changeset
  1888
                        damage at:idx put:nil.
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1889
                        idx := damageSize.
1806
16c958be35d8 fixed no-deviceID error with destroy arriving while waiting for
Claus Gittinger <cg@exept.de>
parents: 1791
diff changeset
  1890
                    ]
16c958be35d8 fixed no-deviceID error with destroy arriving while waiting for
Claus Gittinger <cg@exept.de>
parents: 1791
diff changeset
  1891
                ].
16c958be35d8 fixed no-deviceID error with destroy arriving while waiting for
Claus Gittinger <cg@exept.de>
parents: 1791
diff changeset
  1892
            ].
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1893
            idx := idx + 1.
2432
d4daad924fbf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
  1894
        ].
d4daad924fbf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
  1895
2439
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
  1896
        firstNonNilIndex isNil ifTrue:[
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
  1897
            damage removeAll
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
  1898
        ] ifFalse:[
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
  1899
            firstNonNilIndex ~~ 1 ifTrue:[
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
  1900
                damage removeFromIndex:1 toIndex:firstNonNilIndex-1
2432
d4daad924fbf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
  1901
            ]
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1902
        ].
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1903
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1904
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1905
    ^ theEvent
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1906
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1907
    "Created: / 21.5.1996 / 17:20:54 / cg"
2439
358644786358 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2437
diff changeset
  1908
    "Modified: / 5.2.1999 / 20:58:28 / cg"
703
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1909
!
4324ab5e3630 added facility to lock expose event queue (temporary kludge ?)
Claus Gittinger <cg@exept.de>
parents: 612
diff changeset
  1910
140
claus
parents: 133
diff changeset
  1911
pendingEvent
152
claus
parents: 144
diff changeset
  1912
    "retrieve the next pending user (i.e. non-damage) event.
claus
parents: 144
diff changeset
  1913
     Return nil, if there is none pending.
140
claus
parents: 133
diff changeset
  1914
     Do not remove it from the queue."
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
  1915
1063
ba1bf8091bc1 unused variable cleanup
Claus Gittinger <cg@exept.de>
parents: 1027
diff changeset
  1916
    |e|
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
  1917
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1918
    mouseAndKeyboard size == 0 ifTrue:[^ nil].
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1919
2437
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1920
    "
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1921
     be careful: events are inserted at higher prio ...
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1922
    "
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1923
    self criticalUserEventQueueAccess:[
2058aceaed41 tuning - do not return from a valueOnOnWindDo block if possible.
Claus Gittinger <cg@exept.de>
parents: 2432
diff changeset
  1924
        [e isNil] whileTrue:[
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1925
            mouseAndKeyboard size == 0 ifTrue:[^ nil].
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1926
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1927
            e := mouseAndKeyboard first.
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1928
            e isNil ifTrue:[
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1929
                mouseAndKeyboard removeFirst
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1930
            ].
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1931
        ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1932
    ].
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
  1933
    ^ e
476
cc4848695a66 care to reenable interrupts
Claus Gittinger <cg@exept.de>
parents: 470
diff changeset
  1934
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1935
    "Modified: / 6.6.1998 / 21:10:51 / cg"
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1936
!
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1937
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1938
pushDamageEvent:anEvent
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1939
    "put an event into the damage queue
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1940
     - this is not meant for public use"
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1941
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1942
    self criticalDamageEventQueueAccess:[
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1943
        damage addLast:anEvent.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1944
    ].
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1945
    self notifyEventArrival:anEvent view
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1946
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1947
    "Created: / 18.1.1997 / 14:16:45 / cg"
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1948
    "Modified: / 6.6.1998 / 21:10:56 / cg"
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1949
!
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1950
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1951
pushEvent:anEvent
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1952
    "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
  1953
     applications and allows simulation of events 
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1954
     (implementation of recorders & playback)
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1955
     or asynchronous communication between view applications
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1956
     (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
  1957
      when the target windowGroups process is rescheduled)."
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1958
1412
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
  1959
    |v|
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
  1960
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
  1961
    v := anEvent view.
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1962
    self criticalUserEventQueueAccess:[
1412
c2553d477315 handle #quit event (ST-80 support)
Claus Gittinger <cg@exept.de>
parents: 1359
diff changeset
  1963
        mouseAndKeyboard addLast:anEvent.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1964
    ].
1851
6a6225647696 fixes for expose-event-lost after re-map
Claus Gittinger <cg@exept.de>
parents: 1847
diff changeset
  1965
    self notifyEventArrival:v
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1966
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  1967
    "Created: / 18.9.1995 / 22:37:57 / claus"
2157
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  1968
    "Modified: / 18.6.1998 / 09:27:56 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1969
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1970
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1971
!WindowSensor methodsFor:'event simulation'!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1972
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1973
forwardKeyEventsTo:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1974
    "remove all keyboard events and send them to aViews sensor instead"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1975
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1976
    1 to:mouseAndKeyboard size do:[:i |
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1977
	|anEvent|
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1978
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1979
	anEvent := mouseAndKeyboard at:i.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1980
	anEvent notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1981
	    anEvent isKeyEvent ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1982
		anEvent view:aView.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1983
		aView sensor pushEvent:anEvent.
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1984
		mouseAndKeyboard at:i put:nil
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1985
	    ]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  1986
	]
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1987
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1988
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  1989
    "Modified: 18.1.1997 / 14:05:02 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1990
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1991
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1992
pushUserEvent:aSelector for:aView
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1993
    "manually put an event into the queue - this allows
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1994
     simulation of events (implementation of recorders & playback)
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1995
     or asynchronous communication between view applications.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1996
     The view will perform a method as specified by aSelector,
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1997
     when it performs event processing; this is different than sending
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1998
     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
  1999
     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
  2000
     shows a modal box or similar)."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2001
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2002
     self pushUserEvent:aSelector for:aView withArguments:#() 
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2003
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2004
    "Modified: 18.9.1995 / 22:40:12 / claus"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2005
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2006
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2007
pushUserEvent:aSelector for:aView withArguments:arguments
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2008
    "manually put an event into the queue - this allows
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2009
     simulation of events (implementation of recorders & playback)
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2010
     or asynchronous communication between view applications.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2011
     The view will perform a method as specified by aSelector,
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2012
     when it performs event processing; this is different than sending
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2013
     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
  2014
     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
  2015
     shows a modal box or similar)."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2016
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2017
    self pushEvent:(WindowEvent 
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2018
		     for:aView
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2019
		     type:aSelector
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2020
		     arguments:arguments).
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2021
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2022
    "
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2023
     |b|
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2024
     b := Button label:'test'.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2025
     b open.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2026
     (Delay forSeconds:5) wait.
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2027
     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
  2028
     (Delay forSeconds:1) wait.
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2029
     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
  2030
     (Delay forSeconds:2) wait.
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2031
     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
  2032
     (Delay forSeconds:1) wait.
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2033
     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
  2034
    "
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2035
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2036
    "
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2037
     |b|
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2038
     b := Button label:'test'.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2039
     b open.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2040
     (Delay forSeconds:5) wait.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2041
     b sensor pushUserEvent:#fooBar for:b withArguments:#().
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2042
    "
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2043
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2044
    "
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2045
     |b|
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2046
     b := Button label:'test'.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2047
     b open.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2048
     (Delay forSeconds:3) wait.
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2049
     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
  2050
    "
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2051
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2052
    "Modified: 4.1.1997 / 13:53:01 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2053
! !
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2054
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2055
!WindowSensor methodsFor:'initialization'!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2056
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2057
initialize
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2058
    "initialize the event queues to empty"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2059
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  2060
    damageEventAccessLock := Semaphore forMutualExclusion.
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  2061
    damageEventAccessLock name:'WSensor ev-q damageEventAccessLock'.
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  2062
    userEventAccessLock := Semaphore forMutualExclusion.
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  2063
    userEventAccessLock name:'WSensor ev-q userEventAccessLock'.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2064
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2065
    damage := OrderedCollection new.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2066
    mouseAndKeyboard := OrderedCollection new.
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2067
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2068
    gotExpose := IdentitySet new.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2069
    catchExpose := IdentitySet new.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2070
    gotOtherEvent := IdentitySet new.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2071
    exposeEventSemaphore := Semaphore new name:'WSensor exposeSema'.
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2072
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2073
    compressMotionEvents := translateKeyboardEvents := true.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2074
    ignoreUserInput := false.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2075
    shiftDown := ctrlDown := altDown := metaDown := false.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2076
    leftButtonDown := middleButtonDown := rightButtonDown := false.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2077
2137
cec979de294c now use two semaphores (one for each queue).
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
  2078
    "Modified: / 6.6.1998 / 21:14:49 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2079
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2080
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2081
reinitialize
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2082
    "called when an image is restarted;
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2083
     reinitialize the event queues to empty; leave other setup as-is"
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2084
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2085
    self flushUserEvents.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2086
    self flushExposeEvents.
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2087
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2088
    gotExpose := IdentitySet new.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2089
    catchExpose := IdentitySet new.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2090
    gotOtherEvent := IdentitySet new.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2091
    exposeEventSemaphore := Semaphore new name:'WSensor exposeSema'.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2092
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2093
    shiftDown := ctrlDown := altDown := metaDown := false.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2094
    leftButtonDown := middleButtonDown := rightButtonDown := false.
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2095
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2096
    "Modified: 18.1.1997 / 15:30:23 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2097
! !
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2098
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2099
!WindowSensor methodsFor:'queries - event queue'!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2100
2085
908c3baa4a56 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  2101
damageCount 
908c3baa4a56 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  2102
    "return the number of pending damage events (i.e. expose or resize)"
908c3baa4a56 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  2103
908c3baa4a56 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  2104
    ^ damage size
908c3baa4a56 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  2105
908c3baa4a56 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  2106
    "Modified: / 2.4.1997 / 14:14:01 / cg"
908c3baa4a56 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  2107
    "Created: / 5.4.1998 / 11:35:04 / cg"
908c3baa4a56 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  2108
!
908c3baa4a56 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  2109
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2110
eventPending
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2111
    "return true, if either damage or events are pending"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2112
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2113
    mouseAndKeyboard size ~~ 0 ifTrue:[^ true].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2114
    ^ damage size ~~ 0
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2115
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2116
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2117
hasButtonEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2118
    "return true, if any button events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2119
     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
  2120
     view (i.e. is there a button event for any of my views);
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2121
     otherwise, the information is regarding that specific view."
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2122
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2123
    (self hasButtonMotionEventFor:aView) ifTrue:[^ true].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2124
    (self hasButtonPressEventFor:aView) ifTrue:[^ true].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2125
    ^ (self hasButtonReleaseEventFor:aView)
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2126
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2127
    "Created: 1.11.1996 / 17:02:23 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2128
    "Modified: 1.11.1996 / 17:12:03 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2129
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2130
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2131
hasButtonMotionEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2132
    "return true, if any buttonMotion events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2133
     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
  2134
     view (i.e. is there a motion event for any of my views);
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2135
     otherwise, the information is regarding that specific view."
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2136
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2137
    ^ self hasEvent:#buttonMotion:x:y: orPendingDeviceEvent:#buttonMotion for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2138
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2139
    "Created: 1.11.1996 / 17:04:01 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2140
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2141
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2142
hasButtonPressEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2143
    "return true, if any buttonPress events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2144
     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
  2145
     view (i.e. is there a buttonPress event for any of my views);
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2146
     otherwise, the information is regarding that specific view."
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2147
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2148
    ^ self hasEvent:#buttonPress:x:y: orPendingDeviceEvent:#buttonPress for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2149
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2150
    "Created: 1.11.1996 / 17:05:10 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2151
    "Modified: 1.11.1996 / 17:11:09 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2152
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2153
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2154
hasButtonReleaseEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2155
    "return true, if any buttonRelease events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2156
     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
  2157
     view (i.e. is there a buttonrelease event for any of my views);
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2158
     otherwise, the information is regarding that specific view."
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2159
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2160
    ^ self hasEvent:#buttonRelease:x:y: orPendingDeviceEvent:#buttonRelease for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2161
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2162
    "Created: 1.11.1996 / 17:05:26 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2163
    "Modified: 1.11.1996 / 17:11:18 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2164
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2165
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2166
hasConfigureEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2167
    "return true, if any resize/position events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2168
     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
  2169
     view (i.e. is there a configure event for any of my views);
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2170
     otherwise, the information is regarding that specific view."
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2171
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2172
    ^ self hasEvent:#configureX:y:width:height: orPendingDeviceEvent:#structureNotify for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2173
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2174
    "Modified: 1.11.1996 / 17:11:27 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2175
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2176
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2177
hasDamage 
1512
489ff9d103a0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
  2178
    "return true, if any damage events (i.e. expose or resize) are pending.
489ff9d103a0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
  2179
     Since this is often invoked by ST-80 classes to poll the sensor,
489ff9d103a0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
  2180
     a yield is done here to avoid a busy wait blocking other processes."
489ff9d103a0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
  2181
489ff9d103a0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
  2182
    Processor yield.
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2183
    ^ damage size ~~ 0
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2184
1512
489ff9d103a0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
  2185
    "Modified: 2.4.1997 / 14:14:01 / cg"
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2186
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2187
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2188
hasDamageFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2189
    "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
  2190
     are pending for aView"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2191
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2192
    damage size ~~ 0 ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2193
	damage do:[:aDamage |
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2194
	    aDamage notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2195
		aDamage view == aView ifTrue:[^ true].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2196
	    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2197
	]
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2198
    ].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2199
    ^ false
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2200
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2201
    "Modified: 21.5.1996 / 17:15:09 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2202
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2203
2144
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2204
hasEvent:type for:aView
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2205
    "return true, if a specific event is pending in my queues.
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2206
     Type is the type of event, dType the corresponding device event.
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2207
     If the argument, aView is nil, the information is regarding any
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2208
     view (i.e. is there an event for any of my views);
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2209
     otherwise, the information is regarding to that specific view."
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2210
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2211
    mouseAndKeyboard size ~~ 0 ifTrue:[
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2212
        mouseAndKeyboard do:[:anEvent |
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2213
            anEvent notNil ifTrue:[
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2214
                (aView isNil or:[anEvent view == aView]) ifTrue:[
2157
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2215
                    (type isNil or:[anEvent type == type]) ifTrue:[^ true].
2144
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2216
                ]
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2217
            ].
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2218
        ]
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2219
    ].
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2220
    damage size ~~ 0 ifTrue:[
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2221
        damage do:[:anEvent |
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2222
            anEvent notNil ifTrue:[
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2223
                (aView isNil or:[anEvent view == aView]) ifTrue:[
2157
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2224
                    (type isNil or:[anEvent type == type]) ifTrue:[^ true].
2144
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2225
                ]
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2226
            ].
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2227
        ]
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2228
    ].
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2229
    ^ false
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2230
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2231
    "Created: / 10.6.1998 / 17:33:46 / cg"
2157
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2232
    "Modified: / 18.6.1998 / 09:29:18 / cg"
2144
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2233
!
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2234
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2235
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
  2236
    "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
  2237
     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
  2238
     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
  2239
     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
  2240
     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
  2241
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2242
    ^ self
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2243
        hasEvent:type 
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2244
        for:aView 
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2245
        withMatchingArguments:[:evArgs | evArgs = args]
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2246
!
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2247
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2248
hasEvent:type for:aView withMatchingArguments:argMatchBlock 
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2249
    "return true, if a matching event is pending in my queues.
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2250
     Type is the type of event, matchBlock is a block which gets the event args
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2251
     and should return true.
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2252
     If the argument, aView is nil, the information is regarding any
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2253
     view (i.e. is there an event for any of my views);
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2254
     otherwise, the information is regarding to that specific view."
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2255
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2256
    mouseAndKeyboard size ~~ 0 ifTrue:[
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2257
        mouseAndKeyboard do:[:anEvent |
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2258
            anEvent notNil ifTrue:[
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2259
                (aView isNil or:[anEvent view == aView]) ifTrue:[
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2260
                    anEvent type == type ifTrue:[
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2261
                        (argMatchBlock value:anEvent arguments) ifTrue:[
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2262
                            ^ true
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2263
                        ].
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2264
                    ]
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2265
                ]
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2266
            ].
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2267
        ]
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2268
    ].
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2269
    damage size ~~ 0 ifTrue:[
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2270
        damage do:[:anEvent |
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2271
            anEvent notNil ifTrue:[
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2272
                (aView isNil or:[anEvent view == aView]) ifTrue:[
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2273
                    anEvent type == type ifTrue:[
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2274
                        (argMatchBlock value:anEvent arguments) ifTrue:[
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2275
                            ^ true
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2276
                        ]
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2277
                    ].
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2278
                ]
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2279
            ].
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2280
        ]
1155
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2281
    ].
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2282
    ^ false
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2283
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2284
    "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
  2285
    "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
  2286
!
e8b6f0e8484e added query for event with args for view pending
Claus Gittinger <cg@exept.de>
parents: 1108
diff changeset
  2287
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2288
hasEvent:type orPendingDeviceEvent:dType for:aView
2144
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2289
    "return true, if a specific event is pending in a queue
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2290
     or in the devices event queue.
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2291
     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
  2292
     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
  2293
     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
  2294
     otherwise, the information is regarding to that specific view."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2295
2144
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2296
    "/ look in my queues
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2297
    (self hasEvent:type for:aView) ifTrue:[^ true].
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2298
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2299
    aView notNil ifTrue:[
2144
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2300
        "/ ask the device if it has something pending
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2301
        ^ aView graphicsDevice eventPending:dType for:aView id
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2302
    ].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2303
    ^ false
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2304
2144
c3bd3dfe592a another event pending query added
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  2305
    "Modified: / 10.6.1998 / 17:34:51 / cg"
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2306
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2307
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2308
hasEvents 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2309
    "return true, if any mouse/keyboard events are pending"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2310
2441
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2311
    mouseAndKeyboard size ~~ 0 ifTrue:[^ true].
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2312
    ^ damage size ~~ 0
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2313
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2314
    "Modified: / 5.2.1999 / 22:30:23 / cg"
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2315
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2316
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2317
hasExposeEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2318
    "return true, if any exposure events are pending for aView"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2319
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2320
    damage size ~~ 0 ifTrue:[
1271
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2321
	damage do:[:aDamage |
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2322
	    aDamage notNil ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2323
		aDamage isDamage ifTrue:[
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2324
		    (aView isNil
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2325
		     or:[aDamage view == aView]) ifTrue:[^ true].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2326
		]
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2327
	    ].
d0a46bba43af *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1270
diff changeset
  2328
	]
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2329
    ].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2330
    ^ false
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2331
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2332
    "Modified: 21.5.1996 / 17:13:09 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2333
    "Created: 1.11.1996 / 17:05:41 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2334
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2335
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2336
hasKeyEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2337
    "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
  2338
     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
  2339
     view (i.e. is there a key event for any of my views);
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2340
     otherwise, the information is regarding that specific view."
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2341
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2342
    (self hasKeyPressEventFor:aView) ifTrue:[^ true].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2343
    ^ self hasKeyReleaseEventFor:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2344
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2345
    "Created: 1.11.1996 / 17:08:03 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2346
    "Modified: 1.11.1996 / 17:11:55 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2347
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2348
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2349
hasKeyPressEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2350
    "return true, if any keyPress events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2351
     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
  2352
     view (i.e. is there a keyPress event for any of my views);
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2353
     otherwise, the information is regarding that specific view."
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2354
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2355
    ^ self hasEvent:#keyPress:x:y: orPendingDeviceEvent:#keyPress for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2356
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2357
    "Created: 1.11.1996 / 17:05:58 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2358
    "Modified: 1.11.1996 / 17:12:10 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2359
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2360
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2361
hasKeyReleaseEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2362
    "return true, if any keyRelease events are pending.
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2363
     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
  2364
     view (i.e. is there a keyRelease event for any of my views);
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2365
     otherwise, the information is regarding that specific view."
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2366
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2367
    ^ self hasEvent:#keyRelease:x:y: orPendingDeviceEvent:#keyRelease for:aView
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2368
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2369
    "Created: 1.11.1996 / 17:06:34 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2370
    "Modified: 1.11.1996 / 17:12:15 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2371
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2372
2157
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2373
hasUserEvent:type for:aView
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2374
    "return true, if a specific event is pending in my user event queue.
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2375
     Type is the type of event, dType the corresponding device event.
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2376
     If the argument, aView is nil, the information is regarding any
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2377
     view (i.e. is there an event for any of my views);
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2378
     otherwise, the information is regarding to that specific view."
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2379
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2380
    mouseAndKeyboard size ~~ 0 ifTrue:[
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2381
        mouseAndKeyboard do:[:anEvent |
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2382
            anEvent notNil ifTrue:[
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2383
                (aView isNil or:[anEvent view == aView]) ifTrue:[
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2384
                    (type isNil or:[anEvent type == type]) ifTrue:[^ true].
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2385
                ]
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2386
            ].
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2387
        ]
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2388
    ].
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2389
    ^ false
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2390
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2391
    "Created: / 17.6.1998 / 12:55:54 / cg"
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2392
    "Modified: / 18.6.1998 / 08:57:00 / cg"
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2393
!
9572f0dd369d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  2394
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2395
hasUserEventFor:aView 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2396
    "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
  2397
     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
  2398
     view (i.e. is there a user event for any of my views);
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2399
     otherwise, the information is regarding that specific view."
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2400
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2401
    (self hasKeyEventFor:aView) ifTrue:[^ true].
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2402
    ^ (self hasButtonEventFor:aView)
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2403
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2404
    "Created: 1.11.1996 / 17:08:50 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2405
    "Modified: 1.11.1996 / 17:12:21 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2406
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2407
2441
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2408
hasUserEvents 
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2409
    "return true, if any mouse/keyboard events are pending"
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2410
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2411
    ^ mouseAndKeyboard size ~~ 0
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2412
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2413
    "Created: / 5.2.1999 / 22:29:11 / cg"
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2414
!
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2415
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2416
motionEventPending 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2417
    "return true, if any buttonMotion events are pending."
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2418
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2419
    ^ self hasButtonMotionEventFor:nil
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2420
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2421
    "Created: 24.3.1996 / 20:09:55 / cg"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2422
    "Modified: 1.11.1996 / 17:04:43 / cg"
2177
22bc7dd353b4 added #userEventCount query
Claus Gittinger <cg@exept.de>
parents: 2163
diff changeset
  2423
!
22bc7dd353b4 added #userEventCount query
Claus Gittinger <cg@exept.de>
parents: 2163
diff changeset
  2424
22bc7dd353b4 added #userEventCount query
Claus Gittinger <cg@exept.de>
parents: 2163
diff changeset
  2425
userEventCount 
22bc7dd353b4 added #userEventCount query
Claus Gittinger <cg@exept.de>
parents: 2163
diff changeset
  2426
    "return the number of pending user events"
22bc7dd353b4 added #userEventCount query
Claus Gittinger <cg@exept.de>
parents: 2163
diff changeset
  2427
22bc7dd353b4 added #userEventCount query
Claus Gittinger <cg@exept.de>
parents: 2163
diff changeset
  2428
    ^ mouseAndKeyboard size
22bc7dd353b4 added #userEventCount query
Claus Gittinger <cg@exept.de>
parents: 2163
diff changeset
  2429
22bc7dd353b4 added #userEventCount query
Claus Gittinger <cg@exept.de>
parents: 2163
diff changeset
  2430
    "Modified: / 21.7.1998 / 18:52:19 / cg"
22bc7dd353b4 added #userEventCount query
Claus Gittinger <cg@exept.de>
parents: 2163
diff changeset
  2431
    "Created: / 21.7.1998 / 19:36:04 / cg"
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2432
! !
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2433
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2434
!WindowSensor methodsFor:'queries - key & button state'!
140
claus
parents: 133
diff changeset
  2435
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2436
altDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2437
    "return true, if the meta key is currently pressed.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2438
     Notice, that some keyboards dont have an alt key;
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2439
     it is better to use 'sensor metaDown or:[sensor altDown]'."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2440
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2441
    ^ altDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2442
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2443
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2444
anyButtonPressed
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2445
    "ST-80 compatibility: return true, if any mouse button is pressed.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2446
     You should no use it in 'normal' applications.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2447
     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
  2448
     button-event methods."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2449
1083
6e947cc67324 fixed #anyButtonPressed & setting of buttonDown-flags
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2450
    ^ leftButtonDown or:[middleButtonDown or:[rightButtonDown]]
6e947cc67324 fixed #anyButtonPressed & setting of buttonDown-flags
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2451
6e947cc67324 fixed #anyButtonPressed & setting of buttonDown-flags
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2452
    "Modified: 21.10.1996 / 11:37:31 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2453
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2454
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2455
blueButtonPressed
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2456
    "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
  2457
     You should no use it in 'normal' applications.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2458
     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
  2459
     button-event methods."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2460
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2461
    ^ rightButtonDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2462
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2463
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2464
ctrlDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2465
    "return true, if any CTRL key is currently pressed."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2466
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2467
    ^ ctrlDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2468
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2469
157
claus
parents: 154
diff changeset
  2470
leftButtonPressed
claus
parents: 154
diff changeset
  2471
    "return true, if the left mouse button is pressed.
claus
parents: 154
diff changeset
  2472
     This has been added to support ST-80 style button polling;
claus
parents: 154
diff changeset
  2473
     however, you should no use it in 'normal' applications.
claus
parents: 154
diff changeset
  2474
     Instead, keep track of the buttons state in your views or controllers
claus
parents: 154
diff changeset
  2475
     button-event methods."
claus
parents: 154
diff changeset
  2476
claus
parents: 154
diff changeset
  2477
    ^ leftButtonDown
claus
parents: 154
diff changeset
  2478
!
claus
parents: 154
diff changeset
  2479
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2480
metaDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2481
    "return true, if the meta key is currently pressed.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2482
     Notice, that most keyboards dont have a meta key;
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2483
     it is better to use 'sensor metaDown or:[sensor altDown]'."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2484
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2485
    ^ metaDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2486
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2487
157
claus
parents: 154
diff changeset
  2488
middleButtonPressed
claus
parents: 154
diff changeset
  2489
    "return true, if the middle mouse button is pressed.
claus
parents: 154
diff changeset
  2490
     This has been added to support ST-80 style button polling;
claus
parents: 154
diff changeset
  2491
     however, you should no use it in 'normal' applications.
claus
parents: 154
diff changeset
  2492
     Instead, keep track of the buttons state in your views or controllers
claus
parents: 154
diff changeset
  2493
     button-event methods."
claus
parents: 154
diff changeset
  2494
claus
parents: 154
diff changeset
  2495
    ^ middleButtonDown
claus
parents: 154
diff changeset
  2496
!
claus
parents: 154
diff changeset
  2497
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2498
redButtonPressed
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2499
    "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
  2500
     You should no use it in 'normal' applications.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2501
     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
  2502
     button-event methods."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2503
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2504
    ^ leftButtonDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2505
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2506
157
claus
parents: 154
diff changeset
  2507
rightButtonPressed
claus
parents: 154
diff changeset
  2508
    "return true, if the right mouse button is pressed.
claus
parents: 154
diff changeset
  2509
     This has been added to support ST-80 style button polling;
claus
parents: 154
diff changeset
  2510
     however, you should no use it in 'normal' applications.
claus
parents: 154
diff changeset
  2511
     Instead, keep track of the buttons state in your views or controllers
claus
parents: 154
diff changeset
  2512
     button-event methods."
claus
parents: 154
diff changeset
  2513
claus
parents: 154
diff changeset
  2514
    ^ rightButtonDown
claus
parents: 154
diff changeset
  2515
!
claus
parents: 154
diff changeset
  2516
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2517
shiftDown
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2518
    "return true, if any shift key is currently pressed."
157
claus
parents: 154
diff changeset
  2519
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2520
    ^ shiftDown
157
claus
parents: 154
diff changeset
  2521
!
claus
parents: 154
diff changeset
  2522
claus
parents: 154
diff changeset
  2523
yellowButtonPressed
claus
parents: 154
diff changeset
  2524
    "ST-80 compatibility: return true, if the middle mouse button is pressed.
claus
parents: 154
diff changeset
  2525
     You should no use it in 'normal' applications.
claus
parents: 154
diff changeset
  2526
     Instead, keep track of the buttons state in your views or controllers
claus
parents: 154
diff changeset
  2527
     button-event methods."
claus
parents: 154
diff changeset
  2528
claus
parents: 154
diff changeset
  2529
    ^ middleButtonDown
140
claus
parents: 133
diff changeset
  2530
! !
claus
parents: 133
diff changeset
  2531
1100
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2532
!WindowSensor methodsFor:'queries - pointer'!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2533
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2534
cursorPoint
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2535
    "ST-80 compatibility: 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2536
     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
  2537
     (in screen coordinates)"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2538
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2539
     ^ self class cursorPoint
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2540
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2541
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2542
globalOrigin 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2543
    "ST-80 compatibility: 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2544
     dont know what we should return here ...
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2545
     ... 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
  2546
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2547
     ^ 0@0
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2548
!
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2549
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2550
mousePoint
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2551
    "ST-80 compatibility: 
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2552
     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
  2553
     (in screen coordinates)"
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2554
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2555
     ^ self cursorPoint
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2556
! !
70e93fc002cb more event query methods;
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  2557
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
  2558
!WindowSensor methodsFor:'special'!
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
  2559
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2560
catchExposeFor:aView
54
29a6b2f8e042 *** empty log message ***
claus
parents: 47
diff changeset
  2561
    "start catching noExpose events (must be done BEFORE a bitblt,
29a6b2f8e042 *** empty log message ***
claus
parents: 47
diff changeset
  2562
     to prepare for the exposeEventSemaphore to be signalled when 
29a6b2f8e042 *** empty log message ***
claus
parents: 47
diff changeset
  2563
     the noExpose event arrives)."
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
  2564
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2565
    "/ this is only needed for X ...
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2566
    aView device scrollsAsynchronous ifFalse:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2567
	^ self
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2568
    ].
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2569
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2570
    (catchExpose includes:aView) ifTrue:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2571
        ('WSensor [warning]: already catching (for ' , aView printString , ')') errorPrintCR.
1274
778fdd997e45 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1271
diff changeset
  2572
        Delay waitForMilliseconds:100.
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2573
        (catchExpose includes:aView) ifTrue:[
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2574
            ('WSensor [warning]: still catching (for ' , aView printString , ')') errorPrintCR.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2575
	    "/ wake the other one
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2576
	    gotExpose add:aView.
1274
778fdd997e45 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1271
diff changeset
  2577
            exposeEventSemaphore signalForAll.
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2578
	    Delay waitForMilliseconds:100.
1274
778fdd997e45 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1271
diff changeset
  2579
        ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2580
    ].
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2581
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2582
    [
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2583
        gotOtherEvent remove:aView ifAbsent:nil.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2584
        gotExpose remove:aView ifAbsent:nil.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2585
        catchExpose add:aView.
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2586
    ] valueUninterruptably.
28
3879ff2138f1 *** empty log message ***
claus
parents: 27
diff changeset
  2587
!
3879ff2138f1 *** empty log message ***
claus
parents: 27
diff changeset
  2588
1320
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2589
pollForActivity
1529
cf81e3de53e0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  2590
    "ST-80 compatibility: wait for some activity (i.e. poll for an event) "
1320
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2591
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2592
    "/ should add a buttonStateChangeSemaphore and wait on this ...
1529
cf81e3de53e0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  2593
"/    Delay waitForSeconds:0.01.
cf81e3de53e0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  2594
    Processor yield.
cf81e3de53e0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  2595
cf81e3de53e0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  2596
    "Modified: 12.2.1997 / 12:46:09 / cg"
1320
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2597
!
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2598
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2599
waitButton
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2600
    "ST-80 compatibility: wait until any mouse button is pressed.
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2601
     Do not use this in your applications; polling the sensor is
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2602
     bad style."
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2603
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2604
    [self anyButtonPressed] whileFalse:[
1320
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2605
        self pollForActivity
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2606
    ].
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2607
1320
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2608
    "Modified: 10.2.1997 / 13:30:38 / cg"
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2609
!
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2610
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2611
waitClickButton
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2612
    "ST-80 compatibility: wait until any mouse button is pressed & released again.
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2613
     Do not use this in your applications; polling the sensor is
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2614
     bad style."
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2615
1790
a7f42261ab45 need a RecursionLock for the accessLock to avoid
Claus Gittinger <cg@exept.de>
parents: 1734
diff changeset
  2616
    self waitButton.
1320
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2617
    ^self waitNoButton
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2618
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2619
    "Created: 10.2.1997 / 13:31:09 / cg"
244
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2620
!
83218faf792c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2621
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
  2622
waitForExposeFor:aView
157
claus
parents: 154
diff changeset
  2623
    "wait until a graphicsExpose or a noExpose arrives (after a bitblt).
claus
parents: 154
diff changeset
  2624
     This may be too X-specific, and things may change in this area
claus
parents: 154
diff changeset
  2625
     in future versions. (or the new device may simulate the arrival of
claus
parents: 154
diff changeset
  2626
     such an event)"
54
29a6b2f8e042 *** empty log message ***
claus
parents: 47
diff changeset
  2627
2421
037f43af3b0e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2413
diff changeset
  2628
    |blocked lostExpose device stopPoll endPollTime pollDelay|
1873
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2629
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2630
    device := aView graphicsDevice.
1359
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2631
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2632
    "/ this is only needed for X ...
1873
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2633
    device scrollsAsynchronous ifFalse:[
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2634
        gotExpose remove:aView ifAbsent:nil.
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2635
        catchExpose remove:aView ifAbsent:nil.
1359
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2636
        ^ self
1027
0ba82862ca8d fixes for synchronous scrolling (WINDOWS)
Claus Gittinger <cg@exept.de>
parents: 1013
diff changeset
  2637
    ].
0ba82862ca8d fixes for synchronous scrolling (WINDOWS)
Claus Gittinger <cg@exept.de>
parents: 1013
diff changeset
  2638
1359
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2639
    blocked := true.
1013
32d804ff472d cleanup when unwinding from a waitForExpose
Claus Gittinger <cg@exept.de>
parents: 1012
diff changeset
  2640
    [
1359
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2641
        aView flush.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2642
        Processor activeProcessIsSystemProcess ifTrue:[
2421
037f43af3b0e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2413
diff changeset
  2643
            device platformName = 'WIN32' ifTrue:[
037f43af3b0e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2413
diff changeset
  2644
                pollDelay := 1.
037f43af3b0e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2413
diff changeset
  2645
            ] ifFalse:[
037f43af3b0e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2413
diff changeset
  2646
                pollDelay := 3.
037f43af3b0e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2413
diff changeset
  2647
            ].
037f43af3b0e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2413
diff changeset
  2648
            endPollTime := AbsoluteTime now addSeconds:pollDelay.
1873
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2649
            stopPoll := false.
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2650
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2651
            "/
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2652
            "/ cannot really suspend, if its a systemProcess
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2653
            "/ must poll for the event
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2654
            "/
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2655
            [(gotExpose includes:aView) or:[stopPoll]] whileFalse:[
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2656
                (device exposeEventPendingFor:aView id withSync:true) ifTrue:[
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2657
                    device dispatchExposeEventFor:aView id.
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2658
                ].
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2659
                stopPoll := (AbsoluteTime now > endPollTime).
1359
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2660
                Processor yield.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2661
            ]
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2662
        ] ifFalse:[
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2663
            lostExpose := 1.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2664
            "
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2665
              block interrupt here, to resolve race between
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2666
              testing gotExpose and the semaphore, which is woken up
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2667
              with #signalForAll.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2668
            "
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2669
            blocked := OperatingSystem blockInterrupts.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2670
            [ (gotExpose includes:aView) or:[lostExpose > 2] ] whileFalse:[
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2671
                "
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2672
                 just in case we have a (network or software) problem ...
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2673
                 explanation: it may happen, that an expose event is totally
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2674
                 lost - for example, if the network breaks down.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2675
                 To not block forever, we wait with a timeout, to get out of here
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2676
                 if the event does not arrive after 15 seconds.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2677
                "
1505
e9682a002469 checkin from browser
ca
parents: 1492
diff changeset
  2678
                (exposeEventSemaphore waitWithTimeout:(1 * lostExpose)) isNil ifTrue:[
1873
a67649816bc8 break non-windowGroup expose-poll loop after a while (10 seconds)
Claus Gittinger <cg@exept.de>
parents: 1864
diff changeset
  2679
                    device flush.         "/ we are paranoid
1359
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2680
                    lostExpose == 1 ifTrue:[
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2681
                        "
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2682
                         you can put a comment around the following line, 
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2683
                         if you don't like the message ...
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2684
                        "
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2685
                        ('WindowSensor [info]: late expose event (' , aView printString , ')') infoPrintCR.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2686
                    ] ifFalse:[
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2687
                        'WindowSensor [warning]: lost expose event' errorPrintCR.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2688
                    ].
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2689
                    lostExpose := lostExpose + 1.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2690
                ].
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2691
            ].
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2692
        ].
1013
32d804ff472d cleanup when unwinding from a waitForExpose
Claus Gittinger <cg@exept.de>
parents: 1012
diff changeset
  2693
    ] valueNowOrOnUnwindDo:[
1359
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2694
        gotExpose remove:aView ifAbsent:nil.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2695
        catchExpose remove:aView ifAbsent:nil.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2696
        blocked ifFalse:[
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2697
            OperatingSystem unblockInterrupts.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2698
        ].
1295
ef93ded3c030 renamed graphicExpose -> graphicsExpose;
Claus Gittinger <cg@exept.de>
parents: 1274
diff changeset
  2699
1359
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2700
        "/
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2701
        "/ other incoming events have been ignored during the wait.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2702
        "/ Now handle those ...
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2703
        "/
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2704
        (gotOtherEvent includes:aView) ifTrue:[
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2705
            gotOtherEvent remove:aView ifAbsent:nil.
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2706
        ].
ab88659a5000 Fix race in #waitForExposeFor: which could cause a "late expose event"
Stefan Vogel <sv@exept.de>
parents: 1340
diff changeset
  2707
        eventSemaphore signalOnce
1013
32d804ff472d cleanup when unwinding from a waitForExpose
Claus Gittinger <cg@exept.de>
parents: 1012
diff changeset
  2708
    ].
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 19
diff changeset
  2709
2421
037f43af3b0e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2413
diff changeset
  2710
    "Modified: / 20.2.1997 / 09:24:31 / stefan"
037f43af3b0e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2413
diff changeset
  2711
    "Modified: / 9.1.1999 / 01:58:56 / cg"
47
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
  2712
!
209bc432e4e3 last version with separate queue
claus
parents: 46
diff changeset
  2713
157
claus
parents: 154
diff changeset
  2714
waitNoButton
claus
parents: 154
diff changeset
  2715
    "ST-80 compatibility: wait until no mouse button is pressed.
claus
parents: 154
diff changeset
  2716
     Do not use this in your applications; polling the sensor is
claus
parents: 154
diff changeset
  2717
     bad style."
claus
parents: 154
diff changeset
  2718
claus
parents: 154
diff changeset
  2719
    [self anyButtonPressed] whileTrue:[
1320
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2720
        self pollForActivity
157
claus
parents: 154
diff changeset
  2721
    ].
1241
c65f1c9d8de4 use critical regions around queue manipulation code.
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
  2722
1320
478840db1666 more ST80 stuff
Claus Gittinger <cg@exept.de>
parents: 1318
diff changeset
  2723
    "Modified: 10.2.1997 / 13:30:43 / cg"
157
claus
parents: 154
diff changeset
  2724
! !
claus
parents: 154
diff changeset
  2725
1082
44d671491f5e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1063
diff changeset
  2726
!WindowSensor class methodsFor:'documentation'!
251
915de9a65169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 244
diff changeset
  2727
915de9a65169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 244
diff changeset
  2728
version
2441
6925d83b717e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2439
diff changeset
  2729
    ^ '$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.142 1999-02-08 14:24:17 cg Exp $'
251
915de9a65169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 244
diff changeset
  2730
! !
140
claus
parents: 133
diff changeset
  2731
WindowSensor initialize!