DeviceWorkstation.st
author claus
Fri, 28 Jul 1995 04:58:06 +0200
changeset 159 4c8ff071c8de
parent 157 891eff44c2e7
child 162 0f14db5e47c1
permissions -rw-r--r--
.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     1
"
48194c26a46c Initial revision
claus
parents:
diff changeset
     2
COPYRIGHT (c) 1993 by Claus Gittinger
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
     3
	      All Rights Reserved
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     4
48194c26a46c Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
48194c26a46c Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
48194c26a46c Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
48194c26a46c Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
48194c26a46c Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
48194c26a46c Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
48194c26a46c Initial revision
claus
parents:
diff changeset
    11
"
48194c26a46c Initial revision
claus
parents:
diff changeset
    12
48194c26a46c Initial revision
claus
parents:
diff changeset
    13
Object subclass:#DeviceWorkstation
48194c26a46c Initial revision
claus
parents:
diff changeset
    14
       instanceVariableNames:'displayId
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
    15
			      visualType monitorType
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
    16
			      depth ncells bitsPerRGB
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
    17
			      hasColors hasGreyscales 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
    18
			      width height widthMM heightMM resolutionHor resolutionVer
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
    19
			      idToViewMapping knownViews knownIds knownBitmaps knownBitmapIds
151
claus
parents: 146
diff changeset
    20
			      dispatching dispatchProcess
claus
parents: 146
diff changeset
    21
			      ctrlDown shiftDown metaDown altDown
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
    22
			      motionEventCompression
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
    23
			      lastId lastView
134
claus
parents: 133
diff changeset
    24
			      keyboardMap rootView
133
claus
parents: 123
diff changeset
    25
			      isSlow 
claus
parents: 123
diff changeset
    26
			      activeKeyboardGrab activePointerGrab
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
    27
			      buttonTranslation multiClickTimeDelta'
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    28
       classVariableNames:   'ButtonTranslation MultiClickTimeDelta
151
claus
parents: 146
diff changeset
    29
			      DeviceErrorSignal 
claus
parents: 146
diff changeset
    30
			      DefaultScreen AllScreens'
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    31
       poolDictionaries:''
48194c26a46c Initial revision
claus
parents:
diff changeset
    32
       category:'Interface-Graphics'
48194c26a46c Initial revision
claus
parents:
diff changeset
    33
!
48194c26a46c Initial revision
claus
parents:
diff changeset
    34
48194c26a46c Initial revision
claus
parents:
diff changeset
    35
DeviceWorkstation comment:'
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    36
COPYRIGHT (c) 1993 by Claus Gittinger
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
    37
	      All Rights Reserved
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
    38
159
claus
parents: 157
diff changeset
    39
$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.40 1995-07-28 02:57:54 claus Exp $
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    40
'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    41
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    42
!DeviceWorkstation class methodsFor:'documentation'!
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    43
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    44
copyright
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    45
"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    46
COPYRIGHT (c) 1993 by Claus Gittinger
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
    47
	      All Rights Reserved
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    48
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    49
 This software is furnished under a license and may be used
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    50
 only in accordance with the terms of that license and with the
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    51
 inclusion of the above copyright notice.   This software may not
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    52
 be provided or otherwise made available to, or used by, any
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    53
 other person.  No title to or ownership of the software is
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    54
 hereby transferred.
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    55
"
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    56
!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    57
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    58
version
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    59
"
159
claus
parents: 157
diff changeset
    60
$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.40 1995-07-28 02:57:54 claus Exp $
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    61
"
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
    62
!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    63
48194c26a46c Initial revision
claus
parents:
diff changeset
    64
documentation
48194c26a46c Initial revision
claus
parents:
diff changeset
    65
"
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    66
    this abstract class defines common protocol to all Display types.
151
claus
parents: 146
diff changeset
    67
    For compatibility with ST-80, this class (or a subclass) is also
claus
parents: 146
diff changeset
    68
    bound to the global Screen.
claus
parents: 146
diff changeset
    69
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    70
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    71
    instance variables:
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    72
134
claus
parents: 133
diff changeset
    73
      displayId       <Number>          the device id of the display
claus
parents: 133
diff changeset
    74
      visualType      <Symbol>          one of #StaticGray, #PseudoColor, ... #TrueColor
claus
parents: 133
diff changeset
    75
      monitorType     <Symbol>          one of #monochrome, #color, #unknown
claus
parents: 133
diff changeset
    76
claus
parents: 133
diff changeset
    77
      depth           <Integer>         bits per color
claus
parents: 133
diff changeset
    78
      ncells          <Integer>         number of colors (i.e. colormap size; not always == 2^depth)
claus
parents: 133
diff changeset
    79
      bitsPerRGB      <Integer>         number of valid bits per rgb component
claus
parents: 133
diff changeset
    80
					(actual number taken in A/D converter; not all devices report the true value)
claus
parents: 133
diff changeset
    81
      hasColors       <Boolean>         true, if display supports colors
claus
parents: 133
diff changeset
    82
      hasGreyscales   <Boolean>         true, if display supports grey-scales (i.e is not b/w display)
claus
parents: 133
diff changeset
    83
      width           <Integer>         number of horizontal pixels
claus
parents: 133
diff changeset
    84
      height          <Integer>         number of vertical pixels 
claus
parents: 133
diff changeset
    85
      heightMM        <Number>          screen height in millimeter
claus
parents: 133
diff changeset
    86
      widthMM         <Number>          screen width in millimeter
claus
parents: 133
diff changeset
    87
      resolutionHor   <Number>          pixels per horizontal millimeter
claus
parents: 133
diff changeset
    88
      resolutionVer   <Number>          pixels per vertical millimeter
claus
parents: 133
diff changeset
    89
claus
parents: 133
diff changeset
    90
      idToViewMapping <Dictionary>      maps view-ids to views
claus
parents: 133
diff changeset
    91
      knownViews      <Collection>      all views known
claus
parents: 133
diff changeset
    92
      knownIds        <Collection>      corresponding device-view ids
claus
parents: 133
diff changeset
    93
      knownBitmaps    <Collection>      all known device bitmaps
claus
parents: 133
diff changeset
    94
      knownBitmapIds  <Collection>      corresponding device-bitmap ids
claus
parents: 133
diff changeset
    95
claus
parents: 133
diff changeset
    96
      dispatching     <Boolean>         true, if currently in dispatch loop
claus
parents: 133
diff changeset
    97
151
claus
parents: 146
diff changeset
    98
      ctrlDown        <Boolean>         true, if control key currently pressed
134
claus
parents: 133
diff changeset
    99
      shiftDown       <Boolean>         true, if shift key currently pressed
claus
parents: 133
diff changeset
   100
      metaDown        <Boolean>         true, if meta key (cmd-key) is currently pressed
claus
parents: 133
diff changeset
   101
      altDown         <Boolean>         true, if alt key is currently pressed
claus
parents: 133
diff changeset
   102
claus
parents: 133
diff changeset
   103
      motionEventCompression
claus
parents: 133
diff changeset
   104
		      <Boolean>         if true motion events are compressed
claus
parents: 133
diff changeset
   105
					(obsolete: now done in sensor)
claus
parents: 133
diff changeset
   106
claus
parents: 133
diff changeset
   107
      lastId          <Number>          the id of the last events view (internal)
claus
parents: 133
diff changeset
   108
      lastView        <View>            the last events view (internal, for faster id->view mapping)
claus
parents: 133
diff changeset
   109
claus
parents: 133
diff changeset
   110
      keyboardMap     <KeyBdMap>        mapping for keys
claus
parents: 133
diff changeset
   111
      rootView        <DisplayRootView> this displays root window
claus
parents: 133
diff changeset
   112
      isSlow          <Boolean>         set/cleared from startup - used to turn off
claus
parents: 133
diff changeset
   113
					things like popup-shadows etc.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   114
"
151
claus
parents: 146
diff changeset
   115
!
claus
parents: 146
diff changeset
   116
claus
parents: 146
diff changeset
   117
workstationDevices
claus
parents: 146
diff changeset
   118
"
claus
parents: 146
diff changeset
   119
    In ST/X, all interaction with the graphics device is done through
claus
parents: 146
diff changeset
   120
    an instance of (a subclass) of DeviceWorkstation.
claus
parents: 146
diff changeset
   121
    Every view has a reference to the device it has been created on in
claus
parents: 146
diff changeset
   122
    its device instance variable. 
claus
parents: 146
diff changeset
   123
claus
parents: 146
diff changeset
   124
    One particular device instance is bound to the global variable Display:
claus
parents: 146
diff changeset
   125
    this is the default graphics display, on which new views are created
claus
parents: 146
diff changeset
   126
    (however, provisions exist for multi-display operation)
claus
parents: 146
diff changeset
   127
claus
parents: 146
diff changeset
   128
    Currently, there is are only two classes (released to the public):
claus
parents: 146
diff changeset
   129
claus
parents: 146
diff changeset
   130
	XWorkstation    - a plain X window interface
claus
parents: 146
diff changeset
   131
claus
parents: 146
diff changeset
   132
	GLXWorkstation  - an X window interface with a GL (3D graphic library) 
claus
parents: 146
diff changeset
   133
			  extension; either simulated (VGL) or a real GL 
claus
parents: 146
diff changeset
   134
			  (real GL is only available on SGI machines)
claus
parents: 146
diff changeset
   135
claus
parents: 146
diff changeset
   136
    An experimental version for a NeXTStep interface exists, but is currently
claus
parents: 146
diff changeset
   137
    no longer maintained and not released.
claus
parents: 146
diff changeset
   138
    Also, interfaces for other graphic systems (i.e. OS/2 and Windows) are
claus
parents: 146
diff changeset
   139
    planned for and will be available (hopefully) in late 95.
claus
parents: 146
diff changeset
   140
claus
parents: 146
diff changeset
   141
    DeviceWorkstation itself is an abstract class; the methods as defined
claus
parents: 146
diff changeset
   142
    here perform things which are common to all graphic devices or block
claus
parents: 146
diff changeset
   143
    methods and raise a subclassResponsibilty error condition.
claus
parents: 146
diff changeset
   144
    To create a new graphic interface, at least the subclassResponsibilty-methods
claus
parents: 146
diff changeset
   145
    have to be reimplemented in a concrete subclass.
claus
parents: 146
diff changeset
   146
claus
parents: 146
diff changeset
   147
    In theory, ST/X is designed to allow the use of multiple workstation
claus
parents: 146
diff changeset
   148
    devices in parallel; for example, in X, it is possible to create another
claus
parents: 146
diff changeset
   149
    instance of XWorkstation, start a dispatch process for it, and to create and
claus
parents: 146
diff changeset
   150
    open views on this display. However, (currently) some mechanisms are badly
claus
parents: 146
diff changeset
   151
    implemented and therefore, things do not work fully satisfying.
claus
parents: 146
diff changeset
   152
    (for example, popUpMenus are currently opened on the workstation which is
claus
parents: 146
diff changeset
   153
     bound to the global variable 'Display' - independent of the active
claus
parents: 146
diff changeset
   154
     windowgroups display.)
claus
parents: 146
diff changeset
   155
    These bugs will be fixed and fully working multi-display operation can be
claus
parents: 146
diff changeset
   156
    expected for one of the next releases.
claus
parents: 146
diff changeset
   157
claus
parents: 146
diff changeset
   158
    If you want to experiment with multi-display applications,
claus
parents: 146
diff changeset
   159
    you have to:
claus
parents: 146
diff changeset
   160
claus
parents: 146
diff changeset
   161
	- create a new instance of XWorkstation:
claus
parents: 146
diff changeset
   162
claus
parents: 146
diff changeset
   163
	    Smalltalk at:#Display2 put:(XWorkstation new).
claus
parents: 146
diff changeset
   164
claus
parents: 146
diff changeset
   165
	- have it connect to the display (i.e. the xServer):
claus
parents: 146
diff changeset
   166
	  (replace 'porty' below with the name of your display)
claus
parents: 146
diff changeset
   167
claus
parents: 146
diff changeset
   168
	    Display2 := Display2 initializeFor:'porty:0.0'
claus
parents: 146
diff changeset
   169
claus
parents: 146
diff changeset
   170
	  returns nil, if connection is refused 
claus
parents: 146
diff changeset
   171
	  - leaving you with Display2==nil in this case.
claus
parents: 146
diff changeset
   172
        
claus
parents: 146
diff changeset
   173
	- start an event dispatcher process for it:
claus
parents: 146
diff changeset
   174
claus
parents: 146
diff changeset
   175
	    Display2 startDispatch
claus
parents: 146
diff changeset
   176
claus
parents: 146
diff changeset
   177
	- optionally set its keyboard map
claus
parents: 146
diff changeset
   178
	  (since this is usually done for Display in the startup-file,
claus
parents: 146
diff changeset
   179
	   the new display does not have all your added key bindings)
claus
parents: 146
diff changeset
   180
claus
parents: 146
diff changeset
   181
	    Display2 keyboardMap:(Display keyboardMap)
claus
parents: 146
diff changeset
   182
claus
parents: 146
diff changeset
   183
	- create a view for it:
claus
parents: 146
diff changeset
   184
claus
parents: 146
diff changeset
   185
	    (FileBrowser onDevice:Display2) open
claus
parents: 146
diff changeset
   186
claus
parents: 146
diff changeset
   187
	    (Workspace onDevice:Display2) open
claus
parents: 146
diff changeset
   188
claus
parents: 146
diff changeset
   189
	    (Launcher onDevice:Display2) open
claus
parents: 146
diff changeset
   190
claus
parents: 146
diff changeset
   191
	    NewLauncher openOnDevice:Display2
claus
parents: 146
diff changeset
   192
		--> does not work, since ApplicationModel is not prepared
claus
parents: 146
diff changeset
   193
		    to open views on other devices. (and may never be, since
claus
parents: 146
diff changeset
   194
		    it was written for ST-80 compatibility, which seems not to
claus
parents: 146
diff changeset
   195
		    support this.)
claus
parents: 146
diff changeset
   196
		    To do the above, try:
claus
parents: 146
diff changeset
   197
claus
parents: 146
diff changeset
   198
			Smalltalk at:#OldDisplay put:Display.
claus
parents: 146
diff changeset
   199
			Display := Display2.
claus
parents: 146
diff changeset
   200
			NewLauncher open.
claus
parents: 146
diff changeset
   201
			Display := OldDisplay.
claus
parents: 146
diff changeset
   202
claus
parents: 146
diff changeset
   203
		    Consider this is an ugly kludge ...
claus
parents: 146
diff changeset
   204
claus
parents: 146
diff changeset
   205
    However, as mentioned above, there are a few places, where the default
claus
parents: 146
diff changeset
   206
    display 'Display' is still hard-coded. But, beside from this (little bug ;-),
claus
parents: 146
diff changeset
   207
    remote display operation works pretty well. If you write your application to
claus
parents: 146
diff changeset
   208
    work around those (to-be-fixed) bugs, multi-display applications are
claus
parents: 146
diff changeset
   209
    even possible in the current release. (avoid popUps and use simple buttons
claus
parents: 146
diff changeset
   210
    only).
claus
parents: 146
diff changeset
   211
claus
parents: 146
diff changeset
   212
    Things are being changed to introduce the concept of a 'current' display,
claus
parents: 146
diff changeset
   213
    which is the device on which the current windowGroup has its topView.
claus
parents: 146
diff changeset
   214
    All places in the system whit explicit accesses to Display will be changed
claus
parents: 146
diff changeset
   215
    to use 'Screen current' instead. Especially, this will create popups and
claus
parents: 146
diff changeset
   216
    modalBoxes on the display of the active windowGroup.
claus
parents: 146
diff changeset
   217
claus
parents: 146
diff changeset
   218
    There is no easy solution for things like Notifiers, WarnBoxes or
claus
parents: 146
diff changeset
   219
    Debuggers when opened from some background or non-view process.
claus
parents: 146
diff changeset
   220
    These will come up one the default Display, as returned by 'Screen default'.
claus
parents: 146
diff changeset
   221
claus
parents: 146
diff changeset
   222
    Late note: the above has been mostly fixed, multidisplay applications
claus
parents: 146
diff changeset
   223
    work pretty well. However, there are still some problems to be expected,
claus
parents: 146
diff changeset
   224
    if the screens have different display capabilities (b&w vs. greyscale vs.
claus
parents: 146
diff changeset
   225
    color display). The current styleSheet approach keeps default values
claus
parents: 146
diff changeset
   226
    only once (it should do so per display ...) For now, expect ugly looking
claus
parents: 146
diff changeset
   227
    views in this case - or set your styleSheet for the smallest common 
claus
parents: 146
diff changeset
   228
    capabilities (i.e. for b&w).
claus
parents: 146
diff changeset
   229
"
claus
parents: 146
diff changeset
   230
!
claus
parents: 146
diff changeset
   231
claus
parents: 146
diff changeset
   232
events
claus
parents: 146
diff changeset
   233
"
claus
parents: 146
diff changeset
   234
    All events are processed in a workstations dispatchEvent method.
claus
parents: 146
diff changeset
   235
    There, incoming events are first sent to itself, for a first (view independent)
claus
parents: 146
diff changeset
   236
    preprocessing. For example, the devices state of the shift-, alt-, control and
claus
parents: 146
diff changeset
   237
    meta keys are updated there. After that, the event is forwarded either to
claus
parents: 146
diff changeset
   238
    the views sensor or to the view directly (if it has no sensor).
claus
parents: 146
diff changeset
   239
    (Sensorless views are a leftover from ancient times and will sooner or
claus
parents: 146
diff changeset
   240
     later vanish - simplifying things a bit. Do not depend on views without
claus
parents: 146
diff changeset
   241
     sensors to work correctly in future versions.)
claus
parents: 146
diff changeset
   242
claus
parents: 146
diff changeset
   243
    This event processing is done by the event dispatcher process, which is
claus
parents: 146
diff changeset
   244
    launched in ST/X's startup sequence (see Smalltalk>>start).
claus
parents: 146
diff changeset
   245
    Event processing is done at a high priority, to allow keyboad processing
claus
parents: 146
diff changeset
   246
    and CTRL-C handling to be performed even while other processes are running.
claus
parents: 146
diff changeset
   247
    The code executed by thr event process is found in startDispatch.
claus
parents: 146
diff changeset
   248
claus
parents: 146
diff changeset
   249
    Individual events can be enabled or disabled. The ones that are enabled
claus
parents: 146
diff changeset
   250
    by default are:
claus
parents: 146
diff changeset
   251
	keypress / keyRelease
claus
parents: 146
diff changeset
   252
	buttonPress / buttonRelease / buttonMotion (i.e. motion with button pressed)
claus
parents: 146
diff changeset
   253
	pointerEnter / pointerLeave
claus
parents: 146
diff changeset
   254
claus
parents: 146
diff changeset
   255
    other events have to be enabled by sending a corresponding #enableXXXEvent
claus
parents: 146
diff changeset
   256
    message to the view which shall receive those events.
claus
parents: 146
diff changeset
   257
    For example, pointerMotion events (i.e. motion without button being pressed)
claus
parents: 146
diff changeset
   258
    are enable by: 'aView enableMotionEvent'
claus
parents: 146
diff changeset
   259
claus
parents: 146
diff changeset
   260
    The above is only of interrest, if you write your own widget classes,
claus
parents: 146
diff changeset
   261
    existing widgets set things as required in their #initEvents method.
claus
parents: 146
diff changeset
   262
"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   263
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   264
48194c26a46c Initial revision
claus
parents:
diff changeset
   265
