"{ Encoding: utf8 }"

"

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.

"

"{ Package: 'stx:libview' }"

"{ NameSpace: Smalltalk }"

HostGraphicsDevice subclass:#DeviceWorkstation

	instanceVariableNames:'visualType monitorType depth ncells bitsPerRGB bitsRed bitsGreen

		bitsBlue redMask greenMask blueMask redShift greenShift blueShift

		hasColors hasGreyscales width height widthMM heightMM

		resolutionHor resolutionVer lastId lastView knownViews

		dispatching dispatchProcess exitOnLastClose ctrlDown leftCtrlDown

		rightCtrlDown shiftDown leftShiftDown rightShiftDown metaDown

		buttonLongPressedHandlerProcess buttonPressTimeForMenu

		aboutToOpenModalWindowHooks aboutToOpenNonModalWindowHooks'

	classVariableNames:'AllScreens ButtonTranslation CopyBufferHistory

		CopyBufferHistorySize CurrentScreenQuerySignal

		DefaultButtonPressTimeForMenu DefaultScreen DeviceErrorSignal

		DeviceIOErrorSignal DeviceIOTimeoutErrorSignal

		DeviceOpenErrorSignal DrawingOnClosedDeviceSignal ErrorPrinting

		ExitOnLastClose LastActiveProcess LastActiveScreen

		MultiClickTimeDelta WindowsRightButtonBehavior'

	poolDictionaries:''

	category:'Interface-Graphics'

!

Object subclass:#DeviceFontMetrics

	instanceVariableNames:'encoding ascent descent maxAscent maxDescent minWidth maxWidth

		averageWidth minCode maxCode direction'

	classVariableNames:''

	poolDictionaries:''

	privateIn:DeviceWorkstation

!

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

"

!

documentation

