"

COPYRIGHT (c) 1993 by Claus Gittinger

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

Object subclass:#DeviceWorkstation

       instanceVariableNames:'displayId

                              visualType monitorType

                              depth ncells bitsPerRGB

                              hasColors hasGreyscales 

                              width height widthMM heightMM resolutionHor resolutionVer

                              knownViews knownIds knownBitmaps knownBitmapIds

                              dispatching dispatchExpose

                              controlDown shiftDown metaDown altDown

                              ignoreBackingStore motionEventCompression

                              lastId lastView

                              keyboardMap'

       classVariableNames:   'ButtonTranslation MultiClickTimeDelta

                              DeviceErrorSignal'

       poolDictionaries:''

       category:'Interface-Graphics'

!

DeviceWorkstation comment:'

COPYRIGHT (c) 1993 by Claus Gittinger

              All Rights Reserved

written jan 93 by claus

'!

!DeviceWorkstation class methodsFor:'documentation'!

documentation

"

this abstract class defines common protocol to all Display types.

instance variables:

displayId       <Number>        the device id of the display

visualType      <Symbol>        one of #StaticGray, #PseudoColor, ... #TrueColor

monitorType     <Symbol>        one of #monochrome, #color, #unknown

depth           <Integer>       bits per color

ncells          <Integer>       number of colors (i.e. colormap size; not always == 2^depth)

bitsPerRGB      <Integer>       number of valid bits per rgb component

                                (actual number taken in A/D converter; not all devices report the true value)

hasColors       <Boolean>       true, if display supports colors

hasGreyscales   <Boolean>       true, if display supports grey-scales (i.e is not b/w display)

width           <Integer>       number of horizontal pixels

height          <Integer>       number of vertical pixels 

heightMM        <Number>        screen height in millimeter

widthMM         <Number>        screen width in millimeter

resolutionHor   <Number>        pixels per horizontal millimeter

resolutionVer   <Number>        pixels per vertical millimeter

knownViews      <Collection>    all views known

knownIds        <Collection>    corresponding device-view ids

knownBitmaps    <Collection>    all known device bitmaps

knownBitmapIds  <Collection>    corresponding device-bitmap ids

dispatching     <Boolean>       true, if currently in dispatch loop

dispatchExpose  <Boolean>       nil, or the id we wait for exposes only

controlDown     <Boolean>       control key currently pressed

shiftDown       <Boolean>       shift key currently pressed

metaDown        <Boolean>

altDown         <Boolean>

ignoreBackingStore

motionEventCompression

lastId          <Number>

lastView        <View>

keyboardMap     <KeyBdMap>      mapping for keys

"

! !

!DeviceWorkstation class methodsFor:'initialization'!

initialize

    DeviceErrorSignal isNil ifTrue:[

        DeviceErrorSignal := (Signal new) mayProceed:true.

        DeviceErrorSignal notifierString:'device error'.

    ].

!

initializeConstants

    "initialize some (soft) constants"

    MultiClickTimeDelta := 300.

    ButtonTranslation := #(1 2 3)     "identity translation"

! !

!DeviceWorkstation class methodsFor:'signal access'!

deviceErrorSignal

    "return the signal used for device error reporting"

    ^ DeviceErrorSignal

! !

!DeviceWorkstation class methodsFor:'accessing'!

buttonTranslation:anArray

    "set the button translation, #(1 2 3) is no-translation,

     #(3 2 1) is ok for left-handers"

    ButtonTranslation := anArray

! !

!DeviceWorkstation methodsFor:'initialize / release'!

initialize

    "initialize the receiver for a connection to the default display"

    ^ self initializeFor:nil

!

initializeFor:aDisplayOrNilForAny

    "initialize the receiver for a connection to a display. If the

     argument is non-nil, it should specify which workstation should be

     connected to (in a device specific manner). For X displays, this is

     to be the display-string i.e. hostname:displayNr.

     If the argument is nil,  connect to the default display."

    self subclassResponsibility

!

close

    "close down connection to Display - usually never done"

    ^ self subclassResponsibility

!

reinitialize

    "reinit after snapin"

    |prevKnownViews|

    displayId := nil.

    prevKnownViews := knownViews.

    knownViews := nil.

    knownIds := nil.

    self initializeFor:nil.

    "now, all Forms must be recreated"

    Form reinitializeAllOn:self.

    prevKnownViews notNil ifTrue:[

        "

         first round: flush all device specific stuff

        "

        prevKnownViews do:[:aView |

            aView notNil ifTrue:[

                aView prepareForReinit

            ]

        ].

        "

         2nd round: all views should reinstall themself

                    on the new display

        "

        prevKnownViews do:[:aView |

            aView notNil ifTrue:[

                "have to re-create the view"

                aView reinitialize

            ]

        ].

        "

         3rd round: all views get a chance to handle

                    changed environment (colors, font sizes etc)

        "

        prevKnownViews do:[:aView |

            aView notNil ifTrue:[

                aView reAdjustGeometry

            ]

        ]

    ].

    dispatching := false.

    dispatchExpose := nil

!

initializeKeyboardMap

    "keystrokes from the server are translated via the keyboard map.

     Untranslated keystrokes arrive either as characters, or symbols

     (which are the keySyms as symbol). The mapping table which is

     setup here, is used in sendKeyPress:... later.

    "

    keyboardMap := KeyboardMap new.

    "

     no more setup here - moved everything out into 'display.rc' file

    "

! !

!DeviceWorkstation class methodsFor:'error handling'!

resourceIdOfLastError

    "return the resource id responsible for the last error"

    ^ self subclassResponsibility

!

lastError

    "return a string descibing the last error"

    ^ self subclassResponsibility

!