!DeviceWorkstation class methodsFor:'initialization'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   266
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   267
initialize
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   268
    DeviceErrorSignal isNil ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   269
	DeviceErrorSignal := (Signal new) mayProceed:true.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   270
	DeviceErrorSignal notifierString:'device error'.
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   271
    ].
134
claus
parents: 133
diff changeset
   272
    self initializeConstants.
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   273
!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   274
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   275
initializeConstants
48194c26a46c Initial revision
claus
parents:
diff changeset
   276
    "initialize some (soft) constants"
48194c26a46c Initial revision
claus
parents:
diff changeset
   277
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
   278
    MultiClickTimeDelta := 300.       "a click within 300ms is considered a double one"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   279
    ButtonTranslation := #(1 2 3)     "identity translation"
48194c26a46c Initial revision
claus
parents:
diff changeset
   280
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   281
144
claus
parents: 142
diff changeset
   282
!DeviceWorkstation class methodsFor:'Signal constants'!
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   283
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   284
deviceErrorSignal
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   285
    "return the signal used for device error reporting"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   286
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   287
    ^ DeviceErrorSignal
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   288
! !
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   289
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   290
!DeviceWorkstation class methodsFor:'accessing'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   291
48194c26a46c Initial revision
claus
parents:
diff changeset
   292
buttonTranslation:anArray
48194c26a46c Initial revision
claus
parents:
diff changeset
   293
    "set the button translation, #(1 2 3) is no-translation,
48194c26a46c Initial revision
claus
parents:
diff changeset
   294
     #(3 2 1) is ok for left-handers"
48194c26a46c Initial revision
claus
parents:
diff changeset
   295
75
claus
parents: 71
diff changeset
   296
    ButtonTranslation := anArray.