"

    this abstract class defines common protocol to all Display types.

    For compatibility with ST-80, this class (actually a concrete subclass)

    is also bound to the global variable Screen.

    DeviceWorkstation (and its concrete subclasses) are the central classes

    around windowManagement and event processing.

    See the documentation in #events and #workstationDevices for more detailed

    info.

    [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

      knownViews      <WeakValueDictionary>  viewId -> view all of my known views

      dispatching     <Boolean>         true, if currently in dispatch loop

      exitDispatchOnLastWindowClose

		      <Boolean>         if true, dispatch is finished when the last

					window closes (default:true).

      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.

      focusMode       <Symbol>          nil, #pointer or #activeWindow

      activeWindow    <View>            WINDOWS only: the currently active (foreground) view

      clipBoardEncoding

		      <Symbol>          encoding of pasted clipBoard text;

					nil means: iso8859.

					set this to #shiftJis, if pasting

					SJIS text (for example, from Netscape)

					Some systems pass encoding information

					in the clipBoard - there, this is not

					needed.

    [class variables:]

      MultiClickTimeDelta               in ms; controls how long of a delay is

					required between two clicks, to NOT take

					it as a multi-click.

      ErrorPrinting                     controls low-level (X-) error message printing

      AllScreens                        a collection of known screens

    [see also:]

	GraphicsContext DeviceDrawable

	WindowSensor WindowGroup WindowEvent

	ProcessorScheduler

	PSMedium

    [author:]

	Claus Gittinger

"

!

events

"

    All events are processed in a workstation's dispatchEvent method.

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

    preprocessing. For example, the device's state of the shift-, alt-, control and

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

    the view's 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 keyboard processing

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

    The code executed by the 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 enabled by: 'aView enableMotionEvent'

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

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

"

!

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 twoconcrete display classes (released to the public):

	XWorkstation    - a plain X window interface

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

			  extension; either simulated (VGL) or a real GL

			  (real GL is only available on SGI machines)

    the following are coming soon:

	OpenGLWorkstation

			- an X window interface with a openGL(tm) (3D graphic library)

			  extension; either simulated (MESA) or a real openGL

			  (real openGL is only available on SGI/NT machines)

	WinWorkstation  - what will that be ?

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

    no longer maintained and not released.

    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 subclassResponsibility-methods

    have to be reimplemented in a concrete subclass.

    ST/X is designed to allow the use of multiple workstation devices in parallel,

    if the underlying window system supports this.

    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.

    Multiple display operation does not work with other devices (i.e. Windows).

    If you want to experiment with multi-display applications,

    you have to:

    - create a new instance of XWorkstation:

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

      or:

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

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

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

	Display2 := Display2 initializeFor:'localhost:0.0'

      returns nil, if connection is refused

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

    - start an event dispatcher process for it:

      (this is now no longer needed - the first opened view will do it for you)

	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

	    does not work with Launcher, since its an ApplicationModel (not a view)

	    use:

		Launcher openOnDevice:Display2

	    instead.

    For all of the above, there is now a convenient helper method in

    ApplicationModel, which allows to write:

	Application openOnXScreenNamed:'foo:0'

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

    display 'Display' is still hard-coded - especially, in contributed and

    Public domain code, you may find those.

    Beside this (little bug ;-), remote display operation works pretty well.

    If you write your application to work around those, multi-display applications are

    possible in the current release (and actually being used in a concrete application,

    where up to 6 x-terminals are connected to a single linux PC).

    To make your application ready for multi-display operation, replace all

    references to 'Display' by: 'Screen current', which evaluates to the currently

    active display. I.e. each view gets its actual display via this expression.

    Since ST/X views already use this, new views opened by remote views should

    come up on the remote display.

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

    Finally, your application should care for I/O errors (i.e. lost connection when

    a remote display is switched off).

    The framework provides per-display signals, which are raised in the corresponding

    event dispatchers context.

    For a save environment, you should add static exception handler blocks on those

    signals; i.e. the setup for remote displays should look somewhat like:

	|newDpy|

	newDpy := GLXWorkstation new.

	newDpy := newDpy initializeFor:'localhost:0.0'.

	newDpy isNil ifTrue:[

	    self warn:'cannot connect ...'.

	] ifFalse:[

	    newDpy deviceIOErrorSignal handlerBlock:[:ex |

		Transcript beep.

		Transcript showCR:'Display (' , newDpy displayName , '): connection broken.'.

		AbortSignal raise.

	    ].

	    newDpy startDispatch.

	    Launcher openOnDevice:newDpy.

	].

    There may 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).

    This may be fixed in a future version ...

"

! !

!DeviceWorkstation class methodsFor:'initialization'!

initialize

    "create local error signals; enable errorPrinting"

    DeviceErrorSignal isNil ifTrue:[

	DeviceErrorSignal := (Signal new) mayProceed:true.

	DeviceErrorSignal notifierString:'device error'.

	DeviceErrorSignal nameClass:self message:#deviceErrorSignal.

	DeviceOpenErrorSignal := DeviceErrorSignal newSignalMayProceed:true.

	DeviceOpenErrorSignal nameClass:self message:#deviceOpenErrorSignal.

	DeviceOpenErrorSignal notifierString:'cannot open device'.

	DeviceIOErrorSignal := (Signal new) mayProceed:false.

	DeviceIOErrorSignal notifierString:'device IO error'.

	DeviceIOErrorSignal nameClass:self message:#deviceIOErrorSignal.

	DeviceIOTimeoutErrorSignal := DeviceIOErrorSignal newSignalMayProceed:false.

	DeviceIOTimeoutErrorSignal notifierString:'device IO timeout error'.

	DeviceIOTimeoutErrorSignal nameClass:self message:#deviceIOTimeoutErrorSignal.

	CurrentScreenQuerySignal := QuerySignal new.

	CurrentScreenQuerySignal nameClass:self message:#currentScreenQuerySignal.

	CurrentScreenQuerySignal notifierString:'asking for current screen'.

	DrawingOnClosedDeviceSignal := DeviceErrorSignal newSignalMayProceed:true.

	DrawingOnClosedDeviceSignal nameClass:self message:#drawingOnClosedDeviceSignal.

	DrawingOnClosedDeviceSignal notifierString:'drawing attempt on closed graphics device'.

    ].

    ErrorPrinting := true.

    ExitOnLastClose := false.

    self initializeConstants.

    "/ for ST80 compatibility ...

    Screen := self.

    "Modified: / 03-08-1997 / 18:14:58 / cg"

    "Modified: / 01-03-2019 / 11:48:55 / Stefan Vogel"

