"

 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.

"

'From Smalltalk/X, Version:6.2.3.0 on 23-05-2014 at 17:22:04'                   !

"{ Package: 'stx:libview' }"

GraphicsContext subclass:#DeviceGraphicsContext

	instanceVariableNames:'drawableId gcId deviceFont foreground background drawableType

		parentId'

	classVariableNames:'CachedScaledForms CachedScales Lobby'

	poolDictionaries:''

	category:'Graphics-Support'

!

DeviceHandle subclass:#DevicePixmapGCHandle

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:DeviceGraphicsContext

!

DeviceHandle subclass:#DeviceWindowGCHandle

	instanceVariableNames:'parentId'

	classVariableNames:''

	poolDictionaries:''

	privateIn:DeviceGraphicsContext

!

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

"

    I provide the common protocol for a graphicsContext which is associated with a particular

    device (i.e. Bitmaps, Pixmaps, RootWindow and Windows in Xs world, but also postscript

    printer pages or fax pages).

    My instance variables are mainly caching device-related stuff (such as font- and color-Ids)

    to avoid needless message traffic. This class is abstract, no direct instances of it

    exist in the system.

    All real work is done by my device, which is accessed via the device instance variable.

    Most drawing requests are simply forwarded to it, others are simulated by using more basic

    drawing functions (see GraphicsContext drawing vs. basic drawing category).

    The added variables foreground/background are the drawing colors actually

    used; these are the real (i.e. non dithered) colors supported by the device.

    Direct access to fg/bg is discouraged, since in the future, these may be

    totally replaced by paint/bgPaint

    (there are some operations and special cases, for which a direct access to

     fg/bg makes sense)

    [Instance variables:]

	drawableId      <SmallInteger>  my drawableId on the device (a device handle)

	gcId            <SmallInteger>  my gc's ID on the device (a device handle)

	deviceFont      <Font>          the actual font, currently set in the device

	foreground      <Color>         the device foreground color used for drawing

	background      <Color>         the device background color used for drawing

    [see also:]

	DeviceWorkstation

	Color Font Cursor

    [author:]

	Claus Gittinger

"

! !

!DeviceGraphicsContext class methodsFor:'initialization'!

initialize

    Lobby isNil ifTrue:[

	Lobby := Registry new.

    ]

    "Modified: / 29.1.1998 / 12:56:12 / cg"

! !

!DeviceGraphicsContext class methodsFor:'instance creation'!

new

    "create a new drawable - take the current display as

     its device (for now, this may be changed until the view is

     physically created)"

"

    'Warning: DeviceGraphicsContext (' print. self name print. ') should not be created with new' printNL.

"

    |device|

    device := Screen current.

    device isNil ifTrue:[

	device := Display.

	device isNil ifTrue:[

	    (self class name,' [warning]: no Display') infoPrintCR.

	    Smalltalk openDisplay.

	].

    ].

    ^ self onDevice:Screen current "Display"

!

on:aDevice

    "create a new drawable on aDevice"

    <resource:#obsolete>

    "/ send out a warning: #on: is typically used to create a view

    "/ operating on a model.

    "/ Please use #onDevice: to avoid confusion.

    self obsoleteMethodWarning:'use #onDevice:'.

    ^ self onDevice:aDevice

    "Modified: 5.6.1997 / 21:04:16 / cg"

!

onDevice:aDevice

    "create a new drawable on aDevice"

    |newDrawable|

    newDrawable := self basicNew.

    "

     set display before its initialized

     - so it can do something useful (i.e. get font sizes etc.) in its

     intitialize method(s)

    "

    newDrawable device:aDevice.

    newDrawable initialize.

    ^ newDrawable

    "Modified: 2.4.1997 / 19:19:35 / cg"

! !

!DeviceGraphicsContext class methodsFor:'cleanup'!

cleanupLobbyForChildrenOfViewWithDevice:aDevice id:anId

    "recursively clean all the subcomponents of the handle with id anId.

     This must be done on finalization, because descendent handles

     are destroyed implicitly when a parent handle is destroyed."

    |parents newChildren|

    parents := Array with:anId address.

    [

	newChildren := Set new.

	Lobby unregisterAllForWhichHandle:[:handle |

	    |parentId|

	    (handle notNil

		and:[handle device == aDevice

		and:[(parentId := handle parentId) notNil

		and:[parents includes:parentId]]]

	    ) ifTrue:[newChildren add:handle id. true] ifFalse:[false]

	].

	parents := newChildren.

    ] doWhile:[parents notEmpty].