claus
parents: 71
diff changeset
   297
    Display notNil ifTrue:[
claus
parents: 71
diff changeset
   298
	Display buttonTranslation:anArray
claus
parents: 71
diff changeset
   299
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   300
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   301
48194c26a46c Initial revision
claus
parents:
diff changeset
   302
!DeviceWorkstation methodsFor:'initialize / release'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   303
48194c26a46c Initial revision
claus
parents:
diff changeset
   304
initialize
48194c26a46c Initial revision
claus
parents:
diff changeset
   305
    "initialize the receiver for a connection to the default display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   306
48194c26a46c Initial revision
claus
parents:
diff changeset
   307
    ^ self initializeFor:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   308
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   309
48194c26a46c Initial revision
claus
parents:
diff changeset
   310
initializeFor:aDisplayOrNilForAny
48194c26a46c Initial revision
claus
parents:
diff changeset
   311
    "initialize the receiver for a connection to a display. If the
48194c26a46c Initial revision
claus
parents:
diff changeset
   312
     argument is non-nil, it should specify which workstation should be
48194c26a46c Initial revision
claus
parents:
diff changeset
   313
     connected to (in a device specific manner). For X displays, this is
48194c26a46c Initial revision
claus
parents:
diff changeset
   314
     to be the display-string i.e. hostname:displayNr.
48194c26a46c Initial revision
claus
parents:
diff changeset
   315
     If the argument is nil,  connect to the default display."
48194c26a46c Initial revision
claus
parents:
diff changeset
   316
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   317
    ^ self subclassResponsibility
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   318
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   319
48194c26a46c Initial revision
claus
parents:
diff changeset
   320
close
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   321
    "close down connection to Display - usually never done"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   322
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   323
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
   324
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   325
48194c26a46c Initial revision
claus
parents:
diff changeset
   326
reinitialize
48194c26a46c Initial revision
claus
parents:
diff changeset
   327
    "reinit after snapin"
48194c26a46c Initial revision
claus
parents:
diff changeset
   328
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   329
    |prevKnownViews prevMapping|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   330
48194c26a46c Initial revision
claus
parents:
diff changeset
   331
    displayId := nil.
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
   332
    dispatching := false.
151
claus
parents: 146
diff changeset
   333
    dispatchProcess := nil.
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   334
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   335
"/    prevMapping := idToViewMapping.
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   336
"/    idToViewMapping := nil.
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   337
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   338
    prevKnownViews := knownViews.
48194c26a46c Initial revision
claus
parents:
diff changeset
   339
    knownViews := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   340
    knownIds := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   341
48194c26a46c Initial revision
claus
parents:
diff changeset
   342
    self initializeFor:nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   343
43
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   344
    "
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   345
     first, all Forms must be recreated
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
   346
     (since they may be needed for view recreation as
43
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   347
      background or icons)
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   348
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   349
    Form reinitializeAllOn:self.
48194c26a46c Initial revision
claus
parents:
diff changeset
   350
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   351
"/    prevMapping notNil ifTrue:[
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   352
    prevKnownViews notNil ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   353
	"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   354
	 first round: flush all device specific stuff
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   355
	"
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
   356
"/      prevMapping keysAndValuesDo:[:anId :aView |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   357
	prevKnownViews do:[:aView |
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   358
	    aView notNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   359
		aView prepareForReinit
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   360
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   361
	].
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   362
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   363
	"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   364
	 2nd round: all views should reinstall themself
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   365
		    on the new display
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   366
	"
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
   367
"/      prevMapping keysAndValuesDo:[:anId :aView |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   368
	prevKnownViews do:[:aView |
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   369
	    aView notNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   370
		"have to re-create the view"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   371
		aView reinitialize
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   372
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   373
	].
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   374
	"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   375
	 3rd round: all views get a chance to handle
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   376
		    changed environment (colors, font sizes etc)
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   377
	"
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
   378
"/      prevMapping keysAndValuesDo:[:anId :aView |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   379
	prevKnownViews do:[:aView |
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   380
	    aView notNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   381
		aView reAdjustGeometry
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   382
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   383
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   384
    ].
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   385
    dispatching := false.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   386
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   387
48194c26a46c Initial revision
claus
parents:
diff changeset
   388
initializeKeyboardMap
48194c26a46c Initial revision
claus
parents:
diff changeset
   389
    "keystrokes from the server are translated via the keyboard map.
48194c26a46c Initial revision
claus
parents:
diff changeset
   390
     Untranslated keystrokes arrive either as characters, or symbols
48194c26a46c Initial revision
claus
parents:
diff changeset
   391
     (which are the keySyms as symbol). The mapping table which is
48194c26a46c Initial revision
claus
parents:
diff changeset
   392
     setup here, is used in sendKeyPress:... later.
48194c26a46c Initial revision
claus
parents:
diff changeset
   393
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   394
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
   395
    keyboardMap isNil ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   396
	keyboardMap := KeyboardMap new.
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
   397
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   398
48194c26a46c Initial revision
claus
parents:
diff changeset
   399
    "
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   400
     no more setup here - moved everything out into 'display.rc' file
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   401
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   402
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   403
103
6156d12a414d *** empty log message ***
claus
parents: 98
diff changeset
   404
!DeviceWorkstation class methodsFor:'queries'!
6156d12a414d *** empty log message ***
claus
parents: 98
diff changeset
   405
6156d12a414d *** empty log message ***
claus
parents: 98
diff changeset
   406
platformName
106
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
   407
    "ST-80 compatibility.
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
   408
     Return a string describing the display systems platform.
157
claus
parents: 151
diff changeset
   409
     Returns a dummy here. This must be redefined in concrete
claus
parents: 151
diff changeset
   410
     Workstation classes, to return somthing like 'X', 'MSWindows', 'OS/2' etc."
103
6156d12a414d *** empty log message ***
claus
parents: 98
diff changeset
   411
6156d12a414d *** empty log message ***
claus
parents: 98
diff changeset
   412
    ^ 'unknown'
106
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
   413
!
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
   414
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
   415
default
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
   416
    "ST-80 compatibility.
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
   417
     Return the default screen"
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
   418
151
claus
parents: 146
diff changeset
   419
    ^ DefaultScreen
claus
parents: 146
diff changeset
   420
claus
parents: 146
diff changeset
   421
    "
claus
parents: 146
diff changeset
   422
     Screen default 
claus
parents: 146
diff changeset
   423
    "
claus
parents: 146
diff changeset
   424
!
claus
parents: 146
diff changeset
   425
claus
parents: 146
diff changeset
   426
default:aDevice
claus
parents: 146
diff changeset
   427
    "Set the default screen. This is sent very early during startup,
claus
parents: 146
diff changeset
   428
     and assigns the first opened screenDevice to both Display and the default
claus
parents: 146
diff changeset
   429
     screen. Use of the global Display should vanish over time."
claus
parents: 146
diff changeset
   430
claus
parents: 146
diff changeset
   431
    DefaultScreen := aDevice
claus
parents: 146
diff changeset
   432
!
claus
parents: 146
diff changeset
   433
claus
parents: 146
diff changeset
   434
current
claus
parents: 146
diff changeset
   435
    "EXPERIMENTAL: this should return the currently active screen,
claus
parents: 146
diff changeset
   436
     that is, the device of the currently executing windowGroup.
claus
parents: 146
diff changeset
   437
     It will be used in multi-display operation, to launch views on
claus
parents: 146
diff changeset
   438
     the correct device - even if not specified explicitely.
claus
parents: 146
diff changeset
   439
     This does not yet work fully satisfying ..."
claus
parents: 146
diff changeset
   440
claus
parents: 146
diff changeset
   441
    |wg tops v dev|
claus
parents: 146
diff changeset
   442
claus
parents: 146
diff changeset
   443
    "
claus
parents: 146
diff changeset
   444
     be careful, to not run into an error in case
claus
parents: 146
diff changeset
   445
     the current windowGroup got corrupted somehow ...
claus
parents: 146
diff changeset
   446
    "
claus
parents: 146
diff changeset
   447
    (wg := WindowGroup activeGroup) notNil ifTrue:[
claus
parents: 146
diff changeset
   448
	"
claus
parents: 146
diff changeset
   449
	 ok, not a background process or scheduler ...
claus
parents: 146
diff changeset
   450
	"
claus
parents: 146
diff changeset
   451
	(tops := wg topViews) notNil ifTrue:[
claus
parents: 146
diff changeset
   452
	    tops isEmpty ifFalse:[
claus
parents: 146
diff changeset
   453
		(v := tops first) notNil ifTrue:[
claus
parents: 146
diff changeset
   454
		    "
claus
parents: 146
diff changeset
   455
		     ok, it has a view ...
claus
parents: 146
diff changeset
   456
		    "
claus
parents: 146
diff changeset
   457
		    (dev := v device) notNil ifTrue:[
claus
parents: 146
diff changeset
   458
			^ dev
claus
parents: 146
diff changeset
   459
		    ]
claus
parents: 146
diff changeset
   460
		]
claus
parents: 146
diff changeset
   461
	    ]
claus
parents: 146
diff changeset
   462
	]
claus
parents: 146
diff changeset
   463
    ].
claus
parents: 146
diff changeset
   464
    "
claus
parents: 146
diff changeset
   465
     in all other cases, return the default display
claus
parents: 146
diff changeset
   466
    "
106
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
   467
    ^ Display
151
claus
parents: 146
diff changeset
   468
claus
parents: 146
diff changeset
   469
    "
claus
parents: 146
diff changeset
   470
     Screen current
claus
parents: 146
diff changeset
   471
    "
103
6156d12a414d *** empty log message ***
claus
parents: 98
diff changeset
   472
! !
6156d12a414d *** empty log message ***
claus
parents: 98
diff changeset
   473
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   474
!DeviceWorkstation class methodsFor:'error handling'!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   475
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   476
resourceIdOfLastError
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   477
    "return the resource id responsible for the last error"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   478
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   479
    ^ self subclassResponsibility
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   480
!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   481
134
claus
parents: 133
diff changeset
   482
lastErrorString
54
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
   483
    "return a string describing the last error"
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   484
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   485
    ^ self subclassResponsibility
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   486
!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   487
146
claus
parents: 145
diff changeset
   488
errorInterrupt:errID
144
claus
parents: 142
diff changeset
   489
    "DisplayError interrupt.
claus
parents: 142
diff changeset
   490
     This is invoked via 
claus
parents: 142
diff changeset
   491
	XError->errorInterrupt:#DisplayError->registeredErrorInterruptHandlers
claus
parents: 142
diff changeset
   492
claus
parents: 142
diff changeset
   493
     looks if a signal handler for DeviceErrorSignal is present,
claus
parents: 142
diff changeset
   494
     and - if so raises the signal. If the signal not handled, simply output a
claus
parents: 142
diff changeset
   495
     message and continue.
claus
parents: 142
diff changeset
   496
     This allows for non disrupted error reporting OR to catch and
claus
parents: 142
diff changeset
   497
     investigate errors as required."
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   498
54
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
   499
    |badId badResource msg|
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   500
144
claus
parents: 142
diff changeset
   501
    badId := self resourceIdOfLastError.
claus
parents: 142
diff changeset
   502
    badId ~~ 0 ifTrue:[
claus
parents: 142
diff changeset
   503
	badResource := self resourceOfId:badId.
claus
parents: 142
diff changeset
   504
    ].
claus
parents: 142
diff changeset
   505
    msg := 'Display error: ' , (self lastErrorString).
claus
parents: 142
diff changeset
   506
claus
parents: 142
diff changeset
   507
    DeviceErrorSignal isHandled ifFalse:[
claus
parents: 142
diff changeset
   508
	msg errorPrintNL.
claus
parents: 142
diff changeset
   509
	^ self
claus
parents: 142
diff changeset
   510
    ].
claus
parents: 142
diff changeset
   511
claus
parents: 142
diff changeset
   512
    ^ DeviceErrorSignal
142
claus
parents: 134
diff changeset
   513
	    raiseRequestWith:badResource 
claus
parents: 134
diff changeset
   514
	    errorString:msg
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   515
!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   516
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   517
resourceOfId:id
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   518
    "search thru all device stuff for a resource.
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   519
     Needed for error handling"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   520
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   521
    Form allInstances do:[:f |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   522
	f id == id ifTrue:[^ f]
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   523
    ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   524
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   525
    self allInstances do:[:aDisplay |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   526
	aDisplay allViewsDo:[:aView |
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   527
	    aView id == id ifTrue:[^ aView].
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   528
	    aView gcId == id ifTrue:[^ aView]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   529
	].
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   530
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   531
"/        |views|
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   532
"/        views := aDisplay knownViews.
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   533
"/        views notNil ifTrue:[
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   534
"/            views do:[:v |
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   535
"/                v id == id ifTrue:[^ v].
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   536
"/                v gcId == id ifTrue:[^ v]
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   537
"/            ].
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   538
"/        ].
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   539
    ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   540
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   541
    Color allInstances do:[:c |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   542
	c colorId == id ifTrue:[^ c]
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   543
    ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   544
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   545
    Font allInstances do:[:f |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   546
	f fontId == id ifTrue:[^ f]
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   547
    ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   548
    ^ nil
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   549
! !
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   550
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   551
!DeviceWorkstation methodsFor:'misc'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   552
48194c26a46c Initial revision
claus
parents:
diff changeset
   553
metaDown
48194c26a46c Initial revision
claus
parents:
diff changeset
   554
    "return true, if the meta-key (alt-key on systems without meta)
151
claus
parents: 146
diff changeset
   555
     is currently pressed."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   556
48194c26a46c Initial revision
claus
parents:
diff changeset
   557
    ^ metaDown
48194c26a46c Initial revision
claus
parents:
diff changeset
   558
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   559
48194c26a46c Initial revision
claus
parents:
diff changeset
   560
altDown
151
claus
parents: 146
diff changeset
   561
    "return true, if the alt-key is currently pressed."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   562
48194c26a46c Initial revision
claus
parents:
diff changeset
   563
    ^ altDown
48194c26a46c Initial revision
claus
parents:
diff changeset
   564
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   565
151
claus
parents: 146
diff changeset
   566
ctrlDown   
claus
parents: 146
diff changeset
   567
    "return true, if the control-key is currently pressed."
claus
parents: 146
diff changeset
   568
claus
parents: 146
diff changeset
   569
    ^ ctrlDown   
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   570
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   571
48194c26a46c Initial revision
claus
parents:
diff changeset
   572
shiftDown
151
claus
parents: 146
diff changeset
   573
    "return true, if the shift-key is currently pressed."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   574
48194c26a46c Initial revision
claus
parents:
diff changeset
   575
    ^ shiftDown
48194c26a46c Initial revision
claus
parents:
diff changeset
   576
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   577
48194c26a46c Initial revision
claus
parents:
diff changeset
   578
unBuffered
151
claus
parents: 146
diff changeset
   579
    "make all drawing be sent immediately to the display.
claus
parents: 146
diff changeset
   580
     This may horribly slow down your drawings, but will result
claus
parents: 146
diff changeset
   581
     in any errors to be delivered right after the bad operation
claus
parents: 146
diff changeset
   582
     (in X only). Only useful for debugging."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   583
48194c26a46c Initial revision
claus
parents:
diff changeset
   584
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
   585
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   586
48194c26a46c Initial revision
claus
parents:
diff changeset
   587
buffered
151
claus
parents: 146
diff changeset
   588
    "buffer drawing - do not send it immediately to the display.
claus
parents: 146
diff changeset
   589
     This is the default; see comment in #unBuffered."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   590
48194c26a46c Initial revision
claus
parents:
diff changeset
   591
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
   592
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   593
    
151
claus
parents: 146
diff changeset
   594
flush 
claus
parents: 146
diff changeset
   595
    "send all buffered drawing to the display.
claus
parents: 146
diff changeset
   596
     This used to be called #synchronizeOutput, but has been renamed
claus
parents: 146
diff changeset
   597
     for ST-80 compatibility."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   598
48194c26a46c Initial revision
claus
parents:
diff changeset
   599
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
   600
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   601
151
claus
parents: 146
diff changeset
   602
sync
claus
parents: 146
diff changeset
   603
    "for ST-80 compatibility"
claus
parents: 146
diff changeset
   604
claus
parents: 146
diff changeset
   605
    self flush
claus
parents: 146
diff changeset
   606
!
claus
parents: 146
diff changeset
   607
claus
parents: 146
diff changeset
   608
synchronizeOutput
claus
parents: 146
diff changeset
   609
    "send all buffered drawing to the display.
claus
parents: 146
diff changeset
   610
     OBSOLETE: please use #flush for ST-80 compatibility."
claus
parents: 146
diff changeset
   611
claus
parents: 146
diff changeset
   612
    self obsoleteMethodWarning:'use #flush'.
claus
parents: 146
diff changeset
   613
    ^ self flush
claus
parents: 146
diff changeset
   614
!
claus
parents: 146
diff changeset
   615
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   616
compressMotionEvents:aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   617
    "turn on/off motion event compression 
48194c26a46c Initial revision
claus
parents:
diff changeset
   618
     - compressions makes always sense except in free-hand drawing of curves"
48194c26a46c Initial revision
claus
parents:
diff changeset
   619
48194c26a46c Initial revision
claus
parents:
diff changeset
   620
    motionEventCompression := aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   621
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   622
48194c26a46c Initial revision
claus
parents:
diff changeset
   623
hasColors:aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   624
    "set the hasColors flag - needed since some servers dont tell the
151
claus
parents: 146
diff changeset
   625
     truth if a monochrome monitor is connected to a color server.
claus
parents: 146
diff changeset
   626
     Clearing the hasColors flag in the rc file will force use of grey
claus
parents: 146
diff changeset
   627
     colors (which might make a difference, since some colors are hard to
claus
parents: 146
diff changeset
   628
     distinguish on a greyscale monitor)."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   629
48194c26a46c Initial revision
claus
parents:
diff changeset
   630
    hasColors := aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   631
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   632
48194c26a46c Initial revision
claus
parents:
diff changeset
   633
hasGreyscales:aBoolean
151
claus
parents: 146
diff changeset
   634
    "set the hasGreyscales flag - can be used to simulate b&w behavior
claus
parents: 146
diff changeset
   635
     on greyScale and color monitors.
claus
parents: 146
diff changeset
   636
     (You may want to check if your application looks ok if displayed on
claus
parents: 146
diff changeset
   637
      a b&w monitor - even if you have a color display. To do so, clear
claus
parents: 146
diff changeset
   638
       the hasGreyscales flag from your .rc file)"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   639
48194c26a46c Initial revision
claus
parents:
diff changeset
   640
    hasGreyscales := aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   641
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   642
48194c26a46c Initial revision
claus
parents:
diff changeset
   643
ignoreBackingStore:aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   644
    "if the argument is true, the views backingStore setting will be ignored, and
48194c26a46c Initial revision
claus
parents:
diff changeset
   645
     no backing store used - this can be used on servers where backing store is
48194c26a46c Initial revision
claus
parents:
diff changeset
   646
     very slow (from rc-file)"
48194c26a46c Initial revision
claus
parents:
diff changeset
   647
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   648
    ^ self
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   649
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   650
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   651
isSlow:aBoolean
151
claus
parents: 146
diff changeset
   652
    "set/clear the slow flag.
claus
parents: 146
diff changeset
   653
     The slow-flag has no semantic meaning by itself; 
claus
parents: 146
diff changeset
   654
     however, it can be set via the display.rc file and tested at various
claus
parents: 146
diff changeset
   655
     other places to turn off some bells&whistles which might slow down
claus
parents: 146
diff changeset
   656
     the drawing. For example, shadows under popUps are suppressed if isSlow
claus
parents: 146
diff changeset
   657
     is set."
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   658
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   659
    isSlow := aBoolean
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   660
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   661
48194c26a46c Initial revision
claus
parents:
diff changeset
   662
beep
48194c26a46c Initial revision
claus
parents:
diff changeset
   663
    "output an audible beep or bell"
48194c26a46c Initial revision
claus
parents:
diff changeset
   664
48194c26a46c Initial revision
claus
parents:
diff changeset
   665
    Stdout nextPut:(Character bell)
48194c26a46c Initial revision
claus
parents:
diff changeset
   666
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   667
151
claus
parents: 146
diff changeset
   668
ringBell
claus
parents: 146
diff changeset
   669
    "alias for beep; for ST-80 compatibility"
claus
parents: 146
diff changeset
   670
claus
parents: 146
diff changeset
   671
    self beep
claus
parents: 146
diff changeset
   672
!
claus
parents: 146
diff changeset
   673
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   674
setInputFocusTo:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
   675
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
   676
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   677
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   678
!DeviceWorkstation methodsFor:'enumerating'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   679
48194c26a46c Initial revision
claus
parents:
diff changeset
   680
allViewsDo:aBlock
151
claus
parents: 146
diff changeset
   681
    "evaluate the argument, aBlock for all of my known views"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   682
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   683
"/    idToViewMapping notNil ifTrue:[
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   684
"/        idToViewMapping keysAndValuesDo:[:id :aView |
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   685
"/            aView notNil ifTrue:[
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   686
"/                aBlock value:aView
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   687
"/            ]
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
   688
"/      ]
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
   689
        
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
   690
                
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   691
    knownViews notNil ifTrue:[
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   692
      knownViews do:[:aView |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   693
	  aView notNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   694
	      aBlock value:aView
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   695
	  ]
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
   696
      ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   697
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   698
48194c26a46c Initial revision
claus
parents:
diff changeset
   699
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   700
     View defaultStyle:#iris.
48194c26a46c Initial revision
claus
parents:
diff changeset
   701
     Display allViewsDo:[:v | v initStyle. v redraw]
48194c26a46c Initial revision
claus
parents:
diff changeset
   702
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   703
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   704
     View defaultStyle:#next.
48194c26a46c Initial revision
claus
parents:
diff changeset
   705
     Display allViewsDo:[:v | v initStyle. v redraw]
48194c26a46c Initial revision
claus
parents:
diff changeset
   706
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   707
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   708
     View defaultStyle:#normal.
48194c26a46c Initial revision
claus
parents:
diff changeset
   709
     Display allViewsDo:[:v | v initStyle. v redraw]
48194c26a46c Initial revision
claus
parents:
diff changeset
   710
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   711
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   712
133
claus
parents: 123
diff changeset
   713
!DeviceWorkstation methodsFor:'printing & storing'!
claus
parents: 123
diff changeset
   714
claus
parents: 123
diff changeset
   715
printOn:aStream
151
claus
parents: 146
diff changeset
   716
    "for your convenience, add the name of the display connection
claus
parents: 146
diff changeset
   717
     or 'default' to the printed representation."
claus
parents: 146
diff changeset
   718
claus
parents: 146
diff changeset
   719
    |name|
133
claus
parents: 123
diff changeset
   720
claus
parents: 123
diff changeset
   721
    super printOn:aStream.
claus
parents: 123
diff changeset
   722
claus
parents: 123
diff changeset
   723
    aStream nextPut:$(.
151
claus
parents: 146
diff changeset
   724
    (name := self displayName) isNil ifTrue:[
claus
parents: 146
diff changeset
   725
	name := 'defaultDisplay'
133
claus
parents: 123
diff changeset
   726
    ].
151
claus
parents: 146
diff changeset
   727
    aStream nextPutAll:name.
133
claus
parents: 123
diff changeset
   728
    aStream nextPut:$)
claus
parents: 123
diff changeset
   729
! !
claus
parents: 123
diff changeset
   730
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   731
!DeviceWorkstation methodsFor:'accessing & queries'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   732
48194c26a46c Initial revision
claus
parents:
diff changeset
   733
displayFileDescriptor
10
470d292c3218 before big change
claus
parents: 8
diff changeset
   734
    "return the file descriptor associated with the display
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   735
     if any. If there is no underlying filedescriptor, return nil.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   736
     (used for event select/polling)"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
   737
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   738
    ^ nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   739
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   740
133
claus
parents: 123
diff changeset
   741
displayName
151
claus
parents: 146
diff changeset
   742
    "return the display name - that is the name of the display connection
claus
parents: 146
diff changeset
   743
     or nil, for default display. For example, in X, this returns a string
claus
parents: 146
diff changeset
   744
     like 'hostname:0' for remote connections, and nil for a default local
claus
parents: 146
diff changeset
   745
     connection.
133
claus
parents: 123
diff changeset
   746
     - nothing known here, but maybe redefined in subclasses."
claus
parents: 123
diff changeset
   747
claus
parents: 123
diff changeset
   748
    ^ nil
151
claus
parents: 146
diff changeset
   749
claus
parents: 146
diff changeset
   750
    "
claus
parents: 146
diff changeset
   751
     Display displayName  
claus
parents: 146
diff changeset
   752
    "
133
claus
parents: 123
diff changeset
   753
!
claus
parents: 123
diff changeset
   754
98
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
   755
platformName
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
   756
    "return a string describing the display systems platform.
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
   757
     Returns a dummy here."
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
   758
103
6156d12a414d *** empty log message ***
claus
parents: 98
diff changeset
   759
    ^ self class platformName
151
claus
parents: 146
diff changeset
   760
claus
parents: 146
diff changeset
   761
    "
claus
parents: 146
diff changeset
   762
     Display platformName  
claus
parents: 146
diff changeset
   763
    "
98
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
   764
!
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
   765
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   766
serverVendor
98
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
   767
    "return a string describing the display systems server vendor.
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
   768
     Returns a dummy here"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
   769
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   770
    ^ 'generic'
151
claus
parents: 146
diff changeset
   771
claus
parents: 146
diff changeset
   772
    "
claus
parents: 146
diff changeset
   773
     Display serverVendor  
claus
parents: 146
diff changeset
   774
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   775
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   776
48194c26a46c Initial revision
claus
parents:
diff changeset
   777
vendorRelease
98
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
   778
    "return the display systems release number.
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
   779
     Returns a dummy here."
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   780
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   781
    ^ 0
157
claus
parents: 151
diff changeset
   782
claus
parents: 151
diff changeset
   783
    "
claus
parents: 151
diff changeset
   784
     Display vendorRelease    
claus
parents: 151
diff changeset
   785
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   786
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   787
48194c26a46c Initial revision
claus
parents:
diff changeset
   788
protocolVersion
98
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
   789
    "return the display systems protocol version number.
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
   790
     Returns a dummy here"
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   791
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   792
    ^ 0
157
claus
parents: 151
diff changeset
   793
claus
parents: 151
diff changeset
   794
    "
claus
parents: 151
diff changeset
   795
     Display protocolVersion  
claus
parents: 151
diff changeset
   796
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   797
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   798
159
claus
parents: 157
diff changeset
   799
glVersion
claus
parents: 157
diff changeset
   800
    "return a string describing the GL version.
claus
parents: 157
diff changeset
   801
     Since the generic display does not support 3D GL graphics,
claus
parents: 157
diff changeset
   802
     a dummy is returned here."
claus
parents: 157
diff changeset
   803
claus
parents: 157
diff changeset
   804
    ^ 'noGL'
claus
parents: 157
diff changeset
   805
claus
parents: 157
diff changeset
   806
    "
claus
parents: 157
diff changeset
   807
     Display glVersion 
claus
parents: 157
diff changeset
   808
    "
claus
parents: 157
diff changeset
   809
!
claus
parents: 157
diff changeset
   810
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   811
blackpixel
48194c26a46c Initial revision
claus
parents:
diff changeset
   812
    "return the colorId of black"
48194c26a46c Initial revision
claus
parents:
diff changeset
   813
48194c26a46c Initial revision
claus
parents:
diff changeset
   814
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
   815
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   816
48194c26a46c Initial revision
claus
parents:
diff changeset
   817
whitepixel
48194c26a46c Initial revision
claus
parents:
diff changeset
   818
    "return the colorId of white"
48194c26a46c Initial revision
claus
parents:
diff changeset
   819
48194c26a46c Initial revision
claus
parents:
diff changeset
   820
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
   821
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   822
48194c26a46c Initial revision
claus
parents:
diff changeset
   823
viewIdFromPoint:aPoint in:windowId
48194c26a46c Initial revision
claus
parents:
diff changeset
   824
    "given a point in rootWindow, return the viewId of the subview of windowId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   825
     hit by this coordinate. Return nil if no view was hit.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   826
     - use to find window to drop objects after a cross-view drag"
48194c26a46c Initial revision
claus
parents:
diff changeset
   827
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   828
    "returning nil here actually makes drag&drop impossible
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   829
     - could also be reimplemented to make a search over all knownViews here.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   830
     This method has to be reimplemented in concrete display classes."
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   831
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   832
    ^ nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   833
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   834
48194c26a46c Initial revision
claus
parents:
diff changeset
   835
translatePoint:aPoint from:windowId1 to:windowId2
151
claus
parents: 146
diff changeset
   836
    "given a point in window1 (defined by its id), return the coordinate of
claus
parents: 146
diff changeset
   837
     aPoint in window2 (defined by its id).
claus
parents: 146
diff changeset
   838
     Use to xlate points from a window to rootwindow, mainly for rubber-line
claus
parents: 146
diff changeset
   839
     drawing on the displays root window."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   840
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   841
    "This method has to be reimplemented in concrete display classes."
151
claus
parents: 146
diff changeset
   842
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   843
    ^ self subclassResponsibility
151
claus
parents: 146
diff changeset
   844
claus
parents: 146
diff changeset
   845
    "
claus
parents: 146
diff changeset
   846
     |v p root|
claus
parents: 146
diff changeset
   847
claus
parents: 146
diff changeset
   848
     v := View new.
claus
parents: 146
diff changeset
   849
     v openAndWait.
claus
parents: 146
diff changeset
   850
claus
parents: 146
diff changeset
   851
     root := v device rootView.
claus
parents: 146
diff changeset
   852
claus
parents: 146
diff changeset
   853
     p := v device translatePoint:10@10 from:(v id) to:(root id).
claus
parents: 146
diff changeset
   854
claus
parents: 146
diff changeset
   855
     root clippedByChildren:false.
claus
parents: 146
diff changeset
   856
     root displayLineFrom:0@0 to:p.
claus
parents: 146
diff changeset
   857
     root clippedByChildren:true.
claus
parents: 146
diff changeset
   858
    "
claus
parents: 146
diff changeset
   859
    "
claus
parents: 146
diff changeset
   860
     |v1 v2 p1 p2 root|
claus
parents: 146
diff changeset
   861
claus
parents: 146
diff changeset
   862
     v1 := View new.
claus
parents: 146
diff changeset
   863
     v1 openAndWait.
claus
parents: 146
diff changeset
   864
claus
parents: 146
diff changeset
   865
     v2 := View new.
claus
parents: 146
diff changeset
   866
     v2 openAndWait.
claus
parents: 146
diff changeset
   867
claus
parents: 146
diff changeset
   868
     root := v1 device rootView.
claus
parents: 146
diff changeset
   869
claus
parents: 146
diff changeset
   870
     p1 := v1 device translatePoint:10@10 from:(v1 id) to:(root id).
claus
parents: 146
diff changeset
   871
     p2 := v1 device translatePoint:10@10 from:(v2 id) to:(root id).
claus
parents: 146
diff changeset
   872
claus
parents: 146
diff changeset
   873
     root clippedByChildren:false.
claus
parents: 146
diff changeset
   874
     root displayLineFrom:p1 to:p2.
claus
parents: 146
diff changeset
   875
     root clippedByChildren:true.
claus
parents: 146
diff changeset
   876
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   877
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   878
157
claus
parents: 151
diff changeset
   879
viewIdFromPoint:aPoint
claus
parents: 151
diff changeset
   880
    "given a point on the screen, return the id of the ST/X view in which that
claus
parents: 151
diff changeset
   881
     point is (this may be a subview). Return nil, if its not an ST/X view
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   882
     or if the point is on the background"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   883
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   884
    |view id searchId foundId|
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   885
151
claus
parents: 146
diff changeset
   886
    searchId := self rootWindowId.
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   887
    [searchId notNil] whileTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   888
	id := self viewIdFromPoint:aPoint in:searchId.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   889
	foundId := searchId.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   890
	searchId := id
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   891
    ].
157
claus
parents: 151
diff changeset
   892
    ^ foundId
claus
parents: 151
diff changeset
   893
!
claus
parents: 151
diff changeset
   894
claus
parents: 151
diff changeset
   895
viewFromPoint:aPoint
claus
parents: 151
diff changeset
   896
    "given a point on the screen, return the ST/X view in which that
claus
parents: 151
diff changeset
   897
     point is (this may be a subview). Return nil, if its not an ST/X view
claus
parents: 151
diff changeset
   898
     or if the point is on the background"
claus
parents: 151
diff changeset
   899
claus
parents: 151
diff changeset
   900
    |view id|
claus
parents: 151
diff changeset
   901
claus
parents: 151
diff changeset
   902
    id := self viewIdFromPoint:aPoint.
claus
parents: 151
diff changeset
   903
    view := self viewFromId:id.
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   904
    ^ view
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   905
!
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   906
151
claus
parents: 146
diff changeset
   907
windowAt:aPoint
157
claus
parents: 151
diff changeset
   908
    "given a point on the screen, return the ST/X topview in which that
claus
parents: 151
diff changeset
   909
     point is. 
claus
parents: 151
diff changeset
   910
     Return nil, if its not an ST/X view or if the point is on the background.
claus
parents: 151
diff changeset
   911
     Alias for viewFromPoint: - ST-80 compatibility"
151
claus
parents: 146
diff changeset
   912
claus
parents: 146
diff changeset
   913
    ^ self viewFromPoint:aPoint
claus
parents: 146
diff changeset
   914
!
claus
parents: 146
diff changeset
   915
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   916
id
48194c26a46c Initial revision
claus
parents:
diff changeset
   917
    "return the displayId"
48194c26a46c Initial revision
claus
parents:
diff changeset
   918
48194c26a46c Initial revision
claus
parents:
diff changeset
   919
    ^ displayId
48194c26a46c Initial revision
claus
parents:
diff changeset
   920
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   921
48194c26a46c Initial revision
claus
parents:
diff changeset
   922
ncells
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   923
    "return the number of usable color cells, the display has 
151
claus
parents: 146
diff changeset
   924
     - this is not always 2 to the power of depth
claus
parents: 146
diff changeset
   925
     (for example, on 6bit displays, ncells is 64 while depth is 8)"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   926
48194c26a46c Initial revision
claus
parents:
diff changeset
   927
    ^ ncells
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   928
151
claus
parents: 146
diff changeset
   929
    "
claus
parents: 146
diff changeset
   930
     Display ncells
claus
parents: 146
diff changeset
   931
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   932
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   933
48194c26a46c Initial revision
claus
parents:
diff changeset
   934
depth
48194c26a46c Initial revision
claus
parents:
diff changeset
   935
    "return the depth in pixels of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   936
48194c26a46c Initial revision
claus
parents:
diff changeset
   937
    ^ depth
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   938
151
claus
parents: 146
diff changeset
   939
    "
claus
parents: 146
diff changeset
   940
     Display depth
claus
parents: 146
diff changeset
   941
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   942
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   943
48194c26a46c Initial revision
claus
parents:
diff changeset
   944
bitsPerRGB
151
claus
parents: 146
diff changeset
   945
    "return the number of valid bits per rgb component.
claus
parents: 146
diff changeset
   946
     Currently, assume that r/g/b all have the same precision,
claus
parents: 146
diff changeset
   947
     which is a stupid assumption (there may be some, where less
claus
parents: 146
diff changeset
   948
     resolution is available in the blue component).
claus
parents: 146
diff changeset
   949
     Therefore, this may be changed to return a 3-element vector."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   950
48194c26a46c Initial revision
claus
parents:
diff changeset
   951
    ^ bitsPerRGB
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   952
151
claus
parents: 146
diff changeset
   953
    "
claus
parents: 146
diff changeset
   954
     Display bitsPerRGB 
claus
parents: 146
diff changeset
   955
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   956
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   957
48194c26a46c Initial revision
claus
parents:
diff changeset
   958
visualType:aSymbol
151
claus
parents: 146
diff changeset
   959
    "set the visual type. 
claus
parents: 146
diff changeset
   960
     The only situation, where setting the visual makes sense,
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   961
     is with my plasma-display, which ignores the palette and spits out
151
claus
parents: 146
diff changeset
   962
     grey scales, independent of color LUT definitions. 
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   963
     (of which the server knows nothing).
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   964
     So, this should be used from a display-specific startup file only."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   965
48194c26a46c Initial revision
claus
parents:
diff changeset
   966
    visualType := aSymbol.
48194c26a46c Initial revision
claus
parents:
diff changeset
   967
    (visualType == #StaticGray or:[visualType == #GrayScale]) ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   968
	hasColors := false
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   969
    ] ifFalse:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
   970
	hasColors := true
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   971
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   972
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   973
48194c26a46c Initial revision
claus
parents:
diff changeset
   974
visualType
48194c26a46c Initial revision
claus
parents:
diff changeset
   975
    "return a symbol representing the visual type of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   976
48194c26a46c Initial revision
claus
parents:
diff changeset
   977
    ^ visualType
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   978
151
claus
parents: 146
diff changeset
   979
    "
claus
parents: 146
diff changeset
   980
     Display visualType
claus
parents: 146
diff changeset
   981
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   982
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   983
48194c26a46c Initial revision
claus
parents:
diff changeset
   984
monitorType
48194c26a46c Initial revision
claus
parents:
diff changeset
   985
    "return a symbol representing the monitor type of the display.
48194c26a46c Initial revision
claus
parents:
diff changeset
   986
     It is usually set to #unknown, #color or #monochrome.
48194c26a46c Initial revision
claus
parents:
diff changeset
   987
     But it can be set to any value from the startup file, for later
48194c26a46c Initial revision
claus
parents:
diff changeset
   988
     testing from anywhere. For example the startup for plasma-displays 
48194c26a46c Initial revision
claus
parents:
diff changeset
   989
     can set it to #plasma to later influence the colors used in widgets
48194c26a46c Initial revision
claus
parents:
diff changeset
   990
     (indirectly through the resource file)."
48194c26a46c Initial revision
claus
parents:
diff changeset
   991
48194c26a46c Initial revision
claus
parents:
diff changeset
   992
    ^ monitorType
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   993
151
claus
parents: 146
diff changeset
   994
    "
157
claus
parents: 151
diff changeset
   995
     Display monitorType  
151
claus
parents: 146
diff changeset
   996
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   997
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   998
48194c26a46c Initial revision
claus
parents:
diff changeset
   999
monitorType:aSymbol
48194c26a46c Initial revision
claus
parents:
diff changeset
  1000
    "set the monitorType - see comment in DeviceWorkstation>>montorType"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1001
48194c26a46c Initial revision
claus
parents:
diff changeset
  1002
    monitorType := aSymbol
48194c26a46c Initial revision
claus
parents:
diff changeset
  1003
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1004
48194c26a46c Initial revision
claus
parents:
diff changeset
  1005
hasColors
48194c26a46c Initial revision
claus
parents:
diff changeset
  1006
    "return true, if its a color display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1007
48194c26a46c Initial revision
claus
parents:
diff changeset
  1008
    ^ hasColors
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1009
151
claus
parents: 146
diff changeset
  1010
    "
157
claus
parents: 151
diff changeset
  1011
     Display hasColors 
151
claus
parents: 146
diff changeset
  1012
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1013
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1014
48194c26a46c Initial revision
claus
parents:
diff changeset
  1015
hasGreyscales
48194c26a46c Initial revision
claus
parents:
diff changeset
  1016
    "return true, if this workstation supports greyscales
48194c26a46c Initial revision
claus
parents:
diff changeset
  1017
     (also true for color displays)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1018
48194c26a46c Initial revision
claus
parents:
diff changeset
  1019
    ^ hasGreyscales
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1020
151
claus
parents: 146
diff changeset
  1021
    "
157
claus
parents: 151
diff changeset
  1022
     Display hasGreyscales 
151
claus
parents: 146
diff changeset
  1023
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1024
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1025
48194c26a46c Initial revision
claus
parents:
diff changeset
  1026
hasShape
48194c26a46c Initial revision
claus
parents:
diff changeset
  1027
    "return true, if this workstation supports non-rectangular windows"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1028
48194c26a46c Initial revision
claus
parents:
diff changeset
  1029
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
  1030
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1031
48194c26a46c Initial revision
claus
parents:
diff changeset
  1032
hasShm
48194c26a46c Initial revision
claus
parents:
diff changeset
  1033
    "return true, if this workstation supports shared pixmaps"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1034
48194c26a46c Initial revision
claus
parents:
diff changeset
  1035
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
  1036
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1037
48194c26a46c Initial revision
claus
parents:
diff changeset
  1038
hasFax
48194c26a46c Initial revision
claus
parents:
diff changeset
  1039
    "return true, if this workstation supports decompression of fax images"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1040
48194c26a46c Initial revision
claus
parents:
diff changeset
  1041
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
  1042
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1043
48194c26a46c Initial revision
claus
parents:
diff changeset
  1044
hasDPS
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1045
    "return true, if this workstation supports postscript output into views"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1046
48194c26a46c Initial revision
claus
parents:
diff changeset
  1047
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
  1048
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1049
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1050
isSlow
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1051
    "return true, if this is a relatively slow device -
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1052
     used to turn off things like popup-shadows"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1053
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1054
    ^ isSlow
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1055
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1056
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1057
supportsDeepIcons
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1058
    "return true, if this device supports non b&w (i.e. greyScale
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1059
     or colored icons). We really dont know here."
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1060
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1061
    "This method has to be reimplemented in concrete display classes."
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1062
    ^ self subclassResponsibility
157
claus
parents: 151
diff changeset
  1063
claus
parents: 151
diff changeset
  1064
    "
claus
parents: 151
diff changeset
  1065
     Display supportsDeepIcons 
claus
parents: 151
diff changeset
  1066
    "
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1067
!
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1068
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1069
supportsViewGravity
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1070
    "return true, if this device supports gravity attributes.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1071
     We do not depend on the being implemented, but some resizing operations
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1072
     are faster, it is is."
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1073
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1074
    "This method should to be reimplemented in concrete display classes."
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1075
    ^ false
157
claus
parents: 151
diff changeset
  1076
claus
parents: 151
diff changeset
  1077
    "
claus
parents: 151
diff changeset
  1078
     Display supportsViewGravity 
claus
parents: 151
diff changeset
  1079
    "
claus
parents: 151
diff changeset
  1080
!
claus
parents: 151
diff changeset
  1081
claus
parents: 151
diff changeset
  1082
supportsGLDrawing
claus
parents: 151
diff changeset
  1083
    "return true, if this device supports 3D GL drawing.
claus
parents: 151
diff changeset
  1084
     We do not depend on that being implemented."
claus
parents: 151
diff changeset
  1085
claus
parents: 151
diff changeset
  1086
    "This method should to be reimplemented in concrete display classes."
claus
parents: 151
diff changeset
  1087
    ^ false
claus
parents: 151
diff changeset
  1088
claus
parents: 151
diff changeset
  1089
    "
claus
parents: 151
diff changeset
  1090
     Display supportsGLDrawing 
claus
parents: 151
diff changeset
  1091
    "
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1092
!
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1093
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1094
keyboardMap
48194c26a46c Initial revision
claus
parents:
diff changeset
  1095
    "return the keyboard map"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1096
48194c26a46c Initial revision
claus
parents:
diff changeset
  1097
    ^ keyboardMap
48194c26a46c Initial revision
claus
parents:
diff changeset
  1098
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1099
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  1100
keyboardMap:aMap
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  1101
    "set the keyboard map"
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  1102
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  1103
    keyboardMap := aMap
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  1104
!
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  1105
151
claus
parents: 146
diff changeset
  1106
dispatchProcess
claus
parents: 146
diff changeset
  1107
    ^ dispatchProcess
claus
parents: 146
diff changeset
  1108
!
claus
parents: 146
diff changeset
  1109
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1110
width
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1111
    "return the width of the display (in pixels)"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1112
48194c26a46c Initial revision
claus
parents:
diff changeset
  1113
    ^ width
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1114
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1115
    "Display width"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1116
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1117
48194c26a46c Initial revision
claus
parents:
diff changeset
  1118
height
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1119
    "return the height of the display (in pixels)"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1120
48194c26a46c Initial revision
claus
parents:
diff changeset
  1121
    ^ height
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1122
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1123
    "Display height"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1124
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1125
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1126
extent
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1127
    "return the extent of the display (in pixels)"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1128
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1129
    ^ width @ height
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1130
106
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1131
    "
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1132
     Display extent
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1133
    "
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1134
!
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1135
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1136
bounds
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1137
    "return a rectangle representing the displays bounding box.
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1138
     For Smalltalk-80 4.x compatibility"
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1139
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1140
    ^ Rectangle origin:(0 @ 0) extent:(width @ height)
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1141
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1142
    "
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1143
     Screen default bounds
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1144
    "
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1145
    "/ thats the same as:
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1146
    "
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1147
     Display bounds
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1148
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1149
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1150
48194c26a46c Initial revision
claus
parents:
diff changeset
  1151
boundingBox
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1152
    "return a rectangle representing the displays bounding box.
106
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1153
     For Smalltalk-80 2.x compatibility"
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1154
6f59373d066e *** empty log message ***
claus
parents: 103
diff changeset
  1155
    ^ self bounds
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1156
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1157
48194c26a46c Initial revision
claus
parents:
diff changeset
  1158
widthInMillimeter
48194c26a46c Initial revision
claus
parents:
diff changeset
  1159
    "return the width in millimeter of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1160
48194c26a46c Initial revision
claus
parents:
diff changeset
  1161
    ^ widthMM
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1162
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1163
    "Display widthInMillimeter"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1164
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1165
48194c26a46c Initial revision
claus
parents:
diff changeset
  1166
heightInMillimeter
48194c26a46c Initial revision
claus
parents:
diff changeset
  1167
    "return the height in millimeter of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1168
48194c26a46c Initial revision
claus
parents:
diff changeset
  1169
    ^ heightMM
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1170
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1171
    "Display heightInMillimeter"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1172
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1173
48194c26a46c Initial revision
claus
parents:
diff changeset
  1174
widthInMillimeter:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
  1175
    "set the width in millimeter of the display 
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1176
     - needed since some displays do not tell the truth or do not know it"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1177
48194c26a46c Initial revision
claus
parents:
diff changeset
  1178
    widthMM := aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
  1179
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1180
48194c26a46c Initial revision
claus
parents:
diff changeset
  1181
heightInMillimeter:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
  1182
    "set the height in millimeter of the display 
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1183
     - needed since some displays do not tell the truth or do not know it"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1184
48194c26a46c Initial revision
claus
parents:
diff changeset
  1185
    heightMM := aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
  1186
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1187
48194c26a46c Initial revision
claus
parents:
diff changeset
  1188
pixelPerMillimeter
48194c26a46c Initial revision
claus
parents:
diff changeset
  1189
    "return the number of horizontal/vertical pixels per millimeter of the display as Point"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1190
48194c26a46c Initial revision
claus
parents:
diff changeset
  1191
    ^ (width / widthMM) @ (height / heightMM)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1192
48194c26a46c Initial revision
claus
parents:
diff changeset
  1193
    "Display pixelPerMillimeter"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1194
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1195
48194c26a46c Initial revision
claus
parents:
diff changeset
  1196
pixelPerInch
48194c26a46c Initial revision
claus
parents:
diff changeset
  1197
    "return the number of horizontal/vertical pixels per inch of the display as Point"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1198
48194c26a46c Initial revision
claus
parents:
diff changeset
  1199
    ^ ((width / widthMM) @ (height / heightMM)) * 25.4
48194c26a46c Initial revision
claus
parents:
diff changeset
  1200
48194c26a46c Initial revision
claus
parents:
diff changeset
  1201
    "Display pixelPerInch"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1202
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1203
48194c26a46c Initial revision
claus
parents:
diff changeset
  1204
horizontalPixelPerMillimeter
48194c26a46c Initial revision
claus
parents:
diff changeset
  1205
    "return the number of horizontal pixels per millimeter of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1206
48194c26a46c Initial revision
claus
parents:
diff changeset
  1207
    ^ width / widthMM
48194c26a46c Initial revision
claus
parents:
diff changeset
  1208
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1209
48194c26a46c Initial revision
claus
parents:
diff changeset
  1210
verticalPixelPerMillimeter
48194c26a46c Initial revision
claus
parents:
diff changeset
  1211
    "return the number of vertical pixels per millimeter of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1212
48194c26a46c Initial revision
claus
parents:
diff changeset
  1213
    ^ height / heightMM
48194c26a46c Initial revision
claus
parents:
diff changeset
  1214
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1215
48194c26a46c Initial revision
claus
parents:
diff changeset
  1216
horizontalPixelPerInch
48194c26a46c Initial revision
claus
parents:
diff changeset
  1217
    "return the number of horizontal pixels per inch of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1218
48194c26a46c Initial revision
claus
parents:
diff changeset
  1219
    ^ (width / widthMM) * 25.4
48194c26a46c Initial revision
claus
parents:
diff changeset
  1220
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1221
48194c26a46c Initial revision
claus
parents:
diff changeset
  1222
verticalPixelPerInch
48194c26a46c Initial revision
claus
parents:
diff changeset
  1223
    "return the number of vertical pixels per inch of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1224
48194c26a46c Initial revision
claus
parents:
diff changeset
  1225
    ^ (height / heightMM) * 25.4
48194c26a46c Initial revision
claus
parents:
diff changeset
  1226
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1227
48194c26a46c Initial revision
claus
parents:
diff changeset
  1228
center
48194c26a46c Initial revision
claus
parents:
diff changeset
  1229
    "return the centerpoint in pixels of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1230
48194c26a46c Initial revision
claus
parents:
diff changeset
  1231
    ^ (width // 2) @ (height // 2)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1232
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1233
48194c26a46c Initial revision
claus
parents:
diff changeset
  1234
knownViews
48194c26a46c Initial revision
claus
parents:
diff changeset
  1235
    "return a collection of all known views"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1236
48194c26a46c Initial revision
claus
parents:
diff changeset
  1237
    ^ knownViews
48194c26a46c Initial revision
claus
parents:
diff changeset
  1238
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1239
48194c26a46c Initial revision
claus
parents:
diff changeset
  1240
knownViews:aCollection
48194c26a46c Initial revision
claus
parents:
diff changeset
  1241
    "set the collection of all known views - take care,
48194c26a46c Initial revision
claus
parents:
diff changeset
  1242
     bad use of this will create funny results; use only for snapshot support"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1243
48194c26a46c Initial revision
claus
parents:
diff changeset
  1244
    knownViews := aCollection
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1245
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1246
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1247
buttonTranslation
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1248
    ^ buttonTranslation
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1249
!
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1250
75
claus
parents: 71
diff changeset
  1251
buttonTranslation:anArray
claus
parents: 71
diff changeset
  1252
    buttonTranslation := anArray
claus
parents: 71
diff changeset
  1253
!
claus
parents: 71
diff changeset
  1254
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1255
buttonMotionMask:aMask includesButton:aButton
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1256
    "given a device button mask, return true if a logical button
133
claus
parents: 123
diff changeset
  1257
     (1 .. 3 for left .. right) is included."
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1258
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1259
    |buttonNr|
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1260
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1261
    "reverse buttonTranslation"
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1262
    buttonTranslation notNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1263
	buttonNr := buttonTranslation indexOf:aButton ifAbsent:[1].
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1264
    ] ifFalse:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1265
	buttonNr := aButton.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1266
    ].
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1267
    ^ (aMask bitTest:(self buttonMotionMask:buttonNr))
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1268
!
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1269
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1270
multiClickTimeDelta 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1271
    ^ multiClickTimeDelta
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1272
!
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1273
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1274
multiClickTimeDelta:milliseconds
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1275
    multiClickTimeDelta := milliseconds
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1276
! !
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1277
133
claus
parents: 123
diff changeset
  1278
!DeviceWorkstation methodsFor:'pointer queries'!
claus
parents: 123
diff changeset
  1279
claus
parents: 123
diff changeset
  1280
rootPositionOfLastEvent
claus
parents: 123
diff changeset
  1281
    "return the position in root-window coordinates
claus
parents: 123
diff changeset
  1282
     of the last button, key or pointer event.
claus
parents: 123
diff changeset
  1283
     Must be redefined by concrete subclasses."
claus
parents: 123
diff changeset
  1284
claus
parents: 123
diff changeset
  1285
    ^ self subclassResponsibility
claus
parents: 123
diff changeset
  1286
!
claus
parents: 123
diff changeset
  1287
claus
parents: 123
diff changeset
  1288
pointerPosition
claus
parents: 123
diff changeset
  1289
    "return the current pointer position in root-window coordinates.
claus
parents: 123
diff changeset
  1290
     Must be redefined by concrete subclasses."
claus
parents: 123
diff changeset
  1291
claus
parents: 123
diff changeset
  1292
    ^ self subclassResponsibility
claus
parents: 123
diff changeset
  1293
!
claus
parents: 123
diff changeset
  1294
claus
parents: 123
diff changeset
  1295
buttonStates
claus
parents: 123
diff changeset
  1296
    "return an integer representing the state of the pointer buttons;
claus
parents: 123
diff changeset
  1297
     a one-bit represents a pressed button. The bit positions are device specific
claus
parents: 123
diff changeset
  1298
     and to be returned by the *ButtonStateMask methods.
claus
parents: 123
diff changeset
  1299
     Must be redefined by concrete subclasses."
claus
parents: 123
diff changeset
  1300
claus
parents: 123
diff changeset
  1301
    ^ self subclassResponsibility
claus
parents: 123
diff changeset
  1302
!
claus
parents: 123
diff changeset
  1303
claus
parents: 123
diff changeset
  1304
leftButtonStateMask
claus
parents: 123
diff changeset
  1305
    "return an integer for masking out the left button from a
claus
parents: 123
diff changeset
  1306
     buttonStates value. This is very device specific and to
claus
parents: 123
diff changeset
  1307
     be redefined by concrete subclasses."
claus
parents: 123
diff changeset
  1308
claus
parents: 123
diff changeset
  1309
    ^ self subclassResponsibility
claus
parents: 123
diff changeset
  1310
!
claus
parents: 123
diff changeset
  1311
claus
parents: 123
diff changeset
  1312
middleButtonStateMask
claus
parents: 123
diff changeset
  1313
    "return an integer for masking out the middle button from a
claus
parents: 123
diff changeset
  1314
     buttonStates value. This is very device specific and to
claus
parents: 123
diff changeset
  1315
     be redefined by concrete subclasses."
claus
parents: 123
diff changeset
  1316
claus
parents: 123
diff changeset
  1317
    ^ self subclassResponsibility
claus
parents: 123
diff changeset
  1318
!
claus
parents: 123
diff changeset
  1319
claus
parents: 123
diff changeset
  1320
rightButtonStateMask
claus
parents: 123
diff changeset
  1321
    "return an integer for masking out the right button from a
claus
parents: 123
diff changeset
  1322
     buttonStates value. This is very device specific and to
claus
parents: 123
diff changeset
  1323
     be redefined by concrete subclasses."
claus
parents: 123
diff changeset
  1324
claus
parents: 123
diff changeset
  1325
    ^ self subclassResponsibility
claus
parents: 123
diff changeset
  1326
!
claus
parents: 123
diff changeset
  1327
claus
parents: 123
diff changeset
  1328
leftButtonPressed
claus
parents: 123
diff changeset
  1329
    "return true, if the left button is currently pressed"
claus
parents: 123
diff changeset
  1330
claus
parents: 123
diff changeset
  1331
    ^ (self buttonStates bitAnd:self leftButtonStateMask) ~~ 0
claus
parents: 123
diff changeset
  1332
!
claus
parents: 123
diff changeset
  1333
claus
parents: 123
diff changeset
  1334
middleButtonPressed
claus
parents: 123
diff changeset
  1335
    "return true, if the middle button is currently pressed"
claus
parents: 123
diff changeset
  1336
claus
parents: 123
diff changeset
  1337
    ^ (self buttonStates bitAnd:self middleButtonStateMask) ~~ 0
claus
parents: 123
diff changeset
  1338
!
claus
parents: 123
diff changeset
  1339
claus
parents: 123
diff changeset
  1340
rightButtonPressed
claus
parents: 123
diff changeset
  1341
    "return true, if the right button is currently pressed"
claus
parents: 123
diff changeset
  1342
claus
parents: 123
diff changeset
  1343
    ^ (self buttonStates bitAnd:self rightButtonStateMask) ~~ 0
claus
parents: 123
diff changeset
  1344
! !
claus
parents: 123
diff changeset
  1345
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1346
!DeviceWorkstation methodsFor:'interactive queries'!
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1347
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1348
pointFromUserShowing:aCursor
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1349
    "let user specify a point on the screen (by pressing leftButton).
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1350
     Show aCursor while waiting."
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1351
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1352
    |p|
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1353
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1354
    self ungrabPointer.
151
claus
parents: 146
diff changeset
  1355
    self grabPointerIn:(self rootWindowId) withCursor:((aCursor on:self) id)
75
claus
parents: 71
diff changeset
  1356
	 pointerMode:#async keyboardMode:#sync confineTo:nil.
134
claus
parents: 133
diff changeset
  1357
    activePointerGrab := rootView.
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1358
157
claus
parents: 151
diff changeset
  1359
    "
claus
parents: 151
diff changeset
  1360
     wait for leftButton ...
claus
parents: 151
diff changeset
  1361
    "
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1362
    [self leftButtonPressed] whileFalse:[Processor yield].
157
claus
parents: 151
diff changeset
  1363
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1364
    p := self pointerPosition.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1365
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1366
    self ungrabPointer.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1367
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1368
    "flush all events pending on myself"
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1369
    self disposeButtonEventsFor:nil.
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1370
    ^ p
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1371
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1372
    "
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1373
     Display pointFromUserShowing:(Cursor stop)   
133
claus
parents: 123
diff changeset
  1374
     Display pointFromUserShowing:(Cursor crossHair)   
157
claus
parents: 151
diff changeset
  1375
     Display pointFromUserShowing:(Cursor origin)   
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1376
     Display pointFromUser
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1377
    "
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1378
!
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1379
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1380
pointFromUser
133
claus
parents: 123
diff changeset
  1381
    "let user specify a point on the screen (by pressing the left button)"
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1382
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1383
    ^ self pointFromUserShowing:(Cursor crossHair).
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1384
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1385
    "
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1386
     Display pointFromUser
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1387
    "
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1388
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1389
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1390
rectangleFromUser:initialRectangle
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1391
    "let user specify a rectangle on the screen, return the rectangle.
133
claus
parents: 123
diff changeset
  1392
     Start with initialRectangle. 
claus
parents: 123
diff changeset
  1393
     A helper for rectangleFromUser; can also be used for resizing operations."
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1394
157
claus
parents: 151
diff changeset
  1395
    |curs1 origin corner root rect|
claus
parents: 151
diff changeset
  1396
claus
parents: 151
diff changeset
  1397
    curs1 := Cursor corner on:self.
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1398
134
claus
parents: 133
diff changeset
  1399
    root := self rootView.
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1400
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1401
    "
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1402
     grab and wait for leftButton being pressed
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1403
    "
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1404
    origin := initialRectangle origin.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1405
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1406
    root noClipByChildren.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1407
    root foreground:Color black background:Color white.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1408
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1409
    root xoring:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1410
	|left right top bottom newOrigin newCorner p curs|
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1411
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1412
	corner := origin.
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1413
	rect := origin corner:corner.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1414
	root displayRectangle:rect.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1415
157
claus
parents: 151
diff changeset
  1416
	self 
claus
parents: 151
diff changeset
  1417
	    grabPointerIn:root id 
claus
parents: 151
diff changeset
  1418
	    withCursor:curs1 id
claus
parents: 151
diff changeset
  1419
	    pointerMode:#async 
claus
parents: 151
diff changeset
  1420
	    keyboardMode:#sync 
claus
parents: 151
diff changeset
  1421
	    confineTo:nil.
claus
parents: 151
diff changeset
  1422
claus
parents: 151
diff changeset
  1423
	"
claus
parents: 151
diff changeset
  1424
	 just in case; wait for button to be down ...
claus
parents: 151
diff changeset
  1425
	"
claus
parents: 151
diff changeset
  1426
	[self leftButtonPressed] whileFalse:[Processor yield].
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1427
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1428
	[self leftButtonPressed] whileTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1429
	    left := initialRectangle origin x.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1430
	    top := initialRectangle origin y.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1431
	    right := initialRectangle corner x.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1432
	    bottom := initialRectangle corner y.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1433
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1434
	    p := self pointerPosition.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1435
	    p x < initialRectangle left ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1436
		p y < initialRectangle top ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1437
		    curs := Cursor topLeft.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1438
		    left := p x.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1439
		    top := p y.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1440
		] ifFalse:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1441
		    curs := Cursor bottomLeft.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1442
		    left := p x.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1443
		    bottom := p y
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1444
		]
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1445
	    ] ifFalse:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1446
		p y < initialRectangle top ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1447
		    curs := Cursor topRight.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1448
		    right := p x.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1449
		    top := p y
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1450
		] ifFalse:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1451
		    curs := Cursor bottomRight.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1452
		    right := p x.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1453
		    bottom := p y
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1454
		]
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1455
	    ].
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1456
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1457
	    newOrigin := left @ top.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1458
	    newCorner := right @ bottom.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1459
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1460
	    ((newOrigin ~= origin) or:[newCorner ~= corner]) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1461
		root displayRectangle:rect.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1462
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1463
		self grabPointerIn:root id withCursor:curs id
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1464
			 pointerMode:#async keyboardMode:#sync confineTo:nil.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1465
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1466
		origin :=  newOrigin.
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1467
		corner :=  newCorner.
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1468
		rect := origin corner:corner.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1469
		root displayRectangle:rect.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1470
		self disposeButtonEventsFor:nil.