!

initializeConstants

    "initialize some (soft) constants"

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

    CopyBufferHistorySize := 40.

    ButtonTranslation isNil ifTrue:[

	ButtonTranslation := #(1 2 2 2 2 2 2)  "all other buttons to middleButton menu"

	"/ ButtonTranslation := #(1 2 3 4 5 6 7)  "identity translation"

    ].

    "Modified: / 25-08-2010 / 21:57:43 / cg"

!

nativeWindows:aBoolean

    "enable / disable use of native windows - dummy here."

! !

!DeviceWorkstation class methodsFor:'instance creation'!

newDispatchingFor:aScreenName

    "create a new instance of mySelf, which serves aDeviceName.

     Only useful for device-classes which support multiple devices -

     i.e. X-Workstations"

    |newDevice someScreen|

    newDevice := self newFor:aScreenName.

    newDevice startDispatch.

    (someScreen := Screen current) isNil ifTrue:[

	someScreen := Screen default.

    ].

    someScreen notNil ifTrue:[

	newDevice keyboardMap:(someScreen keyboardMap).

	newDevice buttonTranslation:(someScreen buttonTranslation).

    ].

    "/ arrange for it to finish its event dispatch loop,

    "/ when the last view on it is closed.

    newDevice exitOnLastClose:true.

    ^ newDevice.

!

newFor:aDisplayName

    "Create an new instance for a connection to aDisplayName.

     If aDisplayName is nil, a connection to the standard display is opened"

    ^ self basicNew initializeFor:aDisplayName

!

openDefaultDisplay:aStringOrNil

    "open the default display. aStringOrNil may be the display name,

     if nil, the name is extracted from command-line-arguments or the environment.

     Raise a signal if open fails."

    |display displayName|

    displayName := aStringOrNil ? Screen defaultDisplayName.

    "find out about the concrete Workstation class"

    Screen isAbstract ifTrue:[

	|wsClass wsClasses|

	wsClasses := OrderedCollection new.

	#(OpenGLWorkstation GLXWorkstation XWorkstation)

	    detect:[:eachClassNameSymbol| (wsClass := Smalltalk classNamed:eachClassNameSymbol) notNil] ifNone:nil.

	wsClass notNil ifTrue:[wsClasses add:wsClass].

	"preparation for WIN32/NeXTStep/OS2 and Mac interfacing;

	 But if X11 is linked in and it is capable of setting up a connection, that will be used."

	#(

	    "/ #NeXTWorkstation  nil

	    OS2Workstation       isOS2like

	    MacWorkstation       isMAClike

	    WinWorkstation       isMSWINDOWSlike

	    ElectronWorkstation  nil

	) pairWiseDo:[:wsClassName :checkSel|

	    (checkSel isNil or:[OperatingSystem perform:checkSel]) ifTrue:[

		(wsClass := Smalltalk classNamed:wsClassName) notNil ifTrue:[

		    wsClasses add:wsClass.

		]

	    ].

	].

	"/ try all classes until open of display works.

	wsClasses detect:[:cls|

		[

		    display := cls newFor:displayName.

		] on:Screen deviceOpenErrorSignal do:[:ex| ].

		display notNil

	    ] ifNone:nil.

    ] ifFalse:[

	display := Screen newFor:displayName.

    ].

    display isNil ifTrue:[

	Screen deviceOpenErrorSignal raiseWith:displayName.

    ].

    Screen := display class.