DeviceGraphicsContext.st
changeset 5360 878079de94f0
parent 5242 b81bdd05900f
child 5361 da9562a37595
--- a/DeviceGraphicsContext.st	Tue Oct 06 09:55:56 2009 +0200
+++ b/DeviceGraphicsContext.st	Wed Oct 07 20:28:49 2009 +0200
@@ -1516,135 +1516,7 @@
      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 fontsEncoding 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 onDevice: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.
-    fontUsed := fontUsed 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.
-        ].
-    ].
-
-    "
-     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
-        ]
-    ].
-
-    deviceFont ~~ fontUsed ifTrue:[
-        device setFont:id in:gcId.
-        deviceFont := fontUsed
-    ].
-
-    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 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
-    ].
-
-    "/ the very hard case (fg-dither)
-
-    self displayDeviceOpaqueString:s from:index1 to:index2 in:fontUsed x:pX y:pY.
-
-    "Modified: 30.6.1997 / 15:06:15 / cg"
+    self displayString:aString from:index1 to:index2 x:x y:y opaque:true
 !
 
 displayOpaqueString:aString x:x y:y
@@ -1654,19 +1526,7 @@
      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 fontsEncoding 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:[
+    (aString isString not or:[aString isText]) ifTrue:[
         "
          hook for non-strings (i.e. attributed text)
          that 'thing' should know how to display itself ...
@@ -1675,92 +1535,7 @@
         ^ 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.
-
-    s := aString.
-    fontUsed := fontUsed 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:[
-        "
-         hook for alien fonts
-         that 'font' should know how to display the string ...
-        "
-        fontUsed displayOpaqueString:s from:1 to:(s size) x:x y:y in:self.
-    ] ifFalse:[
-        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: 30.6.1997 / 15:06:17 / cg"
+    self displayOpaqueString:aString from:1 to:(aString size) x:x y:y
 !
 
 displayPointX:x y:y
@@ -1897,12 +1672,39 @@
      leaving background as-is. If the transformation involves scaling,
      the fonts point-size is scaled as appropriate."
 
-    |id pX pY fontUsed sz s fontsEncoding|
-
-    "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
+    self displayString:aString from:index1 to:index2 x:x y:y opaque:false
+!
+
+displayString:aString from:index1Arg to:index2Arg x:x y:y opaque:opaqueArg
+    "draw a substring at the coordinate x/y - draw foreground pixels in
+     paint-color and (if opaque is true), background pixels in bgPaint-color.
+     If the transformation involves scaling, the font's 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"
+
+    |opaque index1 index2 easy w h savedPaint fgId bgId
+     id pX pY fontUsed fontsEncoding sz s
+     nSkipLeft nChars wString wSkipLeft wMax|
+
+    index1 := index1Arg.
+    index2 := index2Arg.
+    opaque := opaqueArg.
+
+    "
+     if backgroundPaint color is nil, we assume
+     this is a non-opaque draw
+    "
+    bgPaint isNil ifTrue:[
+        opaque := false.
+    ].
+
+    (aString isString not or:[aString isText]) ifTrue:[
+        "
+         hook for non-strings (i.e. attributed text)
+         that 'thing' should know how to display itself ...
+        "
+        aString displayOn:self x:x y:y from:index1 to:index2 opaque:opaque.
+        ^ self
     ].
 
     gcId isNil ifTrue:[
@@ -1929,8 +1731,10 @@
     pX := pX rounded.
     pY := pY rounded.
 
+    fontUsed := fontUsed onDevice:device.
+
+    "/ transcode the string into the fonts encoding...
     s := aString.
-    fontUsed := fontUsed onDevice:device.
     fontsEncoding := fontUsed encoding.
     (characterEncoding ~~ fontsEncoding) ifTrue:[
         [
@@ -1944,17 +1748,109 @@
 
     id := fontUsed fontId.
     id isNil ifTrue:[
-        "hook for alien fonts"
-        font displayString:s from:index1 to:index2 x:x y:y in:self.
-    ] ifFalse:[
-        deviceFont ~~ fontUsed ifTrue:[
-            device setFont:id in:gcId.
-            deviceFont := fontUsed
+        "
+         hook for alien fonts
+         that 'font' should know how to display the string...
+        "
+        fontUsed displayString:aString from:index1 to:index2 x:x y:y in:self opaque:opaque.
+        ^ self
+    ].
+
+    "
+     if bgPaint or paint is not a real Color (aka a pattern), we have to do it the hard way ...
+    "
+    easy := true.
+    paint isColor ifFalse:[
+        easy := false
+    ] ifTrue:[
+        fgId := paint colorId.
+        fgId isNil ifTrue:[
+            easy := false
+        ]
+    ].
+    opaque ifTrue:[
+        bgPaint isColor ifFalse:[
+            easy := false
+        ] ifTrue:[
+            bgId := bgPaint colorId.
+            bgId isNil ifTrue:[
+                easy := false
+            ]
         ].
-        device displayString:s from:index1 to:index2 x:pX y:pY in:drawableId with:gcId
+    ].
+
+    deviceFont ~~ fontUsed ifTrue:[
+        device setFont:id in:gcId.
+        deviceFont := fontUsed
     ].
 
-    "Modified: 1.7.1997 / 17:08:44 / cg"
+    "/ check if this string is too long and cut it into a managable size.
+    "/ this is due to win32 limitations which seems to be unable to handle strings
+    "/ which are drawn longer than 32k pixels.
+    (index2 - index1) > 500 ifTrue:[
+        nSkipLeft := wSkipLeft := 0.
+        wMax := self width.
+
+        "/ if the draw starts to the left of the window start,
+        "/ skip some characters at the beginning...
+        pX < 0 ifTrue:[
+"/ ('x=%d wMax=%d l=%d i1=%d i2=%d' printfWith:x with:wMax with:aString size with:index1 with:index2) printCR.
+            nSkipLeft := x negated // font width.                                       "/ estimate
+            wSkipLeft := fontUsed widthOf:aString from:index1 to:index1+nSkipLeft-1.    "/ actual number of pixels
+            [ ((pX+wSkipLeft) > 0) and:[nSkipLeft > 0]] whileTrue:[                      "/ too many
+                nSkipLeft := (nSkipLeft * 0.9) rounded.
+                wSkipLeft := fontUsed widthOf:aString from:index1 to:index1+nSkipLeft-1.
+            ].
+            index1 := index1+nSkipLeft.
+            pX := pX + wSkipLeft.
+"/ ('skip %d w=%d x=%d' printfWith:nSkipLeft with:wSkipLeft with:x) printCR.
+        ].
+
+        "/ if the draw ends to the right of the window ends,
+        "/ skip some characters at the end...
+        nChars := wMax // font width + 2.                                       "/ estimate
+        wString := fontUsed widthOf:aString from:index1 to:index1+nChars-1.     "/ actual number of pixels
+"/ ('n=%d w=%d' printfWith:nChars with:wString) printCR.
+        [ ((pX+wString) < wMax) and:[ (index1+nChars-1) <= aString size] ] whileTrue:[  "/ not enough...       
+            nChars := (nChars * 1.1) rounded.
+            wString := fontUsed widthOf:aString from:index1 to:index1+nChars-1. 
+        ].
+"/ ('n=%d w=%d' printfWith:nChars with:wString) printCR.
+        index2 := (index1+nChars-1) min:aString size.
+    ].
+
+    easy ifTrue:[
+        device setForeground:fgId background:bgId in:gcId.
+        foreground := paint.
+        background := bgPaint.
+        device displayString:s from:index1 to:index2 x:pX y:pY in:drawableId with:gcId opaque:opaque.
+        ^ self
+    ].
+
+    w := fontUsed widthOf:s from:index1 to:index2.
+    h := fontUsed height.
+
+    (fgId notNil and:[function == #copy]) ifTrue:[
+        "
+         only bg is dithered or a pattern; 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 opaque:false.
+        ^ self
+    ].
+
+    "/ the very hard case (fg-dither)
+
+    self displayDeviceOpaqueString:s from:index1 to:index2 in:fontUsed x:pX y:pY.
+
+    "Modified: 30.6.1997 / 15:06:15 / cg"
 !
 
 displayString:aString x:x y:y
@@ -1963,64 +1859,15 @@
      leaving background as-is. If the transformation involves scaling, 
      the fonts point-size is scaled as appropriate."
 
-    |id pX pY fontUsed sz s fontsEncoding|
-
-    "hook for non-strings (i.e. attributed text)"
-    (aString isString not
-    or:[aString isText]) ifTrue:[
+    (aString isString not or:[aString isText]) ifTrue:[
+        "
+         hook for non-strings (i.e. attributed text)
+         that 'thing' should know how to display itself ...
+        "
         ^ 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 asSize:(transformation applyScaleY:sz) rounded.
-            ]
-        ]
-    ] ifFalse:[
-        pX := x.
-        pY := y.
-    ].
-    pX := pX rounded.
-    pY := pY rounded.
-
-    s := aString.
-    fontUsed := fontUsed 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:[
-        "hook for alien fonts"
-        fontUsed displayString:s x:x y:y in:self
-    ] ifFalse:[
-        deviceFont ~~ fontUsed ifTrue:[
-            device setFont:id in:gcId.
-            deviceFont := fontUsed
-        ].
-        device displayString:s x:pX y:pY in:drawableId with:gcId
-    ]
-
-    "Modified: 1.7.1997 / 17:08:35 / cg"
+    self displayString:aString from:1 to:aString size x:x y:y
 !
 
 displayUnscaledForm:formToDraw x:x y:y
@@ -3927,7 +3774,11 @@
 !DeviceGraphicsContext class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/DeviceGraphicsContext.st,v 1.119 2009-05-08 10:30:24 mb Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/DeviceGraphicsContext.st,v 1.120 2009-10-07 18:28:49 cg Exp $'
+!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/libview/DeviceGraphicsContext.st,v 1.120 2009-10-07 18:28:49 cg Exp $'
 ! !
 
 DeviceGraphicsContext initialize!