Merge jv
authorJan Vrany <jan.vrany@fit.cvut.cz>
Mon, 16 Nov 2015 13:35:11 +0000
branchjv
changeset 7071 4939fcb844d6
parent 7053 e44485fe1869 (current diff)
parent 7068 ec3a9fc47076 (diff)
child 7072 2757f8f81f72
Merge
DeviceGraphicsContext.st
DisplaySurface.st
XftFontDescription.st
--- a/DeviceGraphicsContext.st	Thu Oct 29 06:54:23 2015 +0000
+++ b/DeviceGraphicsContext.st	Mon Nov 16 13:35:11 2015 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
 "
  COPYRIGHT (c) 1992 by Claus Gittinger
 	      All Rights Reserved
@@ -177,17 +175,17 @@
     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.
+        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].
 !
 
@@ -562,11 +560,39 @@
 !
 
 deviceClippingRectangle
-    <resource: #obsolete>
-    "get the clipping rectangle for drawing (in device coordinates);
-     a nil clipping rectangle means: no clipping (i.e. whole view is drawable - incl. margins)"
-
-    ^ clipRect
+    "answer the clipping rectangle for drawing in device coordinates, or nil."
+
+    |x y w h transformedRectangle|
+
+    (clipRect isNil or:[transformation isNil]) ifTrue:[
+        ^ clipRect.
+    ].
+
+    transformedRectangle := transformation transformRectangle:clipRect.
+
+    x := transformedRectangle left.
+    y := transformedRectangle top.
+    w := transformedRectangle width + 1.
+    h := transformedRectangle height + 1.
+
+    (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 ceiling.
+    ].
+    (h class == SmallInteger) ifFalse:[
+        h := h ceiling.
+    ].
+    w := w max:0.
+    h := h max:0.
+
+    ^ Rectangle left:x top:y width:w height:h
 !
 
 deviceClippingRectangle:aRectangleOrNil
@@ -1686,13 +1712,13 @@
      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."
 
-    (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
+    aString isPlainString ifFalse:[
+        "
+         hook for non-strings (i.e. attributed text)
+         that 'thing' should know how to display itself ...
+        "
+        aString displayOpaqueOn:self x:x y:y.
+        ^ self
     ].
 
     self displayOpaqueString:aString from:1 to:(aString size) x:x y:y
@@ -2969,7 +2995,7 @@
     "Modified: 22.4.1997 / 21:44:10 / cg"
 !
 
-displayDeviceOpaqueString:aStringArg from:index1 to:index2 in:font x:x y:y
+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
@@ -2977,7 +3003,7 @@
      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 aString
+     id bgForm fgForm tmpForm maskForm dx dy pX pY fontUsed s
      deviceDepth fontsEncoding ascent|
 
     "
@@ -2985,34 +3011,22 @@
      this is a non-opaque draw
     "
     bgPaint isNil ifTrue:[
-        self displayDeviceString:aStringArg from:index1 to:index2 x:x y:y.
+        self displayDeviceString:aString from:index1 to:index2 x:x y:y.
         ^ self
     ].
 
-    (aStringArg isString not or:[aStringArg isText]) ifTrue:[
+    aString isPlainString ifFalse:[
         "
          hook for non-strings (i.e. attributed text)
          that 'thing' should know how to display itself ...
         "
-        aStringArg displayOpaqueOn:self x:x y:y from:index1 to:index2.
+        aString displayOpaqueOn:self x:x y:y from:index1 to:index2.
         ^ self
     ].
 
     pX := x rounded.
     pY := y rounded.
 
-    aString := aStringArg.
-    fontsEncoding := font encoding.
-    (characterEncoding ~~ fontsEncoding) ifTrue:[
-        [
-            aString := CharacterEncoder encodeString:aString from:characterEncoding into:fontsEncoding.
-        ] on:CharacterEncoderError do:[:ex|
-            "substitute a default value for codes that cannot be represented
-             in the new character set"
-            ex proceedWith:ex defaultValue.
-        ].
-    ].
-
     font isAlienFont ifTrue:[
         "
          hook for alien fonts
@@ -3026,7 +3040,20 @@
         self initGC
     ].
 
+
+    s := aString.
     fontUsed := font onDevice:device.
+    fontsEncoding := fontUsed encoding.
+    (characterEncoding ~~ fontsEncoding) ifTrue:[
+        [
+            s := CharacterEncoder encodeString:s from:characterEncoding into:fontsEncoding.
+        ] on:CharacterEncoderError do:[:ex|
+            "substitute a default value for codes that cannot be represented
+             in the new character set"
+            ex proceedWith:ex defaultValue.
+        ].
+    ].
+
     id := fontUsed fontId.
     id isNil ifTrue:[
         "this should not happen, since #onDevice tries replacement fonts"
@@ -3064,11 +3091,11 @@
         device setForeground:fgId background:bgId in:gcId.
         foreground := paint.
         background := bgPaint.
-        device displayOpaqueString:aString from:index1 to:index2 x:pX y:pY in:drawableId with:gcId.
+        device displayOpaqueString:s from:index1 to:index2 x:pX y:pY in:drawableId with:gcId.
         ^ self
     ].
 
-    w := fontUsed widthOf:aString from:index1 to:index2.
+    w := fontUsed widthOf:s from:index1 to:index2.
     h := fontUsed height.
     ascent := fontUsed ascent.
 
@@ -3084,7 +3111,7 @@
         "
          then draw using fgPaint (which is a real color)
         "
-        device displayString:aString from:index1 to:index2 x:pX y:pY in:drawableId with:gcId.
+        device displayString:s from:index1 to:index2 x:pX y:pY in:drawableId with:gcId.
         ^ self
     ].
 
@@ -3161,7 +3188,7 @@
             ].
         ].
 
