DeviceWorkstation.st
author claus
Sat, 30 Apr 1994 21:32:48 +0200
changeset 43 1d44cc4da884
parent 39 1eb8d508411c
child 46 7b331e9012fd
permissions -rw-r--r--
*** empty log message ***
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
48194c26a46c Initial revision
claus
parents:
diff changeset
     3
              All Rights Reserved
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
48194c26a46c Initial revision
claus
parents:
diff changeset
    15
                              visualType monitorType
48194c26a46c Initial revision
claus
parents:
diff changeset
    16
                              depth ncells bitsPerRGB
48194c26a46c Initial revision
claus
parents:
diff changeset
    17
                              hasColors hasGreyscales 
48194c26a46c Initial revision
claus
parents:
diff changeset
    18
                              width height widthMM heightMM resolutionHor resolutionVer
48194c26a46c Initial revision
claus
parents:
diff changeset
    19
                              knownViews knownIds knownBitmaps knownBitmapIds
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
    20
                              dispatching
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    21
                              controlDown shiftDown metaDown altDown
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
    22
                              motionEventCompression
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    23
                              lastId lastView
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
    24
                              keyboardMap
43
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
    25
                              isSlow activeGrab'
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    26
       classVariableNames:   'ButtonTranslation MultiClickTimeDelta
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    27
                              DeviceErrorSignal'
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    28
       poolDictionaries:''
48194c26a46c Initial revision
claus
parents:
diff changeset
    29
       category:'Interface-Graphics'
48194c26a46c Initial revision
claus
parents:
diff changeset
    30
!
48194c26a46c Initial revision
claus
parents:
diff changeset
    31
48194c26a46c Initial revision
claus
parents:
diff changeset
    32
DeviceWorkstation comment:'
48194c26a46c Initial revision
claus
parents:
diff changeset
    33
48194c26a46c Initial revision
claus
parents:
diff changeset
    34
COPYRIGHT (c) 1993 by Claus Gittinger
48194c26a46c Initial revision
claus
parents:
diff changeset
    35
              All Rights Reserved
48194c26a46c Initial revision
claus
parents:
diff changeset
    36
43
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
    37
$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.13 1994-04-30 19:32:48 claus Exp $
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    38
written jan 93 by claus
48194c26a46c Initial revision
claus
parents:
diff changeset
    39
'!
48194c26a46c Initial revision
claus
parents:
diff changeset
    40
48194c26a46c Initial revision
claus
parents:
diff changeset
    41
!DeviceWorkstation class methodsFor:'documentation'!
48194c26a46c Initial revision
claus
parents:
diff changeset
    42
48194c26a46c Initial revision
claus
parents:
diff changeset
    43
documentation
48194c26a46c Initial revision
claus
parents:
diff changeset
    44
"
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    45
    this abstract class defines common protocol to all Display types.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    46
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    47
    instance variables:
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    48
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    49
    displayId       <Number>        the device id of the display
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    50
    visualType      <Symbol>        one of #StaticGray, #PseudoColor, ... #TrueColor
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    51
    monitorType     <Symbol>        one of #monochrome, #color, #unknown
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    52
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    53
    depth           <Integer>       bits per color
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    54
    ncells          <Integer>       number of colors (i.e. colormap size; not always == 2^depth)
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    55
    bitsPerRGB      <Integer>       number of valid bits per rgb component
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    56
                                    (actual number taken in A/D converter; not all devices report the true value)
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    57
    hasColors       <Boolean>       true, if display supports colors
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    58
    hasGreyscales   <Boolean>       true, if display supports grey-scales (i.e is not b/w display)
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    59
    width           <Integer>       number of horizontal pixels
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    60
    height          <Integer>       number of vertical pixels 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    61
    heightMM        <Number>        screen height in millimeter
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    62
    widthMM         <Number>        screen width in millimeter
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    63
    resolutionHor   <Number>        pixels per horizontal millimeter
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    64
    resolutionVer   <Number>        pixels per vertical millimeter
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    65
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    66
    knownViews      <Collection>    all views known
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    67
    knownIds        <Collection>    corresponding device-view ids
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    68
    knownBitmaps    <Collection>    all known device bitmaps
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    69
    knownBitmapIds  <Collection>    corresponding device-bitmap ids
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    70
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    71
    dispatching     <Boolean>       true, if currently in dispatch loop
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    72
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    73
    controlDown     <Boolean>       true, if control key currently pressed
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    74
    shiftDown       <Boolean>       true, if shift key currently pressed
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    75
    metaDown        <Boolean>       true, if meta key (cmd-key) is currently pressed
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    76
    altDown         <Boolean>       true, if alt key is currently pressed
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    77
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    78
    motionEventCompression
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    79
43
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
    80
    lastId          <Number>	    the id of the last events view (internal)
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
    81
    lastView        <View>	    the last events view (internal, for faster id->view mapping)
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    82
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    83
    keyboardMap     <KeyBdMap>      mapping for keys
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    84
    isSlow          <Boolean>       set/cleared from startup - used to turn off
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
    85
                                    things like popup-shadows etc.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    86
"
48194c26a46c Initial revision
claus
parents:
diff changeset
    87
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
    88
48194c26a46c Initial revision
claus
parents:
diff changeset
    89