errorInterrupt

    "x-error interrupt"

    |badId badResource|

    badId := self resourceIdOfLastError.

    badId ~~ 0 ifTrue:[

        badResource := self resourceOfId:badId.

    ].

    ^ DeviceErrorSignal

            raiseRequestWith:badResource

            errorString: 'Display error: ' , (self lastError)

!

resourceOfId:id

    "search thru all device stuff for a resource.

     Needed for error handling"

    Form allInstances do:[:f |

        f id == id ifTrue:[^ f]

    ].

    self allInstances do:[:aDisplay |

        |views|

        views := aDisplay knownViews.

        views notNil ifTrue:[

            views do:[:v |

                v id == id ifTrue:[^ v].

                v gcId == id ifTrue:[^ v]

            ].

        ].

    ].

    Color allInstances do:[:c |

        c colorId == id ifTrue:[^ c]

    ].

    Font allInstances do:[:f |

        f fontId == id ifTrue:[^ f]

    ].

    ^ nil

! !

!DeviceWorkstation methodsFor:'misc'!

metaDown

    "return true, if the meta-key (alt-key on systems without meta)

     is currently pressed"

    ^ metaDown

!

altDown

    "return true, if the alt-key is currently pressed"

    ^ altDown

!

controlDown

    "return true, if the control-key is currently pressed"

    ^ controlDown

!

shiftDown

    "return true, if the shift-key is currently pressed"

    ^ shiftDown

!

unBuffered

    "make all drawing be sent immediately to the display"

    ^ self

!

buffered

    "buffer drawing - do not send it immediately to the display"

    ^ self

!

synchronizeOutput

    "send all buffered drawing to the display"

    ^ self

!

compressMotionEvents:aBoolean

    "turn on/off motion event compression 

     - compressions makes always sense except in free-hand drawing of curves"

    motionEventCompression := aBoolean

!

hasColors:aBoolean

    "set the hasColors flag - needed since some servers dont tell the

     truth if a monochrome monitor is connected to a color server"

    hasColors := aBoolean

!

hasGreyscales:aBoolean

    "set the hasGreyscales flag - can be used to simulate b&w behavior"

    hasGreyscales := aBoolean

!

ignoreBackingStore:aBoolean

    "if the argument is true, the views backingStore setting will be ignored, and

     no backing store used - this can be used on servers where backing store is

     very slow (from rc-file)"

    ignoreBackingStore := aBoolean

!

beep

    "output an audible beep or bell"

    Stdout nextPut:(Character bell)

!

setInputFocusTo:aWindowId

    ^ self subclassResponsibility

! !

!DeviceWorkstation methodsFor:'enumeration'!

allViewsDo:aBlock

    "evaluate the argument, aBlock for all known views"

    knownViews notNil ifTrue:[

        knownViews do:[:aView |

            aView notNil ifTrue:[

                aBlock value:aView

            ]

        ]

    ]

    "

     View defaultStyle:#iris.

     Display allViewsDo:[:v | v initStyle. v redraw]

    "

    "

     View defaultStyle:#next.

     Display allViewsDo:[:v | v initStyle. v redraw]

    "

    "

     View defaultStyle:#normal.

     Display allViewsDo:[:v | v initStyle. v redraw]

    "

! !

!DeviceWorkstation methodsFor:'accessing & queries'!

displayFileDescriptor

    ^ self subclassResponsibility

!

serverVendor

    ^ self subclassResponsibility

!

vendorRelease

    ^ self subclassResponsibility

!

protocolVersion

    ^ self subclassResponsibility

!

blackpixel

    "return the colorId of black"

    ^ self subclassResponsibility

!

whitepixel

    "return the colorId of white"

    ^ self subclassResponsibility

!

viewIdFromPoint:aPoint in:windowId

    "given a point in rootWindow, return the viewId of the subview of windowId

     hit by this coordinate.

     return nil if no view was hit.

     - use to find window to drop objects after a cross-view drag"

    ^ self subclassResponsibility

!

translatePoint:aPoint from:windowId1 to:windowId2

    "given a point in window1, return the coordinate in window2

     - use to xlate points from a window to rootwindow"

    ^ self subclassResponsibility

!

id

    "return the displayId"

    ^ displayId

!

ncells

    "return the number of color cells, the display has"

    ^ ncells

!

depth

    "return the depth in pixels of the display"

    ^ depth

!

bitsPerRGB

    "return the number of valid bits per rgb component"

    ^ bitsPerRGB

!

visualType:aSymbol

    "set the visual type. The only situation, where this makes sense,

     is with my plasma-display, which ignores the palette and spits out

     grey scales independent of LUT definitions. (of which the server

     knows nothing)"

    visualType := aSymbol.

    (visualType == #StaticGray or:[visualType == #GrayScale]) ifTrue:[

        hasColors := false

    ] ifFalse:[

        hasColors := true

    ]

!

visualType

    "return a symbol representing the visual type of the display"

    ^ visualType

!

monitorType

    "return a symbol representing the monitor type of the display.

     It is usually set to #unknown, #color or #monochrome.

     But it can be set to any value from the startup file, for later

     testing from anywhere. For example the startup for plasma-displays 

     can set it to #plasma to later influence the colors used in widgets

     (indirectly through the resource file)."

    ^ monitorType

!

monitorType:aSymbol

    "set the monitorType - see comment in DeviceWorkstation>>montorType"

    monitorType := aSymbol

!

hasColors

    "return true, if its a color display"

    ^ hasColors

!

hasGreyscales

    "return true, if this workstation supports greyscales

     (also true for color displays)"

    ^ hasGreyscales

!

hasShape

    "return true, if this workstation supports non-rectangular windows"

    ^ false

!

hasShm

    "return true, if this workstation supports shared pixmaps"

    ^ false

!

hasFax

    "return true, if this workstation supports decompression of fax images"

    ^ false