DevDraw.st
author Claus Gittinger <cg@exept.de>
Tue, 28 May 1996 16:36:26 +0200
changeset 721 ba7861418087
parent 710 f80fd1a73956
permissions -rw-r--r--
renamed DisplayMedium to Graphicsmedium & changed inheritance

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

GraphicsContext subclass:#DeviceDrawable
	instanceVariableNames:'device drawableId gcId realized deviceFont foreground background'
	classVariableNames:'CachedScaledForms CachedScales Lobby'
	poolDictionaries:''
	category:'Graphics-Support'
!

!DeviceDrawable 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 any drawable which is associated with a 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, most drawing requests are simply forwarded to it, others
    are simulated by using more basic drawing functions.

    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:]

        device          <Device>        the device this drawable is on
        drawableId      <SmallInteger>  my drawableId on the device
        gcId            <SmallInteger>  my gcs ID on the device
        realized        <Boolean>       true if visible (i.e. mapped)
                                        - for bit/pixmaps this is always true

        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

"
! !

!DeviceDrawable class methodsFor:'initialization'!

initialize
    Lobby isNil ifTrue:[
	Lobby := Registry new.
    ]
! !

!DeviceDrawable 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: DeviceDrawables (' print. self name print. ') should not be created with new' printNL.
"
    ^ self onDevice:Screen current "Display"
!

on:aDevice
    "create a new drawable on aDevice"

    ^ self onDevice:aDevice
!

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.
    Lobby register:newDrawable.
    ^ newDrawable
! !

!DeviceDrawable class methodsFor:'cleanup'!

lowSpaceCleanup
    CachedScaledForms := CachedScales := nil
! !

!DeviceDrawable methodsFor:'accessing'!

at:aPoint
    "return the pixel at the coordinate given by aPoint"

    ^ device
	getPixelX:(aPoint x)
		y:(aPoint y)
	     from:drawableId
!

at:aPoint put:aPixel
    "set a pixel"

    |oldFg|

    oldFg := foreground.
    self foreground:aPixel.
    self displayPointX:(aPoint x) y:(aPoint y).
    self foreground:oldFg
!

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

    ^ device getPixelX:x y:y from:drawableId
!

atX:x y:y put:aPixel
    "set a pixel"

    |oldFg|

    oldFg := foreground.
    self foreground:aPixel.
    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 on:device.
		    bgPaint colorId notNil ifTrue:[
			background := bgPaint.
			device setBackground:(bgPaint colorId) in:drawableId.
			^ self
		    ]
		].
		self paint:paint on:aColor
	    ]
	]
    ].
!

basicFont
    "return set 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.
            gcId notNil ifTrue:[
                font := font on:device.
                id := font fontId.
                id notNil ifTrue:[
                    device setFont:id in:gcId
                ]
            ]
        ]
    ]

    "Modified: 23.2.1996 / 17:01:06 / cg"
    "Created: 23.2.1996 / 17:16:51 / 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"
!

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

    |rect|

    clipRect isNil ifTrue:[
        rect := 0@0 extent:(self extent).
        transformation notNil ifTrue:[
            rect := transformation applyInverseTo:rect.
        ].
        ^ rect
    ].
    ^ clipRect

    "Modified: 10.4.1996 / 14:32:22 / cg"
!

clipRect: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|

    aRectangleOrNil isNil ifTrue:[
        clipRect isNil ifTrue:[^ self].
        gcId notNil ifTrue:[
            device noClipIn:gcId
        ]
    ] ifFalse:[
        clipRect notNil ifTrue:[
            (clipRect = aRectangleOrNil) ifTrue:[^ self]
        ].
        gcId notNil ifTrue:[
            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
            ].

            device setClipX:x y:y width:w height:h in:gcId
        ]
    ].
    clipRect := aRectangleOrNil

    "Modified: 22.5.1996 / 13:12:07 / cg"
!

clippingRectangleOrNil
    "return the clipping rectangle for drawing, nil if there is none."

    ^ clipRect

    "Created: 10.4.1996 / 14:32:02 / cg"
!

device
    "return the device, the receiver is associated with"

    ^ device
!

device:aDevice
    "set the device"

    device := aDevice
!

font:aFont
    "set the font for drawing if it has changed.
     This should be redefined in some widget to perform an automatic
     redraw. See also: #basicFont:"

    (aFont ~~ font) ifTrue:[
        self basicFont:aFont
    ]

    "Modified: 6.3.1996 / 18:17:40 / cg"
!

function:aSymbol
    "set the drawing function if it has changed"

    (aSymbol ~~ function) ifTrue:[
	function := aSymbol.
	gcId notNil ifTrue:[
	    device setFunction:aSymbol in:gcId
	]
    ]
!

gcId
    "return the receivers graphic context id on the device"

    ^ gcId
!

graphicsDevice
    "return the device, the receiver is associated with.
     Same as #device, for ST-80 compatibility."

    ^ device

    "Created: 9.5.1996 / 01:37:58 / cg"
!

id
    "return the id of the dravable on the device"

    ^ drawableId
!

joinStyle:aSymbol
    "set the style in which 2 lines are connected in polygons -
     aSymbol may be #miter, #bevel, #round"

    |s|

    (s := aSymbol) isNil ifTrue:[
        s := #miter
    ].
    (s ~~ joinStyle) ifTrue:[
        joinStyle := s.
        
        gcId notNil ifTrue:[
            device setLineWidth:lineWidth 
                          style:lineStyle
                            cap:capStyle
                           join:s
                             in:gcId
        ]
    ]

    "Modified: 12.5.1996 / 22:20:43 / cg"
!

lineStyle:aSymbol
    "set the style in which lines are drawn -
     aSymbol may be #solid, #dashed, #doubleDashed"

    |s|

    (s := aSymbol) isNil ifTrue:[
        s := #solid
    ].
    (s ~~ lineStyle) ifTrue:[
        lineStyle := s.
        gcId notNil ifTrue:[
            device setLineWidth:lineWidth 
                          style:s
                            cap:capStyle
                           join:joinStyle
                             in:gcId
        ]
    ]

    "Modified: 12.5.1996 / 22:21:25 / cg"
!

lineWidth:aNumber
    "set the line width for drawing if it has changed"

    |n|

    (aNumber ~~ lineWidth) ifTrue:[
	lineWidth := aNumber.
	transformation isNil ifTrue:[
	    n := aNumber.
	] ifFalse:[
	    n := transformation applyScaleX:aNumber.
	    n := n rounded
	].
	gcId notNil ifTrue:[
	    device setLineWidth:n 
			  style:lineStyle
			    cap:capStyle
			   join:joinStyle
			     in:gcId
	]
    ]
!

mask:aForm
    "set the mask form for drawing"

    |id|

    (aForm ~~ mask) ifTrue:[
	mask := aForm.
	gcId notNil ifTrue:[
	    (mask == nil) ifTrue:[
		device setBitmapMask:nil in:gcId
	    ] ifFalse:[
		mask := mask on:device.
		id := mask id.
		(mask depth == 1) ifTrue:[
		    device setBitmapMask:id in:gcId
		] ifFalse:[
		    device setPixmapMask:id in:gcId
		]
	    ]
	]
    ]
!

paint:aColor
    "set the drawing color, which may be a real color, a dithered one
     or even an image."

    (aColor ~~ paint) ifTrue:[
        aColor notNil ifTrue:[
            paint := aColor.
            self setGCForPaint.
        ]
    ]

    "Modified: 16.5.1996 / 15:35:57 / cg"
!

paint:fgColor on:bgColor
    "set the paint and background-paint color. 
     The bg-paint is used in opaque-draw operations"

    |fgId bgId|

    ((fgColor ~~ paint) or:[bgColor ~~ bgPaint]) ifTrue:[
        fgColor notNil ifTrue:[
            paint := fgColor
        ].
        bgColor notNil ifTrue:[
            bgPaint := bgColor
        ].
        gcId notNil ifTrue:[
            paint := paint on:device.
            paint isColor ifTrue:[
                fgId := paint colorId.
                fgId notNil ifTrue:[
                    mask notNil ifTrue:[
                        mask := nil.
                        device setBitmapMask:nil in:gcId
                    ]. 
                    bgPaint := bgPaint on:device.
                    bgPaint isColor ifTrue:[
                        bgId := bgPaint colorId.
                        bgId notNil ifTrue:[
                            "the common case, both are real colors"
                            (paint ~~ foreground) ifTrue:[
                                foreground := paint.
                                (bgPaint ~~ background) ifTrue:[
                                    background := bgPaint.
                                    device setForeground:fgId background:bgId in:gcId.
                                    ^ self
                                ].
                                device setForeground:fgId in:gcId.
                                ^ self
                            ].
                            (bgPaint ~~ background) ifTrue:[
                                background := bgPaint.
                                device setBackground:bgId in:gcId.
                            ].
                            ^ self
                        ].
                        "bgPaint is dithered, setup paint here, leave bgPaint
                         till next opaque draw comes around."

                        (paint ~~ foreground) ifTrue:[
                            foreground := paint.
                            device setForeground:fgId in:gcId
                        ].
                        ^ self
                    ]
                ]
            ].
            "either paint or bgPaint (or both) are dithered colors,
             setup for paint, leave bg-problem till next opaque draw
             comes around.
            "
            self setGCForPaint.
        ]
    ]

    "Modified: 16.5.1996 / 15:37:05 / cg"
!

paint:fgColor on:bgColor function:f
    "set paint, background-paint and function"

    self paint:fgColor on:bgColor.
    self function:f

    "Modified: 16.5.1996 / 15:36:35 / cg"
!

setGraphicsExposures:aBoolean
    "want to if aBoolean is true - or dont want to be notified
     of graphics exposures"

    gcId notNil ifTrue:[
	device setGraphicsExposures:aBoolean in:gcId
    ]
!

