"

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

			      bitsRed bitsGreen bitsBlue

			      redMask greenMask blueMask

			      redShift greenShift blueShift

			      hasColors hasGreyscales 

			      width height widthMM heightMM resolutionHor resolutionVer

			      idToViewMapping knownViews knownIds knownBitmaps knownBitmapIds

			      dispatching dispatchProcess

			      ctrlDown shiftDown metaDown altDown

			      motionEventCompression

			      lastId lastView

			      keyboardMap rootView

			      isSlow 

			      activeKeyboardGrab activePointerGrab

			      buttonTranslation multiClickTimeDelta

			      altModifiers metaModifiers ctrlModifiers shiftModifiers'

       classVariableNames:   'ButtonTranslation MultiClickTimeDelta

			      DeviceErrorSignal ErrorPrinting

			      DefaultScreen AllScreens'

       poolDictionaries:''

       category:'Interface-Graphics'

!

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

    For compatibility with ST-80, this class (or a subclass) is also

    bound to the global Screen.

    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           <SmallInteger>    bits per color

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

      bitsPerRGB      <SmallInteger>    number of valid bits per rgb component

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

      bitsRed         <SmallInteger>    number of red bits (only valid for TrueColor displays)

      bitsGreen       <SmallInteger>    number of green bits (only valid for TrueColor displays)

      bitsBlue        <SmallInteger>    number of blue bits (only valid for TrueColor displays)

      redMask         <SmallInteger>    shifted red mask (only useful for TrueColor displays)

      greenMask       <SmallInteger>    shifted green mask (only useful for TrueColor displays)

      blueMask        <SmallInteger>    shifted blue mask (only useful for TrueColor displays)

      shiftRed        <SmallInteger>    number of bits to shift red bits (only valid for TrueColor displays)

      shiftGreen      <SmallInteger>    number of bits to shift green bits (only valid for TrueColor displays)

      shiftBlue       <SmallInteger>    number of bits to shift blue bits (only valid for TrueColor displays)

      hasColors       <Boolean>         true, if display supports colors

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

      width           <SmallInteger>    number of horizontal pixels

      height          <SmallInteger>    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

      ctrlDown        <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

		      <Boolean>         if true motion events are compressed

					(obsolete: now done in sensor)

      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

      rootView        <DisplayRootView> this displays root window

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

					things like popup-shadows etc.

"

!

workstationDevices

"

    In ST/X, all interaction with the graphics device is done through

    an instance of (a subclass) of DeviceWorkstation.

    Every view has a reference to the device it has been created on in

    its device instance variable. 

    One particular device instance is bound to the global variable Display:

    this is the default graphics display, on which new views are created

    (however, provisions exist for multi-display operation)

    Currently, there is are only two classes (released to the public):

	XWorkstation    - a plain X window interface

	GLXWorkstation  - an X window interface with a GL (3D graphic library) 

			  extension; either simulated (VGL) or a real GL 

			  (real GL is only available on SGI machines)

    An experimental version for a NeXTStep interface exists, but is currently

    no longer maintained and not released.

    Also, interfaces for other graphic systems (i.e. OS/2 and Windows) are

    planned for and will be available (hopefully) in late 95.

    DeviceWorkstation itself is an abstract class; the methods as defined

    here perform things which are common to all graphic devices or block

    methods and raise a subclassResponsibilty error condition.

    To create a new graphic interface, at least the subclassResponsibilty-methods

    have to be reimplemented in a concrete subclass.

    In theory, ST/X is designed to allow the use of multiple workstation

    devices in parallel; for example, in X, it is possible to create another

    instance of XWorkstation, start a dispatch process for it, and to create and

    open views on this display. However, (currently) some mechanisms are badly

    implemented and therefore, things do not work fully satisfying.

    (for example, popUpMenus are currently opened on the workstation which is

     bound to the global variable 'Display' - independent of the active

     windowgroups display.)

    These bugs will be fixed and fully working multi-display operation can be

    expected for one of the next releases.

    If you want to experiment with multi-display applications,

    you have to:

	- create a new instance of XWorkstation:

	    Smalltalk at:#Display2 put:(XWorkstation new).

	- have it connect to the display (i.e. the xServer):

	  (replace 'porty' below with the name of your display)

	    Display2 := Display2 initializeFor:'porty:0.0'

	  returns nil, if connection is refused 

	  - leaving you with Display2==nil in this case.

	- start an event dispatcher process for it:

	    Display2 startDispatch

	- optionally set its keyboard map

	  (since this is usually done for Display in the startup-file,

	   the new display does not have all your added key bindings)

	    Display2 keyboardMap:(Display keyboardMap)

	- create a view for it:

	    (FileBrowser onDevice:Display2) open

	    (Workspace onDevice:Display2) open

	    (Launcher onDevice:Display2) open

	    NewLauncher openOnDevice:Display2

		--> does not work, since ApplicationModel is not prepared

		    to open views on other devices. (and may never be, since

		    it was written for ST-80 compatibility, which seems not to

		    support this.)

		    To do the above, try:

			Smalltalk at:#OldDisplay put:Display.

			Display := Display2.

			NewLauncher open.

			Display := OldDisplay.

		    Consider this is an ugly kludge ...

    However, as mentioned above, there are a few places, where the default

    display 'Display' is still hard-coded. But, beside from this (little bug ;-),

    remote display operation works pretty well. If you write your application to

    work around those (to-be-fixed) bugs, multi-display applications are

    even possible in the current release. (avoid popUps and use simple buttons

    only).

    Things are being changed to introduce the concept of a 'current' display,

    which is the device on which the current windowGroup has its topView.

    All places in the system whit explicit accesses to Display will be changed

    to use 'Screen current' instead. Especially, this will create popups and

    modalBoxes on the display of the active windowGroup.

    There is no easy solution for things like Notifiers, WarnBoxes or

    Debuggers when opened from some background or non-view process.

    These will come up one the default Display, as returned by 'Screen default'.

    Late note: the above has been mostly fixed, multidisplay applications

    work pretty well. However, there are still some problems to be expected,

    if the screens have different display capabilities (b&w vs. greyscale vs.

    color display). The current styleSheet approach keeps default values

    only once (it should do so per display ...) For now, expect ugly looking

    views in this case - or set your styleSheet for the smallest common 

    capabilities (i.e. for b&w).