151
claus
parents: 146
diff changeset
  1471
		self flush.
157
claus
parents: 151
diff changeset
  1472
	    ] ifFalse:[
claus
parents: 151
diff changeset
  1473
		Processor yield
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1474
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1475
	].
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1476
	root displayRectangle:rect.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1477
	self ungrabPointer.
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1478
    ].
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1479
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1480
    self ungrabPointer.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1481
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1482
    "flush all events pending on my display"
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1483
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1484
    root clipByChildren.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1485
151
claus
parents: 146
diff changeset
  1486
    self flush.
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1487
    self disposeButtonEventsFor:nil.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1488
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1489
    ^ rect
157
claus
parents: 151
diff changeset
  1490
claus
parents: 151
diff changeset
  1491
    "
claus
parents: 151
diff changeset
  1492
     Display rectangleFromUser:(100@100 corner:300@300)
claus
parents: 151
diff changeset
  1493
    "
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1494
!
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1495
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1496
rectangleFromUser
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1497
    "let user specify a rectangle in the screen, return the rectangle"
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1498
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1499
    |origin|
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1500
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1501
    "
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1502
     get origin
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1503
    "
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1504
    origin := self pointFromUserShowing:(Cursor origin on:self).
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1505
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1506
    "
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1507
     get corner
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1508
    "
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1509
    ^ self rectangleFromUser:(origin corner:origin). 
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1510
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1511
    "