setMaskOrigin:aPoint
    "set the origin of the fill pattern"

    (maskOrigin isNil or:[maskOrigin ~= aPoint]) ifTrue:[
	transformation isNil ifTrue:[
	    maskOrigin := aPoint.
	] ifFalse:[
	    maskOrigin := transformation applyTo:aPoint
	].
	gcId notNil ifTrue:[
	    device setMaskOriginX:maskOrigin x rounded 
				y:maskOrigin y rounded 
			       in:gcId
	]
    ]
!

setMaskOriginX:orgX y:orgY
    "set the origin of the pattern"

    |x y|

    transformation notNil ifTrue:[
	x := transformation applyToX:orgX.
	y := transformation applyToY:orgY.
    ] ifFalse:[
	x := orgX.
	y := orgY
    ].
    x := x rounded.
    y := y rounded.

    (maskOrigin isNil or:[
     ((x ~~ maskOrigin x) or:[y ~~ maskOrigin y]) ]) ifTrue:[

	maskOrigin := x @ y.
	gcId notNil ifTrue:[
	    device setMaskOriginX:x y:y in:gcId
	]
    ]
! !

!DeviceDrawable methodsFor:'accessing - internals'!

background
    "return the current background drawing color.
     OBSOLETE: use #paint: / #backgroundPaint: / #paint:on:"

    ^ background

    "Modified: 12.5.1996 / 22:28:09 / cg"
!

background:aColor
    "set the internal background color for drawing - aColor must be a real color.
     OBSOLETE: this method will vanish; use #paint: / #backgroundPaint: / #paint:on:"

    |bgId|

    (aColor ~~ background) ifTrue:[
        aColor notNil ifTrue:[
            background := aColor.
            gcId notNil ifTrue:[
                background := background on:device.
                bgId := background colorId.

                "
                 mhmh the following is a kludge ....
                "
                bgId isNil ifTrue:[
                    (background greyIntensity >= 50) ifTrue:[
                        bgId := device whitepixel
                    ] ifFalse:[
                        bgId := device blackpixel
                    ]
                ].
                device setBackground:bgId in:gcId
            ]
        ]
    ]

    "Modified: 12.5.1996 / 22:28:15 / cg"
!

foreground
    "return the current foreground drawing color.
     OBSOLETE: use #paint: / #paint:on:"

    ^ foreground

    "Modified: 12.5.1996 / 22:28:03 / cg"
!

foreground:aColor
    "set the internal foreground color for drawing - aColor must be a real color.
     OBSOLETE: this method will vanish; use #paint: / #paint:on:"

    |fgId|

    (aColor ~~ foreground) ifTrue:[
        aColor notNil ifTrue:[
            foreground := aColor.
            gcId notNil ifTrue:[
                (foreground class == SmallInteger) ifTrue:[
                    fgId := foreground
                ] ifFalse:[
                    foreground := foreground on:device.
                    fgId := foreground colorId.
                ].

                "mhmh the following is a kludge ...."
                fgId isNil ifTrue:[
                    (foreground greyIntensity >= 50) ifTrue:[
                        fgId := device whitepixel
                    ] ifFalse:[
                        fgId := device blackpixel
                    ]
                ].
                device setForeground:fgId in:gcId.
                paint := foreground
            ]
        ]
    ]

    "Modified: 12.5.1996 / 22:28:23 / cg"
!

foreground:fgColor background:bgColor
    "set both internal foreground and internal background colors 
     - these must be real colors.
     OBSOLETE: this method will vanish; use #paint: / #paint:on:"

    |fgPixel bgPixel|

    ((fgColor ~~ foreground) or:[bgColor ~~ background]) ifTrue:[
        fgColor notNil ifTrue:[
            foreground := fgColor
        ].
        bgColor notNil ifTrue:[
            background := bgColor
        ].
        gcId notNil ifTrue:[
            foreground := foreground on:device.
            background := background on:device.
            fgPixel := foreground colorId.
            bgPixel := background colorId.

            "mhmh the following is a kludge ...."
            fgPixel isNil ifTrue:[
                (foreground greyIntensity >= 50) ifTrue:[
                    fgPixel := device whitepixel
                ] ifFalse:[
                    fgPixel := device blackpixel
                ]
            ].
            bgPixel isNil ifTrue:[
                (background greyIntensity >= 50) ifTrue:[
                    bgPixel := device whitepixel
                ] ifFalse:[
                    bgPixel := device blackpixel
                ]
            ].
            device setForeground:fgPixel background:bgPixel in:gcId.
            paint := foreground
        ]
    ]

    "Modified: 12.5.1996 / 22:28:27 / cg"
!

foreground:fgColor background:bgColor function:fun
    "set foreground, background colors and function.
     OBSOLETE: this method will vanish; use #paint: / #paint:on:"

    self foreground:fgColor background:bgColor.
    self function:fun

    "Modified: 12.5.1996 / 22:28:34 / cg"
!

foreground:aColor function:fun
    "set the foreground color and function for drawing.
     OBSOLETE: this method will vanish; use #paint: / #paint:on:"

    |fgPixel|

    ((aColor ~~ foreground) or:[fun ~~ function]) ifTrue:[
        foreground := aColor.
        function := fun.
        gcId notNil ifTrue:[
            foreground := foreground on:device.
            fgPixel := foreground colorId.

            "mhmh the following is a kludge ...."
            fgPixel isNil ifTrue:[
                (foreground greyIntensity >= 50) ifTrue:[
                    fgPixel := device whitepixel
                ] ifFalse:[
                    fgPixel := device blackpixel
                ]
            ].
            device setForeground:fgPixel in:gcId.
            device setFunction:fun in:gcId.
            paint := foreground
        ]
    ]

    "Modified: 12.5.1996 / 22:28:48 / cg"
! !

!DeviceDrawable methodsFor:'bit blitting'!

copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY
    "copy bits from a smalltalk byteArray.
     The bits found there are supposed to be in the devices native format (i.e.
     translated to allocated color indices on pseudoColor devices and padded as required.
     The byteOrder is MSB and will be converted as appropriate by the underlying devices 
     method to whatever the device needs."

    device
	drawBits:aByteArray bitsPerPixel:bpp depth:depth  
	   width:srcW height:srcH
	       x:srcX y:srcY
	    into:drawableId
	       x:dstX y:dstY 
	   width:(self width) height:(self height)
	    with:gcId.

    "Created: 21.10.1995 / 00:04:22 / cg"
!

copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h
    "copy from aDrawable into the receiver;
     the source may be the receiver as well - in this case its a scroll.
     All coordinates are in device coordinates."

    |id|

    id := aDrawable id.

    "temporary ...
     this fixes a problem after restart on another display,
     when a file-bitmap wasnt found. In this case, the id of the
     bitmap will be nil. This will be fixed soon.
    "
    (id isNil 
    or:[aDrawable device ~~ device]) ifTrue:[
	'DEVDRAW: invalid bitmap copy - ignored' errorPrintNL.
	^ self
    ].

    gcId isNil ifTrue:[
	self initGC
    ].

    "this is a workaround for a bug (or a feature ?) in many X-servers;
     copy is only copy if fg==1 and bg==0"

"/No: it was my fault - shame, shame
"/
"/    ((aDrawable == self) and:[function == #copy]) ifTrue:[
"/        device setForeground:1 background:0 in:gcId.
"/        background := nil.
"/        foreground := nil.
"/        paint := nil
"/    ].
"/
    ((aDrawable depth == 1) and:[device depth ~~ 1]) ifTrue:[
	device
	    copyPlaneFromId:id
		     x:srcX y:srcY
		    to:drawableId
		     x:dstX y:dstY
		 width:w
		height:h
		  with:gcId
    ] ifFalse:[
	device
	    copyFromId:id
		     x:srcX y:srcY
		    to:drawableId
		     x:dstX y:dstY
		 width:w
		height:h
		  with:gcId
    ]
!

copyPlaneFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h
    "copy one plane from aDrawable into the receiver. 0's are drawn in
     background, while 1's are drawn with foreground color.
     The depth of aDrawable must (should) be 1.
     The drawable must have been allocated on the same device.
     All coordinates are in device coordinates."

    |id|

    id := aDrawable id.

    "temporary ...
     this fixes a problem after restart on another display,
     when a file-bitmap wasnt found. In this case, the id of the
     bitmap will be nil. This will be fixed soon.
    "
    (id isNil 
    or:[aDrawable device ~~ device]) ifTrue:[
	'DEVDRAW: invalid copyPlane - ignored' errorPrintNL.
	^ self
    ].

    gcId isNil ifTrue:[
	self initGC
    ].

    device
	copyPlaneFromId:id
		 x:srcX y:srcY
		to:drawableId
		 x:dstX y:dstY
	     width:w
	    height:h
	      with:gcId
! !

!DeviceDrawable methodsFor:'copying'!

postCopy
    "this may not be enough to allow copying of views ..."

    super postCopy.
    device := drawableId := gcId := nil.
    realized := false.
    self recreate
! !

!DeviceDrawable methodsFor:'drawing'!

displayArcX:x y:y width:w height:h from:startAngle angle:angle
    "draw an arc; apply transformation if nonNil"

    |pX pY nW nH|

    gcId isNil ifTrue:[
        self initGC
    ].
    transformation notNil ifTrue:[
        pX := transformation applyToX:x.
        pY := transformation applyToY:y.
        nW := transformation applyScaleX:w.
        nH := transformation applyScaleY:h.
        nW < 0 ifTrue:[
              nW := nW abs.  
              pX := pX - nW.
        ].
        nH < 0 ifTrue:[
              nH := nH abs.  
              pY := pY - nH.
        ].
    ] ifFalse:[
        pX := x.
        pY := y.
        nW := w.
        nH := h.
    ].

    pX := pX rounded.
    pY := pY rounded.
    nW := nW rounded.
    nH := nH rounded.

    device
          displayArcX:pX 
                    y:pY 
                width:nW 
               height:nH 
                 from:startAngle 
                angle:angle
                   in:drawableId 
                 with:gcId

    "Created: 8.5.1996 / 08:31:30 / cg"
!

displayForm:formToDraw x:x y:y
    "draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
     current paint-color, leaving pixels with 0-bits unchanged
     (i.e. only 1-bits are drawn from the form).
     If its a deep form (i.e. a pixmap) the current paint
     settings are ignored and the form is drawn as-is. 
     Care must be taken, that the paint color is correctly allocated 
     (by sending #on: to the color) before doing so.
     Using functions other than #copy only makes sense if you are
     certain, that the colors are real colors (actually, only for
     noColor or allColor)."

    |realForm pX pY w h nW nH|

    realForm := formToDraw.

    transformation notNil ifTrue:[
        pX := transformation applyToX:x.
        pY := transformation applyToY:y.

        transformation noScale ifFalse:[
            w := formToDraw width.
            h := formToDraw height.

            nW := (transformation applyScaleX:w) rounded.
            nH := (transformation applyScaleY:h) rounded.

            ((nW ~= w) or:[nH ~= h]) ifTrue:[
                "/
                "/ hard case - someone is drawing forms with scaling in effect
                "/ look if we have a scaled version in our pocket ...
                "/
                realForm := nil.
                CachedScaledForms notNil ifTrue:[
                    (CachedScales at:formToDraw ifAbsent:nil) = transformation scale ifTrue:[
                        realForm := CachedScaledForms at:formToDraw ifAbsent:nil.
                    ]
                ].
                realForm isNil ifTrue:[
                    "/
                    "/ nope - must do the work ...
                    "/
                    realForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
                    CachedScaledForms isNil ifTrue:[
                        CachedScaledForms := WeakIdentityDictionary new.
                        CachedScales := WeakIdentityDictionary new.
                    ].
                    CachedScaledForms at:formToDraw put:realForm.
                    CachedScales at:formToDraw put:transformation scale.
                ]
            ]
        ]
    ] ifFalse:[
        pX := x.
        pY := y.
    ].
    pX := pX rounded.
    pY := pY rounded.

    self displayDeviceForm:realForm x:pX y:pY

    "Modified: 21.5.1996 / 21:15:44 / cg"
!

displayLineFromX:x0 y:y0 toX:x1 y:y1
    "draw a line (with current paint-color); apply transformation if nonNil"

    |pX0 pY0 pX1 pY1 easy fgId bgId|

    gcId isNil ifTrue:[
        self initGC
    ].

    lineStyle == #doubleDashed ifTrue:[
        "
         if bgPaint or paint is not a real color, we have to do it the hard way ...
        "
        easy := true.
        paint isColor ifFalse:[
            easy := false
        ] ifTrue:[
            fgId := paint colorId.
            fgId isNil ifTrue:[
                easy := false
            ]
        ].
        bgPaint isColor ifFalse:[
            easy := false
        ] ifTrue:[
            bgId := bgPaint colorId.
            bgId isNil ifTrue:[
                easy := false
            ]
        ].

        easy ifTrue:[
            ((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
                device setForeground:fgId background:bgId in:gcId.
                foreground := paint.
                background := bgPaint.
            ].
        ] ifFalse:[
            'DEVDRAW: cannot draw dashes with dithered colors' errorPrintNL
        ].
    ].

    transformation notNil ifTrue:[
        pX0 := transformation applyToX:x0.
        pY0 := transformation applyToY:y0.
        pX1 := transformation applyToX:x1.
        pY1 := transformation applyToY:y1.
    ] ifFalse:[
        pX0 := x0.
        pY0 := y0.
        pX1 := x1.
        pY1 := y1
    ].

    pX0 := pX0 rounded.
    pY0 := pY0 rounded.
    pX1 := pX1 rounded.
    pY1 := pY1 rounded.

    device displayLineFromX:pX0 y:pY0 toX:pX1 y:pY1 in:drawableId with:gcId

    "Modified: 13.4.1996 / 20:31:19 / cg"
!

displayOpaqueForm:formToDraw x:x y:y
    "draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
     current paint-color and 0-bits in the bgPaint color.
     If its a deep form (i.e. a pixmap) the current paint/bgPaint
     settings are ignored and the form drawn as-is. 
     In the 1-plane case, special care must be taken if paint and/or bgPaint 
     dithered colors or patterns, since are that the colors are correctly allocated 
     (by sending #on: to the colors) before doing so.
     If there is a transformation, the image is scaled as appropiate."

    |w h realForm pX pY nW nH|

    bgPaint isNil ifTrue:[
        "/
        "/ actually not an opaque draw
        "/
        self displayForm:formToDraw x:x y:y.
        ^ self
    ].

    realForm := formToDraw.

    transformation notNil ifTrue:[
        pX := transformation applyToX:x.
        pY := transformation applyToY:y.

        transformation noScale ifFalse:[
            w := formToDraw width.
            h := formToDraw height.

            nW := (transformation applyScaleX:w) rounded.
            nH := (transformation applyScaleY:h) rounded.

            ((nW ~= w) or:[nH ~= h]) ifTrue:[
                "/
                "/ hard case - someone is drawing forms with scaling in effect
                "/ look if we have a scaled version in our pocket ...
                "/
                realForm := nil.
                CachedScaledForms notNil ifTrue:[
                    (CachedScales at:formToDraw ifAbsent:nil) = transformation scale ifTrue:[
                        realForm := CachedScaledForms at:formToDraw ifAbsent:nil.
                    ]
                ].
                realForm isNil ifTrue:[
                    "/
                    "/ nope - must do the work ...
                    "/
                    realForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
                    CachedScaledForms isNil ifTrue:[
                        CachedScaledForms := WeakIdentityDictionary new.
                        CachedScales := WeakIdentityDictionary new.
                    ].
                    CachedScaledForms at:formToDraw put:realForm.
                    CachedScales at:formToDraw put:transformation scale.
                ]
            ]
        ]
    ] ifFalse:[
        pX := x.
        pY := y.
    ].

    pX := pX rounded.
    pY := pY rounded.

    self displayDeviceOpaqueForm:realForm x:pX y:pY

    "Modified: 21.5.1996 / 21:15:54 / cg"
!

displayOpaqueString:aString from:index1 to:index2 x:x y:y
    "draw a substring at the coordinate x/y - draw foreground pixels in
     paint-color and background pixels in bgPaint-color.
     If the transformation involves scaling, 
     the fonts point-size is scaled as appropriate.
     Assuming that device can only draw in device colors, we have to handle
     the case where paint and/or bgPaint are dithered colors"

    |easy w h savedPaint fgId bgId
     id pX pY fontUsed sz s|

    "
     if backgroundPaint color is nil, we assume
     this is a non-opaque draw
    "
    bgPaint isNil ifTrue:[
        self displayString:aString from:index1 to:index2 x:x y:y.
        ^ self
    ].

    (aString isString not
    or:[aString isText]) ifTrue:[
        "
         hook for non-strings (i.e. attributed text)
         that 'thing' should know how to display itself ...
        "
        aString displayOpaqueOn:self x:x y:y from:index1 to:index2.
        ^ self
    ].

    gcId isNil ifTrue:[
        self initGC
    ].

    fontUsed := font.
    transformation notNil ifTrue:[
        pX := transformation applyToX:x.
        pY := transformation applyToY:y.
        transformation noScale ifFalse:[
            sz := font size.
            sz isNil ifTrue:[
                "/ oops - not a real font; use original font
                fontUsed := font
            ] ifFalse:[
                fontUsed := font size:(transformation applyScaleY:sz) rounded.
            ]
        ]
    ] ifFalse:[
        pX := x.
        pY := y.
    ].
    pX := pX rounded.
    pY := pY rounded.

    fontUsed := fontUsed on:device.

    id := fontUsed fontId.
    id isNil ifTrue:[
        "
         hook for alien fonts
         that 'font' should know how to display the string ...
        "
        fontUsed displayOpaqueString:aString from:index1 to:index2 x:x y:y in:self.
        ^ self
    ].

    s := aString.
    s encoding ~~ font encoding ifTrue:[
        s := s encodeInto:(font encoding).
    ].

    "
     if bgPaint or paint is not a real Color, we have to do it the hard way ...
    "
    easy := true.
    paint isColor ifFalse:[
        easy := false
    ] ifTrue:[
        fgId := paint colorId.
        fgId isNil ifTrue:[
            easy := false
        ]
    ].
    bgPaint isColor ifFalse:[
        easy := false
    ] ifTrue:[
        bgId := bgPaint colorId.
        bgId isNil ifTrue:[
            easy := false
        ]
    ].

    easy ifTrue:[
        deviceFont ~~ fontUsed ifTrue:[
            device setFont:id in:gcId.
            deviceFont := fontUsed
        ].

        device setForeground:fgId background:bgId in:gcId.
        foreground := paint.
        background := bgPaint.
        device displayOpaqueString:s 
                              from:index1 to:index2
                                 x:pX y:pY 
                                in:drawableId with:gcId.
        ^ self
    ].

    w := fontUsed widthOf:s from:index1 to:index2.
    h := fontUsed height.

    (fgId notNil and:[function == #copy]) ifTrue:[
        deviceFont ~~ fontUsed ifTrue:[
            device setFont:id in:gcId.
            deviceFont := fontUsed
        ].
        "
         only bg is dithered; fill with bg first ...
        "
        savedPaint := paint.
        self paint:bgPaint.
        self fillDeviceRectangleX:pX y:(pY - fontUsed ascent) width:w height:h.
        self paint:savedPaint.

        "
         then draw using fgPaint (which is a real color)
        "
        device displayString:s 
                        from:index1 to:index2
                           x:pX y:pY 
                          in:drawableId with:gcId.
        ^ self
    ].

    self displayDeviceOpaqueString:s from:index1 to:index2 in:fontUsed x:pX y:pY.

    "Modified: 21.5.1996 / 21:16:08 / cg"
!

displayOpaqueString:aString x:x y:y
    "draw a string at the coordinate x/y - draw foreground pixels in paint-color,
     background pixels in bgPaint color. If the transformation involves scaling, 
     the fonts point-size is scaled as appropriate.
     Assuming that device can only draw in device colors, we have to handle
     the case where paint and/or bgPaint are dithered colors or images."

    |id easy fgId bgId pX pY fontUsed sz s|

    "
     if backgroundPaint color is nil, we assume
     this is a non-opaque draw
    "
    bgPaint isNil ifTrue:[
        self displayString:aString x:x y:y.
        ^ self
    ].

    (aString isString not
    or:[aString isText]) ifTrue:[
        "
         hook for non-strings (i.e. attributed text)
         that 'thing' should know how to display itself ...
        "
        aString displayOpaqueOn:self x:x y:y.
        ^ self
    ].

    "
     if bgPaint or paint is not a real Color, we have to do it the hard way ...
    "
    easy := true.
    paint isColor ifFalse:[
        easy := false
    ] ifTrue:[
        fgId := paint colorId.
        fgId isNil ifTrue:[
            easy := false
        ]
    ].
    bgPaint isColor ifFalse:[
        easy := false
    ] ifTrue:[
        bgId := bgPaint colorId.
        bgId isNil ifTrue:[
            easy := false
        ]
    ].
    easy ifFalse:[
        "
         for the hard case, use the general drawing method
         (no need for optimizations - its slow anyway)
        "
        self displayOpaqueString:aString 
                            from:1 to:(aString size)
                               x:x y:y. 
        ^ self
    ].

    gcId isNil ifTrue:[
        self initGC
    ].

    fontUsed := font.
    transformation notNil ifTrue:[
        pX := transformation applyToX:x.
        pY := transformation applyToY:y.
        transformation noScale ifFalse:[
            sz := font size.
            sz isNil ifTrue:[
                "/ oops - not a real font; use original font
                fontUsed := font
            ] ifFalse:[
                fontUsed := font size:(transformation applyScaleY:sz) rounded.
            ]
        ]
    ] ifFalse:[
        pX := x.
        pY := y.
    ].
    pX := pX rounded.
    pY := pY rounded.

    fontUsed := fontUsed on:device.

    id := fontUsed fontId.
    id isNil ifTrue:[
        "
         hook for alien fonts
         that 'font' should know how to display the string ...
        "
        fontUsed displayOpaqueString:aString from:1 to:(aString size) x:x y:y in:self.
        ^ self
    ].

    s := aString.
    s encoding ~~ font encoding ifTrue:[
        s := s encodeInto:(font encoding).
    ].

    deviceFont ~~ fontUsed ifTrue:[
        device setFont:id in:gcId.
        deviceFont := fontUsed
    ].


    device setForeground:fgId background:bgId in:gcId.
    foreground := paint.
    background := bgPaint.
    device displayOpaqueString:s 
                             x:pX y:pY 
                            in:drawableId with:gcId.

    "Modified: 21.5.1996 / 21:16:17 / cg"
!

displayPointX:x y:y
    "draw a point (with current paint-color); apply transformation if nonNil"

    |pX pY|

    gcId isNil ifTrue:[
	self initGC
    ].
    transformation notNil ifTrue:[
	pX := transformation applyToX:x.
	pY := transformation applyToY:y.
    ] ifFalse:[
	pX := x.
	pY := y
    ].
    pX := pX rounded.
    pY := pY rounded.

    device displayPointX:pX y:pY in:drawableId with:gcId
!

displayPolygon:aPolygon
    "draw (the outline of) a polygon (with current paint-color).
     Apply transformation if nonNil"

    |newPolygon|

    gcId isNil ifTrue:[
	self initGC
    ].
    transformation notNil ifTrue:[
	newPolygon := aPolygon collect:[:point | transformation applyTo:point].
    ] ifFalse:[
	newPolygon := aPolygon
    ].
    (newPolygon findFirst:[:p | 
	(p isPoint not 
	or:[(p x class ~~ SmallInteger)
	or:[(p y class ~~ SmallInteger)]])
     ]) ~~ 0 ifTrue:[
	newPolygon := newPolygon collect:[:p | p asPoint rounded]
    ].
        
    device displayPolygon:newPolygon in:drawableId with:gcId
!

displayRectangleX:x y:y width:w height:h
    "draw a rectangle (with current paint-color).
     If transformation is nonNil, drawing is in logical coordinates."

    |pX pY nW nH easy fgId bgId|

    gcId isNil ifTrue:[
        self initGC
    ].

    lineStyle == #doubleDashed ifTrue:[
        "
         if bgPaint or paint is not a real color, we have to do it the hard way ...
        "
        easy := true.
        paint isColor ifFalse:[
            easy := false
        ] ifTrue:[
            fgId := paint colorId.
            fgId isNil ifTrue:[
                easy := false
            ]
        ].
        bgPaint isColor ifFalse:[
            easy := false
        ] ifTrue:[
            bgId := bgPaint colorId.
            bgId isNil ifTrue:[
                easy := false
            ]
        ].

        easy ifTrue:[
            ((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
                device setForeground:fgId background:bgId in:gcId.
                foreground := paint.
                background := bgPaint.
            ].
        ] ifFalse:[
            'DEVDRAW: cannot draw dashes with dithered colors' errorPrintNL
        ].
    ].

    transformation notNil ifTrue:[
        pX := transformation applyToX:x.
        pY := transformation applyToY:y.
        nW := transformation applyScaleX:w.
        nH := transformation applyScaleY:h.
        nW < 0 ifTrue:[
              nW := nW abs.  
              pX := pX - nW.
        ].
        nH < 0 ifTrue:[
              nH := nH abs.  
              pY := pY - nH.
        ].
    ] ifFalse:[
        pX := x.
        pY := y.
        nW := w.
        nH := h
    ].

    pX := pX rounded.
    pY := pY rounded.
    nW := nW rounded.
    nH := nH rounded.

    "I asked myself many times if we should draw w/h or (w-1)/(h-1) bits -
     this one seems mathematically incorrect but allows to draw and fill
     a rectangle using the same extents.
     I'm not certain if is the right thing to do ...
    "
    device displayRectangleX:pX y:pY 
                       width:(nW - 1) height:(nH - 1)
                           in:drawableId with:gcId

    "Modified: 13.4.1996 / 20:31:59 / cg"
!

displayString:aString from:index1 to:index2 x:x y:y
    "draw a substring at the coordinate x/y -  
     draw foreground-pixels only (in current paint-color), 
     leaving background as-is. If the transformation involves scaling,
     the fonts point-size is scaled as appropriate."

    |id pX pY fontUsed sz s|

    "hook for non-strings (i.e. attributed text)"
    aString isString ifFalse:[
        ^ aString displayOn:self x:x y:y from:index1 to:index2
    ].

    gcId isNil ifTrue:[
        self initGC
    ].

    fontUsed := font.
    transformation notNil ifTrue:[
        pX := transformation applyToX:x.
        pY := transformation applyToY:y.
        transformation noScale ifFalse:[
            sz := font size.
            sz isNil ifTrue:[
                "/ oops - not a real font; use original font
                fontUsed := font
            ] ifFalse:[
                fontUsed := font size:(transformation applyScaleY:sz) rounded.
            ]
        ]
    ] ifFalse:[
        pX := x.
        pY := y.
    ].
    pX := pX rounded.
    pY := pY rounded.

    fontUsed := fontUsed on:device.

    id := fontUsed fontId.
    id isNil ifTrue:[
        "hook for alien fonts"
        font displayString:aString from:index1 to:index2 x:x y:y in:self.
        ^ self
    ].

    s := aString.
    s encoding ~~ font encoding ifTrue:[
        s := s encodeInto:(font encoding).
    ].

    deviceFont ~~ fontUsed ifTrue:[
        device setFont:id in:gcId.
        deviceFont := fontUsed
    ].
    device displayString:s from:index1 to:index2
                       x:pX y:pY in:drawableId with:gcId

    "Modified: 21.5.1996 / 21:16:24 / cg"
!

displayString:aString x:x y:y
    "draw a string at the coordinate x/y - 
     draw foreground-pixels only (in current paint-color), 
     leaving background as-is. If the transformation involves scaling, 
     the fonts point-size is scaled as appropriate."

    |id pX pY fontUsed sz s|

    "hook for non-strings (i.e. attributed text)"
    (aString isString not
    or:[aString isText]) ifTrue:[
        ^ aString displayOn:self x:x y:y
    ].

    gcId isNil ifTrue:[
        self initGC
    ].

    fontUsed := font.
    transformation notNil ifTrue:[
        pX := transformation applyToX:x.
        pY := transformation applyToY:y.
        transformation noScale ifFalse:[
            sz := font size.
            sz isNil ifTrue:[
                "/ oops - not a real font; use original font
                fontUsed := font
            ] ifFalse:[
                fontUsed := font size:(transformation applyScaleY:sz) rounded.
            ]
        ]
    ] ifFalse:[
        pX := x.
        pY := y.
    ].
    pX := pX rounded.
    pY := pY rounded.

    fontUsed := fontUsed on:device.

    id := fontUsed fontId.
    id isNil ifTrue:[
        "hook for alien fonts"
        fontUsed displayString:aString x:x y:y in:self
    ] ifFalse:[
        s := aString.
        s encoding ~~ fontUsed encoding ifTrue:[
            s := s encodeInto:(fontUsed encoding).
        ].

        deviceFont ~~ fontUsed ifTrue:[
            device setFont:id in:gcId.
            deviceFont := fontUsed
        ].
        device displayString:s x:pX y:pY in:drawableId with:gcId
    ]

    "Modified: 21.5.1996 / 21:16:30 / cg"
!

displayUnscaledForm:formToDraw x:x y:y
    "draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
     current paint-color, leaving pixels with 0-bits unchanged
     (i.e. only 1-bits are drawn from the form).
     If its a deep form (i.e. a pixmap) the current paint
     settings are ignored and the form is drawn as-is. 
     Care must be taken, that the paint color is correctly allocated 
     (by sending #on: to the color) before doing so.
     Using functions other than #copy only makes sense if you are
     certain, that the colors are real colors (actually, only for
     noColor or allColor).
     The origins coordinate is transformed, but the image itself is unscaled."

    |pX pY|

    transformation notNil ifTrue:[
	pX := transformation applyToX:x.
	pY := transformation applyToY:y.
    ] ifFalse:[
	pX := x.
	pY := y.
    ].
    pX := pX rounded.
    pY := pY rounded.

    self displayDeviceForm:formToDraw x:pX y:pY
!

displayUnscaledOpaqueForm:formToDraw x:x y:y
    "draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
     current paint-color, 0 bits in background color.
     If its a deep form (i.e. a pixmap) the current paint
     settings are ignored and the form is drawn as-is (opaque). 
     The origins coordinate is transformed, but the image itself is unscaled."

    |pX pY|

    transformation notNil ifTrue:[
	pX := transformation applyToX:x.
	pY := transformation applyToY:y.
    ] ifFalse:[
	pX := x.
	pY := y.
    ].
    pX := pX rounded.
    pY := pY rounded.

    self displayDeviceOpaqueForm:formToDraw x:pX y:pY
!

displayUnscaledOpaqueString:aString from:index1 to:index2 x:x y:y
    "draw a substring at the transformed coordinate x/y but do not scale the font.
     Draw foreground pixels in paint-color, background pixels in bgPaint color."

    |pX pY|

    transformation notNil ifTrue:[
	pX := transformation applyToX:x.
	pY := transformation applyToY:y.
    ] ifFalse:[
	pX := x.
	pY := y.
    ].
    self displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:pX y:pY
!

displayUnscaledOpaqueString:aString x:x y:y
    "draw a string at the transformed coordinate x/y but do not scale the font.
     Draw foreground pixels in paint-color, background pixels in bgPaint color."

    |pX pY|

    transformation notNil ifTrue:[
	pX := transformation applyToX:x.
	pY := transformation applyToY:y.
    ] ifFalse:[
	pX := x.
	pY := y.
    ].
    self displayDeviceOpaqueString:aString from:1 to:(aString size) in:font x:pX y:pY
!

displayUnscaledString:aString from:index1 to:index2 x:x y:y
    "draw a substring at the transformed coordinate x/y but do not scale the font.
     draw foreground-pixels only (in current paint-color), leaving background as-is."

    |pX pY|

    transformation notNil ifTrue:[
	pX := transformation applyToX:x.
	pY := transformation applyToY:y.
    ] ifFalse:[
	pX := x.
	pY := y.
    ].
    self displayDeviceString:aString from:index1 to:index2 in:font x:pX y:pY
!

displayUnscaledString:aString x:x y:y
    "draw a string at the transformed coordinate x/y but do not scale the font.
     draw foreground-pixels only (in current paint-color), leaving background as-is."

    |pX pY|

    transformation notNil ifTrue:[
	pX := transformation applyToX:x.
	pY := transformation applyToY:y.
    ] ifFalse:[
	pX := x.
	pY := y.
    ].
    self displayDeviceString:aString from:1 to:(aString size) in:font x:pX y:pY
! !

!DeviceDrawable methodsFor:'drawing in device coordinates'!

displayDeviceForm:aForm x:x y:y
    "draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
     current paint-color, leaving pixels with 0-bits unchanged
     (i.e. only 1-bits are drawn from the form).
     The form must have been allocated on the same device.
     No transformation or scaling is done.
     If its a deep form (i.e. a pixmap) the current paint
     settings are ignored and the form is drawn as-is. 
     Care must be taken, that the paint color is correctly allocated 
     (by sending #on: to the color) before doing so.
     Using functions other than #copy only makes sense if you are
     certain, that the colors are real colors (actually, only for
     noColor or allColor)."

    |id w h easy paintDither tmpForm 
     fgId noColor allColor allBits pX pY|

    w := aForm width.
    h := aForm height.

    pX := x rounded.
    pY := y rounded.

    id := aForm id.

    "temporary ..."
    (id isNil 
    or:[aForm device ~~ device]) ifTrue:[
	id := (aForm on:device) id.
	id isNil ifTrue:[
	    'DEVDRAW: invalid form draw - ignored' errorPrintNL.
	    ^ self
	].
    ].
    gcId isNil ifTrue:[
	self initGC
    ].

    "
     a deep form ignores paint/bgPaint settings
    "
    (aForm depth ~~ 1) ifTrue:[
	device
	    copyFromId:id
		     x:0 y:0
		    to:drawableId
		     x:pX y:pY 
		 width:w 
		height:h 
		  with:gcId.
	^ self
    ].

    "
     the following code is somewhat complicated, since it has to deal
     with dithered paint colors, which cannot be done directly on most
     devices (actually, a test for the devices capabilities has to be added here)
     (just assume drawing a bitmap with dithered paint color ... sigh)
    "

    "
     if paint is not a real color, we have to do it the hard way ...
    "
    easy := (function == #copy).
    easy ifTrue:[
	paint isColor ifFalse:[
	    paintDither := paint.
	    easy := false
	] ifTrue:[
	    paintDither := paint ditherForm.
	    paintDither notNil ifTrue:[
		easy := false.
	    ]
	].
    ].

    allColor := Color allColor.
    allBits := allColor colorId.

    easy ifTrue:[
	"
	 paint is a real color
	"

	"
	 if paint color is all-0 or all-1's, we can do it in one
	 operation ...
	"
	fgId := paint colorId.

	((fgId ~~ ((1 bitShift:device depth)-1))
	and:[fgId ~~ allBits]) ifTrue:[
	    "
	     clear fg-bits ...
	    "
	    device setForeground:0 background:allBits in:gcId.
	    device setFunction:#and in:gcId.
	    device
		copyPlaneFromId:id
			      x:0 y:0
			     to:drawableId
			      x:pX y:pY
			  width:w 
			 height:h 
			   with:gcId.
	].

	fgId ~~ 0 ifTrue:[
	    "
	     or-in fg-bits ...
	    "
	    device setForeground:fgId background:0 in:gcId.
	    device setFunction:#or in:gcId.
	    device
		copyPlaneFromId:id
			      x:0 y:0
			     to:drawableId
			      x:pX y:pY
			  width:w 
			 height:h 
			   with:gcId.
	].
	"
	 flush foreground/background cache
	"
	foreground := nil.
	background := nil.
	device setFunction:function in:gcId.
	^ self
    ].


    "
     hard case; paint is a dithered color
    "

    noColor := Color noColor.

    "
     create temp-form;
    "
    tmpForm := Form width:w height:h depth:device depth on:device.
    "
     fill tempform
    "
    tmpForm paint:paint.
    tmpForm fillRectangleX:0 y:0 width:w height:h.
    "
     stamp out background
    "
    tmpForm paint:allColor on:noColor.
    tmpForm function:#and.
    tmpForm displayOpaqueForm:aForm x:0 y:0.
    "
     stamp out foreground from destination
    "
    device setForeground:0 background:allBits in:gcId.
    device setFunction:#and in:gcId.
    device
	copyPlaneFromId:aForm id
		      x:0 y:0
		     to:drawableId
		      x:pX y:pY
		  width:w 
		 height:h 
		   with:gcId.
    "
     or-in temp into destination
    "
    device setForeground:allBits background:0 in:gcId.
    device setFunction:#or in:gcId.

    device
	copyFromId:tmpForm id
		 x:0 y:0
		to:drawableId
		 x:pX y:pY
	     width:w 
	    height:h 
	      with:gcId.
    "
     flush foreground/background cache
    "
    foreground := nil.
    background := nil.
    device setFunction:function in:gcId.
!

displayDeviceLineFromX:x0 y:y0 toX:x1 y:y1
    "draw a line (with current paint-color) in device coordinate space.
     This ignores any transformations. The coordinates must be integers."

    gcId isNil ifTrue:[
	self initGC
    ].
    device displayLineFromX:x0 y:y0 toX:x1 y:y1 in:drawableId with:gcId
!

displayDeviceOpaqueForm:aForm x:x y:y
    "draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
     current paint-color and 0-bits in the bgPaint color.
     If its a deep form (i.e. a pixmap) the current paint/bgPaint
     settings are ignored and the form drawn as-is. 
     In the 1-plane case, special care must be taken if paint and/or bgPaint 
     dithered colors or patterns, since are that the colors are correctly allocated (by sending #on:
     to the colors) before doing so.
     The form must have been allocated on the same device.
     Drawing is in device coordinates; no scaling is done."

    |id w h easy savedPaint bgForm fgForm tmpForm 
     fgId bgId noColor allColor allBits dx dy
     pX pY|

    bgPaint isNil ifTrue:[
	self displayDeviceForm:aForm x:x y:y.
	^ self
    ].

    w := aForm width.
    h := aForm height.

    pX := x rounded.
    pY := y rounded.

    id := aForm id.

    "temporary ..."
    (id isNil 
    or:[aForm device ~~ device]) ifTrue:[
	id := (aForm on:device) id.
	id isNil ifTrue:[
	    'DEVDRAW: invalid form draw - ignored' errorPrintNL.
	    ^ self
	].
    ].

    gcId isNil ifTrue:[
	self initGC
    ].

    "
     a deep form ignores paint/bgPaint settings
    "
    (aForm depth ~~ 1) ifTrue:[
	device
	    copyFromId:id
		     x:0 y:0
		    to:drawableId
		     x:pX y:pY 
		 width:w 
		height:h 
		  with:gcId.
	^ self
    ].

    "the following code is somewhat complicated, since it has to deal
     with dithered fg/bg colors, which cannot be done directly on most
     devices (actually, a test for the devices capabilities has to be added here)
     (just assume drawing a bitmap with dithered fg/bg colors ... sigh)
    "

    "
     if bgPaint or paint is not a real color, we have to do it the hard way ...
    "
    easy := true.
    paint isColor ifFalse:[
	easy := false
    ] ifTrue:[
	fgId := paint colorId.
	fgId isNil ifTrue:[
	    easy := false
	]
    ].
    bgPaint isColor ifFalse:[
	easy := false
    ] ifTrue:[
	bgId := bgPaint colorId.
	bgId isNil ifTrue:[
	    easy := false
	]
    ].

    easy ifTrue:[
	"
	 easy: both paint and bgPaint are real colors
	"
	((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
	    device setForeground:fgId background:bgId in:gcId.
	    foreground := paint.
	    background := bgPaint.
	].
	device
	    copyPlaneFromId:id
			  x:0 y:0
			 to:drawableId
			  x:pX y:pY 
		      width:w 
		     height:h 
		       with:gcId.
	^ self
    ].

    "
     hard case: paint and/or bgPaint are dithered or patterns
    "
    allColor := Color allColor.
    allBits := allColor colorId.

    (fgId notNil and:[function == #copy]) ifTrue:[
	"
	 only bg is dithered; fill with bg first ...
	"
	savedPaint := paint.
	self paint:bgPaint.
	self fillDeviceRectangleX:pX y:pY width:w height:h.
	self paint:savedPaint.

	"
	 if paint color is all-0 or all-1's, we can do it in one
	 operation ...
	"
	((fgId ~~ ((1 bitShift:device depth)-1))
	and:[fgId ~~ allBits]) ifTrue:[
	    "
	     clear fg-bits ...
	    "
	    device setForeground:0 background:allBits in:gcId.
	    device setFunction:#and in:gcId.
	    device
		copyPlaneFromId:id
			      x:0 y:0
			     to:drawableId
			      x:pX y:pY
			  width:w 
			 height:h 
			   with:gcId.
	].

	fgId ~~ 0 ifTrue:[
	    "
	     or-in fg-bits ...
	    "
	    device setForeground:fgId background:0 in:gcId.
	    device setFunction:#or in:gcId.
	    device
		copyPlaneFromId:id
			      x:0 y:0
			     to:drawableId
			      x:pX y:pY
			  width:w 
			 height:h 
			   with:gcId.
	].
	"
	 flush foreground/background cache
	"
	foreground := nil.
	background := nil.
	device setFunction:function in:gcId.
	^ self
    ].

    (bgId notNil and:[function == #copy]) ifTrue:[
	"
	 only fg is dithered; fill with fg first ...
	"
	self fillDeviceRectangleX:pX y:pY width:w height:h.

	"
	 if paint color is all-0 or all-1's, we can do it in one
	 operation ...
	"
	((bgId ~~ ((1 bitShift:device depth)-1))
	and:[bgId ~~ allBits]) ifTrue:[
	    "
	     clear bg-bits ...
	    "
	    device setForeground:allBits background:0 in:gcId.
	    device setFunction:#and in:gcId.
	    device
		copyPlaneFromId:id
			      x:0 y:0
			     to:drawableId
			      x:pX y:pY
			  width:w 
			 height:h 
			   with:gcId.
	].

	"
	 or-in bg-bits ...
	"
	bgId ~~ 0 ifTrue:[
	    device setForeground:0 background:bgId in:gcId.
	    device setFunction:#or in:gcId.
	    device
		copyPlaneFromId:id
			      x:0 y:0
			     to:drawableId
			      x:pX y:pY 
			  width:w 
			 height:h 
			   with:gcId.
	].
	"
	 flush foreground/background cache
	"
	foreground := nil.
	background := nil.
	device setFunction:function in:gcId.
	^ self
    ].

    "
     very hard case; both fg and bg are dithered colors
    "
    noColor := Color noColor.

    "
     create temp-forms;
    "
    bgForm := Form width:w height:h depth:device depth on:device.
    fgForm := Form width:w height:h depth:device depth on:device.
    tmpForm := Form width:w height:h depth:device depth on:device.

    "
     fill
    "
    dx := dy := 0.
    maskOrigin notNil ifTrue:[
	dx := maskOrigin x.
	dy := maskOrigin y
    ].

    bgForm paint:bgPaint.
    bgForm setMaskOriginX:(x negated + dx) y:(y negated + dy).
    bgForm fillRectangleX:0 y:0 width:w height:h.
    fgForm paint:paint.
    fgForm setMaskOriginX:(x negated + dx) y:(y negated + dy).
    fgForm fillRectangleX:0 y:0 width:w height:h.

    "
     stamp-out background
    "
    bgForm paint:noColor on:allColor.
    bgForm function:#and.
    bgForm displayOpaqueForm:aForm x:0 y:0.

    "
     stamp-out foreground
    "
    fgForm paint:allColor on:noColor.
    fgForm function:#and.
    fgForm displayOpaqueForm:aForm x:0 y:0.

    "
     clear tempform
    "
    tmpForm paint:noColor.
    tmpForm fillRectangleX:0 y:0 width:w height:h.

    "
     merge fg-temp and bg-temp into tmp
    "
    tmpForm function:#or.
    tmpForm paint:noColor on:allColor.
    tmpForm copyFrom:fgForm x:0 y:0 toX:0 y:0 width:w height:h.
    tmpForm copyFrom:bgForm x:0 y:0 toX:0 y:0 width:w height:h.

    "
     finally, draw it
    "
    device setForeground:0 background:allBits in:gcId.
    device
	copyFromId:tmpForm id
		 x:0 y:0
		to:drawableId
		 x:pX y:pY 
	     width:w 
	    height:h 
	      with:gcId.
    "
     flush foreground/background cache
    "
    foreground := nil.
    background := nil.
!

displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:x y:y
    "draw a substring at the coordinate x/y - draw foreground pixels in
     paint-color and background pixels in bgPaint-color.
     Assuming that device can only draw in device colors, we have to handle
     the case where paint and/or bgPaint are dithered colors.
     No translation or scaling is done."

    |easy w h savedPaint fgId bgId allColor allBits noColor
     id bgForm fgForm tmpForm maskForm dx dy pX pY fontUsed s|

    "
     if backgroundPaint color is nil, we assume
     this is a non-opaque draw
    "
    bgPaint isNil ifTrue:[
        self displayDeviceString:aString from:index1 to:index2 x:x y:y.
        ^ self
    ].

    (aString isString not
    or:[aString isText]) ifTrue:[
        "
         hook for non-strings (i.e. attributed text)
         that 'thing' should know how to display itself ...
        "
        aString displayOpaqueOn:self x:x y:y from:index1 to:index2.
        ^ self
    ].

    gcId isNil ifTrue:[
        self initGC
    ].

    pX := x rounded.
    pY := y rounded.

    fontUsed := font on:device.

    id := fontUsed fontId.
    id isNil ifTrue:[
        "
         hook for alien fonts
         that 'font' should know how to display the string ...
        "
        font displayOpaqueString:aString from:index1 to:index2 x:x y:y in:self.
        ^ self
    ].

    s := aString.
    s encoding ~~ font encoding ifTrue:[
        s := s encodeInto:(font encoding).
    ].

    deviceFont ~~ fontUsed ifTrue:[
        device setFont:id in:gcId.
        deviceFont := fontUsed
    ].

    "
     if bgPaint or paint is not a real Color, we have to do it the hard way ...
    "
    easy := true.
    paint isColor ifFalse:[
        easy := false
    ] ifTrue:[
        fgId := paint colorId.
        fgId isNil ifTrue:[
            easy := false
        ]
    ].
    bgPaint isColor ifFalse:[
        easy := false
    ] ifTrue:[
        bgId := bgPaint colorId.
        bgId isNil ifTrue:[
            easy := false
        ]
    ].

    easy ifTrue:[
        device setForeground:fgId background:bgId in:gcId.
        foreground := paint.
        background := bgPaint.
        device displayOpaqueString:s 
                              from:index1 to:index2
                                 x:pX y:pY 
                                in:drawableId with:gcId.
        ^ self
    ].

    w := fontUsed widthOf:s from:index1 to:index2.
    h := fontUsed height.

    (fgId notNil and:[function == #copy]) ifTrue:[
        "
         only bg is dithered; fill with bg first ...
        "
        savedPaint := paint.
        self paint:bgPaint.
        self fillRectangleX:pX y:(pY - fontUsed ascent) width:w height:h.
        self paint:savedPaint.

        "
         then draw using fgPaint (which is a real color)
        "
        device displayString:s 
                        from:index1 to:index2
                           x:pX y:pY 
                          in:drawableId with:gcId.
        ^ self
    ].

    allColor := Color allColor.
    allBits := allColor colorId.

    "
     the code below is correct, but some (all?) implementations of the
     X Window system seem to not support ALU-functions when drawing opaque strings.
     Therefore we use the slower code below.
    "

"/    (bgId notNil and:[function == #copy]) ifTrue:[
"/      "
"/       only fg is dithered; fill with fg first ...
"/      "
"/      self fillRectangleX:pX y:(pY - fontUsed ascent) width:w height:h.
"/
"/      "
"/       if bgPaint color is all-0 or all-1's, we can do it in one
"/       operation ...
"/      "
"/      ((bgId ~~ ((1 bitShift:device depth)-1))
"/      and:[bgId ~~ allBits]) ifTrue:[
"/          "
"/           clear bg bits ...
"/          "
"/          device setForeground:allBits background:0 in:gcId.
"/          device setFunction:#and in:gcId.
"/          device displayOpaqueString:s 
"/                                from:index1 to:index2
"/                                   x:pX y:pY 
"/                                  in:drawableId with:gcId.
"/      ].
"/
"/      "
"/       or-in bg bits ...
"/      "
"/      bgId ~~ 0 ifTrue:[
"/          device setForeground:0 background:bgId in:gcId.
"/          device setFunction:#or in:gcId.
"/          device displayOpaqueString:s 
"/                                from:index1 to:index2
"/                                   x:pX y:pY 
"/                                  in:drawableId with:gcId.
"/      ].
"/      "
"/       flush foreground/background cache
"/      "
"/      foreground := nil.
"/      background := nil.
"/      device setFunction:function in:gcId.
"/      ^ self
"/  ].

    "
     hard case, both fg and bg are dithered colors/images
    "
    noColor := Color noColor.

    "
     create temp-forms;
    "
    bgForm := Form width:w height:h depth:device depth on:device.
    fgForm := Form width:w height:h depth:device depth on:device.
    tmpForm := Form width:w height:h depth:device depth on:device.
    maskForm := Form width:w height:h depth:device depth on:device.

    "
     fill
    "
    dx := 0.
    dy := fontUsed ascent.
    maskOrigin notNil ifTrue:[
        dx := maskOrigin x.
        dy := dy + maskOrigin y
    ].

    bgForm paint:bgPaint.
    bgForm setMaskOriginX:(pX negated + dx) y:(pY negated + dy).
    bgForm fillRectangleX:0 y:0 width:w height:h.

    fgForm paint:paint.
    fgForm setMaskOriginX:(pX negated + dx) y:(pY negated + dy).
    fgForm fillRectangleX:0 y:0 width:w height:h.

    "
     stamp-out background (have now bg-bits with fg=0 in bgForm)
    "
    bgForm font:fontUsed.
    bgForm paint:noColor on:allColor.
    bgForm function:#and.
    bgForm displayString:s 
                    from:index1 to:index2 
                       x:0 y:fontUsed ascent.

    "
     stamp-out foreground
    "
    maskForm font:fontUsed.
    maskForm paint:allColor on:noColor.
    maskForm displayOpaqueString:s 
                            from:index1 to:index2 
                               x:0 y:fontUsed ascent.

    fgForm function:#and.
    fgForm copyFrom:maskForm x:0 y:0 toX:0 y:0 width:w height:h.

    "
     clear tempform
    "
    tmpForm paint:noColor.
    tmpForm fillRectangleX:0 y:0 width:w height:h.

    "
     merge fg-temp and bg-temp into tmp
    "
    tmpForm function:#or.
    tmpForm paint:noColor on:allColor.
    tmpForm copyFrom:fgForm x:0 y:0 toX:0 y:0 width:w height:h.
    tmpForm copyFrom:bgForm x:0 y:0 toX:0 y:0 width:w height:h.
    "
     finally, draw it
    "
    device setForeground:0 background:allBits in:gcId.
    device
        copyFromId:tmpForm id
                 x:0 y:0
                to:drawableId
                 x:pX y:pY-fontUsed ascent
             width:w
            height:h
              with:gcId.
    "
     flush foreground/background cache
    "
    foreground := nil.
    background := nil.

    "Modified: 12.5.1996 / 17:49:32 / cg"
!

displayDeviceOpaqueString:aString from:index1 to:index2 x:x y:y
    "draw a substring at the coordinate x/y - draw foreground pixels in
     paint-color and background pixels in bgPaint-color.
     Assuming that device can only draw in device colors, we have to handle
     the case where paint and/or bgPaint are dithered colors.
     No translation or scaling is done."

    self displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:x y:y
!

displayDeviceOpaqueString:aString x:x y:y
    "draw a string at the coordinate x/y - draw foreground pixels in
     paint-color and background pixels in bgPaint-color.
     No translation or scaling is done"

    self displayDeviceOpaqueString:aString from:1 to:(aString size) in:font x:x y:y
!

displayDeviceString:aString from:index1 to:index2 in:font x:x y:y
    "draw a substring at the coordinate x/y -  
     draw foreground-pixels only (in current paint-color), leaving background as-is.
     No translation or scaling is done"

    |id pX pY fontUsed s|

    "
     hook for non-strings (i.e. attributed text)
    "
    (aString isString not
    or:[aString isText]) ifTrue:[
        ^ aString displayOn:self x:x y:y from:index1 to:index2
    ].

    gcId isNil ifTrue:[
        self initGC
    ].

    pX := x rounded.
    pY := y rounded.

    fontUsed := font on:device.

    id := fontUsed fontId.
    id isNil ifTrue:[
        "hook for alien fonts"
        font displayString:aString from:index1 to:index2 x:x y:y in:self
    ] ifFalse:[
        s := aString.
        s encoding ~~ font encoding ifTrue:[
            s := s encodeInto:(font encoding).
        ].

        deviceFont ~~ fontUsed ifTrue:[
            device setFont:id in:gcId.
            deviceFont := fontUsed
        ].
        device displayString:s from:index1 to:index2
                           x:pX y:pY in:drawableId with:gcId
    ]

    "Modified: 12.5.1996 / 17:49:22 / cg"
!

displayDeviceString:aString from:index1 to:index2 x:x y:y
    "draw a substring at the coordinate x/y -  
     draw foreground-pixels only (in current paint-color), leaving background as-is.
     No translation or scaling is done"

    self displayDeviceString:aString from:index1 to:index2 in:font x:x y:y
!

displayDeviceString:aString x:x y:y
    "draw a string at the coordinate x/y -  
     draw foreground-pixels only (in current paint-color), leaving background as-is.
     No translation or scaling is done"

    self displayDeviceString:aString from:1 to:(aString size) in:font x:x y:y
!

fillDeviceRectangleX:x y:y width:w height:h
    "draw a filled rectangle in device coordinate space.
     This ignores any transformations. The coordinates must be integers."

    gcId isNil ifTrue:[
	self initGC
    ].
    device
	fillRectangleX:x 
		     y:y
		 width:w
		height:h
		    in:drawableId with:gcId
! !

!DeviceDrawable methodsFor:'evaluating in another context'!

reverseDo:aBlock
    "evaluate aBlock with foreground and background interchanged.
     This can be reimplemented here in a faster way."

    |oldFg oldBg|

    oldFg := foreground on:device.
    oldBg := background on:device.
    self foreground:background background:foreground.
    aBlock value.
    self foreground:oldFg background:oldBg
!

withBackground:fgColor do:aBlock
    "evaluate aBlock with changed background."

    |oldBg|

    oldBg := background.
    self background:fgColor.
    aBlock value.
    self background:oldBg
!

withForeground:fgColor background:bgColor do:aBlock
    "evaluate aBlock with changed foreground and background."

    |oldFg oldBg|

    oldFg := foreground.
    oldBg := background.
    self foreground:fgColor background:bgColor.
    aBlock value.
    self foreground:oldFg background:oldBg
!

withForeground:fgColor background:bgColor function:aFunction do:aBlock
    "evaluate aBlock with foreground, background and function"

    |oldFg oldBg oldFun|

    oldFg := foreground.
    oldBg := background.
    oldFun := function.
    self foreground:fgColor background:bgColor function:aFunction.
    aBlock value.
    self foreground:oldFg background:oldBg function:oldFun
!

withForeground:fgColor background:bgColor mask:aMask do:aBlock
    "evaluate aBlock with foreground, background and mask"

    |oldFg oldBg oldMask|

    oldFg := foreground.
    oldBg := background.
    oldMask := mask.
    self foreground:fgColor background:bgColor.
    self mask:aMask.
    aBlock value.
    self foreground:oldFg background:oldBg.
    self mask:oldMask
!

withForeground:fgColor do:aBlock
    "evaluate aBlock with changed foreground."

    |oldFg|

    oldFg := foreground.
    self foreground:fgColor.
    aBlock value.
    self foreground:oldFg
!

withForeground:fgColor function:aFunction do:aBlock
    "evaluate aBlock with changed foreground and function."

    |oldFg oldFun|

    oldFg := foreground.
    oldFun := function.
    self foreground:fgColor background:background function:aFunction.
    aBlock value.
    self foreground:oldFg background:background function:oldFun
!

xoring:aBlock
    "evaluate aBlock with function xoring"

    |fgPixel bgPixel oldFunction|

    fgPixel := (Black on:device) colorId.
    bgPixel := (White on:device) colorId.

    gcId isNil ifTrue:[
	self initGC
    ].
    oldFunction := function.
    device setForeground:(fgPixel bitXor:bgPixel)
	      background:bgPixel
		      in:gcId.
    device setFunction:#xor in:gcId.
    aBlock value.
    paint := nil.        "invalidate"
    foreground := Black.   
    background := White.
    device setForeground:fgPixel
	      background:bgPixel
		      in:gcId.
    device setFunction:oldFunction in:gcId.
    function := oldFunction
! !

!DeviceDrawable methodsFor:'filling'!

fillArcX:x y:y width:w height:h from:startAngle angle:angle
    "draw a filled arc; apply transformation if nonNil"

    |pX pY nW nH|

    gcId isNil ifTrue:[
        self initGC
    ].
    transformation notNil ifTrue:[
        pX := transformation applyToX:x.
        pY := transformation applyToY:y.
        nW := transformation applyScaleX:w.
        nH := transformation applyScaleY:h.
        nW < 0 ifTrue:[
              nW := nW abs.  
              pX := pX - nW.
        ].
        nH < 0 ifTrue:[
              nH := nH abs.  
              pY := pY - nH.
        ].
    ] ifFalse:[
        pX := x.
        pY := y.
        nW := w.
        nH := h.
    ].

    pX := pX rounded.
    pY := pY rounded.
    nW := nW rounded.
    nH := nH rounded.

    device
          fillArcX:pX 
                 y:pY 
             width:nW
            height:nH 
              from:startAngle
             angle:angle
                in:drawableId
              with:gcId

    "Created: 8.5.1996 / 08:29:45 / cg"
    "Modified: 8.5.1996 / 08:38:10 / cg"
!

fillPolygon:aPolygon
    "draw a filled polygon; apply transformation if nonNil"

    |newPolygon|

    gcId isNil ifTrue:[
	self initGC
    ].
    transformation notNil ifTrue:[
	newPolygon := aPolygon collect:[:point | transformation applyTo:point].
    ] ifFalse:[
	newPolygon := aPolygon
    ].
    (newPolygon findFirst:[:p | 
	(p isPoint not 
	or:[(p x class ~~ SmallInteger)
	or:[(p y class ~~ SmallInteger)]])
     ]) ~~ 0 ifTrue:[
	newPolygon := newPolygon collect:[:p | p asPoint rounded]
    ].
    device
	fillPolygon:newPolygon
		 in:drawableId
	       with:gcId
!

fillRectangleX:x y:y width:w height:h
    "draw a filled rectangle; apply transformation if nonNil"

    |pX pY nW nH|

    gcId isNil ifTrue:[
	self initGC
    ].
    transformation notNil ifTrue:[
	pX := transformation applyToX:x.
	pY := transformation applyToY:y.
	nW := transformation applyScaleX:w.
	nH := transformation applyScaleY:h.
	nW < 0 ifTrue:[
	      nW := nW abs.  
	      pX := pX - nW.
	].
	nH < 0 ifTrue:[
	      nH := nH abs.  
	      pY := pY - nH.
	].
    ] ifFalse:[
	pX := x.
	pY := y.
	nW := w.
	nH := h.
    ].
    pX := pX rounded.
    pY := pY rounded.
    nW := nW rounded.
    nH := nH rounded.

    device
	fillRectangleX:pX 
		     y:pY 
		 width:nW 
		height:nH 
		    in:drawableId with:gcId
! !

!DeviceDrawable methodsFor:'initialization'!

createGC
    "since we do not need a gc-object for the drawable until something is
     really drawn, none is created.
     This method is sent, when the first drawing happens"

    |fgId bgId p|

    gcId := device gcFor:drawableId.

    foreground isNil ifTrue:[foreground := Black].
    background isNil ifTrue:[background := White].

    foreground isColor ifTrue:[
	"get device colors from the device indep. colors"
	foreground := foreground on:device.
	fgId := foreground colorId.
	fgId isNil ifTrue:[
	    (foreground greyIntensity >= 50) ifTrue:[
		fgId := device whitepixel
	    ] ifFalse:[
		fgId := device blackpixel
	    ]
	].
    ] ifFalse:[
	fgId := device blackpixel.
    ].

    background isColor ifTrue:[
	background := background on:device.
	bgId := background colorId.
	bgId isNil ifTrue:[
	    (background greyIntensity >= 50) ifTrue:[
		bgId := device whitepixel
	    ] ifFalse:[
		bgId := device blackpixel
	    ]
	].
    ] ifFalse:[
	bgId := device whitepixel
    ].

    "now, this is something the device can work with ..."
    device setForeground:fgId background:bgId in:gcId.

    "switch to paint"
    p := paint.
    paint := nil.
    self paint:p.

    ((lineWidth ~~ 0) 
    or:[(lineStyle ~~ #solid) 
    or:[(capStyle ~~ #butt)
    or:[joinStyle ~~ #miter]]]) ifTrue:[
	device setLineWidth:lineWidth 
		      style:lineStyle
			cap:capStyle
		       join:joinStyle
			 in:gcId
    ].

    mask notNil ifTrue:[
	(mask depth == 1) ifTrue:[
	    device setBitmapMask:(mask id) in:gcId
	] ifFalse:[
	    device setPixmapMask:(mask id) in:gcId
	].
	maskOrigin notNil ifTrue:[
	    device setMaskOriginX:maskOrigin x y:maskOrigin y in:gcId
	]
    ].
    (function ~~ #copy) ifTrue:[device setFunction:function in:gcId].

    "defer the getting of a device font 
     - this is now done when the first drawstring occurs,
     since many views (layout-views) will never draw strings and
     therefore, the overhead of aquiring a font can be avoided.
    "

"
    font := font on:device.
    id := font fontId.
    id notNil ifTrue:[
	device setFont:id in:gcId
    ]
"
!

destroy
    "when the drawable is destroyed, the associated GC must be destroyed with it"

    gcId notNil ifTrue:[
	device destroyGC:gcId.
	gcId := nil.
	Lobby registerChange:self.
    ]
!

initGC
    "since we do not need a gc-object for the drawable until something is
     really drawn, none is created.
     This method is sent, when the first drawing happens"

    self createGC.
    Lobby registerChange:self.
!

initialize
    "setup everything for later use; actual work is done in
     initColors and initFont, which are usually redefined."

    "make certain Workstation is initialized - just a check - will vanish soon"
    Display isNil ifTrue:[
	'DEVDRAW: Display not initialized when first DeviceDrawable created' errorPrintNL.
	Workstation initialize
    ].

    super initialize.

    foreground := Black.
    background := White.

    realized := false
!

prepareForReinit
    "kludge - clear drawableId and gcId 
     needed after snapin"

    gcId := nil.
    drawableId := nil.
    deviceFont := nil
!

recreate
    "sent after a snapin, reinit draw stuff for new device"

    gcId := nil.
    foreground notNil ifTrue:[
	foreground := foreground on:device
    ].
    background notNil ifTrue:[
	background := background on:device
    ].
    paint notNil ifTrue:[
	paint := paint on:device
    ].
    bgPaint notNil ifTrue:[
	bgPaint := bgPaint on:device
    ]
!

reinitialize
    'reinit of ' errorPrint. self classNameWithArticle errorPrint.
    ' failed' errorPrintNL
!

setRealized:aBoolean
    "low level special interface to manipulate the realized state.
     Non-public interface, only to be used by experts.
     (use to pretend a view has been realized - for example with alien views)"

    realized := aBoolean

    "Modified: 24.4.1996 / 10:19:58 / cg"
! !

!DeviceDrawable methodsFor:'instance release'!

disposed
    "some Drawable has been collected 
     - must release operating system resources"

    ^ self subclassResponsibility
! !

!DeviceDrawable methodsFor:'private'!

setDevice:aDevice id:aDrawbleId gcId:aGCId
    "private"

    device := aDevice.
    gcId := aGCId.
    drawableId := aDrawbleId
!

setGCForPaint
    "private; given a complex color (i.e. a pixmap or dithered color,
     setup the GC to draw in this color.
     A helper for paint and paint:on:"

    |dither map pixelId p fg bg vOrg|

    gcId notNil ifTrue:[
        (p := paint) isColor ifTrue:[
            paint := p := p on:device.
            pixelId := p colorId.
            pixelId notNil ifTrue:[
                "
                 a real (undithered) color
                "
                mask notNil ifTrue:[
                    mask := nil.
                    device setBitmapMask:nil in:gcId
                ]. 
                (p ~~ foreground) ifTrue:[
                    foreground := paint.
                    device setForeground:pixelId in:gcId
                ].
                ^ self
            ].
            "a dithered color"
            dither := paint ditherForm.
        ] ifFalse:[
            "mhmh - seems to be some kind of form ..."
            paint := paint on:device.
            dither := paint
        ].
        "
         a dithered color or image
        "
        (dither depth == 1) ifTrue:[
            "a simple 0/1 bitmap"
            map := dither colorMap.
            "temporary (kludgy) fix for destroyed paint"
            p := paint.
            map isNil ifTrue:[
                fg := Color black.
                bg := Color white.
            ] ifFalse:[
                fg := map at:2.
                bg := map at:1.
            ].
            self foreground:fg background:bg.
            paint := p
        ] ifFalse:[
            (dither depth ~~ device depth) ifTrue:[
                dither := dither asFormOn:device.
                (dither isNil or:[dither depth ~~ device depth]) ifTrue:[
                    self error:'bad dither'.
                    ^ self
                ]
            ]
        ].
        self mask:dither.
        vOrg := self viewOrigin.
        self setMaskOriginX:vOrg x negated y:vOrg y negated.
    ]

    "Created: 16.5.1996 / 15:35:51 / cg"
    "Modified: 16.5.1996 / 15:37:31 / cg"
! !

!DeviceDrawable methodsFor:'queries'!

horizontalIntegerPixelPerMillimeter
    "return the (rounded) number of pixels per millimeter"

    ^ device horizontalPixelPerMillimeter rounded
!

horizontalPixelPerInch
    "return the number of horizontal pixels per inch of the display"

    ^ device horizontalPixelPerMillimeter * 25.4
!

horizontalPixelPerMillimeter
    "return the number of pixels per millimeter (not rounded)"

    ^ device horizontalPixelPerMillimeter
!

horizontalPixelPerMillimeter:millis
    "return the number of pixels (not rounded) for millis millimeter"

    ^ device horizontalPixelPerMillimeter * millis
!

realized
    "return true, if the receiver is realized"

    ^ realized

    "Created: 24.4.1996 / 10:16:15 / cg"
!

verticalIntegerPixelPerMillimeter
    "return the (rounded) number of pixels per millimeter"

    ^ device verticalPixelPerMillimeter rounded
!

verticalPixelPerInch
    "return the number of vertical pixels per inch of the display"

    ^ device verticalPixelPerMillimeter * 25.4
!

verticalPixelPerMillimeter
    "return the number of pixels per millimeter (not rounded)"

    ^ device verticalPixelPerMillimeter
!

verticalPixelPerMillimeter:millis
    "return the number of pixels (not rounded) for millis millimeter"

    ^ device verticalPixelPerMillimeter * millis
! !

!DeviceDrawable class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.54 1996-05-28 14:35:39 cg Exp $'
! !
DeviceDrawable initialize!