--- a/DeviceGraphicsContext.st Wed Jun 04 22:33:42 2014 +0100
+++ b/DeviceGraphicsContext.st Thu Jun 05 08:23:01 2014 +0100
@@ -9,15 +9,32 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+'From Smalltalk/X, Version:6.2.3.0 on 23-05-2014 at 17:22:04' !
+
"{ Package: 'stx:libview' }"
GraphicsContext subclass:#DeviceGraphicsContext
- instanceVariableNames:'drawableId gcId deviceFont foreground background'
+ instanceVariableNames:'drawableId gcId deviceFont foreground background drawableType
+ parentId'
classVariableNames:'CachedScaledForms CachedScales Lobby'
poolDictionaries:''
category:'Graphics-Support'
!
+DeviceHandle subclass:#DevicePixmapGCHandle
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:DeviceGraphicsContext
+!
+
+DeviceHandle subclass:#DeviceWindowGCHandle
+ instanceVariableNames:'parentId'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:DeviceGraphicsContext
+!
+
!DeviceGraphicsContext class methodsFor:'documentation'!
copyright
@@ -146,7 +163,7 @@
!DeviceGraphicsContext class methodsFor:'cleanup'!
cleanupLobbyForChildrenOfViewWithDevice:aDevice id:anId
- "clean all the subcomponents of the handle with id anId.
+ "recursively clean all the subcomponents of the handle with id anId.
This must be done on finalization, because descendent handles
are destroyed implicitly when a parent handle is destroyed."
@@ -382,15 +399,10 @@
(for example, when dragging a rubber-line)"
gcId isNil ifTrue:[
- self initGC
+ self initGC
].
device noClipIn:drawableId gc:gcId.
device setClipByChildren:aBoolean in:drawableId gc:gcId.
-"/ device noClipIn:drawableId gc:gcId.
-
-"/
-"/ device setClipX:0 y:0 width:(self width) height:(self height) in:drawableId gc:gcId.
-"/
"Created: 17.7.1996 / 13:25:16 / cg"
"Modified: 29.4.1997 / 15:33:55 / dq"
@@ -400,101 +412,52 @@
"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 r|
-
- (r := aRectangleOrNil) isNil ifTrue:[
- clipRect isNil ifTrue:[^ self].
- gcId notNil ifTrue:[
- device noClipIn:drawableId gc: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
- ].
- w := w max:0.
- h := h max:0.
- device setClipX:x y:y width:w height:h in:drawableId gc:gcId.
- r := Rectangle left:x top:y width:w height:h
- ]
+ |x y w h newBounds|
+
+ aRectangleOrNil isNil ifTrue:[
+ clipRect isNil ifTrue:[^ self].
+ gcId notNil ifTrue:[
+ device noClipIn:drawableId gc:gcId
+ ].
+ clipRect := nil.
+ ^ self.
+ ].
+
+ x := aRectangleOrNil left.
+ y := aRectangleOrNil top.
+ w := aRectangleOrNil width.
+ h := aRectangleOrNil height.
+ transformation notNil ifTrue:[
+ x := transformation applyToX:x.
+ y := transformation applyToY:y.
+ w := transformation applyScaleX:w.
+ h := transformation applyScaleY:h.
].
- clipRect := r
-
- "Created: / 28.5.1996 / 19:40:20 / cg"
- "Modified: / 16.5.1999 / 19:40:37 / cg"
-!
-
-clippingRectangle: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 r|
-
- (r := aRectangleOrNil) isNil ifTrue:[
- clipRect isNil ifTrue:[^ self].
- gcId notNil ifTrue:[
- device noClipIn:drawableId gc: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
- ].
- w := w max:0.
- h := h max:0.
- device setClipX:x y:y width:w height:h in:drawableId gc:gcId.
- r := Rectangle left:x top:y width:w height: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
].
- clipRect := r
+ (h class == SmallInteger) ifFalse:[
+ h := h truncated + 1
+ ].
+ w := w max:0.
+ h := h max:0.
+
+ newBounds := Rectangle left:x top:y width:w height:h.
+ (clipRect notNil and:[clipRect = newBounds]) ifTrue:[
+ ^ self
+ ].
+ clipRect := newBounds.
+ gcId notNil ifTrue:[
+ device setClipX:x y:y width:w height:h in:drawableId gc:gcId.
+ ].
"Created: / 28.5.1996 / 19:40:20 / cg"
"Modified: / 16.5.1999 / 19:40:37 / cg"
@@ -556,35 +519,54 @@
device := aDevice
!
-deviceClippingRectangle:aRectangleOrNil
+deviceClippingBounds:aRectangleOrNil
"set the clipping rectangle for drawing (in device coordinates);
a nil argument turns off clipping (i.e. whole view is drawable - incl. margins)"
- |x y w h|
+ clipRect = aRectangleOrNil ifTrue:[
+ ^ self
+ ].
+ clipRect := aRectangleOrNil.
+
+ gcId isNil ifTrue:[
+ ^ self.
+ ].
aRectangleOrNil isNil ifTrue:[
- clipRect isNil ifTrue:[^ self].
- gcId notNil ifTrue:[
- device noClipIn:drawableId gc:gcId
- ]
+ device noClipIn:drawableId gc:gcId
] ifFalse:[
- clipRect notNil ifTrue:[
- (clipRect = aRectangleOrNil) ifTrue:[^ self]
- ].
- gcId notNil ifTrue:[
- x := aRectangleOrNil left.
- y := aRectangleOrNil top.
- w := aRectangleOrNil width.
- h := aRectangleOrNil height.
- device setClipX:x y:y width:w height:h in:drawableId gc:gcId
- ]
+ device setClipX:aRectangleOrNil left
+ y:aRectangleOrNil top
+ width:aRectangleOrNil width
+ height:aRectangleOrNil height
+ in:drawableId
+ gc:gcId
].
- clipRect := aRectangleOrNil
"Modified: / 22.5.1996 / 13:12:07 / cg"
"Created: / 14.9.1998 / 18:50:31 / cg"
!
+deviceClippingBoundsOrNil
+ "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
+!
+
+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
+!
+
+deviceClippingRectangle:aRectangleOrNil
+ <resource: #obsolete>
+ self deviceClippingBounds:aRectangleOrNil
+!
+
drawableId
"return the id of the drawable on the device"
@@ -607,8 +589,7 @@
redraw. See also: #basicFont:"
(aFont ~~ font) ifTrue:[
- self basicFont:aFont.
- self changed:#font.
+ self basicFont:aFont.
]
"Modified: 6.3.1996 / 18:17:40 / cg"
@@ -1113,39 +1094,37 @@
method to whatever the device needs."
device
- drawBits:aByteArray
- bitsPerPixel:bpp
- depth:depth
- padding:pad
- width:srcW height:srcH
- x:srcX y:srcY
- into:drawableId
- x:dstX y:dstY
- width:(self width) height:(self height)
- with:gcId.
+ drawBits:aByteArray
+ bitsPerPixel:bpp
+ depth:depth
+ padding:pad
+ width:srcW height:srcH
+ x:srcX y:srcY
+ into:drawableId
+ x:dstX y:dstY
+ width:srcW height:srcH "all senders set srcW/srcH to self width / self height"
+ with:gcId.
!
-copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY
+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.
Assumes the source bits are in ST/X's natural padding (i.e. 8-bit padded)"
-
- device
- drawBits:aByteArray
- bitsPerPixel:bpp
- depth:depth
- padding:8
- 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"
+
+ self
+ copyBitsFrom:aByteArray
+ bitsPerPixel:bpp
+ depth:depth
+ padding:8
+ width:srcW
+ height:srcH
+ x:srcX
+ y:srcY
+ toX:dstX
+ y:dstY
!
copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h
@@ -1172,13 +1151,13 @@
(not all devices care for this).
If the receiver is a pixmap, the call always returns immediately."
- |deviceDrawable id srcGCId asy|
+ |deviceDrawable id srcGCId|
((aDrawable graphicsDevice ~~ device)
- or:[aDrawable isImage]) ifTrue:[
- deviceDrawable := aDrawable asFormOn:device.
+ or:[aDrawable isImage]) ifTrue:[
+ deviceDrawable := aDrawable asFormOn:device.
] ifFalse:[
- deviceDrawable := aDrawable
+ deviceDrawable := aDrawable
].
id := deviceDrawable id.
@@ -1190,77 +1169,69 @@
This will be fixed soon (no longer use device>>bitmapFromFile:).
"
id isNil ifTrue:[
- 'DeviceGraphicsContext [warning]: invalid bitmap copy - ignored' errorPrintCR.
- ^ self
+ 'DeviceGraphicsContext [warning]: invalid bitmap copy - ignored' errorPrintCR.
+ ^ self
].
gcId isNil ifTrue:[
- self initGC
+ self initGC
].
deviceDrawable gcId isNil ifTrue:[deviceDrawable initGC].
srcGCId := deviceDrawable gcId.
((deviceDrawable depth == 1) and:[device depth ~~ 1]) ifTrue:[
- deviceDrawable isForm ifTrue:[
- device
- copyPlaneFromPixmapId:id
- x:srcX
- y:srcY
- gc:srcGCId
- to:drawableId
- x:dstX
- y:dstY
- gc:gcId
- width:w
- height:h
- ] ifFalse:[
- device
- copyPlaneFromId:id
- x:srcX
- y:srcY
- gc:srcGCId
- to:drawableId
- x:dstX
- y:dstY
- gc:gcId
- width:w
- height:h
- ]
+ deviceDrawable isForm ifTrue:[
+ device
+ copyPlaneFromPixmapId:id
+ x:srcX
+ y:srcY
+ gc:srcGCId
+ to:drawableId
+ x:dstX
+ y:dstY
+ gc:gcId
+ width:w
+ height:h
+ ] ifFalse:[
+ device
+ copyPlaneFromId:id
+ x:srcX
+ y:srcY
+ gc:srcGCId
+ to:drawableId
+ x:dstX
+ y:dstY
+ gc:gcId
+ width:w
+ height:h
+ ]
] ifFalse:[
- deviceDrawable isForm ifTrue:[
- device
- copyFromPixmapId:id
- x:srcX
- y:srcY
- gc:srcGCId
- to:drawableId
- x:dstX
- y:dstY
- gc:gcId
- width:w
- height:h
- ] ifFalse:[
- asy := async or:[self isView not].
- asy ifFalse:[
- self catchExpose
- ].
- device
- copyFromId:id
- x:srcX
- y:srcY
- gc:srcGCId
- to:drawableId
- x:dstX
- y:dstY
- gc:gcId
- width:w
- height:h.
- asy ifFalse:[
- device flush.
- self waitForExpose
- ]
- ]
+ deviceDrawable isForm ifTrue:[
+ device
+ copyFromPixmapId:id
+ x:srcX
+ y:srcY
+ gc:srcGCId
+ to:drawableId
+ x:dstX
+ y:dstY
+ gc:gcId
+ width:w
+ height:h
+ ] ifFalse:[
+ device
+ copyFromId:id
+ x:srcX
+ y:srcY
+ gc:srcGCId
+ to:drawableId
+ x:dstX
+ y:dstY
+ gc:gcId
+ width:w
+ height:h.
+ ]
]
"Created: / 29.1.1997 / 13:02:10 / cg"
@@ -1334,14 +1305,6 @@
!DeviceGraphicsContext methodsFor:'copying'!
-executor
- "I am abstract"
-
- self subclassResponsibility.
-
- "Created: 2.4.1997 / 19:22:11 / cg"
-!
-
postCopy
"this may not be enough to allow copying of views ..."
@@ -1612,7 +1575,7 @@
Assuming that device can only draw in device colors, we have to handle
the case where paint and/or bgPaint are dithered colors"
- self displayString:aString from:index1 to:index2 x:x y:y opaque:true
+ self displayString:aString from:index1 to:index2 x:x y:y opaque:true maxWidth:nil
!
displayOpaqueString:aString x:x y:y
@@ -1768,19 +1731,26 @@
leaving background as-is. If the transformation involves scaling,
the fonts point-size is scaled as appropriate."
- self displayString:aString from:index1 to:index2 x:x y:y opaque:false
+ self displayString:aString from:index1 to:index2 x:x y:y opaque:false maxWidth:nil
!
-displayString:aString from:index1Arg to:index2Arg x:x y:y opaque:opaqueArg
+displayString:aString from:index1 to:index2 x:x y:y opaque:opaque
+ "draw part of a string with both fg and bg at x/y in current font"
+
+ ^ self displayString:aString from:index1 to:index2 x:x y:y opaque:opaque maxWidth:nil.
+!
+
+displayString:aStringArg from:index1Arg to:index2Arg x:x y:y opaque:opaqueArg maxWidth:maxWidth
"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"
+ the case where paint and/or bgPaint are dithered colors.
+ maxWidth is the maximum width of the string in pixels or nil if unknown."
|opaque index1 index2 easy w h savedPaint fgId bgId
- fontId pX pY fontUsed fontsEncoding sz s
- nSkipLeft nChars wString wSkipLeft wMax index2Guess|
+ fontId pX pY fontUsed fontsEncoding aString
+ nSkipLeft nChars wString wSkipLeft index2Guess|
index1 := index1Arg.
index2 := index2Arg.
@@ -1791,171 +1761,170 @@
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
- ].
- font isAlienFont ifTrue:[
- "
- hook for alien fonts
- that 'font' should know how to display the string...
- "
- font displayString:aString from:index1 to:index2 x:x rounded y:y rounded in:self opaque:opaque.
- ^ self
+ opaque := false.
].
gcId isNil ifTrue:[
- self initGC
+ self initGC
+ ].
+
+ (aStringArg isString not or:[aStringArg isText]) ifTrue:[
+ "
+ hook for non-strings (i.e. attributed text)
+ that 'thing' should know how to display itself ...
+ "
+ aStringArg displayOn:self x:x y:y from:index1 to:index2 opaque:opaque.
+ ^ self
+ ].
+
+ "/ transcode the string into the fonts encoding...
+ 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.
+ ].
].
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.
- ]
- ]
+ pX := transformation applyToX:x.
+ pY := transformation applyToY:y.
+ transformation noScale ifFalse:[
+ |sz|
+
+ sz := font size.
+ sz notNil ifTrue:[
+ fontUsed := font asSize:(transformation applyScaleY:sz) rounded.
+ ]
+ ]
] ifFalse:[
- pX := x.
- pY := y.
+ pX := x.
+ pY := y.
].
+
+ fontUsed isAlienFont ifTrue:[
+ "
+ hook for alien fonts
+ that 'font' should know how to display the string...
+ "
+ fontUsed displayString:aString from:index1 to:index2 x:x rounded y:y rounded in:self opaque:opaque maxWidth:maxWidth.
+ ^ self
+ ].
+
pX := pX rounded.
pY := pY rounded.
fontUsed := fontUsed onDevice:device.
-
- "/ transcode the string into the fonts encoding...
- s := aString.
- 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.
- ].
- ].
-
fontId := fontUsed fontId.
fontId isNil ifTrue:[
- "this should not happen, since #onDevice tries replacement fonts"
- 'STX[DeviceGraphicsContext] no font: ' errorPrint. fontUsed errorPrintCR.
- ^ self
+ "this should not happen, since #onDevice tries replacement fonts"
+ 'STX[DeviceGraphicsContext] no font: ' errorPrint. fontUsed errorPrintCR.
+ ^ 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
- ]
+ paint isColor ifTrue:[
+ easy := true.
+ fgId := paint colorId.
+ fgId isNil ifTrue:[
+ easy := false
+ ]
+ ] ifFalse:[
+ easy := false
].
opaque ifTrue:[
- bgPaint isColor ifFalse:[
- easy := false
- ] ifTrue:[
- bgId := bgPaint colorId.
- bgId isNil ifTrue:[
- easy := false
- ]
- ].
+ bgPaint isColor ifTrue:[
+ bgId := bgPaint colorId.
+ bgId isNil ifTrue:[
+ easy := false
+ ]
+ ] ifFalse:[
+ easy := false
+ ].
].
deviceFont ~~ fontUsed ifTrue:[
- device setFont:fontId in:gcId.
- deviceFont := fontUsed
+ device setFont:fontId in:gcId.
+ deviceFont := fontUsed
].
"/ 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 := (pX negated // font width) min:index2. "/ 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.
+ (maxWidth notNil and:[(index2 - index1) > 500]) ifTrue:[
+ nSkipLeft := wSkipLeft := 0.
+
+ "/ 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:maxWidth with:aString size with:index1 with:index2) printCR.
+ nSkipLeft := (pX negated // font width) min:index2. "/ 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
- index2Guess := (index1+nChars-1) min:index2.
- wString := fontUsed widthOf:aString from:index1 to:index2Guess. "/ actual number of pixels
+ ].
+
"/ ('n=%d w=%d' printfWith:nChars with:wString) printCR.
- [ ((pX+wString) < wMax) and:[ index2Guess < index2] ] whileTrue:[ "/ not enough...
- nChars := (nChars * 1.1) rounded.
- index2Guess := (index1+nChars-1) min:index2.
- wString := fontUsed widthOf:aString from:index1 to:index2Guess.
- ].
+ [ ((pX+wString) < maxWidth) and:[ index2Guess < index2] ] whileTrue:[ "/ not enough...
+ nChars := (nChars * 1.1) rounded.
+ index2Guess := (index1+nChars-1) min:index2.
+ wString := fontUsed widthOf:aString from:index1 to:index2Guess.
+ ].
"/ ('n=%d w=%d' printfWith:nChars with:wString) printCR.
- index2 := index2Guess.
+ index2 := index2Guess.
].
easy ifTrue:[
- opaque ifTrue:[
- device setForeground:fgId background:bgId in:gcId.
- background := bgPaint.
- ] ifFalse:[
- device setForeground:fgId in:gcId.
- ].
- foreground := paint.
- device displayString:s from:index1 to:index2 x:pX y:pY in:drawableId with:gcId opaque:opaque.
- ^ self
+ opaque ifTrue:[
+ device setForeground:fgId background:bgId in:gcId.
+ background := bgPaint.
+ ] ifFalse:[
+ device setForeground:fgId in:gcId.
+ ].
+ foreground := paint.
+ device displayString:aString from:index1 to:index2 x:pX y:pY in:drawableId with:gcId opaque:opaque.
+ ^ self
].
- w := fontUsed widthOf:s from:index1 to:index2.
+ "/
+ "/ do it the hard way - either forground or background is not a plain color,
+ "/ but dithered or a pattern
+ "/
+ w := fontUsed widthOf:aString 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
+ "
+ 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:aString 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.
+ self displayDeviceOpaqueString:aString from:index1 to:index2 in:fontUsed x:pX y:pY.
"Modified: / 30-06-1997 / 15:06:15 / cg"
"Modified: / 14-04-2011 / 11:11:00 / Stefan Vogel <sv@exept.de>"
@@ -1967,15 +1936,7 @@
leaving background as-is. If the transformation involves scaling,
the fonts point-size is scaled as appropriate."
- (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
- ].
-
- self displayString:aString from:1 to:aString size x:x y:y
+ self displayString:aString from:1 to:aString size x:x y:y opaque:false maxWidth:nil
!
displayUnscaledForm:formToDraw x:x y:y
@@ -2568,7 +2529,7 @@
|id w h easy savedPaint bgForm fgForm tmpForm
fgId bgId noColor allColor allBits dx dy
- pX pY deviceDepth deviceForm|
+ pX pY deviceDepth deviceForm map|
deviceForm := aForm asFormOn:device.
id := deviceForm id.
@@ -2576,16 +2537,16 @@
"temporary ..."
(id isNil
or:[aForm graphicsDevice ~~ device]) ifTrue:[
- deviceForm := deviceForm asFormOn:device.
- id := deviceForm id.
- id isNil ifTrue:[
- 'DeviceGraphicsContext [warning]: invalid form draw - ignored' errorPrintCR.
- ^ self
- ].
+ deviceForm := deviceForm asFormOn:device.
+ id := deviceForm id.
+ id isNil ifTrue:[
+ 'DeviceGraphicsContext [warning]: invalid form draw - ignored' errorPrintCR.
+ ^ self
+ ].
].
gcId isNil ifTrue:[
- self initGC
+ self initGC
].
deviceForm gcId isNil ifTrue:[deviceForm initGC].
@@ -2600,25 +2561,30 @@
and is always drawn opaque.
"
(aForm depth ~~ 1) ifTrue:[
- device
- copyFromPixmapId:id
- x:0
- y:0
- gc:deviceForm gcId
- to:drawableId
- x:pX
- y:pY
- gc:gcId
- width:w
- height:h.
- ^ self
+ device
+ copyFromPixmapId:id
+ x:0
+ y:0
+ gc:deviceForm gcId
+ to:drawableId
+ x:pX
+ y:pY
+ gc:gcId
+ width:w
+ height:h.
+ ^ self
+ ].
+ map := aForm colorMap.
+ map notNil ifTrue:[
+ paint := map at:2.
+ bgPaint := map at:1.
].
"/ if no bgPaint is set, this is a non-opaque draw
bgPaint isNil ifTrue:[
- self displayDeviceForm:aForm x:x y:y.
- ^ self
+ self displayDeviceForm:aForm x:x y:y.
+ ^ self
].
"the following code is somewhat complicated, since it has to deal
@@ -2632,43 +2598,43 @@
"
easy := true.
paint isColor ifFalse:[
- easy := false
+ easy := false
] ifTrue:[
- fgId := paint colorId.
- fgId isNil ifTrue:[
- easy := false
- ]
+ fgId := paint colorId.
+ fgId isNil ifTrue:[
+ easy := false
+ ]
].
bgPaint isColor ifFalse:[
- easy := false
+ easy := false
] ifTrue:[
- bgId := bgPaint colorId.
- bgId isNil ifTrue:[
- easy := false
- ]
+ 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
- copyPlaneFromPixmapId:id
- x:0
- y:0
- gc:(deviceForm gcId)
- to:drawableId
- x:pX
- y:pY
- gc:gcId
- width:w
- height:h.
- ^ self
+ "
+ 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
+ copyPlaneFromPixmapId:id
+ x:0
+ y:0
+ gc:(deviceForm gcId)
+ to:drawableId
+ x:pX
+ y:pY
+ gc:gcId
+ width:w
+ height:h.
+ ^ self
].
"
@@ -2679,120 +2645,120 @@
deviceDepth := device depth.
(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:deviceDepth)-1))
- and:[fgId ~~ allBits]) ifTrue:[
- "
- clear fg-bits ...
- "
- device setForeground:0 background:allBits in:gcId.
- device setFunction:#and in:gcId.
- device
- copyPlaneFromPixmapId:id
- x:0
- y:0
- gc:(deviceForm gcId)
- to:drawableId
- x:pX
- y:pY
- gc:gcId
- width:w
- height:h
- ].
-
- fgId ~~ 0 ifTrue:[
- "
- or-in fg-bits ...
- "
- device setForeground:fgId background:0 in:gcId.
- device setFunction:#or in:gcId.
- device
- copyPlaneFromPixmapId:id
- x:0
- y:0
- gc:(deviceForm gcId)
- to:drawableId
- x:pX
- y:pY
- gc:gcId
- width:w
- height:h
- ].
- "
- flush foreground/background cache
- "
- foreground := nil.
- background := nil.
- device setFunction:function in:gcId.
- ^ self
+ "
+ 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:deviceDepth)-1))
+ and:[fgId ~~ allBits]) ifTrue:[
+ "
+ clear fg-bits ...
+ "
+ device setForeground:0 background:allBits in:gcId.
+ device setFunction:#and in:gcId.
+ device
+ copyPlaneFromPixmapId:id
+ x:0
+ y:0
+ gc:(deviceForm gcId)
+ to:drawableId
+ x:pX
+ y:pY
+ gc:gcId
+ width:w
+ height:h
+ ].
+
+ fgId ~~ 0 ifTrue:[
+ "
+ or-in fg-bits ...
+ "
+ device setForeground:fgId background:0 in:gcId.
+ device setFunction:#or in:gcId.
+ device
+ copyPlaneFromPixmapId:id
+ x:0
+ y:0
+ gc:(deviceForm gcId)
+ to:drawableId
+ x:pX
+ y:pY
+ gc:gcId
+ width:w
+ height:h
+ ].
+ "
+ 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:deviceDepth)-1))
- and:[bgId ~~ allBits]) ifTrue:[
- "
- clear bg-bits ...
- "
- device setForeground:allBits background:0 in:gcId.
- device setFunction:#and in:gcId.
- device
- copyPlaneFromPixmapId:id
- x:0
- y:0
- gc:(deviceForm gcId)
- to:drawableId
- x:pX
- y:pY
- gc:gcId
- width:w
- height:h
- ].
-
- "
- or-in bg-bits ...
- "
- bgId ~~ 0 ifTrue:[
- device setForeground:0 background:bgId in:gcId.
- device setFunction:#or in:gcId.
- device
- copyPlaneFromPixmapId:id
- x:0
- y:0
- gc:(deviceForm gcId)
- to:drawableId
- x:pX
- y:pY
- gc:gcId
- width:w
- height:h
- ].
- "
- flush foreground/background cache
- "
- foreground := nil.
- background := nil.
- device setFunction:function in:gcId.
- ^ self
+ "
+ 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:deviceDepth)-1))
+ and:[bgId ~~ allBits]) ifTrue:[
+ "
+ clear bg-bits ...
+ "
+ device setForeground:allBits background:0 in:gcId.
+ device setFunction:#and in:gcId.
+ device
+ copyPlaneFromPixmapId:id
+ x:0
+ y:0
+ gc:(deviceForm gcId)
+ to:drawableId
+ x:pX
+ y:pY
+ gc:gcId
+ width:w
+ height:h
+ ].
+
+ "
+ or-in bg-bits ...
+ "
+ bgId ~~ 0 ifTrue:[
+ device setForeground:0 background:bgId in:gcId.
+ device setFunction:#or in:gcId.
+ device
+ copyPlaneFromPixmapId:id
+ x:0
+ y:0
+ gc:(deviceForm gcId)
+ to:drawableId
+ x:pX
+ y:pY
+ gc:gcId
+ width:w
+ height:h
+ ].
+ "
+ flush foreground/background cache
+ "
+ foreground := nil.
+ background := nil.
+ device setFunction:function in:gcId.
+ ^ self
].
"
@@ -2812,8 +2778,8 @@
"
dx := dy := 0.
maskOrigin notNil ifTrue:[
- dx := maskOrigin x.
- dy := maskOrigin y
+ dx := maskOrigin x.
+ dy := maskOrigin y
].
bgForm paint:bgPaint.
@@ -2856,16 +2822,16 @@
"
device setForeground:0 background:allBits in:gcId.
device
- copyFromPixmapId:tmpForm id
- x:0
- y:0
- gc:tmpForm gcId
- to:drawableId
- x:pX
- y:pY
- gc:gcId
- width:w
- height:h.
+ copyFromPixmapId:tmpForm id
+ x:0
+ y:0
+ gc:tmpForm gcId
+ to:drawableId
+ x:pX
+ y:pY
+ gc:gcId
+ width:w
+ height:h.
"
release tempForms immediately
@@ -2885,7 +2851,7 @@
"Modified: 22.4.1997 / 21:44:10 / cg"
!
-displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:x y:y
+displayDeviceOpaqueString:aStringArg 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
@@ -2893,7 +2859,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 s
+ id bgForm fgForm tmpForm maskForm dx dy pX pY fontUsed aString
deviceDepth fontsEncoding ascent|
"
@@ -2901,60 +2867,58 @@
this is a non-opaque draw
"
bgPaint isNil ifTrue:[
- self displayDeviceString:aString from:index1 to:index2 x:x y:y.
- ^ self
+ self displayDeviceString:aStringArg 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
+ (aStringArg isString not or:[aStringArg isText]) ifTrue:[
+ "
+ 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.
+ ^ 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
- that 'font' should know how to display the string ...
- "
- font displayOpaqueString:aString from:index1 to:index2 x:pX y:pY in:self.
- ^ self
+ "
+ 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
+ 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"
- 'STX[DeviceGraphicsContext] no font: ' errorPrint. fontUsed errorPrintCR.
- ^ self
+ "this should not happen, since #onDevice tries replacement fonts"
+ 'STX[DeviceGraphicsContext] no font: ' errorPrint. fontUsed errorPrintCR.
+ ^ self
].
deviceFont ~~ fontUsed ifTrue:[
- device setFont:id in:gcId.
- deviceFont := fontUsed
+ device setFont:id in:gcId.
+ deviceFont := fontUsed
].
"
@@ -2962,48 +2926,48 @@
"
easy := true.
paint isColor ifFalse:[
- easy := false
+ easy := false
] ifTrue:[
- fgId := paint colorId.
- fgId isNil ifTrue:[
- easy := false
- ]
+ fgId := paint colorId.
+ fgId isNil ifTrue:[
+ easy := false
+ ]
].
bgPaint isColor ifFalse:[
- easy := false
+ easy := false
] ifTrue:[
- bgId := bgPaint colorId.
- bgId isNil ifTrue:[
- easy := false
- ]
+ 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
+ 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.
+ ^ self
].
- w := fontUsed widthOf:s from:index1 to:index2.
+ w := fontUsed widthOf:aString from:index1 to:index2.
h := fontUsed height.
ascent := fontUsed ascent.
(fgId notNil and:[function == #copy]) ifTrue:[
- "
- only bg is dithered; fill with bg first ...
- "
- savedPaint := paint.
- self paint:bgPaint.
- self fillRectangleX:pX y:(pY - 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
+ "
+ only bg is dithered; fill with bg first ...
+ "
+ savedPaint := paint.
+ self paint:bgPaint.
+ self fillRectangleX:pX y:(pY - ascent) width:w height:h.
+ self paint:savedPaint.
+
+ "
+ then draw using fgPaint (which is a real color)
+ "
+ device displayString:aString from:index1 to:index2 x:pX y:pY in:drawableId with:gcId.
+ ^ self
].
allColor := Color allColor.
@@ -3061,26 +3025,26 @@
"/ ].
(bgId notNil and:[function == #copy]) ifTrue:[
- "
- only fg is dithered; fill with bg first ...
- "
- device setForeground:bgId in:gcId.
- device setFunction:#copy in:gcId.
- device setBitmapMask:nil in:gcId.
- self fillRectangleX:pX y:(pY - ascent) width:w height:h.
-
- mask notNil ifTrue:[
- "/ draw fg dithered
- (mask depth == 1) ifTrue:[
- device setBitmapMask:mask id in:gcId.
- device setForegroundColor:foreground backgroundColor:background in:gcId.
- ] ifFalse:[
- device setPixmapMask:mask id in:gcId
- ].
- ].
-
- device displayString:s from:index1 to:index2 x:pX y:pY in:drawableId with:gcId.
- ^ self.
+ "
+ only fg is dithered; fill with bg first ...
+ "
+ device setForeground:bgId in:gcId.
+ device setFunction:#copy in:gcId.
+ device setBitmapMask:nil in:gcId.
+ self fillRectangleX:pX y:(pY - ascent) width:w height:h.
+
+ mask notNil ifTrue:[
+ "/ draw fg dithered
+ (mask depth == 1) ifTrue:[
+ device setBitmapMask:mask id in:gcId.
+ device setForegroundColor:foreground backgroundColor:background in:gcId.
+ ] ifFalse:[
+ device setPixmapMask:mask id in:gcId
+ ].
+ ].
+
+ device displayString:aString from:index1 to:index2 x:pX y:pY in:drawableId with:gcId.
+ ^ self.
].
"
@@ -3102,8 +3066,8 @@
dx := 0.
dy := ascent.
maskOrigin notNil ifTrue:[
- dx := maskOrigin x.
- dy := dy + maskOrigin y
+ dx := maskOrigin x.
+ dy := dy + maskOrigin y
].
bgForm paint:bgPaint.
@@ -3120,14 +3084,14 @@
bgForm font:fontUsed.
bgForm paint:noColor on:allColor.
bgForm function:#and.
- bgForm displayString:s from:index1 to:index2 x:0 y:ascent.
+ bgForm displayString:aString from:index1 to:index2 x:0 y:ascent.
"
stamp-out foreground
"
maskForm font:fontUsed.
maskForm paint:allColor on:noColor.
- maskForm displayOpaqueString:s from:index1 to:index2 x:0 y:ascent.
+ maskForm displayOpaqueString:aString 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.
@@ -3150,11 +3114,11 @@
"
device setForeground:0 background:allBits in:gcId.
device
- copyFromId:tmpForm id
- x:0 y:0 gc:tmpForm gcId
- to:drawableId
- x:pX y:(pY-ascent) gc:gcId
- width:w height:h.
+ copyFromId:tmpForm id
+ x:0 y:0 gc:tmpForm gcId
+ to:drawableId
+ x:pX y:(pY-ascent) gc:gcId
+ width:w height:h.
"
release tempForms immediately
@@ -3193,61 +3157,60 @@
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
+displayDeviceString:aStringArg 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 fontsEncoding|
+ |id pX pY fontUsed aString 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
+ (aStringArg isString not or:[aStringArg isText]) ifTrue:[
+ ^ aStringArg 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
+ self initGC
].
- s := aString.
- fontUsed := font onDevice:device.
- fontsEncoding := fontUsed encoding.
+ aString := aStringArg.
+ fontsEncoding := font 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.
- ].
+ [
+ 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
+ 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"
- 'STX[DeviceGraphicsContext] no font: ' errorPrint. fontUsed errorPrintCR.
- ^ self
+ "this should not happen, since #onDevice tries replacement fonts"
+ 'STX[DeviceGraphicsContext] no font: ' errorPrint. fontUsed errorPrintCR.
+ ^ self
] ifFalse:[
- 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
+ deviceFont ~~ fontUsed ifTrue:[
+ device setFont:id in:gcId.
+ deviceFont := fontUsed
+ ].
+ device displayString:aString from:index1 to:index2 x:pX y:pY in:drawableId with:gcId
]
"Modified: 1.7.1997 / 17:08:48 / cg"
@@ -3542,6 +3505,31 @@
"Modified: 4.6.1996 / 17:58:49 / cg"
! !
+!DeviceGraphicsContext methodsFor:'finalization'!
+
+executor
+ drawableType == #window ifTrue:[
+ ^ DeviceWindowGCHandle basicNew
+ setDevice:self graphicsDevice id:self drawableId gcId:self gcId parentId:parentId.
+ ] ifFalse:[
+ ^ DevicePixmapGCHandle basicNew
+ setDevice:self graphicsDevice id:self drawableId gcId:self gcId.
+ ].
+!
+
+finalizationLobby
+ "answer the registry used for finalization.
+ DeviceGraphicContexts have their own Registry"
+
+ ^ Lobby
+!
+
+registerChange
+ "register a change with the finalizationLobby"
+
+ Lobby registerChange:self.
+! !
+
!DeviceGraphicsContext methodsFor:'initialization & release'!
close
@@ -3558,38 +3546,30 @@
really drawn, none is created up to the first draw.
This method is sent, when the first drawing happens"
- gcId := device gcFor:drawableId.
+ drawableType == #pixmap ifTrue:[
+ gcId := device gcForBitmap:drawableId.
+ ] ifFalse:[
+ gcId := device gcFor:drawableId.
+ ].
Lobby registerChange:self.
"Modified: 19.3.1997 / 11:07:52 / cg"
!
-createGCForBitmap
- "physically create a device GC.
- Since we do not need a gc-object for the drawable until something is
- really drawn, none is created up to the first draw.
- This method is sent, when the first drawing happens.
- Redefined here to create a bitmap GC (some devices (i.e. windows) require
- different GC's for different canvases."
-
- gcId := device gcForBitmap:drawableId.
- Lobby registerChange:self.
-!
-
destroy
- "I am abstract"
-
- self subclassResponsibility.
-
-"/ "when the drawable is destroyed, the associated GC must be destroyed with it"
-"/
-"/ gcId notNil ifTrue:[
-"/ device destroyGC:gcId.
-"/ gcId := nil.
-"/ Lobby registerChange:self.
-"/ ]
-
- "Modified: 2.4.1997 / 19:37:53 / cg"
+ |id|
+
+ self destroyGC .
+ id := drawableId.
+ id notNil ifTrue:[
+ drawableId := nil.
+ drawableType == #window ifTrue:[
+ device destroyView:nil withId:id.
+ ] ifFalse:[
+ device destroyPixmap:id.
+ ].
+ ].
+ Lobby unregister:self.
!
destroyGC
@@ -3602,37 +3582,6 @@
].
!
-destroyPixmap
- "physically destroy the pixmap."
-
- |id|
-
- (id := drawableId) notNil ifTrue:[
- drawableId := nil.
- device destroyPixmap:id.
- ].
- Lobby unregister:self.
-!
-
-destroyView
- "physically destroy the view."
-
- |id|
-
- (id := drawableId) notNil ifTrue:[
- drawableId := nil.
- device destroyView:self withId:id.
- ].
- Lobby unregister:self.
-!
-
-finalizationLobby
- "answer the registry used for finalization.
- DeviceGraphicContexts have their own Registry"
-
- ^ Lobby
-!
-
initGC
"since we do not need a gc-object for the drawable until something is
really drawn, none is created.
@@ -3642,11 +3591,11 @@
gcId notNil ifTrue:[^ self].
drawableId isNil ifTrue:[
- "/
- "/ the drawable has been closed (or was never open)
- "/ no drawing is possible.
- "/
- ^ DrawingOnClosedDrawableSignal raiseRequest
+ "/
+ "/ the drawable has been closed (or was never open)
+ "/ no drawing is possible.
+ "/
+ ^ DrawingOnClosedDrawableSignal raiseRequest
].
self createGC.
@@ -3654,32 +3603,32 @@
background isNil ifTrue:[background := device whiteColor].
foreground isColor ifTrue:[
- "get device colors from the device indep. colors"
- foreground := foreground onDevice:device.
- fgId := foreground colorId.
- fgId isNil ifTrue:[
- (foreground grayIntensity >= 50) ifTrue:[
- fgId := device whitepixel
- ] ifFalse:[
- fgId := device blackpixel
- ]
- ].
+ "get device colors from the device indep. colors"
+ foreground := foreground onDevice:device.
+ fgId := foreground colorId.
+ fgId isNil ifTrue:[
+ (foreground grayIntensity >= 50) ifTrue:[
+ fgId := device whitepixel
+ ] ifFalse:[
+ fgId := device blackpixel
+ ]
+ ].
] ifFalse:[
- fgId := device blackpixel.
+ fgId := device blackpixel.
].
background isColor ifTrue:[
- background := background onDevice:device.
- bgId := background colorId.
- bgId isNil ifTrue:[
- (background grayIntensity >= 50) ifTrue:[
- bgId := device whitepixel
- ] ifFalse:[
- bgId := device blackpixel
- ]
- ].
+ background := background onDevice:device.
+ bgId := background colorId.
+ bgId isNil ifTrue:[
+ (background grayIntensity >= 50) ifTrue:[
+ bgId := device whitepixel
+ ] ifFalse:[
+ bgId := device blackpixel
+ ]
+ ].
] ifFalse:[
- bgId := device whitepixel
+ bgId := device whitepixel
].
"now, this is something the device can work with ..."
@@ -3694,22 +3643,22 @@
or:[(lineStyle ~~ #solid)
or:[(capStyle ~~ #butt)
or:[joinStyle ~~ #miter]]]) ifTrue:[
- device setLineWidth:lineWidth
- style:lineStyle
- cap:capStyle
- join:joinStyle
- in:gcId
+ 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
- ]
+ (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].
@@ -3725,12 +3674,12 @@
"/ ]
font notNil ifTrue:[
- font graphicsDevice == device ifTrue:[
- (fontId := font fontId) notNil ifTrue:[
- deviceFont := font.
- device setFont:fontId in:gcId
- ]
- ]
+ font graphicsDevice == device ifTrue:[
+ (fontId := font fontId) notNil ifTrue:[
+ deviceFont := font.
+ device setFont:fontId in:gcId
+ ]
+ ]
]
"Modified: / 22-10-2006 / 14:10:53 / cg"
@@ -3764,32 +3713,26 @@
"sent after a snapin or a migration, reinit draw stuff for new device"
gcId := nil.
+ drawableId := nil.
foreground notNil ifTrue:[
- foreground := foreground onDevice:device
+ foreground := foreground onDevice:device
].
background notNil ifTrue:[
- background := background onDevice:device
+ background := background onDevice:device
].
paint notNil ifTrue:[
- paint := paint onDevice:device
+ paint := paint onDevice:device
].
bgPaint notNil ifTrue:[
- bgPaint := bgPaint onDevice:device
+ bgPaint := bgPaint onDevice:device
].
font notNil ifTrue:[
- font := font onDevice:device
+ font := font onDevice:device
]
"Modified: 28.10.1996 / 13:25:02 / cg"
!
-reinitialize
- 'DeviceGraphicsContext [warning]: reinit of ' errorPrint. self classNameWithArticle errorPrint.
- ' failed' errorPrintCR
-
- "Modified: 10.1.1997 / 17:47:06 / cg"
-!
-
releaseGC
"destroy the associated device GC resource - can be done to be nice to the
display if you know that you are done with a drawable."
@@ -3966,37 +3909,49 @@
"create a bitmap from data and set the drawableId"
drawableId := device createBitmapFromArray:data width:width height:height.
+ drawableType := #pixmap.
+ Lobby registerChange:self.
!
createPixmapWidth:w height:h depth:d
"create a pixmap and set the drawableId"
drawableId := device createPixmapWidth:w height:h depth:d.
+ drawableType := #pixmap.
+ Lobby registerChange:self.
!
-createRootWindow
- drawableId := device rootWindowFor:self.
+createRootWindowFor:aView
+ drawableId := device rootWindowFor:aView.
+ drawableType := #window.
!
createWindowFor:aView type:typeSymbol origin:org extent:ext minExtent:minE maxExtent:maxE borderWidth:bw subViewOf:sv style:styleSymbol inputOnly:inp label:label owner:owner icon:icn iconMask:icnM iconView:icnV
"create a window and set the drawableId"
+ |container|
+
drawableId := device
- createWindowFor:aView
- type:typeSymbol
- origin:org
- extent:ext
- minExtent:minE
- maxExtent:maxE
- borderWidth:bw
- subViewOf:sv
- style:styleSymbol
- inputOnly:inp
- label:label
- owner:owner
- icon:icn
- iconMask:icnM
- iconView:icnV.
+ createWindowFor:aView
+ type:typeSymbol
+ origin:org
+ extent:ext
+ minExtent:minE
+ maxExtent:maxE
+ borderWidth:bw
+ subViewOf:sv
+ style:styleSymbol
+ inputOnly:inp
+ label:label
+ owner:owner
+ icon:icn
+ iconMask:icnM
+ iconView:icnV.
+
+ drawableType := #window.
+ container := aView container.
+ container notNil ifTrue:[ parentId := container id ].
+ Lobby registerChange:self.
! !
!DeviceGraphicsContext methodsFor:'view properties'!
@@ -4091,14 +4046,99 @@
^ false.
! !
+!DeviceGraphicsContext::DevicePixmapGCHandle methodsFor:'accessing'!
+
+parentId
+ "pixmaps do not have a parent"
+
+ ^ nil
+! !
+
+!DeviceGraphicsContext::DevicePixmapGCHandle methodsFor:'finalization'!
+
+finalize
+ "the Form for which I am a handle has been collected - tell it to the x-server"
+
+ |id|
+
+ drawableId notNil ifTrue:[
+ (id := gcId) notNil ifTrue:[
+ gcId := nil.
+ device destroyGC:id.
+ ].
+ id := drawableId.
+ drawableId := nil.
+ device destroyPixmap:id.
+ ]
+! !
+
+!DeviceGraphicsContext::DeviceWindowGCHandle methodsFor:'accessing'!
+
+parentId
+ ^ parentId
+! !
+
+!DeviceGraphicsContext::DeviceWindowGCHandle methodsFor:'finalization'!
+
+finalize
+ "the view for which I am a handle was collected
+ - release system resources"
+
+ drawableId notNil ifTrue:[
+ [
+ (device viewIdKnown:drawableId) ifTrue:[
+"/ 'Display [info]: recycled view (' infoPrint. v infoPrint. ') not destroyed: ' infoPrint.
+"/ drawableId displayString infoPrintCR.
+ drawableId := nil.
+ ] ifFalse:[
+ |id|
+
+ (id := gcId) notNil ifTrue:[
+ gcId := nil.
+ device deviceIOErrorSignal handle:[:ex |
+ ] do:[
+ device destroyGC:id.
+ ]
+ ].
+
+ id := drawableId.
+ drawableId := nil.
+ device deviceIOErrorSignal handle:[:ex |
+ ] do:[
+ device destroyView:nil withId:id.
+ ].
+
+ "When a window ist destroyed, all its subwindows are also destroyed.
+ Unregister all the subwindows, to avoid destroying of reused windoeIds
+ later."
+ DeviceGraphicsContext cleanupLobbyForChildrenOfViewWithDevice:device id:id.
+ ]
+ ] valueUninterruptably.
+ ].
+
+ "Created: / 25.9.1997 / 10:01:46 / stefan"
+ "Modified: / 15.11.2001 / 14:17:12 / cg"
+! !
+
+!DeviceGraphicsContext::DeviceWindowGCHandle methodsFor:'private-accessing'!
+
+setDevice:aDevice id:aDrawableId gcId:aGCId parentId:parentIdArg
+ "set the handles contents"
+
+ device := aDevice.
+ drawableId := aDrawableId.
+ gcId := aGCId.
+ parentId := parentIdArg.
+! !
+
!DeviceGraphicsContext class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/DeviceGraphicsContext.st,v 1.138 2014-05-23 18:50:28 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceGraphicsContext.st,v 1.137.2.2 2014-05-23 15:42:24 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/DeviceGraphicsContext.st,v 1.138 2014-05-23 18:50:28 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceGraphicsContext.st,v 1.137.2.2 2014-05-23 15:42:24 stefan Exp $'
! !
--- a/DeviceHandle.st Wed Jun 04 22:33:42 2014 +0100
+++ b/DeviceHandle.st Thu Jun 05 08:23:01 2014 +0100
@@ -9,11 +9,10 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libview' }"
Object subclass:#DeviceHandle
- instanceVariableNames:'device parentId drawableId gcId'
+ instanceVariableNames:'device drawableId gcId'
classVariableNames:''
poolDictionaries:''
category:'Graphics-Support'
@@ -66,10 +65,6 @@
^ drawableId
"Modified: 20.3.1997 / 16:34:00 / cg"
-!
-
-parentId
- ^ parentId
! !
!DeviceHandle methodsFor:'finalization'!
@@ -92,19 +87,11 @@
gcId := aGCId
"Modified: 23.4.1996 / 22:10:26 / cg"
-!
-
-setDevice:aDevice id:aDrawableId gcId:aGCId parentId:parentIdArg
- "set the handles contents"
-
- device := aDevice.
- drawableId := aDrawableId.
- gcId := aGCId.
- parentId := parentIdArg.
! !
!DeviceHandle class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/DeviceHandle.st,v 1.16 2014-03-20 09:53:38 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceHandle.st,v 1.16.2.1 2014-05-08 08:27:50 stefan Exp $'
! !
+
--- a/DisplayRootView.st Wed Jun 04 22:33:42 2014 +0100
+++ b/DisplayRootView.st Thu Jun 05 08:23:01 2014 +0100
@@ -9,6 +9,8 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+'From Smalltalk/X, Version:6.2.3.0 on 17-03-2014 at 20:22:04' !
+
"{ Package: 'stx:libview' }"
DisplaySurface subclass:#DisplayRootView
@@ -228,6 +230,6 @@
!DisplayRootView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/DisplayRootView.st,v 1.42 2014-04-03 14:39:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DisplayRootView.st,v 1.42.2.1 2014-05-08 08:27:50 stefan Exp $'
! !
--- a/DisplaySurface.st Wed Jun 04 22:33:42 2014 +0100
+++ b/DisplaySurface.st Thu Jun 05 08:23:01 2014 +0100
@@ -19,13 +19,6 @@
category:'Graphics-Support'
!
-DeviceHandle subclass:#DeviceViewHandle
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- privateIn:DisplaySurface
-!
-
!DisplaySurface class methodsFor:'documentation'!
copyright
@@ -111,22 +104,22 @@
newTop newBottom newLeft newRight|
updateRegion isNil ifTrue:[
- updateRegion := OrderedCollection with:newRectangle.
- ^ true
+ updateRegion := OrderedCollection with:newRectangle.
+ ^ true
].
(updateRegion contains:[:oldRectangle | (newRectangle isContainedIn:oldRectangle)]) ifTrue:[
- ^ false.
+ ^ false.
].
numRect := updateRegion size.
numRect > 20 ifTrue:[
- closure := updateRegion
- inject:newRectangle
- into:[:boundsSoFar :thisRectangle |
- boundsSoFar quickMerge:thisRectangle
- ].
- updateRegion := OrderedCollection with:closure.
- ^ true
+ closure := updateRegion
+ inject:newRectangle
+ into:[:boundsSoFar :thisRectangle |
+ boundsSoFar quickMerge:thisRectangle
+ ].
+ updateRegion := OrderedCollection with:closure.
+ ^ true
].
lastRect := updateRegion at:numRect.
@@ -140,24 +133,24 @@
newRight := newRectangle right.
lastTop = newTop ifTrue:[
- lastBottom = newBottom ifTrue:[
- lastLeft <= newLeft ifTrue:[
- lastRight >= newLeft ifTrue:[
- updateRegion at:numRect put:(lastRect copy right:newRight).
- ^ false "/ true
- ]
- ]
- ].
+ lastBottom = newBottom ifTrue:[
+ lastLeft <= newLeft ifTrue:[
+ lastRight >= newLeft ifTrue:[
+ updateRegion at:numRect put:(lastRect copy right:newRight).
+ ^ false "/ true
+ ]
+ ]
+ ].
].
lastLeft = newLeft ifTrue:[
- lastRight = newRight ifTrue:[
- lastTop <= newTop ifTrue:[
- lastBottom >= newTop ifTrue:[
- updateRegion at:numRect put:(lastRect copy bottom:newBottom).
- ^ false "/ true
- ]
- ]
- ].
+ lastRight = newRight ifTrue:[
+ lastTop <= newTop ifTrue:[
+ lastBottom >= newTop ifTrue:[
+ updateRegion at:numRect put:(lastRect copy bottom:newBottom).
+ ^ false "/ true
+ ]
+ ]
+ ].
].
updateRegion add:newRectangle.
@@ -172,7 +165,7 @@
viewBackground ~~ something ifTrue:[
viewBackground := something.
- drawableId notNil ifTrue:[
+ self drawableId notNil ifTrue:[
self setViewBackground
]
]
@@ -190,7 +183,7 @@
but support for mixed depth views is being prepared.
(especially useful on SGI, with 24bit view)"
- ^ device depth
+ ^ self graphicsDevice depth
!
insideColor:aColor
@@ -205,7 +198,7 @@
However, subclasses may redefine this, to return their own
keyboard map (for example a terminalView may want treat CTRL-C as regular key)"
- ^ device keyboardMap
+ ^ self graphicsDevice keyboardMap
!
renderer
@@ -231,123 +224,123 @@
|id devBgPixmap bgPixmap w h colorMap
pixmapDepth deviceDepth defBG|
- drawableId notNil ifTrue:[
- viewBackground isColor ifTrue:[
- viewBackground := viewBackground onDevice:device.
- id := viewBackground colorId.
- "
- a real color (i.e. one supported by the device) ?
- "
- id notNil ifTrue:[
- device setWindowBackground:id in:drawableId.
- ^ self
- ].
- "
- no, a dithered one - must have a dither-pattern
- (which is ready for the device, since viewBackground
- is already assigned to the device)
- "
- bgPixmap := viewBackground ditherForm.
- ] ifFalse:[
- viewBackground notNil ifTrue:[
- viewBackground isViewBackground ifTrue:[
- ^ self.
- ].
-
- "
- assume, it can convert itself to a form
- "
- bgPixmap := viewBackground asFormOn:device.
- bgPixmap isNil ifTrue:[
- "/ assume it knows how to draw itself
- ^ self
- ].
- ].
- ].
-
- "
- must now have:
- a dithered color or bitmap or pixmap
- "
- bgPixmap isNil ifTrue:[
- 'DisplaySurface [warning]: background not convertable - ignored' errorPrintCR.
- ^ self
- ].
-
- "/ if the device does not support background pixmaps,
- "/ set the backgroundColor to the default background.
- "/ this will avoid flicker in win32 systems,
- "/ since that background is drawn directly in the
- "/ devices expose event handling.
- "/ (in contrast, the pixmap filling is done by the
- "/ window itself in its expose event handler)
-
- (device supportsViewBackgroundPixmap:bgPixmap) ifFalse:[
- defBG := View defaultViewBackgroundColor.
- defBG isColor ifTrue:[
- defBG := defBG onDevice:device.
- id := defBG colorId.
- id notNil ifTrue:[
- device setWindowBackground:id in:drawableId.
- ].
- ].
- ^ self
- ].
-
- w := bgPixmap width.
- h := bgPixmap height.
-
- deviceDepth := device depth.
- pixmapDepth := bgPixmap depth.
-
- (pixmapDepth ~~ deviceDepth) ifTrue:[
- (pixmapDepth ~~ 1) ifTrue:[
- 'DisplaySurface [warning]: Bad dither depth (must be one or devices depth)' errorPrintCR.
- ^ self
- ].
-
- "
- convert it into a deep form
- "
- colorMap := bgPixmap colorMap.
- devBgPixmap := Form width:w height:h depth:deviceDepth onDevice:device.
- devBgPixmap isNil ifTrue:[
- 'DisplaySurface [warning]: could not create a device form for viewBackground' infoPrintCR.
- ^ self
- ].
- devBgPixmap paint:(colorMap at:1).
- devBgPixmap fillRectangleX:0 y:0 width:w height:h.
- devBgPixmap foreground:(colorMap at:2) background:(colorMap at:1).
- devBgPixmap copyPlaneFrom:bgPixmap x:0 y:0 toX:0 y:0 width:w height:h.
- bgPixmap := devBgPixmap.
- ] ifFalse:[
- (pixmapDepth == 1) ifTrue:[
- "
- although depth matches,
- values in the dither are to be interpreted via the ditherForms
- colormap, which is not always the same as blackpixel/whitepixel ...
- "
- colorMap := bgPixmap colorMap.
- (colorMap at:1) colorId == device whitepixel ifTrue:[
- (colorMap at:2) colorId == device blackpixel ifTrue:[
- "
- ok, can use it
- "
- device setWindowBackgroundPixmap:(bgPixmap id) in:drawableId.
- ^ self
- ]
- ].
-
- "
- no, must invert it
- "
- devBgPixmap := Form width:w height:h depth:deviceDepth onDevice:device.
- devBgPixmap paint:(colorMap at:2) on:(colorMap at:1).
- devBgPixmap copyPlaneFrom:bgPixmap x:0 y:0 toX:0 y:0 width:w height:h.
- bgPixmap := devBgPixmap.
- ]
- ].
- device setWindowBackgroundPixmap:(bgPixmap id) in:drawableId.
+ self drawableId notNil ifTrue:[
+ viewBackground isColor ifTrue:[
+ viewBackground := viewBackground onDevice:self graphicsDevice.
+ id := viewBackground colorId.
+ "
+ a real color (i.e. one supported by the device) ?
+ "
+ id notNil ifTrue:[
+ self graphicsDevice setWindowBackground:id in:self drawableId.
+ ^ self
+ ].
+ "
+ no, a dithered one - must have a dither-pattern
+ (which is ready for the device, since viewBackground
+ is already assigned to the device)
+ "
+ bgPixmap := viewBackground ditherForm.
+ ] ifFalse:[
+ viewBackground notNil ifTrue:[
+ viewBackground isViewBackground ifTrue:[
+ ^ self.
+ ].
+
+ "
+ assume, it can convert itself to a form
+ "
+ bgPixmap := viewBackground asFormOn:self graphicsDevice.
+ bgPixmap isNil ifTrue:[
+ "/ assume it knows how to draw itself
+ ^ self
+ ].
+ ].
+ ].
+
+ "
+ must now have:
+ a dithered color or bitmap or pixmap
+ "
+ bgPixmap isNil ifTrue:[
+ 'DisplaySurface [warning]: background not convertable - ignored' errorPrintCR.
+ ^ self
+ ].
+
+ "/ if the device does not support background pixmaps,
+ "/ set the backgroundColor to the default background.
+ "/ this will avoid flicker in win32 systems,
+ "/ since that background is drawn directly in the
+ "/ devices expose event handling.
+ "/ (in contrast, the pixmap filling is done by the
+ "/ window itself in its expose event handler)
+
+ (self graphicsDevice supportsViewBackgroundPixmap:bgPixmap) ifFalse:[
+ defBG := View defaultViewBackgroundColor.
+ defBG isColor ifTrue:[
+ defBG := defBG onDevice:self graphicsDevice.
+ id := defBG colorId.
+ id notNil ifTrue:[
+ self graphicsDevice setWindowBackground:id in:self drawableId.
+ ].
+ ].
+ ^ self
+ ].
+
+ w := bgPixmap width.
+ h := bgPixmap height.
+
+ deviceDepth := self depth.
+ pixmapDepth := bgPixmap depth.
+
+ (pixmapDepth ~~ deviceDepth) ifTrue:[
+ (pixmapDepth ~~ 1) ifTrue:[
+ 'DisplaySurface [warning]: Bad dither depth (must be one or devices depth)' errorPrintCR.
+ ^ self
+ ].
+
+ "
+ convert it into a deep form
+ "
+ colorMap := bgPixmap colorMap.
+ devBgPixmap := Form width:w height:h depth:deviceDepth onDevice:self graphicsDevice.
+ devBgPixmap isNil ifTrue:[
+ 'DisplaySurface [warning]: could not create a device form for viewBackground' infoPrintCR.
+ ^ self
+ ].
+ devBgPixmap paint:(colorMap at:1).
+ devBgPixmap fillRectangleX:0 y:0 width:w height:h.
+ devBgPixmap foreground:(colorMap at:2) background:(colorMap at:1).
+ devBgPixmap copyPlaneFrom:bgPixmap x:0 y:0 toX:0 y:0 width:w height:h.
+ bgPixmap := devBgPixmap.
+ ] ifFalse:[
+ (pixmapDepth == 1) ifTrue:[
+ "
+ although depth matches,
+ values in the dither are to be interpreted via the ditherForms
+ colormap, which is not always the same as blackpixel/whitepixel ...
+ "
+ colorMap := bgPixmap colorMap.
+ (colorMap at:1) colorId == self graphicsDevice whitepixel ifTrue:[
+ (colorMap at:2) colorId == self graphicsDevice blackpixel ifTrue:[
+ "
+ ok, can use it
+ "
+ self graphicsDevice setWindowBackgroundPixmap:(bgPixmap id) in:self drawableId.
+ ^ self
+ ]
+ ].
+
+ "
+ no, must invert it
+ "
+ devBgPixmap := Form width:w height:h depth:deviceDepth onDevice:self graphicsDevice.
+ devBgPixmap paint:(colorMap at:2) on:(colorMap at:1).
+ devBgPixmap copyPlaneFrom:bgPixmap x:0 y:0 toX:0 y:0 width:w height:h.
+ bgPixmap := devBgPixmap.
+ ]
+ ].
+ self graphicsDevice setWindowBackgroundPixmap:(bgPixmap id) in:self drawableId.
]
"Modified: / 23-01-2011 / 01:44:38 / cg"
@@ -409,10 +402,18 @@
^ self
!
+windowClass:classString name:nameString
+ gc windowClass:classString name:nameString.
+!
+
windowGroup
"return nil - I have no windowGroup"
^ nil
+!
+
+windowName:aString
+ gc windowName:aString.
! !
!DisplaySurface methodsFor:'accessing-cursor'!
@@ -456,11 +457,11 @@
aCursor notNil ifTrue:[
(aCursor ~~ cursor) ifTrue:[
cursor := aCursor.
- drawableId notNil ifTrue:[
+ self drawableId notNil ifTrue:[
self setCursor.
(showImmediately and:[realized]) ifTrue:[
"flush, to make cursor immediately visible"
- device flush
+ self flush
]
]
]
@@ -489,16 +490,16 @@
|id|
cursor isNil ifTrue:[ ^ self].
- cursor := cursor onDevice:self device.
+ cursor := cursor onDevice:self graphicsDevice.
cursor isNil ifTrue:[ ^ self].
id := cursor id.
id isNil ifTrue:[
- 'DisplaySurface [warning]: nil cursorId ignored; shape=' errorPrint.
- cursor shape errorPrintCR.
- ^ self.
+ 'DisplaySurface [warning]: nil cursorId ignored; shape=' errorPrint.
+ cursor shape errorPrintCR.
+ ^ self.
].
- self setCursorId:id .
+ gc setCursorId:id .
!
withCursor:aCursor do:aBlock
@@ -550,19 +551,19 @@
|ret|
cursor == aCursor ifTrue:[
- ^ aBlock value
+ ^ aBlock value
].
- self
- withCursor:aCursor do:[
- |time|
-
- time := Time millisecondsToRun:[ ret := aBlock value].
- time := UserPreferences current waitCursorVisibleTime - time.
- time > 0 ifTrue:[
- Delay waitForMilliseconds:time.
- ].
- ].
+ self
+ withCursor:aCursor do:[
+ |time|
+
+ time := Time millisecondsToRun:[ ret := aBlock value].
+ time := UserPreferences current waitCursorVisibleTime - time.
+ time > 0 ifTrue:[
+ Delay waitForMilliseconds:time.
+ ].
+ ].
^ ret.
"Modified (comment): / 12-09-2011 / 12:14:29 / cg"
@@ -661,8 +662,8 @@
how may true/false, but also #always, #whenMapped or #never."
how ~~ backed ifTrue:[
- backed := how.
- super backingStore:how.
+ backed := how.
+ super backingStore:how.
]
!
@@ -684,7 +685,7 @@
"tell the Display to assign keyboard focus to the receiver"
self shown ifTrue:[
- device setInputFocusTo:drawableId.
+ self graphicsDevice setInputFocusTo:self drawableId.
].
"Modified: / 15.3.1999 / 08:25:10 / cg"
@@ -731,17 +732,17 @@
- used for temporary views (i.e. PopUps and ModalBoxes)"
aBoolean ifTrue:[
- flags := flags bitOr:SaveUnderFlagMask.
+ flags := flags bitOr:SaveUnderFlagMask.
] ifFalse:[
- flags := flags bitClear:SaveUnderFlagMask.
+ flags := flags bitClear:SaveUnderFlagMask.
].
- super saveUnder:aBoolean.
+ gc saveUnder:aBoolean.
!
setPointerPosition:aRelativePoint
"set the pointer to aRelativePoint relative to the views origin"
- device setPointerPosition:aRelativePoint in:drawableId.
+ self graphicsDevice setPointerPosition:aRelativePoint in:self drawableId.
"
Transcript setPointerPosition:Transcript extent // 2.
@@ -835,15 +836,15 @@
setAttribute:key to:newValue
newValue isNil ifTrue:[
- moreAttributes notNil ifTrue:[
- moreAttributes removeKey:key ifAbsent:[].
- moreAttributes := moreAttributes asNilIfEmpty
- ]
+ moreAttributes notNil ifTrue:[
+ moreAttributes removeKey:key ifAbsent:[].
+ moreAttributes := moreAttributes asNilIfEmpty
+ ]
] ifFalse:[
- moreAttributes isNil ifTrue:[
- moreAttributes := IdentityDictionary new.
- ].
- moreAttributes at:key put:newValue.
+ moreAttributes isNil ifTrue:[
+ moreAttributes := IdentityDictionary new.
+ ].
+ moreAttributes at:key put:newValue.
].
!
@@ -853,6 +854,53 @@
flags := flags bitOr:GotExposeFlagMask.
! !
+!DisplaySurface methodsFor:'binary storage'!
+
+readBinaryContentsFrom: stream manager: manager
+ "tell the newly restored View to recreate itself.
+ Bug: does not work correctly yet.
+ (restored view looses its position & wg process)"
+
+ |wasRealized|
+
+ super readBinaryContentsFrom: stream manager: manager.
+
+ wasRealized := realized.
+ realized := false.
+ self recreate.
+ wasRealized ifTrue:[
+ self remap
+ ]
+
+
+ "
+ |s l|
+ s := 'storedLabel.boss' asFilename writeStream binary.
+ l := (Label label:'hello there') realize.
+ Delay waitForSeconds:1.
+ l storeBinaryOn:s.
+ s close.
+ "
+
+ "
+ |s l|
+ s := 'storedLabel.boss' asFilename writeStream binary.
+ (l := Label label:'hello there') open.
+ (Delay forSeconds:10) wait.
+ l storeBinaryOn:s.
+ s close.
+ l destroy.
+ "
+
+ "
+ |s|
+ s := 'storedLabel.boss' asFilename readStream binary.
+ (Object readBinaryFrom:s)
+ "
+
+ "Modified: 3.5.1996 / 23:59:38 / stefan"
+ "Modified: 14.2.1997 / 15:42:55 / cg"
+! !
!DisplaySurface methodsFor:'button menus'!
@@ -886,9 +934,9 @@
|oldMenu|
(oldMenu := self getMiddleButtonMenu) notNil ifTrue:[
- oldMenu isArray ifFalse:[
- oldMenu destroy
- ]
+ oldMenu isArray ifFalse:[
+ oldMenu destroy
+ ]
].
self setMiddleButtonMenu:aMenu
@@ -908,7 +956,7 @@
"return the object selection
- either the local one, or the displays clipBoard buffer."
- ^ device getClipboardObjectFor:drawableId.
+ ^ self graphicsDevice getClipboardObjectFor:self drawableId.
"Modified: 13.2.1997 / 13:18:50 / cg"
!
@@ -929,7 +977,7 @@
Return aString or nil if there is no selection"
- ^ device getClipboardText:selectionBufferSymbol for:drawableId.
+ ^ self graphicsDevice getClipboardText:selectionBufferSymbol for:self drawableId.
!
getSelection
@@ -967,14 +1015,14 @@
"set the object selection - both the local one, and tell the display
that we have changed it (i.e. place it into the clipBoard)."
- device setClipboardObject:something ownerView:self.
+ self graphicsDevice setClipboardObject:something ownerView:self.
!
setClipboardText:something
"set the text selection - both the local one, and tell the display
that we have changed it (i.e. place it into the clipBoard)."
- device setClipboardText:something ownerView:self
+ self graphicsDevice setClipboardText:something ownerView:self
!
setSelection:something
@@ -984,7 +1032,7 @@
<resource: #obsolete>
self obsoleteMethodWarning:'use setClipboardObject:'.
- device setClipboardObject:something ownerView:self.
+ self graphicsDevice setClipboardObject:something ownerView:self.
!
setTextSelection:something
@@ -994,7 +1042,7 @@
<resource: #obsolete>
self obsoleteMethodWarning:'use setClipboardText:'.
- device setClipboardText:something ownerView:self
+ self graphicsDevice setClipboardText:something ownerView:self
! !
!DisplaySurface methodsFor:'drawing'!
@@ -1004,33 +1052,31 @@
redefined since GraphicsMedium fills with background
- not viewBackground as we want here."
- |oldPaint org|
+ |oldPaint|
viewBackground isColor ifFalse:[
- viewBackground isViewBackground ifTrue:[
- self paint:background.
- self fillDeviceRectangleX:x y:y width:w height:h.
- self paint:paint.
- viewBackground fillRectangleX:x y:y width:w height:h in:self.
- ^ self.
- ].
-
- gcId notNil ifTrue:[
- org := self viewOrigin.
- device setMaskOriginX:org x rounded negated
- y:org y rounded negated
- in:gcId
- ].
- (device supportsMaskedDrawingWith:viewBackground) ifFalse:[
- self fillDeviceRectangleWithViewBackgroundX:x y:y width:w height:h.
- ^ self.
- ]
+ viewBackground isViewBackground ifTrue:[
+ oldPaint := self paint.
+ self paint:self background.
+ self fillDeviceRectangleX:x y:y width:w height:h.
+ self paint:oldPaint.
+ viewBackground fillRectangleX:x y:y width:w height:h in:self.
+ ^ self.
+ ].
+
+ gc notNil ifTrue:[
+ self maskOrigin:self viewOrigin negated.
+ (gc graphicsDevice supportsMaskedDrawingWith:viewBackground) ifFalse:[
+ gc graphicsDevice fillDeviceRectangleWithViewBackgroundX:x y:y width:w height:h.
+ ^ self.
+ ].
+ ].
].
"
fill in device coordinates - not logical coordinates
"
- oldPaint := paint.
+ oldPaint := self paint.
self paint:viewBackground.
self fillDeviceRectangleX:x y:y width:w height:h "with:viewBackground".
self paint:oldPaint
@@ -1043,13 +1089,14 @@
redefined since GraphicsMedium fills with background
- not viewBackground as we want here."
- |pX pY pW pH|
-
- transformation notNil ifTrue:[
- pX := transformation applyToX:x.
- pY := transformation applyToY:y.
- pW := transformation applyScaleX:w.
- pH := transformation applyScaleY:h.
+ |pX pY pW pH currentTransformation|
+
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
+ pX := currentTransformation applyToX:x.
+ pY := currentTransformation applyToY:y.
+ pW := currentTransformation applyScaleX:w.
+ pH := currentTransformation applyScaleY:h.
] ifFalse:[
pX := x.
pY := y.
@@ -1057,17 +1104,13 @@
pH := h.
].
- pX := pX rounded.
- pY := pY rounded.
- pW := pW rounded.
- pH := pH rounded.
-
- ^ self clearDeviceRectangleX:pX y:pY width:pW height:pH.
+ ^ self clearDeviceRectangleX:pX rounded y:pY rounded width:pW rounded height:pH rounded.
"Modified: / 30.10.1998 / 15:00:37 / cg"
!
fillDeviceRectangleWithPattern:aPixmap x:xIn y:yIn width:wIn height:hIn patternOffset:pattOffs
+ <resource: #obsolete>
"fill a rectangular area with some pattern.
A helper for devices which do not support pixmap drawing (i.e. win95).
This is never invoked with X11 or Win-NT/XP/Vista systems.
@@ -1103,10 +1146,10 @@
oldClip := self clippingRectangleOrNil.
oldClip notNil ifTrue:[
- x := x max:oldClip left.
- y := y max:oldClip top.
- r := r min:oldClip right.
- b := b min:oldClip bottom.
+ x := x max:oldClip left.
+ y := y max:oldClip top.
+ r := r min:oldClip right.
+ b := b min:oldClip bottom.
].
w := r-x+1.
h := b-y+1.
@@ -1122,16 +1165,16 @@
xR0 >= yE ifTrue:[^ self].
aPixmap depth == 1 ifTrue:[
- oldFg := foreground.
- oldBg := background.
- (clrMap := aPixmap colorMap) notNil ifTrue:[
- bg := clrMap at:1.
- fg := clrMap at:2.
- ] ifFalse:[
- bg := Color white.
- fg := Color black.
- ].
- self foreground:fg background:bg.
+ oldFg := self foreground.
+ oldBg := self background.
+ (clrMap := aPixmap colorMap) notNil ifTrue:[
+ bg := clrMap at:1.
+ fg := clrMap at:2.
+ ] ifFalse:[
+ bg := Color white.
+ fg := Color black.
+ ].
+ self foreground:fg background:bg.
].
self deviceClippingRectangle:(x@y extent:w@h).
@@ -1140,24 +1183,24 @@
oY := offsY.
[yR < yE] whileTrue:[
- xR := xR0.
- oX := offsX.
- [xR < xE] whileTrue:[
- self
- copyFrom:aPixmap
- x:oX y:oY
- toX:xR y:yR
- width:(pW - oX) height:(pH - oY)
- async:true.
- xR := xR + pW - oX.
- oX := 0.
- ].
- yR := yR + pH - oY.
- oY := 0.
+ xR := xR0.
+ oX := offsX.
+ [xR < xE] whileTrue:[
+ self
+ copyFrom:aPixmap
+ x:oX y:oY
+ toX:xR y:yR
+ width:(pW - oX) height:(pH - oY)
+ async:true.
+ xR := xR + pW - oX.
+ oX := 0.
+ ].
+ yR := yR + pH - oY.
+ oY := 0.
].
oldFg notNil ifTrue:[
- self foreground:oldFg background:oldBg.
+ self foreground:oldFg background:oldBg.
].
self deviceClippingRectangle:oldClip.
@@ -1167,46 +1210,46 @@
!
fillDeviceRectangleWithViewBackgroundX:xIn y:yIn width:wIn height:hIn
+ <resource: #obsolete>
"fill a rectangular area with the viewBackground.
A helper for devices which do not support background pixmaps (i.e. win95 screens).
This is never invoked with X11 or Win-NT/XP/Vista systems.
Caller must ensure that the viewBackground is really a form"
self
- fillDeviceRectangleWithPattern:viewBackground
- x:xIn y:yIn width:wIn height:hIn
- patternOffset:self viewOrigin
+ fillDeviceRectangleWithPattern:viewBackground
+ x:xIn y:yIn width:wIn height:hIn
+ patternOffset:self viewOrigin
!
fillRectangleWithPattern:aPixmap x:x y:y width:w height:h patternOffset:pattOffs
+ <resource: #obsolete>
"fill a rectangular area with aPixmap.
A helper for devices which do not support pixmap filling (i.e. win95 screens).
This is never invoked with X11 or Win-NT/XP/Vista systems.
Caller must ensure that the aPixmap is really a form"
- |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.
- ].
+ |pX pY nW nH currentTransformation|
+
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
+ pX := currentTransformation applyToX:x.
+ pY := currentTransformation applyToY:y.
+ nW := currentTransformation applyScaleX:w.
+ nH := currentTransformation 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 := x.
+ pY := y.
+ nW := w.
+ nH := h.
].
pX := pX rounded.
pY := pY rounded.
@@ -1214,23 +1257,24 @@
nH := nH rounded.
self
- fillDeviceRectangleWithPattern:aPixmap
- x:pX y:pY width:nW height:nH
- patternOffset:pattOffs
+ fillDeviceRectangleWithPattern:aPixmap
+ x:pX y:pY width:nW height:nH
+ patternOffset:pattOffs
"Modified: 4.6.1996 / 17:58:49 / cg"
!
fillRectangleWithViewBackgroundX:x y:y width:w height:h
+ <resource: #obsolete>
"fill a rectangular area with the viewBackground.
A helper for devices which do not support background pixmaps (i.e. win95 screens).
This is never invoked with X11 or Win-NT/XP/Vista systems.
Caller must ensure that the viewBackground is really a form"
self
- fillRectangleWithPattern:viewBackground
- x:x y:y width:w height:h
- patternOffset:self viewOrigin
+ fillRectangleWithPattern:viewBackground
+ x:x y:y width:w height:h
+ patternOffset:self viewOrigin
!
redraw
@@ -1293,9 +1337,9 @@
this is a private (internal) method not to be used externally.
for a list of allowed event symbols see Workstation class"
- eventMask := eventMask bitAnd:(device eventMaskFor:anEventSymbol) bitInvert.
- drawableId notNil ifTrue:[
- device setEventMask:eventMask in:drawableId
+ eventMask := eventMask bitAnd:(self graphicsDevice eventMaskFor:anEventSymbol) bitInvert.
+ self drawableId notNil ifTrue:[
+ self graphicsDevice setEventMask:eventMask in:self drawableId
]
!
@@ -1354,9 +1398,9 @@
this is a private (internal) method not to be used externally.
for a list of allowed event symbols see Workstation class"
- eventMask := (eventMask ? 0) bitOr:(device eventMaskFor:anEventSymbol).
- drawableId notNil ifTrue:[
- device setEventMask:eventMask in:drawableId
+ eventMask := (eventMask ? 0) bitOr:(self graphicsDevice eventMaskFor:anEventSymbol).
+ self drawableId notNil ifTrue:[
+ self graphicsDevice setEventMask:eventMask in:self drawableId
]
!
@@ -1454,7 +1498,7 @@
y := rect top.
w := rect width.
h := rect height.
- transformation notNil ifTrue:[
+ gc transformation notNil ifTrue:[
self deviceExposeX:x y:y width:w height:h
] ifFalse:[
self exposeX:x y:y width:w height:h
@@ -1477,7 +1521,7 @@
y := rect top.
w := rect width.
h := rect height.
- transformation notNil ifTrue:[
+ gc transformation notNil ifTrue:[
self deviceExposeX:x y:y width:w height:h
] ifFalse:[
self exposeX:x y:y width:w height:h
@@ -1590,10 +1634,13 @@
"
mhmh ... have to convert to logical coordinates
"
- transformation notNil ifTrue:[
+ |currentTransformation|
+
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
argArray size > 2 ifTrue:[
- argArray at:2 put:(transformation applyInverseToX:(argArray at:2)).
- argArray at:3 put:(transformation applyInverseToY:(argArray at:3)).
+ argArray at:2 put:(currentTransformation applyInverseToX:(argArray at:2)).
+ argArray at:3 put:(currentTransformation applyInverseToY:(argArray at:3)).
].
].
argArray isNil ifTrue:[
@@ -1646,7 +1693,7 @@
"
selector := type.
- transformation notNil ifTrue:[
+ gc transformation notNil ifTrue:[
(isKeyEvent
or:[isButtonEvent
or:[isMouseWheelEvent
@@ -1695,12 +1742,12 @@
|menu|
(menu := self middleButtonMenu) notNil ifTrue:[
- menu isArray ifTrue:[
- "/ a spec array
- menu := menu decodeAsLiteralArray.
- menu receiver:self.
- ].
- menu showAtPointer
+ menu isArray ifTrue:[
+ "/ a spec array
+ menu := menu decodeAsLiteralArray.
+ menu receiver:self.
+ ].
+ menu showAtPointer
]
"Created: 1.3.1996 / 13:24:55 / cg"
@@ -1722,9 +1769,9 @@
"button was pressed - if its middle button and there is a menu, show it."
(button == 2) ifTrue:[
- UserPreferences current showRightButtonMenuOnRelease ifFalse:[
- self activateMenu.
- ].
+ UserPreferences current showRightButtonMenuOnRelease ifFalse:[
+ self activateMenu.
+ ].
]
"Modified: 1.3.1996 / 13:25:07 / cg"
@@ -1732,9 +1779,9 @@
buttonRelease:button x:x y:y
(button == 2) ifTrue:[
- UserPreferences current showRightButtonMenuOnRelease ifTrue:[
- self activateMenu.
- ].
+ UserPreferences current showRightButtonMenuOnRelease ifTrue:[
+ self activateMenu.
+ ].
].
!
@@ -1749,7 +1796,7 @@
|wg|
- device scrollsAsynchronous ifFalse:[
+ self graphicsDevice scrollsAsynchronous ifFalse:[
self setGotExposeFlag.
^ self
].
@@ -1787,14 +1834,15 @@
those which are interested in logical coordinates
should redefine #buttonMotion:x:y:"
- |lx ly|
+ |lx ly currentTransformation|
lx := x.
ly := y.
- transformation notNil ifTrue:[
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
lx notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
+ lx := currentTransformation applyInverseToX:lx.
+ ly := currentTransformation applyInverseToY:ly.
].
].
self buttonMotion:state x:lx y:ly
@@ -1814,14 +1862,15 @@
those which are interested in logical coordinates
should redefine #buttonMultiPress:x:y:"
- |lx ly|
+ |lx ly currentTransformation|
lx := x.
ly := y.
- transformation notNil ifTrue:[
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
lx notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
+ lx := currentTransformation applyInverseToX:lx.
+ ly := currentTransformation applyInverseToY:ly.
].
].
self buttonMultiPress:butt x:lx y:ly
@@ -1841,14 +1890,15 @@
those which are interested in logical coordinates
should redefine #buttonPress:x:y:"
- |lx ly|
+ |lx ly currentTransformation|
lx := x.
ly := y.
- transformation notNil ifTrue:[
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
lx notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
+ lx := currentTransformation applyInverseToX:lx.
+ ly := currentTransformation applyInverseToY:ly.
].
].
self buttonPress:butt x:lx y:ly
@@ -1868,14 +1918,15 @@
those which are interested in logical coordinates
should redefine #buttonRelease:x:y:"
- |lx ly|
+ |lx ly currentTransformation|
lx := x.
ly := y.
- transformation notNil ifTrue:[
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
lx notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
+ lx := currentTransformation applyInverseToX:lx.
+ ly := currentTransformation applyInverseToY:ly.
].
].
self buttonRelease:butt x:lx y:ly
@@ -1895,14 +1946,15 @@
those which are interested in logical coordinates
should redefine #buttonShiftPress:x:y:"
- |lx ly|
+ |lx ly currentTransformation|
lx := x.
ly := y.
- transformation notNil ifTrue:[
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
lx notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
+ lx := currentTransformation applyInverseToX:lx.
+ ly := currentTransformation applyInverseToY:ly.
].
].
self buttonShiftPress:butt x:lx y:ly
@@ -1922,17 +1974,18 @@
those which are interested in logical coordinates
should redefine #exposeX:x:y:width:height:"
- |lx ly lw lh|
+ |lx ly lw lh currentTransformation|
lx := x.
ly := y.
lw := w.
lh := h.
- transformation notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
- lw := transformation applyInverseScaleX:lw.
- lh := transformation applyInverseScaleY:lh.
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
+ lx := currentTransformation applyInverseToX:lx.
+ ly := currentTransformation applyInverseToY:ly.
+ lw := currentTransformation applyInverseScaleX:lw.
+ lh := currentTransformation applyInverseScaleY:lh.
].
self exposeX:lx y:ly width:lw height:lh
@@ -1951,17 +2004,18 @@
those which are interested in logical coordinates
should redefine #graphicsExposeX:x:y:width:height:"
- |lx ly lw lh|
+ |lx ly lw lh currentTransformation|
lx := x.
ly := y.
lw := w.
lh := h.
- transformation notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
- lw := transformation applyInverseScaleX:lw.
- lh := transformation applyInverseScaleY:lh.
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
+ lx := currentTransformation applyInverseToX:lx.
+ ly := currentTransformation applyInverseToY:ly.
+ lw := currentTransformation applyInverseScaleX:lw.
+ lh := currentTransformation applyInverseScaleY:lh.
].
self graphicsExposeX:lx y:ly width:lw height:lh final:final
@@ -1980,14 +2034,15 @@
those which are interested in logical coordinates
should redefine #keyPress:x:y:"
- |lx ly|
+ |lx ly currentTransformation|
lx := x.
ly := y.
- transformation notNil ifTrue:[
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
lx notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
+ lx := currentTransformation applyInverseToX:lx.
+ ly := currentTransformation applyInverseToY:ly.
]
].
self keyPress:key x:lx y:ly
@@ -2007,14 +2062,15 @@
those which are interested in logical coordinates
should redefine #keyRelease:x:y:"
- |lx ly|
+ |lx ly currentTransformation|
lx := x.
ly := y.
- transformation notNil ifTrue:[
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
lx notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
+ lx := currentTransformation applyInverseToX:lx.
+ ly := currentTransformation applyInverseToY:ly.
]
].
self keyRelease:key x:lx y:ly
@@ -2034,14 +2090,15 @@
those which are interested in logical coordinates
should redefine #pointerEnter:x:y:"
- |lx ly|
+ |lx ly currentTransformation|
lx := x.
ly := y.
- transformation notNil ifTrue:[
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
lx notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
+ lx := currentTransformation applyInverseToX:lx.
+ ly := currentTransformation applyInverseToY:ly.
]
].
self pointerEnter:state x:lx y:ly
@@ -2087,20 +2144,20 @@
|action rest restKey keyCommands|
(keyCommands := self keyCommands) notNil ifTrue:[
- action := keyCommands at:key ifAbsent:[nil].
- action value
+ action := keyCommands at:key ifAbsent:[nil].
+ action value
].
key isSymbol ifTrue:[
- (key startsWith:'Basic') ifTrue:[
- "/ an unhandled BasicFoo key;
- "/ retry as Foo
- rest := key withoutPrefix:'Basic'.
- restKey := rest asSymbolIfInterned.
- restKey notNil ifTrue:[
- self keyPress:restKey x:x y:y
- ]
- ].
+ (key startsWith:'Basic') ifTrue:[
+ "/ an unhandled BasicFoo key;
+ "/ retry as Foo
+ rest := key withoutPrefix:'Basic'.
+ restKey := rest asSymbolIfInterned.
+ restKey notNil ifTrue:[
+ self keyPress:restKey x:x y:y
+ ]
+ ].
].
"Modified: 6.11.1996 / 17:51:15 / cg"
@@ -2148,53 +2205,54 @@
waitForExpose
"wait until an expose event arrives (to wait for scroll-finish)"
- |wg endPollTime pollDelay|
-
- device scrollsAsynchronous ifFalse:[
- self setGotExposeFlag.
- ^ self
+ |wg endPollTime pollDelay graphicsDevice|
+
+ graphicsDevice := self graphicsDevice.
+ graphicsDevice scrollsAsynchronous ifFalse:[
+ self setGotExposeFlag.
+ ^ self
].
wg := self windowGroup.
wg notNil ifTrue:[
- "/
- "/ a normal (suspendable) view.
- "/ wait by doing a real wait
- "/
- wg sensor waitForExposeFor:self
+ "/
+ "/ a normal (suspendable) view.
+ "/ wait by doing a real wait
+ "/
+ wg sensor waitForExposeFor:self
] ifFalse:[
- "/
- "/ a pure event driven view.
- "/ wait by doing a direct dispatch loop until the event arrives.
- "/ i.e. poll for the event
- "/
- device isWindowsPlatform ifTrue:[
- pollDelay := 1.
- ] ifFalse:[
- pollDelay := 3.
- ].
- endPollTime := Timestamp now addSeconds:pollDelay.
-
- [self gotExpose] whileFalse:[
- realized ifTrue:[
- (device exposeEventPendingFor:drawableId withSync:true) ifTrue:[
- device dispatchExposeEventFor:drawableId.
- ].
- ].
- realized ifFalse:[
- self setGotExposeFlag.
- ^ self
- ].
-
- "/ break out of the poll after a while
-
- Timestamp now > endPollTime ifTrue:[
- 'DisplaySurface [warning]: lost expose event' errorPrintCR.
- self setGotExposeFlag.
- ^ self
- ].
- Processor yield.
- ].
+ "/
+ "/ a pure event driven view.
+ "/ wait by doing a direct dispatch loop until the event arrives.
+ "/ i.e. poll for the event
+ "/
+ graphicsDevice platformName = 'WIN32' ifTrue:[
+ pollDelay := 1.
+ ] ifFalse:[
+ pollDelay := 3.
+ ].
+ endPollTime := Timestamp now addSeconds:pollDelay.
+
+ [self gotExpose] whileFalse:[
+ realized ifTrue:[
+ (graphicsDevice exposeEventPendingFor:self drawableId withSync:true) ifTrue:[
+ graphicsDevice dispatchExposeEventFor:self drawableId.
+ ].
+ ].
+ realized ifFalse:[
+ self setGotExposeFlag.
+ ^ self
+ ].
+
+ "/ break out of the poll after a while
+
+ Timestamp now > endPollTime ifTrue:[
+ 'DisplaySurface [warning]: lost expose event' errorPrintCR.
+ self setGotExposeFlag.
+ ^ self
+ ].
+ Processor yield.
+ ].
]
"Modified: / 9.1.1999 / 01:58:09 / cg"
@@ -2207,43 +2265,10 @@
first destroy menu if there is one and also destroy the GC.
then the view is physically destroyed."
- |id|
-
- self middleButtonMenu:nil.
- self keyCommands:nil.
- id := gcId.
- id notNil ifTrue:[
- gcId := nil.
- device destroyGC:id.
- ].
- self destroyView.
- Lobby unregister:self.
-
- "Modified: 8.2.1997 / 15:50:04 / cg"
-!
-
-destroyGC
- "physically destroy the gc"
-
- |id|
-
- id := gcId.
- id notNil ifTrue:[
- gcId := nil.
- device destroyGC:id.
- ].
-!
-
-destroyView
- "physically destroy the view."
-
- |id|
-
- (id := drawableId) notNil ifTrue:[
- drawableId := nil.
- device destroyView:self withId:id.
- realized := false.
- ].
+ self
+ middleButtonMenu:nil;
+ keyCommands:nil.
+ super destroy.
!
destroyed
@@ -2251,9 +2276,9 @@
|id|
- (id := drawableId) notNil ifTrue:[
- drawableId := nil.
- device removeKnownView:self withId:id.
+ (id := self drawableId) notNil ifTrue:[
+ self setId:nil.
+ self graphicsDevice removeKnownView:self withId:id.
realized := false.
].
self destroy
@@ -2261,22 +2286,6 @@
"Modified: 22.3.1997 / 14:56:34 / cg"
!
-executor
- "redefined for faster creation of finalization copies
- (only device, gcId and drawableId are needed)"
-
- |aCopy container parentId|
-
- container := self container.
- container notNil ifTrue:[ parentId := container id ].
-
- aCopy := DeviceViewHandle basicNew.
- aCopy setDevice:device id:drawableId gcId:gcId parentId:parentId.
- ^ aCopy
-
- "Created: 3.5.1996 / 15:35:13 / stefan"
-!
-
initCursor
"default cursor for all views"
@@ -2295,10 +2304,10 @@
super initialize.
eventMask := 0.
- device notNil ifTrue:[
- eventMask := device defaultEventMask.
+ self graphicsDevice notNil ifTrue:[
+ eventMask := self graphicsDevice defaultEventMask.
].
- viewBackground := background.
+ viewBackground := self background.
backed := false.
flags := 0.
self initCursor
@@ -2306,6 +2315,12 @@
"Modified: 18.1.1997 / 18:09:41 / cg"
!
+prepareForReinit
+ gc notNil ifTrue:[
+ gc prepareForReinit.
+ ].
+!
+
reAdjustGeometry
"sent late during snapin processing, nothing done here"
@@ -2316,10 +2331,12 @@
"recreate (i.e. tell X about me) after a snapin or a migration"
viewBackground isColor ifTrue:[
- viewBackground := viewBackground onDevice:device
+ viewBackground := viewBackground onDevice:self graphicsDevice
].
super recreate.
- cursor := cursor onDevice:device.
+ cursor notNil ifTrue:[
+ cursor := cursor onDevice:self graphicsDevice.
+ ].
"Modified: 28.3.1997 / 13:48:06 / cg"
!
@@ -2331,14 +2348,8 @@
!
releaseDeviceResources
- self destroyGC.
- self destroyView.
- self unregisterFromLobby.
+ super destroy.
self setDevice:nil id:nil gcId:nil.
-!
-
-unregisterFromLobby
- Lobby unregister:self.
! !
!DisplaySurface methodsFor:'keyboard commands'!
@@ -2376,12 +2387,12 @@
"return true, if a button motion event is pending.
Normally, you don't want to use this, since no polling is needed
(not even for mouse-tracking).
- Also, don't use it, since it does not honor the windowGroup,
+ Also, don't use it, since it does not honor the windowGroup,
but goes directly to the device instead.
Actually, its a historical leftover"
- device flush.
- ^ device eventPending:#buttonMotion for:drawableId
+ self graphicsDevice flush.
+ ^ self graphicsDevice eventPending:#buttonMotion for:self drawableId
!
buttonReleaseEventPending
@@ -2390,8 +2401,8 @@
goes directly to the device instead.
Actually, its a historical leftover"
- device flush.
- ^ device eventPending:#buttonRelease for:drawableId
+ self graphicsDevice flush.
+ ^ self graphicsDevice eventPending:#buttonRelease for:self drawableId
!
exposeEventPending
@@ -2403,7 +2414,7 @@
windowGroup notNil ifTrue:[
(windowGroup sensor hasExposeEventFor:self) ifTrue:[^ true].
].
- ^ device eventPending:#expose for:drawableId
+ ^ self graphicsDevice eventPending:#expose for:self drawableId
"Modified: / 15.9.1998 / 23:18:16 / cg"
!
@@ -2505,7 +2516,7 @@
beep
"output an audible beep or bell on my screen device"
- device beep; flush
+ self graphicsDevice beep; flush
"Created: 28.5.1996 / 16:16:13 / cg"
"Modified: 28.5.1996 / 16:58:25 / cg"
@@ -2520,78 +2531,10 @@
"Modified: 18.5.1996 / 15:44:33 / cg"
! !
-!DisplaySurface::DeviceViewHandle class methodsFor:'documentation'!
-
-documentation
-"
- This is used as a finalization handle for views - in previous systems,
- a shallowCopy of a view was responsible to destroy the underlying
- devices view. To make the memory requirements smaller and to speed up
- view creation a bit, this lightweight class is used now, which only
- keeps the device handle for finalization.
-
- [see also:]
- DeviceHandle DisplaySurface
-
- [author:]
- Claus Gittinger
-"
-! !
-
-!DisplaySurface::DeviceViewHandle methodsFor:'finalization'!
-
-finalize
- "the view for which I am a handle was collected
- - release system resources"
-
- |id|
-
- drawableId notNil ifTrue:[
- [
- (device viewIdKnown:drawableId) ifTrue:[
-"/ 'Display [info]: recycled view (' infoPrint. v infoPrint. ') not destroyed: ' infoPrint.
-"/ drawableId displayString infoPrintCR.
- drawableId := nil.
- ] ifFalse:[
- (id := gcId) notNil ifTrue:[
- gcId := nil.
- device deviceIOErrorSignal handle:[:ex |
- ] do:[
- device destroyGC:id.
- ]
- ].
-
- "/ care for lost-view trouble:
- "/ if the windowID is still registered,
- "/ this may be due to a not-yet-reclaimed
- "/ subview of a view which has already been destroyed
- "/ (X recycles window handles.)
- "/ In this case, we arrive here with a nil-view argument,
- "/ and a windowId, which is already reused for some other view.
- "/ The situation is detected by finding a non-nil (and non-zero)
- "/ view in the devices id<->view table for the given windowId.
-
-"/ 'GC destroy: ' print. drawableId displayString printCR.
-"/ device checkKnownViewId:drawableId.
- id := drawableId.
- drawableId := nil.
- device deviceIOErrorSignal handle:[:ex |
- ] do:[
- device destroyView:nil withId:id.
- ].
- DeviceGraphicsContext cleanupLobbyForChildrenOfViewWithDevice:device id:id.
- ]
- ] valueUninterruptably.
- ].
-
- "Created: / 25.9.1997 / 10:01:46 / stefan"
- "Modified: / 15.11.2001 / 14:17:12 / cg"
-! !
-
!DisplaySurface class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/DisplaySurface.st,v 1.162 2014-04-29 08:59:44 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DisplaySurface.st,v 1.162.2.1 2014-05-08 08:27:50 stefan Exp $'
! !
--- a/Form.st Wed Jun 04 22:33:42 2014 +0100
+++ b/Form.st Thu Jun 05 08:23:01 2014 +0100
@@ -9,10 +9,12 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+'From Smalltalk/X, Version:6.2.3.0 on 23-05-2014 at 17:22:23' !
+
"{ Package: 'stx:libview' }"
GraphicsMedium subclass:#Form
- instanceVariableNames:'depth localColorMap offset data fileName'
+ instanceVariableNames:'depth localColorMap offset data'
classVariableNames:'VeryLightGreyForm LightGreyForm GreyForm DarkGreyForm
VeryDarkGreyForm AdditionalBitmapDirectoryNames
BlackAndWhiteColorMap DitherPatternArray'
@@ -20,13 +22,6 @@
category:'Compatibility-ST80-Graphics-Display Objects'
!
-DeviceHandle subclass:#DeviceFormHandle
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- privateIn:Form
-!
-
Form subclass:#ImageForm
instanceVariableNames:''
classVariableNames:''
@@ -86,23 +81,6 @@
!Form class methodsFor:'initialization'!
-flushDeviceForms
- "recreate all forms on aDevice; called by Workstation, to
- have all background bitmaps at hand, when views are restored"
-
- Lobby do:[:aDrawable |
- aDrawable isForm ifTrue:[
- (aDrawable graphicsDevice notNil) ifTrue:[
- "now, try to recreate it"
- aDrawable recreate.
- ]
- ]
- ]
-
- "Created: 18.6.1996 / 13:04:59 / cg"
- "Modified: 5.7.1996 / 17:56:02 / cg"
-!
-
initialize
"initialize set of dictionaries to look for bitmaps"
@@ -118,16 +96,14 @@
!
reinitializeAllOn:aDevice
- "recreate all forms on aDevice; called by Workstation, to
+ "recreate all forms on aDevice; called by Workstation after snapIn, to
have all background bitmaps at hand, when views are restored"
- Lobby do:[:aDrawable |
- (aDrawable graphicsDevice == aDevice) ifTrue:[
- aDrawable isForm ifTrue:[
- "now, try to recreate it"
- aDrawable recreate.
- ]
- ]
+ Form allSubInstancesDo:[:eachForm |
+ eachForm graphicsDevice == aDevice ifTrue:[
+ "now, try to recreate it"
+ eachForm recreate.
+ ]
]
"Modified: 5.7.1996 / 17:55:58 / cg"
@@ -138,28 +114,23 @@
(something == #save) ifTrue:[
"get all bits from the device into saveable arrays"
- Lobby do:[:aDrawable |
- aDrawable isForm ifTrue:[
- (PrimitiveFailureSignal , DeviceWorkstation drawingOnClosedDeviceSignal) handle:[:ex |
- 'Form [warning]: cannot fetch form bits from device' errorPrintCR
- ] do:[
- |dev|
+ Form allSubInstancesDo:[:eachForm |
+ (PrimitiveFailureSignal , DeviceWorkstation drawingOnClosedDeviceSignal) handle:[:ex |
+ 'Form [warning]: cannot fetch form bits from device' errorPrintCR
+ ] do:[
+ |dev|
- ((dev := aDrawable device) isNil
- or:[dev isPersistentInSnapshot]) ifTrue:[
- aDrawable getBits
- ]
+ ((dev := eachForm graphicsDevice) notNil
+ and:[dev isPersistentInSnapshot]) ifTrue:[
+ eachForm getBits
]
]
]
].
(something == #restarted) ifTrue:[
"remove all left-over device info"
- Lobby do:[:aDrawable |
- aDrawable isForm ifTrue:[
- aDrawable flushDeviceHandles.
- Lobby registerChange:aDrawable
- ]
+ Form allSubInstancesDo:[:eachForm |
+ eachForm flushDeviceHandles.
]
]
@@ -542,18 +513,6 @@
"Modified: 19.12.1996 / 13:59:09 / cg"
!
-fromFile:filename on:aDevice
- "create a new form on device, aDevice and
- initialize the pixels from the file filename"
-
- <resource:#obsolete>
-
- self obsoleteMethodWarning:'please use Image>>fromFile:'.
- ^ (self onDevice:aDevice) readFromFile:filename
-
- "Modified: 5.6.1997 / 21:05:59 / cg"
-!
-
fromFile:filename resolution:dpi
"create a new form taking the bits from a file on the default device
the data in the file is assumed to be for dpi resolution;
@@ -586,22 +545,6 @@
^ (self onDevice:aDevice) readFromFile:filename resolution:dpi
"Modified: 5.6.1997 / 21:05:54 / cg"
-!
-
-readFrom:fileName
- "same as Form>>fromFile: - for ST-80 compatibility.
- WARNING:
- Please do no longer use this, since it will not work
- correctly in multi-display applications (creates the form on the
- default Display).
- Use #fromFile:on: and pass the device as argument."
-
- <resource:#obsolete>
-
- self obsoleteMethodWarning:'please use Image>>fromFile:'.
- ^ (self onDevice:Screen current) readFromFile:fileName.
-
- "Modified: 19.12.1996 / 13:59:50 / cg"
! !
!Form class methodsFor:'obsolete instance creation'!
@@ -892,26 +835,6 @@
!Form methodsFor:'Compatibility-ST80'!
-destroy
- "destroy my underlying device resource(s)"
-
- |id|
-
- (id := gcId) notNil ifTrue:[
- gcId := nil.
- device destroyGC:id.
- ].
-
- (id := drawableId) notNil ifTrue:[
- drawableId := nil.
- device destroyPixmap:id.
- ].
-
- Lobby unregister:self.
-
- "Modified: 2.4.1997 / 19:39:52 / cg"
-!
-
displayAt:aPoint
"show the receiver on the current display screen"
@@ -999,7 +922,7 @@
!
magnify:aRectangle by:scale smoothing:smooth
- ^ ((Image fromSubForm:aRectangle in:self) magnifiedBy:scale) asFormOn:device.
+ ^ ((Image fromSubForm:aRectangle in:self) magnifiedBy:scale) asFormOn:self graphicsDevice.
! !
!Form methodsFor:'accessing'!
@@ -1024,10 +947,7 @@
data notNil ifTrue:[
^ data
].
- drawableId isNil ifTrue:[
- fileName notNil ifTrue:[
- ^ (self onDevice:Screen current) bits
- ].
+ self drawableId isNil ifTrue:[
^ nil
].
@@ -1044,7 +964,7 @@
bytesPerLine := (width * spaceBitsPerPixel + 31) // 32 * 4.
inData := ByteArray uninitializedNew:(bytesPerLine * height).
- info := device getBitsFromPixmapId:drawableId x:0 y:0 width:width height:height into:inData.
+ info := self graphicsDevice getBitsFromPixmapId:self drawableId x:0 y:0 width:width height:height into:inData.
bytesPerLineIn := (info at:#bytesPerLine). "what I got"
bytesPerLine := (width * depth + 7) // 8. "what I want"
(bytesPerLine ~~ bytesPerLineIn) ifTrue:[
@@ -1146,21 +1066,6 @@
^ depth
!
-fileName
- "return the filename, from which the receiver was created,
- or nil, if it was not read from a file"
-
- ^ fileName
-!
-
-filename
- "return the filename, from which the receiver was created,
- or nil, if it was not read from a file"
-
- "/ going to be obsoleted - use #fileName
- ^ fileName
-!
-
forgetBits
"for image, which also keeps the bits - so there is
no need to hold them again here"
@@ -1237,6 +1142,85 @@
"Modified: 23.4.1996 / 10:12:48 / cg"
! !
+!Form methodsFor:'binary storage'!
+
+readBinaryContentsFrom: stream manager: manager
+ "tell the newly restored Form about restoration"
+
+ width := manager nextObject.
+ height := manager nextObject.
+ depth := manager nextObject.
+ offset := manager nextObject.
+ data := manager nextObject.
+
+"/ super readBinaryContentsFrom: stream manager: manager.
+"/ device := nil. "/ Screen current.
+
+ self restored.
+"/ self recreate.
+"/ Lobby register:self.
+
+ "
+ |f|
+
+ f := Form fromFile:'bitmaps/SBrowser.xbm'.
+ f storeBinaryOn:'foo.bos'.
+
+ (Form readBinaryFrom:'foo.bos') inspect
+ "
+!
+
+storeBinaryDefinitionOn: stream manager: manager
+ "store a binary representation of the receiver on stream.
+ This is an internal interface for binary storage mechanism.
+ Redefined to store the actual bits, even if I have been loaded
+ from a file, and to ommit all device related stuff."
+
+ |bits|
+
+ manager putIdOfClass:(self class) on:stream.
+ manager putIdOf:width on:stream.
+ manager putIdOf:height on:stream.
+ manager putIdOf:depth on:stream.
+ manager putIdOf:offset on:stream.
+ (bits := data) isNil ifTrue:[
+ bits := self bits.
+ ].
+ manager putIdOf:bits on:stream.
+
+"/ savedDevice := device.
+"/ (savedData := data) isNil ifTrue:[
+"/ data := self bits.
+"/ ].
+"/ device := nil.
+"/ super storeBinaryDefinitionOn:stream manager:manager.
+"/ data := savedData.
+"/ device := savedDevice.
+
+ "Modified: 23.4.1996 / 09:30:47 / cg"
+! !
+
+!Form methodsFor:'comanche processing'!
+
+asHtmlElementIn: htmlContainer
+ "answer my HTML representation (String),
+ as I would look like inside htmlContainer"
+
+ ^'<IMG SRC="', self comancheUrl, '">'
+!
+
+asHttpResponseTo: request
+ ^HttpResponse fromMIMEDocument: self asWebImage
+!
+
+asWebImage
+ "return a MIMEDocument"
+ | aStream |
+ aStream _ (RWBinaryOrTextStream on: '').
+ GIFReadWriter putForm: (self asFormOfDepth: 8) onStream: aStream.
+ aStream reset.
+ ^MIMEDocument contentType: MIMEDocument contentTypeGif content: aStream
+! !
!Form methodsFor:'converting'!
@@ -1266,20 +1250,15 @@
"kludge: have to unregister. Otherwise the form will be destroyed when
we are garbage collected"
- Lobby unregister:self.
- Lobby registerChange:imageForm.
+ gc finalizationLobby
+ unregister:gc;
+ registerChange:imageForm graphicsContext.
+
^ imageForm.
! !
!Form methodsFor:'copying'!
-executor
- "redefined for faster creation of finalization copies
- (only device, gcId and drawableId are needed)"
-
- ^ DeviceFormHandle basicNew setDevice:device id:drawableId gcId:gcId.
-!
-
postCopy
"redefined to copy the colorMap as well"
@@ -1311,7 +1290,7 @@
and associate it to a device (i.e. download its bits).
Added for protocol compatibility with Image."
- aDevice == device ifTrue:[
+ aDevice == self graphicsDevice ifTrue:[
^ self
].
^ self onDevice:aDevice
@@ -1323,12 +1302,10 @@
asMonochromeFormOn:aDevice
"added for protocol compatiblity with Image"
- aDevice == device ifTrue:[
- depth == 1 ifTrue:[
+ depth == 1 ifTrue:[
+ aDevice == self graphicsDevice ifTrue:[
^ self
].
- ].
- (depth == 1) ifTrue:[
^ self onDevice:aDevice
].
^ nil
@@ -1377,7 +1354,7 @@
"associate the receiver to a device (i.e. download its bits);
return a deviceForm (possibly different from the receiver)."
- aDevice == device ifTrue:[
+ aDevice == self graphicsDevice ifTrue:[
^ self
].
aDevice isNil ifTrue:[^ self].
@@ -1388,10 +1365,6 @@
"/ 'Form [info]: create from data' printCR.
^ self class width:width height:height fromArray:data onDevice:aDevice
].
- fileName notNil ifTrue:[
- "/ 'Form [info]: create from file' printCR.
- ^ (Image fromFile:fileName) asFormOn:aDevice
- ].
'Form [warning]: no bit data in #onDevice: - returning a black form.' infoPrintCR.
^ (self class width:width height:height onDevice:aDevice) clear
@@ -1475,7 +1448,7 @@
|dstX newForm |
- newForm := (self class onDevice:device)
+ newForm := (self class onDevice:self graphicsDevice)
width:width
height:height
depth:depth.
@@ -1517,7 +1490,7 @@
|dstY newForm |
- newForm := (self class onDevice:device)
+ newForm := (self class onDevice:self graphicsDevice)
width:width
height:height
depth:depth.
@@ -1563,7 +1536,7 @@
and this operation is slow anyway, use the implementation
in Image for this."
- ^ ((Image fromForm:self) magnifiedBy:extent) asFormOn:device.
+ ^ ((Image fromForm:self) magnifiedBy:extent) asFormOn:self graphicsDevice.
"
(Form fromFile:'OutputOn.64') magnifiedBy:0.5@0.5
@@ -1597,7 +1570,7 @@
^ self hardMagnifiedBy:ext
].
- newForm := (self class onDevice:device)
+ newForm := (self class onDevice:self graphicsDevice)
width:(width * mX)
height:(height * mY)
depth:depth.
@@ -1633,17 +1606,6 @@
!Form methodsFor:'initialization'!
-createGC
- "physically create a device GC.
- Since we do not need a gc-object for the drawable until something is
- really drawn, none is created up to the first draw.
- This method is sent, when the first drawing happens.
- Redefined here to create a bitmap GC (some devices (i.e. windows) require
- different GC's for different canvases."
-
- self createGCForBitmap.
-!
-
initGC
"stop server from sending exposure events for Forms -
(will fill up stream-queue on some stupid (i.e. sco) systems"
@@ -1651,12 +1613,15 @@
"/ depth-1 forms draw differently ...
depth == 1 ifTrue:[
- foreground isNil ifTrue:[
- foreground := paint := Color colorId:1.
- ].
- background isNil ifTrue:[
- background := bgPaint := Color colorId:0
- ]
+ |fg bg|
+ self foreground isNil ifTrue:[
+ fg := Color colorId:1.
+ ].
+ self background isNil ifTrue:[
+ bg := Color colorId:0
+ ].
+ "nil colors will not be set"
+ self setPaint:fg on:bg.
].
super initGC.
self setGraphicsExposures:false
@@ -1665,44 +1630,27 @@
!
initialize
- foreground := paint := Color colorId:1.
- background := bgPaint := Color colorId:0.
depth := 1.
-
super initialize.
!
recreate
"reconstruct the form after a snapin or a migration"
- self device isNil ifTrue:[^ self].
+ self graphicsDevice isNil ifTrue:[^ self].
data notNil ifTrue:[
"
create one from data
"
- (depth == 1 or:[depth == device depth]) ifTrue:[
- self createBitmapFromArray:data width:width height:height.
- Lobby registerChange:self.
+ (depth == 1 or:[depth == self graphicsDevice depth]) ifTrue:[
+ gc createBitmapFromArray:data width:width height:height.
self drawableId notNil ifTrue:[
^ self
]
].
'FORM: cannot recreate form' errorPrintCR.
].
- fileName notNil ifTrue:[
- "
- create one from a file (mhmh - this seems X-specific and will vanish)
- "
- self readFromFile:fileName.
-
-"/ drawableId := device createBitmapFromFile:fileName for:self.
-"/ Lobby registerChange:self.
- self drawableId notNil ifTrue:[
- ^ self
- ].
- 'FORM: cannot recreate file form: ' errorPrint. fileName errorPrintCR.
- ].
^ self.
@@ -1710,11 +1658,10 @@
"/ create an empty one
"/ "
"/ depth == 1 ifTrue:[
-"/ drawableId := device createBitmapWidth:width height:height
+"/ drawableId := self graphicsDevice createBitmapWidth:width height:height
"/ ] ifFalse:[
-"/ drawableId := device createPixmapWidth:width height:height depth:device depth
+"/ drawableId := self graphicsDevice createPixmapWidth:width height:height depth:self graphicsDevice depth
"/ ].
-"/ Lobby registerChange:self
"Modified: 15.6.1996 / 16:18:12 / cg"
!
@@ -1724,9 +1671,17 @@
The sender has to take care that the Form has been
unregistered from (Finalization-)Lobby"
- device := drawableId := gcId := nil.
+ self setDevice:nil id:nil gcId:nil
! !
+!Form methodsFor:'inspecting'!
+
+inspectorClass
+ "redefined to launch an ImageInspector
+ (instead of the default InspectorView)."
+
+ ^ ImageInspectorView
+! !
!Form methodsFor:'printing & storing'!
@@ -1749,16 +1704,11 @@
beImmediateForm
"read the pixels from the device into a local data array.
- This makes certain that a fileName form is independent of
- its fileName.
To make the image smaller (i.e. not keep all those bitmaps),
this is NOT done by default."
data isNil ifTrue:[
data := self bits.
- data notNil ifTrue:[
- fileName := nil
- ]
]
"
@@ -1773,8 +1723,10 @@
flushDeviceHandles
"flush device handles (sent after a restart)"
- drawableId := nil.
- gcId := nil.
+ self setDevice:self graphicsDevice id:nil gcId:nil.
+ gc notNil ifTrue:[
+ gc registerChange.
+ ].
"Created: 15.6.1996 / 15:44:28 / cg"
!
@@ -1786,90 +1738,11 @@
an image is saved, or the receiver is storedBinary, since
the information present in the device is lost after restart/reload"
- (data isNil and:[fileName isNil]) ifTrue:[
+ data isNil ifTrue:[
data := self bits
]
!
-readFromFile:fn
- "read a monochrome form from a file (in xbm-format).
- The fileName argument, fn should be a relative pathname
- such as bitmaps/foo.xbm and the corresponding file
- will be searched in the standard places (i.e. along the SEARCHPATH).
- Notice, when saving an image, only that fileName is kept with the
- form, and the file is reloaded at image startup time.
- You should therefore make certain, that the file is present at image
- reload time. (this is done to make the image smaller ...)
- If you dont like that behavior (or your application should be able to
- restart fully standAlone), send #beImmediateForm to all instances of
- Form - this will set the data instance variable to a ByteArray containing
- the actual bits and will therefore no longer depend on the file being present.
- "
-
- <resource:#obsolete>
-
- |pathName|
-
- "/ this method is a historic leftover; it uses
- "/ the X-libs bitmap file reading function, which is not
- "/ available with other windowing systems ...
- self obsoleteMethodWarning:'use Image fromFile:'.
-
- pathName := self class findBitmapFile:fn.
- pathName notNil ifTrue:[
- drawableId := device createBitmapFromFile:pathName for:self.
- drawableId isNil ifTrue:[^ nil].
-
-"/ fileName := pathName. "/ keep the actual name (wrong)
- fileName := fn. "/ keep the relative name (better - SEARCHPATH may be different at restart)
-
- offset := 0@0.
- realized := true.
- BlackAndWhiteColorMap isNil ifTrue:[
- BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
- ].
- localColorMap := BlackAndWhiteColorMap.
- Lobby registerChange:self.
- ^ self
- ].
- ^ nil
-
- "Modified: 7.2.1996 / 16:04:25 / cg"
-!
-
-readFromFile:filename resolution:dpi
- "read a monochrome form from a file, which is assumed to have data for a dpi-resolution;
- if the actual resolution of the device differs, magnify the form.
- Read the comment in #readFromFile: on what happenes if the file is no longer present
- after an image reload."
-
- <resource:#obsolete>
-
- |dpiH mag dev|
-
- (self readFromFile:filename) isNil ifTrue:[^ nil].
-
- "if the device is within +- 50% of dpi, no magnify is needed"
- dev := self device.
- dev isNil ifTrue:[
- "should not happen ..."
- dev := Screen current
- ].
- dpiH := dev isNil ifTrue:[90] ifFalse:[dev horizontalPixelPerInch].
- ((dpi >= (dpiH * 0.75)) and:[dpi <= (dpiH * 1.5)]) ifTrue:[^ self].
- mag := (dpiH / dpi) rounded.
- mag == 0 ifTrue:[
- ^ self
- ].
- ^ self magnifiedBy:(mag @ mag)
-
- "
- Form fromFile:'SBrowser.icn' resolution:50
- "
-
- "Modified: 7.2.1996 / 16:03:45 / cg"
-!
-
restored
"flush device data, when restored (sent after a binaryLoad)"
@@ -2039,9 +1912,9 @@
^ localColorMap at:(pixel + 1)
].
depth == 1 ifTrue:[
- pixel == 0 ifTrue:[^ White].
+ pixel == 0 ifTrue:[^ self whiteColor].
].
- ^ Black
+ ^ self blackColor
"Created: 28.6.1996 / 16:10:13 / cg"
"Modified: 13.1.1997 / 23:06:25 / cg"
@@ -2100,45 +1973,6 @@
"Modified: 13.5.1996 / 10:26:05 / cg"
! !
-!Form::DeviceFormHandle class methodsFor:'documentation'!
-
-documentation
-"
- This is used as a finalization handle for forms - in previous systems,
- a shallowCopy of a form was responsible to destroy the underlying
- devices bitmap. To make the memory requirements smaller and to speed up
- bitmap creation a bit, this lightweight class is used now, which only
- keeps the device handle for finalization.
-
- [see also:]
- DeviceHandle Form
-
- [author:]
- Claus Gittinger
-
-"
-! !
-
-!Form::DeviceFormHandle methodsFor:'finalization'!
-
-finalize
- "the Form for which I am a handle has been collected - tell it to the x-server"
-
- |id|
-
- drawableId notNil ifTrue:[
- (id := gcId) notNil ifTrue:[
- gcId := nil.
- device destroyGC:id.
- ].
- id := drawableId.
- drawableId := nil.
- device destroyPixmap:id.
- ]
-
- "Created: 25.9.1997 / 10:03:05 / stefan"
-! !
-
!Form::ImageForm class methodsFor:'documentation'!
documentation
@@ -2177,7 +2011,7 @@
!Form class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Form.st,v 1.151 2014-05-23 18:49:08 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Form.st,v 1.150.2.2 2014-05-23 15:42:24 stefan Exp $'
! !
--- a/GraphicsContext.st Wed Jun 04 22:33:42 2014 +0100
+++ b/GraphicsContext.st Thu Jun 05 08:23:01 2014 +0100
@@ -9,6 +9,8 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+'From Smalltalk/X, Version:6.2.3.0 on 25-03-2014 at 11:57:17' !
+
"{ Package: 'stx:libview' }"
Object subclass:#GraphicsContext
@@ -789,6 +791,9 @@
].
^ rect
].
+ transformation notNil ifTrue:[
+ ^ transformation applyInverseTo:clipRect.
+ ].
^ clipRect
"Modified: 28.5.1996 / 14:05:15 / cg"
@@ -798,15 +803,25 @@
"set the clipping rectangle for drawing (in logical coordinates);
a nil argument turn off clipping (i.e. whole view is drawable)"
- clipRect := aRectangleOrNil
+ (aRectangleOrNil notNil and:[transformation notNil]) ifTrue:[
+ clipRect := transformation applyTo:aRectangleOrNil.
+ ] ifFalse:[
+ clipRect := aRectangleOrNil
+ ].
"Modified: 22.5.1996 / 13:12:07 / cg"
"Created: 28.5.1996 / 14:09:27 / cg"
!
clippingBoundsOrNil
- "return the clipping bounds (a Rectangle) for drawing, nil if there is none."
-
+ "return the clipping bounds (a Rectangle) for drawing in logical coordinates, nil if there is none."
+
+ clipRect isNil ifTrue:[
+ ^ nil
+ ].
+ transformation notNil ifTrue:[
+ ^ transformation applyInverseTo:clipRect.
+ ].
^ clipRect
"Created: 10.4.1996 / 14:32:02 / cg"
@@ -1291,6 +1306,12 @@
^ self subclassResponsibility
!
+displayOpaqueString:aString from:index1 to:index2 x:x y:y maxWitdh:maxWidth
+ "draw part of a string with both fg and bg at x/y in current font"
+
+ ^ self subclassResponsibility
+!
+
displayPolygon:aPolygon
"draw a polygon
- this could be recoded to draw using displayLine"
@@ -2521,11 +2542,11 @@
!GraphicsContext class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.136 2014-04-12 11:35:51 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.136.2.1 2014-05-08 08:27:50 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.136 2014-04-12 11:35:51 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.136.2.1 2014-05-08 08:27:50 stefan Exp $'
! !
--- a/GraphicsMedium.st Wed Jun 04 22:33:42 2014 +0100
+++ b/GraphicsMedium.st Thu Jun 05 08:23:01 2014 +0100
@@ -9,9 +9,11 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+'From Smalltalk/X, Version:6.2.3.0 on 26-03-2014 at 14:24:09' !
+
"{ Package: 'stx:libview' }"
-DeviceGraphicsContext subclass:#GraphicsMedium
+Object subclass:#GraphicsMedium
instanceVariableNames:'gc width height realized'
classVariableNames:''
poolDictionaries:''
@@ -50,6 +52,273 @@
"
! !
+!GraphicsMedium class methodsFor:'instance creation'!
+
+new
+ "create a new drawable - take the current display as
+ its device (for now, this may be changed until the view is
+ physically created)"
+
+"
+ 'Warning: DeviceGraphicsContext (' print. self name print. ') should not be created with new' printNL.
+"
+ ^ self onDevice:Screen current.
+!
+
+on:aDevice
+ "create a new drawable on aDevice"
+
+ <resource:#obsolete>
+
+ "/ send out a warning: #on: is typically used to create a view
+ "/ operating on a model.
+ "/ Please use #onDevice: to avoid confusion.
+
+ self obsoleteMethodWarning:'use #onDevice:'.
+ ^ self onDevice:aDevice
+
+ "Modified: 5.6.1997 / 21:04:16 / cg"
+!
+
+onDevice:aDevice
+ "create a new drawable on aDevice"
+
+ ^ self basicNew initializeForDevice:aDevice.
+! !
+
+!GraphicsMedium class methodsFor:'Signal constants'!
+
+drawingOnClosedDrawableSignal
+ "return the signal which is raised, if drawing is attempted
+ on a closed drawable.
+ This is especially useful, if a forked thread animates
+ a view in the background, and is not properly synchronized
+ with the window thread - i.e. the window gets closed by the user,
+ and the background process continues to draw.
+ In this case, the background thread should handle this signal
+ and terminate itself in the handler."
+
+ ^ GraphicsContext drawingOnClosedDrawableSignal
+
+ "demonstration1: (error if closed by the windowManager):
+
+ |v|
+
+ v := StandardSystemView new openAndWait.
+ [
+ [true] whileTrue:[
+ |x y|
+
+ x := Random nextIntegerBetween:0 and:(v width).
+ y := Random nextIntegerBetween:0 and:(v height).
+ v displayString:'hello' x:x y:y.
+ Delay waitForSeconds:0.5.
+ ]
+ ] fork.
+ "
+ "demonstration2: (no error if closed by the windowManager):
+
+ |v|
+
+ v := StandardSystemView new openAndWait.
+ [
+ v class drawingOnClosedDrawableSignal handle:[:ex |
+ ex return
+ ] do:[
+ [true] whileTrue:[
+ |x y|
+
+ x := Random nextIntegerBetween:0 and:(v width).
+ y := Random nextIntegerBetween:0 and:(v height).
+ v displayString:'hello' x:x y:y.
+ Delay waitForSeconds:0.5.
+ ]
+ ]
+ ] fork.
+ "
+
+ "Created: / 29.1.1998 / 13:10:41 / cg"
+ "Modified: / 29.1.1998 / 13:11:14 / cg"
+! !
+
+!GraphicsMedium class methodsFor:'accessing-defaults'!
+
+defaultFont
+ "get the default font used for drawing"
+
+ ^ GraphicsContext defaultFont
+!
+
+defaultFont:aFont
+ "set the default font used for drawing"
+
+ GraphicsContext defaultFont:aFont
+! !
+
+!GraphicsMedium methodsFor:'Compatibility-ST80'!
+
+displayArc:origin radius:radius from:startAngle angle:angle
+ "draw an arc around a point"
+
+ self
+ displayArcX:(origin x - radius)
+ y:(origin y - radius)
+ width:(radius * 2)
+ height:(radius * 2)
+ from:startAngle
+ angle:angle
+
+ "Modified: 8.5.1996 / 08:34:43 / cg"
+!
+
+displayArcBoundedBy:boundingBox startAngle:startAngle sweepAngle:sweepAngle
+ "draw an arc/circle/ellipse - ST-80 compatibility"
+
+ ^ self displayArcX:(boundingBox left)
+ y:(boundingBox top)
+ width:(boundingBox width)
+ height:(boundingBox height)
+ from:startAngle
+ angle:sweepAngle
+
+ "Created: / 14.11.1997 / 21:04:19 / cg"
+!
+
+displayArcBoundedBy:boundingBox startAngle:startAngle sweepAngle:sweepAngle at:origin
+ "draw an arc/circle/ellipse - ST-80 compatibility"
+
+ ^ self displayArcX:(boundingBox left + origin x)
+ y:(boundingBox top + origin y)
+ width:(boundingBox width)
+ height:(boundingBox height)
+ from:startAngle
+ angle:sweepAngle
+!
+
+displayLineFrom:startPoint to:endPoint translateBy:anOffset
+ "draw a line - ST-80 compatibility"
+
+ self displayLineFrom:(startPoint + anOffset)
+ to:(endPoint + anOffset)
+!
+
+displayPolyline:aPolygon
+ "draw a polygon - ST-80 compatibility"
+
+ ^ self displayPolygon:aPolygon
+!
+
+displayRectangularBorder:aRectangle
+ "draw a rectangle - ST-80 compatibility"
+
+ self displayRectangle:aRectangle
+!
+
+displayRectangularBorder:aRectangle at:aPoint
+ "draw a rectangle - ST-80 compatibility"
+
+ self displayRectangle:(aRectangle translateBy:aPoint)
+!
+
+displayWedgeBoundedBy:boundingBox startAngle:startAngle sweepAngle:sweepAngle
+ "fill an arc/circle/ellipse - ST-80 compatibility"
+
+ ^ self fillArcX:(boundingBox left)
+ y:(boundingBox top)
+ width:(boundingBox width)
+ height:(boundingBox height)
+ from:startAngle
+ angle:sweepAngle
+
+ "Created: 27.1.1997 / 15:50:14 / cg"
+!
+
+displayWedgeBoundedBy:boundingBox startAngle:startAngle sweepAngle:sweepAngle at:origin
+ "fill an arc/circle/ellipse - ST-80 compatibility"
+
+ ^ self fillArcX:(boundingBox left + origin x)
+ y:(boundingBox top + origin y)
+ width:(boundingBox width)
+ height:(boundingBox height)
+ from:startAngle
+ angle:sweepAngle
+!
+
+findFont:aFontDescription
+ "given a fontDescription, return a device font for it
+ on my device."
+
+ ^ aFontDescription onDevice:self device
+
+ "Modified: 28.5.1996 / 20:22:29 / cg"
+!
+
+key
+ ^ self id
+!
+
+phase
+ "return the origin within the mask (used to draw with patterns).
+ This is an alias for ST/X's #maskOrigin"
+
+ ^ self maskOrigin
+!
+
+phase:aPoint
+ "set the origin within the mask (used to draw with patterns).
+ This is an alias for ST/X's #maskOrigin:"
+
+ ^ self maskOrigin:aPoint
+!
+
+setDevicePattern:aColorOrMask
+ "ST/X can paint in any color or image"
+
+ self paint:aColorOrMask
+!
+
+tilePhase
+ "return the origin within the mask (used to draw with patterns).
+ This is an alias for ST/X's #maskOrigin"
+
+ ^ self maskOrigin
+
+ "Created: 4.6.1996 / 15:26:39 / cg"
+!
+
+tilePhase:aPoint
+ "set the origin within the mask (used to draw with patterns).
+ This is an alias for ST/X's #maskOrigin"
+
+ ^ self maskOrigin:aPoint
+
+ "Created: 4.6.1996 / 15:26:49 / cg"
+!
+
+widthOfString:aString
+ "given a string, return its width in pixels if
+ drawn on the receivers device."
+
+ gc == self ifTrue:[
+ ^ super widthOfString:aString.
+ ].
+ ^ gc widthOfString:aString.
+
+ "Modified: 28.5.1996 / 20:22:22 / cg"
+!
+
+widthOfString:aString from:start to:stop
+ "given a string, return the width in pixels if
+ a substring is drawn on the receivers device."
+
+ gc == self ifTrue:[
+ ^ super widthOfString:aString from:start to:stop.
+ ].
+ ^ gc widthOfString:aString from:start to:stop.
+
+ "Modified: 28.5.1996 / 20:22:18 / cg"
+! !
+
!GraphicsMedium methodsFor:'Compatibility-Squeak'!
copyBits:aRectangle from:aForm at:srcOrigin clippingBox:clippingBox rule:rule fillColor:fillColor
@@ -57,24 +326,55 @@
(f := rule) isInteger ifTrue:[
"/ ST-80 compatibility: numeric rule
- f := #(#clear #and #andReverse #copy #andInverted #noop #xor #or #nor #equiv #invert #orInverted #copyInverted
- #orReverse #nand #set) at:(rule + 1).
+ f := #(clear and andReverse copy andInverted noop xor or nor equiv invert orInverted copyInverted
+ orReverse nand set) at:(rule + 1).
].
- oldFunction := function.
- oldClip := clipRect.
-"/
- self clippingRectangle:clippingBox.
- self function:f.
-
- self
+ oldFunction := gc function.
+ oldClip := gc clippingRectangleOrNil.
+
+ gc clippingRectangle:clippingBox.
+ gc function:f.
+
+ gc
copyFrom:aForm
x:srcOrigin x y:srcOrigin y
toX:aRectangle left y:aRectangle top
width:aRectangle width height:aRectangle height.
- self clippingRectangle:oldClip.
- self function:oldFunction.
+ gc clippingRectangle:oldClip.
+ gc function:oldFunction.
+
+ "
+ |dst src|
+
+ dst := Form width:8 height:8 fromArray:#[
+ 2r00000000
+ 2r00000000
+ 2r00000000
+ 2r00000000
+ 2r11111111
+ 2r11111111
+ 2r11111111
+ 2r11111111
+ ].
+ src := Form width:8 height:8 fromArray:#[
+ 2r00001111
+ 2r00001111
+ 2r00001111
+ 2r00001111
+ 2r00001111
+ 2r00001111
+ 2r00001111
+ 2r00001111
+ ].
+
+ dst copyBits:(0@0 corner:8@8) from:src at:0@0 clippingBox:(0@0 corner:8@8) rule:15 fillColor:Color black.
+ dst inspect
+
+ "
+
+ "Modified: / 23.10.2000 / 16:50:44 / martin"
"
|dst src|
@@ -111,18 +411,17 @@
fill:aRectangle fillColor:aColor
"fill the rectangular area specified by aRectangle with the black color"
- |oldPaint|
-
- oldPaint := paint.
- gc paint:aColor.
- gc fillRectangleX:aRectangle left y:aRectangle top width:aRectangle width height:aRectangle height.
- gc paint:oldPaint
+ gc == self ifTrue:[
+ super fill:aRectangle fillColor:aColor.
+ ^ self.
+ ].
+ gc fill:aRectangle fillColor:aColor
!
fillBlack:aRectangle
"fill the rectangular area specified by aRectangle with the black color"
- self fill:aRectangle fillColor:Black
+ self fill:aRectangle fillColor:Color black
!
fillColor:something
@@ -132,14 +431,154 @@
self fill:something
!
+fillRectangle:aRectangle color:aColor
+ "fill a rectangle with the given paint color"
+
+ gc == self ifTrue:[
+ super fillRectangle:aRectangle color:aColor.
+ ^ self.
+ ].
+ gc fillRectangle:aRectangle color:aColor
+!
+
+fillWhite
+ "fill all of the receiver with the white color"
+
+ self fill:Color white
+!
+
fillWhite:aRectangle
"fill the rectangular area specified by aRectangle with the white color"
- self fill:aRectangle fillColor:White
+ self fill:aRectangle fillColor:Color white
+! !
+
+!GraphicsMedium methodsFor:'Compatibility-VW'!
+
+displayBackgroundIfNeededOn: aGraphicsContext
+ aGraphicsContext clearView.
+!
+
+inactiveForegroundColor
+ "a dummy method to support VW widgets"
+
+ ^ self foregroundColor
+!
+
+selectionBackgroundColor
+ "a dummy method to support VW widgets"
+
+ ^ self foregroundColor
+!
+
+selectionForegroundColor
+ "a dummy method to support VW widgets"
+
+ ^ self backgroundColor
+!
+
+separatorColor
+ "a dummy method to support VW widgets"
+
+ ^ self foregroundColor
! !
!GraphicsMedium methodsFor:'accessing'!
+at:aPoint
+ "return the pixel at the coordinate given by aPoint"
+
+ ^ self atX:aPoint x y:aPoint y
+
+ "Modified: / 29.1.2000 / 12:17:42 / cg"
+!
+
+at:aPoint put:aPixelColor
+ "set a pixel"
+
+ ^ self atX:aPoint x y:aPoint y put:aPixelColor
+
+ "
+ Display rootView at:(0@0) put:(Color red).
+ Display rootView at:(1@1) put:(Color red).
+ Display rootView at:(2@2) put:(Color red).
+ Display rootView at:(3@3) put:(Color red).
+ Display rootView at:(4@4) put:(Color red).
+ Display rootView at:(5@5) put:(Color red).
+ "
+!
+
+atX:x y:y
+ "return the pixel at the coordinate given by x/y"
+
+ gc == self ifTrue:[
+ ^ super atX:x y:y
+ ].
+ ^ gc atX:x y:y
+!
+
+atX:x y:y put:aPixelColor
+ "set a pixel"
+
+ gc == self ifTrue:[
+ super atX:x y:y put:aPixelColor.
+ ^ self.
+ ].
+ gc atX:x y:y put:aPixelColor.
+!
+
+backgroundPaint
+ "return the background paint color.
+ (used for opaqueForms and opaqueStrings)"
+
+ gc == self ifTrue:[
+ ^ super backgroundPaint.
+ ].
+ ^ gc backgroundPaint
+!
+
+backgroundPaint:aColor
+ "set the background-paint color; this is used in opaque-draw
+ operations"
+
+ gc == self ifTrue:[
+ super backgroundPaint:aColor.
+ ^ self.
+ ].
+ gc backgroundPaint:aColor
+!
+
+basicFont
+ "return the font for drawing"
+
+ gc == self ifTrue:[
+ ^ super basicFont.
+ ].
+ ^ gc basicFont
+!
+
+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)"
+
+ gc == self ifTrue:[
+ super basicFont:aFont.
+ ^ self.
+ ].
+ gc basicFont:aFont
+!
+
+blackColor
+ gc isNil ifTrue:[
+ ^ Color black.
+ ].
+ gc == self ifTrue:[
+ ^ super device blackColor.
+ ].
+ ^ gc device blackColor
+!
+
bottomCenter
"return the topCenter point"
@@ -159,23 +598,184 @@
!
+capStyle
+ "return the current cap-style for line-drawing.
+ possible styles are: #notLast, #butt, #round, #projecting"
+
+ gc == self ifTrue:[
+ ^ super capStyle.
+ ].
+ ^ gc capStyle
+!
+
+capStyle:aStyleSymbol
+ "set the cap-style for line-drawing;
+ possible styles are: #notLast, #butt, #round, #projecting"
+
+ gc == self ifTrue:[
+ super capStyle:aStyleSymbol.
+ ^ self.
+ ].
+ gc capStyle:aStyleSymbol
+
+ "Modified: 12.5.1996 / 22:24:30 / cg"
+!
+
center
"return the point at the center of the receiver"
^ (self left + (width // 2)) @ (self top + (height // 2))
!
+characterEncoding
+ "returns a symbol describing how the contents is encoded internally.
+ For now, this should be the same encoding as my fonts encoding (otherwise, mappings would
+ occur when drawing).
+ This is (currently) only passed down from the fileBrowser,
+ and required when japanese/chinese/korean text is edited.
+ (encoding is something like #'iso8859-5' #euc, #sjis, #jis7, #gb, #big5 or #ksc)"
+
+ gc == self ifTrue:[
+ ^ super characterEncoding.
+ ].
+ ^ gc characterEncoding
+!
+
+characterEncoding:encodingArg
+ "define how the contents is encoded internally.
+ This should normally never be required, as ST/X now assumes
+ unicode (of which iso8859-1 is a subset) encoding.
+ The possibility to change the characterEncoding is provided as
+ a backward compatibility hook for programs which want to use
+ another encoding internally. One such view is the CharacterSetView,
+ which wants to show character as they are actually present in a font."
+
+ gc == self ifTrue:[
+ super characterEncoding:encodingArg.
+ ^ self.
+ ].
+ gc characterEncoding:encodingArg
+!
+
+clipByChildren
+ "drawing shall be done into my view only (default)"
+
+ <resource:#obsolete>
+
+ self obsoleteMethodWarning:'use #clippedByChildren:true'.
+ ^ self clippedByChildren:true
+
+ "Created: 17.7.1996 / 13:25:55 / cg"
+!
+
+clipRect
+ "return the clip-rectangle for drawing.
+ If there is currently no active clip, return the underlying
+ displaySurfaces (i.e. views) bounds. Added for ST-80 compatibility."
+
+ <resource:#obsolete>
+
+ self obsoleteMethodWarning:'use #clippingBounds'.
+ ^ self clippingBounds.
+
+ "Modified: 28.5.1996 / 14:14:53 / cg"
+!
+
+clipRect:aRectangle
+ "set the drawing clip-rectangle"
+
+ <resource:#obsolete>
+
+ self obsoleteMethodWarning:'use #deviceClippingBounds:'.
+ ^ gc deviceClippingBounds:aRectangle
+
+ "Modified: 28.5.1996 / 14:13:09 / cg"
+!
+
+clippedByChildren:aBoolean
+ "turn on/off drawing over children.
+ If on, a superview may draw 'over' its children.
+ If off (the default), drawing is 'under' its children.
+ Only useful for the rootView, to draw over any visible views.
+ (for example, when dragging a rubber-line)"
+
+ gc == self ifTrue:[
+ super clippedByChildren:aBoolean.
+ ^ self.
+ ].
+ gc clippedByChildren:aBoolean.
+
+ "Created: 17.7.1996 / 13:25:16 / cg"
+ "Modified: 29.4.1997 / 15:33:55 / dq"
+!
+
clippingBounds
- "return the clipping rectangle for drawing (in logical coordinates).
- If there is currently no clippingBounds, a dummy is created."
-
- clipRect notNil ifTrue:[
- ^ clipRect.
- ] ifFalse:[
- ^ Rectangle
- origin: 0 @ 0
- corner: width @ height
+ "return the clipping rectangle for drawing, nil if there is none."
+
+ gc == self ifTrue:[
+ ^ super clippingBounds.
+ ].
+ ^ gc clippingBounds
+!
+
+clippingBounds:aRectangleOrNil
+ "set the clipping rectangle for drawing (in logical coordinates);
+ a nil argument turn off clipping (i.e. whole view is drawable)"
+
+ gc == self ifTrue:[
+ super clippingBounds:aRectangleOrNil.
+ ^ self.
+ ].
+ gc clippingBounds:aRectangleOrNil
+!
+
+clippingBoundsOrNil
+ "return the clipping rectangle for drawing, nil if there is none."
+
+ gc == self ifTrue:[
+ ^ super clippingBoundsOrNil.
].
+ ^ gc clippingBoundsOrNil
+!
+
+clippingRectangle:aRectangleOrNil
+ "set the clipping rectangle for drawing (in logical coordinates);
+ a nil argument turn off clipping (i.e. whole view is drawable)"
+
+ <resource: #obsolete>
+
+ self clippingBounds:aRectangleOrNil
+!
+
+clippingRectangleOrNil
+ "return the clipping rectangle for drawing, nil if there is none."
+
+ <resource: #obsolete>
+
+ ^ self clippingBoundsOrNil
+!
+
+colorAt:aPoint
+ "return the color of the pixel at the coordinate given by x@y"
+
+ ^ self colorAtX:(aPoint x) y:(aPoint y)
+
+ "Modified: 1.8.1997 / 20:01:58 / cg"
+!
+
+colorAtX:x y:y
+ "return the color of the pixel at the coordinate given by aPoint"
+
+ gc == self ifTrue:[
+ ^ super colorAtX:x y:y.
+ ].
+ ^ gc colorAtX:x y:y
+!
+
+container
+ "return my container - for protocol compatibility"
+
+ ^ nil
!
corner
@@ -193,6 +793,74 @@
(aPoint y - self top + 1)
!
+dashStyle:aDashList offset:dashOffset
+ "define dashes. Each element of the dashList specifies the length
+ of a corresponding dash. For example, setting it to [4 4]
+ defines 4on-4off dashing;
+ Setting it to [1 2 4 2] defines 1on-2off-4on-2off dashes.
+ The dashOffset specifies where in the dashList the dashing starts.
+ Ignored here - this may not be supported by all graphics devices."
+
+ gc == self ifTrue:[
+ ^ super dashStyle:aDashList offset:dashOffset.
+ ].
+ ^ gc dashStyle:aDashList offset:dashOffset
+!
+
+device
+ "return the device, the receiver is associated with"
+
+ gc == self ifTrue:[
+ ^ super device.
+ ].
+ gc isNil ifTrue:[
+ ^ nil.
+ ].
+ ^ gc device
+!
+
+device:aDevice
+ "set the device"
+
+ aDevice isNil ifTrue:[
+ ^ self.
+ ].
+
+ gc isNil ifTrue:[
+ gc := aDevice newGraphicsContextFor:self.
+ ^ self.
+ ].
+
+ gc == self ifTrue:[
+ super device:aDevice.
+ ] ifFalse:[
+ gc device:aDevice
+ ].
+!
+
+deviceClippingRectangle:aRectangleOrNil
+ "set the clipping rectangle for drawing (in device coordinates);
+ a nil argument turns off clipping (i.e. whole view is drawable - incl. margins)"
+
+ gc == self ifTrue:[
+ super deviceClippingRectangle:aRectangleOrNil.
+ ^ self.
+ ].
+ gc deviceClippingRectangle:aRectangleOrNil
+!
+
+drawableId
+ "return the id of the drawable on the device"
+
+ gc == self ifTrue:[
+ ^ super drawableId.
+ ].
+ gc isNil ifTrue:[
+ ^ nil.
+ ].
+ ^ gc drawableId
+!
+
extent
"return the extent i.e. a point with width as x, height as y
coordinate"
@@ -207,6 +875,77 @@
height := extent y
!
+font
+ "return the current drawing font"
+
+ gc == self ifTrue:[
+ ^ super font.
+ ].
+ ^ gc font
+!
+
+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:"
+
+ gc == self ifTrue:[
+ super font:aFont.
+ ] ifFalse:[
+ gc font:aFont.
+ ].
+ self changed:#font.
+!
+
+function
+ "return the current drawing function"
+
+ gc == self ifTrue:[
+ ^ super function.
+ ].
+ ^ gc function
+!
+
+function:aSymbol
+ "set the drawing function if it has changed"
+
+ gc == self ifTrue:[
+ super function:aSymbol.
+ ^ self.
+ ].
+ gc function:aSymbol
+!
+
+gcId
+ "return the receivers graphic context id on the device"
+
+ gc == self ifTrue:[
+ ^ super gcId.
+ ].
+ gc isNil ifTrue:[
+ ^ nil.
+ ].
+ ^ gc gcId.
+!
+
+graphicsContext
+ "for ST-80 compatibility"
+
+ ^ gc
+!
+
+graphicsDevice
+ "same as #device, for ST-80 compatibility"
+
+ gc == self ifTrue:[
+ ^ super graphicsDevice.
+ ].
+ gc isNil ifTrue:[
+ ^ nil.
+ ].
+ ^ gc graphicsDevice
+!
+
height
"return the height of the receiver"
@@ -219,6 +958,33 @@
height := anInteger
!
+id
+ "return the id of the drawable on the device"
+
+ ^ self drawableId
+!
+
+joinStyle
+ "return the current join-style for polygon-drawing.
+ possible styles are: #miter, #bevel, #round"
+
+ gc == self ifTrue:[
+ ^ super joinStyle.
+ ].
+ ^ gc joinStyle
+!
+
+joinStyle:aStyleSymbol
+ "set the join-style of lines in polygon-drawing;
+ possible styles are: #miter, #bevel, #round"
+
+ gc == self ifTrue:[
+ super joinStyle:aStyleSymbol.
+ ^ self.
+ ].
+ gc joinStyle:aStyleSymbol
+!
+
left
"return the left i.e. x-coordinate of top-left of the receiver"
@@ -231,29 +997,177 @@
^ (self left) @ (self top + (height // 2) - 1)
!
+lineStyle
+ "return the current line-drawing-style.
+ possible styles are: #solid, #dashed, #doubleDashed,
+ #dotted, #dashDot or #dashDotDot."
+
+ gc == self ifTrue:[
+ ^ super lineStyle.
+ ].
+ ^ gc lineStyle
+!
+
+lineStyle:aStyleSymbol
+ "set the line-drawing-style;
+ possible styles are: #solid, #dashed, #doubleDashed,
+ #dotted, #dashDot or #dashDotDot."
+
+ gc == self ifTrue:[
+ super lineStyle:aStyleSymbol.
+ ^ self.
+ ].
+ gc lineStyle:aStyleSymbol
+!
+
+lineWidth
+ "return the current drawing linewidth"
+
+ gc == self ifTrue:[
+ ^ super lineWidth.
+ ].
+ ^ gc lineWidth
+!
+
+lineWidth:aNumber
+ "set the line drawing width in pixels"
+
+ gc == self ifTrue:[
+ super lineWidth:aNumber.
+ ^ self.
+ ].
+ gc lineWidth:aNumber
+!
+
+mask
+ "return the current drawing mask"
+
+ gc == self ifTrue:[
+ ^ super mask.
+ ].
+ ^ gc mask
+!
+
+mask:aForm
+ "set the drawing mask"
+
+ gc == self ifTrue:[
+ super mask:aForm.
+ ^ self.
+ ].
+ gc mask:aForm
+!
+
+maskOrigin
+ "return the origin within the mask (used to draw with patterns).
+ Should be redefined in classes which support it.
+ This is an alias for ST-80's #phase"
+
+ gc == self ifTrue:[
+ ^ super maskOrigin.
+ ].
+ ^ gc maskOrigin
+!
+
+maskOrigin:aPoint
+ "set the origin within the mask (used to draw with patterns).
+ Should be redefined in classes which support it.
+ This is an alias for ST-80's #phase:"
+
+ gc == self ifTrue:[
+ super maskOrigin:aPoint.
+ ^ self.
+ ].
+ gc maskOrigin:aPoint
+!
+
+maskOriginX:x y:y
+ "set the origin within the mask (used to draw with patterns).
+ Should be redefined in classes which support it.
+ This is an alias for ST-80's #phase:"
+
+ self maskOrigin:(x @ y)
+!
+
+medium
+ "return the destination medium i.e. the underlying graphics device"
+
+ gc == self ifTrue:[
+ ^ super graphicsDevice.
+ ].
+ ^ gc graphicsDevice
+!
+
+noClipByChildren
+ "drawing shall also be done into subviews"
+
+ <resource:#obsolete>
+
+ self obsoleteMethodWarning:'use #clippedByChildren:false'.
+ ^ self clippedByChildren:false
+
+ "Created: 17.7.1996 / 14:15:54 / cg"
+!
+
origin
"return the origin i.e. coordinate of top-left of the receiver"
^ 0 @ 0
!
+paint
+ "return the current paint drawing color"
+
+ gc == self ifTrue:[
+ ^ super paint.
+ ].
+ ^ gc paint
+!
+
+paint:aColor
+ "set the drawing painting color, aColor can be a dithered one"
+
+ gc == self ifTrue:[
+ super paint:aColor.
+ ^ self.
+ ].
+ gc paint:aColor
+!
+
+paint:fgColor on:bgColor
+ "set the paint and backgroundPaint, used for text and bitmaps.
+ Both colors may be dithered colors"
+
+ gc == self ifTrue:[
+ super paint:fgColor on:bgColor.
+ ^ self.
+ ].
+ gc paint:fgColor on:bgColor
+!
+
+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"
+!
+
realized
"return true, if the receiver is realized.
- Realized means that it has been mapped (i.e. made visible) on
- the display (as opposed to being only created and possibly invisible).
- The receiver may still be actually still unmapped (invisible), if the container is not
- yet realized.
+ The receiver may still be unmapped, if the container is unrealized.
Use reallyRealized to make certain that I am really mapped."
^ realized
!
reallyRealized
- "return true, if the receiver is realized and all containers are realized.
- Realized means that it has been mapped (i.e. made visible) on
- the display (as opposed to being only created and possibly invisible)"
+ "return true, if the receiver is realized and all containers
+ are realized."
^ self realized
+
!
rightCenter
@@ -262,6 +1176,45 @@
^ (self left + width - 1) @ (self top + (height // 2) - 1)
!
+setClippingBounds:aRectangleOrNil
+ gc == self ifTrue:[
+ super setClippingBounds:aRectangleOrNil.
+ ^ self.
+ ].
+ gc setClippingBounds:aRectangleOrNil
+!
+
+setGraphicsExposures:aBoolean
+ "want to if aBoolean is true - or don't want to be notified
+ of graphics exposures"
+
+ gc == self ifTrue:[
+ super setGraphicsExposures:aBoolean.
+ ^ self.
+ ].
+ gc setGraphicsExposures:aBoolean
+!
+
+setMaskOrigin:aPoint
+ <resource: #obsolete>
+ "set the origin within the mask (used to draw with patterns).
+ OBSOLETE: use #maskOrigin: or #phase:"
+
+ self obsoleteMethodWarning:'use #maskOrigin:'.
+ ^ self maskOriginX:aPoint x y:aPoint y
+
+ "Modified: / 26.1.1998 / 18:54:14 / cg"
+!
+
+setMaskOriginX:x y:y
+ <resource: #obsolete>
+ "set the origin within the mask (used to draw with patterns).
+ OBSOLETE: use #maskOriginX:y: or #phase:"
+
+ self obsoleteMethodWarning:'use #maskOriginX:y:'.
+ ^ self maskOriginX:x y:y
+!
+
setWidth:w height:h
"set both width and height - not to be redefined"
@@ -290,7 +1243,23 @@
viewBackground
"for protocol compatibility with view; return my background paint color here"
- ^ bgPaint
+ ^ self backgroundPaint
+!
+
+viewOrigin
+ "return the drawables visible origin (for scrolling)"
+
+ ^ 0@0
+!
+
+whiteColor
+ gc isNil ifTrue:[
+ ^ Color white.
+ ].
+ gc == self ifTrue:[
+ ^ super graphicsDevice whiteColor.
+ ].
+ ^ gc graphicsDevice whiteColor
!
width
@@ -312,6 +1281,431 @@
height := h
! !
+!GraphicsMedium methodsFor:'accessing-internals'!
+
+background
+ <resource: #obsolete>
+ "return the current background drawing color.
+ OBSOLETE: use #paint: / #backgroundPaint: / #paint:on:"
+
+ gc == self ifTrue:[
+ ^ super background.
+ ].
+ ^ gc background
+
+ "Modified: 12.5.1996 / 22:28:09 / cg"
+!
+
+background:aColor
+ <resource: #obsolete>
+ "set the internal background color for drawing - aColor must be a real color.
+ OBSOLETE: this method will vanish; use #paint: / #backgroundPaint: / #paint:on:"
+
+ gc == self ifTrue:[
+ super background:aColor.
+ ^ self.
+ ].
+ gc background:aColor
+!
+
+foreground
+ <resource: #obsolete>
+ "return the current foreground drawing color.
+ OBSOLETE: use #paint: / #paint:on:"
+
+ gc == self ifTrue:[
+ ^ super foreground.
+ ].
+ ^ gc foreground
+!
+
+foreground:aColor
+ <resource: #obsolete>
+ "set the internal foreground color for drawing - aColor must be a real color.
+ OBSOLETE: this method will vanish; use #paint: / #paint:on:"
+
+ gc == self ifTrue:[
+ super foreground:aColor.
+ ^ self.
+ ].
+ gc foreground:aColor
+!
+
+foreground:fgColor background:bgColor
+ <resource: #obsolete>
+ "set both internal foreground and internal background colors
+ - these must be real colors.
+ OBSOLETE: this method will vanish; use #paint: / #paint:on:"
+
+ gc == self ifTrue:[
+ super foreground:fgColor background:bgColor.
+ ^ self.
+ ].
+ gc foreground:fgColor background:bgColor
+!
+
+foreground:fgColor background:bgColor function:fun
+ <resource: #obsolete>
+ "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
+ <resource: #obsolete>
+ "set the foreground color and function for drawing.
+ OBSOLETE: this method will vanish; use #paint: / #paint:on:"
+
+ gc == self ifTrue:[
+ super foreground:aColor function:fun.
+ ^ self.
+ ].
+ gc foreground:aColor function:fun
+!
+
+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
+! !
+
+!GraphicsMedium methodsFor:'accessing-transformation'!
+
+scale
+ "return the scale factor (as point) of the transformation"
+
+ gc == self ifTrue:[
+ ^ super scale.
+ ].
+ ^ gc scale
+!
+
+scale:aPoint
+ "set the scale factor of the transformation"
+
+ gc == self ifTrue:[
+ super scale:aPoint.
+ ^ self.
+ ].
+ ^ gc scale:aPoint
+!
+
+transformation
+ "return the transformation"
+
+ gc == self ifTrue:[
+ ^ super transformation.
+ ].
+ ^ gc transformation
+!
+
+transformation:aTransformation
+ "set the transformation"
+
+ gc == self ifTrue:[
+ super transformation:aTransformation.
+ ^ self.
+ ].
+ ^ gc transformation:aTransformation
+!
+
+translateBy:aPoint
+ "add to the translation offset of the transformation"
+
+ gc == self ifTrue:[
+ super translateBy:aPoint.
+ ^ self.
+ ].
+ ^ gc translateBy:aPoint
+!
+
+translation
+ "return the translation factor (as point) of the transformation"
+
+ gc == self ifTrue:[
+ ^ super translation.
+ ].
+ ^ gc translation
+!
+
+translation:aPoint
+ "set the translation offset of the transformation"
+
+ gc == self ifTrue:[
+ super translation:aPoint.
+ ^ self.
+ ].
+ ^ gc translation:aPoint
+! !
+
+!GraphicsMedium methodsFor:'basic drawing'!
+
+displayArcX:x y:y width:width height:height from:startAngle angle:angle
+ "draw an arc in a box
+ - this could be recoded to draw using displayLine"
+
+ gc == self ifTrue:[
+ super displayArcX:x y:y width:width height:height from:startAngle angle:angle.
+ ^ self.
+ ].
+ gc displayArcX:x y:y width:width height:height from:startAngle angle:angle
+!
+
+displayDottedRectangleX:x y:y width:w height:h
+ "draw a dotted-line rectangle
+ A general implementation is found here; deviceGC's
+ may reimplement this if directly supported by the device"
+
+ gc == self ifTrue:[
+ super displayDottedRectangleX:x y:y width:w height:h.
+ ^ self.
+ ].
+ gc displayDottedRectangleX:x y:y width:w height:h
+!
+
+displayHorizontalWavelineFromX:x0 y:y0 toX:x1
+ "draw a horizontal wave-line from x0/y0 to x1/y0"
+
+ gc == self ifTrue:[
+ super displayHorizontalWavelineFromX:x0 y:y0 toX:x1.
+ ^ self.
+ ].
+ gc displayHorizontalWavelineFromX:x0 y:y0 toX:x1
+!
+
+displayLineFromX:x0 y:y0 toX:x1 y:y1
+ "draw a line from x0/y0 to x1/y1"
+
+ gc == self ifTrue:[
+ super displayLineFromX:x0 y:y0 toX:x1 y:y1.
+ ^ self.
+ ].
+ gc displayLineFromX:x0 y:y0 toX:x1 y:y1
+!
+
+displayOpaqueForm:aForm x:x y:y
+ "draw a form at x/y; if the form has depth 1, 1's in the form are
+ drawn in current fg, 0's in current bg color.
+ If the form has depth ~~ 1, it is copied as is onto the receiver"
+
+ gc == self ifTrue:[
+ super displayOpaqueForm:aForm x:x y:y.
+ ^ self.
+ ].
+ gc displayOpaqueForm:aForm x:x y:y
+!
+
+displayOpaqueString:aString from:index1 to:index2 x:x y:y
+ "draw part of a string with both fg and bg at x/y in current font"
+
+ gc == self ifTrue:[
+ super displayString:aString from:index1 to:index2 x:x y:y opaque:true maxWidth:self width.
+ ^ self.
+ ].
+ gc displayString:aString from:index1 to:index2 x:x y:y opaque:true maxWidth:self width
+!
+
+displayPolygon:aPolygon
+ "draw a polygon
+ - this could be recoded to draw using displayLine"
+
+ gc == self ifTrue:[
+ super displayPolygon:aPolygon.
+ ^ self.
+ ].
+ gc displayPolygon:aPolygon
+!
+
+displayRectangleX:x y:y width:w height:h
+ "draw a rectangle
+ - this could be recoded to draw using displayLine"
+
+ gc == self ifTrue:[
+ super displayRectangleX:x y:y width:w height:h.
+ ^ self.
+ ].
+ gc displayRectangleX:x y:y width:w height:h
+!
+
+displayString:aString from:index1 to:index2 x:x y:y
+ "draw part of a string with fg at x/y in current font"
+
+ gc displayString:aString from:index1 to:index2 x:x y:y opaque:false maxWidth:self width
+!
+
+displayString:aString from:index1 to:index2 x:x y:y opaque:opaque
+ "draw part of a string with both fg and bg at x/y in current font"
+
+ self displayString:aString from:index1 to:index2 x:x y:y opaque:opaque maxWidth:self width.
+!
+
+displayString:aString from:index1 to:index2 x:x y:y opaque:opaque maxWidth:maxWidth
+ "draw part of a string with both fg and bg at x/y in current font"
+
+ gc == self ifTrue:[
+ super displayString:aString from:index1 to:index2 x:x y:y opaque:opaque maxWidth:maxWidth.
+ ^ self.
+ ].
+ gc displayString:aString from:index1 to:index2 x:x y:y opaque:opaque maxWidth:maxWidth
+! !
+
+!GraphicsMedium methodsFor:'basic filling'!
+
+fillArcX:x y:y width:w height:h from:start angle:angle
+ "fill an arc with current paint color"
+
+ gc == self ifTrue:[
+ super fillArcX:x y:y width:w height:h from:start angle:angle.
+ ^ self.
+ ].
+ gc fillArcX:x y:y width:w height:h from:start angle:angle
+!
+
+fillPolygon:points
+ "fill a polygon with current paint color"
+
+ gc == self ifTrue:[
+ super fillPolygon:points.
+ ^ self.
+ ].
+ gc fillPolygon:points
+!
+
+fillRectangleX:x y:y width:w height:h
+ "fill a rectangle with current paint color"
+
+ gc == self ifTrue:[
+ super fillRectangleX:x y:y width:w height:h.
+ ^ self.
+ ].
+ gc fillRectangleX:x y:y width:w height:h
+!
+
+fillRectangleX:x y:y width:w height:h color:aColor
+ "fill a rectangle with given color"
+
+ gc == self ifTrue:[
+ super fillRectangleX:x y:y width:w height:h color:aColor.
+ ^ self.
+ ].
+ gc fillRectangleX:x y:y width:w height:h color:aColor
+! !
+
+!GraphicsMedium methodsFor:'bit blitting'!
+
+copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth padding:pad 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."
+
+ gc == self ifTrue:[
+ super copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth padding:pad width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY.
+ ^ self.
+ ].
+ gc copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth padding:pad width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY
+!
+
+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.
+ Assumes the source bits are in ST/X's natural padding (i.e. 8-bit padded)"
+
+ gc == self ifTrue:[
+ super copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY.
+ ^ self.
+ ].
+ gc copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY
+!
+
+copyFrom:aGC toX:dstX y:dstY
+ "copy from a drawable - maybe self"
+
+ gc == self ifTrue:[
+ super copyFrom:aGC toX:dstX y:dstY.
+ ^ self.
+ ].
+ gc copyFrom:aGC toX:dstX y:dstY
+!
+
+copyFrom:aGC x:srcX y:srcY toX:dstX y:dstY width:w height:h
+ "copy from a drawable - maybe self"
+
+ gc == self ifTrue:[
+ super copyFrom:aGC x:srcX y:srcY toX:dstX y:dstY width:w height:h.
+ ^ self.
+ ].
+ gc copyFrom:aGC x:srcX y:srcY toX:dstX y:dstY width:w height:h
+!
+
+copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h async:async
+ "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.
+ If the receiver is a view AND async is true, the call returns immediately
+ - otherwise, it returns when the scroll operation is finished.
+ (not all devices care for this).
+ If the receiver is a pixmap, the call always returns immediately."
+
+ |myDevice deviceDrawable asy|
+
+ myDevice := gc graphicsDevice.
+
+ ((aDrawable graphicsDevice ~~ myDevice)
+ or:[aDrawable isImage]) ifTrue:[
+ deviceDrawable := aDrawable asFormOn:myDevice.
+ ] ifFalse:[
+ deviceDrawable := aDrawable
+ ].
+ asy := async or:[self isView not].
+ asy ifFalse:[
+ self catchExpose
+ ].
+ gc == self ifTrue:[
+ super copyFrom:deviceDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h async:async.
+ ] ifFalse:[
+ gc copyFrom:deviceDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h async:async.
+ ].
+ asy ifFalse:[
+ myDevice flush.
+ self waitForExpose
+ ]
+!
+
+copyFrom:aGC x:dstX y:dstY width:w height:h
+ "copy from a drawable - maybe self"
+
+ gc == self ifTrue:[
+ super copyFrom:aGC x:dstX y:dstY width:w height:h.
+ ^ self.
+ ].
+ gc copyFrom:aGC x:dstX y:dstY width:w height:h
+!
+
+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."
+
+ gc == self ifTrue:[
+ super copyPlaneFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h.
+ ^ self.
+ ].
+ gc copyPlaneFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h
+! !
+
!GraphicsMedium methodsFor:'copying'!
postCopy
@@ -326,12 +1720,1037 @@
realized := false.
! !
+!GraphicsMedium methodsFor:'drawing'!
+
+display:someObject at:aPoint
+ "draw someObject - this must understand the #displayOn:at: message"
+
+ someObject displayOn:self at:aPoint
+
+ "Created: 28.5.1996 / 14:22:57 / cg"
+!
+
+displayArcIn:aRectangle from:startAngle angle:angle
+ "draw an arc in a box"
+
+ self
+ displayArcX:(aRectangle left)
+ y:(aRectangle top)
+ width:(aRectangle width)
+ height:(aRectangle height)
+ from:startAngle
+ angle:angle
+!
+
+displayArcOrigin:origin corner:corner from:startAngle angle:angle
+ "draw an arc in a box"
+
+ |left top right bot|
+
+ left := origin x.
+ top := origin y.
+ right := corner x.
+ bot := corner y.
+ self
+ displayArcX:left
+ y:top
+ width:(right - left + 1)
+ height:(bot - top + 1)
+ from:startAngle
+ angle:angle
+
+ "Modified: 8.5.1996 / 08:35:25 / cg"
+!
+
+displayArcX:x y:y w:w h:h from:startAngle angle:angle
+ "draw an arc; apply transformation if nonNil"
+
+ <resource:#obsolete>
+
+ self obsoleteMethodWarning:'use #displayArcX:y:width:height:from:angle:'.
+ self displayArcX:x y:y width:w height:h from:startAngle angle:angle
+
+ "Modified: 8.5.1996 / 08:46:56 / cg"
+!
+
+displayCircle:aPoint radius:r
+ "draw a circle around a center point"
+
+ gc == self ifTrue:[
+ super displayCircleX:(aPoint x) y:(aPoint y) radius:r.
+ ^ self.
+ ].
+ gc displayCircleX:(aPoint x) y:(aPoint y) radius:r
+!
+
+displayCircleIn:aRectangle
+ "draw a circle in a box"
+
+ self
+ displayArcX:(aRectangle left)
+ y:(aRectangle top)
+ width:(aRectangle width)
+ height:(aRectangle height)
+ from:0
+ angle:360
+
+ "Modified: 8.5.1996 / 08:35:40 / cg"
+!
+
+displayCircleX:x y:y radius:r
+ "draw a circle around a center point"
+
+ |d|
+ d := 2 * r.
+ self
+ displayArcX:(x - r)
+ y:(y - r)
+ width:d
+ height:d
+ from:0
+ angle:360
+
+ "Modified: 8.5.1996 / 08:36:03 / cg"
+!
+
+displayForm:aFormOrImage
+ "draw a form (or image) at the origin"
+
+ gc == self ifTrue:[
+ super displayForm:aFormOrImage x:0 y:0.
+ ^ self.
+ ].
+ gc displayForm:aFormOrImage x:0 y:0
+
+ "Modified: / 24.4.1997 / 16:00:11 / cg"
+ "Created: / 9.11.1997 / 00:50:52 / cg"
+!
+
+displayForm:aFormOrImage at:aPoint
+ "draw a form (or image)"
+
+ gc == self ifTrue:[
+ super displayForm:aFormOrImage x:(aPoint x) y:(aPoint y).
+ ^ self.
+ ].
+ gc displayForm:aFormOrImage x:(aPoint x) y:(aPoint y)
+
+ "Modified: 24.4.1997 / 16:00:11 / cg"
+!
+
+displayForm:formToDraw x:x y:y
+ "draw a form or image non opaque;
+ 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)."
+
+ gc == self ifTrue:[
+ super displayForm:formToDraw x:x y:y.
+ ^ self.
+ ].
+ gc displayForm:formToDraw x:x y:y
+!
+
+displayForm:aFormOrImage x:x y:y opaque:opaque
+ "draw a form (or image) at x/y;
+ if the form has depth 1, 1's in the form are
+ drawn in current paint color, 0's are ignored.
+ If the form has depth ~~ 1, the current fg color setting is ignored."
+
+ opaque ifTrue:[
+ self displayOpaqueForm:aFormOrImage x:x y:y
+ ] ifFalse:[
+ self displayForm:aFormOrImage x:x y:y
+ ].
+!
+
+displayImage:aFormOrImage
+ "draw an image (or form).
+ Provided for ST-80 compatibilty;
+ in ST/X, images are also handled by #displayForm:"
+
+ gc == self ifTrue:[
+ super displayForm:aFormOrImage x:0 y:0.
+ ^ self.
+ ].
+ gc displayForm:aFormOrImage x:0 y:0
+!
+
+displayImage:aFormOrImage at:aPoint
+ "draw an image (or form).
+ Provided for ST-80 compatibilty;
+ in ST/X, images are also handled by #displayForm:"
+
+ gc == self ifTrue:[
+ super displayForm:aFormOrImage x:(aPoint x) y:(aPoint y).
+ ^ self.
+ ].
+ gc displayForm:aFormOrImage x:(aPoint x) y:(aPoint y)
+
+ "Modified: 24.4.1997 / 16:02:43 / cg"
+!
+
+displayImage:aFormOrImage x:x y:y
+ "draw an image (or form).
+ Provided for ST-80 compatibilty;
+ in ST/X, images are also handled by #displayForm:"
+
+ gc == self ifTrue:[
+ super displayForm:aFormOrImage x:x y:y.
+ ^ self.
+ ].
+ gc displayForm:aFormOrImage x:x y:y
+
+ "Created: 24.4.1997 / 16:03:03 / cg"
+!
+
+displayLineFrom:point1 to:point2
+ "draw a line"
+
+ gc == self ifTrue:[
+ super displayLineFromX:(point1 x) y:(point1 y)
+ toX:(point2 x) y:(point2 y).
+ ^ self.
+ ].
+ gc displayLineFromX:(point1 x) y:(point1 y)
+ toX:(point2 x) y:(point2 y)
+!
+
+displayLineFromX:xStart y:yStart toX:xEnd y:yEnd brush:aForm
+ "draw a line using a brush.
+ Here, a slow fallback is used, drawing into a
+ temporary bitmap first, which is then displayed"
+
+ |deltaX deltaY dx dy px py destX destY p tempForm
+ xMin xMax yMin yMax x1 x2 y1 y2|
+
+ xStart < xEnd ifTrue:[
+ xMin := xStart.
+ xMax := xEnd.
+ ] ifFalse:[
+ xMin := xEnd.
+ xMax := xStart
+ ].
+ yStart < yEnd ifTrue:[
+ yMin := yStart.
+ yMax := yEnd.
+ ] ifFalse:[
+ yMin := yEnd.
+ yMax := yStart
+ ].
+
+ tempForm := Form width:(xMax-xMin+1+aForm width)
+ height:(yMax-yMin+1+aForm height)
+ depth:aForm depth
+ onDevice:self graphicsDevice.
+ tempForm clear.
+ tempForm paint:(Color colorId:1) on:(Color colorId:0).
+ tempForm function:#or.
+
+ ((yStart = yEnd and:[xStart < xEnd])
+ or: [yStart < yEnd]) ifTrue:[
+ x1 := xStart. y1 := yStart.
+ x2 := xEnd. y2 := yEnd.
+ ] ifFalse:[
+ x1 := xEnd. y1 := yEnd.
+ x2 := xStart. y2 := yStart.
+ ].
+
+ x1 := x1 - xMin. x2 := x2 - xMin.
+ y1 := y1 - yMin. y2 := y2 - yMin.
+
+ destX := x1.
+ destY := y1.
+
+ "/ bresenham ...
+
+ deltaX := x2 - x1.
+ deltaY := y2 - y1.
+
+ dx := deltaX sign.
+ dy := deltaY sign.
+ px := deltaY abs.
+ py := deltaX abs.
+
+ tempForm displayForm:aForm x:destX y:destY.
+
+ py > px ifTrue:[
+ "horizontal"
+ p := py // 2.
+ py timesRepeat:[
+ destX := destX + dx.
+ (p := p - px) < 0 ifTrue:[
+ destY := destY + dy.
+ p := p + py
+ ].
+ tempForm displayForm:aForm x:destX y:destY.
+ ]
+ ] ifFalse:[
+ "vertical"
+ p := px // 2.
+ px timesRepeat:[
+ destY := destY + dy.
+ (p := p - py) < 0 ifTrue:[
+ destX := destX + dx.
+ p := p + px
+ ].
+ tempForm displayForm:aForm x:destX y:destY
+ ]
+ ].
+ self displayForm:tempForm
+ x:xMin-aForm offset x
+ y:yMin-aForm offset y.
+ tempForm close
+
+ "Modified: 1.4.1997 / 21:29:06 / cg"
+!
+
+displayOpaqueString:aString at:aPoint
+ "draw a string with both fg and bg"
+
+ gc == self ifTrue:[
+ super displayOpaqueString:aString x:(aPoint x) y:(aPoint y).
+ ^ self.
+ ].
+ gc displayOpaqueString:aString x:(aPoint x) y:(aPoint y)
+!
+
+displayOpaqueString:aString from:start to:stop at:aPoint
+ "draw part of a string - drawing both fg and bg"
+
+ gc displayString:aString from:start to:stop x:aPoint x y:aPoint x opaque:true maxWidth:self width.
+!
+
+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."
+
+ gc == self ifTrue:[
+ super displayOpaqueString:aString x:x y:y.
+ ^ self.
+ ].
+ gc displayOpaqueString:aString x:x y:y
+!
+
+displayOpaqueString:aString x:x y:y angle:drawAngle
+ "draw a string along a (possibly non-horizontal) line,
+ drawing both fg and bg pixels.
+ The angle is in degrees, clock-wise, starting with 0 for
+ a horizontal draw.
+ Drawing is done by first drawing the string into a temporary bitmap,
+ which is rotated and finally drawn as usual.
+ NOTICE: due to the rotation of the temporary bitmap, this is a slow
+ operation - not to be used with cillions of strings ..."
+
+ gc == self ifTrue:[
+ super displayString:aString x:x y:y angle:drawAngle opaque:true.
+ ^ self.
+ ].
+ gc displayString:aString x:x y:y angle:drawAngle opaque:true
+
+ "
+ |v|
+
+ v := View new.
+ v extent:300@200.
+ v openAndWait.
+ 0 to:360 by:45 do:[:a |
+ v paint:Color black on:Color red.
+ v displayOpaqueString:'hello world' x:100 y:100 angle:a.
+ ].
+ "
+
+ "in contrast to non-opaque draw:
+ |v|
+
+ v := View new.
+ v extent:300@200.
+ v openAndWait.
+ 0 to:360 by:45 do:[:a |
+ v paint:Color black on:Color red.
+ v displayString:'hello world' x:100 y:100 angle:a.
+ ].
+ "
+
+ "Modified: 23.4.1997 / 17:50:23 / cg"
+!
+
+displayPoint:aPoint
+ "draw a pixel"
+
+ gc == self ifTrue:[
+ super displayPointX:(aPoint x) y:(aPoint y).
+ ^ self.
+ ].
+ gc displayPointX:(aPoint x) y:(aPoint y)
+!
+
+displayPointX:x y:y
+ "draw a point (with current paint-color); apply transformation if nonNil"
+
+ gc == self ifTrue:[
+ super displayPointX:x y:y.
+ ^ self.
+ ].
+ gc displayPointX:x y:y
+!
+
+displayRectangle:aRectangle
+ "draw a rectangle"
+
+ self displayRectangleX:(aRectangle left)
+ y:(aRectangle top)
+ width:(aRectangle width)
+ height:(aRectangle height)
+!
+
+displayRectangleOrigin:origin corner:corner
+ "draw a rectangle"
+
+ |top left|
+
+ left := origin x.
+ top := origin y.
+ self displayRectangleX:left y:top
+ width:(corner x - left)
+ height:(corner y - top)
+!
+
+displayRectangleOrigin:origin extent:extent
+ "draw a rectangle"
+
+ self displayRectangleX:(origin x) y:(origin y)
+ width:(extent x)
+ height:(extent y)
+!
+
+displayRoundRectangleX:left y:top width:width height:height wCorner:wCorn hCorner:hCorn
+ |right bottom wC hC wHalf hHalf isWin32|
+
+ "/ BIG KLUDGE WARNING HERE: the code below looks "good" on windows displays;
+ "/ (if you change anything under Unix, make it X-platform specific.
+ "/ (there seem to be drawing incompatibilities between Win- and XWorkstation)
+
+ isWin32 := self device platformName = 'WIN32'.
+
+ right := left + width-1.
+ bottom := top + height-1.
+
+ wC := wCorn.
+ hC := hCorn.
+
+ self scale = 1 ifTrue:[
+ wHalf := wC // 2.
+ hHalf := hC // 2.
+ ] ifFalse:[
+ wHalf := wC / 2.
+ hHalf := hC / 2.
+ ].
+
+ "top left arc"
+ self displayArcX:left y:top width:wC height:hC from:90 angle:90.
+
+ "top right arc"
+ self displayArcX:(right - wC) y:top width:wC height:hC from:0 angle:90.
+
+ "bottom right arc"
+ (isWin32 and:[self scale = 1]) ifTrue:[
+ self displayArcX:(right - wC+1) y:(bottom - hC+1) width:wC height:hC from:270 angle:90.
+ ] ifFalse:[
+ self displayArcX:(right - wC) y:(bottom - hC) width:wC height:hC from:270 angle:90.
+ ].
+
+ "bottom left arc"
+ self displayArcX:left y:(bottom - hC) width:wC height:hC from:180 angle:90.
+
+ "top line"
+ self displayLineFromX:(left + wHalf) y:top toX:(right - wHalf-1) y:top.
+
+ "left line"
+ self displayLineFromX:left y:(top + hHalf - 1) toX:left y:(bottom - hHalf - 2).
+
+ "bottom line"
+ self displayLineFromX:(left + wHalf-1) y:bottom
+ toX:(right - wHalf ) y:bottom.
+
+ "right line"
+ self displayLineFromX:right y:(top + hHalf) toX:right y:(bottom - hHalf).
+
+
+ "
+ |v|
+
+ (v := View new) extent:200@200; openAndWait.
+ v displayRoundRectangleX:10 y:10 width:100 height:100 wCorner:20 hCorner:20
+ "
+!
+
+displayString:aString at:aPoint
+ "draw a string - drawing fg only"
+
+ self displayString:aString x:aPoint x y:aPoint y
+!
+
+displayString:aString centeredAtX:x y:y
+ "draw a string - drawing fg only"
+
+ |w h|
+
+ w := aString widthOn:self.
+ h := aString heightOn:self.
+ self displayString:aString x:x-(w/2) y:y-(h/2)
+!
+
+displayString:aString from:start to:stop at:aPoint
+ "draw part of a string - drawing fg only"
+
+ ^ self displayString:aString from:start to:stop x:aPoint x y:aPoint y
+!
+
+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."
+
+ self displayString:aString from:1 to:aString size x:x y:y opaque:false maxWidth:self width.
+!
+
+displayString:aString x:x y:y angle:drawAngle
+ "draw a string along a (possibly non-horizontal) line - drawing fg only.
+ The angle is in degrees, clock-wise, starting with 0 for
+ a horizontal draw.
+ Drawing is done by first drawing the string into a temporary bitmap,
+ which is rotated and finally drawn as usual.
+ NOTICE: due to the rotation of the temporary bitmap, this is a slow
+ operation - not to be used with cillions of strings ..."
+
+ self
+ displayString:aString x:x y:y angle:drawAngle opaque:false
+
+ "
+ |v|
+
+ v := View new.
+ v extent:300@200.
+ v openAndWait.
+ 0 to:360 by:90 do:[:a |
+ v paint:Color black.
+ v displayString:'hello world' x:100 y:100 angle:a.
+ ].
+ "
+ "
+ |v|
+
+ v := View new.
+ v extent:400@400.
+ v openAndWait.
+ 0 to:360 by:5 do:[:a |
+ v paint:Color black.
+ v displayString:'.........hello' x:200 y:200 angle:a.
+ ].
+ "
+ "
+ |v|
+
+ v := View new.
+ v extent:200@100.
+ v openAndWait.
+ v displayString:' hello' x:90 y:50 angle:0.
+ v displayString:' hello' x:90 y:50 angle:45.
+ v displayString:' hello' x:90 y:50 angle:90.
+ v displayString:' hello' x:90 y:50 angle:180.
+ v displayString:' hello' x:90 y:50 angle:270.
+ "
+ "
+ |v|
+
+ v := View new.
+ v extent:200@100.
+ v openAndWait.
+ v displayString:'hello' x:50 y:50 angle:0.
+ v displayString:'hello' x:50 y:50 angle:45.
+ v displayString:'hello' x:50 y:50 angle:90.
+ v displayString:'hello' x:50 y:50 angle:135.
+ v displayString:'hello' x:50 y:50 angle:180.
+ v displayString:'hello' x:50 y:50 angle:225.
+ v displayString:'hello' x:50 y:50 angle:270.
+ v displayString:'hello' x:50 y:50 angle:315.
+ "
+
+ "Modified: 24.4.1997 / 12:51:25 / cg"
+!
+
+displayString:aString x:x y:y angle:drawAngle opaque:opaque
+ "common code to draw a string along a (possibly non-horizontal) line.
+ The angle is in degrees, clock-wise, starting with 0 for
+ a horizontal draw.
+ Drawing is done by first drawing the string into a temporary bitmap,
+ which is rotated and finally drawn as usual.
+ NOTICE: due to the rotation of the temporary bitmap, this is a slow
+ operation - not to be used with cillions of strings ...
+ CAVEAT: if the string is not a real string (i.e. a LabelAndIcon),
+ this can (currently) only be done opaque"
+
+ gc == self ifTrue:[
+ super displayString:aString x:x y:y angle:drawAngle opaque:opaque.
+ ^ self.
+ ].
+ gc displayString:aString x:x y:y angle:drawAngle opaque:opaque
+!
+
+displayUnscaledForm:formToDraw x:x y:y
+ "draw a form or image non opaque and unscaled;
+ 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."
+
+ gc == self ifTrue:[
+ super displayUnscaledForm:formToDraw x:x y:y.
+ ^ self.
+ ].
+ gc displayUnscaledForm:formToDraw x:x y:y
+!
+
+displayUnscaledOpaqueForm:formToDraw x:x y:y
+ "draw a form or image opaque and unscaled;
+ 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."
+
+ gc == self ifTrue:[
+ super displayUnscaledOpaqueForm:formToDraw x:x y:y.
+ ^ self.
+ ].
+ gc displayUnscaledOpaqueForm:formToDraw x:x y:y
+!
+
+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."
+
+ gc == self ifTrue:[
+ super displayUnscaledOpaqueString:aString from:index1 to:index2 x:x y:y.
+ ^ self.
+ ].
+ gc displayUnscaledOpaqueString:aString from:index1 to:index2 x:x y:y
+!
+
+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."
+
+ gc == self ifTrue:[
+ super displayUnscaledOpaqueString:aString x:x y:y.
+ ^ self.
+ ].
+ gc displayUnscaledOpaqueString:aString x:x y:y
+!
+
+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."
+
+ gc == self ifTrue:[
+ super displayUnscaledString:aString from:index1 to:index2 x:x y:y.
+ ^ self.
+ ].
+ gc displayUnscaledString:aString from:index1 to:index2 x:x y:y
+!
+
+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."
+
+ gc == self ifTrue:[
+ super displayUnscaledString:aString x:x y:y.
+ ^ self.
+ ].
+ gc displayUnscaledString:aString x:x y:y
+! !
+
+!GraphicsMedium methodsFor:'drawing in device coordinates'!
+
+displayDeviceForm:aForm x:x y:y
+ "draw a form or image non opaque (i.e. only foreground color is drawn);
+ 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;
+ however, the mask is applied if present.
+
+ The form should must have been allocated on the same device,
+ otherwise its converted here, which slows down the draw.
+ No transformation or scaling is done.
+ 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)."
+
+ gc == self ifTrue:[
+ super displayDeviceForm:aForm x:x y:y.
+ ^ self.
+ ].
+ gc displayDeviceForm:aForm x:x y:y
+!
+
+displayDeviceLineFromX:x1 y:y1 toX:x2 y:y2
+ "draw a line in device coordinates"
+
+ gc == self ifTrue:[
+ super displayDeviceLineFromX:x1 y:y1 toX:x2 y:y2.
+ ^ self.
+ ].
+ gc displayDeviceLineFromX:x1 y:y1 toX:x2 y:y2
+!
+
+displayDeviceOpaqueForm:aForm x:x y:y
+ "draw a form or image opaque (i.e. both fg and bg is drawn);
+ 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.
+ Any mask is ignored.
+ 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 should have been allocated on the same device; otherwise,
+ its converted here, which slows down the draw.
+ Drawing is in device coordinates; no scaling is done."
+
+ gc == self ifTrue:[
+ super displayDeviceOpaqueForm:aForm x:x y:y.
+ ^ self.
+ ].
+ gc displayDeviceOpaqueForm:aForm 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
+ the case where paint and/or bgPaint are dithered colors.
+ No translation or scaling is done."
+
+ gc == self ifTrue:[
+ super displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:x y:y.
+ ^ self.
+ ].
+ gc displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:x y:y
+!
+
+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:self 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:self font x:x y:y
+!
+
+displayDeviceRectangleX:x y:y width:w height:h
+ "draw a rectangle in device coordinates"
+
+ gc == self ifTrue:[
+ super displayDeviceRectangleX:x y:y width:w height:h.
+ ^ self.
+ ].
+ gc displayDeviceRectangleX:x y:y width:w height:h
+!
+
+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"
+
+ gc == self ifTrue:[
+ super displayDeviceString:aString from:index1 to:index2 in:font x:x y:y.
+ ^ self.
+ ].
+ gc displayDeviceString:aString from:index1 to:index2 in:font x:x y:y
+!
+
+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:self 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:self font x:x y:y
+!
+
+fillDeviceRectangleX:x y:y width:w height:h
+ "fill a rectangle with current paint color (device coordinates)"
+
+ gc == self ifTrue:[
+ super fillDeviceRectangleX:x y:y width:w height:h.
+ ^ self.
+ ].
+ gc fillDeviceRectangleX:x y:y width:w height:h
+! !
+
+!GraphicsMedium methodsFor:'edge drawing'!
+
+drawEdgesForX:x y:y width:w height:h level:l
+ "draw 3D edges into a rectangle"
+ self
+ drawEdgesForX:x y:y width:w height:h level:l
+ shadow:self blackColor light:self whiteColor
+ halfShadow:nil halfLight:nil
+ style:nil
+!
+
+drawEdgesForX:x y:y width:w height:h level:l
+ shadow:shadowColor light:lightColor
+ halfShadow:halfShadowColor halfLight:halfLightColor
+ style:edgeStyle
+
+ "draw 3D edges into a rectangle"
+
+ |topLeftFg botRightFg topLeftHalfFg botRightHalfFg
+ count "{ Class: SmallInteger }"
+ r
+ b
+ xi "{ Class: SmallInteger }"
+ yi "{ Class: SmallInteger }"
+ run paint|
+
+ count := l.
+ (count < 0) ifTrue:[
+ topLeftFg := shadowColor.
+ botRightFg := lightColor.
+ topLeftHalfFg := halfShadowColor.
+ botRightHalfFg := halfLightColor.
+ count := count negated
+ ] ifFalse:[
+ topLeftFg := lightColor.
+ botRightFg := shadowColor.
+ topLeftHalfFg := halfLightColor.
+ botRightHalfFg := halfShadowColor.
+ ].
+ topLeftHalfFg isNil ifTrue:[
+ topLeftHalfFg := topLeftFg
+ ].
+ botRightHalfFg isNil ifTrue:[
+ botRightHalfFg := botRightFg
+ ].
+
+ r := x + w - 1. "right"
+ b := y + h - 1. "bottom"
+
+ self lineWidth:0.
+
+ "top and left edges"
+ ((edgeStyle == #soft or:[edgeStyle == #softWin95]) and:["l" count > 0]) ifTrue:[
+ paint := topLeftHalfFg
+ ] ifFalse:[
+ paint := topLeftFg
+ ].
+ self paint:paint.
+
+ 0 to:(count - 1) do:[:i |
+ run := y + i.
+ run < b ifTrue:[
+ self displayDeviceLineFromX:x y:run toX:r y:run. "top"
+ ].
+ run := x + i.
+ self displayDeviceLineFromX:run y:y toX:run y:b "left"
+ ].
+ (edgeStyle == #soft or:[edgeStyle == #softWin95]) ifTrue:[
+"
+ self paint:topLeftFg.
+ self displayDeviceLineFromX:x y:y toX:r y:y.
+ self displayDeviceLineFromX:x y:y toX:x y:b
+"
+ (l > 1) ifTrue:[
+ edgeStyle == #softWin95 ifTrue:[
+ self paint:(Color veryLightGrey).
+ ] ifFalse:[
+ (l > 2 and:[edgeStyle == #soft]) ifTrue:[
+ self paint:(self device blackColor).
+ ] ifFalse:[
+ self paint:halfLightColor.
+ ]
+ ].
+ self displayDeviceLineFromX:x y:y toX:r y:y.
+ self displayDeviceLineFromX:x y:y toX:x y:b.
+ ]
+ ].
+
+ xi := x + 1.
+ yi := y + 1.
+
+"/ does not look good
+"/ style == #st80 iftrue:[
+"/ yi := yi + 1
+"/ ].
+
+ "bottom and right edges"
+ ((edgeStyle == #soft or:[edgeStyle == #softWin95])
+ "new:" and:[count > 1]) ifTrue:[
+ paint := botRightHalfFg
+ ] ifFalse:[
+ paint := botRightFg
+ ].
+
+ self paint:paint.
+ 0 to:(count - 1) do:[:i |
+ run := b - i.
+ run > y ifTrue:[
+ self displayDeviceLineFromX:xi-1 y:run toX:r y:run. "bottom"
+ ].
+ run := r - i.
+ self displayDeviceLineFromX:run y:yi-1 toX:run y:b. "right"
+ xi := xi + 1.
+ yi := yi + 1
+ ].
+ ((edgeStyle == #soft or:[edgeStyle == #softWin95])
+ and:[l > 1]) ifTrue:[
+ self paint:(self device blackColor) "shadowColor".
+ self displayDeviceLineFromX:x y:b toX:r y:b.
+ self displayDeviceLineFromX:r y:y toX:r y:b
+ ].
+
+ self edgeDrawn:#all
+
+ "Modified: / 24.8.1998 / 18:23:02 / cg"
+!
+
+edgeDrawn:whichOne
+ "a redefinable hook for views which like to draw
+ over their edges (some checkToggles do).
+ Nothing done here."
+
+ "Created: 7.3.1997 / 17:59:07 / cg"
+! !
+
+!GraphicsMedium methodsFor:'evaluating in another context'!
+
+reverseDo:aBlock
+ "evaluate aBlock with foreground and background interchanged.
+ This can be reimplemented here in a faster way."
+
+ gc == self ifTrue:[
+ super reverseDo:aBlock.
+ ^ self.
+ ].
+ gc reverseDo:aBlock
+!
+
+withBackground:fgColor do:aBlock
+ "evaluate aBlock with changed background."
+
+ gc == self ifTrue:[
+ super withBackground:fgColor do:aBlock.
+ ^ self.
+ ].
+ gc withBackground:fgColor do:aBlock
+!
+
+withForeground:fgColor background:bgColor do:aBlock
+ "evaluate aBlock with changed foreground and background."
+
+ gc == self ifTrue:[
+ super withForeground:fgColor background:bgColor do:aBlock.
+ ^ self.
+ ].
+ gc withForeground:fgColor background:bgColor do:aBlock
+!
+
+withForeground:fgColor background:bgColor function:aFunction do:aBlock
+ "evaluate aBlock with foreground, background and function"
+
+ gc == self ifTrue:[
+ super withForeground:fgColor background:bgColor function:aFunction do:aBlock.
+ ^ self.
+ ].
+ gc withForeground:fgColor background:bgColor function:aFunction do:aBlock
+!
+
+withForeground:fgColor background:bgColor mask:aMask do:aBlock
+ "evaluate aBlock with foreground, background and mask"
+
+ gc == self ifTrue:[
+ super withForeground:fgColor background:bgColor mask:aMask do:aBlock.
+ ^ self.
+ ].
+ gc withForeground:fgColor background:bgColor mask:aMask do:aBlock
+!
+
+withForeground:fgColor do:aBlock
+ "evaluate aBlock with changed foreground."
+
+ gc == self ifTrue:[
+ super withForeground:fgColor do:aBlock.
+ ^ self.
+ ].
+ gc withForeground:fgColor do:aBlock
+!
+
+withForeground:fgColor function:aFunction do:aBlock
+ "evaluate aBlock with changed foreground and function."
+
+ gc == self ifTrue:[
+ super withForeground:fgColor function:aFunction do:aBlock.
+ ^ self.
+ ].
+ gc withForeground:fgColor function:aFunction do:aBlock
+!
+
+xoring:aBlock
+ "evaluate aBlock with function xoring"
+
+ gc == self ifTrue:[
+ super xoring:aBlock.
+ ^ self.
+ ].
+ gc xoring:aBlock
+! !
+
!GraphicsMedium methodsFor:'filling'!
black
"fill the receiver with black"
- self fill:Black
+ self fill:self blackColor
!
clear
@@ -340,6 +2759,18 @@
self clearView.
!
+clearDeviceRectangleX:x y:y width:w height:h
+ "clear a rectangular area to viewBackground -
+ redefined since GraphicsMedium fills with background
+ - not viewBackground as we want here."
+
+ gc == self ifTrue:[
+ super clearDeviceRectangleX:x y:y width:w height:h.
+ ^ self.
+ ].
+ gc clearDeviceRectangleX:x y:y width:w height:h.
+!
+
clearInside
"clear the receiver with background - ST-80 compatibility"
@@ -360,8 +2791,8 @@
|oldPaint|
- oldPaint := paint.
- gc paint:bgPaint.
+ oldPaint := gc paint.
+ gc paint:gc backgroundPaint.
gc fillRectangleX:left y:top width:w height:h.
gc paint:oldPaint
@@ -372,7 +2803,7 @@
"clear the receiver with background"
"currently need this kludge for form ..."
- transformation isNil ifTrue:[
+ gc transformation isNil ifTrue:[
self clearRectangleX:0 y:0 width:width height:height
] ifFalse:[
self clearDeviceRectangleX:0 y:0 width:width height:height
@@ -385,60 +2816,501 @@
|oldPaint|
- oldPaint := paint.
- gc paint:something.
- gc fillRectangleX:0 y:0 width:width height:height.
- gc paint:oldPaint
+ oldPaint := self paint.
+ self paint:something.
+ self fillRectangleX:0 y:0 width:width height:height.
+ self paint:oldPaint
"Modified: 28.5.1996 / 20:13:29 / cg"
!
+fillArc:origin radius:r from:startAngle angle:angle
+ "draw a filled arc around a point"
+
+ |d|
+ d := 2 * r.
+ self
+ fillArcX:(origin x - r)
+ y:(origin y - r)
+ width:d
+ height:d
+ from:startAngle
+ angle:angle
+
+ "Modified: 8.5.1996 / 08:41:54 / cg"
+!
+
+fillArcIn:aRectangle from:startAngle angle:angle
+ "draw a filled arc in a box"
+
+ self
+ fillArcX:(aRectangle left)
+ y:(aRectangle top)
+ width:(aRectangle width)
+ height:(aRectangle height)
+ from:startAngle
+ angle:angle
+
+ "Created: 13.4.1996 / 20:56:03 / cg"
+ "Modified: 8.5.1996 / 08:42:13 / cg"
+!
+
+fillArcOrigin:origin corner:corner from:startAngle angle:angle
+ "draw a filled arc in a box"
+
+ |left top right bot|
+
+ left := origin x.
+ top := origin y.
+ right := corner x.
+ bot := corner y.
+ self
+ fillArcX:left
+ y:top
+ width:(right - left + 1)
+ height:(bot - top + 1)
+ from:startAngle
+ angle:angle
+
+ "Created: 13.4.1996 / 20:56:56 / cg"
+ "Modified: 8.5.1996 / 08:42:23 / cg"
+!
+
+fillArcX:x y:y w:w h:h from:startAngle angle:angle
+ "draw a filled arc; apply transformation if nonNil"
+
+ <resource:#obsolete>
+
+ self obsoleteMethodWarning:'use #fillArcX:y:width:height:from:angle:'.
+ self fillArcX:x y:y width:w height:h from:startAngle angle:angle
+
+ "Modified: 8.5.1996 / 08:47:52 / cg"
+!
+
+fillArcX:x y:y width:w height:h from:startAngle to:endAngle
+ "draw a filled arc in a box, given startAngle and endAngle."
+
+ self
+ fillArcX:x
+ y:y
+ width:w
+ height:h
+ from:startAngle
+ angle:(endAngle - startAngle)
+
+ "Created: 8.5.1996 / 08:52:41 / cg"
+!
+
+fillCircle:aPoint radius:aNumber
+ "draw a filled circle around aPoint"
+
+ self fillCircleX:(aPoint x) y:(aPoint y) radius:aNumber
+!
+
+fillCircleIn:aRectangle
+ "draw a filled circle in a box"
+
+ self
+ fillArcX:(aRectangle left)
+ y:(aRectangle top)
+ width:(aRectangle width)
+ height:(aRectangle height)
+ from:0
+ angle:360
+
+ "Created: 13.4.1996 / 20:57:41 / cg"
+ "Modified: 8.5.1996 / 08:42:38 / cg"
+!
+
+fillCircleX:x y:y radius:r
+ "draw a filled circle around x@y"
+
+ |d|
+
+ d := 2 * r.
+ self
+ fillArcX:(x - r)
+ y:(y - r)
+ width:d
+ height:d
+ from:0
+ angle:360
+
+ "Modified: 8.5.1996 / 08:43:02 / cg"
+!
+
+fillRectangle:aRectangle
+ "fill a rectangle with current paint color"
+
+ self fillRectangleX:(aRectangle left)
+ y:(aRectangle top)
+ width:(aRectangle width)
+ height:(aRectangle height)
+!
+
+fillRectangleLeft:left top:top right:cornerX bottom:cornerY
+ "draw a filled rectangle.
+ Notice: the cornerPoint itself is NOT included"
+
+ self fillRectangleX:left y:top width:(cornerX - left) height:(cornerY - top)
+!
+
+fillRectangleOrigin:origin corner:corner
+ "draw a filled rectangle.
+ Notice: the cornerPoint itself is NOT included"
+
+ |top left|
+
+ left := origin x.
+ top := origin y.
+ self fillRectangleX:left y:top width:(corner x - left) height:(corner y - top)
+
+ "Created: 13.4.1996 / 20:58:16 / cg"
+!
+
+fillRectangleOrigin:origin extent:extent
+ "draw a filled rectangle.
+ Notice: the cornerPoint itself is NOT included"
+
+ self fillRectangleX:(origin x) y:(origin y) width:(extent x) height:(extent y)
+!
+
+fillRoundRectangleX:left y:top width:width height:height wCorner:wCorn hCorner:hCorn
+ |right bottom wC hC wHalf hHalf|
+
+ right := left + width.
+ bottom := top + height.
+
+ wC := wCorn.
+ hC := hCorn.
+
+ wHalf := wC / 2.
+ hHalf := hC / 2.
+
+ self device platformName = #WIN32 ifTrue:[
+ "/ bug workaround
+ "top left arc"
+ self fillArcX:left y:top width:wC height:hC from:90 angle:90.
+ "top right arc"
+ self fillArcX:(right - wC - 1) y:top width:wC height:hC from:0 angle:90.
+ "bottom right arc"
+ self fillArcX:(right - wC - 1) y:(bottom - hC - 1) width:wC height:hC from:270 angle:90.
+ "bottom left arc"
+ self fillArcX:left y:(bottom - hC) width:wC height:hC-1 from:180 angle:90.
+
+ "center rectangle"
+ self fillRectangleX:(left + wHalf) y:top width:(width - wHalf - wHalf+1) height:height-1.
+ "left partial rectangle"
+ self fillRectangleX:left y:top+hHalf width:wHalf height:(height-hHalf-hHalf).
+ "right partial rectangle"
+ self fillRectangleX:right-wHalf y:top+hHalf width:wHalf-1 height:(height-hHalf-hHalf).
+ ] ifFalse:[
+ "top left arc"
+ self fillArcX:left y:top width:wC height:hC from:90 angle:90.
+ "top right arc"
+ self fillArcX:(right - wC) y:top width:wC height:hC from:0 angle:90.
+ "bottom right arc"
+ self fillArcX:(right - wC - 1) y:(bottom - hC) width:wC height:hC from:270 angle:90.
+ "bottom left arc"
+ self fillArcX:left y:(bottom - hC) width:wC height:hC from:180 angle:90.
+
+ "center rectangle"
+ self fillRectangleX:(left + wHalf) y:top width:(width - wHalf - wHalf+1) height:height.
+ "left partial rectangle"
+ self fillRectangleX:left y:top+hHalf width:wHalf height:(height-hHalf-hHalf).
+ "right partial rectangle"
+ self fillRectangleX:right-wHalf y:top+hHalf width:wHalf height:(height-hHalf-hHalf).
+ ].
+
+
+ "
+ |v|
+
+ (v := View new) extent:200@200; openAndWait.
+ v fillRoundRectangleX:10 y:10 width:100 height:100 wCorner:20 hCorner:20
+ "
+!
+
invertRectangle:aRectangle
"invert a rectangle in the receiver"
- gc xoring:[
- gc fillRectangle:aRectangle
+ self xoring:[
+ self fillRectangle:aRectangle
]
!
white
"fill the receiver with white"
- gc fill:White
+ self fill:Color white
! !
-!GraphicsMedium methodsFor:'initialization'!
+!GraphicsMedium methodsFor:'initialization & release'!
+
+close
+ "same as destroy - for ST-80 compatibility"
+
+ self destroy
+
+ "Created: 2.4.1997 / 19:31:27 / cg"
+!
+
+destroy
+ "destroy a medium - here the fc is completely destroyed"
+
+ gc notNil ifTrue:[
+ gc destroy.
+ ].
+ realized := false.
+!
+
+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"
+
+ gc == self ifTrue:[
+ super initGC.
+ ^ self.
+ ].
+ gc initGC
+!
initialize
- "set up some useful default values"
-
super initialize.
width := 0.
height := 0.
realized := false.
-
- "/ in the future, gc will be set to some object which really does
- "/ all the graphics work, and the drawXXX drawing operation methods
- "/ will be changed to forward to it. Then, GraphicsMedium will no longer inherit
- "/ from DeviceGraphicsContext.
- "/ In the meantime (the intermediate migration phase), gc is set to alias self,
- "/ so we are backward compatible.
- "/ During the migration, all self drawXXX operations should be changed to gc drawXXX
- gc := self.
+!
+
+initializeForDevice:aDevice
+ "allocate a GraphicsContext for a device"
+
+ aDevice notNil ifTrue:[
+ gc := aDevice newGraphicsContextFor:self.
+ ] ifFalse:[
+ "should not be reached"
+ GraphicsMedium superclass == DeviceGraphicsContext ifTrue:[
+ gc := self.
+ super device:aDevice.
+ ].
+ ].
+
+ self initialize.
+!
+
+recreate
+ "reacreate a medium after snapIn"
+
+ gc notNil ifTrue:[
+ gc recreate.
+ ].
+!
+
+releaseGC
+ "destroy the associated device GC resource - can be done to be nice to the
+ display if you know that you are done with a drawable."
+
+ gc == self ifTrue:[
+ super releaseGC.
+ ^ self.
+ ].
+ gc notNil ifTrue:[
+ gc releaseGC.
+ ].
+! !
+
+!GraphicsMedium methodsFor:'misc'!
+
+clippedTo:aRectangle do:aBlock
+ |oldClip|
+
+ oldClip := gc deviceClippingBoundsOrNil.
+ gc clippingBounds:aRectangle.
+
+ aBlock
+ ensure:[
+ gc deviceClippingBounds:oldClip
+ ]
+!
+
+flush
+ "send all buffered drawing to the device."
+
+ gc == self ifTrue:[
+ super flush.
+ ^ self.
+ ].
+ gc flush
+!
+
+setDevice:aDevice id:aDrawbleId gcId:aGCId
+ "private"
+
+ gc == self ifTrue:[
+ super setDevice:aDevice id:aDrawbleId gcId:aGCId.
+ ^ self.
+ ].
+ gc notNil ifTrue:[
+ gc setDevice:aDevice id:aDrawbleId gcId:aGCId
+ ].
+!
+
+setId:aDrawableId
+ "private"
+
+ gc == self ifTrue:[
+ super setId:aDrawableId.
+ ^ self.
+ ].
+ gc setId:aDrawableId
+!
+
+setPaint:fgColor on:bgColor
+ "set the paint and background-paint color.
+ The bg-paint is used in opaque-draw operations.
+ Only set the variables, but do not send it to the device,
+ Used on initialization."
+
+ gc == self ifTrue:[
+ super setPaint:fgColor on:bgColor.
+ ^ self.
+ ].
+ gc setPaint:fgColor on:bgColor
!
-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
+sync
+ "send all buffered drawing to the device and wait until the device responds"
+
+ gc == self ifTrue:[
+ super sync.
+ ^ self.
+ ].
+ gc sync
+! !
+
+!GraphicsMedium methodsFor:'printing & storing'!
+
+storeOn:aStream
+ "blocked: ascii storeString not possible (recursive - view - subviews - container)"
+
+ self shouldNotImplement.
+ "if proceeded from exception..."
+ self printOn:aStream.
! !
-!GraphicsMedium class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libview/GraphicsMedium.st,v 1.22 2014-02-06 11:50:14 cg Exp $'
+!GraphicsMedium methodsFor:'queries'!
+
+fontAscent
+ "answer the ascent of the current font on the current device"
+
+ gc == self ifTrue:[
+ ^ super fontAscent.
+ ].
+ ^ gc fontAscent
+!
+
+horizontalIntegerPixelPerMillimeter
+ "return the (rounded) number of pixels per millimeter"
+
+ ^ self horizontalPixelPerMillimeter asInteger
+!
+
+horizontalPixelPerInch
+ "return the number of horizontal pixels per inch of the display"
+
+ ^ self horizontalPixelPerMillimeter * 25.4
+!
+
+horizontalPixelPerMillimeter
+ "return the number of pixels per millimeter (not rounded)"
+
+ gc == self ifTrue:[
+ ^ super horizontalPixelPerMillimeter.
+ ].
+ ^ gc horizontalPixelPerMillimeter
+!
+
+horizontalPixelPerMillimeter:millis
+ "return the number of pixels (not rounded) for millis millimeter"
+
+ ^ self horizontalPixelPerMillimeter * millis
+!
+
+resolution
+ "return a point consisting of pixel-per-inch horizontally and vertically."
+
+ gc == self ifTrue:[
+ ^ super resolution.
+ ].
+ ^ gc resolution
+!
+
+verticalIntegerPixelPerMillimeter
+ "return the (rounded) number of pixels per millimeter"
+
+ ^ self verticalPixelPerMillimeter rounded
+!
+
+verticalPixelPerInch
+ "return the number of vertical pixels per inch of the display"
+
+ ^ self verticalPixelPerMillimeter * 25.4
+!
+
+verticalPixelPerMillimeter
+ "return the number of pixels per millimeter (not rounded)"
+
+ gc == self ifTrue:[
+ ^ super verticalPixelPerMillimeter.
+ ].
+ ^ gc verticalPixelPerMillimeter
+!
+
+verticalPixelPerMillimeter:millis
+ "return the number of pixels (not rounded) for millis millimeter"
+
+ ^ self verticalPixelPerMillimeter * millis
! !
+!GraphicsMedium methodsFor:'view creation'!
+
+createBitmapFromArray:data width:width height:height
+ "create a bitmap from data and set the drawableId"
+
+ gc == self ifTrue:[
+ super createBitmapFromArray:data width:width height:height.
+ ^ self.
+ ].
+ gc createBitmapFromArray:data width:width height:height
+!
+
+createPixmapWidth:w height:h depth:d
+ "create a pixmap and set the drawableId"
+
+ gc == self ifTrue:[
+ super createPixmapWidth:w height:h depth:d.
+ ^ self.
+ ].
+ gc createPixmapWidth:w height:h depth:d
+!
+
+createRootWindow
+ gc == self ifTrue:[
+ super createRootWindowFor:self.
+ ^ self.
+ ].
+ gc createRootWindowFor:self
+!
+
+createWindowFor:aView type:typeSymbol origin:org extent:ext minExtent:minE maxExtent:maxE borderWidth:bw subViewOf:sv style:styleSymbol inputOnly:inp label:label owner:owner icon:icn iconMask:icnM iconView:icnV
+ "create a window and set the drawableId"
+
+ gc == self ifTrue:[
+ super createWindowFor:aView type:typeSymbol origin:org extent:ext minExtent:minE maxExtent:maxE borderWidth:bw subViewOf:sv style:styleSymbol inputOnly:inp label:label owner:owner icon:icn iconMask:icnM iconView:icnV.
+ ^ self.
+ ].
+ gc createWindowFor:aView type:typeSymbol origin:org extent:ext minExtent:minE maxExtent:maxE borderWidth:bw subViewOf:sv style:styleSymbol inputOnly:inp label:label owner:owner icon:icn iconMask:icnM iconView:icnV
+! !
+
--- a/SimpleView.st Wed Jun 04 22:33:42 2014 +0100
+++ b/SimpleView.st Thu Jun 05 08:23:01 2014 +0100
@@ -838,12 +838,11 @@
newView := self basicNew.
aView notNil ifTrue:[
- newView device:(aView graphicsDevice).
+ newView initializeForDevice:(aView graphicsDevice).
"/ newView container:aView.
] ifFalse:[
- newView device:Screen current
- ].
- newView initialize.
+ newView initializeForDevice:Screen current
+ ].
aView notNil ifTrue:[aView addSubView:newView].
^ newView
@@ -1089,20 +1088,18 @@
DefaultFont notNil ifTrue:[^ DefaultFont].
- DefaultFont isNil ifTrue:[
- self == SimpleView ifFalse:[
- f := self superclass defaultFont.
- ] ifTrue:[
- f := super defaultFont
- ].
+ self == SimpleView ifTrue:[
+ f := super defaultFont
+ ] ifFalse:[
+ f := self superclass defaultFont.
].
f notNil ifTrue:[
- DefaultFont := f.
- f := f onDevice:(Screen current).
- f notNil ifTrue:[
- DefaultFont := f.
- ]
+ DefaultFont := f.
+ f := f onDevice:Screen current.
+ f notNil ifTrue:[
+ DefaultFont := f.
+ ]
].
^ DefaultFont
@@ -1116,10 +1113,10 @@
DefaultFont := aFont.
aFont notNil ifTrue:[
- f := aFont onDevice:(Screen current).
- f notNil ifTrue:[
- DefaultFont := f.
- ]
+ f := aFont onDevice:(Screen current).
+ f notNil ifTrue:[
+ DefaultFont := f.
+ ]
]
"Modified: 18.3.1996 / 12:56:20 / cg"
@@ -2841,7 +2838,9 @@
!
layout:aLayoutObject
- "set the layout object which controls my geometry."
+ "set the layout object which controls my geometry.
+ Currently, this is almost nowhere used but views will be
+ incrementally changed to use this new geometry management."
layout = aLayoutObject ifFalse:[
layout := aLayoutObject.
@@ -3876,74 +3875,68 @@
bitGravity ~~ gravity ifTrue:[
bitGravity := gravity.
- super bitGravity:gravity.
+ gc bitGravity:gravity.
]
!
-clippingBounds:aRectangle
+clippingBounds:aRectangleOrNil
"set the clipping rectangle for drawing (in logical coordinates);
a nil argument turns off clipping (i.e. whole view is drawable).
Redefined to care for any margin."
- |x y w h currentClippingBounds|
+ |x y w h currentClippingBounds newBounds|
currentClippingBounds := gc clippingBoundsOrNil.
-
- aRectangle isNil ifTrue:[
- currentClippingBounds isNil ifTrue:[^ self].
- gc gcId notNil ifTrue:[
- gc graphicsDevice noClipIn:gc drawableId gc:gc gcId
- ]
- ] ifFalse:[
- currentClippingBounds notNil ifTrue:[
- (currentClippingBounds = aRectangle) ifTrue:[^ self]
+ (currentClippingBounds = aRectangleOrNil) ifTrue:[
+ ^ self
+ ].
+ newBounds := aRectangleOrNil.
+
+ aRectangleOrNil notNil ifTrue:[
+ |currentTransformation|
+
+ x := aRectangleOrNil left.
+ y := aRectangleOrNil top.
+ w := aRectangleOrNil width.
+ h := aRectangleOrNil height.
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
+ x := currentTransformation applyToX:x.
+ y := currentTransformation applyToY:y.
+ w := currentTransformation applyScaleX:w.
+ h := currentTransformation applyScaleY:h.
+ ].
+ (x isMemberOf:SmallInteger) ifFalse:[
+ w := w + (x - x truncated).
+ x := x truncated
].
- gc gcId notNil ifTrue:[
- |currentTransformation|
-
- x := aRectangle left.
- y := aRectangle top.
- w := aRectangle width.
- h := aRectangle height.
- currentTransformation := gc transformation.
- currentTransformation notNil ifTrue:[
- x := currentTransformation applyToX:x.
- y := currentTransformation applyToY:y.
- w := currentTransformation applyScaleX:w.
- h := currentTransformation applyScaleY:h.
- ].
- (x isMemberOf:SmallInteger) ifFalse:[
- w := w + (x - x truncated).
- x := x truncated
- ].
- (y isMemberOf:SmallInteger) ifFalse:[
- h := h + (y - y truncated).
- y := y truncated
- ].
- (w isMemberOf:SmallInteger) ifFalse:[
- w := w truncated + 1
- ].
- (h isMemberOf:SmallInteger) ifFalse:[
- h := h truncated + 1
- ].
- x < margin ifTrue:[
- x := margin.
- ].
- y < margin ifTrue:[
- y := margin.
- ].
- x + w - 1 >= (width-margin) ifTrue:[
- w := width - margin - x
- ].
- y + h - 1 >= (height-margin) ifTrue:[
- h := height - margin - y
- ].
- w := w max:0.
- h := h max:0.
- self graphicsDevice setClipX:x y:y width:w height:h in:self drawableId gc:gc gcId
- ]
- ].
- self setClippingBounds:aRectangle
+ (y isMemberOf:SmallInteger) ifFalse:[
+ h := h + (y - y truncated).
+ y := y truncated
+ ].
+ (w isMemberOf:SmallInteger) ifFalse:[
+ w := w truncated + 1
+ ].
+ (h isMemberOf:SmallInteger) ifFalse:[
+ h := h truncated + 1
+ ].
+ x < margin ifTrue:[
+ x := margin.
+ ].
+ y < margin ifTrue:[
+ y := margin.
+ ].
+ x + w - 1 >= (width-margin) ifTrue:[
+ w := width - margin - x
+ ].
+ y + h - 1 >= (height-margin) ifTrue:[
+ h := height - margin - y
+ ].
+ w := w max:0.
+ h := h max:0.
+ newBounds := Rectangle left:x top:y width:w height:h.
+ ].
+ gc deviceClippingBounds:newBounds
"Created: 28.5.1996 / 19:50:03 / cg"
"Modified: 28.5.1996 / 22:32:15 / cg"
@@ -4020,7 +4013,7 @@
viewGravity ~~ gravity ifTrue:[
viewGravity := gravity.
- super viewGravity:gravity.
+ gc viewGravity:gravity.
]
! !
@@ -4176,17 +4169,18 @@
setViewOrigin:aPoint
"set the viewOrigin - i.e. virtually scroll without redrawing"
- |p currentTransformation|
-
- p := aPoint negated.
+ |currentTransformation|
+
currentTransformation := gc transformation.
currentTransformation isNil ifTrue:[
- gc transformation:(WindowingTransformation scale:1 translation:p).
+ (aPoint x ~~ 0 or:[aPoint y ~~ 0]) ifTrue:[
+ gc transformation:(WindowingTransformation scale:1 translation:aPoint negated).
+ ].
] ifFalse:[
- currentTransformation translation:p
+ currentTransformation translation:aPoint negated.
].
self clippingBoundsOrNil notNil ifTrue:[
- self setInnerClip.
+ self setInnerClip.
].
!
@@ -4320,7 +4314,7 @@
visible."
self beVisible.
- self graphicsDevice sync. "that's a round-trip; when returning, the view is definitely visible"
+ self graphicsDevice sync. "thats a round-trip; when returning, the view is definitely visible"
"/ realized := true.
"/ shown := true.
@@ -5334,11 +5328,11 @@
"redraw my edges (if any)"
(level ~~ 0) ifTrue:[
- shown ifTrue:[
- self clippingRectangle:nil.
- self drawEdges.
- self deviceClippingRectangle:innerClipRect
- ]
+ shown ifTrue:[
+ gc clippingBounds:nil.
+ self drawEdges.
+ gc deviceClippingBounds:innerClipRect
+ ]
]
"Modified: / 25.5.1999 / 14:50:25 / cg"
@@ -5926,16 +5920,16 @@
"a low level redraw event from device
- let subclass handle the redraw and take care of edges here"
- |leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh dx dy dw dh old oldPaint|
+ |leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh old oldPaint|
shown ifFalse:[
- ^ self
- ].
-
- nw := dw := w.
- nh := dh := h.
- nx := dx := x.
- ny := dy := y.
+ ^ self
+ ].
+
+ nw := w.
+ nh := h.
+ nx := x.
+ ny := y.
anyEdge := false.
@@ -5943,117 +5937,112 @@
check if there is a need to draw an edge (i.e. if margin is hit)
"
(margin ~~ 0) ifTrue:[
- |currentTransformation|
-
- leftEdge := false.
- topEdge := false.
- rightEdge := false.
- botEdge := false.
- currentTransformation := gc transformation.
- currentTransformation notNil ifTrue:[
- "
- need device coordinates for this test
- "
- nx := currentTransformation applyToX:nx.
- ny := currentTransformation applyToY:ny.
- nw := currentTransformation applyScaleX:nw.
- nh := currentTransformation applyScaleY:nh.
- ].
- "
- adjust expose rectangle, to exclude the margin.
- Care for rounding errors ...
- "
- (nx isMemberOf:SmallInteger) ifFalse:[
- old := nx.
- nx := nx truncated.
- nw := nw + (nx - old).
- ].
- (ny isMemberOf:SmallInteger) ifFalse:[
- old := ny.
- ny := ny truncated.
- nh := nh + (ny - old).
- ].
- (nw isMemberOf:SmallInteger) ifFalse:[
- nw := nw truncated + 1
- ].
- (nh isMemberOf:SmallInteger) ifFalse:[
- nh := nh truncated + 1
- ].
-
- dx := nx.
- dy := ny.
- dw := nw.
- dh := nh.
-
- (nx < margin) ifTrue:[
- old := nx.
- nx := margin.
- nw := nw - (nx - old).
- leftEdge := anyEdge := true.
- ].
- ((nx + nw - 1) >= (width - margin)) ifTrue:[
- nw := (width - margin - nx).
- rightEdge := anyEdge := true.
- ].
- (ny < margin) ifTrue:[
- old := ny.
- ny := margin.
- nh := nh - (ny - old).
- topEdge := anyEdge := true.
- ].
- ((ny + nh - 1) >= (height - margin)) ifTrue:[
- nh := (height - margin - ny).
- botEdge := anyEdge := true.
- ].
- currentTransformation notNil ifTrue:[
- "
- need logical coordinates for redraw
- "
- nx := currentTransformation applyInverseToX:nx.
- ny := currentTransformation applyInverseToY:ny.
- nw := currentTransformation applyInverseScaleX:nw.
- nh := currentTransformation applyInverseScaleY:nh.
- ].
+ |currentTransformation|
+
+ leftEdge := false.
+ topEdge := false.
+ rightEdge := false.
+ botEdge := false.
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
+ "
+ need device coordinates for this test
+ "
+ nx := currentTransformation applyToX:nx.
+ ny := currentTransformation applyToY:ny.
+ nw := currentTransformation applyScaleX:nw.
+ nh := currentTransformation applyScaleY:nh.
+ ].
+ "
+ adjust expose rectangle, to exclude the margin.
+ Care for rounding errors ...
+ "
+ (nx isMemberOf:SmallInteger) ifFalse:[
+ old := nx.
+ nx := nx truncated.
+ nw := nw + (nx - old).
+ ].
+ (ny isMemberOf:SmallInteger) ifFalse:[
+ old := ny.
+ ny := ny truncated.
+ nh := nh + (ny - old).
+ ].
+ (nw isMemberOf:SmallInteger) ifFalse:[
+ nw := nw truncated + 1
+ ].
+ (nh isMemberOf:SmallInteger) ifFalse:[
+ nh := nh truncated + 1
+ ].
+
+ (nx < margin) ifTrue:[
+ old := nx.
+ nx := margin.
+ nw := nw - (nx - old).
+ leftEdge := anyEdge := true.
+ ].
+ ((nx + nw - 1) >= (width - margin)) ifTrue:[
+ nw := (width - margin - nx).
+ rightEdge := anyEdge := true.
+ ].
+ (ny < margin) ifTrue:[
+ old := ny.
+ ny := margin.
+ nh := nh - (ny - old).
+ topEdge := anyEdge := true.
+ ].
+ ((ny + nh - 1) >= (height - margin)) ifTrue:[
+ nh := (height - margin - ny).
+ botEdge := anyEdge := true.
+ ].
+ currentTransformation notNil ifTrue:[
+ "
+ need logical coordinates for redraw
+ "
+ nx := currentTransformation applyInverseToX:nx.
+ ny := currentTransformation applyInverseToY:ny.
+ nw := currentTransformation applyInverseScaleX:nw.
+ nh := currentTransformation applyInverseScaleY:nh.
+ ].
].
(nw > 0 and:[nh > 0]) ifTrue:[
- "
- redraw inside area
- "
- self clippingRectangle:(Rectangle left:nx top:ny width:nw height:nh).
-
- self redrawX:nx y:ny width:nw height:nh.
+ "
+ redraw inside area
+ "
+ self
+ clippingBounds:(Rectangle left:nx top:ny width:nw height:nh);
+ redrawX:nx y:ny width:nw height:nh.
].
"
redraw edge(s)
"
anyEdge ifTrue:[
- self deviceClippingRectangle:nil.
- oldPaint := self paint.
- border notNil ifTrue:[
- border displayOn:self forDisplayBox:(Rectangle left:0 top:0 width:width height:height).
- ] ifFalse:[
- (topEdge and:[leftEdge and:[botEdge and:[rightEdge]]]) ifTrue:[
- self drawEdges
- ] ifFalse:[
- topEdge ifTrue:[
- self drawTopEdge
- ].
- leftEdge ifTrue:[
- self drawLeftEdge
- ].
- botEdge ifTrue:[
- self drawBottomEdge
- ].
- rightEdge ifTrue:[
- self drawRightEdge
- ]
- ].
- ].
- self paint:oldPaint.
- ].
- self deviceClippingRectangle:innerClipRect.
+ self clippingBounds:nil.
+ oldPaint := self paint.
+ border notNil ifTrue:[
+ border displayOn:self forDisplayBox:(Rectangle left:0 top:0 width:width height:height).
+ ] ifFalse:[
+ (topEdge and:[leftEdge and:[botEdge and:[rightEdge]]]) ifTrue:[
+ self drawEdges
+ ] ifFalse:[
+ topEdge ifTrue:[
+ self drawTopEdge
+ ].
+ leftEdge ifTrue:[
+ self drawLeftEdge
+ ].
+ botEdge ifTrue:[
+ self drawBottomEdge
+ ].
+ rightEdge ifTrue:[
+ self drawRightEdge
+ ]
+ ].
+ ].
+ self paint:oldPaint.
+ ].
+ gc deviceClippingBounds:innerClipRect.
"Modified: / 25.5.1999 / 14:57:38 / cg"
!
@@ -6220,34 +6209,34 @@
sensor := self sensor.
UserPreferences current allowMouseWheelZoom ifTrue:[
- zoomInOrOut := sensor ctrlDown or:[sensor metaDown].
- zoomInOrOut ifTrue:[
- self mouseWheelZoom:amount.
- ^ self.
- ].
+ zoomInOrOut := sensor ctrlDown.
+ zoomInOrOut ifTrue:[
+ self mouseWheelZoom:amount.
+ ^ self.
+ ].
].
pageScroll := sensor shiftDown.
pageScroll ifFalse:[
- amountToScroll := self verticalScrollStep.
- sensor shiftDown ifFalse:[
- amountToScroll := self scaleMouseWheelScrollAmount:amountToScroll.
- ]
+ amountToScroll := self verticalScrollStep.
+ sensor shiftDown ifFalse:[
+ amountToScroll := self scaleMouseWheelScrollAmount:amountToScroll.
+ ]
].
amount > 0 ifTrue:[
- pageScroll ifTrue:[
- self pageUp
- ] ifFalse:[
- self scrollUp:amountToScroll
- ]
+ pageScroll ifTrue:[
+ self pageUp
+ ] ifFalse:[
+ self scrollUp:amountToScroll
+ ]
] ifFalse:[
- pageScroll ifTrue:[
- self pageDown
- ] ifFalse:[
- self scrollDown:amountToScroll
- ]
+ pageScroll ifTrue:[
+ self pageDown
+ ] ifFalse:[
+ self scrollDown:amountToScroll
+ ]
].
"Modified: / 21.5.1999 / 19:58:42 / cg"
@@ -7374,7 +7363,7 @@
prepareForReinit
super prepareForReinit.
windowGroup notNil ifTrue:[
- windowGroup reinitialize
+ windowGroup reinitialize
]
!
@@ -7824,30 +7813,30 @@
!
computeInnerClip
- "compute, but do not set the inside clip-area"
+ "compute, but do not set the inside clip-area, in device coordinates"
|m2 nX nY nW nH|
margin isNil ifTrue:[margin := 0].
(margin ~~ 0) ifTrue:[
- m2 := margin + margin.
- nX := nY := margin.
- nW := width - m2.
- nH := height - m2.
+ m2 := margin + margin.
+ nX := nY := margin.
+ nW := width - m2.
+ nH := height - m2.
"/ transformation notNil ifTrue:[
"/ nX := transformation applyInverseToX:nX.
"/ nY := transformation applyInverseToY:nY.
"/ nW := transformation applyInverseScaleX:nW.
"/ nH := transformation applyInverseScaleY:nH.
"/ ].
- innerClipRect := Rectangle
- left:nX
- top:nY
- width:nW
- height:nH
+ innerClipRect := Rectangle
+ left:nX
+ top:nY
+ width:nW
+ height:nH
] ifFalse:[
- "no clipping"
- innerClipRect := nil
+ "no clipping"
+ innerClipRect := nil
]
"Modified: / 22.5.1999 / 16:50:58 / cg"
@@ -8349,7 +8338,7 @@
"compute, and set the inside clip-area"
self computeInnerClip.
- self deviceClippingRectangle:innerClipRect.
+ self clippingBounds:innerClipRect.
"Modified: / 25.5.1999 / 14:45:53 / cg"
!
@@ -8363,10 +8352,10 @@
|form|
(form := viewShape borderShapeForm) notNil ifTrue:[
- self windowBorderShape:form.
+ gc windowBorderShape:form.
].
(form := viewShape viewShapeForm) notNil ifTrue:[
- self windowShape:form.
+ gc windowShape:form.
].
"Created: 18.9.1997 / 11:09:00 / cg"
@@ -9331,8 +9320,6 @@
icon:nil iconMask:nil
iconView:nil.
- Lobby registerChange:self.
-
"/ if there is a global eventListener,
"/ give it a chance to track views
@@ -9347,28 +9334,28 @@
"/ ]
"/ ].
(viewGravity notNil "and:[viewGravity ~~ #NorthWest]") ifTrue:[
- super viewGravity:viewGravity.
+ gc viewGravity:viewGravity.
].
(bitGravity notNil "and:[bitGravity ~~ #NorthWest]") ifTrue:[
- isInputOnly ifFalse:[
- super bitGravity:bitGravity.
- ]
+ isInputOnly ifFalse:[
+ gc bitGravity:bitGravity.
+ ]
].
viewShape notNil ifTrue:[
- self setViewShape
+ self setViewShape
].
(backed notNil and:[backed ~~ false]) ifTrue:[
- self backingStore:backed.
+ self backingStore:backed.
].
self saveUnder ifTrue:[
- self saveUnder:true.
+ self saveUnder:true.
].
cursor notNil ifTrue:[
- self setCursor
+ self setCursor
].
name notNil ifTrue:[
- self windowName:name.
+ self windowName:name.
].
"Modified: / 9.4.1998 / 20:18:12 / cg"
@@ -11045,6 +11032,13 @@
isApplicationSubView
^ false
+!
+
+isCodeView2
+
+ ^ false
+
+ "Created: / 20-07-2010 / 15:42:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SimpleView methodsFor:'user interaction & notifications'!
@@ -11224,11 +11218,11 @@
!SimpleView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.754 2014-06-03 16:19:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.751.2.1 2014-05-08 08:27:50 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.754 2014-06-03 16:19:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.751.2.1 2014-05-08 08:27:50 stefan Exp $'
!
version_SVN
--- a/StandardSystemView.st Wed Jun 04 22:33:42 2014 +0100
+++ b/StandardSystemView.st Thu Jun 05 08:23:01 2014 +0100
@@ -9,6 +9,8 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+'From Smalltalk/X, Version:6.2.3.0 on 19-03-2014 at 15:29:39' !
+
"{ Package: 'stx:libview' }"
TopView subclass:#StandardSystemView
@@ -1572,8 +1574,6 @@
icon:icn iconMask:icnMask
iconView:iconView.
- Lobby registerChange:self.
-
"/ give global listeners a chance to track views
WindowSensor postViewCreateNotification:self.
@@ -1699,11 +1699,11 @@
!StandardSystemView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.220 2014-05-23 08:27:42 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.219.2.1 2014-05-08 08:27:50 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.220 2014-05-23 08:27:42 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.219.2.1 2014-05-08 08:27:50 stefan Exp $'
! !
--- a/WindowSensor.st Wed Jun 04 22:33:42 2014 +0100
+++ b/WindowSensor.st Thu Jun 05 08:23:01 2014 +0100
@@ -1951,7 +1951,7 @@
eventListeners notNil ifTrue:[
"/ be prepared that a listener removes itself while we iterate...
eventListeners copy do:[:aListener |
- (aListener processEvent:anEvent) == true ifTrue:[
+ (aListener notNil and:[(aListener processEvent:anEvent) == true]) ifTrue:[
anyListenerReturnedTrue := true
]
]
@@ -3253,7 +3253,7 @@
!WindowSensor class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.284 2014-04-03 14:34:01 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.284.2.1 2014-05-08 08:27:50 stefan Exp $'
! !
--- a/XWorkstation.st Wed Jun 04 22:33:42 2014 +0100
+++ b/XWorkstation.st Thu Jun 05 08:23:01 2014 +0100
@@ -9,6 +9,8 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+'From Smalltalk/X, Version:6.2.3.0 on 04-04-2014 at 21:28:11' !
+
"{ Package: 'stx:libview' }"
DeviceWorkstation subclass:#XWorkstation
@@ -7444,7 +7446,7 @@
).
Screen current
- heightOf:'hello World gggÖÜ' from:1 to:15
+ heightOf:'hello World ggg' from:1 to:15
inFont:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
"
!
@@ -8338,8 +8340,8 @@
%{
int x_style, x_cap, x_join;
- static char dashList[2] = { 1,1 };
- static char dotList[2] = { 4,4 };
+ static char dashList[2] = { 4,4 };
+ static char dotList[2] = { 1,1 };
static char dashDotList[4] = { 4,1 , 1,1 };
static char dashDotDotList[6] = { 4,1 , 1,1 , 1,1 };
char *x_dashes = 0;
@@ -11933,6 +11935,19 @@
self primitiveFailedOrClosedConnection
!
+newGraphicsContextFor:aGraphicsMedium
+ "create a new graphics context.
+ The defaults is to use the inherited graphics context.
+ Subclasses may redefine this to use their own graphics context"
+
+"/ ^ aGraphicsMedium.
+ |gc|
+
+ gc := X11GraphicsContext onDevice:self.
+ gc font:aGraphicsMedium class defaultFont.
+ ^ gc.
+!
+
parentWindowIdOf:aWindowId
"return a windows parent-window id.
Useful with getGeometryOf:, to compute information about the decoration."
@@ -13272,11 +13287,11 @@
!XWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.592 2014-04-01 08:54:23 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.592.2.1 2014-05-08 08:27:50 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.592 2014-04-01 08:54:23 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.592.2.1 2014-05-08 08:27:50 stefan Exp $'
!
version_SVN
--- a/XftFontDescription.st Wed Jun 04 22:33:42 2014 +0100
+++ b/XftFontDescription.st Thu Jun 05 08:23:01 2014 +0100
@@ -76,8 +76,7 @@
# define __HANDLE_VAL(type, externalAddress) \
((type)__externalAddressVal(externalAddress))
-
-# define __HANDLE_NEW(ptr, __cls) \
+#define __HANDLE_NEW(ptr, __cls) \
({ \
OBJ handle; \
handle = __MKEXTERNALADDRESS(ptr); \
@@ -421,7 +420,7 @@
!XftFontDescription methodsFor:'accessing'!
encoding
- ^ encoding ? 'iso10646-1'
+ ^ encoding ? #'iso10646-1'
!
face
@@ -534,77 +533,73 @@
displayString:aString from:index1 to:index2Arg x:xArg y:yArg in:aGC opaque:opaque
"display a partial string at some position in aGC."
- |index2 bytesPerCharacter transformation clipR clipX clipY clipW clipH fg fgR fgG fgB fgA fgPixel bg bgR bgG bgB bgA bgPixel drawX drawY displayId screen drawableId error stringLen|
+ |index2 bytesPerCharacter transformation clipR clipX clipY clipW clipH fg fgR fgG fgB fgA fgPixel
+ bg bgR bgG bgB bgA bgPixel drawX drawY displayId screen drawableId error stringLen|
"limit the string len, otherwise bad output is generated"
- stringLen := index2Arg - index1 + 1.
- stringLen > 8000 ifTrue:[
- index2 := index1 + 8000 - 1.
+ stringLen := index2Arg - index1.
+ stringLen > 4000 ifTrue:[
+ index2 := index1 + 4000.
] ifFalse:[
- stringLen <= 0 ifTrue:[^ self].
- index2 := index2Arg.
+ index2 := index2Arg.
].
bytesPerCharacter := aString bitsPerCharacter // 8.
- transformation := aGC transformation.
- clipR := aGC clippingBoundsOrNil.
+ clipR := aGC deviceClippingBoundsOrNil.
clipR notNil ifTrue:[
- clipX := clipR left.
- clipY := clipR top.
- clipW := clipR width.
- clipH := clipR height.
- transformation notNil ifTrue:[
- clipX := (transformation applyToX:clipX) ceiling.
- clipY := (transformation applyToY:clipY) ceiling.
- ].
+ clipX := clipR left.
+ clipY := clipR top.
+ clipW := clipR width.
+ clipH := clipR height.
+clipW > 32767 ifTrue:['clipW > 32767 ' errorPrintCR. clipW errorPrintCR. self halt. clipW := 32767].
+(clipX > 16384 or:[clipX < -16384]) ifTrue:['clipX < 16384 ' errorPrintCR. clipX errorPrintCR.].
].
+ transformation := aGC transformation.
transformation isNil ifTrue:[
- drawX := xArg.
- drawY := yArg.
+ drawX := xArg.
+ drawY := yArg.
] ifFalse:[
- drawX := (transformation applyToX:xArg) ceiling.
- drawY := (transformation applyToY:yArg) 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.
- "/].
- fgR isNil ifTrue:[
- "/ when drawing into a pixmap...
- fg colorId == 0 ifTrue:[
- fgR := fgG := fgB := 0.
- ] ifFalse:[
- fgR := fgG := fgB := 16rFFFF.
- ]
+ fgA := fg scaledAlpha.
+ fgR := fg scaledRed.
+ fgR notNil ifTrue:[
+ fgG := fg scaledGreen.
+ fgB := fg scaledBlue.
+ ] ifFalse:[
+ "/ when drawing into a pixmap...
+ fgPixel == 0 ifTrue:[
+ fgR := fgG := fgB := 0.
+ ] ifFalse:[
+ fgR := fgG := fgB := 16rFFFF.
+ ]
].
opaque ifTrue:[
- bg := aGC backgroundPaint.
- bgPixel := bg colorId.
- "/bgPixel notNil ifTrue:[
- bgR := bg scaledRed.
- bgG := bg scaledGreen.
- bgB := bg scaledBlue.
- bgA := (bg alpha * 65535) rounded.
- "/].
- bgR isNil ifTrue:[
- "/ when drawing into a pixmap...
- bg colorId == 0 ifTrue:[
- bgR := bgG := bgB := 0.
- ] ifFalse:[
- bgR := bgG := bgB := 16rFFFF.
- ]
- ].
+ bg := aGC backgroundPaint.
+ bgPixel := bg colorId.
+ bgA := bg scaledAlpha.
+ bgR := bg scaledRed.
+ bgR notNil ifTrue:[
+ bgG := bg scaledGreen.
+ bgB := bg scaledBlue.
+ ] ifFalse:[
+ "/ when drawing into a pixmap...
+ bgPixel == 0 ifTrue:[
+ bgR := bgG := bgB := 0.
+ ] ifFalse:[
+ bgR := bgG := bgB := 16rFFFF.
+ ]
+ ].
].
displayId := device displayIdOrErrorIfBroken.
displayId isNil ifTrue:[
- ^ self.
+ ^ self.
].
screen := device screen.
drawableId := aGC drawableId.
@@ -621,102 +616,103 @@
int __bytesPerCharacter;
if (!(__bothSmallInteger(drawX, drawY)
- && __bothSmallInteger(index1, index2)
- && __isSmallInteger(bytesPerCharacter)
- && (__isSmallInteger(fgPixel) || (__bothSmallInteger(fgR, fgG) && __bothSmallInteger(fgB, fgA)))
- && (opaque == false || __isSmallInteger(bgPixel) || (__bothSmallInteger(bgR, bgG) && __bothSmallInteger(bgB, bgA)))
- && __isNonNilObject(aString)
+ && __bothSmallInteger(index1, index2)
+ && __isSmallInteger(bytesPerCharacter)
+ && (__isSmallInteger(fgPixel) || (__bothSmallInteger(fgR, fgG) && __bothSmallInteger(fgB, fgA)))
+ && (opaque == false || __isSmallInteger(bgPixel) || (__bothSmallInteger(bgR, bgG) && __bothSmallInteger(bgB, bgA)))
+ && __isNonNilObject(aString)
)) {
- goto err;
+ goto err;
}
__bytesPerCharacter = __intVal(bytesPerCharacter);
if ( __INST(sharedDrawId) == nil ) {
- __INST(sharedDrawId) = XFT_DRAW_HANDLE_NEW ( XftDrawCreate ( DISPLAY( displayId ) ,
- DRAWABLE( drawableId ) ,
- DefaultVisual( DISPLAY( displayId), SCREEN (screen) ) ,
- DefaultColormap( DISPLAY( displayId), SCREEN (screen) ) ) );
- __STORE(self, __INST(sharedDrawId));
+ __INST(sharedDrawId) = XFT_DRAW_HANDLE_NEW ( XftDrawCreate ( DISPLAY( displayId ) ,
+ DRAWABLE( drawableId ) ,
+ DefaultVisual( DISPLAY( displayId), SCREEN (screen) ) ,
+ DefaultColormap( DISPLAY( displayId), SCREEN (screen) ) ) );
+ __STORE(self, __INST(sharedDrawId));
}
if ( XftDrawDrawable ( XFT_DRAW ( __INST(sharedDrawId) ) ) != DRAWABLE( drawableId ) ) {
- XftDrawChange( XFT_DRAW( __INST(sharedDrawId) ) , DRAWABLE( drawableId ) );
+ XftDrawChange( XFT_DRAW( __INST(sharedDrawId) ) , DRAWABLE( drawableId ) );
}
string = __stringVal( aString ) + (( __intVal(index1) - 1 ) * __bytesPerCharacter);
len = __intVal(index2) - __intVal(index1) + 1;
if (clipR != nil) {
- clipRX.x = __intVal(clipX);
- clipRX.y = __intVal(clipY);
- clipRX.width = __intVal(clipW);
- clipRX.height = __intVal(clipH);
- XftDrawSetClipRectangles( XFT_DRAW( __INST( sharedDrawId ) ) , 0, 0, &clipRX, 1);
+ clipRX.x = __intVal(clipX);
+ clipRX.y = __intVal(clipY);
+ clipRX.width = __intVal(clipW);
+ clipRX.height = __intVal(clipH);
+ XftDrawSetClipRectangles( XFT_DRAW( __INST( sharedDrawId ) ) , 0, 0, &clipRX, 1);
} else {
- XftDrawSetClip( XFT_DRAW( __INST( sharedDrawId ) ) , 0);
+ XftDrawSetClip( XFT_DRAW( __INST( sharedDrawId ) ) , 0);
}
if (opaque == true) {
- 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);
- // }
- switch (__bytesPerCharacter) {
- case 1:
- XftTextExtents8( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar8*)string, len, &extents);
- break;
- case 2:
- XftTextExtents16( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar16*)string, len, &extents);
- break;
- case 4:
- XftTextExtents32( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar32*)string, len, &extents);
- break;
- }
- XftDrawRect( XFT_DRAW ( __INST( sharedDrawId ) ), &color, __intVal(drawX) - extents.x, __intVal(drawY) - XFT_FONT( __INST( fontId ) )->ascent, extents.width, XFT_FONT(__INST (fontId ) )->height);
+ 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);
+ // }
+ switch (__bytesPerCharacter) {
+ case 1:
+ XftTextExtents8( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar8*)string, len, &extents);
+ break;
+ case 2:
+ XftTextExtents16( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar16*)string, len, &extents);
+ break;
+ case 4:
+ XftTextExtents32( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar32*)string, len, &extents);
+ break;
+ }
+if (extents.width < 0) printf("width: %d < 0\n", extents.width);
+ XftDrawRect( XFT_DRAW ( __INST( sharedDrawId ) ), &color, __intVal(drawX) - extents.x, __intVal(drawY) - XFT_FONT( __INST( fontId ) )->ascent, extents.width, XFT_FONT(__INST (fontId ) )->height);
}
if (fgPixel != nil) {
- color.pixel = (unsigned long)__intVal(fgPixel);
+ 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( XFT_DRAW ( __INST( sharedDrawId ) ), &color, XFT_FONT( __INST( fontId ) ),
- __intVal(drawX),
- __intVal(drawY),
- (FcChar8*)string,
- len);
- RETURN ( self );
- break;
+ XftDrawString8( XFT_DRAW ( __INST( sharedDrawId ) ), &color, XFT_FONT( __INST( fontId ) ),
+ __intVal(drawX),
+ __intVal(drawY),
+ (FcChar8*)string,
+ len);
+ RETURN ( self );
+ break;
case 2:
- XftDrawString16( XFT_DRAW ( __INST( sharedDrawId ) ), &color, XFT_FONT( __INST( fontId ) ),
- __intVal(drawX),
- __intVal(drawY),
- (FcChar16*)string,
- len);
- RETURN ( self );
- break;
+ XftDrawString16( XFT_DRAW ( __INST( sharedDrawId ) ), &color, XFT_FONT( __INST( fontId ) ),
+ __intVal(drawX),
+ __intVal(drawY),
+ (FcChar16*)string,
+ len);
+ RETURN ( self );
+ break;
case 4:
- XftDrawString32( XFT_DRAW ( __INST( sharedDrawId ) ), &color, XFT_FONT( __INST( fontId ) ),
- __intVal(drawX),
- __intVal(drawY),
- (FcChar32*)string,
- len);
- RETURN ( self );
- break;
+ XftDrawString32( XFT_DRAW ( __INST( sharedDrawId ) ), &color, XFT_FONT( __INST( fontId ) ),
+ __intVal(drawX),
+ __intVal(drawY),
+ (FcChar32*)string,
+ len);
+ RETURN ( self );
+ break;
}
+#endif
err:;
-#endif
%}.
self primitiveFailed: error.
@@ -877,16 +873,17 @@
device := deviceArg.
fontId := fontIdArg.
patternIdArg notNil ifTrue:[
- family := self xftPatternGet: patternIdArg attribute: FC_FAMILY index: 0.
- size := self xftPatternGet: patternIdArg attribute: FC_SIZE index: 0.
- face := self xftPatternGet: patternIdArg attribute: FC_WEIGHT index: 0.
- face := StXFace2FCWeightMap keyAtValue: face.
- style := self xftPatternGet: patternIdArg attribute: FC_SLANT index: 0.
- style := StXStyle2FCSlantMap keyAtValue: style.
+ family := self xftPatternGet: patternIdArg attribute: FC_FAMILY index: 0.
+ size := self xftPatternGet: patternIdArg attribute: FC_SIZE index: 0.
+ face := self xftPatternGet: patternIdArg attribute: FC_WEIGHT index: 0.
+ face := StXFace2FCWeightMap keyAtValue: face.
+ style := self xftPatternGet: patternIdArg attribute: FC_SLANT index: 0.
+ style := StXStyle2FCSlantMap keyAtValue: style.
- name:= self xftPatternGet: patternIdArg attribute: 'fullname' index: 0.
+ name:= self xftPatternGet: patternIdArg attribute: 'fullname' index: 0.
- encoding:= self xftPatternGet: patternIdArg attribute: 'encoding' index: 0.
+ encoding:= self xftPatternGet: patternIdArg attribute: 'encoding' index: 0.
+ encoding notNil ifTrue:[encoding := encoding asSymbol].
].
"Created: / 21-12-2013 / 00:46:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -1665,10 +1662,26 @@
widthOf:aString from:start to:stop
"return the width of a sub string"
- | extents |
+ |extents maxWidthOfSingleGlyph|
(stop < start) ifTrue:[^ 0].
- extents := self xftTextExtents: device displayId font: fontId string: aString from: start to: stop.
+ maxWidthOfSingleGlyph := self maxWidth.
+ "xOff from XFTTextExtents is a signed short.
+ Work arond for long strings"
+ (stop - start + 1) * maxWidthOfSingleGlyph > 32767 ifTrue:[
+ |total chunkSize|
+
+ chunkSize := (32767 // maxWidthOfSingleGlyph) - 1.
+ total := 0.
+ start to:stop by:chunkSize do:[:eachChunkStart|
+ extents := self xftTextExtents:device displayId font:fontId string:aString
+ from:eachChunkStart to:((eachChunkStart+chunkSize-1) min:stop).
+ "/ extents --> #(width height x y xOff yOff)
+ total := total + extents fifth.
+ ].
+ ^ total.
+ ].
+ extents := self xftTextExtents: device displayId font:fontId string:aString from:start to:stop.
"/ extents --> #(width height x y xOff yOff)
^ extents fifth.
@@ -2035,11 +2048,11 @@
!XftFontDescription class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.54 2014-06-03 09:43:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.51.2.1 2014-05-08 08:27:51 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.54 2014-06-03 09:43:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.51.2.1 2014-05-08 08:27:51 stefan Exp $'
! !