-        device displayString:aString from:index1 to:index2 x:pX y:pY in:drawableId with:gcId.
+        device displayString:s from:index1 to:index2 x:pX y:pY in:drawableId with:gcId.
         ^ self.
     ].
 
@@ -3202,14 +3229,14 @@
     bgForm font:fontUsed.
     bgForm paint:noColor on:allColor.
     bgForm function:#and.
-    bgForm displayString:aString from:index1 to:index2 x:0 y:ascent.
+    bgForm displayString:s from:index1 to:index2 x:0 y:ascent.
 
     "
      stamp-out foreground
     "
     maskForm font:fontUsed.
     maskForm paint:allColor on:noColor.
-    maskForm displayOpaqueString:aString from:index1 to:index2 x:0 y:ascent.
+    maskForm displayOpaqueString:s from:index1 to:index2 x:0 y:ascent.
 
     fgForm function:#and.
     fgForm copyFrom:maskForm x:0 y:0 toX:0 y:0 width:w height:h.
@@ -3275,32 +3302,42 @@
     self displayDeviceOpaqueString:aString from:1 to:(aString size) in:font x:x y:y
 !
 
-displayDeviceString:aStringArg from:index1 to:index2 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 aString fontsEncoding|
+    |id pX pY fontUsed s fontsEncoding|
 
     "
      hook for non-strings (i.e. attributed text)
     "
-    (aStringArg isString not or:[aStringArg isText]) ifTrue:[
-        ^ aStringArg displayOn:self x:x y:y from:index1 to:index2
+    aString isPlainString ifFalse:[
+        ^ aString displayOn:self x:x y:y from:index1 to:index2
     ].
 
     pX := x rounded.
     pY := y rounded.
 
+    font isAlienFont ifTrue:[
+        "
+         hook for alien fonts
+         that 'font' should know how to display the string ...
+        "
+        font displayOpaqueString:aString from:index1 to:index2 x:pX y:pY in:self.
+        ^ self
+    ].
+
     gcId isNil ifTrue:[
         self initGC
     ].
 
-    aString := aStringArg.
-    fontsEncoding := font encoding.
+    s := aString.
+    fontUsed := font onDevice:device.
+    fontsEncoding := fontUsed encoding.
     (characterEncoding ~~ fontsEncoding) ifTrue:[
         [
-            aString := CharacterEncoder encodeString:aString from:characterEncoding into:fontsEncoding.
+            s := CharacterEncoder encodeString:s from:characterEncoding into:fontsEncoding.
         ] on:CharacterEncoderError do:[:ex|
             "substitute a default value for codes that cannot be represented
              in the new character set"
@@ -3308,16 +3345,6 @@
         ].
     ].
 
-    font isAlienFont ifTrue:[
-        "
-         hook for alien fonts
-         that 'font' should know how to display the string ...
-        "
-        font displayString:aString from:index1 to:index2 x:pX y:pY in:self.
-        ^ self
-    ].
-
-    fontUsed := font onDevice:device.
     id := fontUsed fontId.
     id isNil ifTrue:[
         "this should not happen, since #onDevice tries replacement fonts"
@@ -3328,7 +3355,7 @@
             device setFont:id in:gcId.
             deviceFont := fontUsed
         ].
-        device displayString:aString from:index1 to:index2 x:pX y:pY in:drawableId with:gcId
+        device displayString:s from:index1 to:index2 x:pX y:pY in:drawableId with:gcId
     ]
 
     "Modified: 1.7.1997 / 17:08:48 / cg"
