"

 COPYRIGHT (c) 1992 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 }"

GraphicsMedium subclass:#DisplaySurface

	instanceVariableNames:'viewBackground cursor eventMask moreAttributes renderer uuid

		backed flags delegate updateRegion'

	classVariableNames:'GotExposeFlagMask SaveUnderFlagMask'

	poolDictionaries:''

	category:'Graphics-Support'

!

!DisplaySurface class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1992 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 describes stuff common to any Window on a display

    device. i.e. RootWindow, TopWindows, PopUps and Subwindows.

    That is, they have a viewBackground, cursor etc. and especially events.

    A special feature is the delegate field, which allows key- and button

    events to be stolen from a view.

    If the delegate is non-nil, these events will be sent to it instead.

    So you can change a view's behavior even if it was not initially designed

    for it. Also, controller functionality could be simulated using delegates.

    [instance variables:]

        viewBackground  <Color|Form|Image>      the view's background

        cursor          <Cursor>                the cursor

        eventMask                               mask specifying the enabled

                                                events.

        moreAttributes                          optional dictionary, allowing for more attributes

                                                to be store there

            fields:

                middleButtonMenu                a fix popup menu for the middle button.

                keyCommands                     not yet supported

        backed                                  one of #always, #whenMapped or #never

                                                corresponds to X's backing store mechanism.

                                                May be ignored by other devices.

        flags                                   flag bits

            saveUnder                               bit 1; 1 if saveunder store for

                                                            that view is enabled

            gotExpose                               bit 2; 1 if an expose/noExpose event arrived

                                                            (for exposure handling after a scroll)

       delegate                                for event delegation

    [see also:]

        DeviceWorkstation

        WindowGroup

        StandardSYstemView SimpleView View

    [author:]

        Claus Gittinger

"

! !

!DisplaySurface class methodsFor:'initialization'!

initialize

    SaveUnderFlagMask := 1.

    GotExposeFlagMask := 2.

! !

!DisplaySurface methodsFor:'accessing'!

