"

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

			      idToViewMapping knownViews knownIds knownBitmaps knownBitmapIds

			      dispatching

			      controlDown shiftDown metaDown altDown

			      motionEventCompression

			      lastId lastView

			      keyboardMap

			      isSlow activeGrab 

			      buttonTranslation multiClickTimeDelta'

       classVariableNames:   'ButtonTranslation MultiClickTimeDelta

			      DeviceErrorSignal'

       poolDictionaries:''

       category:'Interface-Graphics'

!

DeviceWorkstation comment:'

COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

'!

!DeviceWorkstation class methodsFor:'documentation'!

copyright

"

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.

"

!

version

"

"

!

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

    idToViewMapping <Dictionary>    maps view-ids to views

    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

    controlDown     <Boolean>       true, if control key currently pressed

    shiftDown       <Boolean>       true, if shift key currently pressed

    metaDown        <Boolean>       true, if meta key (cmd-key) is currently pressed

    altDown         <Boolean>       true, if alt key is currently pressed

    motionEventCompression

    lastId          <Number>        the id of the last events view (internal)

    lastView        <View>          the last events view (internal, for faster id->view mapping)

    keyboardMap     <KeyBdMap>      mapping for keys

    isSlow          <Boolean>       set/cleared from startup - used to turn off

				    things like popup-shadows etc.

"

! !

!DeviceWorkstation class methodsFor:'initialization'!

initialize

    DeviceErrorSignal isNil ifTrue:[

	DeviceErrorSignal := (Signal new) mayProceed:true.

	DeviceErrorSignal notifierString:'device error'.

    ].

!

initializeConstants

    "initialize some (soft) constants"

    MultiClickTimeDelta := 300.       "a click within 300ms is considered a double one"

    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"

! !

!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 prevMapping|

    displayId := nil.

    dispatching := false.

"/    prevMapping := idToViewMapping.

"/    idToViewMapping := nil.

    prevKnownViews := knownViews.

    knownViews := nil.

    knownIds := nil.

    self initializeFor:nil.

    "

     first, all Forms must be recreated

     (since they may be needed for view recreation as

      background or icons)

    "

    Form reinitializeAllOn:self.

"/    prevMapping notNil ifTrue:[

    prevKnownViews notNil ifTrue:[

	"

	 first round: flush all device specific stuff

	"

"/      prevMapping keysAndValuesDo:[:anId :aView |

	prevKnownViews do:[:aView |

	    aView notNil ifTrue:[

		aView prepareForReinit

	    ]

	].

	"

	 2nd round: all views should reinstall themself

		    on the new display

	"

"/      prevMapping keysAndValuesDo:[:anId :aView |

	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)

	"

"/      prevMapping keysAndValuesDo:[:anId :aView |

	prevKnownViews do:[:aView |

	    aView notNil ifTrue:[

		aView reAdjustGeometry

	    ]

	]

    ].

    dispatching := false.

!

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 isNil ifTrue:[

	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 describing the last error"

    ^ self subclassResponsibility

!

errorInterrupt

    "x-error interrupt"

    |badId badResource msg|

    badId := self resourceIdOfLastError.

    badId ~~ 0 ifTrue:[

	badResource := self resourceOfId:badId.

    ].

    msg := 'Display error: ' , (self lastError).

    DeviceErrorSignal isHandled ifFalse:[

	msg printNL

    ] ifTrue:[

	^ DeviceErrorSignal

	       raiseRequestWith:badResource errorString:msg

    ]

!

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 |

	aDisplay allViewsDo:[:aView |

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

	    aView gcId == id ifTrue:[^ aView]

	].

"/        |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.

     WARNING: obsolete, may vanish. Use protocol in WindowSensor."

    ^ metaDown

!

altDown

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

     WARNING: obsolete, may vanish. Use protocol in WindowSensor."

    ^ altDown

!

controlDown

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

     WARNING: obsolete, may vanish. Use protocol in WindowSensor."

    ^ controlDown

!

shiftDown

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

     WARNING: obsolete, may vanish. Use protocol in WindowSensor."

    ^ 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)"

    ^ self

!

isSlow:aBoolean

    "set/clear the slow flag"

    isSlow := 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"

"/    idToViewMapping notNil ifTrue:[

"/        idToViewMapping keysAndValuesDo:[:id :aView |

"/            aView notNil ifTrue:[

"/                aBlock value:aView

"/            ]

"/      ]

    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

    "return the file descriptor associated with the display

     if any. If there is no underlying filedescriptor, return nil.

     (used for event select/polling)"

    ^ nil

!

serverVendor

    "return a string describing the server vendor

     - returns a dummy here"

    ^ 'generic'

!

vendorRelease

    "return a workstation release number

     - returns a dummy here"

    ^ 0

!

protocolVersion

    "return a protocol version number

     - returns a dummy here"

    ^ 0

!

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"

    "returning nil here actually makes drag&drop impossible

     - could also be reimplemented to make a search over all knownViews here.

     This method has to be reimplemented in concrete display classes."

    ^ nil

!

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"

    "This method has to be reimplemented in concrete display classes."

    ^ self subclassResponsibility

!