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