@@ -4276,4 +4303,5 @@
     ^ '$Header$'
 ! !
 
+
 DeviceGraphicsContext initialize!
--- a/DisplaySurface.st	Thu Oct 29 06:54:23 2015 +0000
+++ b/DisplaySurface.st	Mon Nov 16 13:35:11 2015 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
 "
  COPYRIGHT (c) 1992 by Claus Gittinger
 	      All Rights Reserved
@@ -864,10 +862,6 @@
     flags := flags bitOr:GotExposeFlagMask.
 ! !
 
-!DisplaySurface methodsFor:'binary storage'!
-
- !
-
 !DisplaySurface methodsFor:'button menus'!
 
 getMiddleButtonMenu
@@ -1067,27 +1061,25 @@
      redefined since GraphicsMedium fills with background
      - not viewBackground as we want here."
 
-    |pX pY nW nH pO pC currentTransformation |
-
-    currentTransformation := gc transformation.
-    currentTransformation notNil ifTrue:[
-	pO := currentTransformation transformPoint:x@y.
-	pC := currentTransformation transformPoint:(x+w-1)@(y+h-1).
-	pX := pO x.
-	pY := pO y.
-	nW := pC x - pX + 1.
-	nH := pC y - pY + 1.
+    |pX pY nW nH rect transformation |
+    transformation := gc transformation.
+    transformation notNil ifTrue:[
+        rect := transformation transformRectangle:(Rectangle left:x top:y width:w height:h).
+        pX := rect left.
+        pY := rect top.
+        nW := rect width.
+        nH := rect height.
     ] ifFalse:[
-	pX := x.
-	pY := y.
-	nW := w.
-	nH := h.
+        pX := x.
+        pY := y.
+        nW := w.
+        nH := h.
     ].
 
     pX := pX rounded.
     pY := pY rounded.
-    nW := nW rounded.
-    nH := nH rounded.
+    nW := nW ceiling.
+    nH := nH ceiling.
 
     ^ self clearDeviceRectangleX:pX y:pY width:nW height:nH.
 
@@ -1128,8 +1120,7 @@
     pW := aPixmap width.
     pH := aPixmap height.
 
-    oldClip := self clippingRectangleOrNil.
-
+    oldClip := self deviceClippingRectangle.
     oldClip notNil ifTrue:[
 	x := x max:oldClip left.
 	y := y max:oldClip top.
@@ -1161,7 +1152,7 @@
 	].
 	self foreground:fg background:bg.
     ].
-    self deviceClippingRectangle:(x@y extent:w@h).
+    self deviceClippingRectangle:(Rectangle left:x top:y width:w height:h).
 
     offsX := (xR0 + pattOffs x) \\ pW.
     offsY := (yR + pattOffs y) \\ pH.
@@ -2524,11 +2515,11 @@
 !DisplaySurface class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/DisplaySurface.st,v 1.171 2015-03-19 11:43:06 cg Exp $'
+    ^ '$Header$'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libview/DisplaySurface.st,v 1.171 2015-03-19 11:43:06 cg Exp $'
+    ^ '$Header$'
 ! !
 
 
--- a/ScaleTransform.st	Thu Oct 29 06:54:23 2015 +0000
+++ b/ScaleTransform.st	Mon Nov 16 13:35:11 2015 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "{ Package: 'stx:libview' }"
 
 "{ NameSpace: Smalltalk }"
@@ -203,6 +205,15 @@
         ^ p
     ].
     ^ p * scale
+!
+
+transformRectangle:aRectangle 
+    "Apply the receiver to a rectangle, returning a new rectangle."
+
+    scale isNil ifTrue:[
+        ^ aRectangle.
+    ].
+    ^ aRectangle scaledBy:scale.
 ! !
 
 !ScaleTransform methodsFor:'printing & storing'!
@@ -308,10 +319,10 @@
 !ScaleTransform class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/ScaleTransform.st,v 1.3 2015-01-22 14:23:48 cg Exp $'
+    ^ '$Header$'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libview/ScaleTransform.st,v 1.3 2015-01-22 14:23:48 cg Exp $'
+    ^ '$Header$'
 ! !
 
--- a/TranslationTransform.st	Thu Oct 29 06:54:23 2015 +0000
+++ b/TranslationTransform.st	Mon Nov 16 13:35:11 2015 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1992 by Claus Gittinger
 	      All Rights Reserved
@@ -11,6 +13,8 @@
 "
 "{ Package: 'stx:libview' }"
 
