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