!DeviceWorkstation class methodsFor:'initialization'!
48194c26a46c Initial revision
claus
parents:
diff changeset
    90
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    91
initialize
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    92
    DeviceErrorSignal isNil ifTrue:[
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    93
        DeviceErrorSignal := (Signal new) mayProceed:true.
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    94
        DeviceErrorSignal notifierString:'device error'.
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    95
    ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    96
!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    97
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    98
initializeConstants
48194c26a46c Initial revision
claus
parents:
diff changeset
    99
    "initialize some (soft) constants"
48194c26a46c Initial revision
claus
parents:
diff changeset
   100
43
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   101
    MultiClickTimeDelta := 300.	      "a click within 300ms is considered a double one"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   102
    ButtonTranslation := #(1 2 3)     "identity translation"
48194c26a46c Initial revision
claus
parents:
diff changeset
   103
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   104
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   105
!DeviceWorkstation class methodsFor:'signal access'!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   106
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   107
deviceErrorSignal
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   108
    "return the signal used for device error reporting"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   109
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   110
    ^ DeviceErrorSignal
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   111
! !
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   112
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   113
!DeviceWorkstation class methodsFor:'accessing'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   114
48194c26a46c Initial revision
claus
parents:
diff changeset
   115
buttonTranslation:anArray
48194c26a46c Initial revision
claus
parents:
diff changeset
   116
    "set the button translation, #(1 2 3) is no-translation,
48194c26a46c Initial revision
claus
parents:
diff changeset
   117
     #(3 2 1) is ok for left-handers"
48194c26a46c Initial revision
claus
parents:
diff changeset
   118
48194c26a46c Initial revision
claus
parents:
diff changeset
   119
    ButtonTranslation := anArray
48194c26a46c Initial revision
claus
parents:
diff changeset
   120
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   121
48194c26a46c Initial revision
claus
parents:
diff changeset
   122
!DeviceWorkstation methodsFor:'initialize / release'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   123
48194c26a46c Initial revision
claus
parents:
diff changeset
   124
initialize
48194c26a46c Initial revision
claus
parents:
diff changeset
   125
    "initialize the receiver for a connection to the default display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   126
48194c26a46c Initial revision
claus
parents:
diff changeset
   127
    ^ self initializeFor:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   128
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   129
48194c26a46c Initial revision
claus
parents:
diff changeset
   130
initializeFor:aDisplayOrNilForAny
48194c26a46c Initial revision
claus
parents:
diff changeset
   131
    "initialize the receiver for a connection to a display. If the
48194c26a46c Initial revision
claus
parents:
diff changeset
   132
     argument is non-nil, it should specify which workstation should be
48194c26a46c Initial revision
claus
parents:
diff changeset
   133
     connected to (in a device specific manner). For X displays, this is
48194c26a46c Initial revision
claus
parents:
diff changeset
   134
     to be the display-string i.e. hostname:displayNr.
48194c26a46c Initial revision
claus
parents:
diff changeset
   135
     If the argument is nil,  connect to the default display."
48194c26a46c Initial revision
claus
parents:
diff changeset
   136
48194c26a46c Initial revision
claus
parents:
diff changeset
   137
    self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
   138
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   139
48194c26a46c Initial revision
claus
parents:
diff changeset
   140
close
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   141
    "close down connection to Display - usually never done"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   142
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   143
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
   144
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   145
48194c26a46c Initial revision
claus
parents:
diff changeset
   146
reinitialize
48194c26a46c Initial revision
claus
parents:
diff changeset
   147
    "reinit after snapin"
48194c26a46c Initial revision
claus
parents:
diff changeset
   148
48194c26a46c Initial revision
claus
parents:
diff changeset
   149
    |prevKnownViews|
48194c26a46c Initial revision
claus
parents:
diff changeset
   150
48194c26a46c Initial revision
claus
parents:
diff changeset
   151
    displayId := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   152
    prevKnownViews := knownViews.
48194c26a46c Initial revision
claus
parents:
diff changeset
   153
    knownViews := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   154
    knownIds := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   155
48194c26a46c Initial revision
claus
parents:
diff changeset
   156
    self initializeFor:nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   157
43
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   158
    "
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   159
     first, all Forms must be recreated
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   160
     (since they bay be needed for view recreation as
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   161
      background or icons)
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   162
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   163
    Form reinitializeAllOn:self.
48194c26a46c Initial revision
claus
parents:
diff changeset
   164
48194c26a46c Initial revision
claus
parents:
diff changeset
   165
    prevKnownViews notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   166
        "
48194c26a46c Initial revision
claus
parents:
diff changeset
   167
         first round: flush all device specific stuff
48194c26a46c Initial revision
claus
parents:
diff changeset
   168
        "
48194c26a46c Initial revision
claus
parents:
diff changeset
   169
        prevKnownViews do:[:aView |
48194c26a46c Initial revision
claus
parents:
diff changeset
   170
            aView notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   171
                aView prepareForReinit
48194c26a46c Initial revision
claus
parents:
diff changeset
   172
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   173
        ].
43
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   174
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   175
        "
48194c26a46c Initial revision
claus
parents:
diff changeset
   176
         2nd round: all views should reinstall themself
48194c26a46c Initial revision
claus
parents:
diff changeset
   177
                    on the new display
48194c26a46c Initial revision
claus
parents:
diff changeset
   178
        "
48194c26a46c Initial revision
claus
parents:
diff changeset
   179
        prevKnownViews do:[:aView |
48194c26a46c Initial revision
claus
parents:
diff changeset
   180
            aView notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   181
                "have to re-create the view"
48194c26a46c Initial revision
claus
parents:
diff changeset
   182
                aView reinitialize
48194c26a46c Initial revision
claus
parents:
diff changeset
   183
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   184
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   185
        "
48194c26a46c Initial revision
claus
parents:
diff changeset
   186
         3rd round: all views get a chance to handle
48194c26a46c Initial revision
claus
parents:
diff changeset
   187
                    changed environment (colors, font sizes etc)
48194c26a46c Initial revision
claus
parents:
diff changeset
   188
        "
48194c26a46c Initial revision
claus
parents:
diff changeset
   189
        prevKnownViews do:[:aView |
48194c26a46c Initial revision
claus
parents:
diff changeset
   190
            aView notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   191
                aView reAdjustGeometry
48194c26a46c Initial revision
claus
parents:
diff changeset
   192
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   193
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   194
    ].
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   195
    dispatching := false.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   196
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   197
48194c26a46c Initial revision
claus
parents:
diff changeset
   198
initializeKeyboardMap
48194c26a46c Initial revision
claus
parents:
diff changeset
   199
    "keystrokes from the server are translated via the keyboard map.
48194c26a46c Initial revision
claus
parents:
diff changeset
   200
     Untranslated keystrokes arrive either as characters, or symbols
48194c26a46c Initial revision
claus
parents:
diff changeset
   201
     (which are the keySyms as symbol). The mapping table which is
48194c26a46c Initial revision
claus
parents:
diff changeset
   202
     setup here, is used in sendKeyPress:... later.
48194c26a46c Initial revision
claus
parents:
diff changeset
   203
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   204
48194c26a46c Initial revision
claus
parents:
diff changeset
   205
    keyboardMap := KeyboardMap new.
48194c26a46c Initial revision
claus
parents:
diff changeset
   206
48194c26a46c Initial revision
claus
parents:
diff changeset
   207
    "
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   208
     no more setup here - moved everything out into 'display.rc' file
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   209
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   210
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   211
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   212
!DeviceWorkstation class methodsFor:'error handling'!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   213
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   214
resourceIdOfLastError
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   215
    "return the resource id responsible for the last error"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   216
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   217
    ^ self subclassResponsibility
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   218
!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   219
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   220
lastError
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   221
    "return a string descibing the last error"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   222
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   223
    ^ self subclassResponsibility
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   224
!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   225
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   226
errorInterrupt
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   227
    "x-error interrupt"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   228
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   229
    |badId badResource|
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   230
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   231
    badId := self resourceIdOfLastError.
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   232
    badId ~~ 0 ifTrue:[
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   233
        badResource := self resourceOfId:badId.
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   234
    ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   235
    ^ DeviceErrorSignal
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   236
            raiseRequestWith:badResource
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   237
            errorString: 'Display error: ' , (self lastError)
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   238
!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   239
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   240
resourceOfId:id
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   241
    "search thru all device stuff for a resource.
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   242
     Needed for error handling"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   243
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   244
    Form allInstances do:[:f |
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   245
        f id == id ifTrue:[^ f]
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   246
    ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   247
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   248
    self allInstances do:[:aDisplay |
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   249
        |views|
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   250
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   251
        views := aDisplay knownViews.
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   252
        views notNil ifTrue:[
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   253
            views do:[:v |
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   254
                v id == id ifTrue:[^ v].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   255
                v gcId == id ifTrue:[^ v]
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   256
            ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   257
        ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   258
    ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   259
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   260
    Color allInstances do:[:c |
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   261
        c colorId == id ifTrue:[^ c]
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   262
    ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   263
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   264
    Font allInstances do:[:f |
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   265
        f fontId == id ifTrue:[^ f]
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   266
    ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   267
    ^ nil
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   268
! !
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   269
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   270
!DeviceWorkstation methodsFor:'misc'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   271
48194c26a46c Initial revision
claus
parents:
diff changeset
   272
metaDown
48194c26a46c Initial revision
claus
parents:
diff changeset
   273
    "return true, if the meta-key (alt-key on systems without meta)
43
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   274
     is currently pressed.
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   275
     WARNING: obsolete, may vanish. Use protocol in WindowSensor."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   276
48194c26a46c Initial revision
claus
parents:
diff changeset
   277
    ^ metaDown
48194c26a46c Initial revision
claus
parents:
diff changeset
   278
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   279
48194c26a46c Initial revision
claus
parents:
diff changeset
   280
altDown
43
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   281
    "return true, if the alt-key is currently pressed.
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   282
     WARNING: obsolete, may vanish. Use protocol in WindowSensor."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   283
48194c26a46c Initial revision
claus
parents:
diff changeset
   284
    ^ altDown
48194c26a46c Initial revision
claus
parents:
diff changeset
   285
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   286
48194c26a46c Initial revision
claus
parents:
diff changeset
   287
controlDown
43
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   288
    "return true, if the control-key is currently pressed.
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   289
     WARNING: obsolete, may vanish. Use protocol in WindowSensor."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   290
48194c26a46c Initial revision
claus
parents:
diff changeset
   291
    ^ controlDown
48194c26a46c Initial revision
claus
parents:
diff changeset
   292
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   293
48194c26a46c Initial revision
claus
parents:
diff changeset
   294
shiftDown
43
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   295
    "return true, if the shift-key is currently pressed.
1d44cc4da884 *** empty log message ***
claus
parents: 39
diff changeset
   296
     WARNING: obsolete, may vanish. Use protocol in WindowSensor."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   297
48194c26a46c Initial revision
claus
parents:
diff changeset
   298
    ^ shiftDown
48194c26a46c Initial revision
claus
parents:
diff changeset
   299
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   300
48194c26a46c Initial revision
claus
parents:
diff changeset
   301
unBuffered
48194c26a46c Initial revision
claus
parents:
diff changeset
   302
    "make all drawing be sent immediately to the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   303
48194c26a46c Initial revision
claus
parents:
diff changeset
   304
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
   305
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   306
48194c26a46c Initial revision
claus
parents:
diff changeset
   307
buffered
48194c26a46c Initial revision
claus
parents:
diff changeset
   308
    "buffer drawing - do not send it immediately to the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   309
48194c26a46c Initial revision
claus
parents:
diff changeset
   310
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
   311
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   312
    
48194c26a46c Initial revision
claus
parents:
diff changeset
   313
synchronizeOutput
48194c26a46c Initial revision
claus
parents:
diff changeset
   314
    "send all buffered drawing to the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   315
48194c26a46c Initial revision
claus
parents:
diff changeset
   316
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
   317
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   318
48194c26a46c Initial revision
claus
parents:
diff changeset
   319
compressMotionEvents:aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   320
    "turn on/off motion event compression 
48194c26a46c Initial revision
claus
parents:
diff changeset
   321
     - compressions makes always sense except in free-hand drawing of curves"
48194c26a46c Initial revision
claus
parents:
diff changeset
   322
48194c26a46c Initial revision
claus
parents:
diff changeset
   323
    motionEventCompression := aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   324
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   325
48194c26a46c Initial revision
claus
parents:
diff changeset
   326
hasColors:aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   327
    "set the hasColors flag - needed since some servers dont tell the
48194c26a46c Initial revision
claus
parents:
diff changeset
   328
     truth if a monochrome monitor is connected to a color server"
48194c26a46c Initial revision
claus
parents:
diff changeset
   329
48194c26a46c Initial revision
claus
parents:
diff changeset
   330
    hasColors := aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   331
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   332
48194c26a46c Initial revision
claus
parents:
diff changeset
   333
hasGreyscales:aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   334
    "set the hasGreyscales flag - can be used to simulate b&w behavior"
48194c26a46c Initial revision
claus
parents:
diff changeset
   335
48194c26a46c Initial revision
claus
parents:
diff changeset
   336
    hasGreyscales := aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   337
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   338
48194c26a46c Initial revision
claus
parents:
diff changeset
   339
ignoreBackingStore:aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
   340
    "if the argument is true, the views backingStore setting will be ignored, and
48194c26a46c Initial revision
claus
parents:
diff changeset
   341
     no backing store used - this can be used on servers where backing store is
48194c26a46c Initial revision
claus
parents:
diff changeset
   342
     very slow (from rc-file)"
48194c26a46c Initial revision
claus
parents:
diff changeset
   343
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   344
    ^ self
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   345
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   346
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   347
isSlow:aBoolean
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   348
    "set/clear the slow flag"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   349
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   350
    isSlow := aBoolean
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   351
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   352
48194c26a46c Initial revision
claus
parents:
diff changeset
   353
beep
48194c26a46c Initial revision
claus
parents:
diff changeset
   354
    "output an audible beep or bell"
48194c26a46c Initial revision
claus
parents:
diff changeset
   355
48194c26a46c Initial revision
claus
parents:
diff changeset
   356
    Stdout nextPut:(Character bell)
48194c26a46c Initial revision
claus
parents:
diff changeset
   357
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   358
48194c26a46c Initial revision
claus
parents:
diff changeset
   359
setInputFocusTo:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
   360
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
   361
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   362
48194c26a46c Initial revision
claus
parents:
diff changeset
   363
!DeviceWorkstation methodsFor:'enumeration'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   364
48194c26a46c Initial revision
claus
parents:
diff changeset
   365
allViewsDo:aBlock
48194c26a46c Initial revision
claus
parents:
diff changeset
   366
    "evaluate the argument, aBlock for all known views"
48194c26a46c Initial revision
claus
parents:
diff changeset
   367
48194c26a46c Initial revision
claus
parents:
diff changeset
   368
    knownViews notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   369
        knownViews do:[:aView |
48194c26a46c Initial revision
claus
parents:
diff changeset
   370
            aView notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   371
                aBlock value:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   372
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   373
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   374
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   375
48194c26a46c Initial revision
claus
parents:
diff changeset
   376
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   377
     View defaultStyle:#iris.
48194c26a46c Initial revision
claus
parents:
diff changeset
   378
     Display allViewsDo:[:v | v initStyle. v redraw]
48194c26a46c Initial revision
claus
parents:
diff changeset
   379
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   380
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   381
     View defaultStyle:#next.
48194c26a46c Initial revision
claus
parents:
diff changeset
   382
     Display allViewsDo:[:v | v initStyle. v redraw]
48194c26a46c Initial revision
claus
parents:
diff changeset
   383
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   384
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   385
     View defaultStyle:#normal.
48194c26a46c Initial revision
claus
parents:
diff changeset
   386
     Display allViewsDo:[:v | v initStyle. v redraw]
48194c26a46c Initial revision
claus
parents:
diff changeset
   387
    "
48194c26a46c Initial revision
claus
parents:
diff changeset
   388
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   389
48194c26a46c Initial revision
claus
parents:
diff changeset
   390
!DeviceWorkstation methodsFor:'accessing & queries'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   391
48194c26a46c Initial revision
claus
parents:
diff changeset
   392
displayFileDescriptor
10
470d292c3218 before big change
claus
parents: 8
diff changeset
   393
    "return the file descriptor associated with the display
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   394
     if any. If there is no underlying filedescriptor, return nil.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   395
     (used for event select/polling)"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
   396
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   397
    ^ nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   398
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   399
48194c26a46c Initial revision
claus
parents:
diff changeset
   400
serverVendor
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   401
    "return a string describing the server vendor
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   402
     - returns a dummy here"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
   403
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   404
    ^ 'generic'
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   405
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   406
48194c26a46c Initial revision
claus
parents:
diff changeset
   407
vendorRelease
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   408
    "return a workstation release number
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   409
     - returns a dummy here"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   410
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   411
    ^ 0
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   412
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   413
48194c26a46c Initial revision
claus
parents:
diff changeset
   414
protocolVersion
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   415
    "return a protocol version number
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   416
     - returns a dummy here"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   417
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   418
    ^ 0
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   419
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   420
48194c26a46c Initial revision
claus
parents:
diff changeset
   421
blackpixel
48194c26a46c Initial revision
claus
parents:
diff changeset
   422
    "return the colorId of black"
48194c26a46c Initial revision
claus
parents:
diff changeset
   423
48194c26a46c Initial revision
claus
parents:
diff changeset
   424
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
   425
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   426
48194c26a46c Initial revision
claus
parents:
diff changeset
   427
whitepixel
48194c26a46c Initial revision
claus
parents:
diff changeset
   428
    "return the colorId of white"
48194c26a46c Initial revision
claus
parents:
diff changeset
   429
48194c26a46c Initial revision
claus
parents:
diff changeset
   430
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
   431
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   432
48194c26a46c Initial revision
claus
parents:
diff changeset
   433
viewIdFromPoint:aPoint in:windowId
48194c26a46c Initial revision
claus
parents:
diff changeset
   434
    "given a point in rootWindow, return the viewId of the subview of windowId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   435
     hit by this coordinate. Return nil if no view was hit.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   436
     - use to find window to drop objects after a cross-view drag"
48194c26a46c Initial revision
claus
parents:
diff changeset
   437
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   438
    "returning nil here actually makes drag&drop impossible
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   439
     - could also be reimplemented to make a search over all knownViews here"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   440
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   441
    ^ nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   442
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   443
48194c26a46c Initial revision
claus
parents:
diff changeset
   444
translatePoint:aPoint from:windowId1 to:windowId2
48194c26a46c Initial revision
claus
parents:
diff changeset
   445
    "given a point in window1, return the coordinate in window2
48194c26a46c Initial revision
claus
parents:
diff changeset
   446
     - use to xlate points from a window to rootwindow"
48194c26a46c Initial revision
claus
parents:
diff changeset
   447
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   448
    "could be reimplemented to make a search over all knownViews here"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   449
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
   450
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   451
48194c26a46c Initial revision
claus
parents:
diff changeset
   452
id
48194c26a46c Initial revision
claus
parents:
diff changeset
   453
    "return the displayId"
48194c26a46c Initial revision
claus
parents:
diff changeset
   454
48194c26a46c Initial revision
claus
parents:
diff changeset
   455
    ^ displayId
48194c26a46c Initial revision
claus
parents:
diff changeset
   456
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   457
48194c26a46c Initial revision
claus
parents:
diff changeset
   458
ncells
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   459
    "return the number of usable color cells, the display has 
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   460
     - this is not always the 2 to the power of depth."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   461
48194c26a46c Initial revision
claus
parents:
diff changeset
   462
    ^ ncells
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   463
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   464
    "Display ncells"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   465
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   466
48194c26a46c Initial revision
claus
parents:
diff changeset
   467
depth
48194c26a46c Initial revision
claus
parents:
diff changeset
   468
    "return the depth in pixels of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   469
48194c26a46c Initial revision
claus
parents:
diff changeset
   470
    ^ depth
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   471
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   472
    "Display depth"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   473
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   474
48194c26a46c Initial revision
claus
parents:
diff changeset
   475
bitsPerRGB
48194c26a46c Initial revision
claus
parents:
diff changeset
   476
    "return the number of valid bits per rgb component"
48194c26a46c Initial revision
claus
parents:
diff changeset
   477
48194c26a46c Initial revision
claus
parents:
diff changeset
   478
    ^ bitsPerRGB
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   479
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   480
    "Display bitsPerRGB"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   481
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   482
48194c26a46c Initial revision
claus
parents:
diff changeset
   483
visualType:aSymbol
48194c26a46c Initial revision
claus
parents:
diff changeset
   484
    "set the visual type. The only situation, where this makes sense,
48194c26a46c Initial revision
claus
parents:
diff changeset
   485
     is with my plasma-display, which ignores the palette and spits out
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   486
     grey scales, independent of LUT definitions. 
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   487
     (of which the server knows nothing).
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   488
     So, this should be used from a display-specific startup file only."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   489
48194c26a46c Initial revision
claus
parents:
diff changeset
   490
    visualType := aSymbol.
48194c26a46c Initial revision
claus
parents:
diff changeset
   491
    (visualType == #StaticGray or:[visualType == #GrayScale]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   492
        hasColors := false
48194c26a46c Initial revision
claus
parents:
diff changeset
   493
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   494
        hasColors := true
48194c26a46c Initial revision
claus
parents:
diff changeset
   495
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   496
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   497
48194c26a46c Initial revision
claus
parents:
diff changeset
   498
visualType
48194c26a46c Initial revision
claus
parents:
diff changeset
   499
    "return a symbol representing the visual type of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   500
48194c26a46c Initial revision
claus
parents:
diff changeset
   501
    ^ visualType
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   502
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   503
    "Display visualType"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   504
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   505
48194c26a46c Initial revision
claus
parents:
diff changeset
   506
monitorType
48194c26a46c Initial revision
claus
parents:
diff changeset
   507
    "return a symbol representing the monitor type of the display.
48194c26a46c Initial revision
claus
parents:
diff changeset
   508
     It is usually set to #unknown, #color or #monochrome.
48194c26a46c Initial revision
claus
parents:
diff changeset
   509
     But it can be set to any value from the startup file, for later
48194c26a46c Initial revision
claus
parents:
diff changeset
   510
     testing from anywhere. For example the startup for plasma-displays 
48194c26a46c Initial revision
claus
parents:
diff changeset
   511
     can set it to #plasma to later influence the colors used in widgets
48194c26a46c Initial revision
claus
parents:
diff changeset
   512
     (indirectly through the resource file)."
48194c26a46c Initial revision
claus
parents:
diff changeset
   513
48194c26a46c Initial revision
claus
parents:
diff changeset
   514
    ^ monitorType
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   515
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   516
    "Display monitorType"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   517
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   518
48194c26a46c Initial revision
claus
parents:
diff changeset
   519
monitorType:aSymbol
48194c26a46c Initial revision
claus
parents:
diff changeset
   520
    "set the monitorType - see comment in DeviceWorkstation>>montorType"
48194c26a46c Initial revision
claus
parents:
diff changeset
   521
48194c26a46c Initial revision
claus
parents:
diff changeset
   522
    monitorType := aSymbol
48194c26a46c Initial revision
claus
parents:
diff changeset
   523
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   524
48194c26a46c Initial revision
claus
parents:
diff changeset
   525
hasColors
48194c26a46c Initial revision
claus
parents:
diff changeset
   526
    "return true, if its a color display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   527
48194c26a46c Initial revision
claus
parents:
diff changeset
   528
    ^ hasColors
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   529
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   530
    "Display hasColors"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   531
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   532
48194c26a46c Initial revision
claus
parents:
diff changeset
   533
hasGreyscales
48194c26a46c Initial revision
claus
parents:
diff changeset
   534
    "return true, if this workstation supports greyscales
48194c26a46c Initial revision
claus
parents:
diff changeset
   535
     (also true for color displays)"
48194c26a46c Initial revision
claus
parents:
diff changeset
   536
48194c26a46c Initial revision
claus
parents:
diff changeset
   537
    ^ hasGreyscales
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   538
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   539
    "Display hasGreyscales"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   540
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   541
48194c26a46c Initial revision
claus
parents:
diff changeset
   542
hasShape
48194c26a46c Initial revision
claus
parents:
diff changeset
   543
    "return true, if this workstation supports non-rectangular windows"
48194c26a46c Initial revision
claus
parents:
diff changeset
   544
48194c26a46c Initial revision
claus
parents:
diff changeset
   545
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
   546
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   547
48194c26a46c Initial revision
claus
parents:
diff changeset
   548
hasShm
48194c26a46c Initial revision
claus
parents:
diff changeset
   549
    "return true, if this workstation supports shared pixmaps"
48194c26a46c Initial revision
claus
parents:
diff changeset
   550
48194c26a46c Initial revision
claus
parents:
diff changeset
   551
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
   552
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   553
48194c26a46c Initial revision
claus
parents:
diff changeset
   554
hasFax
48194c26a46c Initial revision
claus
parents:
diff changeset
   555
    "return true, if this workstation supports decompression of fax images"
48194c26a46c Initial revision
claus
parents:
diff changeset
   556
48194c26a46c Initial revision
claus
parents:
diff changeset
   557
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
   558
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   559
48194c26a46c Initial revision
claus
parents:
diff changeset
   560
hasDPS
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   561
    "return true, if this workstation supports postscript output into views"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   562
48194c26a46c Initial revision
claus
parents:
diff changeset
   563
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
   564
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   565
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   566
isSlow
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   567
    "return true, if this is a relatively slow device -
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   568
     used to turn off things like popup-shadows"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   569
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   570
    ^ isSlow
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   571
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   572
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   573
keyboardMap
48194c26a46c Initial revision
claus
parents:
diff changeset
   574
    "return the keyboard map"
48194c26a46c Initial revision
claus
parents:
diff changeset
   575
48194c26a46c Initial revision
claus
parents:
diff changeset
   576
    ^ keyboardMap
48194c26a46c Initial revision
claus
parents:
diff changeset
   577
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   578
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   579
keyboardMap:aMap
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   580
    "set the keyboard map"
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   581
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   582
    keyboardMap := aMap
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   583
!
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   584
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   585
width
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   586
    "return the width of the display (in pixels)"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   587
48194c26a46c Initial revision
claus
parents:
diff changeset
   588
    ^ width
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   589
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   590
    "Display width"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   591
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   592
48194c26a46c Initial revision
claus
parents:
diff changeset
   593
height
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   594
    "return the height of the display (in pixels)"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   595
48194c26a46c Initial revision
claus
parents:
diff changeset
   596
    ^ height
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   597
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   598
    "Display height"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   599
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   600
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   601
extent
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   602
    "return the extent of the display (in pixels)"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   603
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   604
    ^ width @ height
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   605
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   606
    "Display extent"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   607
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   608
48194c26a46c Initial revision
claus
parents:
diff changeset
   609
boundingBox
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   610
    "return a rectangle representing the displays bounding box.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   611
     For Smalltalk-80 compatibility"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   612
48194c26a46c Initial revision
claus
parents:
diff changeset
   613
    ^ Rectangle origin:(0 @ 0) extent:(width @ height)
48194c26a46c Initial revision
claus
parents:
diff changeset
   614
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   615
48194c26a46c Initial revision
claus
parents:
diff changeset
   616
widthInMillimeter
48194c26a46c Initial revision
claus
parents:
diff changeset
   617
    "return the width in millimeter of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   618
48194c26a46c Initial revision
claus
parents:
diff changeset
   619
    ^ widthMM
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   620
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   621
    "Display widthInMillimeter"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   622
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   623
48194c26a46c Initial revision
claus
parents:
diff changeset
   624
heightInMillimeter
48194c26a46c Initial revision
claus
parents:
diff changeset
   625
    "return the height in millimeter of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   626
48194c26a46c Initial revision
claus
parents:
diff changeset
   627
    ^ heightMM
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   628
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   629
    "Display heightInMillimeter"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   630
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   631
48194c26a46c Initial revision
claus
parents:
diff changeset
   632
widthInMillimeter:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   633
    "set the width in millimeter of the display 
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   634
     - needed since some displays do not tell the truth or do not know it"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   635
48194c26a46c Initial revision
claus
parents:
diff changeset
   636
    widthMM := aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   637
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   638
48194c26a46c Initial revision
claus
parents:
diff changeset
   639
heightInMillimeter:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   640
    "set the height in millimeter of the display 
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   641
     - needed since some displays do not tell the truth or do not know it"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   642
48194c26a46c Initial revision
claus
parents:
diff changeset
   643
    heightMM := aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   644
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   645
48194c26a46c Initial revision
claus
parents:
diff changeset
   646
pixelPerMillimeter
48194c26a46c Initial revision
claus
parents:
diff changeset
   647
    "return the number of horizontal/vertical pixels per millimeter of the display as Point"
48194c26a46c Initial revision
claus
parents:
diff changeset
   648
48194c26a46c Initial revision
claus
parents:
diff changeset
   649
    ^ (width / widthMM) @ (height / heightMM)
48194c26a46c Initial revision
claus
parents:
diff changeset
   650
48194c26a46c Initial revision
claus
parents:
diff changeset
   651
    "Display pixelPerMillimeter"
48194c26a46c Initial revision
claus
parents:
diff changeset
   652
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   653
48194c26a46c Initial revision
claus
parents:
diff changeset
   654
pixelPerInch
48194c26a46c Initial revision
claus
parents:
diff changeset
   655
    "return the number of horizontal/vertical pixels per inch of the display as Point"
48194c26a46c Initial revision
claus
parents:
diff changeset
   656
48194c26a46c Initial revision
claus
parents:
diff changeset
   657
    ^ ((width / widthMM) @ (height / heightMM)) * 25.4
48194c26a46c Initial revision
claus
parents:
diff changeset
   658
48194c26a46c Initial revision
claus
parents:
diff changeset
   659
    "Display pixelPerInch"
48194c26a46c Initial revision
claus
parents:
diff changeset
   660
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   661
48194c26a46c Initial revision
claus
parents:
diff changeset
   662
horizontalPixelPerMillimeter
48194c26a46c Initial revision
claus
parents:
diff changeset
   663
    "return the number of horizontal pixels per millimeter of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   664
48194c26a46c Initial revision
claus
parents:
diff changeset
   665
    ^ width / widthMM
48194c26a46c Initial revision
claus
parents:
diff changeset
   666
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   667
48194c26a46c Initial revision
claus
parents:
diff changeset
   668
verticalPixelPerMillimeter
48194c26a46c Initial revision
claus
parents:
diff changeset
   669
    "return the number of vertical pixels per millimeter of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   670
48194c26a46c Initial revision
claus
parents:
diff changeset
   671
    ^ height / heightMM
48194c26a46c Initial revision
claus
parents:
diff changeset
   672
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   673
48194c26a46c Initial revision
claus
parents:
diff changeset
   674
horizontalPixelPerInch
48194c26a46c Initial revision
claus
parents:
diff changeset
   675
    "return the number of horizontal pixels per inch of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   676
48194c26a46c Initial revision
claus
parents:
diff changeset
   677
    ^ (width / widthMM) * 25.4
48194c26a46c Initial revision
claus
parents:
diff changeset
   678
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   679
48194c26a46c Initial revision
claus
parents:
diff changeset
   680
verticalPixelPerInch
48194c26a46c Initial revision
claus
parents:
diff changeset
   681
    "return the number of vertical pixels per inch of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   682
48194c26a46c Initial revision
claus
parents:
diff changeset
   683
    ^ (height / heightMM) * 25.4
48194c26a46c Initial revision
claus
parents:
diff changeset
   684
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   685
48194c26a46c Initial revision
claus
parents:
diff changeset
   686
center
48194c26a46c Initial revision
claus
parents:
diff changeset
   687
    "return the centerpoint in pixels of the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   688
48194c26a46c Initial revision
claus
parents:
diff changeset
   689
    ^ (width // 2) @ (height // 2)
48194c26a46c Initial revision
claus
parents:
diff changeset
   690
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   691
48194c26a46c Initial revision
claus
parents:
diff changeset
   692
knownViews
48194c26a46c Initial revision
claus
parents:
diff changeset
   693
    "return a collection of all known views"
48194c26a46c Initial revision
claus
parents:
diff changeset
   694
48194c26a46c Initial revision
claus
parents:
diff changeset
   695
    ^ knownViews
48194c26a46c Initial revision
claus
parents:
diff changeset
   696
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   697
48194c26a46c Initial revision
claus
parents:
diff changeset
   698
knownViews:aCollection
48194c26a46c Initial revision
claus
parents:
diff changeset
   699
    "set the collection of all known views - take care,
48194c26a46c Initial revision
claus
parents:
diff changeset
   700
     bad use of this will create funny results; use only for snapshot support"
48194c26a46c Initial revision
claus
parents:
diff changeset
   701
48194c26a46c Initial revision
claus
parents:
diff changeset
   702
    knownViews := aCollection
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   703
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   704
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   705
pointFromUser
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   706
    "let user specify a point on the screen"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   707
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   708
    |curs p|
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   709
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   710
    curs := Cursor crossHair on:self.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   711
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   712
    self ungrabPointer.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   713
    self grabPointerIn:RootView id withCursor:curs id
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   714
             pointerMode:#async keyboardMode:#sync confineTo:nil.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   715
    ActiveGrab := RootView.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   716
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   717
    [self leftButtonPressed] whileFalse:[].
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   718
    p := self pointerPosition.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   719
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   720
    self ungrabPointer.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   721
    ActiveGrab := nil.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   722
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   723
    "flush all events pending on myself"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   724
    self disposeEvents.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   725
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   726
    ^ p
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   727
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   728
    "Display pointFromUser"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   729
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   730
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   731
rectangleFromUser
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   732
    "let user specify a rectangle"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   733
39
1eb8d508411c *** empty log message ***
claus
parents: 38
diff changeset
   734
    |curs1 curs2 p1 p2 |
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   735
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   736
    curs1 := Cursor origin on:self.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   737
    curs2 := Cursor corner on:self.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   738
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   739
    self ungrabPointer.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   740
    self grabPointerIn:RootView id withCursor:curs1 id
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   741
             pointerMode:#async keyboardMode:#sync confineTo:nil.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   742
    ActiveGrab := RootView.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   743
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   744
    [self leftButtonPressed] whileFalse:[].
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   745
    p1 := self pointerPosition.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   746
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   747
    self ungrabPointer.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   748
    self grabPointerIn:RootView id withCursor:curs1 id
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   749
             pointerMode:#async keyboardMode:#sync confineTo:nil.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   750
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   751
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   752
    RootView noClipByChildren.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   753
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   754
    RootView foreground:Color black.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   755
    RootView background:Color white.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   756
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   757
    RootView xoring:[
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   758
        p2 := p1.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   759
        RootView displayRectangle:(p1 corner:p2).
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   760
        [self leftButtonPressed] whileTrue:[
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   761
            RootView displayRectangle:(p1 corner:p2).
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   762
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   763
            self ungrabPointer.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   764
            self grabPointerIn:RootView id withCursor:curs2 id
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   765
                     pointerMode:#async keyboardMode:#sync confineTo:nil.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   766
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   767
            p2 := self pointerPosition.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   768
            RootView displayRectangle:(p1 corner:p2).
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   769
            self synchronizeOutput.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   770
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   771
        ].
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   772
        RootView displayRectangle:(p1 corner:p2).
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   773
    ].
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   774
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   775
    self ungrabPointer.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   776
    ActiveGrab := nil.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   777
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   778
    "flush all events pending on my display"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   779
    self disposeEvents.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   780
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   781
    RootView clipByChildren.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   782
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   783
    ^ p1 corner:p2
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   784
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   785
    "Display rectangleFromUser"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   786
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   787
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   788
viewFromUser
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   789
    "let user specify a view on the screen; if the selected view is
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   790
     not an st/x view, nil is returned.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   791
     (send topView to the returned view to get its root-top)"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   792
39
1eb8d508411c *** empty log message ***
claus
parents: 38
diff changeset
   793
    |view p id searchId foundId|
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   794
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   795
    p := self pointFromUser.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   796
39
1eb8d508411c *** empty log message ***
claus
parents: 38
diff changeset
   797
    "search view the point is in"
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   798
    searchId := RootView id.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   799
    [searchId notNil] whileTrue:[
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   800
        id := self viewIdFromPoint:p in:searchId.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   801
        foundId := searchId.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   802
        searchId := id
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   803
    ].
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   804
    view := self viewFromId:foundId.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   805
    ^ view
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   806
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   807
    "Display viewFromUser"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   808
    "|v|
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   809
     v := Display viewFromUser.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   810
     v notNil ifTrue:[v topView] ifFalse:[nil]"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   811
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   812
48194c26a46c Initial revision
claus
parents:
diff changeset
   813
!DeviceWorkstation methodsFor:'keyboard mapping'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   814
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   815
sendKeyPress:untranslatedKey x:x y:y to:someone
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   816
    "forward a key-press event to some handler;
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   817
     the key is translated via the translation table here."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   818
48194c26a46c Initial revision
claus
parents:
diff changeset
   819
    |key xlatedKey|
48194c26a46c Initial revision
claus
parents:
diff changeset
   820
48194c26a46c Initial revision
claus
parents:
diff changeset
   821
    key := untranslatedKey.
48194c26a46c Initial revision
claus
parents:
diff changeset
   822
    controlDown ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   823
        (key size == 1) ifTrue:[   "a single character"
48194c26a46c Initial revision
claus
parents:
diff changeset
   824
            key := ('Ctrl' , untranslatedKey asString) asSymbol
48194c26a46c Initial revision
claus
parents:
diff changeset
   825
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   826
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   827
    metaDown ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   828
        (untranslatedKey isMemberOf:Character) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   829
            key := ('Cmd' , untranslatedKey asString) asSymbol
48194c26a46c Initial revision
claus
parents:
diff changeset
   830
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   831
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   832
    altDown ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   833
        (untranslatedKey isMemberOf:Character) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   834
            key := ('Alt' , untranslatedKey asString) asSymbol
48194c26a46c Initial revision
claus
parents:
diff changeset
   835
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   836
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   837
48194c26a46c Initial revision
claus
parents:
diff changeset
   838
48194c26a46c Initial revision
claus
parents:
diff changeset
   839
    xlatedKey := keyboardMap valueFor:key.
48194c26a46c Initial revision
claus
parents:
diff changeset
   840
    xlatedKey notNil ifTrue:[
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   841
        someone delegate notNil ifTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   842
            someone delegate keyPress:xlatedKey x:x y:y view:someone
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   843
        ] ifFalse:[
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   844
            someone keyPress:xlatedKey x:x y:y
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   845
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   846
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   847
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   848
48194c26a46c Initial revision
claus
parents:
diff changeset
   849
!DeviceWorkstation methodsFor:'private'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   850
48194c26a46c Initial revision
claus
parents:
diff changeset
   851
addKnownView:aView withId:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   852
    "add the View aView with Id:aNumber to the list of known views/id's"
48194c26a46c Initial revision
claus
parents:
diff changeset
   853
48194c26a46c Initial revision
claus
parents:
diff changeset
   854
    knownViews isNil ifTrue:[
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
   855
        knownViews := OrderedCollection new "(VariableArray new:100) grow:0".
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
   856
        knownIds := OrderedCollection new "(VariableArray new:100) grow:0"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   857
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   858
    knownViews add:aView.
48194c26a46c Initial revision
claus
parents:
diff changeset
   859
    knownIds add:aNumber.
48194c26a46c Initial revision
claus
parents:
diff changeset
   860
    lastView := aView.
48194c26a46c Initial revision
claus
parents:
diff changeset
   861
    lastId := aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   862
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   863
48194c26a46c Initial revision
claus
parents:
diff changeset
   864
removeKnownView:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   865
    "remove aView from the list of known views/id's"
48194c26a46c Initial revision
claus
parents:
diff changeset
   866
48194c26a46c Initial revision
claus
parents:
diff changeset
   867
    |index|
48194c26a46c Initial revision
claus
parents:
diff changeset
   868
48194c26a46c Initial revision
claus
parents:
diff changeset
   869
    knownViews notNil ifTrue:[
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   870
        index := knownViews identityIndexOf:aView.
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   871
        index == 0 ifFalse:[
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   872
            knownViews removeIndex:index.
48194c26a46c Initial revision
claus
parents:
diff changeset
   873
            knownIds removeIndex:index.
48194c26a46c Initial revision
claus
parents:
diff changeset
   874
            lastId := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   875
            lastView := nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   876
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   877
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   878
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   879
48194c26a46c Initial revision
claus
parents:
diff changeset
   880
viewFromId:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   881
    "given an Id, return the corresponding view"
48194c26a46c Initial revision
claus
parents:
diff changeset
   882
48194c26a46c Initial revision
claus
parents:
diff changeset
   883
    |index|
48194c26a46c Initial revision
claus
parents:
diff changeset
   884
48194c26a46c Initial revision
claus
parents:
diff changeset
   885
    (aNumber == lastId) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   886
        ^ lastView
48194c26a46c Initial revision
claus
parents:
diff changeset
   887
    ].
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   888
    index := knownIds identityIndexOf:aNumber.
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
   889
    index == 0 ifTrue:[^ nil].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   890
    lastView := knownViews at:index.
48194c26a46c Initial revision
claus
parents:
diff changeset
   891
    lastId := aNumber.
48194c26a46c Initial revision
claus
parents:
diff changeset
   892
    ^ lastView
48194c26a46c Initial revision
claus
parents:
diff changeset
   893
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   894
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   895
!DeviceWorkstation methodsFor:'window stuff'!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   896
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   897
setCursors:aCursor
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   898
    "change the cursor of all views to aCursorId"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   899
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   900
    | id |
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   901
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   902
    id := (aCursor on:self) id.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   903
    id notNil ifTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   904
        knownViews notNil ifTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   905
            knownViews do:[:aView |
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   906
                aView id notNil ifTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   907
                    self setCursor:id in:(aView id)
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   908
                ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   909
            ].
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   910
            self synchronizeOutput
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   911
        ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   912
    ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   913
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   914
    "Display setCursors:Cursor wait"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   915
    "Display restoreCursors"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   916
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   917
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   918
restoreCursors
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   919
    "restore the cursors of all views to their current cursor"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   920
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   921
    knownViews notNil ifTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   922
        knownViews do:[:aView |
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   923
            aView id notNil ifTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   924
                aView cursor notNil ifTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   925
                    aView cursor id notNil ifTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   926
                        self setCursor:(aView cursor id) in:(aView id)
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   927
                    ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   928
                ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   929
            ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   930
        ].
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   931
        self synchronizeOutput
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   932
    ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   933
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   934
    "Display setCursors:(Cursor wait)"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   935
    "Display restoreCursors"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   936
! !
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   937
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   938
!DeviceWorkstation methodsFor:'events'!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   939
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   940
startDispatch
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   941
    "create the display dispatch process"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   942
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   943
    |sema fd p|
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   944
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   945
    dispatching ifTrue:[^ self].
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   946
    dispatching := true.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   947
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   948
    fd := self displayFileDescriptor.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   949
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   950
    ProcessorScheduler isPureEventDriven ifTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   951
        "handle all events by having preocessor call a block when something
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   952
         arrives on my filedescriptor"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   953
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   954
        Processor enableIOAction:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   955
                                     dispatching ifTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   956
                                         [self eventPending] whileTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   957
                                             self dispatchPendingEvents.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   958
                                             self checkForEndOfDispatch.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   959
                                         ].
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   960
                                         dispatching ifFalse:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   961
                                             Processor disableFd:fd
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   962
                                         ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   963
                                     ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   964
                                 ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   965
                              on:fd
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   966
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   967
    ] ifFalse:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   968
        "handle stuff as a process - sitting on a semaphore.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   969
         Tell Processor to trigger this semaphore when something arrives
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   970
         on my filedescriptor"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   971
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   972
        sema := Semaphore new.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   973
        p := [
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   974
            [dispatching] whileTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   975
                self eventPending ifFalse:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   976
                    Processor enableSemaphore:sema onInput:fd check:[self eventPending].
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   977
                    sema wait.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   978
                    Processor disableSemaphore:sema
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   979
                ].
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   980
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   981
                self dispatchPendingEvents.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   982
                self checkForEndOfDispatch.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   983
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   984
                dispatching ifFalse:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   985
                    sema := nil
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   986
                ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   987
            ]
21
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
   988
        ] forkAt:(Processor userSchedulingPriority).
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   989
        p name:'event dispatcher'
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   990
    ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   991
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   992
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   993
checkForEndOfDispatch
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   994
    "return true, if there are still any views of interrest - if not,
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   995
     stop dispatch"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   996
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   997
    self == Display ifTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   998
        knownViews isEmpty ifTrue:[
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
   999
            dispatching := false
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1000
        ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1001
    ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1002
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1003
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1004
dispatchPendingEvents
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1005
    Object abortSignal catch:[
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1006
        [self eventPending] whileTrue:[
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1007
            self dispatchEventFor:nil withMask:nil
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1008
        ]
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1009
    ]
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1010
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1011
21
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  1012
dispatchModalWhile:aBlock
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  1013
    "get and process next event for any view as long as the 
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  1014
     argument-block evaluates to true.
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  1015
     This is a modal loop, not switching to other processes."
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1016
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1017
    [aBlock value] whileTrue:[
21
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  1018
        self eventPending ifFalse:[
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  1019
            Processor evaluateTimeouts.
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  1020
            OperatingSystem millisecondDelay:50.
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  1021
        ].
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1022
        self dispatchEvent
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1023
    ].
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1024
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1025
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1026
dispatchEvent
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1027
    "get and process next event for any view"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1028
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1029
    self dispatchEventFor:nil withMask:nil
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1030
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1031
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1032
eventMaskFor:anEventSymbol
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1033
    ^ self subclassResponsibility
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1034
! 
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1035
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1036
setEventMask:aMask in:aWindowId
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1037
    ^ self subclassResponsibility
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1038
! 
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1039
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1040
dispatchEventFor:aViewIdOrNil withMask:eventMask
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1041
    "central event handling method:
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1042
     get next event and send appropriate message to the view or the sensor,
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1043
     if the view has one.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1044
     If the argument aViewIdOrNil is nil, events for any view are processed,
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1045
     otherwise only events for the view with given id are processed
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1046
     (in this case, nothing is done if no events are pending);
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1047
     if the argument aMask is nonNil, only events for this eventMask are
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1048
     handled;"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1049
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1050
    ^ self subclassResponsibility
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1051
! 
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1052
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1053
disposeEventsWithMask:aMask for:aWindowId
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1054
    "dispose (throw away) specific events"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1055
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1056
    ^ self subclassResponsibility
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1057
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1058
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1059
disposeEvents
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1060
    "flush all events pending on this display"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1061
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1062
    [self eventPending] whileTrue:[
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1063
        self getEventFor:nil withMask:nil
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1064
    ].
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1065
! 
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1066
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1067
eventPending
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1068
    "return true, if any event is pending"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1069
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1070
    ^ self subclassResponsibility
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1071
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1072
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1073
eventPendingWithoutSync
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1074
    "return true, if any event is pending"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1075
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1076
    ^ self subclassResponsibility
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1077
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1078
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1079
eventsPending:anEventMask for:aWindowId
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1080
    "return true, if any of the masked events is pending"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1081
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1082
    ^ self subclassResponsibility
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1083
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1084
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1085
eventPending:anEventSymbol for:aWindowId
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1086
    "return true, if a specific event is pending"
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1087
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1088
    ^ self subclassResponsibility
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1089
! !
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1090
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1091
!DeviceWorkstation methodsFor:'bitmap/window creation'!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1092
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1093
createFaxImageFromArray:data width:w height:h type:type k:k msbFirst:msbFirst
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1094
    "create a new faxImage in the workstation
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1095
     type: 0 -> uncompressed
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1096
           1 -> group3 1D (k is void)
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1097
           2 -> group3 2D
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1098
           3 -> group4 2D (k is void)"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1099
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1100
    ^ nil
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1101
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1102
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1103
createBitmapWidth:w height:h
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1104
    "allocate a bitmap on the Xserver, the contents is undefined
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1105
     (i.e. random). Return a bitmap id or nil"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1106
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1107
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1108
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1109
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1110
createPixmapWidth:w height:h depth:d
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1111
    "allocate a pixmap on the Xserver, the contents is undefined
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1112
     (i.e. random). Return a bitmap id or nil"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1113
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1114
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1115
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1116
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1117
createBitmapFromFile:aString for:aForm
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1118
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1119
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1120
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1121
createBitmapFromArray:anArray width:w height:h
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1122
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1123
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1124
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1125
destroyPixmap:aDrawableId
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1126
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1127
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1128
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1129
destroyFaxImage:aFaxImageId
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1130
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1131
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1132
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1133
rootWindowFor:aView
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1134
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1135
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1136
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1137
createWindowFor:aView left:xpos top:ypos width:wwidth height:wheight
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1138
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1139
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1140
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1141
destroyView:aView withId:aWindowId
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1142
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1143
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1144
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1145
destroyGC:aGCId
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1146
    "destroy a GC"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1147
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1148
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1149
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1150
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1151
gcFor:aDrawableId
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1152
    "create a GC for drawing into aDrawable"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1153
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1154
    ^ self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1155
! !
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1156
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1157
!DeviceWorkstation methodsFor:'font stuff'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1158
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1159
listOfAvailableFonts
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1160
    "return a list containing all fonts on this display.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1161
     The returned list is an array of 4-element arrays, each
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1162
     containing family, face, style, size and encoding."
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1163
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1164
    self subclassResponsibility
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1165
!
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1166
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1167
fontFamilies
48194c26a46c Initial revision
claus
parents:
diff changeset
  1168
    "return a set of all available font families on this display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1169
48194c26a46c Initial revision
claus
parents:
diff changeset
  1170
    |allFonts families family|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1171
48194c26a46c Initial revision
claus
parents:
diff changeset
  1172
    allFonts := self listOfAvailableFonts.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1173
    allFonts isNil ifTrue:[^ nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1174
    families := Set new.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1175
    allFonts do:[:arr |
48194c26a46c Initial revision
claus
parents:
diff changeset
  1176
        family := arr at:1.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1177
        family notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1178
            families add:family
48194c26a46c Initial revision
claus
parents:
diff changeset
  1179
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1180
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1181
    ^ families
48194c26a46c Initial revision
claus
parents:
diff changeset
  1182
48194c26a46c Initial revision
claus
parents:
diff changeset
  1183
    "Display fontFamilies"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1184
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1185
48194c26a46c Initial revision
claus
parents:
diff changeset
  1186
facesInFamily:aFamilyName
48194c26a46c Initial revision
claus
parents:
diff changeset
  1187
    "return a set of all available font faces in aFamily on this display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1188
48194c26a46c Initial revision
claus
parents:
diff changeset
  1189
    |allFonts faces family face|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1190
48194c26a46c Initial revision
claus
parents:
diff changeset
  1191
    allFonts := self listOfAvailableFonts.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1192
    allFonts isNil ifTrue:[^ nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1193
    faces := Set new.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1194
    allFonts do:[:arr |
48194c26a46c Initial revision
claus
parents:
diff changeset
  1195
        family := arr at:1.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1196
        (family = aFamilyName) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1197
            face := arr at:2.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1198
            faces add:face
48194c26a46c Initial revision
claus
parents:
diff changeset
  1199
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1200
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1201
    ^ faces
48194c26a46c Initial revision
claus
parents:
diff changeset
  1202
48194c26a46c Initial revision
claus
parents:
diff changeset
  1203
    "Display facesInFamily:'times'"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1204
    "Display facesInFamily:'fixed'"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1205
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1206
48194c26a46c Initial revision
claus
parents:
diff changeset
  1207
stylesInFamily:aFamilyName face:aFaceName
48194c26a46c Initial revision
claus
parents:
diff changeset
  1208
    "return a set of all available font styles in aFamily/aFace on this display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1209
48194c26a46c Initial revision
claus
parents:
diff changeset
  1210
    |allFonts styles family face style|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1211
48194c26a46c Initial revision
claus
parents:
diff changeset
  1212
    allFonts := self listOfAvailableFonts.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1213
    allFonts isNil ifTrue:[^ nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1214
    styles := Set new.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1215
    allFonts do:[:arr |
48194c26a46c Initial revision
claus
parents:
diff changeset
  1216
        family := arr at:1.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1217
        (family = aFamilyName) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1218
            face := arr at:2.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1219
            (face = aFaceName) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1220
                style := arr at:3.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1221
                styles add:style
48194c26a46c Initial revision
claus
parents:
diff changeset
  1222
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1223
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1224
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1225
    ^ styles
48194c26a46c Initial revision
claus
parents:
diff changeset
  1226
48194c26a46c Initial revision
claus
parents:
diff changeset
  1227
    "Display stylesInFamily:'times' face:'medium'"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1228
    "Display stylesInFamily:'times' face:'bold'"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1229
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1230
48194c26a46c Initial revision
claus
parents:
diff changeset
  1231
sizesInFamily:aFamilyName face:aFaceName style:aStyleName
48194c26a46c Initial revision
claus
parents:
diff changeset
  1232
    "return a set of all available font sizes in aFamily/aFace/aStyle
48194c26a46c Initial revision
claus
parents:
diff changeset
  1233
     on this display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1234
48194c26a46c Initial revision
claus
parents:
diff changeset
  1235
    |allFonts sizes family face style size|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1236
48194c26a46c Initial revision
claus
parents:
diff changeset
  1237
    allFonts := self listOfAvailableFonts.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1238
    allFonts isNil ifTrue:[^ nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1239
    sizes := Set new.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1240
    allFonts do:[:arr |
48194c26a46c Initial revision
claus
parents:
diff changeset
  1241
        family := arr at:1.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1242
        (family = aFamilyName) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1243
            face := arr at:2.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1244
            (face = aFaceName) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1245
                style := arr at:3.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1246
                (style = aStyleName) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1247
                    size := arr at:4.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1248
                    sizes add:size
48194c26a46c Initial revision
claus
parents:
diff changeset
  1249
                ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1250
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1251
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1252
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1253
    ^ sizes
48194c26a46c Initial revision
claus
parents:
diff changeset
  1254
48194c26a46c Initial revision
claus
parents:
diff changeset
  1255
    "Display sizesInFamily:'times' face:'medium' style:'italic'"
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  1256
!
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  1257
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1258
getFontWithFamily:familyString
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1259
             face:faceString
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1260
            style:styleString
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1261
             size:sizeArg
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1262
         encoding:encodingSym
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1263
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1264
    "try to get the specified font, return id.
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1265
     If not available, try next smaller font. 
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1266
     If no font fits, return nil"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1267
48194c26a46c Initial revision
claus
parents:
diff changeset
  1268
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1269
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1270
48194c26a46c Initial revision
claus
parents:
diff changeset
  1271
getDefaultFont
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1272
    "return a default font id 
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1273
     - used when class Font cannot find anything usable"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1274
48194c26a46c Initial revision
claus
parents:
diff changeset
  1275
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1276
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1277
48194c26a46c Initial revision
claus
parents:
diff changeset
  1278
releaseFont:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1279
    "free a font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1280
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1281
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1282
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1283
48194c26a46c Initial revision
claus
parents:
diff changeset
  1284
ascentOf:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1285
    "return the number of pixels above the base line of a font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1286
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1287
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1288
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1289
48194c26a46c Initial revision
claus
parents:
diff changeset
  1290
descentOf:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1291
    "return the number of pixels below the base line of a font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1292
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1293
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1294
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1295
48194c26a46c Initial revision
claus
parents:
diff changeset
  1296
minWidthOfFont:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1297
    "return the width in pixels of the smallest character a specific font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1298
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1299
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1300
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1301
48194c26a46c Initial revision
claus
parents:
diff changeset
  1302
maxWidthOfFont:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1303
    "return the width in pixels of the widest character a specific font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1304
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1305
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1306
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1307
48194c26a46c Initial revision
claus
parents:
diff changeset
  1308
widthOf:aString inFont:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1309
    "return the width in pixels of a string in a specific font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1310
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1311
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1312
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1313
48194c26a46c Initial revision
claus
parents:
diff changeset
  1314
widthOf:aString from:index1 to:index2 inFont:aFontId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1315
    "return the width in pixels of a substring in a specific font"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1316
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1317
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1318
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1319
48194c26a46c Initial revision
claus
parents:
diff changeset
  1320
!DeviceWorkstation methodsFor:'cursor stuff'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1321
48194c26a46c Initial revision
claus
parents:
diff changeset
  1322
destroyCursor:aCursorId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1323
    "free a cursor"
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1324
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1325
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1326
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1327
48194c26a46c Initial revision
claus
parents:
diff changeset
  1328
createCursorSourceForm:sourceForm maskForm:maskForm hotX:hx hotY:hy
48194c26a46c Initial revision
claus
parents:
diff changeset
  1329
    "create a cursor given 2 bitmaps (source, mask) and a hotspot"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1330
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1331
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1332
48194c26a46c Initial revision
claus
parents:
diff changeset
  1333
createCursorShape:aShape
48194c26a46c Initial revision
claus
parents:
diff changeset
  1334
    "create a cursor given a shape-symbol"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1335
48194c26a46c Initial revision
claus
parents:
diff changeset
  1336
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1337
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1338
48194c26a46c Initial revision
claus
parents:
diff changeset
  1339
colorCursor:aCursorId foreground:fgColor background:bgColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  1340
    "change a cursors colors"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1341
48194c26a46c Initial revision
claus
parents:
diff changeset
  1342
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1343
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1344
48194c26a46c Initial revision
claus
parents:
diff changeset
  1345
grabKeyboardIn:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1346
    "grab the keyboard - all keyboard input will be sent to aWindow"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1347
48194c26a46c Initial revision
claus
parents:
diff changeset
  1348
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1349
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1350
48194c26a46c Initial revision
claus
parents:
diff changeset
  1351
ungrabKeyboard
48194c26a46c Initial revision
claus
parents:
diff changeset
  1352
    "release the keyboard"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1353
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1354
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1355
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1356
48194c26a46c Initial revision
claus
parents:
diff changeset
  1357
grabPointerIn:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1358
    "grap the pointer"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1359
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1360
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1361
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1362
48194c26a46c Initial revision
claus
parents:
diff changeset
  1363
ungrabPointer
48194c26a46c Initial revision
claus
parents:
diff changeset
  1364
    "release the pointer"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1365
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1366
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1367
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1368
48194c26a46c Initial revision
claus
parents:
diff changeset
  1369
!DeviceWorkstation methodsFor:'color stuff'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1370
48194c26a46c Initial revision
claus
parents:
diff changeset
  1371
listOfAvailableColors
48194c26a46c Initial revision
claus
parents:
diff changeset
  1372
    "return a list of all available colornames;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1373
     This method should not be used, since colornames are
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1374
     very X specific. However, the names defined here are pretty common"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1375
48194c26a46c Initial revision
claus
parents:
diff changeset
  1376
    ^ #('red' 'green' 'blue' 'yellow' 'magenta' 'cyan' 'white' 'black')
48194c26a46c Initial revision
claus
parents:
diff changeset
  1377
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1378
48194c26a46c Initial revision
claus
parents:
diff changeset
  1379
freeColor:colorIndex
48194c26a46c Initial revision
claus
parents:
diff changeset
  1380
    "free a color on the display, when its no longer needed"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1381
48194c26a46c Initial revision
claus
parents:
diff changeset
  1382
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1383
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1384
48194c26a46c Initial revision
claus
parents:
diff changeset
  1385
colorRed:redVal green:greenVal blue:blueVal
48194c26a46c Initial revision
claus
parents:
diff changeset
  1386
    "allocate a color with rgb values (0..100) - return index"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1387
48194c26a46c Initial revision
claus
parents:
diff changeset
  1388
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1389
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1390
48194c26a46c Initial revision
claus
parents:
diff changeset
  1391
colorNamed:aString
48194c26a46c Initial revision
claus
parents:
diff changeset
  1392
    "allocate a color with color name - return index.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1393
     Colors should not be allocated by name, since most colors
48194c26a46c Initial revision
claus
parents:
diff changeset
  1394
     are X specific - get colors by rgb instead."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1395
48194c26a46c Initial revision
claus
parents:
diff changeset
  1396
    "support some of them ..."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1397
48194c26a46c Initial revision
claus
parents:
diff changeset
  1398
    self getRGBFromName:aString into:[:r :g :b |
48194c26a46c Initial revision
claus
parents:
diff changeset
  1399
        ^ self colorRed:r green:g blue:b
48194c26a46c Initial revision
claus
parents:
diff changeset
  1400
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1401
    ^ nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  1402
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1403
48194c26a46c Initial revision
claus
parents:
diff changeset
  1404
colorCell
48194c26a46c Initial revision
claus
parents:
diff changeset
  1405
    "allocate a color - return index"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1406
48194c26a46c Initial revision
claus
parents:
diff changeset
  1407
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1408
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1409
48194c26a46c Initial revision
claus
parents:
diff changeset
  1410
setColor:index red:redVal green:greenVal blue:blueVal
48194c26a46c Initial revision
claus
parents:
diff changeset
  1411
    "change color in map at:index to rgb (0..100)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1412
48194c26a46c Initial revision
claus
parents:
diff changeset
  1413
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1414
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1415
48194c26a46c Initial revision
claus
parents:
diff changeset
  1416
getRGBFromName:colorName into:aBlock
48194c26a46c Initial revision
claus
parents:
diff changeset
  1417
    "get rgb components (0..100) of color named colorName,
48194c26a46c Initial revision
claus
parents:
diff changeset
  1418
     and evaluate the 3-arg block, aBlock with them.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1419
     The method here only handles some often used colors;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1420
     getRGBFromName should not be used, since colorNames other
48194c26a46c Initial revision
claus
parents:
diff changeset
  1421
     than those below are X specific."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1422
48194c26a46c Initial revision
claus
parents:
diff changeset
  1423
    |idx names triple|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1424
48194c26a46c Initial revision
claus
parents:
diff changeset
  1425
    names := #('red' 'green' 'blue' 'yellow' 'magenta' 'cyan' 'white' 'black').
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  1426
    idx := names indexOf:colorName.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1427
    idx == 0 ifTrue:[
8
640de5f72f88 last version before change of dispatch
claus
parents: 5
diff changeset
  1428
        idx := (names asLowercase) indexOf:colorName.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1429
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1430
    idx == 0 ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1431
        triple := #(
48194c26a46c Initial revision
claus
parents:
diff changeset
  1432
                        (100   0   0)  "red"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1433
                        (  0 100   0)  "green"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1434
                        (  0   0 100)  "blue"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1435
                        (100 100   0)  "yellow"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1436
                        (100   0 100)  "magenta"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1437
                        (  0 100 100)  "cyan"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1438
                        (100 100 100)  "white"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1439
                        (  0   0   0)  "black"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1440
                   ) at:idx.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1441
                        
48194c26a46c Initial revision
claus
parents:
diff changeset
  1442
        ^ aBlock value:(triple at:1)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1443
                 value:(triple at:2)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1444
                 value:(triple at:3)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1445
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1446
    ^ nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  1447
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1448
48194c26a46c Initial revision
claus
parents:
diff changeset
  1449
getRGBFrom:index into:aBlock
48194c26a46c Initial revision
claus
parents:
diff changeset
  1450
    "get rgb components (0..100) of color in map at:index,
48194c26a46c Initial revision
claus
parents:
diff changeset
  1451
     and evaluate the 3-arg block, aBlock with them"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1452
48194c26a46c Initial revision
claus
parents:
diff changeset
  1453
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1454
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1455
48194c26a46c Initial revision
claus
parents:
diff changeset
  1456
!DeviceWorkstation methodsFor:'window stuff'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1457
48194c26a46c Initial revision
claus
parents:
diff changeset
  1458
setBackingStore:how in:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1459
    "turn on/off backing-store for a window"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1460
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1461
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1462
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1463
48194c26a46c Initial revision
claus
parents:
diff changeset
  1464
setSaveUnder:yesOrNo in:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1465
    "turn on/off save-under for a window"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1466
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1467
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1468
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1469
48194c26a46c Initial revision
claus
parents:
diff changeset
  1470
setWindowBackground:aColorIndex in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1471
    "set a windows background color"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1472
48194c26a46c Initial revision
claus
parents:
diff changeset
  1473
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1474
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1475
48194c26a46c Initial revision
claus
parents:
diff changeset
  1476
setWindowBackgroundPixmap:aPixmapId in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1477
    "set a windows background pattern to be a form"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1478
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1479
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1480
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1481
48194c26a46c Initial revision
claus
parents:
diff changeset
  1482
setWindowBorderColor:aColorIndex in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1483
    "set a windows border color"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1484
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1485
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1486
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1487
48194c26a46c Initial revision
claus
parents:
diff changeset
  1488
setWindowBorderPixmap:aPixmapId in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1489
    "set a windows border pattern"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1490
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1491
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1492
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1493
48194c26a46c Initial revision
claus
parents:
diff changeset
  1494
setWindowBorderWidth:aNumber in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1495
    "set a windows border width"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1496
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1497
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1498
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1499
48194c26a46c Initial revision
claus
parents:
diff changeset
  1500
setWindowBorderShape:aPixmapId in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1501
    "set a windows border shape"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1502
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1503
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1504
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1505
48194c26a46c Initial revision
claus
parents:
diff changeset
  1506
setWindowShape:aPixmapId in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1507
    "set a windows visible shape"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1508
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1509
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1510
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1511
48194c26a46c Initial revision
claus
parents:
diff changeset
  1512
setCursor:aCursorId in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1513
    "set a windows visible shape"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1514
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1515
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1516
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1517
48194c26a46c Initial revision
claus
parents:
diff changeset
  1518
setWindowName:aString in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1519
    "set a windows name"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1520
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1521
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1522
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1523
48194c26a46c Initial revision
claus
parents:
diff changeset
  1524
setIconName:aString in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1525
    "set a windows icon name"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1526
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1527
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1528
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1529
48194c26a46c Initial revision
claus
parents:
diff changeset
  1530
setWindowIcon:aForm in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1531
    "set a windows icon"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1532
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1533
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1534
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1535
48194c26a46c Initial revision
claus
parents:
diff changeset
  1536
setWindowIconWindow:aView in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1537
    "set a windows icon window"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1538
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1539
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1540
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1541
48194c26a46c Initial revision
claus
parents:
diff changeset
  1542
clearWindow:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1543
    "clear a windows to its view background"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1544
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1545
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1546
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1547
48194c26a46c Initial revision
claus
parents:
diff changeset
  1548
clearRectangleX:x y:y width:width height:height in:aWindowId
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1549
    "clear a rectangular area of a window to its view background"
470d292c3218 before big change
claus
parents: 8
diff changeset
  1550
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1551
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1552
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1553
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1554
mapView:aView id:aWindowId iconified:aBoolean atX:xPos y:yPos width:w height:h
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1555
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1556
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1557
48194c26a46c Initial revision
claus
parents:
diff changeset
  1558
mapWindow:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1559
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1560
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1561
48194c26a46c Initial revision
claus
parents:
diff changeset
  1562
unmapWindow:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1563
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1564
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1565
48194c26a46c Initial revision
claus
parents:
diff changeset
  1566
raiseWindow:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1567
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1568
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1569
48194c26a46c Initial revision
claus
parents:
diff changeset
  1570
lowerWindow:aWindowId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1571
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1572
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1573
48194c26a46c Initial revision
claus
parents:
diff changeset
  1574
moveWindow:aWindowId x:x y:y
48194c26a46c Initial revision
claus
parents:
diff changeset
  1575
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1576
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1577
48194c26a46c Initial revision
claus
parents:
diff changeset
  1578
resizeWindow:aWindowId width:w height:h
48194c26a46c Initial revision
claus
parents:
diff changeset
  1579
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1580
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1581
48194c26a46c Initial revision
claus
parents:
diff changeset
  1582
moveResizeWindow:aWindowId x:x y:y width:w height:h
48194c26a46c Initial revision
claus
parents:
diff changeset
  1583
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1584
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1585
48194c26a46c Initial revision
claus
parents:
diff changeset
  1586
!DeviceWorkstation methodsFor:'graphic context stuff'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1587
48194c26a46c Initial revision
claus
parents:
diff changeset
  1588
setForeground:fgColorIndex in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1589
    "set foreground color to be drawn with"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1590
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1591
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1592
48194c26a46c Initial revision
claus
parents:
diff changeset
  1593
setBackground:bgColorIndex in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1594
    "set background color to be drawn with"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1595
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1596
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1597
48194c26a46c Initial revision
claus
parents:
diff changeset
  1598
setForeground:fgColorIndex background:bgColorIndex in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1599
    "set foreground and background colors to be drawn with"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1600
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1601
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1602
48194c26a46c Initial revision
claus
parents:
diff changeset
  1603
setForeground:fgColor background:bgColor mask:aBitmapId in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1604
    "set foreground and background colors to be drawn with using mask or
48194c26a46c Initial revision
claus
parents:
diff changeset
  1605
     solid (if aBitmapId is nil)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1606
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1607
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1608
48194c26a46c Initial revision
claus
parents:
diff changeset
  1609
setLineWidth:aNumber style:lineStyle cap:capStyle join:joinStyle in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1610
    "set line attributes"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1611
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1612
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1613
48194c26a46c Initial revision
claus
parents:
diff changeset
  1614
setForeground:fgColor background:bgColor mask:aBitmapId lineWidth:lw in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1615
    "set foreground and background colors to be drawn with using mask or
48194c26a46c Initial revision
claus
parents:
diff changeset
  1616
     solid (if aBitmapId is nil); also set lineWidth"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1617
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1618
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1619
48194c26a46c Initial revision
claus
parents:
diff changeset
  1620
setFunction:aFunctionSymbol in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1621
    "set alu function to be drawn with"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1622
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1623
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1624
48194c26a46c Initial revision
claus
parents:
diff changeset
  1625
setFont:aFontId in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1626
    "set font to be drawn in"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1627
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1628
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1629
48194c26a46c Initial revision
claus
parents:
diff changeset
  1630
setPixmapMask:aPixmapId in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1631
    "set or clear the drawing mask - a pixmap mask providing full color"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1632
48194c26a46c Initial revision
claus
parents:
diff changeset
  1633
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1634
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1635
48194c26a46c Initial revision
claus
parents:
diff changeset
  1636
setBitmapMask:aBitmapId in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1637
    "set or clear the drawing mask - a bitmap mask using current fg/bg"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1638
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1639
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1640
48194c26a46c Initial revision
claus
parents:
diff changeset
  1641
setMaskOriginX:orgX y:orgY in:aGCid
48194c26a46c Initial revision
claus
parents:
diff changeset
  1642
    "set the mask origin"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1643
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1644
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1645
48194c26a46c Initial revision
claus
parents:
diff changeset
  1646
setClipByChildren:aBool in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1647
    "enable/disable drawing into child views"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1648
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1649
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1650
48194c26a46c Initial revision
claus
parents:
diff changeset
  1651
noClipIn:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1652
    "disable clipping rectangle"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1653
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1654
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1655
48194c26a46c Initial revision
claus
parents:
diff changeset
  1656
setClipX:clipX y:clipY width:clipWidth height:clipHeight in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1657
    "clip to a rectangle"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1658
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1659
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1660
48194c26a46c Initial revision
claus
parents:
diff changeset
  1661
setGraphicsExposures:aBoolean in:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1662
    "set or clear the graphics exposures flag"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1663
48194c26a46c Initial revision
claus
parents:
diff changeset
  1664
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1665
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1666
48194c26a46c Initial revision
claus
parents:
diff changeset
  1667
!DeviceWorkstation methodsFor:'retrieving pixels'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1668
48194c26a46c Initial revision
claus
parents:
diff changeset
  1669
getPixelX:x y:y from:aDrawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1670
    "return the pixel value at x/y"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1671
48194c26a46c Initial revision
claus
parents:
diff changeset
  1672
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1673
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1674
48194c26a46c Initial revision
claus
parents:
diff changeset
  1675
!DeviceWorkstation methodsFor:'drawing'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1676
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1677
displayString:aString x:x y:y in:aDrawableId with:aGCId round:round opaque:opaque
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1678
    "draw a string"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1679
48194c26a46c Initial revision
claus
parents:
diff changeset
  1680
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1681
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1682
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1683
displayString:aString from:i1 to:i2 x:x y:y in:aDrawableId with:aGCId round:round opaque:opaque
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1684
    "draw part of a string"
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1685
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1686
    "should be redefined to avoid creation of throw-away string" 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1687
    self displayString:(aString copyFrom:i1 to:i2)
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1688
                     x:x 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1689
                     y:y 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1690
                     in:aDrawableId 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1691
                     with:aGCId
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1692
                     round:round
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1693
                     opaque:opaque
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1694
!
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1695
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1696
displayString:aString x:x y:y in:aDrawableId with:aGCId
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1697
    "draw a string - draw foreground only.
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1698
     If the coordinates are not integers, retry with rounded." 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1699
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1700
    self displayString:aString 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1701
         x:x 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1702
         y:y 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1703
         in:aDrawableId 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1704
         with:aGCId 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1705
         round:true
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1706
         opaque:false
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1707
!
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1708
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1709
displayString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1710
    "draw a sub-string - draw foreground only.
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1711
     If the coordinates are not integers, retry with rounded." 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1712
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1713
    self displayString:aString 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1714
         from:index1
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1715
         to:index2
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1716
         x:x 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1717
         y:y 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1718
         in:aDrawableId 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1719
         with:aGCId 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1720
         round:true
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1721
         opaque:false
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1722
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1723
48194c26a46c Initial revision
claus
parents:
diff changeset
  1724
displayOpaqueString:aString x:x y:y in:aDrawableId with:aGCId
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1725
    "draw a string - draw foreground on background.
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1726
     If the coordinates are not integers, retry with rounded." 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1727
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1728
    self displayString:aString 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1729
         x:x 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1730
         y:y 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1731
         in:aDrawableId 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1732
         with:aGCId 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1733
         round:true
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1734
         opaque:true
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1735
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1736
48194c26a46c Initial revision
claus
parents:
diff changeset
  1737
displayOpaqueString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1738
    "draw a sub-string - draw foreground on background.
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1739
     If the coordinates are not integers, retry with rounded." 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1740
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1741
    self displayString:aString 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1742
         from:index1
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1743
         to:index2
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1744
         x:x 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1745
         y:y 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1746
         in:aDrawableId 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1747
         with:aGCId 
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1748
         round:true
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1749
         opaque:true
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1750
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1751
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1752
displayPointX:x y:y in:aDrawableId with:aGCId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1753
    "draw a point"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1754
48194c26a46c Initial revision
claus
parents:
diff changeset
  1755
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1756
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1757
48194c26a46c Initial revision
claus
parents:
diff changeset
  1758
displayLineFromX:x0 y:y0 toX:x1 y:y1 in:aDrawableId with:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1759
    "draw a line"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1760
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1761
    "could add a bresenham line drawer here ..."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1762
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1763
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1764
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 23
diff changeset
  1765
displayRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1766
    "draw a rectangle"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1767
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1768
    "should draw four lines here"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1769
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1770
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1771
26
ac9f66dc8f53 *** empty log message ***
claus
parents: 23
diff changeset
  1772
displayPolygon:aPolygon in:aDrawableId with:aGCId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1773
    "draw a polygon"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1774
38
2652fc96e660 *** empty log message ***
claus
parents: 26
diff changeset
  1775
    "should draw the lines here"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1776
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1777
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1778
48194c26a46c Initial revision
claus
parents:
diff changeset
  1779
copyFromFaxImage:sourceId x:srcX y:srcY to:destId x:dstX y:dstY
48194c26a46c Initial revision
claus
parents:
diff changeset
  1780
                      width:w height:h with:aGCId scaleX:scaleX scaleY:scaleY
48194c26a46c Initial revision
claus
parents:
diff changeset
  1781
    "do a bit-blt"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1782
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1783
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1784
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1785
48194c26a46c Initial revision
claus
parents:
diff changeset
  1786
copyFromId:sourceId x:srcX y:srcY to:destId x:dstX y:dstY
48194c26a46c Initial revision
claus
parents:
diff changeset
  1787
                width:w height:h with:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1788
    "do a bit-blt"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1789
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1790
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1791
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1792
48194c26a46c Initial revision
claus
parents:
diff changeset
  1793
copyPlaneFromId:sourceId x:srcX y:srcY to:destId x:dstX y:dstY
48194c26a46c Initial revision
claus
parents:
diff changeset
  1794
                width:w height:h with:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1795
    "do a bit-blt"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1796
48194c26a46c Initial revision
claus
parents:
diff changeset
  1797
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1798
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1799
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1800
displayArcX:x y:y w:width h:height from:startAngle angle:angle
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1801
             in:aDrawableId with:aGCId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1802
    "draw an arc"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1803
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1804
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1805
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1806
48194c26a46c Initial revision
claus
parents:
diff changeset
  1807
fillArcX:x y:y w:width h:height from:startAngle angle:angle
48194c26a46c Initial revision
claus
parents:
diff changeset
  1808
               in:aDrawableId with:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1809
    "fill an arc"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1810
48194c26a46c Initial revision
claus
parents:
diff changeset
  1811
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1812
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1813
48194c26a46c Initial revision
claus
parents:
diff changeset
  1814
fillRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1815
    "fill a rectangle"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1816
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1817
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1818
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1819
48194c26a46c Initial revision
claus
parents:
diff changeset
  1820
fillPolygon:aPolygon in:aDrawableId with:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1821
    "fill a polygon"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1822
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1823
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1824
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1825
48194c26a46c Initial revision
claus
parents:
diff changeset
  1826
drawBits:imageBits depth:imageDepth width:imageWidth height:imageHeight
48194c26a46c Initial revision
claus
parents:
diff changeset
  1827
                       x:srcx y:srcy
48194c26a46c Initial revision
claus
parents:
diff changeset
  1828
                    into:aDrawableId x:dstx y:dsty width:w height:h with:aGCId
12
9f0995fac1fa *** empty log message ***
claus
parents: 10
diff changeset
  1829
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1830
    "draw a bitimage which has depth id, width iw and height ih into
48194c26a46c Initial revision
claus
parents:
diff changeset
  1831
     the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1832
     It has to be checked elsewhere, that server can do it with the given
48194c26a46c Initial revision
claus
parents:
diff changeset
  1833
     depth; also it is assumed, that the colormap is setup correctly"
10
470d292c3218 before big change
claus
parents: 8
diff changeset
  1834
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1835
    ^ self subclassResponsibility
48194c26a46c Initial revision
claus
parents:
diff changeset
  1836
! !