!

lowSpaceCleanup

    CachedScaledForms := CachedScales := nil

!

releaseResourcesOnDevice:aDevice

    "this is sent when a display connection is closed,

     to release all cached bitmap/window objects from that device"

    Lobby unregisterAllForWhich:[:aDrawable | aDrawable graphicsDevice == aDevice]

    "Created: 16.1.1997 / 16:43:52 / cg"

! !

!DeviceGraphicsContext methodsFor:'Compatibility-ST80'!

key

    ^ self id

! !

!DeviceGraphicsContext methodsFor:'Compatibility-VW'!

displayBackgroundIfNeededOn: aGraphicsContext

    aGraphicsContext clearView.

!

inactiveForegroundColor

    "a dummy method to support VW widgets"

    ^ self foregroundColor

!

selectionBackgroundColor

    "a dummy method to support VW widgets"

    ^ self foregroundColor

!

selectionForegroundColor

    "a dummy method to support VW widgets"

    ^ self backgroundColor

!

separatorColor

    "a dummy method to support VW widgets"

    ^ self foregroundColor

! !

!DeviceGraphicsContext methodsFor:'accessing'!

at:aPoint

    "return the pixel at the coordinate given by aPoint"

    ^ self atX:aPoint x y:aPoint y

    "Modified: / 29.1.2000 / 12:17:42 / cg"

!

at:aPoint put:aPixelColor

    "set a pixel"

    ^ self atX:aPoint x y:aPoint y put:aPixelColor

    "

     Display rootView at:(0@0) put:(Color red).

     Display rootView at:(1@1) put:(Color red).

     Display rootView at:(2@2) put:(Color red).

     Display rootView at:(3@3) put:(Color red).

     Display rootView at:(4@4) put:(Color red).

     Display rootView at:(5@5) put:(Color red).

    "

!

atX:x y:y

    "return the pixel at the coordinate given by x/y"

    ^ device getPixelX:x y:y from:drawableId with:gcId

    "Modified: / 22.5.1999 / 01:40:23 / cg"

!

atX:x y:y put:aPixelColor

    "set a pixel"

    |oldFg|

    oldFg := foreground.

    self foreground:aPixelColor.

    self displayPointX:x y:y.

    self foreground:oldFg

!

backgroundPaint:aColor

    "set the background-paint color; this is used in opaque-draw

     operations"

    (aColor ~~ bgPaint) ifTrue:[

	aColor notNil ifTrue:[

	    bgPaint := aColor.

	    gcId notNil ifTrue:[

		bgPaint isColor ifTrue:[

		    bgPaint := aColor onDevice:device.

		    bgPaint colorId notNil ifTrue:[

			background := bgPaint.

			gcId notNil ifTrue:[

			    device setBackground:(bgPaint colorId) in:gcId.

			].

			^ self

		    ]

		].

		self paint:paint on:aColor

	    ]

	]

    ].

!

basicFont

    "return the font for drawing"

    ^ font

    "Created: 12.5.1996 / 11:17:59 / cg"

!

basicFont:aFont

    "set the font for drawing if it has changed.

     This is a low level entry, which is not to be redefined

     (i.e. it must not imply a redraw operation)"

    |id|

    (aFont ~~ font) ifTrue:[

	aFont notNil ifTrue:[

	    font := aFont.

	    device notNil ifTrue:[

		font := font onDevice:device.

		gcId notNil ifTrue:[

		    id := font fontId.

		    id notNil ifTrue:[

			deviceFont := font.

			device setFont:id in:gcId

		    ]

		]

	    ]

	]

    ]

    "Created: / 23-02-1996 / 17:16:51 / cg"

    "Modified: / 22-10-2006 / 14:11:37 / cg"

!

capStyle:aSymbol

    "set the style in which the endpoints of lines

     are drawn - aSymbol may be #notLast, #butt, #round, #projecting"

    |s|

    (s := aSymbol) isNil ifTrue:[

	s := #butt.

    ].

    (s ~~ capStyle) ifTrue:[

	capStyle := s.

	gcId notNil ifTrue:[

	    device setLineWidth:lineWidth

			  style:lineStyle

			    cap:s

			   join:joinStyle

			     in:gcId

	]

    ]

    "Modified: 12.5.1996 / 22:23:03 / cg"

