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