"

!

events

"

    All events are processed in a workstations dispatchEvent method.

    There, incoming events are first sent to itself, for a first (view independent)

    preprocessing. For example, the devices state of the shift-, alt-, control and

    meta keys are updated there. After that, the event is forwarded either to

    the views sensor or to the view directly (if it has no sensor).

    (Sensorless views are a leftover from ancient times and will sooner or

     later vanish - simplifying things a bit. Do not depend on views without

     sensors to work correctly in future versions.)

    This event processing is done by the event dispatcher process, which is

    launched in ST/X's startup sequence (see Smalltalk>>start).

    Event processing is done at a high priority, to allow keyboad processing

    and CTRL-C handling to be performed even while other processes are running.

    The code executed by thr event process is found in startDispatch.

    Individual events can be enabled or disabled. The ones that are enabled

    by default are:

	keypress / keyRelease

	buttonPress / buttonRelease / buttonMotion (i.e. motion with button pressed)

	pointerEnter / pointerLeave

    other events have to be enabled by sending a corresponding #enableXXXEvent

    message to the view which shall receive those events.

    For example, pointerMotion events (i.e. motion without button being pressed)

    are enable by: 'aView enableMotionEvent'

    The above is only of interrest, if you write your own widget classes,

    existing widgets set things as required in their #initEvents method.

"

! !

!DeviceWorkstation class methodsFor:'initialization'!

initialize

    DeviceErrorSignal isNil ifTrue:[

	DeviceErrorSignal := (Signal new) mayProceed:true.

	DeviceErrorSignal notifierString:'device error'.

    ].

    ErrorPrinting := true.

    self initializeConstants.

!

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 constants'!

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.

    Display notNil ifTrue:[

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

    displayId := nil.

    dispatching := false.

    dispatchProcess := nil.

"/    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:'queries'!

platformName

    "ST-80 compatibility.

     Return a string describing the display systems platform.

     Returns a dummy here. This must be redefined in concrete

     Workstation classes, to return somthing like 'X', 'MSWindows', 'OS/2' etc."

    ^ 'unknown'

!

default

    "ST-80 compatibility.

     Return the default screen. This is typically the first opened

     Display screen in a session. Use of the global variable Display

     should vanish over time - replace it by Screen default."

    ^ DefaultScreen

    "

     Screen default 

    "

!

default:aDevice

    "Set the default screen. This is sent very early during startup,

     and assigns the first opened screenDevice to both Display and the default

     screen."

    DefaultScreen := aDevice

!

allScreens

    "EXPERIMENTAL: return a collection of active display devices.

     Typically, there is only one, Display or Screen current."

    ^ AllScreens

    "

     Screen allScreens  

    "

    "Modified: 1.9.1995 / 13:38:35 / claus"

!

current

    "EXPERIMENTAL: this should return the currently active screen,

     that is, the device of the currently executing windowGroup.

     It will be used in multi-display operation, to launch views on

     the correct device - even if not specified explicitely.

     This does not yet work fully satisfying ..."

    |wg tops v dev|

    AllScreens size == 1 ifTrue:[

	^ AllScreens anElement

    ].

    "

     mhmh - multiple screens are active.

     be careful, to not run into an error in case

     the current windowGroup got corrupted somehow ...

    "

    (wg := WindowGroup activeGroup) notNil ifTrue:[

	"

	 ok, not a background process or scheduler ...

	"

	(tops := wg topViews) notNil ifTrue:[

	    tops isEmpty ifFalse:[

		(v := tops first) notNil ifTrue:[

		    "

		     ok, it has a view ...

		    "

		    (dev := v device) notNil ifTrue:[

			^ dev

		    ]

		]

	    ]

	]

    ].

    "

     in all other cases, return the default display