!

clipByChildren

    "drawing shall be done into my view only (default)"

    <resource:#obsolete>

    self obsoleteMethodWarning:'use #clippedByChildren:true'.

    ^ self clippedByChildren:true

    "Created: 17.7.1996 / 13:25:55 / cg"

!

clipRect

    "return the clipping rectangle for drawing. If there is currently no clipRect,

     a dummy is created."

    |rect|

    (rect := clipRect) isNil ifTrue:[

	rect := 0@0 extent:(self extent).

    ].

"/ nope - it is already kept in logical coordinates

"/    transformation notNil ifTrue:[

"/        rect := transformation applyInverseTo:rect.

"/    ].

    ^ rect

    "Modified: / 20-10-2006 / 13:24:21 / cg"

!

clippedByChildren:aBoolean

    "turn on/off drawing over children.

     If on, a superview may draw 'over' its children.

     If off (the default), drawing is 'under' its children.

     Only useful for the rootView, to draw over any visible views.

     (for example, when dragging a rubber-line)"

    gcId isNil ifTrue:[

        self initGC

    ].

    device noClipIn:drawableId gc:gcId.

    device setClipByChildren:aBoolean in:drawableId gc:gcId.

    "Created: 17.7.1996 / 13:25:16 / cg"

    "Modified: 29.4.1997 / 15:33:55 / dq"

!

clippingBounds:aRectangleOrNil

    "set the clipping rectangle for drawing (in logical coordinates);

     a nil argument turn off clipping (i.e. whole view is drawable)"

    |x y w h newBounds|

    aRectangleOrNil isNil ifTrue:[

        clipRect isNil ifTrue:[^ self].

        gcId notNil ifTrue:[

            device noClipIn:drawableId gc:gcId

        ].

        clipRect := nil.

        ^ self.

    ].

    x := aRectangleOrNil left.

    y := aRectangleOrNil top.

    w := aRectangleOrNil width.

    h := aRectangleOrNil height.

    transformation notNil ifTrue:[

        x := transformation applyToX:x.

        y := transformation applyToY:y.

        w := transformation applyScaleX:w.

        h := transformation applyScaleY:h.

    ].

    (x class == SmallInteger) ifFalse:[

        w := w + (x - x truncated).

        x := x truncated

    ].

    (y class == SmallInteger) ifFalse:[

        h := h + (y - y truncated).

        y := y truncated

    ].

    (w class == SmallInteger) ifFalse:[

        w := w truncated + 1

    ].

    (h class == SmallInteger) ifFalse:[

        h := h truncated + 1

    ].

    w := w max:0.

    h := h max:0.

    newBounds := Rectangle left:x top:y width:w height:h.

    (clipRect notNil and:[clipRect = newBounds]) ifTrue:[

        ^ self

    ].

    clipRect := newBounds.

    gcId notNil ifTrue:[

        device setClipX:x y:y width:w height:h in:drawableId gc:gcId.

    ].

    "Created: / 28.5.1996 / 19:40:20 / cg"

    "Modified: / 16.5.1999 / 19:40:37 / cg"

!

colorAt:aPoint

    "return the color of the pixel at the coordinate given by x@y"

    ^ self colorAtX:(aPoint x) y:(aPoint y)

    "Modified: 1.8.1997 / 20:01:58 / cg"

!

colorAtX:x y:y

    "return the color of the pixel at the coordinate given by aPoint"

    |pixel|

    pixel := self atX:x y:y.

    device getScaledRGBFrom:pixel into:[:r :g :b |

	^ Color scaledRed:r scaledGreen:g scaledBlue:b

    ].

    "Created: 1.8.1997 / 20:01:32 / cg"

!

container

    "return my container - for protocol compatibility"

    ^ nil

!

dashStyle:aDashList offset:dashOffset

    "define dashes. Each element of the dashList specifies the length

     of a corresponding dash. For example, setting it to [4 4]

     defines 4on-4off dashing;

     Setting it to [1 2 4 2] defines 1on-2off-4on-2off dashes.

     The dashOffset specifies where in the dashList the dashing starts.