133
claus
parents: 123
diff changeset
  1512
     Display rectangleFromUser    
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1513
    "
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1514
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1515
157
claus
parents: 151
diff changeset
  1516
originFromUser:extent
claus
parents: 151
diff changeset
  1517
    "let user specify a rectangles origin on the screen, return the rectangle.
claus
parents: 151
diff changeset
  1518
     Start with initialRectangle. 
claus
parents: 151
diff changeset
  1519
     Can be used for dragging operations."
claus
parents: 151
diff changeset
  1520
claus
parents: 151
diff changeset
  1521
    |curs origin root rect|
claus
parents: 151
diff changeset
  1522
claus
parents: 151
diff changeset
  1523
    curs := Cursor origin on:self.
claus
parents: 151
diff changeset
  1524
claus
parents: 151
diff changeset
  1525
    "
claus
parents: 151
diff changeset
  1526
     just in case; wait for button to be down ...
claus
parents: 151
diff changeset
  1527
    "
claus
parents: 151
diff changeset
  1528
    [self leftButtonPressed] whileFalse:[Processor yield].
claus
parents: 151
diff changeset
  1529
claus
parents: 151
diff changeset
  1530
    root := self rootView.
claus
parents: 151
diff changeset
  1531
claus
parents: 151
diff changeset
  1532
    "
claus
parents: 151
diff changeset
  1533
     grab and wait for leftButton being pressed
claus
parents: 151
diff changeset
  1534
    "
claus
parents: 151
diff changeset
  1535
    origin := self pointerPosition.
claus
parents: 151
diff changeset
  1536
claus
parents: 151
diff changeset
  1537
    root noClipByChildren.
claus
parents: 151
diff changeset
  1538
    root foreground:Color black background:Color white.
claus
parents: 151
diff changeset
  1539
claus
parents: 151
diff changeset
  1540
    root xoring:[
claus
parents: 151
diff changeset
  1541
	|left right top bottom newOrigin newCorner p|
claus
parents: 151
diff changeset
  1542
claus
parents: 151
diff changeset
  1543
	rect := origin extent:extent.
claus
parents: 151
diff changeset
  1544
	root displayRectangle:rect.
claus
parents: 151
diff changeset
  1545
claus
parents: 151
diff changeset
  1546
	self 
claus
parents: 151
diff changeset
  1547
	    grabPointerIn:root id 
claus
parents: 151
diff changeset
  1548
	    withCursor:curs id
claus
parents: 151
diff changeset
  1549
	    pointerMode:#async 
claus
parents: 151
diff changeset
  1550
	    keyboardMode:#sync 
claus
parents: 151
diff changeset
  1551
	    confineTo:nil.
claus
parents: 151
diff changeset
  1552
claus
parents: 151
diff changeset
  1553
	[self leftButtonPressed] whileTrue:[
claus
parents: 151
diff changeset
  1554
	    newOrigin := self pointerPosition.
claus
parents: 151
diff changeset
  1555
claus
parents: 151
diff changeset
  1556
	    (newOrigin ~= origin) ifTrue:[
claus
parents: 151
diff changeset
  1557
		root displayRectangle:rect.
claus
parents: 151
diff changeset
  1558
claus
parents: 151
diff changeset
  1559
		self 
claus
parents: 151
diff changeset
  1560
		    grabPointerIn:root id 
claus
parents: 151
diff changeset
  1561
		    withCursor:curs id
claus
parents: 151
diff changeset
  1562
		    pointerMode:#async 
claus
parents: 151
diff changeset
  1563
		    keyboardMode:#sync 
claus
parents: 151
diff changeset
  1564
		    confineTo:nil.
claus
parents: 151
diff changeset
  1565
claus
parents: 151
diff changeset
  1566
		rect := newOrigin extent:extent.
claus
parents: 151
diff changeset
  1567
		root displayRectangle:rect.
claus
parents: 151
diff changeset
  1568
		self disposeButtonEventsFor:nil.
claus
parents: 151
diff changeset
  1569
		self flush.
claus
parents: 151
diff changeset
  1570
		origin := newOrigin.
claus
parents: 151
diff changeset
  1571
	    ] ifFalse:[
claus
parents: 151
diff changeset
  1572
		Processor yield
claus
parents: 151
diff changeset
  1573
	    ]
claus
parents: 151
diff changeset
  1574
	].
claus
parents: 151
diff changeset
  1575
	root displayRectangle:rect.
claus
parents: 151
diff changeset
  1576
	self ungrabPointer.
claus
parents: 151
diff changeset
  1577
    ].
claus
parents: 151
diff changeset
  1578
claus
parents: 151
diff changeset
  1579
    self ungrabPointer.
claus
parents: 151
diff changeset
  1580
claus
parents: 151
diff changeset
  1581
    "flush all events pending on my display"
claus
parents: 151
diff changeset
  1582
claus
parents: 151
diff changeset
  1583
    root clipByChildren.
claus
parents: 151
diff changeset
  1584
claus
parents: 151
diff changeset
  1585
    self flush.
claus
parents: 151
diff changeset
  1586
    self disposeButtonEventsFor:nil.
claus
parents: 151
diff changeset
  1587
claus
parents: 151
diff changeset
  1588
    ^ rect
claus
parents: 151
diff changeset
  1589
claus
parents: 151
diff changeset
  1590
    "
claus
parents: 151
diff changeset
  1591
     Display originFromUser:200@200
claus
parents: 151
diff changeset
  1592
    "
claus
parents: 151
diff changeset
  1593
!
claus
parents: 151
diff changeset
  1594
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1595
viewFromUser
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1596
    "let user specify a view on the screen; if the selected view is
133
claus
parents: 123
diff changeset
  1597
     not an ST/X view, nil is returned.
claus
parents: 123
diff changeset
  1598
     This returns the view being clicked in, which is not always a topView.
claus
parents: 123
diff changeset
  1599
     (send topView to the returned view or use topviewFromUser,
claus
parents: 123
diff changeset
  1600
      to get the topview)"
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1601
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1602
    ^ self viewFromPoint:(self pointFromUser) 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1603
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1604
    "
133
claus
parents: 123
diff changeset
  1605
     Display viewFromUser 
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1606
    "
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1607
    "
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1608
     |v|
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1609
     v := Display viewFromUser.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1610
     v notNil ifTrue:[v topView] ifFalse:[nil]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1611
    "
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1612
!
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1613
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1614
topviewFromUser
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1615
    "let user specify a view on the screen; if the selected view is
133
claus
parents: 123
diff changeset
  1616
     not an ST/X view, nil is returned.
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1617
     Otherwise, the topview is returned."
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1618
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1619
    |v|
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1620
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1621
    v := self viewFromUser.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1622
    v notNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1623
	v := v topView
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1624
    ].
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1625
    ^ v 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1626
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1627
    "
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1628
     Display topviewFromUser
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  1629
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1630
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1631
48194c26a46c Initial revision
claus
parents:
diff changeset
  1632