+"{ NameSpace: Smalltalk }"
+
 DisplayTransform variableFloatSubclass:#TranslationTransform
 	instanceVariableNames:'translation'
 	classVariableNames:''
@@ -292,6 +296,15 @@
         ^ p
     ].
     ^ p + translation
+!
+
+transformRectangle:aRectangle 
+    "Apply the receiver to a rectangle, returning a new rectangle."
+
+    translation isNil ifTrue:[
+        ^ aRectangle.
+    ].
+    ^ aRectangle translatedBy:translation.
 ! !
 
 !TranslationTransform methodsFor:'printing & storing'!
@@ -308,12 +321,12 @@
 !TranslationTransform methodsFor:'private'!
 
 inverseTranslation
-    "return with a Point representing the inverse of my translation."
+    "return with a Point or Number representing the inverse of my translation."
 
-    |trans|
-
-    trans := translation asPoint.
-    ^ Point x:(trans x negated) y:trans y negated
+    translation isNil ifTrue:[
+        ^ nil.
+    ].
+    ^ translation negated.
 ! !
 
 !TranslationTransform methodsFor:'testing'!
@@ -376,10 +389,10 @@
 !TranslationTransform class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/TranslationTransform.st,v 1.1 2014-12-21 22:24:09 cg Exp $'
+    ^ '$Header$'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libview/TranslationTransform.st,v 1.1 2014-12-21 22:24:09 cg Exp $'
+    ^ '$Header$'
 ! !
 
--- a/WindowingTransformation.st	Thu Oct 29 06:54:23 2015 +0000
+++ b/WindowingTransformation.st	Mon Nov 16 13:35:11 2015 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1992 by Claus Gittinger
 	      All Rights Reserved
@@ -513,19 +515,10 @@
     ^ (p * scale + translation)
 !
 
-transformRectangle:rect 
-    "Apply the receiver to a point, returning a new point."
+transformRectangle:aRectangle 
+    "Apply the receiver to a rectangle, returning a new rectangle."
 
-    scale isNil ifTrue:[
-        translation isNil ifTrue:[
-            ^ rect.
-        ].
-        ^ rect + translation
-    ].
-    translation isNil ifTrue:[
-        ^ rect scaledBy: scale
-    ].
-    ^ (rect scaledBy: scale) + translation
+    ^ aRectangle scaledBy:scale translatedBy:translation.
 ! !
 
 !WindowingTransformation methodsFor:'printing & storing'!
@@ -544,13 +537,13 @@
 !WindowingTransformation methodsFor:'private'!
 
 inverseTranslation
-    "return with a Point representing the inverse of my
+    "return with a Point or Number representing the inverse of my
      translation."
 
-    |trans|
-
-    trans := translation asPoint.
-    ^ Point x:(trans x negated) y:(trans y negated)
+    translation isNil ifTrue:[
+        ^ nil.
+    ].
+    ^ translation negated.
 ! !
 
 !WindowingTransformation methodsFor:'testing'!
--- a/XftFontDescription.st	Thu Oct 29 06:54:23 2015 +0000
+++ b/XftFontDescription.st	Mon Nov 16 13:35:11 2015 +0000
@@ -613,7 +613,7 @@
     "display a partial string at some position in aGC."
     
     |index2 bytesPerCharacter transformation
-     clipOrg clipCorn clipRect clipCX clipCY clipX clipY clipW clipH clipPnt
+     clipOrg clipCorn clipRect clipX clipY clipW clipH clipPnt
      fg fgR fgG fgB fgA fgPixel bg bgR bgG bgB bgA bgPixel
      drawX drawY drawPnt displayId screen drawableId error stringLen drawId drawIdIsShared
      newXftDrawId newDrawableAssociation|
@@ -627,30 +627,16 @@
         index2 := index2Arg.
     ].
     bytesPerCharacter := aString bitsPerCharacter // 8.
-    transformation := aGC transformation.
 
-    clipRect := aGC deviceClippingBoundsOrNil.
+    clipRect := aGC deviceClippingRectangle.
     clipRect notNil ifTrue:[
         clipX := clipRect left.
         clipY := clipRect top.
-        clipCX := clipRect right.
-        clipCY := clipRect bottom.
-        "/ YES YES YES: this MUST be transformed!!
-        "/ (see htmlView) fix the notebook, please.
-        transformation notNil ifTrue:[
-            clipOrg := transformation transformPoint:(clipRect origin).
-            clipCorn := transformation transformPoint:(clipRect corner).
-            clipX := clipOrg x ceiling.
-            clipY := clipOrg y ceiling.
-            clipCX := clipCorn x ceiling.
-            clipCY := clipCorn y ceiling.
-"/            clipX := (transformation applyToX:clipPnt x) ceiling.
-"/            clipY := (transformation applyToY:clipY) ceiling.
-        ].
-        clipW := clipCX-clipX.
-        clipH := clipCY-clipY.
+        clipW := clipRect width.
+        clipH := clipRect height.
     ].
 