addUpdateRectangle:newRectangle

    "return true, if the newRectangle is not already contained in the updateRegion

     (i.e. if it added any pixels to the region"

    |closure lastRect numRect lastTop lastBottom lastLeft lastRight

     newTop newBottom newLeft newRight|

    updateRegion isNil ifTrue:[

	updateRegion := OrderedCollection with:newRectangle.

	^ true

    ].

    (updateRegion contains:[:oldRectangle | (newRectangle isContainedIn:oldRectangle)]) ifTrue:[

	^ false.

    ].

    numRect := updateRegion size.

    numRect > 20 ifTrue:[

	closure := updateRegion

			inject:newRectangle

			into:[:boundsSoFar :thisRectangle |

				boundsSoFar quickMerge:thisRectangle

			     ].

	updateRegion := OrderedCollection with:closure.

	^ true

    ].

    lastRect := updateRegion at:numRect.

    lastTop := lastRect top.

    lastBottom := lastRect bottom.

    lastLeft := lastRect left.

    lastRight := lastRect right.

    newTop := newRectangle top.

    newBottom := newRectangle bottom.

    newLeft := newRectangle left.

    newRight := newRectangle right.

    lastTop = newTop ifTrue:[

	lastBottom = newBottom ifTrue:[

	    lastLeft <= newLeft ifTrue:[

		lastRight >= newLeft ifTrue:[

		    updateRegion at:numRect put:(lastRect copy right:newRight).

		    ^ false "/ true

		]

	    ]

	].

    ].

    lastLeft = newLeft ifTrue:[

	lastRight = newRight ifTrue:[

	    lastTop <= newTop ifTrue:[

		lastBottom >= newTop ifTrue:[

		    updateRegion at:numRect put:(lastRect copy bottom:newBottom).

		    ^ false "/ true

		]

	    ]

	].

    ].

    updateRegion add:newRectangle.

    ^ true

!

application

    "to be redefined in real widgets.

     Here nil is returned as fallback"

    ^ nil

    "Created: / 15-03-2017 / 10:42:10 / cg"

!

basicViewBackground:aColorOrFormOrViewBackground

    "set the viewBackground to something, a color, image or form.

     The viewBackground is the color or pattern with which exposed

     regions are filled - do not confuse this with the drawing background

     color, which is used with opaque drawing."

    viewBackground ~~ aColorOrFormOrViewBackground ifTrue:[

        viewBackground := aColorOrFormOrViewBackground.

        self drawableId notNil ifTrue:[

            self setViewBackground

        ]

    ]

    "Modified (format): / 12-02-2017 / 12:57:07 / cg"

!

controller

    "return nil - I have no controller"

    ^ nil

!

depth

    "return the depth in pixels of the view.

     Notice, that this is currently the devices depth,

     but support for mixed depth views is being prepared.

     (especially useful on SGI, with 24bit view)"

    ^ device depth

!

insideColor:aColor

    "set the view's background color - ST-80 compatibility"

    self viewBackground:aColor.

    self background:aColor

!

keyboardMap

    "by default, use my devices standard mapping.

     However, subclasses may redefine this, to return their own

     keyboard map (for example a terminalView may want treat CTRL-C as regular key)"

    ^ device keyboardMap

!

renderer

    "warning: this is experimental and not yet implemented"

    ^ renderer

!

renderer:something

    "warning: this is experimental and not yet implemented"

    renderer := something.

!

sensor

    "I can only return a SynchronousWindowSensor,

     since I do not have a window group"

    ^ SynchronousWindowSensor new

!

setViewBackground

    "install the viewBackground for the receiver on the device"

    |id devBgPixmap bgPixmap w h colorMap

     pixmapDepth deviceDepth defBG|

    self drawableId notNil ifTrue:[

        viewBackground isColor ifTrue:[

            viewBackground := viewBackground onDevice:self graphicsDevice.

            id := viewBackground colorId.

            "

             a real color (i.e. one supported by the device) ?

            "

            id notNil ifTrue:[

                self graphicsDevice setWindowBackground:id in:self drawableId.

                ^ self

            ].

            "

             no, a dithered one - must have a dither-pattern

             (which is ready for the device, since viewBackground

              is already assigned to the device)

            "

            bgPixmap := viewBackground ditherForm.

        ] ifFalse:[

            viewBackground notNil ifTrue:[

                viewBackground isViewBackground ifTrue:[

                    ^ self.

                ].

                "

                 assume, it can convert itself to a form

                "

                bgPixmap := viewBackground asFormOn:self graphicsDevice.

                bgPixmap isNil ifTrue:[

                    "/ assume it knows how to draw itself

                    ^ self

                ].

            ].

        ].

        "

         must now have:

         a dithered color or bitmap or pixmap

        "

        bgPixmap isNil ifTrue:[

            'DisplaySurface [warning]: background not convertable - ignored' errorPrintCR.

            ^ self

        ].

        "/ if the device does not support background pixmaps,

        "/ set the backgroundColor to the default background.

        "/ this will avoid flicker in win32 systems,

        "/ since that background is drawn directly in the

        "/ devices expose event handling.

        "/ (in contrast, the pixmap filling is done by the

        "/ window itself in its expose event handler)

        (self graphicsDevice supportsViewBackgroundPixmap:bgPixmap) ifFalse:[

            defBG := View defaultViewBackgroundColor.

            defBG isColor ifTrue:[

                defBG := defBG onDevice:self graphicsDevice.

                id := defBG colorId.

                id notNil ifTrue:[

                    self graphicsDevice setWindowBackground:id in:self drawableId.

                ].

            ].

            ^ self

        ].

        w := bgPixmap width.

        h := bgPixmap height.

        deviceDepth := self depth.

        pixmapDepth := bgPixmap depth.

        (pixmapDepth ~~ deviceDepth) ifTrue:[

            (pixmapDepth ~~ 1) ifTrue:[

                'DisplaySurface [warning]: Bad dither depth (must be one or devices depth)' errorPrintCR.

                ^ self

            ].

            "

             convert it into a deep form

            "

            colorMap := bgPixmap colorMap.

            devBgPixmap := Form width:w height:h depth:deviceDepth onDevice:self graphicsDevice.

            devBgPixmap isNil ifTrue:[

                'DisplaySurface [warning]: could not create a device form for viewBackground' infoPrintCR.

                ^ self

            ].

            devBgPixmap paint:(colorMap at:1).

            devBgPixmap fillRectangleX:0 y:0 width:w height:h.

            devBgPixmap foreground:(colorMap at:2) background:(colorMap at:1).

            devBgPixmap copyPlaneFrom:bgPixmap x:0 y:0 toX:0 y:0 width:w height:h.

            bgPixmap := devBgPixmap.

        ] ifFalse:[

            (pixmapDepth == 1) ifTrue:[

                "

                 although depth matches,

                 values in the dither are to be interpreted via the ditherForms

                 colormap, which is not always the same as blackpixel/whitepixel ...

                "

                colorMap := bgPixmap colorMap.

                (colorMap at:1) colorId == self graphicsDevice whitepixel ifTrue:[

                    (colorMap at:2) colorId == self graphicsDevice blackpixel ifTrue:[

                        "

                         ok, can use it

                        "

                        self graphicsDevice setWindowBackgroundPixmap:(bgPixmap drawableId) in:self drawableId.

                        ^ self

                    ]

                ].

                "

                 no, must invert it

                "

                devBgPixmap := Form width:w height:h depth:deviceDepth onDevice:self graphicsDevice.

                devBgPixmap paint:(colorMap at:2) on:(colorMap at:1).

                devBgPixmap copyPlaneFrom:bgPixmap x:0 y:0 toX:0 y:0 width:w height:h.

                bgPixmap := devBgPixmap.

            ]

        ].

        self graphicsDevice setWindowBackgroundPixmap:(bgPixmap drawableId) in:self drawableId.

    ]

    "Modified: / 23-01-2011 / 01:44:38 / cg"

!

updateRegion

    ^ updateRegion

!

updateRegion:something

    updateRegion := something.

!

viewBackground

    "return the viewBackground"

    ^ viewBackground

!

viewBackground:aColorOrFormOrViewBackground

    "set the viewBackground to something, a color, image or form.

     The viewBackground is the color or pattern with which exposed

     regions are filled - do not confuse this with the drawing background

     color, which is used with opaque drawing."

    viewBackground ~~ aColorOrFormOrViewBackground ifTrue:[

        self basicViewBackground:aColorOrFormOrViewBackground

    ]

    "Modified (format): / 12-02-2017 / 12:57:01 / cg"

!

viewBackgroundAndClear:something

    "set the viewBackground to something, a color, image or form.

     and clear the View.

     The viewBackground is the color or pattern with which exposed

     regions are filled - do not confuse this with the drawing background

     color, which is used with opaque drawing."

    self viewBackground:something.

    self clearView.

    "Created: 27.4.1996 / 14:09:08 / cg"

!

viewGravity

    "return the view's gravity"

    ^ #NorthWest

!

viewOrigin

    "0@0 here, since by default we cannot be scrolled"

    ^ 0 @ 0

!

widget

    "ST-80 compatibility"

    ^ self

!

windowClass:classString name:nameString

    gc windowClass:classString name:nameString.

!

windowGroup

    "return nil - I have no windowGroup"

    ^ nil

!

windowName:aString

    gc windowName:aString.

! !

!DisplaySurface methodsFor:'accessing-cursor'!

cursor

    "return the view's cursor"

    ^ cursor

!

cursor:aCursor

    "set the view's cursor. This cursor will be automatically displayed whenever

     the mouse-pointer enters the receiver.

     Cursors are typically set at view creation time and left as installed."

    self cursor:aCursor now:true

    "

     |v|

     v := View new.

     v cursor:(Cursor wait).

     v open.

     [v shown] whileFalse:[Processor yield].

     [v shown] whileTrue:[

        (Delay forSeconds:1) wait.

        v cursor:(Cursor normal).

        (Delay forSeconds:1) wait.

        v cursor:(Cursor wait).

     ]

    "

    "Modified: 14.12.1995 / 21:28:14 / cg"

!

cursor:aCursor now:showImmediately

    "set the view's cursor. This cursor will be automatically displayed whenever

     the mouse-pointer enters the receiver.

     Cursors are typically set at view creation time and left as installed.

     The showImmediately parameter controls if the request is to be buffered,

     or enforced immediately. Under XWindows, that makes a performance difference if many

     cursors (a whole group) are set, because the setting involves an XServer round trip."

    aCursor notNil ifTrue:[

        (aCursor ~~ cursor) ifTrue:[

            cursor := aCursor.

            self drawableId notNil ifTrue:[

                self setCursor.

                (showImmediately and:[realized]) ifTrue:[

                    "flush, to make cursor immediately visible"

                    self flush

                ]

            ]

        ]

    ]

    "

     |v|

     v := View new.

     v cursor:(Cursor wait).

     v open.

     [v shown] whileFalse:[Processor yield].

     [v shown] whileTrue:[

        (Delay forSeconds:1) wait.

        v cursor:(Cursor normal).

        (Delay forSeconds:1) wait.