!DeviceWorkstation methodsFor:'keyboard mapping'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1633
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1634
translateKey:untranslatedKey
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1635
    "Return the key translated via the translation table.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1636
     Your application program should never depend on the values returned
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1637
     by this method, but instead use symbolic keys (such as #FindNext).
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1638
     Doing so allows easier reconfiguration by changing the translation map
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1639
     in the 'smalltalk.rc' or 'display.rc' startup files.
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1640
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1641
     First, the modifier is prepended, making character X into
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1642
     AltX, CtrlX or CmdX (on most systems, no separate Cmd (or Meta)
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1643
     key exists; on those we always get AltX).
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1644
     If multiple modifiers are active, the symbol becoms the concatenation
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1645
     as in AltCtrlq (for control-alt-q). Shift will affect the last component,
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1646
     thus the above with shift becoms: AltCtrlQ instead.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1647
     Some keyboards offer both Alt and Meta keys - on those, the first has a
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1648
     prefix of Alt, the second has Cmd as prefix. Keyboards with only an Alt
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1649
     key will will create prefix codes of Cmd for that.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1650
     For symbolic keys (i.e.Tab, Backspace etc, shift is ignored).
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1651
     Then the result is used as a key into the translation keyboardMap
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1652
     to get the final return value."
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1653
145
claus
parents: 144
diff changeset
  1654
    |xlatedKey dontTranslate|
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1655
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1656
    xlatedKey := untranslatedKey.
145
claus
parents: 144
diff changeset
  1657
claus
parents: 144
diff changeset
  1658
    "should this come from a configurable variable ?"
claus
parents: 144
diff changeset
  1659
    dontTranslate := (untranslatedKey == #Control
claus
parents: 144
diff changeset
  1660
		     or:[untranslatedKey == #'Control_L'   
claus
parents: 144
diff changeset
  1661
		     or:[untranslatedKey == #'Control_R'   
claus
parents: 144
diff changeset
  1662
		     or:[untranslatedKey == #'Shift'   
claus
parents: 144
diff changeset
  1663
		     or:[untranslatedKey == #'Shift_L'   
claus
parents: 144
diff changeset
  1664
		     or:[untranslatedKey == #'Shift_R'   
claus
parents: 144
diff changeset
  1665
		     or:[untranslatedKey == #'Alt'   
claus
parents: 144
diff changeset
  1666
		     or:[untranslatedKey == #'Alt_L'   
claus
parents: 144
diff changeset
  1667
		     or:[untranslatedKey == #'Alt_R'   
claus
parents: 144
diff changeset
  1668
		     or:[untranslatedKey == #'Meta'   
claus
parents: 144
diff changeset
  1669
		     or:[untranslatedKey == #'Meta_L'   
claus
parents: 144
diff changeset
  1670
		     or:[untranslatedKey == #'Meta_R'   
claus
parents: 144
diff changeset
  1671
		     or:[untranslatedKey == #'Cmd'   
claus
parents: 144
diff changeset
  1672
		     or:[untranslatedKey == #'Cmd_L'   
claus
parents: 144
diff changeset
  1673
		     or:[untranslatedKey == #'Cmd_R']]]]]]]]]]]]]]).   
claus
parents: 144
diff changeset
  1674
151
claus
parents: 146
diff changeset
  1675
    ctrlDown ifTrue:[
145
claus
parents: 144
diff changeset
  1676
	dontTranslate ifFalse:[
144
claus
parents: 142
diff changeset
  1677
	    xlatedKey := ('Ctrl' , xlatedKey asString) asSymbol
claus
parents: 142
diff changeset
  1678
	]
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1679
    ].
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1680
    metaDown ifTrue:[
145
claus
parents: 144
diff changeset
  1681
	dontTranslate ifFalse:[
144
claus
parents: 142
diff changeset
  1682
	    xlatedKey := ('Cmd' , xlatedKey asString) asSymbol
claus
parents: 142
diff changeset
  1683
	]
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1684
    ].
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1685
    altDown ifTrue:[
145
claus
parents: 144
diff changeset
  1686
	dontTranslate ifFalse:[
144
claus
parents: 142
diff changeset
  1687
	    xlatedKey := ('Alt' , xlatedKey asString) asSymbol
claus
parents: 142
diff changeset
  1688
	]
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1689
    ].
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1690
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1691
    xlatedKey := keyboardMap valueFor:xlatedKey.
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  1692
    ^ xlatedKey
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1693
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1694
115
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1695
!DeviceWorkstation methodsFor:'event forwarding'!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1696
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1697
keyPress:untranslatedKey x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1698
    "forward a key-press event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1699
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1700
    |xlatedKey sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1701
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1702
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1703
	sensor keyPress:untranslatedKey x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1704
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1705
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1706
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1707
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1708
	xlatedKey := self translateKey:untranslatedKey.
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1709
	xlatedKey notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1710
	    WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1711
	      sendEvent:#keyPress:x:y:
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1712
	      arguments:(Array with:xlatedKey with:x with:y)
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1713
	      view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1714
	]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1715
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1716
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1717
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1718
keyRelease:untranslatedKey x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1719
    "forward a key-release event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1720
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1721
    |xlatedKey sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1722
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1723
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1724
	sensor keyRelease:untranslatedKey x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1725
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1726
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1727
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1728
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1729
	xlatedKey := self translateKey:untranslatedKey.
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1730
	xlatedKey notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1731
	    WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1732
		sendEvent:#keyRelease:x:y:
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1733
		arguments:(Array with:xlatedKey with:x with:y)
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1734
		view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1735
	]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1736
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1737
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1738
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1739
buttonPress:button x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1740
    "forward a button-press event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1741
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1742
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1743
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1744
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1745
	sensor buttonPress:button x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1746
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1747
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1748
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1749
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1750
	WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1751
	    sendEvent:#buttonPress:x:y:
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1752
	    arguments:(Array with:button with:x with:y)
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1753
	    view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1754
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1755
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1756
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1757
buttonShiftPress:button x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1758
    "forward a button-shift-press event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1759
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1760
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1761
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1762
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1763
	sensor buttonShiftPress:button x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1764
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1765
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1766
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1767
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1768
	WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1769
	    sendEvent:#buttonShiftPress:x:y:
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1770
	    arguments:(Array with:button with:x with:y)
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1771
	    view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1772
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1773
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1774
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1775
buttonMultiPress:button x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1776
    "forward a button-multi-press event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1777
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1778
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1779
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1780
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1781
	sensor buttonMultiPress:button x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1782
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1783
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1784
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1785
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1786
	WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1787
	    sendEvent:#buttonMultiPress:x:y:
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1788
	    arguments:(Array with:button with:x with:y)
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1789
	    view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1790
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1791
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1792
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1793
buttonRelease:button x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1794
    "forward a button-release event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1795
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1796
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1797
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1798
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1799
	sensor buttonRelease:button x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1800
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1801
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1802
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1803
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1804
	WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1805
	    sendEvent:#buttonRelease:x:y:
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1806
	    arguments:(Array with:button with:x with:y)
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1807
	    view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1808
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1809
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1810
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1811
buttonMotion:button x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1812
    "forward a button-motion for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1813
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1814
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1815
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1816
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1817
	sensor buttonMotion:button x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1818
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1819
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1820
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1821
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1822
	WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1823
	    sendEvent:#buttonMotion:x:y:
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1824
	    arguments:(Array with:button with:x with:y)
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1825
	    view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1826
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1827
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1828
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1829
pointerEnter:buttonState x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1830
    "forward a pointer enter for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1831
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1832
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1833
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1834
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1835
	sensor pointerEnter:buttonState x:x y:y view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1836
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1837
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1838
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1839
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1840
	WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1841
	    sendEvent:#pointerEnter:x:y:
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1842
	    arguments:(Array with:buttonState with:x with:y)
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1843
	    view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1844
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1845
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1846
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1847
pointerLeave:buttonState view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1848
    "forward a pointer leave for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1849
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1850
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1851
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1852
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1853
	sensor pointerLeave:buttonState view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1854
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1855
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1856
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1857
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1858
	WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1859
	    sendEvent:#pointerLeave:
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1860
	    arguments:(Array with:buttonState)
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1861
	    view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1862
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1863
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1864
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1865
focusInView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1866
    "forward a focusIn event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1867
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1868
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1869
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1870
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1871
	sensor focusInView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1872
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1873
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1874
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1875
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1876
	WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1877
	    sendEvent:#focusIn
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1878
	    arguments:nil
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1879
	    view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1880
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1881
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1882
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1883
focusOutView:aView 
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1884
    "forward a focusOut event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1885
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1886
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1887
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1888
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1889
	sensor focusOutView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1890
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1891
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1892
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1893
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1894
	WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1895
	    sendEvent:#focusOut
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1896
	    arguments:nil
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1897
	    view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1898
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1899
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1900
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1901
terminateView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1902
    "forward a terminate event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1903
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1904
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1905
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1906
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1907
	sensor terminateView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1908
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1909
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1910
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1911
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1912
	aView terminate
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1913
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1914
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1915
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1916
saveAndTerminateView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1917
    "forward a saveAndTerminate event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1918
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1919
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1920
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1921
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1922
	sensor saveAndTerminateView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1923
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1924
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1925
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1926
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1927
	aView saveAndTerminate
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1928
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1929
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1930
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1931
destroyedView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1932
    "forward a destroyed event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1933
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1934
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1935
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1936
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1937
	sensor destroyedView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1938
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1939
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1940
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1941
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1942
	aView destroyed
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1943
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1944
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1945
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1946
unmappedView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1947
    "forward an unmapped event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1948
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1949
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1950
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1951
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1952
	sensor unmappedView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1953
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1954
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1955
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1956
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1957
	aView unmapped
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1958
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1959
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1960
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1961
mappedView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1962
    "forward a mapped event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1963
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1964
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1965
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1966
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1967
	sensor mappedView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1968
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1969
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1970
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1971
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1972
	aView mapped
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1973
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1974
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1975
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1976
coveredBy:otherView view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1977
    "forward a covered for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1978
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1979
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1980
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1981
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1982
	sensor coveredBy:otherView view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1983
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1984
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1985
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1986
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1987
	aView coveredBy:otherView 
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1988
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1989
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1990
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1991
configureX:x y:y width:w height:h view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1992
    "forward a configure for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1993
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1994
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1995
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1996
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1997
	sensor configureX:x y:y width:w height:h view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1998
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  1999
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2000
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2001
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2002
	aView configureX:x y:y width:w height:h 
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2003
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2004
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2005
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2006
exposeX:x y:y width:w height:h view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2007
    "forward an expose for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2008
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2009
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2010
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2011
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2012
	sensor exposeX:x y:y width:w height:h view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2013
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2014
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2015
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2016
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2017
	WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2018
	    sendEvent:#exposeX:y:width:height:
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2019
	    arguments:(Array with:x with:y with:width with:height)
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2020
	    view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2021
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2022
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2023
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2024
graphicExposeX:x y:y width:w height:h view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2025
    "forward a graphic expose for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2026
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2027
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2028
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2029
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2030
	sensor graphicExposeX:x y:y width:w height:h view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2031
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2032
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2033
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2034
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2035
	WindowEvent
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2036
	    sendEvent:#graphicExposeX:y:width:height:
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2037
	    arguments:(Array with:x with:y with:width with:height)
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2038
	    view:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2039
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2040
!
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2041
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2042
noExposeView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2043
    "forward a noExpose event for some view"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2044
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2045
    |sensor|
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2046
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2047
    (sensor := aView sensor) notNil ifTrue:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2048
	sensor noExposeView:aView
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2049
    ] ifFalse:[
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2050
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2051
	 if there is no sensor ...
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2052
	"
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2053
	aView noExpose 
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2054
    ]
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2055
! !
1d93fd8c5371 *** empty log message ***
claus
parents: 109
diff changeset
  2056
54
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2057
!DeviceWorkstation methodsFor:'view registration'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2058
48194c26a46c Initial revision
claus
parents:
diff changeset
  2059
addKnownView:aView withId:aNumber
54
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2060
    "add the View aView with id:aNumber to the list of known views/id's.
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2061
     This map is needed later (on event arrival) to get the view from
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2062
     the views id (which is passed along with the devices event) quickly."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2063
151
claus
parents: 146
diff changeset
  2064
    |freeIdx newArr sz newSize|
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2065
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2066
    knownViews isNil ifTrue:[
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2067
	knownViews := WeakArray new:50.
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2068
	knownIds := Array new:50.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2069
	freeIdx := 1.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2070
    ] ifFalse:[
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2071
	freeIdx := knownViews identityIndexOf:nil.
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2072
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2073
"/        1 to:knownViews size do:[:idx |
151
claus
parents: 146
diff changeset
  2074
"/            |id|
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2075
"/            (knownViews at:idx) isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2076
"/                freeIdx := idx
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2077
"/                id := knownIds at:idx.
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2078
"/                id notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2079
"/                    "/ this one is no longer valid ...
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2080
"/                    knownIds at:idx put:nil.
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2081
"/                ].
133
claus
parents: 123
diff changeset
  2082
"/          ]
claus
parents: 123
diff changeset
  2083
"/      ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2084
    ].
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2085
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2086
    freeIdx == 0 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2087
	sz := knownViews size.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2088
	newSize := sz * 2.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2089
	newArr := WeakArray new:newSize.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2090
	newArr replaceFrom:1 to:sz with:knownViews.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2091
	knownViews := newArr.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2092
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2093
	newArr := Array new:newSize.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2094
	newArr replaceFrom:1 to:sz with:knownIds.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2095
	knownIds := newArr.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2096
	freeIdx := sz + 1
54
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2097
    ].
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2098
    knownViews at:freeIdx put:aView.
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2099
    knownIds at:freeIdx put:aNumber.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2100
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2101
48194c26a46c Initial revision
claus
parents:
diff changeset
  2102
removeKnownView:aView
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2103
    "remove aView from the list of known views/id's."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2104
54
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2105
    |index|
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2106
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2107
    aView isNil ifTrue:[^ self].
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2108
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2109
"/    idToViewMapping removeValue:aView ifAbsent:[].
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2110
"/    lastId := nil.
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2111
"/    lastView := nil
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2112
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2113
    knownViews notNil ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2114
	index := knownViews identityIndexOf:aView.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2115
	index == 0 ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2116
	    knownViews at:index put:nil.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2117
	    knownIds at:index put:nil.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2118
	    lastId := nil.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2119
	    lastView := nil
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2120
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2121
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2122
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2123
48194c26a46c Initial revision
claus
parents:
diff changeset
  2124
viewFromId:aNumber
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2125
    "given an Id, return the corresponding view."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2126
48194c26a46c Initial revision
claus
parents:
diff changeset
  2127
    |index|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2128
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2129
"/    ^ idToViewMapping at:aNumber ifAbsent:[nil].
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2130
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  2131
    index := knownIds identityIndexOf:aNumber.
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  2132
    index == 0 ifTrue:[^ nil].
54
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2133
    ^ knownViews at:index.
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2134
!
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2135
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2136
update:something
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2137
    |id|
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2138
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2139
    "/ no longer called for ...
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  2140
    "/
54
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2141
    something == knownViews ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2142
	"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2143
	 some view was garbage-collected;
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2144
	 destroy it ...
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2145
	"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2146
	1 to:knownViews size do:[:idx |
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2147
	    (knownViews at:idx) isNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2148
		id := knownIds at:idx.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2149
		id notNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2150
		    knownIds at:idx put:nil.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2151
		].
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2152
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2153
	].
54
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2154
        
29a6b2f8e042 *** empty log message ***
claus
parents: 51
diff changeset
  2155
    ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2156
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  2157
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2158
!DeviceWorkstation methodsFor:'window stuff'!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2159
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2160
setCursors:aCursor
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2161
    "change the cursor of all views to aCursorId"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2162
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2163
    | id |
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2164
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2165
    id := (aCursor on:self) id.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2166
    id notNil ifTrue:[
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2167
"/        idToViewMapping notNil ifTrue:[
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2168
"/          idToViewMapping keysAndValuesDo:[:viewId :view |
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2169
"/              self setCursor:id in:viewId
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2170
"/          ].
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2171
	    knownViews do:[:aView |
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2172
		|vid|
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2173
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2174
		(aView notNil and:[(vid := aView id) notNil]) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2175
		    self setCursor:id in:vid
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2176
		]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2177
	    ].
151
claus
parents: 146
diff changeset
  2178
	    self flush
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2179
"/        ]
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2180
    ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2181
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2182
    "Display setCursors:Cursor wait"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2183
    "Display restoreCursors"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2184
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2185
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2186
restoreCursors
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2187
    "restore the cursors of all views to their current cursor"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2188
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2189
"/    idToViewMapping notNil ifTrue:[
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2190
"/      idToViewMapping keysAndValuesDo:[:viewId :view |
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2191
"/          |curs cid|
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2192
"/          curs := view cursor.
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2193
"/          curs notNil ifTrue:[
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2194
"/              cid := curs id.
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2195
"/              cid notNil ifTrue:[
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2196
"/                 self setCursor:cid in:viewId
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2197
"/              ]
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2198
"/          ]
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2199
"/       ].
151
claus
parents: 146
diff changeset
  2200
"/       self flush
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2201
"/  ]
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2202
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2203
    knownViews notNil ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2204
	knownViews do:[:aView |
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2205
	    |c vid cid|
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2206
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2207
	    (aView notNil and:[(vid := aView id) notNil]) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2208
		c := aView cursor.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2209
		(c notNil and:[(cid := c id) notNil]) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2210
		    self setCursor:cid in:vid
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2211
		]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2212
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2213
	].
151
claus
parents: 146
diff changeset
  2214
	self flush
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2215
    ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2216
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2217
    "Display setCursors:(Cursor wait)"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2218
    "Display restoreCursors"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2219
! !
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2220
86
032006651226 *** empty log message ***
claus
parents: 83
diff changeset
  2221
!DeviceWorkstation methodsFor:'event handling'!
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2222
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2223
startDispatch
151
claus
parents: 146
diff changeset
  2224
    "create the display dispatch process."
claus
parents: 146
diff changeset
  2225
claus
parents: 146
diff changeset
  2226
    |inputSema fd p nm|
claus
parents: 146
diff changeset
  2227
claus
parents: 146
diff changeset
  2228
    "
claus
parents: 146
diff changeset
  2229
     only allow one dispatcher process per display
claus
parents: 146
diff changeset
  2230
    "
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2231
    dispatching ifTrue:[^ self].
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2232
    dispatching := true.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2233
151
claus
parents: 146
diff changeset
  2234
    AllScreens isNil ifTrue:[
claus
parents: 146
diff changeset
  2235
	AllScreens := Set new:1
claus
parents: 146
diff changeset
  2236
    ].
claus
parents: 146
diff changeset
  2237
    AllScreens add:self.
claus
parents: 146
diff changeset
  2238
claus
parents: 146
diff changeset
  2239
    "
claus
parents: 146
diff changeset
  2240
     The code below (still) handles the situation where ST/X was built
claus
parents: 146
diff changeset
  2241
     without lightweight process support. Since there are many other places
claus
parents: 146
diff changeset
  2242
     in the system whic depend on lightweight processes to function, this
claus
parents: 146
diff changeset
  2243
     may be a stupid thing to do ... expect it to vanish sooner or later.
claus
parents: 146
diff changeset
  2244
    "
claus
parents: 146
diff changeset
  2245
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2246
    fd := self displayFileDescriptor.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2247
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2248
    ProcessorScheduler isPureEventDriven ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2249
	"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2250
	 no threads built in;
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2251
	 handle all events by having processor call a block when something
151
claus
parents: 146
diff changeset
  2252
	 arrives on my filedescriptor. Dispatch the event in that block.
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2253
	"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2254
	Processor enableIOAction:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2255
				     dispatching ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2256
					 [self eventPending] whileTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2257
					     self dispatchPendingEvents.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2258
					     self checkForEndOfDispatch.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2259
					 ].
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2260
					 dispatching ifFalse:[
151
claus
parents: 146
diff changeset
  2261
					     Processor disableFd:fd.
claus
parents: 146
diff changeset
  2262
					     AllScreens remove:self.
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2263
					 ]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2264
				     ]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2265
				 ]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2266
			 onInput:fd
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2267
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2268
    ] ifFalse:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2269
	"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2270
	 handle stuff as a process - sitting on a semaphore.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2271
	 Tell Processor to trigger this semaphore when something arrives
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2272
	 on my filedescriptor. Since a select alone is not enough to
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2273
	 know if events are pending (Xlib reads out event-queue while
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2274
	 doing output), we also have to install a poll-check block.        
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2275
	"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2276
	inputSema := Semaphore new.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2277
	p := [
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2278
	    [dispatching] whileTrue:[
94
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  2279
		AbortSignal handle:[:ex |
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  2280
		    ex return
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  2281
		] do:[
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  2282
		    self eventPending ifFalse:[
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  2283
			Processor activeProcess setStateTo:#ioWait if:#active.
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  2284
			inputSema wait.
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  2285
		    ].
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  2286
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  2287
		    self dispatchPendingEvents.
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  2288
		    self checkForEndOfDispatch.
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2289
		]
94
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  2290
	    ].
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  2291
	    Processor disableSemaphore:inputSema.
151
claus
parents: 146
diff changeset
  2292
	    inputSema := nil.
claus
parents: 146
diff changeset
  2293
	    AllScreens remove:self.
claus
parents: 146
diff changeset
  2294
	    dispatchProcess := nil
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2295
	] forkAt:(Processor userInterruptPriority).
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2296
	"
151
claus
parents: 146
diff changeset
  2297
	 give the process a nice name (for the processMonitor)
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2298
	"
151
claus
parents: 146
diff changeset
  2299
	(nm := self displayName) notNil ifTrue:[
claus
parents: 146
diff changeset
  2300
	    nm := 'event dispatcher (' ,  nm , ')'.
133
claus
parents: 123
diff changeset
  2301
	] ifFalse:[
151
claus
parents: 146
diff changeset
  2302
	    nm := 'event dispatcher'.
133
claus
parents: 123
diff changeset
  2303
	].
151
claus
parents: 146
diff changeset
  2304
	p name:nm.
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2305
	Processor signal:inputSema onInput:fd orCheck:[self eventPending].
151
claus
parents: 146
diff changeset
  2306
	dispatchProcess := p.
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2307
    ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2308
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2309
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2310
checkForEndOfDispatch
46
7b331e9012fd *** empty log message ***
claus
parents: 43
diff changeset
  2311
    "return true, if there are still any views of interrest - 
151
claus
parents: 146
diff changeset
  2312
     if not, stop dispatch. This ends the dispatcher process when the
claus
parents: 146
diff changeset
  2313
     last view is closed on that device."
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2314
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2315
    self == Display ifTrue:[
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2316
"/      idToViewMapping isEmpty ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2317
	knownViews isEmpty ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2318
	    dispatching := false
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2319
	]
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2320
    ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2321
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2322
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2323
dispatchPendingEvents
151
claus
parents: 146
diff changeset
  2324
    "go dispatch events as long as there is one."
claus
parents: 146
diff changeset
  2325
83
597bdb33e832 *** empty log message ***
claus
parents: 81
diff changeset
  2326
    [self eventPending] whileTrue:[
597bdb33e832 *** empty log message ***
claus
parents: 81
diff changeset
  2327
	self dispatchEventFor:nil withMask:nil
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2328
    ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2329
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2330
21
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  2331
dispatchModalWhile:aBlock
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  2332
    "get and process next event for any view as long as the 
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  2333
     argument-block evaluates to true.
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2334
     This is a modal loop, not switching to other processes,
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2335
     effectively polling the device in a (nice) busy loop. 
151
claus
parents: 146
diff changeset
  2336
     This should only be (and is only) used for emergency cases.
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2337
     (such as a graphical debugger, debugging the event-dispatcher itself)"
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2338
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2339
    |myFd|
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2340
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2341
    "
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2342
     if this display has a fileDescriptor to wait on,
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2343
     it is used; otherwise we poll (with a delay to not lock up
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2344
     the workstation)
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2345
    "
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2346
    myFd := self displayFileDescriptor.
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2347
    [aBlock value] whileTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2348
	self eventPending ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2349
	    myFd isNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2350
		OperatingSystem millisecondDelay:50
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2351
	    ] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2352
		OperatingSystem selectOn:myFd withTimeOut:50.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2353
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2354
	    Processor evaluateTimeouts.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2355
	].
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2356
	self eventPending ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2357
	    self dispatchEvent
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2358
	].
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2359
    ]
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2360
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2361
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2362
dispatchEvent
151
claus
parents: 146
diff changeset
  2363
    "get and process the next pending event - for any view"
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2364
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2365
    self dispatchEventFor:nil withMask:nil
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2366
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2367
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2368
dispatchEventFor:aViewIdOrNil withMask:eventMask
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2369
    "central event handling method:
151
claus
parents: 146
diff changeset
  2370
     get next event and send an appropriate message to the views sensor,
claus
parents: 146
diff changeset
  2371
     or to the view directly (if the view has none).
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2372
     If the argument aViewIdOrNil is nil, events for any view are processed,
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2373
     otherwise only events for the view with given id are processed
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2374
     (in this case, nothing is done if no events are pending);
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2375
     if the argument aMask is nonNil, only events for this eventMask are
151
claus
parents: 146
diff changeset
  2376
     handled. The mask is a device dependent event mask."
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2377
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2378
    ^ self subclassResponsibility
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2379
! 
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2380
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2381
disposeEventsWithMask:aMask for:aWindowId
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2382
    "dispose (throw away) specific events"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2383
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2384
    ^ self subclassResponsibility
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2385
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2386
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2387
disposeEvents
151
claus
parents: 146
diff changeset
  2388
    "dispose (i.e. forget) all events pending on this display"
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2389
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2390
    [self eventPending] whileTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2391
	self getEventFor:nil withMask:nil
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2392
    ].
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2393
! 
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2394
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2395
disposeButtonEventsFor:aViewIdOrNil
151
claus
parents: 146
diff changeset
  2396
    "dispose (i.e. forget) all pending button events on this display"
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2397
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2398
    |mask|
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2399
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2400
    mask := self eventMaskFor:#buttonPress.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2401
    mask := mask bitOr:(self eventMaskFor:#buttonRelease).
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2402
    mask := mask bitOr:(self eventMaskFor:#buttonMotion).
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2403
    self disposeEventsWithMask:mask for:aViewIdOrNil
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2404
!
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2405
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2406
eventPending
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2407
    "return true, if any event is pending"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2408
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2409
    ^ self subclassResponsibility
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2410
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2411
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2412
eventPendingWithoutSync
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2413
    "return true, if any event is pending"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2414
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2415
    ^ self subclassResponsibility
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2416
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2417
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2418
eventsPending:anEventMask for:aWindowId
151
claus
parents: 146
diff changeset
  2419
    "return true, if any of the masked events is pending
claus
parents: 146
diff changeset
  2420
     for a specific window.
claus
parents: 146
diff changeset
  2421
     This expects a device dependent event mask as first argument."
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2422
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2423
    ^ self subclassResponsibility
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2424
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2425
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2426
eventPending:anEventSymbol for:aWindowId
151
claus
parents: 146
diff changeset
  2427
    "return true, if a specific event is pending for a specific window.
claus
parents: 146
diff changeset
  2428
     This expects device independent event symbols (such as #buttonPress,
claus
parents: 146
diff changeset
  2429
     #buttonRelease etc.) as first argument."
claus
parents: 146
diff changeset
  2430
claus
parents: 146
diff changeset
  2431
    ^ self subclassResponsibility
claus
parents: 146
diff changeset
  2432
!
claus
parents: 146
diff changeset
  2433
claus
parents: 146
diff changeset
  2434
eventMaskFor:anEventSymbol
claus
parents: 146
diff changeset
  2435
    ^ self subclassResponsibility
claus
parents: 146
diff changeset
  2436
! 
claus
parents: 146
diff changeset
  2437
claus
parents: 146
diff changeset
  2438
setEventMask:aMask in:aWindowId
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2439
    ^ self subclassResponsibility
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2440
! !
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2441
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2442
!DeviceWorkstation methodsFor:'bitmap/window creation'!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2443
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2444
createFaxImageFromArray:data width:w height:h type:type k:k msbFirst:msbFirst
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2445
    "create a new faxImage in the workstation.
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2446
     This is a special interface to servers with the fax-image
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2447
     extension (you won't find it in standard X-servers).
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2448
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2449
     type: 0 -> uncompressed
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2450
	   1 -> group3 1D (k is void)
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2451
	   2 -> group3 2D
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2452
	   3 -> group4 2D (k is void)
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2453
    "
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2454
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2455
    ^ nil
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2456
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2457
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2458
createBitmapWidth:w height:h
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2459
    "allocate a bitmap on the Xserver, the contents is undefined
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2460
     (i.e. random). Return a bitmap id or nil"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2461
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2462
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2463
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2464
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2465
createPixmapWidth:w height:h depth:d
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2466
    "allocate a pixmap on the Xserver, the contents is undefined
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2467
     (i.e. random). Return a bitmap id or nil"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2468
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2469
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2470
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2471
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2472
createBitmapFromFile:aString for:aForm
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2473
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2474
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2475
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2476
createBitmapFromArray:anArray width:w height:h
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2477
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2478
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2479
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2480
destroyPixmap:aDrawableId
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2481
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2482
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2483
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2484
destroyFaxImage:aFaxImageId
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2485
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2486
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2487
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2488
rootWindowFor:aView
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2489
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2490
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2491
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2492
createWindowFor:aView left:xpos top:ypos width:wwidth height:wheight
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2493
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2494
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2495
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2496
destroyView:aView withId:aWindowId
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2497
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2498
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2499
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2500
destroyGC:aGCId
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2501
    "destroy a GC"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2502
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2503
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2504
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2505
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2506
gcFor:aDrawableId
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2507
    "create a GC for drawing into aDrawable"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2508
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2509
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2510
! !
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2511
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2512
!DeviceWorkstation methodsFor:'font stuff'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2513
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2514
listOfAvailableFonts
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2515
    "return a list containing all fonts on this display.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2516
     The returned list is an array of 4-element arrays, each
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2517
     containing family, face, style, size and encoding."
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2518
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2519
    self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2520
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2521
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2522
fontFamilies
48194c26a46c Initial revision
claus
parents:
diff changeset
  2523
    "return a set of all available font families on this display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2524
48194c26a46c Initial revision
claus
parents:
diff changeset
  2525
    |allFonts families family|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2526
48194c26a46c Initial revision
claus
parents:
diff changeset
  2527
    allFonts := self listOfAvailableFonts.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2528
    allFonts isNil ifTrue:[^ nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2529
    families := Set new.
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2530
    allFonts do:[:fntDescr |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2531
	family := fntDescr family.
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2532
	family notNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2533
	    families add:family
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2534
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2535
    ].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2536
    ^ families asSortedCollection
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2537
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2538
    "
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2539
     Display fontFamilies
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2540
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2541
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2542
48194c26a46c Initial revision
claus
parents:
diff changeset
  2543
facesInFamily:aFamilyName
48194c26a46c Initial revision
claus
parents:
diff changeset
  2544
    "return a set of all available font faces in aFamily on this display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2545
75
claus
parents: 71
diff changeset
  2546
    |allFonts faces "family face"|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2547
48194c26a46c Initial revision
claus
parents:
diff changeset
  2548
    allFonts := self listOfAvailableFonts.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2549
    allFonts isNil ifTrue:[^ nil].
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2550
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2551
    faces := Set new.
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2552
    allFonts do:[:fntDescr |
75
claus
parents: 71
diff changeset
  2553
	aFamilyName = fntDescr family ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2554
	    faces add:(fntDescr face)
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2555
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2556
    ].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2557
    ^ faces asSortedCollection
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2558
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2559
    "
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2560
     Display facesInFamily:'times'
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2561
     Display facesInFamily:'fixed'
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2562
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2563
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2564
48194c26a46c Initial revision
claus
parents:
diff changeset
  2565
stylesInFamily:aFamilyName face:aFaceName
48194c26a46c Initial revision
claus
parents:
diff changeset
  2566
    "return a set of all available font styles in aFamily/aFace on this display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2567
75
claus
parents: 71
diff changeset
  2568
    |allFonts styles "family face style"|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2569
48194c26a46c Initial revision
claus
parents:
diff changeset
  2570
    allFonts := self listOfAvailableFonts.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2571
    allFonts isNil ifTrue:[^ nil].
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2572
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2573
    styles := Set new.
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2574
    allFonts do:[:fntDescr |
75
claus
parents: 71
diff changeset
  2575
	(aFamilyName = fntDescr family) ifTrue:[
claus
parents: 71
diff changeset
  2576
	    (aFaceName = fntDescr face) ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2577
		styles add:fntDescr style
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2578
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2579
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2580
    ].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2581
    ^ styles asSortedCollection
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2582
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2583
    "
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2584
     Display stylesInFamily:'times' face:'medium'
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2585
     Display stylesInFamily:'times' face:'bold'
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2586
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2587
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2588
48194c26a46c Initial revision
claus
parents:
diff changeset
  2589
sizesInFamily:aFamilyName face:aFaceName style:aStyleName
48194c26a46c Initial revision
claus
parents:
diff changeset
  2590
    "return a set of all available font sizes in aFamily/aFace/aStyle
48194c26a46c Initial revision
claus
parents:
diff changeset
  2591
     on this display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2592
75
claus
parents: 71
diff changeset
  2593
    |allFonts sizes "family face style size"|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2594
48194c26a46c Initial revision
claus
parents:
diff changeset
  2595
    allFonts := self listOfAvailableFonts.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2596
    allFonts isNil ifTrue:[^ nil].
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2597
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2598
    sizes := Set new.
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2599
    allFonts do:[:fntDescr |
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2600
"/        family := fntDescr at:1.
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2601
"/        (family = aFamilyName) ifTrue:[
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2602
"/            face := fntDescr at:2.
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2603
"/            (face = aFaceName) ifTrue:[
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2604
"/                style := fntDescr at:3.
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2605
"/                (style = aStyleName) ifTrue:[
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2606
"/                    size := fntDescr at:4.
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2607
"/                    sizes add:size
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2608
"/                ]
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2609
"/            ]
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2610
"/        ]
75
claus
parents: 71
diff changeset
  2611
	(aFamilyName = fntDescr family) ifTrue:[
claus
parents: 71
diff changeset
  2612
	    (aFaceName = fntDescr face) ifTrue:[
claus
parents: 71
diff changeset
  2613
		(aStyleName = fntDescr style) ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2614
		    sizes add:fntDescr size
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2615
		]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2616
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2617
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2618
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2619
    ^ sizes
48194c26a46c Initial revision
claus
parents:
diff changeset
  2620
51
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2621
    "
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2622
     Display sizesInFamily:'times' face:'medium' style:'italic'
bab0d5f83df3 *** empty log message ***
claus
parents: 46
diff changeset
  2623
    "
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  2624
!
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  2625
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2626
getFontWithFamily:familyString
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2627
	     face:faceString
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2628
	    style:styleString
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2629
	     size:sizeArg
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2630
	 encoding:encodingSym
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2631
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2632
    "try to get the specified font, return id.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2633
     If not available, try next smaller font. 
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2634
     If no font fits, return nil"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2635
48194c26a46c Initial revision
claus
parents:
diff changeset
  2636
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2637
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2638
48194c26a46c Initial revision
claus
parents:
diff changeset
  2639
getDefaultFont
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2640
    "return a default font id 
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2641
     - used when class Font cannot find anything usable"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2642
48194c26a46c Initial revision
claus
parents:
diff changeset
  2643
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2644
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2645
48194c26a46c Initial revision
claus
parents:
diff changeset
  2646
releaseFont:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2647
    "free a font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2648
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2649
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2650
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2651
48194c26a46c Initial revision
claus
parents:
diff changeset
  2652
ascentOf:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2653
    "return the number of pixels above the base line of a font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2654
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2655
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2656
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2657
48194c26a46c Initial revision
claus
parents:
diff changeset
  2658
descentOf:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2659
    "return the number of pixels below the base line of a font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2660
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2661
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2662
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2663
48194c26a46c Initial revision
claus
parents:
diff changeset
  2664
minWidthOfFont:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2665
    "return the width in pixels of the smallest character a specific font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2666
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2667
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2668
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2669
48194c26a46c Initial revision
claus
parents:
diff changeset
  2670
maxWidthOfFont:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2671
    "return the width in pixels of the widest character a specific font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2672
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2673
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2674
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2675
48194c26a46c Initial revision
claus
parents:
diff changeset
  2676
widthOf:aString inFont:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2677
    "return the width in pixels of a string in a specific font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2678
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2679
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2680
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2681
48194c26a46c Initial revision
claus
parents:
diff changeset
  2682
widthOf:aString from:index1 to:index2 inFont:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2683
    "return the width in pixels of a substring in a specific font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2684
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2685
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2686
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  2687
48194c26a46c Initial revision
claus
parents:
diff changeset
  2688
!DeviceWorkstation methodsFor:'cursor stuff'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2689
48194c26a46c Initial revision
claus
parents:
diff changeset
  2690
destroyCursor:aCursorId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2691
    "free a cursor"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2692
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2693
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2694
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2695
48194c26a46c Initial revision
claus
parents:
diff changeset
  2696
createCursorSourceForm:sourceForm maskForm:maskForm hotX:hx hotY:hy
48194c26a46c Initial revision
claus
parents:
diff changeset
  2697
    "create a cursor given 2 bitmaps (source, mask) and a hotspot"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2698
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2699
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2700
48194c26a46c Initial revision
claus
parents:
diff changeset
  2701
createCursorShape:aShape
48194c26a46c Initial revision
claus
parents:
diff changeset
  2702
    "create a cursor given a shape-symbol"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2703
48194c26a46c Initial revision
claus
parents:
diff changeset
  2704
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2705
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2706
48194c26a46c Initial revision
claus
parents:
diff changeset
  2707
colorCursor:aCursorId foreground:fgColor background:bgColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  2708
    "change a cursors colors"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2709
48194c26a46c Initial revision
claus
parents:
diff changeset
  2710
    ^ self subclassResponsibility
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2711
! !
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2712
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2713
!DeviceWorkstation methodsFor:'grabbing '!
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2714
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2715
grabKeyboardInView:aView
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2716
    "grab the keyboard - all keyboard input will be sent to aView.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2717
     Return true if ok, false if it failed for some reason."
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2718
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2719
    activeKeyboardGrab notNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2720
	self ungrabKeyboard.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2721
	activeKeyboardGrab := nil
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2722
    ].
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2723
    (self grabKeyboardIn:(aView id)) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2724
	activeKeyboardGrab := aView.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2725
	^ true
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2726
    ].
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2727
    ^ false
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2728
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2729
48194c26a46c Initial revision
claus
parents:
diff changeset
  2730
grabKeyboardIn:aWindowId
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2731
    "grab the keyboard - all keyboard input will be sent to the view
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2732
     with id aWindowId"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2733
48194c26a46c Initial revision
claus
parents:
diff changeset
  2734
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2735
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2736
48194c26a46c Initial revision
claus
parents:
diff changeset
  2737
ungrabKeyboard
48194c26a46c Initial revision
claus
parents:
diff changeset
  2738
    "release the keyboard"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2739
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2740
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2741
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2742
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2743
activeKeyboardGrab
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2744
    "return the view, which currently has the keyboard grabbed,
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2745
     or nil, if there is none"
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2746
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2747
    ^ activeKeyboardGrab
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2748
!
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2749
        
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2750
grabPointerInView:aView
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2751
    "grap the pointer; all pointer events will be reported to
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2752
     aView. Return true if ok, false if it failed for some reason."
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2753
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2754
    activePointerGrab notNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2755
	self ungrabPointer.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2756
	activePointerGrab := nil
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2757
    ].
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2758
    (self grabPointerIn:(aView id)) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2759
	activePointerGrab := aView.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2760
	^ true
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2761
    ].
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2762
    ^ false
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2763
!
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2764
75
claus
parents: 71
diff changeset
  2765
grabPointerIn:aWindowId withCursor:cursorId pointerMode:pMode keyboardMode:kMode confineTo:confineId
claus
parents: 71
diff changeset
  2766
    "grap the pointer - all pointer events will be reported to aWindowId. The cursor will be set to cursorId
claus
parents: 71
diff changeset
  2767
     for the duration of the grab. For pMode/kMode, see X documentation. The pointer is restricted to
claus
parents: 71
diff changeset
  2768
     confineId - if non-nil."
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2769
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2770
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2771
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2772
75
claus
parents: 71
diff changeset
  2773
grabPointerIn:aWindowId
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2774
    "grap the pointer; all pointer events will be reported to the view
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2775
     with id aWindowId. Return true if ok, false if it failed for some reason."
75
claus
parents: 71
diff changeset
  2776
claus
parents: 71
diff changeset
  2777
    ^ self grabPointerIn:aWindowId withCursor:nil pointerMode:#async keyboardMode:#sync confineTo:nil
claus
parents: 71
diff changeset
  2778
!
claus
parents: 71
diff changeset
  2779
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2780
ungrabPointer
48194c26a46c Initial revision
claus
parents:
diff changeset
  2781
    "release the pointer"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2782
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2783
    ^ self subclassResponsibility
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2784
!
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2785
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2786
activePointerGrab
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2787
    "return the view, which currently has the pointer grabbed,
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2788
     or nil, if there is none"
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2789
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2790
    ^ activePointerGrab
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2791
!
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2792
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2793
setActivePointerGrab:aView
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2794
    "DO NOT USE. private kludge - will vanish"
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2795
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  2796
    activePointerGrab := aView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2797
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  2798
48194c26a46c Initial revision
claus
parents:
diff changeset
  2799
!DeviceWorkstation methodsFor:'color stuff'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2800
48194c26a46c Initial revision
claus
parents:
diff changeset
  2801
listOfAvailableColors
48194c26a46c Initial revision
claus
parents:
diff changeset
  2802
    "return a list of all available colornames;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2803
     This method should not be used, since colornames are
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  2804
     very X specific. However, the names defined here are pretty common"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2805
48194c26a46c Initial revision
claus
parents:
diff changeset
  2806
    ^ #('red' 'green' 'blue' 'yellow' 'magenta' 'cyan' 'white' 'black')
48194c26a46c Initial revision
claus
parents:
diff changeset
  2807
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2808
48194c26a46c Initial revision
claus
parents:
diff changeset
  2809
freeColor:colorIndex
48194c26a46c Initial revision
claus
parents:
diff changeset
  2810
    "free a color on the display, when its no longer needed"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2811
48194c26a46c Initial revision
claus
parents:
diff changeset
  2812
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2813
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2814
48194c26a46c Initial revision
claus
parents:
diff changeset
  2815
colorRed:redVal green:greenVal blue:blueVal
48194c26a46c Initial revision
claus
parents:
diff changeset
  2816
    "allocate a color with rgb values (0..100) - return index"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2817
48194c26a46c Initial revision
claus
parents:
diff changeset
  2818
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2819
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2820
48194c26a46c Initial revision
claus
parents:
diff changeset
  2821
colorNamed:aString
48194c26a46c Initial revision
claus
parents:
diff changeset
  2822
    "allocate a color with color name - return index.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2823
     Colors should not be allocated by name, since most colors
48194c26a46c Initial revision
claus
parents:
diff changeset
  2824
     are X specific - get colors by rgb instead."
48194c26a46c Initial revision
claus
parents:
diff changeset
  2825
48194c26a46c Initial revision
claus
parents:
diff changeset
  2826
    "support some of them ..."
48194c26a46c Initial revision
claus
parents:
diff changeset
  2827
48194c26a46c Initial revision
claus
parents:
diff changeset
  2828
    self getRGBFromName:aString into:[:r :g :b |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2829
	^ self colorRed:r green:g blue:b
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2830
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2831
    ^ nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  2832
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2833
48194c26a46c Initial revision
claus
parents:
diff changeset
  2834
colorCell
48194c26a46c Initial revision
claus
parents:
diff changeset
  2835
    "allocate a color - return index"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2836
48194c26a46c Initial revision
claus
parents:
diff changeset
  2837
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2838
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2839
48194c26a46c Initial revision
claus
parents:
diff changeset
  2840
setColor:index red:redVal green:greenVal blue:blueVal
48194c26a46c Initial revision
claus
parents:
diff changeset
  2841
    "change color in map at:index to rgb (0..100)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2842
48194c26a46c Initial revision
claus
parents:
diff changeset
  2843
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2844
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2845
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2846
redComponentOfColor:colorId
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2847
    "get red component (0..100) of color in map at:index"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2848
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2849
    self getRGBFrom:colorId into:[:r :g :b | ^ r]
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2850
!
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2851
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2852
greenComponentOfColor:colorId
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2853
    "get green component (0..100) of color in map at:index"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2854
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2855
    self getRGBFrom:colorId into:[:r :g :b | ^ g]
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2856
!
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2857
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2858
blueComponentOfColor:colorId
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2859
    "get blue component (0..100) of color in map at:index"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2860
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2861
    self getRGBFrom:colorId into:[:r :g :b | ^ b]
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2862
!
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  2863
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2864
getRGBFromName:colorName into:aBlock
48194c26a46c Initial revision
claus
parents:
diff changeset
  2865
    "get rgb components (0..100) of color named colorName,
48194c26a46c Initial revision
claus
parents:
diff changeset
  2866
     and evaluate the 3-arg block, aBlock with them.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2867
     The method here only handles some often used colors;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2868
     getRGBFromName should not be used, since colorNames other
48194c26a46c Initial revision
claus
parents:
diff changeset
  2869
     than those below are X specific."
48194c26a46c Initial revision
claus
parents:
diff changeset
  2870
48194c26a46c Initial revision
claus
parents:
diff changeset
  2871
    |idx names triple|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2872
48194c26a46c Initial revision
claus
parents:
diff changeset
  2873
    names := #('red' 'green' 'blue' 'yellow' 'magenta' 'cyan' 'white' 'black').
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  2874
    idx := names indexOf:colorName.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2875
    idx == 0 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2876
	idx := (names asLowercase) indexOf:colorName.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2877
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2878
    idx == 0 ifFalse:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2879
	triple := #(
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2880
			(100   0   0)  "red"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2881
			(  0 100   0)  "green"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2882
			(  0   0 100)  "blue"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2883
			(100 100   0)  "yellow"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2884
			(100   0 100)  "magenta"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2885
			(  0 100 100)  "cyan"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2886
			(100 100 100)  "white"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2887
			(  0   0   0)  "black"
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2888
		   ) at:idx.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2889
                        
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2890
	^ aBlock value:(triple at:1)
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2891
		 value:(triple at:2)
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  2892
		 value:(triple at:3)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2893
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2894
    ^ nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  2895
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2896
48194c26a46c Initial revision
claus
parents:
diff changeset
  2897
getRGBFrom:index into:aBlock
48194c26a46c Initial revision
claus
parents:
diff changeset
  2898
    "get rgb components (0..100) of color in map at:index,
48194c26a46c Initial revision
claus
parents:
diff changeset
  2899
     and evaluate the 3-arg block, aBlock with them"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2900
48194c26a46c Initial revision
claus
parents:
diff changeset
  2901
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2902
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  2903
48194c26a46c Initial revision
claus
parents:
diff changeset
  2904
!DeviceWorkstation methodsFor:'window stuff'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2905
48194c26a46c Initial revision
claus
parents:
diff changeset
  2906
setBackingStore:how in:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  2907
    "turn on/off backing-store for a window"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2908
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2909
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2910
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2911
48194c26a46c Initial revision
claus
parents:
diff changeset
  2912
setSaveUnder:yesOrNo in:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  2913
    "turn on/off save-under for a window"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2914
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2915
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2916
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2917
48194c26a46c Initial revision
claus
parents:
diff changeset
  2918
setWindowBackground:aColorIndex in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2919
    "set a windows background color"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2920
48194c26a46c Initial revision
claus
parents:
diff changeset
  2921
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2922
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2923
48194c26a46c Initial revision
claus
parents:
diff changeset
  2924
setWindowBackgroundPixmap:aPixmapId in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2925
    "set a windows background pattern to be a form"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2926
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2927
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2928
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2929
48194c26a46c Initial revision
claus
parents:
diff changeset
  2930
setWindowBorderColor:aColorIndex in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2931
    "set a windows border color"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2932
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2933
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2934
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2935
48194c26a46c Initial revision
claus
parents:
diff changeset
  2936
setWindowBorderPixmap:aPixmapId in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2937
    "set a windows border pattern"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2938
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2939
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2940
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2941
48194c26a46c Initial revision
claus
parents:
diff changeset
  2942
setWindowBorderWidth:aNumber in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2943
    "set a windows border width"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2944
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2945
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2946
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2947
48194c26a46c Initial revision
claus
parents:
diff changeset
  2948
setWindowBorderShape:aPixmapId in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2949
    "set a windows border shape"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2950
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2951
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2952
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2953
48194c26a46c Initial revision
claus
parents:
diff changeset
  2954
setWindowShape:aPixmapId in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2955
    "set a windows visible shape"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2956
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2957
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2958
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2959
48194c26a46c Initial revision
claus
parents:
diff changeset
  2960
setCursor:aCursorId in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2961
    "set a windows visible shape"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2962
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2963
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2964
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2965
48194c26a46c Initial revision
claus
parents:
diff changeset
  2966
setWindowName:aString in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2967
    "set a windows name"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2968
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2969
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2970
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2971
48194c26a46c Initial revision
claus
parents:
diff changeset
  2972
setIconName:aString in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2973
    "set a windows icon name"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2974
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2975
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2976
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2977
48194c26a46c Initial revision
claus
parents:
diff changeset
  2978
setWindowIcon:aForm in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2979
    "set a windows icon"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2980
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2981
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2982
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2983
48194c26a46c Initial revision
claus
parents:
diff changeset
  2984
setWindowIconWindow:aView in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2985
    "set a windows icon window"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2986
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2987
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2988
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2989
48194c26a46c Initial revision
claus
parents:
diff changeset
  2990
clearWindow:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2991
    "clear a windows to its view background"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2992
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2993
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  2994
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2995
48194c26a46c Initial revision
claus
parents:
diff changeset
  2996
clearRectangleX:x y:y width:width height:height in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  2997
    "clear a rectangular area of a window to its view background"
470d292c3218 before big change
claus
parents: 8
diff changeset
  2998
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2999
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3000
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3001
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  3002
mapView:aView id:aWindowId iconified:aBoolean atX:xPos y:yPos width:w height:h
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3003
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3004
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3005
48194c26a46c Initial revision
claus
parents:
diff changeset
  3006
mapWindow:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3007
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3008
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3009
48194c26a46c Initial revision
claus
parents:
diff changeset
  3010
unmapWindow:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3011
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3012
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3013
48194c26a46c Initial revision
claus
parents:
diff changeset
  3014
raiseWindow:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3015
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3016
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3017
48194c26a46c Initial revision
claus
parents:
diff changeset
  3018
lowerWindow:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3019
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3020
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3021
48194c26a46c Initial revision
claus
parents:
diff changeset
  3022
moveWindow:aWindowId x:x y:y
48194c26a46c Initial revision
claus
parents:
diff changeset
  3023
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3024
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3025
48194c26a46c Initial revision
claus
parents:
diff changeset
  3026
resizeWindow:aWindowId width:w height:h
48194c26a46c Initial revision
claus
parents:
diff changeset
  3027
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3028
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3029
48194c26a46c Initial revision
claus
parents:
diff changeset
  3030
moveResizeWindow:aWindowId x:x y:y width:w height:h
48194c26a46c Initial revision
claus
parents:
diff changeset
  3031
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3032
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  3033
48194c26a46c Initial revision
claus
parents:
diff changeset
  3034
!DeviceWorkstation methodsFor:'graphic context stuff'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3035
48194c26a46c Initial revision
claus
parents:
diff changeset
  3036
setForeground:fgColorIndex in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3037
    "set foreground color to be drawn with"
133
claus
parents: 123
diff changeset
  3038
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3039
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3040
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3041
48194c26a46c Initial revision
claus
parents:
diff changeset
  3042
setBackground:bgColorIndex in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3043
    "set background color to be drawn with"
133
claus
parents: 123
diff changeset
  3044
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3045
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3046
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3047
48194c26a46c Initial revision
claus
parents:
diff changeset
  3048
setForeground:fgColorIndex background:bgColorIndex in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3049
    "set foreground and background colors to be drawn with"
133
claus
parents: 123
diff changeset
  3050
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3051
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3052
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3053
48194c26a46c Initial revision
claus
parents:
diff changeset
  3054
setForeground:fgColor background:bgColor mask:aBitmapId in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3055
    "set foreground and background colors to be drawn with using mask or
48194c26a46c Initial revision
claus
parents:
diff changeset
  3056
     solid (if aBitmapId is nil)"
133
claus
parents: 123
diff changeset
  3057
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3058
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3059
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3060
48194c26a46c Initial revision
claus
parents:
diff changeset
  3061
setLineWidth:aNumber style:lineStyle cap:capStyle join:joinStyle in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3062
    "set line attributes"
133
claus
parents: 123
diff changeset
  3063
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3064
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3065
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3066
48194c26a46c Initial revision
claus
parents:
diff changeset
  3067
setForeground:fgColor background:bgColor mask:aBitmapId lineWidth:lw in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3068
    "set foreground and background colors to be drawn with using mask or
48194c26a46c Initial revision
claus
parents:
diff changeset
  3069
     solid (if aBitmapId is nil); also set lineWidth"
133
claus
parents: 123
diff changeset
  3070
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3071
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3072
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3073
48194c26a46c Initial revision
claus
parents:
diff changeset
  3074
setFunction:aFunctionSymbol in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3075
    "set alu function to be drawn with"
133
claus
parents: 123
diff changeset
  3076
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3077
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3078
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3079
48194c26a46c Initial revision
claus
parents:
diff changeset
  3080
setFont:aFontId in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3081
    "set font to be drawn in"
133
claus
parents: 123
diff changeset
  3082
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3083
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3084
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3085
48194c26a46c Initial revision
claus
parents:
diff changeset
  3086
setPixmapMask:aPixmapId in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3087
    "set or clear the drawing mask - a pixmap mask providing full color"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3088
48194c26a46c Initial revision
claus
parents:
diff changeset
  3089
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3090
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3091
48194c26a46c Initial revision
claus
parents:
diff changeset
  3092
setBitmapMask:aBitmapId in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3093
    "set or clear the drawing mask - a bitmap mask using current fg/bg"
133
claus
parents: 123
diff changeset
  3094
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3095
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3096
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3097
48194c26a46c Initial revision
claus
parents:
diff changeset
  3098
setMaskOriginX:orgX y:orgY in:aGCid
48194c26a46c Initial revision
claus
parents:
diff changeset
  3099
    "set the mask origin"
133
claus
parents: 123
diff changeset
  3100
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3101
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3102
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3103
48194c26a46c Initial revision
claus
parents:
diff changeset
  3104
setClipByChildren:aBool in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3105
    "enable/disable drawing into child views"
133
claus
parents: 123
diff changeset
  3106
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3107
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3108
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3109
48194c26a46c Initial revision
claus
parents:
diff changeset
  3110
noClipIn:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3111
    "disable clipping rectangle"
133
claus
parents: 123
diff changeset
  3112
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3113
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3114
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3115
48194c26a46c Initial revision
claus
parents:
diff changeset
  3116
setClipX:clipX y:clipY width:clipWidth height:clipHeight in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3117
    "clip to a rectangle"
133
claus
parents: 123
diff changeset
  3118
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3119
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3120
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3121
48194c26a46c Initial revision
claus
parents:
diff changeset
  3122
setGraphicsExposures:aBoolean in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3123
    "set or clear the graphics exposures flag"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3124
48194c26a46c Initial revision
claus
parents:
diff changeset
  3125
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3126
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  3127
48194c26a46c Initial revision
claus
parents:
diff changeset
  3128
!DeviceWorkstation methodsFor:'retrieving pixels'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3129
48194c26a46c Initial revision
claus
parents:
diff changeset
  3130
getPixelX:x y:y from:aDrawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3131
    "return the pixel value at x/y"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3132
48194c26a46c Initial revision
claus
parents:
diff changeset
  3133
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3134
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  3135
48194c26a46c Initial revision
claus
parents:
diff changeset
  3136
!DeviceWorkstation methodsFor:'drawing'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3137
75
claus
parents: 71
diff changeset
  3138
displayString:aString x:x y:y in:aDrawableId with:aGCId opaque:opaque
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3139
    "draw a string"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3140
48194c26a46c Initial revision
claus
parents:
diff changeset
  3141
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3142
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3143
75
claus
parents: 71
diff changeset
  3144
displayString:aString from:i1 to:i2 x:x y:y in:aDrawableId with:aGCId opaque:opaque
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3145
    "draw part of a string"
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3146
75
claus
parents: 71
diff changeset
  3147
    "
claus
parents: 71
diff changeset
  3148
     should be redefined in concrete subclasses
claus
parents: 71
diff changeset
  3149
     to avoid creation of throw-away string
claus
parents: 71
diff changeset
  3150
    "
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3151
    self displayString:(aString copyFrom:i1 to:i2)
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3152
		     x:x 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3153
		     y:y 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3154
		     in:aDrawableId 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3155
		     with:aGCId
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3156
		     opaque:opaque
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3157
!
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3158
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3159
displayString:aString x:x y:y in:aDrawableId with:aGCId
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3160
    "draw a string - draw foreground only.
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3161
     If the coordinates are not integers, retry with rounded." 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3162
75
claus
parents: 71
diff changeset
  3163
    self 
claus
parents: 71
diff changeset
  3164
	displayString:aString 
claus
parents: 71
diff changeset
  3165
	x:x 
claus
parents: 71
diff changeset
  3166
	y:y 
claus
parents: 71
diff changeset
  3167
	in:aDrawableId 
claus
parents: 71
diff changeset
  3168
	with:aGCId 
claus
parents: 71
diff changeset
  3169
	opaque:false
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3170
!
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3171
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3172
displayString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3173
    "draw a sub-string - draw foreground only.
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3174
     If the coordinates are not integers, retry with rounded." 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3175
75
claus
parents: 71
diff changeset
  3176
    self 
claus
parents: 71
diff changeset
  3177
	displayString:aString 
claus
parents: 71
diff changeset
  3178
	from:index1
claus
parents: 71
diff changeset
  3179
	to:index2
claus
parents: 71
diff changeset
  3180
	x:x 
claus
parents: 71
diff changeset
  3181
	y:y 
claus
parents: 71
diff changeset
  3182
	in:aDrawableId 
claus
parents: 71
diff changeset
  3183
	with:aGCId 
claus
parents: 71
diff changeset
  3184
	opaque:false
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3185
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3186
48194c26a46c Initial revision
claus
parents:
diff changeset
  3187
displayOpaqueString:aString x:x y:y in:aDrawableId with:aGCId
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3188
    "draw a string - draw foreground on background.
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3189
     If the coordinates are not integers, retry with rounded." 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3190
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3191
    self displayString:aString 
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3192
	 x:x 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3193
	 y:y 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3194
	 in:aDrawableId 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3195
	 with:aGCId 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3196
	 opaque:true
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3197
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3198
48194c26a46c Initial revision
claus
parents:
diff changeset
  3199
displayOpaqueString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3200
    "draw a sub-string - draw foreground on background.
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3201
     If the coordinates are not integers, retry with rounded." 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3202
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3203
    self displayString:aString 
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3204
	 from:index1
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3205
	 to:index2
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3206
	 x:x 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3207
	 y:y 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3208
	 in:aDrawableId 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3209
	 with:aGCId 
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3210
	 opaque:true
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3211
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3212
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  3213
displayPointX:x y:y in:aDrawableId with:aGCId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3214
    "draw a point"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3215
48194c26a46c Initial revision
claus
parents:
diff changeset
  3216
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3217
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3218
48194c26a46c Initial revision
claus
parents:
diff changeset
  3219
displayLineFromX:x0 y:y0 toX:x1 y:y1 in:aDrawableId with:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3220
    "draw a line"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  3221
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  3222
    "could add a bresenham line drawer here ..."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3223
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3224
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3225
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 23
diff changeset
  3226
displayRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3227
    "draw a rectangle"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3228
75
claus
parents: 71
diff changeset
  3229
    "
claus
parents: 71
diff changeset
  3230
     should draw four lines here
133
claus
parents: 123
diff changeset
  3231
     but then, we have to reimplement all line and join styles here
75
claus
parents: 71
diff changeset
  3232
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3233
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3234
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3235
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 23
diff changeset
  3236
displayPolygon:aPolygon in:aDrawableId with:aGCId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3237
    "draw a polygon"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  3238
75
claus
parents: 71
diff changeset
  3239
    "
claus
parents: 71
diff changeset
  3240
     should draw the lines here
133
claus
parents: 123
diff changeset
  3241
     but then, we have to reimplement all line and join styles here
75
claus
parents: 71
diff changeset
  3242
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3243
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3244
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3245
48194c26a46c Initial revision
claus
parents:
diff changeset
  3246
copyFromFaxImage:sourceId x:srcX y:srcY to:destId x:dstX y:dstY
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3247
		      width:w height:h with:aGCId scaleX:scaleX scaleY:scaleY
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3248
    "do a bit-blt"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  3249
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3250
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3251
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3252
48194c26a46c Initial revision
claus
parents:
diff changeset
  3253
copyFromId:sourceId x:srcX y:srcY to:destId x:dstX y:dstY
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3254
		width:w height:h with:aGCId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3255
    "do a bit-blt"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  3256
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3257
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3258
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3259
48194c26a46c Initial revision
claus
parents:
diff changeset
  3260
copyPlaneFromId:sourceId x:srcX y:srcY to:destId x:dstX y:dstY
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3261
		width:w height:h with:aGCId
133
claus
parents: 123
diff changeset
  3262
    "do a bit-blt, using the low-bit plane of the source only"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3263
48194c26a46c Initial revision
claus
parents:
diff changeset
  3264
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3265
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3266
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  3267
displayArcX:x y:y w:width h:height from:startAngle angle:angle
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3268
	     in:aDrawableId with:aGCId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3269
    "draw an arc"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  3270
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3271
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3272
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3273
48194c26a46c Initial revision
claus
parents:
diff changeset
  3274
fillArcX:x y:y w:width h:height from:startAngle angle:angle
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3275
	       in:aDrawableId with:aGCId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3276
    "fill an arc"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3277
48194c26a46c Initial revision
claus
parents:
diff changeset
  3278
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3279
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3280
48194c26a46c Initial revision
claus
parents:
diff changeset
  3281
fillRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3282
    "fill a rectangle"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  3283
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3284
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3285
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3286
48194c26a46c Initial revision
claus
parents:
diff changeset
  3287
fillPolygon:aPolygon in:aDrawableId with:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  3288
    "fill a polygon"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  3289
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3290
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3291
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3292
48194c26a46c Initial revision
claus
parents:
diff changeset
  3293
drawBits:imageBits depth:imageDepth width:imageWidth height:imageHeight
71
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3294
		       x:srcx y:srcy
6a42b2b115f8 *** empty log message ***
claus
parents: 57
diff changeset
  3295
		    into:aDrawableId x:dstx y:dsty width:w height:h with:aGCId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  3296
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3297
    "draw a bitimage which has depth id, width iw and height ih into
48194c26a46c Initial revision
claus
parents:
diff changeset
  3298
     the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3299
     It has to be checked elsewhere, that server can do it with the given
48194c26a46c Initial revision
claus
parents:
diff changeset
  3300
     depth; also it is assumed, that the colormap is setup correctly"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  3301
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3302
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  3303
! !