+    transformation := aGC transformation.
     transformation isNil ifTrue:[
         drawX := xArg.
         drawY := yArg.
@@ -658,21 +644,18 @@
         drawPnt := transformation transformPoint:(xArg @ yArg).
         drawX := drawPnt x ceiling.
         drawY := drawPnt y ceiling.
-"/        drawX := (transformation applyToX:xArg) ceiling.
-"/        drawY := (transformation applyToY:yArg) ceiling.
     ].
 
-    fg  :=  aGC paint.
-    fgPixel := fg colorId.
-    "/ fgPixel notNil ifTrue:[
-        fgR := fg scaledRed.
-        fgG := fg scaledGreen.
-        fgB := fg scaledBlue.
-        fgA := (fg alpha * 65535) rounded.
-    "/].
+    fg  := aGC paint.
+    fgR := fg scaledRed.
+    fgG := fg scaledGreen.
+    fgB := fg scaledBlue.
+    fgA := fg scaledAlpha.
+
     fgR isNil ifTrue:[
         "/ when drawing into a pixmap...
-        fg colorId == 0 ifTrue:[
+        fgPixel := fg colorId.
+        fgPixel == 0 ifTrue:[
             fgR := fgG := fgB := 0.
         ] ifFalse:[
             fgR := fgG := fgB := 16rFFFF.
@@ -680,15 +663,12 @@
     ].
 
     opaque ifTrue:[
-        bg  := aGC backgroundPaint.
+        bg := aGC backgroundPaint.
         bg isColor ifTrue:[
-            bgPixel := bg colorId.
-            "/bgPixel notNil ifTrue:[
-                bgR := bg scaledRed.
-                bgG := bg scaledGreen.
-                bgB := bg scaledBlue.
-                bgA := (bg alpha * 65535) rounded.
-            "/].
+            bgR := bg scaledRed.
+            bgG := bg scaledGreen.
+            bgB := bg scaledBlue.
+            bgA := bg scaledAlpha.
         ] ifFalse:[
             "images are not yet implemented"
             "/ #todo: fill background rectangle
@@ -696,7 +676,8 @@
         ].
         bgR isNil ifTrue:[
             "/ when drawing into a pixmap...
-            bg colorId == 0 ifTrue:[
+            bgPixel := bg colorId.
+            bgPixel == 0 ifTrue:[
                 bgR := bgG := bgB := 0.
             ] ifFalse:[
                 bgR := bgG := bgB := 16rFFFF.
@@ -785,12 +766,11 @@
         if (bgPixel != nil) {
             color.pixel = (unsigned long)__intVal(bgPixel);
         }
-        // else {
-            color.color.red = __intVal(bgR);
-            color.color.green = __intVal(bgG);
-            color.color.blue = __intVal(bgB);
-            color.color.alpha = __intVal(bgA);
-        // }
+        color.color.red = __intVal(bgR);
+        color.color.green = __intVal(bgG);
+        color.color.blue = __intVal(bgB);
+        color.color.alpha = __intVal(bgA);
+
         switch (__bytesPerCharacter) {
         case 1:
             XftTextExtents8(DISPLAY(displayId), __xftFont, (FcChar8*)string, len, &extents);
@@ -807,12 +787,11 @@
     if (fgPixel != nil) {
         color.pixel = (unsigned long)__intVal(fgPixel);
     }
-    // else {
-        color.color.red = __intVal(fgR);
-        color.color.green = __intVal(fgG);
-        color.color.blue = __intVal(fgB);
-        color.color.alpha = __intVal(fgA);
-    // }
+    color.color.red = __intVal(fgR);
+    color.color.green = __intVal(fgG);
+    color.color.blue = __intVal(fgB);
+    color.color.alpha = __intVal(fgA);
+
     switch (__bytesPerCharacter) {
     case 1:
         XftDrawString8(__sharedDrawId, &color,__xftFont,
@@ -1989,7 +1968,10 @@
     "I am no longer available on the device"
 
     Lobby unregister:self.
-    self xftDrawDestroy.
+    "/ cg: no, xftDrawDestroy should not be done.
+    "/ (releaseFromDevice is called when either the display connection
+    "/ is lost, or a snapshot image is restarted)
+    "/ self xftDrawDestroy.
 
     device := nil.
     fontId := nil.