--- a/AbstractBorder.st Thu Feb 19 06:21:17 2015 +0000
+++ b/AbstractBorder.st Tue Mar 03 03:55:48 2015 +0000
@@ -12,6 +12,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
Object subclass:#AbstractBorder
instanceVariableNames:'width'
classVariableNames:''
@@ -50,6 +52,12 @@
!AbstractBorder class methodsFor:'instance creation'!
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+!
+
width:borderWidth
"create a new instance of the receiver with a border of the given width
(and default color)."
@@ -71,7 +79,7 @@
!AbstractBorder methodsFor:'accessing'!
color:aColor
- "set the width"
+ "set the color"
"/ self subclassResponsibility
!
@@ -85,7 +93,7 @@
width
"get the width"
- ^ width
+ ^ width ? 1
!
width:aNumber
@@ -110,6 +118,12 @@
"/ self subclassResponsibility
! !
+!AbstractBorder methodsFor:'initialization'!
+
+initialize
+ width := 1.
+! !
+
!AbstractBorder methodsFor:'queries'!
allSidesEqual:aSmallInteger
@@ -141,7 +155,7 @@
insetDisplayBoxFor:aRectangle
"return a rectangle representing the display box of a component
bordered by the receiver in the outer bounds, aRectangle.
- That is, the argument inset by the receivers borders."
+ That is, the argument inset by the receiver's borders."
|insetRectangle|
@@ -157,6 +171,11 @@
!AbstractBorder class methodsFor:'documentation'!
+version
+ ^ '$Header: /cvs/stx/stx/libview/AbstractBorder.st,v 1.5 2015-01-06 01:41:40 cg Exp $'
+!
+
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/AbstractBorder.st,v 1.3 2009-10-24 10:07:22 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/AbstractBorder.st,v 1.5 2015-01-06 01:41:40 cg Exp $'
! !
+
--- a/BeveledBorder.st Thu Feb 19 06:21:17 2015 +0000
+++ b/BeveledBorder.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
AbstractBorder subclass:#BeveledBorder
instanceVariableNames:'shadowColor lightColor level'
classVariableNames:'RaisedBorder2 InsetBorder2 RaisedBorder1 InsetBorder1'
@@ -36,25 +38,40 @@
examples
"
- |v b|
+ [exBegin]
+ |top v b|
- v := StandardSystemView extent:10@10.
- v openAndWait.
-
- b := BeveledBorder raised.
- b displayOn:v forDisplayBox:(0@0 corner:9@9).
+
+ top := StandardSystemView extent:100@100.
+ v := View origin:10@10 corner:90@30 in:top.
+ top openAndWait.
-
-
+ b := BeveledBorder raised1.
+ v border:b.
+ Delay waitForSeconds:1.
+ v border:(BeveledBorder level:2).
+ Delay waitForSeconds:1.
+ v border:(BeveledBorder level:3).
+ Delay waitForSeconds:1.
+ v border:(BeveledBorder level:-3).
+ Delay waitForSeconds:1.
+ v border:(BeveledBorder level:-2).
+ Delay waitForSeconds:1.
+ v border:(BeveledBorder level:-1).
+ Delay waitForSeconds:1.
+ v border:(BeveledBorder level:0).
+ [exEnd]
- |v b|
+ [exBegin]
+ |top v b|
- v := StandardSystemView extent:100@100.
- v openAndWait.
+ top := StandardSystemView extent:100@100.
+ v := View origin:10@10 corner:90@30 in:top.
+ top openAndWait.
b := BeveledBorder inset1.
- b displayOn:v forDisplayBox:(0@0 corner:99@99).
-
+ v border:b.
+ [exEnd]
"
! !
@@ -194,5 +211,6 @@
!BeveledBorder class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/BeveledBorder.st,v 1.4 2009-11-04 14:31:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/BeveledBorder.st,v 1.5 2015-01-06 11:36:13 cg Exp $'
! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/BitmapFillStyle.st Tue Mar 03 03:55:48 2015 +0000
@@ -0,0 +1,40 @@
+"{ Package: 'stx:libview' }"
+
+FillStyle subclass:#BitmapFillStyle
+ instanceVariableNames:'form origin direction'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Compatibility-Squeak-Balloon-Fills'
+!
+
+!BitmapFillStyle class methodsFor:'documentation'!
+
+documentation
+"
+ an as-yet unused class.
+ For now, this is present as compatibility class (for Squeak),
+ but we may move change the fill/drawing code in the view hierarchy to use it later.
+
+ [author:]
+ cg
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+
+"
+! !
+
+
+!BitmapFillStyle class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/BitmapFillStyle.st,v 1.3 2014-12-19 21:31:31 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/BitmapFillStyle.st,v 1.3 2014-12-19 21:31:31 cg Exp $'
+! !
+
--- a/Border.st Thu Feb 19 06:21:17 2015 +0000
+++ b/Border.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
AbstractBorder subclass:#Border
instanceVariableNames:'leftColor rightColor topColor bottomColor'
classVariableNames:''
@@ -51,64 +53,56 @@
examples
"
- [exBegin]
- |v b|
-
- v := StandardSystemView extent:10@10.
- v openAndWait.
-
- b := Border width:2 color:Color red.
- b displayOn:v forDisplayBox:(0@0 corner:9@9).
-
- Delay waitForSeconds:1.
- b setLeftColor:Color blue.
- b displayOn:v forDisplayBox:(0@0 corner:9@9).
- Delay waitForSeconds:1.
- b setTopColor:Color green.
- b displayOn:v forDisplayBox:(0@0 corner:9@9).
- Delay waitForSeconds:1.
- b setRightColor:Color magenta.
- b displayOn:v forDisplayBox:(0@0 corner:9@9).
- [exEnd]
-
- [exBegin]
+ [exBegin]
|v b|
v := StandardSystemView extent:100@100.
v openAndWait.
- b := Border width:2 color:Color red.
- b displayOn:v forDisplayBox:(0@0 corner:99@99).
+ b := Border width:10 color:Color red.
+ b displayOn:v forDisplayBox:(0@0 corner:90@90).
Delay waitForSeconds:1.
- b setLeft:5.
- v clear.
- b displayOn:v forDisplayBox:(0@0 corner:99@99).
+ b leftColor:Color blue.
+ b displayOn:v forDisplayBox:(0@0 corner:90@90).
+ Delay waitForSeconds:1.
+ b topColor:Color green.
+ b displayOn:v forDisplayBox:(0@0 corner:90@90).
Delay waitForSeconds:1.
- b setTop:3.
- v clear.
- b displayOn:v forDisplayBox:(0@0 corner:99@99).
- Delay waitForSeconds:1.
- b setRight:1.
- v clear.
- b displayOn:v forDisplayBox:(0@0 corner:99@99).
- [exEnd]
+ b rightColor:Color yellow.
+ b displayOn:v forDisplayBox:(0@0 corner:90@90).
+ [exEnd]
+
+ [exBegin]
+ |v b|
- [exBegin]
+ v := StandardSystemView extent:100@100.
+ v openAndWait.
+
+ b := Border width:10 color:Color red.
+ v border:b
+ [exEnd]
+
+ [exBegin]
|v sub1 sub2 sub3|
v := StandardSystemView extent:200@200.
v openAndWait.
sub1 := (View in:v) origin:10@10; corner:90@90.
- sub1 border:(SimpleBorder width:1 color:Color red ).
+ sub1 border:(SimpleBorder width:10 color:Color red ).
+ sub1 realize.
sub2 := (View in:v) origin:110@10; corner:190@90.
- sub2 border:(Border new width:1; color:Color blue; leftColor:Color red rightColor:Color red ).
+ sub2 border:(Border new width:10; color:Color blue; leftColor:Color red; rightColor:Color red ).
+ sub2 realize.
sub3 := (View in:v) origin:110@110; corner:190@190.
- sub3 border:(SimpleBorder width:1 color:Color green ).
+ sub3 border:(SimpleBorder width:10 color:Color green ).
+ sub3 realize.
- v open.
- [exEnd]
+ Delay waitForSeconds:1.
+ sub3 border:(Border new width:10; color:Color yellow; leftColor:Color red; rightColor:Color red ).
+
+ [exEnd]
"
! !
@@ -190,17 +184,13 @@
displayOn:aGC forDisplayBox:aRectangle
"display the border represented by the receiver in the given rectangle.
- colorSource is ignored here, but subclasses (i.e. 3D-borders) may use
- it to ask for shadow/lightColors.
The gc's state is restored after the drawing."
- |paint oldPaint
- t r l b rL rR rT rB rW rH|
+ |oldPaint rL rR rT rB rW rH|
width == 0 ifTrue:[ ^ self ].
oldPaint := aGC paint.
- r := aRectangle copy.
rL := aRectangle left.
rT := aRectangle top.
@@ -211,22 +201,38 @@
leftColor notNil ifTrue:[
aGC paint:leftColor.
- aGC fillRectangleX:rL y:rT width:width height:rH + 1 - b
+ width == 1 ifTrue:[
+ aGC displayLineFromX:rL y:rT toX:rL y:rB-1.
+ ] ifFalse:[
+ aGC fillRectangleX:rL y:rT width:width height:rH
+ ].
].
topColor notNil ifTrue:[
aGC paint:topColor.
- aGC fillRectangleX:(rL + l) y:rT width:rW - l height:width
+ width == 1 ifTrue:[
+ aGC displayLineFromX:rL+1 y:rT toX:rR-1 y:rT.
+ ] ifFalse:[
+ aGC fillRectangleX:(rL + width) y:rT width:rW - width height:width
+ ].
].
rightColor notNil ifTrue:[
aGC paint:rightColor.
- aGC fillRectangleX:(rR - r) y:(rT + t) width:width height:rH + 1 - t
+ width == 1 ifTrue:[
+ aGC displayLineFromX:rR-1 y:rT toX:rR-1 y:rB-1.
+ ] ifFalse:[
+ aGC fillRectangleX:(rR - width) y:(rT + width) width:width height:rH-width
+ ].
].
bottomColor notNil ifTrue:[
- aGC paint:paint.
- aGC fillRectangleX:(rL) y:(rB + 1 - b) width:rW - r height:width
+ aGC paint:bottomColor.
+ width == 1 ifTrue:[
+ aGC displayLineFromX:rL y:rB-1 toX:rR-1 y:rB-1.
+ ] ifFalse:[
+ aGC fillRectangleX:rL y:(rB-width) width:rW - width height:width
+ ].
].
aGC paint: oldPaint
@@ -237,9 +243,10 @@
!Border class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Border.st,v 1.9 2009-11-04 11:23:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Border.st,v 1.10 2015-01-05 20:34:51 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/Border.st,v 1.9 2009-11-04 11:23:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Border.st,v 1.10 2015-01-05 20:34:51 cg Exp $'
! !
+
--- a/Color.st Thu Feb 19 06:21:17 2015 +0000
+++ b/Color.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
Object subclass:#Color
instanceVariableNames:'red green blue device colorId ditherForm replacementColor
writable'
@@ -5372,17 +5374,15 @@
!Color methodsFor:'queries'!
averageColor
- "return the average color - thats myself.
- This method has been added for compatibility with the image
- protocol."
+ "return the average color - that's myself.
+ This method has been added for compatibility with the image protocol."
^ self
!
averageColorIn:aRectangle
"return the average color - thats myself.
- This method has been added for compatibility with the image
- protocol."
+ This method has been added for compatibility with the image protocol."
^ self
!
@@ -5402,7 +5402,10 @@
deltaFrom:aColor
"return the distance of the receiver from some color specified
- by r/g/b values"
+ by r/g/b values.
+ A very questionable value;
+ basing the distance on rgb values is very bad
+ - better do a distance in a cie color cone"
^ aColor deltaFromRed:self red green:self green blue:self blue
@@ -5620,11 +5623,11 @@
!Color class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Color.st,v 1.236 2014-12-09 15:36:50 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Color.st,v 1.238 2015-02-26 22:15:30 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/Color.st,v 1.236 2014-12-09 15:36:50 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Color.st,v 1.238 2015-02-26 22:15:30 cg Exp $'
! !
--- a/Colormap.st Thu Feb 19 06:21:17 2015 +0000
+++ b/Colormap.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
SequenceableCollection subclass:#Colormap
instanceVariableNames:'redVector greenVector blueVector'
classVariableNames:''
@@ -217,7 +219,7 @@
at:index
"return the color for a index.
- Notice that index range is 1...nColors"
+ Notice that the index range is 1...nColors"
|r g b idx "{ Class: SmallInteger }" |
@@ -234,7 +236,7 @@
at:index put:aColor
"set the color for a index. Return aColor (sigh).
- Notice that index range is 1..."
+ Notice that the index range is 1..."
|r g b idx "{ Class: SmallInteger }" |
@@ -550,6 +552,28 @@
!Colormap methodsFor:'queries'!
+colorNearestTo:aColor
+ "a very questionable algorithm;
+ basing the distance on rgb values is very bad - better
+ do a distance in a cie color cone"
+
+ |minDelta nearest|
+
+ nearest := self at:1.
+ minDelta := aColor deltaFrom:nearest.
+ 2 to:self size do:[:idx |
+ |delta clr|
+
+ clr := self at:idx.
+ delta := aColor deltaFrom:clr.
+ delta < minDelta ifTrue:[
+ minDelta := delta.
+ nearest := clr
+ ]
+ ].
+ ^ nearest.
+!
+
indexOfColor: aColor
1 to:self size do:[:idx |
(self at:idx) = aColor ifTrue:[^ idx].
@@ -611,6 +635,6 @@
!Colormap class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Colormap.st,v 1.42 2014-03-04 22:17:24 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Colormap.st,v 1.43 2015-02-22 12:31:20 cg Exp $'
! !
--- a/Depth24Image.st Thu Feb 19 06:21:17 2015 +0000
+++ b/Depth24Image.st Tue Mar 03 03:55:48 2015 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -11,6 +13,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
Image subclass:#Depth24Image
instanceVariableNames:''
classVariableNames:''
@@ -2681,7 +2685,8 @@
hardAntiAliasedMagnifiedBy:scalePoint
"return a new image magnified by scalePoint, aPoint.
- This interpolates pixels and is therefore slower."
+ This interpolates pixels and is therefore much slower,
+ but generates nicer looking magnifications."
|mX
mY
@@ -2705,24 +2710,24 @@
newBytesPerRow := ((newWidth * bitsPerPixel) + 7) // 8.
newBits := ByteArray new: "uninitializedNew:" (newBytesPerRow * newHeight).
newBits isNil ifTrue:[
- 'Depth24Image [warning]: failed to allocate byteArray for image bits' errorPrintCR.
- ^ nil
+ 'Depth24Image [warning]: failed to allocate byteArray for image bits' errorPrintCR.
+ ^ nil
].
mask notNil ifTrue:[
- newMask := (mask magnifiedBy:scalePoint)
+ newMask := (mask magnifiedBy:scalePoint)
].
newImage := self species new.
newImage
- width:newWidth
- height:newHeight
- photometric:photometric
- samplesPerPixel:samplesPerPixel
- bitsPerSample:bitsPerSample
- colorMap:colorMap copy
- bits:newBits
- mask:newMask.
+ width:newWidth
+ height:newHeight
+ photometric:photometric
+ samplesPerPixel:samplesPerPixel
+ bitsPerSample:bitsPerSample
+ colorMap:nil
+ bits:newBits
+ mask:newMask.
mY := mY asFloat.
mX := mX asFloat.
@@ -2741,86 +2746,86 @@
double _mY = __floatVal(mY);
for (_row = 0; _row <= _h; _row++) {
- double _srcY;
- double _dY;
- int _sR;
-
- _srcY = ((double)_row / _mY);
- _sR = (int)_srcY;
- _dY = _srcY - ((double)_sR);
- _srcRowP = _srcP + (_width3 * _sR);
-
- for (_col = 0; _col <= _w; _col++) {
- unsigned int rHere, gHere, bHere;
- unsigned int rRight, gRight, bRight;
- unsigned int rRightBelow, gRightBelow, bRightBelow;
- unsigned int rBelow, gBelow, bBelow;
- unsigned int _r, _g, _b;
- double wHere, wRight, wRightBelow, wBelow, sumW;
- double _srcX;
- double _dX;
- int _sC;
-
- _srcX = ((double)_col / _mX);
- _sC = (int)_srcX;
- _dX = _srcX - ((double)_sC);
- sP = _srcRowP + (_sC * 3);
-
- rHere = sP[0];
- gHere = sP[1];
- bHere = sP[2];
-
- if (_sC < _oldW) {
- rRight = sP[3];
- gRight = sP[4];
- bRight = sP[5];
-
- if (_sR < _oldH) {
- rBelow = sP[0+_width3];
- gBelow = sP[1+_width3];
- bBelow = sP[2+_width3];
- rRightBelow = sP[3+_width3];
- gRightBelow = sP[4+_width3];
- bRightBelow = sP[5+_width3];
- } else {
- rRightBelow = rHere;
- gRightBelow = gHere;
- bRightBelow = bHere;
- rBelow = rHere;
- gBelow = gHere;
- bBelow = bHere;
- }
- } else {
- rRight = rRightBelow = rHere;
- gRight = gRightBelow = gHere;
- bRight = bRightBelow = bHere;
- if (_sR < _oldH) {
- rBelow = sP[0+_width3];
- gBelow = sP[1+_width3];
- bBelow = sP[2+_width3];
- } else {
- rBelow = rHere;
- gBelow = gHere;
- bBelow = bHere;
- }
- }
-
- wHere = (1.0 - _dX) * (1.0 - _dY);
- wRight = _dX * (1.0 - _dY);
- wBelow = _dY * (1.0 - _dX);
- wRightBelow = _dX * _dY;
- sumW = wHere + wRight + wBelow + wRightBelow;
-
- _r = ((rHere * wHere) + (rRight * wRight) + (rBelow * wBelow) + (rRightBelow * wRightBelow)) / sumW;
- _g = ((gHere * wHere) + (gRight * wRight) + (gBelow * wBelow) + (gRightBelow * wRightBelow)) / sumW;
- _b = ((bHere * wHere) + (bRight * wRight) + (bBelow * wBelow) + (bRightBelow * wRightBelow)) / sumW;
-
- _dstP[0] = _r;
- _dstP[1] = _g;
- _dstP[2] = _b;
-
- _dstP += 3;
- }
+ double _srcY;
+ double _dY;
+ int _sR;
+
+ _srcY = ((double)_row / _mY);
+ _sR = (int)_srcY;
+ _dY = _srcY - ((double)_sR);
+ _srcRowP = _srcP + (_width3 * _sR);
+
+ for (_col = 0; _col <= _w; _col++) {
+ unsigned int rHere, gHere, bHere;
+ unsigned int rRight, gRight, bRight;
+ unsigned int rRightBelow, gRightBelow, bRightBelow;
+ unsigned int rBelow, gBelow, bBelow;
+ unsigned int _r, _g, _b;
+ double wHere, wRight, wRightBelow, wBelow, sumW;
+ double _srcX;
+ double _dX;
+ int _sC;
+
+ _srcX = ((double)_col / _mX);
+ _sC = (int)_srcX;
+ _dX = _srcX - ((double)_sC);
+ sP = _srcRowP + (_sC * 3);
+
+ rHere = sP[0];
+ gHere = sP[1];
+ bHere = sP[2];
+
+ if (_sC < _oldW) {
+ rRight = sP[3];
+ gRight = sP[4];
+ bRight = sP[5];
+
+ if (_sR < _oldH) {
+ rBelow = sP[0+_width3];
+ gBelow = sP[1+_width3];
+ bBelow = sP[2+_width3];
+ rRightBelow = sP[3+_width3];
+ gRightBelow = sP[4+_width3];
+ bRightBelow = sP[5+_width3];
+ } else {
+ rRightBelow = rHere;
+ gRightBelow = gHere;
+ bRightBelow = bHere;
+ rBelow = rHere;
+ gBelow = gHere;
+ bBelow = bHere;
+ }
+ } else {
+ rRight = rRightBelow = rHere;
+ gRight = gRightBelow = gHere;
+ bRight = bRightBelow = bHere;
+ if (_sR < _oldH) {
+ rBelow = sP[0+_width3];
+ gBelow = sP[1+_width3];
+ bBelow = sP[2+_width3];
+ } else {
+ rBelow = rHere;
+ gBelow = gHere;
+ bBelow = bHere;
+ }
+ }
+
+ wHere = (1.0 - _dX) * (1.0 - _dY);
+ wRight = _dX * (1.0 - _dY);
+ wBelow = _dY * (1.0 - _dX);
+ wRightBelow = _dX * _dY;
+ sumW = wHere + wRight + wBelow + wRightBelow;
+
+ _r = ((rHere * wHere) + (rRight * wRight) + (rBelow * wBelow) + (rRightBelow * wRightBelow)) / sumW;
+ _g = ((gHere * wHere) + (gRight * wRight) + (gBelow * wBelow) + (gRightBelow * wRightBelow)) / sumW;
+ _b = ((bHere * wHere) + (bRight * wRight) + (bBelow * wBelow) + (bRightBelow * wRightBelow)) / sumW;
+
+ _dstP[0] = _r;
+ _dstP[1] = _g;
+ _dstP[2] = _b;
+
+ _dstP += 3;
+ }
}
%}.
@@ -2834,8 +2839,8 @@
"
|i|
i := Depth24Image width:3 height:3 fromArray:#[ 0 0 0 0 0 0 0 0 0
- 0 0 0 255 255 255 0 0 0
- 0 0 0 0 0 0 0 0 0].
+ 0 0 0 255 255 255 0 0 0
+ 0 0 0 0 0 0 0 0 0].
i hardAntiAliasedMagnifiedBy:8@8
"
@@ -3114,10 +3119,10 @@
!Depth24Image class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.97 2014-03-02 13:59:49 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.98 2015-02-27 13:48:04 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.97 2014-03-02 13:59:49 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.98 2015-02-27 13:48:04 cg Exp $'
! !
--- a/DeviceGraphicsContext.st Thu Feb 19 06:21:17 2015 +0000
+++ b/DeviceGraphicsContext.st Tue Mar 03 03:55:48 2015 +0000
@@ -92,11 +92,11 @@
!
version
- ^ '$Header: /cvs/stx/stx/libview/DeviceGraphicsContext.st,v 1.137.2.4 2014-09-26 10:25:04 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceGraphicsContext.st,v 1.150 2015-02-10 18:09:32 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/DeviceGraphicsContext.st,v 1.137.2.4 2014-09-26 10:25:04 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceGraphicsContext.st,v 1.150 2015-02-10 18:09:32 stefan Exp $'
! !
!DeviceGraphicsContext class methodsFor:'initialization'!
@@ -469,6 +469,8 @@
"Modified: / 16.5.1999 / 19:40:37 / cg"
!
+
+
colorAt:aPoint
"return the color of the pixel at the coordinate given by x@y"
@@ -569,8 +571,39 @@
!
deviceClippingRectangle:aRectangleOrNil
- <resource: #obsolete>
- self deviceClippingBounds:aRectangleOrNil
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
+<conflict>
!
drawableId
@@ -687,20 +720,16 @@
|n|
(aNumber ~~ lineWidth) ifTrue:[
- lineWidth := aNumber.
- transformation isNil ifTrue:[
- n := aNumber.
- ] ifFalse:[
- n := transformation applyScaleX:aNumber.
- n := n rounded
- ].
- gcId notNil ifTrue:[
- device setLineWidth:n
- style:lineStyle
- cap:capStyle
- join:joinStyle
- in:gcId
- ]
+ lineWidth := aNumber.
+ transformation isNil ifTrue:[
+ n := aNumber.
+ ] ifFalse:[
+ n := transformation applyScaleX:aNumber.
+ n := n rounded
+ ].
+ gcId notNil ifTrue:[
+ device setLineWidth:n style:lineStyle cap:capStyle join:joinStyle in:gcId
+ ]
]
!
@@ -730,7 +759,7 @@
maskOrigin:aPoint
"set the origin of the mask-pattern"
- |x y|
+ |x y pO|
x := aPoint x.
y := aPoint y.
@@ -738,18 +767,19 @@
(maskOrigin isNil or:[
((x ~= maskOrigin x) or:[y ~= maskOrigin y]) ]) ifTrue:[
- maskOrigin := aPoint.
-
- transformation notNil ifTrue:[
- x := transformation applyToX:x.
- y := transformation applyToY:y.
- ].
- x := x rounded.
- y := y rounded.
-
- gcId notNil ifTrue:[
- device setMaskOriginX:x y:y in:gcId
- ]
+ maskOrigin := aPoint.
+
+ transformation notNil ifTrue:[
+ pO := transformation transformPoint:aPoint.
+ x:= pO x.
+ y := pO y.
+ ].
+ x := x rounded.
+ y := y rounded.
+
+ gcId notNil ifTrue:[
+ device setMaskOriginX:x y:y in:gcId
+ ]
]
"Created: / 26.1.1998 / 19:03:02 / cg"
@@ -758,28 +788,7 @@
maskOriginX:orgX y:orgY
"set the origin of the pattern"
- |x y|
-
- transformation notNil ifTrue:[
- x := transformation applyToX:orgX.
- y := transformation applyToY:orgY.
- ] ifFalse:[
- x := orgX.
- y := orgY
- ].
- x := x rounded.
- y := y rounded.
-
- (maskOrigin isNil or:[
- ((x ~~ maskOrigin x) or:[y ~~ maskOrigin y]) ]) ifTrue:[
-
- maskOrigin := x @ y.
- gcId notNil ifTrue:[
- device setMaskOriginX:x y:y in:gcId
- ]
- ]
-
- "Created: / 26.1.1998 / 18:51:18 / cg"
+ self maskOrigin:(orgX @ orgY)
!
noClipByChildren
@@ -1133,7 +1142,20 @@
y:dstY
!
-
+copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h
+ "copy from aDrawable into the receiver;
+ the source may be the receiver as well - in this case its a scroll.
+ All coordinates are in device coordinates."
+
+ ^ self
+ copyFrom:aDrawable
+ x:srcX y:srcY
+ toX:dstX y:dstY
+ width:w height:h
+ async:false
+
+ "Modified: 29.1.1997 / 13:12:36 / cg"
+!
copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h async:async
"copy from aDrawable into the receiver;
@@ -1144,10 +1166,10 @@
(not all devices care for this).
If the receiver is a pixmap, the call always returns immediately."
- |deviceDrawable id srcGCId|
+ |deviceDrawable id srcGCId asy|
((aDrawable graphicsDevice ~~ device)
- or:[aDrawable isImage]) ifTrue:[
+ or:[aDrawable isImage]) ifTrue:[
deviceDrawable := aDrawable asFormOn:device.
] ifFalse:[
deviceDrawable := aDrawable
@@ -1162,7 +1184,9 @@
This will be fixed soon (no longer use device>>bitmapFromFile:).
"
id isNil ifTrue:[
- 'DeviceGraphicsContext [warning]: invalid bitmap copy - ignored' errorPrintCR.
+ Smalltalk isStandAloneApp ifFalse:[
+ 'DeviceGraphicsContext [warning]: invalid bitmap copy - ignored' infoPrintCR.
+ ].
^ self
].
@@ -1213,6 +1237,10 @@
width:w
height:h
] ifFalse:[
+ asy := async or:[self isView not].
+ asy ifFalse:[
+ self catchExpose
+ ].
device
copyFromId:id
x:srcX
@@ -1224,6 +1252,10 @@
gc:gcId
width:w
height:h.
+ asy ifFalse:[
+ device flush.
+ self waitForExpose
+ ]
]
]
@@ -1315,29 +1347,32 @@
displayArcX:x y:y width:w height:h from:startAngle angle:angle
"draw an arc; apply transformation if nonNil"
- |pX pY nW nH sA a|
+ |pX pY nW nH sA a pO pC|
gcId isNil ifTrue:[
- self initGC
+ 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.
- ].
+ pO := transformation transformPoint:x@y.
+ pC := transformation transformPoint:(x+w-1)@(y+h-1).
+ pX := pO x.
+ pY := pO y.
+ nW := pC x - pX + 1.
+ nH := pC y - pY + 1.
+
+ 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.
@@ -1351,14 +1386,14 @@
a isInteger ifFalse:[a := a asFloat].
device
- displayArcX:pX
- y:pY
- width:nW
- height:nH
- from:sA
- angle:a
- in:drawableId
- with:gcId
+ displayArcX:pX
+ y:pY
+ width:nW
+ height:nH
+ from:sA
+ angle:a
+ in:drawableId
+ with:gcId
"Created: 8.5.1996 / 08:31:30 / cg"
"Modified: 4.6.1996 / 17:59:28 / cg"
@@ -1377,49 +1412,52 @@
certain, that the colors are real colors (actually, only for
noColor or allColor)."
- |realForm pX pY w h nW nH|
+ |realForm pX pY w h nW nH pO pC|
realForm := formToDraw.
transformation notNil ifTrue:[
- pX := transformation applyToX:x.
- pY := transformation applyToY:y.
-
- transformation noScale ifFalse:[
- w := formToDraw width.
- h := formToDraw height.
-
- nW := (transformation applyScaleX:w) rounded.
- nH := (transformation applyScaleY:h) rounded.
-
- ((nW ~= w) or:[nH ~= h]) ifTrue:[
- "/
- "/ hard case - someone is drawing forms with scaling in effect
- "/ look if we have a scaled version in our pocket ...
- "/
- realForm := nil.
- CachedScaledForms notNil ifTrue:[
- (CachedScales at:formToDraw ifAbsent:nil) = transformation scale ifTrue:[
- realForm := CachedScaledForms at:formToDraw ifAbsent:nil.
- ]
- ].
- realForm isNil ifTrue:[
- "/
- "/ nope - must do the work ...
- "/
- realForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
- CachedScaledForms isNil ifTrue:[
- CachedScaledForms := WeakIdentityDictionary new.
- CachedScales := WeakIdentityDictionary new.
- ].
- CachedScaledForms at:formToDraw put:realForm.
- CachedScales at:formToDraw put:transformation scale.
- ]
- ]
- ]
+ pO := transformation transformPoint:x@y.
+ pX := pO x.
+ pY := pO y.
+
+ transformation isNoScale ifFalse:[
+ w := formToDraw width.
+ h := formToDraw height.
+ pC := transformation applyTo:(x+w-1)@(y+h-1).
+ nW := pC x - pX + 1.
+ nH := pC y - pY + 1.
+ "/ nW := (transformation applyScaleX:w) rounded.
+ "/ nH := (transformation applyScaleY:h) rounded.
+
+ ((nW ~= w) or:[nH ~= h]) ifTrue:[
+ "/
+ "/ hard case - someone is drawing forms with scaling in effect
+ "/ look if we have a scaled version in our pocket ...
+ "/
+ realForm := nil.
+ CachedScaledForms notNil ifTrue:[
+ (CachedScales at:formToDraw ifAbsent:nil) = transformation scale ifTrue:[
+ realForm := CachedScaledForms at:formToDraw ifAbsent:nil.
+ ]
+ ].
+ realForm isNil ifTrue:[
+ "/
+ "/ nope - must do the work ...
+ "/
+ realForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
+ CachedScaledForms isNil ifTrue:[
+ CachedScaledForms := WeakIdentityDictionary new.
+ CachedScales := WeakIdentityDictionary new.
+ ].
+ CachedScaledForms at:formToDraw put:realForm.
+ CachedScales at:formToDraw put:transformation scale.
+ ]
+ ]
+ ]
] ifFalse:[
- pX := x.
- pY := y.
+ pX := x.
+ pY := y.
].
self displayDeviceForm:realForm x:pX y:pY
@@ -1427,58 +1465,124 @@
"Modified: 12.4.1997 / 12:47:29 / cg"
!
-displayLineFromX:x0 y:y0 toX:x1 y:y1
+displayLineFrom:p0 to:p1
"draw a line (with current paint-color); apply transformation if nonNil"
- |pX0 pY0 pX1 pY1 easy fgId bgId|
+ |pX0 pY0 pX1 pY1 easy fgId bgId tp0 tp1|
gcId isNil ifTrue:[
- self initGC
+ self initGC
].
lineStyle == #doubleDashed ifTrue:[
- "
- if bgPaint or paint is not a real color, we have to do it the hard way ...
- "
- easy := true.
- paint isColor ifFalse:[
- easy := false
- ] ifTrue:[
- fgId := paint colorId.
- fgId isNil ifTrue:[
- easy := false
- ]
- ].
- bgPaint isColor ifFalse:[
- easy := false
- ] ifTrue:[
- bgId := bgPaint colorId.
- bgId isNil ifTrue:[
- easy := false
- ]
- ].
-
- easy ifTrue:[
- ((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
- device setForeground:fgId background:bgId in:gcId.
- foreground := paint.
- background := bgPaint.
- ].
- ] ifFalse:[
- 'DeviceGraphicsContext [warning]: cannot draw dashes with dithered colors' errorPrintCR
- ].
+ "
+ if bgPaint or paint is not a real color, we have to do it the hard way ...
+ "
+ easy := true.
+ paint isColor ifFalse:[
+ easy := false
+ ] ifTrue:[
+ fgId := paint colorId.
+ fgId isNil ifTrue:[
+ easy := false
+ ]
+ ].
+ bgPaint isColor ifFalse:[
+ easy := false
+ ] ifTrue:[
+ bgId := bgPaint colorId.
+ bgId isNil ifTrue:[
+ easy := false
+ ]
+ ].
+
+ easy ifTrue:[
+ ((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
+ device setForeground:fgId background:bgId in:gcId.
+ foreground := paint.
+ background := bgPaint.
+ ].
+ ] ifFalse:[
+ 'DeviceGraphicsContext [warning]: cannot draw dashes with dithered colors' errorPrintCR
+ ].
].
transformation notNil ifTrue:[
- pX0 := transformation applyToX:x0.
- pY0 := transformation applyToY:y0.
- pX1 := transformation applyToX:x1.
- pY1 := transformation applyToY:y1.
+ tp0 := transformation transformPoint:p0.
+ tp1 := transformation transformPoint:p1.
+ pX0 := tp0 x.
+ pY0 := tp0 y.
+ pX1 := tp1 x.
+ pY1 := tp1 y.
] ifFalse:[
- pX0 := x0.
- pY0 := y0.
- pX1 := x1.
- pY1 := y1
+ pX0 := p0 x.
+ pY0 := p0 y.
+ pX1 := p1 x.
+ pY1 := p1 y
+ ].
+
+ pX0 := pX0 rounded.
+ pY0 := pY0 rounded.
+ pX1 := pX1 rounded.
+ pY1 := pY1 rounded.
+
+ device displayLineFromX:pX0 y:pY0 toX:pX1 y:pY1 in:drawableId with:gcId
+!
+
+displayLineFromX:x0 y:y0 toX:x1 y:y1
+ "draw a line (with current paint-color); apply transformation if nonNil"
+
+ |pX0 pY0 pX1 pY1 easy fgId bgId p0 p1|
+
+ gcId isNil ifTrue:[
+ self initGC
+ ].
+
+ lineStyle == #doubleDashed ifTrue:[
+ "
+ if bgPaint or paint is not a real color, we have to do it the hard way ...
+ "
+ easy := true.
+ paint isColor ifFalse:[
+ easy := false
+ ] ifTrue:[
+ fgId := paint colorId.
+ fgId isNil ifTrue:[
+ easy := false
+ ]
+ ].
+ bgPaint isColor ifFalse:[
+ easy := false
+ ] ifTrue:[
+ bgId := bgPaint colorId.
+ bgId isNil ifTrue:[
+ easy := false
+ ]
+ ].
+
+ easy ifTrue:[
+ ((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
+ device setForeground:fgId background:bgId in:gcId.
+ foreground := paint.
+ background := bgPaint.
+ ].
+ ] ifFalse:[
+ 'DeviceGraphicsContext [warning]: cannot draw dashes with dithered colors' errorPrintCR
+ ].
+ ].
+
+ transformation notNil ifTrue:[
+ p0 := transformation transformPoint:x0@y0.
+ p1 := transformation transformPoint:x1@y1.
+ pX0 := p0 x.
+ pY0 := p0 y.
+ pX1 := p1 x.
+ pY1 := p1 y.
+ ] ifFalse:[
+ pX0 := x0.
+ pY0 := y0.
+ pX1 := x1.
+ pY1 := y1
].
pX0 := pX0 rounded.
@@ -1502,57 +1606,62 @@
(by sending #on: to the colors) before doing so.
If there is a transformation, the image is scaled as appropiate."
- |w h realForm pX pY nW nH|
+ |w h realForm pX pY nW nH pO pC|
bgPaint isNil ifTrue:[
- "/
- "/ actually not an opaque draw
- "/
- self displayForm:formToDraw x:x y:y.
- ^ self
+ "/
+ "/ actually not an opaque draw
+ "/
+ self displayForm:formToDraw x:x y:y.
+ ^ self
].
realForm := formToDraw.
transformation notNil ifTrue:[
- pX := transformation applyToX:x.
- pY := transformation applyToY:y.
-
- transformation noScale ifFalse:[
- w := formToDraw width.
- h := formToDraw height.
-
- nW := (transformation applyScaleX:w) rounded.
- nH := (transformation applyScaleY:h) rounded.
-
- ((nW ~= w) or:[nH ~= h]) ifTrue:[
- "/
- "/ hard case - someone is drawing forms with scaling in effect
- "/ look if we have a scaled version in our pocket ...
- "/
- realForm := nil.
- CachedScaledForms notNil ifTrue:[
- (CachedScales at:formToDraw ifAbsent:nil) = transformation scale ifTrue:[
- realForm := CachedScaledForms at:formToDraw ifAbsent:nil.
- ]
- ].
- realForm isNil ifTrue:[
- "/
- "/ nope - must do the work ...
- "/
- realForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
- CachedScaledForms isNil ifTrue:[
- CachedScaledForms := WeakIdentityDictionary new.
- CachedScales := WeakIdentityDictionary new.
- ].
- CachedScaledForms at:formToDraw put:realForm.
- CachedScales at:formToDraw put:transformation scale.
- ]
- ]
- ]
+ pO := transformation transformPoint:x@y.
+ pX := pO x.
+ pY := pO y.
+ "/ pX := transformation applyToX:x.
+ "/ pY := transformation applyToY:y.
+
+ transformation isNoScale ifFalse:[
+ w := formToDraw width.
+ h := formToDraw height.
+ pC := transformation applyTo:(x+w-1)@(y+h-1).
+ nW := pX - x + 1.
+ nH := pY - y + 1.
+ "/ nW := (transformation applyScaleX:w) rounded.
+ "/ nH := (transformation applyScaleY:h) rounded.
+
+ ((nW ~= w) or:[nH ~= h]) ifTrue:[
+ "/
+ "/ hard case - someone is drawing forms with scaling in effect
+ "/ look if we have a scaled version in our pocket ...
+ "/
+ realForm := nil.
+ CachedScaledForms notNil ifTrue:[
+ (CachedScales at:formToDraw ifAbsent:nil) = transformation scale ifTrue:[
+ realForm := CachedScaledForms at:formToDraw ifAbsent:nil.
+ ]
+ ].
+ realForm isNil ifTrue:[
+ "/
+ "/ nope - must do the work ...
+ "/
+ realForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
+ CachedScaledForms isNil ifTrue:[
+ CachedScaledForms := WeakIdentityDictionary new.
+ CachedScales := WeakIdentityDictionary new.
+ ].
+ CachedScaledForms at:formToDraw put:realForm.
+ CachedScales at:formToDraw put:transformation scale.
+ ]
+ ]
+ ]
] ifFalse:[
- pX := x.
- pY := y.
+ pX := x.
+ pY := y.
].
self displayDeviceOpaqueForm:realForm x:pX y:pY
@@ -1593,17 +1702,18 @@
displayPointX:x y:y
"draw a point (with current paint-color); apply transformation if nonNil"
- |pX pY|
+ |pX pY pO|
gcId isNil ifTrue:[
- self initGC
+ self initGC
].
transformation notNil ifTrue:[
- pX := transformation applyToX:x.
- pY := transformation applyToY:y.
+ pO := transformation transformPoint:x@y.
+ pX := pO x.
+ pY := pO y.
] ifFalse:[
- pX := x.
- pY := y
+ pX := x.
+ pY := y
].
pX := pX rounded.
pY := pY rounded.
@@ -1621,7 +1731,7 @@
self initGC
].
transformation notNil ifTrue:[
- newPolygon := aPolygon collect:[:point | transformation applyTo:point].
+ newPolygon := aPolygon collect:[:point | transformation transformPoint:point].
] ifFalse:[
newPolygon := aPolygon
].
@@ -1640,63 +1750,69 @@
"draw a rectangle (with current paint-color).
If transformation is nonNil, drawing is in logical coordinates."
- |pX pY nW nH easy fgId bgId|
+ |pX pY nW nH easy fgId bgId pO pC|
gcId isNil ifTrue:[
- self initGC
+ self initGC
].
lineStyle == #doubleDashed ifTrue:[
- "
- if bgPaint or paint is not a real color, we have to do it the hard way ...
- "
- easy := true.
- paint isColor ifFalse:[
- easy := false
- ] ifTrue:[
- fgId := paint colorId.
- fgId isNil ifTrue:[
- easy := false
- ]
- ].
- bgPaint isColor ifFalse:[
- easy := false
- ] ifTrue:[
- bgId := bgPaint colorId.
- bgId isNil ifTrue:[
- easy := false
- ]
- ].
-
- easy ifTrue:[
- ((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
- device setForeground:fgId background:bgId in:gcId.
- foreground := paint.
- background := bgPaint.
- ].
- ] ifFalse:[
- 'DeviceGraphicsContext [warning]: cannot draw dashes with dithered colors' errorPrintCR
- ].
+ "
+ if bgPaint or paint is not a real color, we have to do it the hard way ...
+ "
+ easy := true.
+ paint isColor ifFalse:[
+ easy := false
+ ] ifTrue:[
+ fgId := paint colorId.
+ fgId isNil ifTrue:[
+ easy := false
+ ]
+ ].
+ bgPaint isColor ifFalse:[
+ easy := false
+ ] ifTrue:[
+ bgId := bgPaint colorId.
+ bgId isNil ifTrue:[
+ easy := false
+ ]
+ ].
+
+ easy ifTrue:[
+ ((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
+ device setForeground:fgId background:bgId in:gcId.
+ foreground := paint.
+ background := bgPaint.
+ ].
+ ] ifFalse:[
+ 'DeviceGraphicsContext [warning]: cannot draw dashes with dithered colors' errorPrintCR
+ ].
].
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.
- ].
+ pO := transformation transformPoint:x@y.
+ pC := transformation transformPoint:(x+w-1)@(y+h-1).
+ pX := pO x.
+ pY := pO y.
+ nW := pC x - pX + 1.
+ nH := pC y - pY + 1.
+"/ pX := transformation applyToX:x.
+"/ pY := transformation applyToY:y.
+"/ nW := transformation applyScaleX:w.
+"/ nH := transformation applyScaleY:h.
+ nW < 0 ifTrue:[
+ nW := nW abs.
+ pX := pX - nW.
+ ].
+ nH < 0 ifTrue:[
+ nH := nH abs.
+ pY := pY - nH.
+ ].
] ifFalse:[
- pX := x.
- pY := y.
- nW := w.
- nH := h
+ pX := x.
+ pY := y.
+ nW := w.
+ nH := h
].
pX := pX rounded.
@@ -1710,10 +1826,10 @@
I'm not certain if is the right thing to do ...
"
device displayRectangleX:pX
- y:pY
- width:(nW - 1)
- height:(nH - 1)
- in:drawableId with:gcId
+ y:pY
+ width:(nW - 1)
+ height:(nH - 1)
+ in:drawableId with:gcId
"Modified: 10.1.1997 / 17:46:41 / cg"
!
@@ -1949,14 +2065,15 @@
noColor or allColor).
The origins coordinate is transformed, but the image itself is unscaled."
- |pX pY|
+ |pX pY pO|
transformation notNil ifTrue:[
- pX := transformation applyToX:x.
- pY := transformation applyToY:y.
+ pO := transformation transformPoint:(x@y).
+ pX := pO x.
+ pY := pO y.
] ifFalse:[
- pX := x.
- pY := y.
+ pX := x.
+ pY := y.
].
self displayDeviceForm:formToDraw x:pX y:pY
@@ -1972,14 +2089,15 @@
settings are ignored and the form is drawn as-is (opaque).
The origins coordinate is transformed, but the image itself is unscaled."
- |pX pY|
+ |pX pY pO|
transformation notNil ifTrue:[
- pX := transformation applyToX:x.
- pY := transformation applyToY:y.
+ pO := transformation transformPoint:(x@y).
+ pX := pO x.
+ pY := pO y.
] ifFalse:[
- pX := x.
- pY := y.
+ pX := x.
+ pY := y.
].
self displayDeviceOpaqueForm:formToDraw x:pX y:pY
@@ -1991,14 +2109,15 @@
"draw a substring at the transformed coordinate x/y but do not scale the font.
Draw foreground pixels in paint-color, background pixels in bgPaint color."
- |pX pY|
+ |pX pY pO|
transformation notNil ifTrue:[
- pX := transformation applyToX:x.
- pY := transformation applyToY:y.
+ pO := transformation transformPoint:(x@y).
+ pX := pO x.
+ pY := pO y.
] ifFalse:[
- pX := x.
- pY := y.
+ pX := x.
+ pY := y.
].
self displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:pX y:pY
!
@@ -2007,14 +2126,15 @@
"draw a string at the transformed coordinate x/y but do not scale the font.
Draw foreground pixels in paint-color, background pixels in bgPaint color."
- |pX pY|
+ |pX pY pO|
transformation notNil ifTrue:[
- pX := transformation applyToX:x.
- pY := transformation applyToY:y.
+ pO := transformation transformPoint:(x@y).
+ pX := pO x.
+ pY := pO y.
] ifFalse:[
- pX := x.
- pY := y.
+ pX := x.
+ pY := y.
].
self displayDeviceOpaqueString:aString from:1 to:(aString size) in:font x:pX y:pY
!
@@ -2023,14 +2143,15 @@
"draw a substring at the transformed coordinate x/y but do not scale the font.
draw foreground-pixels only (in current paint-color), leaving background as-is."
- |pX pY|
+ |pX pY pO|
transformation notNil ifTrue:[
- pX := transformation applyToX:x.
- pY := transformation applyToY:y.
+ pO := transformation transformPoint:(x@y).
+ pX := pO x.
+ pY := pO y.
] ifFalse:[
- pX := x.
- pY := y.
+ pX := x.
+ pY := y.
].
self displayDeviceString:aString from:index1 to:index2 in:font x:pX y:pY
!
@@ -2039,14 +2160,15 @@
"draw a string at the transformed coordinate x/y but do not scale the font.
draw foreground-pixels only (in current paint-color), leaving background as-is."
- |pX pY|
+ |pX pY pO|
transformation notNil ifTrue:[
- pX := transformation applyToX:x.
- pY := transformation applyToY:y.
+ pO := transformation transformPoint:(x@y).
+ pX := pO x.
+ pY := pO y.
] ifFalse:[
- pX := x.
- pY := y.
+ pX := x.
+ pY := y.
].
self displayDeviceString:aString from:1 to:(aString size) in:font x:pX y:pY
! !
@@ -3385,29 +3507,31 @@
fillArcX:x y:y width:w height:h from:startAngle angle:angle
"draw a filled arc; apply transformation if nonNil"
- |pX pY nW nH sA a|
+ |pX pY nW nH sA a pO pC|
gcId isNil ifTrue:[
- self initGC
+ 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.
- ].
+ pO := transformation transformPoint:x@y.
+ pC := transformation transformPoint:(x+w-1)@(y+h-1).
+ pX := pO x.
+ pY := pO y.
+ nW := pC x - pX + 1.
+ nH := pC y - pY + 1.
+ 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.
@@ -3421,14 +3545,14 @@
a isInteger ifFalse:[a := a asFloat].
device
- fillArcX:pX
- y:pY
- width:nW
- height:nH
- from:sA
- angle:a
- in:drawableId
- with:gcId
+ fillArcX:pX
+ y:pY
+ width:nW
+ height:nH
+ from:sA
+ angle:a
+ in:drawableId
+ with:gcId
"Created: 8.5.1996 / 08:29:45 / cg"
"Modified: 4.6.1996 / 17:58:21 / cg"
@@ -3440,52 +3564,55 @@
|newPolygon|
gcId isNil ifTrue:[
- self initGC
+ self initGC
].
transformation notNil ifTrue:[
- newPolygon := aPolygon collect:[:point | transformation applyTo:point].
+ newPolygon := aPolygon collect:[:point | transformation transformPoint:point].
] ifFalse:[
- newPolygon := aPolygon
+ newPolygon := aPolygon
].
(newPolygon contains:[:p |
- (p isPoint not
- or:[(p x class ~~ SmallInteger)
- or:[(p y class ~~ SmallInteger)]])
+ (p isPoint not
+ or:[(p x class ~~ SmallInteger)
+ or:[(p y class ~~ SmallInteger)]])
]) ifTrue:[
- newPolygon := newPolygon collect:[:p | p asPoint rounded]
+ newPolygon := newPolygon collect:[:p | p asPoint rounded]
].
device
- fillPolygon:newPolygon
- in:drawableId
- with:gcId
+ fillPolygon:newPolygon
+ in:drawableId
+ with:gcId
!
fillRectangleX:x y:y width:w height:h
"draw a filled rectangle; apply transformation if nonNil"
- |pX pY nW nH|
+ |pX pY nW nH pO pC|
gcId isNil ifTrue:[
- self initGC
+ 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.
- ].
+ pO := transformation transformPoint:x@y.
+ pC := transformation transformPoint:(x+w-1)@(y+h-1).
+ pX := pO x.
+ pY := pO y.
+ nW := pC x - pX + 1.
+ nH := pC y - pY + 1.
+
+ 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.
@@ -3493,11 +3620,11 @@
nH := nH rounded.
device
- fillRectangleX:pX
- y:pY
- width:nW
- height:nH
- in:drawableId with:gcId
+ fillRectangleX:pX
+ y:pY
+ width:nW
+ height:nH
+ in:drawableId with:gcId
"Modified: 4.6.1996 / 17:58:49 / cg"
! !
@@ -3553,6 +3680,8 @@
"Modified: 19.3.1997 / 11:07:52 / cg"
!
+
+
destroy
|id|
@@ -3579,6 +3708,10 @@
].
!
+
+
+
+
initGC
"since we do not need a gc-object for the drawable until something is
really drawn, none is created.
@@ -3730,6 +3863,8 @@
"Modified: 28.10.1996 / 13:25:02 / 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."
@@ -3918,6 +4053,8 @@
Lobby registerChange:self.
!
+
+
createRootWindowFor:aView
drawableId := device rootWindowFor:aView.
drawableType := #window.
--- a/DeviceWorkstation.st Thu Feb 19 06:21:17 2015 +0000
+++ b/DeviceWorkstation.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
HostGraphicsDevice subclass:#DeviceWorkstation
instanceVariableNames:'visualType monitorType depth ncells bitsPerRGB bitsRed bitsGreen
bitsBlue redMask greenMask blueMask redShift greenShift blueShift
@@ -4599,17 +4601,27 @@
aView sensor mappedView:aView
!
-mouseWheelMotion:buttonState x:x y:y amount:amount deltaTime:dTime view:aView
+mouseWheelMotion:buttonState x:x y:y amount:amountArg deltaTime:dTime view:aView
"the mousewheel was moved by some amount (signed).
This event is sent to the current pointer view (like keyPress/release)."
+ |amount|
+
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
- ].
+ "/ event arrived, after I destroyed it myself
+ ^ self
+ ].
+ amount := amountArg.
+ UserPreferences current mouseWheelDirectionReversed ifTrue:[
+ amount := amount negated
+ ].
aView sensor
- mouseWheelMotion:buttonState x:x y:y amount:amount deltaTime:dTime view:aView
-
+ mouseWheelMotion:buttonState x:x y:y amount:amount deltaTime:dTime view:aView
+
+ "
+ UserPreferences current mouseWheelDirectionReversed:true
+ UserPreferences current mouseWheelDirectionReversed:false
+ "
"Modified: / 21.5.1999 / 13:05:53 / cg"
!
@@ -7085,12 +7097,12 @@
!DeviceWorkstation methodsFor:'misc'!
beep
+ "output an audible beep or bell"
+
"{ Pragma: +optSpace }"
- "output an audible beep or bell"
-
UserPreferences current beepEnabled ifTrue:[
- Stdout nextPut:(Character bell)
+ Stdout nextPut:(Character bell)
]
"Modified: / 13.1.1997 / 22:56:13 / cg"
@@ -8425,11 +8437,11 @@
!DeviceWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.626 2014-11-28 16:11:45 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.628 2015-02-10 12:53:50 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.626 2014-11-28 16:11:45 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.628 2015-02-10 12:53:50 cg Exp $'
! !
--- a/DisplayRootView.st Thu Feb 19 06:21:17 2015 +0000
+++ b/DisplayRootView.st Tue Mar 03 03:55:48 2015 +0000
@@ -87,7 +87,7 @@
!
version
- ^ '$Header: /cvs/stx/stx/libview/DisplayRootView.st,v 1.42.2.2 2014-12-12 18:32:42 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DisplayRootView.st,v 1.45 2015-02-10 13:18:23 cg Exp $'
! !
!DisplayRootView class methodsFor:'instance creation'!
@@ -248,8 +248,12 @@
!
isActive
- "compatibility with all other views"
+ "for protocol compatibility with regular views"
+ ^ false.
+!
+
+isComponentOf: aView
^ false
!
--- a/DisplaySurface.st Thu Feb 19 06:21:17 2015 +0000
+++ b/DisplaySurface.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
GraphicsMedium subclass:#DisplaySurface
instanceVariableNames:'viewBackground cursor eventMask moreAttributes renderer uuid
backed flags delegate updateRegion'
@@ -85,10 +87,6 @@
[author:]
Claus Gittinger
"
-!
-
-version_CVS
- ^ '$Header: /cvs/stx/stx/libview/DisplaySurface.st,v 1.162.2.2 2014-09-25 21:09:41 stefan Exp $'
! !
!DisplaySurface class methodsFor:'initialization'!
@@ -460,6 +458,10 @@
aCursor notNil ifTrue:[
(aCursor ~~ cursor) ifTrue:[
+ "/ aCursor = Cursor wait ifTrue:[
+ "/ Transcript showCR:'==========================='.
+ "/ thisContext fullPrintAllOn:Transcript.
+ "/ ].
cursor := aCursor.
self drawableId notNil ifTrue:[
self setCursor.
@@ -560,12 +562,12 @@
self
withCursor:aCursor do:[
- |timeToExecute remainingShowTime|
-
- timeToExecute := Time millisecondsToRun:[ ret := aBlock value].
- remainingShowTime := UserPreferences current waitCursorVisibleTime - timeToExecute.
- remainingShowTime > 0 ifTrue:[
- Delay waitForMilliseconds:remainingShowTime.
+ |timeToExecute remainingShowTime|
+
+ timeToExecute := Time millisecondsToRun:[ ret := aBlock value].
+ remainingShowTime := UserPreferences current waitCursorVisibleTime - timeToExecute.
+ remainingShowTime > 0 ifTrue:[
+ Delay waitForMilliseconds:remainingShowTime.
].
].
^ ret.
@@ -1049,22 +1051,29 @@
redefined since GraphicsMedium fills with background
- not viewBackground as we want here."
- |pX pY pW pH currentTransformation|
+ |pX pY nW nH pO pC currentTransformation |
currentTransformation := gc transformation.
currentTransformation notNil ifTrue:[
- pX := currentTransformation applyToX:x.
- pY := currentTransformation applyToY:y.
- pW := currentTransformation applyScaleX:w.
- pH := currentTransformation applyScaleY:h.
+ pO := currentTransformation transformPoint:x@y.
+ pC := currentTransformation transformPoint:(x+w-1)@(y+h-1).
+ pX := pO x.
+ pY := pO y.
+ nW := pC x - pX + 1.
+ nH := pC y - pY + 1.
] ifFalse:[
pX := x.
pY := y.
- pW := w.
- pH := h.
+ nW := w.
+ nH := h.
].
- ^ self clearDeviceRectangleX:pX rounded y:pY rounded width:pW rounded height:pH rounded.
+ pX := pX rounded.
+ pY := pY rounded.
+ nW := nW rounded.
+ nH := nH rounded.
+
+ ^ self clearDeviceRectangleX:pX y:pY width:nW height:nH.
"Modified: / 30.10.1998 / 15:00:37 / cg"
!
@@ -1122,7 +1131,7 @@
xR0 := (x // pW) * pW.
xE := x+w.
- xR0 >= yE ifTrue:[^ self].
+ xR0 >= xE ifTrue:[^ self].
aPixmap depth == 1 ifTrue:[
oldFg := self foreground.
@@ -1189,14 +1198,17 @@
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 currentTransformation|
+ |pX pY nW nH pO pC currentTransformation|
currentTransformation := gc transformation.
currentTransformation notNil ifTrue:[
- pX := currentTransformation applyToX:x.
- pY := currentTransformation applyToY:y.
- nW := currentTransformation applyScaleX:w.
- nH := currentTransformation applyScaleY:h.
+ pO := currentTransformation transformPoint:x@y.
+ pC := currentTransformation transformPoint:(x+w-1)@(y+h-1).
+ pX := pO x.
+ pY := pO y.
+ nW := pC x - pX + 1.
+ nH := pC y - pY + 1.
+
nW < 0 ifTrue:[
nW := nW abs.
pX := pX - nW.
@@ -2169,50 +2181,50 @@
graphicsDevice := self graphicsDevice.
graphicsDevice scrollsAsynchronous ifFalse:[
- self setGotExposeFlag.
- ^ self
+ 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
- "/
- graphicsDevice isWindowsPlatform 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.
- ].
+ "/
+ "/ a pure event driven view.
+ "/ wait by doing a direct dispatch loop until the event arrives.
+ "/ i.e. poll for the event
+ "/
+ graphicsDevice isWindowsPlatform 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"
@@ -2491,5 +2503,15 @@
"Modified: 18.5.1996 / 15:44:33 / cg"
! !
+!DisplaySurface class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/DisplaySurface.st,v 1.168 2015-02-15 13:57:51 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/DisplaySurface.st,v 1.168 2015-02-15 13:57:51 cg Exp $'
+! !
+
DisplaySurface initialize!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/DisplayTransform.st Tue Mar 03 03:55:48 2015 +0000
@@ -0,0 +1,209 @@
+"{ Package: 'stx:libview' }"
+
+Object subclass:#DisplayTransform
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Transformations'
+!
+
+DisplayTransform comment:'This class represents a base for generic transformations of 2D points between different coordinate systems (including scaling and rotation). The transformations map objects between one coordinate system and another where it is assumed that a nested hierarchy of transformations can be defined.
+
+It is assumed that transformations deal with Integer points. All transformations should return Integer coordinates (even though float points may be passed in as argument).
+
+Compositions of transformations MUST work in the following order. A ''global'' transformation (the argument in #composedWithGlobal:) is defined as a transformation that takes place between the receiver (the ''local'') transformation and any ''global'' point computations, whereas a ''local'' transformation (e.g., the argument in #composedWithLocal:) takes place between the receiver (''global'') and any ''local'' points. For the transformation methods this means that combining a global and a local transformation will result in the following order:
+
+ globalPointToLocal: globalPoint
+ "globalPoint -> globalTransform -> localTransform -> locaPoint"
+ ^localTransform globalPointToLocal:
+ (globalTransform globalPointToLocal: globalPoint)
+
+ localPointToGlobal: localPoint
+ "localPoint -> localTransform -> globalTransform -> globalPoint"
+ ^globalTransform localPointToGlobal:
+ (localTransform localPointToGlobal: localPoint)
+
+'
+!
+
+
+!DisplayTransform class methodsFor:'instance creation'!
+
+identity
+ ^self new setIdentity
+! !
+
+!DisplayTransform methodsFor:'accessing'!
+
+inverseTransformation
+ "Return the inverse transformation of the receiver"
+ ^self subclassResponsibility
+! !
+
+!DisplayTransform methodsFor:'composing'!
+
+composedWithGlobal: aTransformation
+ "Return the composition of the receiver and the global transformation passed in.
+ A 'global' transformation is defined as a transformation that takes place
+ between the receiver (the 'local') transformation and any 'global' point
+ computations, e.g., for the methods
+
+ globalPointToLocal: globalPoint
+ globalPoint -> globalTransform -> localTransform -> locaPoint
+
+ localPointToGlobal: localPoint
+ localPoint -> localTransform -> globalTransform -> globalPoint
+
+ "
+ ^aTransformation composedWithLocal: self
+!
+
+composedWithLocal: aTransformation
+ "Return the composition of the receiver and the local transformation passed in.
+ A 'local' transformation is defined as a transformation that takes place
+ between the receiver (the 'global') transformation and any 'local' point
+ computations, e.g., for the methods
+
+ globalPointToLocal: globalPoint
+ globalPoint -> globalTransform -> localTransform -> locaPoint
+
+ localPointToGlobal: localPoint
+ localPoint -> localTransform -> globalTransform -> globalPoint
+
+ "
+ self isIdentity ifTrue:[^ aTransformation].
+ aTransformation isIdentity ifTrue:[^ self].
+ ^ CompositeTransform new globalTransform: self
+ localTransform: aTransformation
+! !
+
+!DisplayTransform methodsFor:'converting'!
+
+asCompositeTransform
+ "Represent the receiver as a composite transformation"
+ ^CompositeTransform new
+ globalTransform: self
+ localTransform: self species identity
+!
+
+asMatrixTransform2x3
+ "Represent the receiver as a 2x3 matrix transformation"
+ ^self subclassResponsibility
+! !
+
+!DisplayTransform methodsFor:'initialize'!
+
+setIdentity
+ "Initialize the receiver to the identity transformation (e.g., not affecting points)"
+
+ ^self subclassResponsibility
+! !
+
+!DisplayTransform methodsFor:'testing'!
+
+isCompositeTransform
+ "Return true if the receiver is a composite transformation.
+ Composite transformations may have impact on the accuracy."
+ ^false
+!
+
+isIdentity
+ "Return true if the receiver is the identity transform; that is, if applying to a point returns the point itself."
+ ^self subclassResponsibility
+!
+
+isMatrixTransform2x3
+ "Return true if the receiver is 2x3 matrix transformation"
+ ^false
+!
+
+isMorphicTransform
+ "Return true if the receiver is a MorphicTransform, that is specifies the transformation values explicitly."
+ ^false
+!
+
+isNoScale
+ "return true if the identity scale is in effect (i.e. saleFactor is 1);
+ return false, otherwise."
+
+ |s|
+
+ s := self scale.
+ ^ s x = 1 and:[s y = 1]
+!
+
+isPureTranslation
+ "Return true if the receiver specifies no rotation or scaling."
+ ^self subclassResponsibility
+!
+
+noScale
+ "return true if the identity scale is in effect (i.e. saleFactor is 1);
+ return false, otherwise.
+ Obsolete: use isNoScale"
+
+ <resource: #obsolete>
+
+ ^ self isNoScale
+! !
+
+!DisplayTransform methodsFor:'transforming points'!
+
+applyInverseTo:aPoint
+ ^ self invertPoint: aPoint
+!
+
+applyScaleX:aNumber
+ ^ (self transformPoint: aNumber @ 0) x
+!
+
+applyScaleY:aNumber
+ ^ (self transformPoint: 0 @ aNumber) y
+!
+
+applyTo:aPoint
+ ^ self transformPoint: aPoint
+!
+
+globalPointToLocal: aPoint
+ "Transform aPoint from global coordinates into local coordinates"
+ ^self subclassResponsibility
+!
+
+globalPointsToLocal: inArray
+ "Transform all the points of inArray from global into local coordinates"
+ ^inArray collect:[:pt| self globalPointToLocal: pt]
+!
+
+localPointToGlobal: aPoint
+ "Transform aPoint from local coordinates into global coordinates"
+ ^self subclassResponsibility
+!
+
+localPointsToGlobal: inArray
+ "Transform all the points of inArray from local into global coordinates"
+ ^inArray collect:[:pt| self localPointToGlobal: pt]
+! !
+
+!DisplayTransform methodsFor:'transforming rects'!
+
+globalBoundsToLocal: aRectangle
+ "Transform aRectangle from global coordinates into local coordinates"
+ ^Rectangle encompassing: (self globalPointsToLocal: aRectangle corners)
+!
+
+localBoundsToGlobal: aRectangle
+ "Transform aRectangle from local coordinates into global coordinates"
+ ^Rectangle encompassing: (self localPointsToGlobal: aRectangle corners)
+! !
+
+!DisplayTransform class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/DisplayTransform.st,v 1.1 2014-12-21 22:27:44 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/DisplayTransform.st,v 1.1 2014-12-21 22:27:44 cg Exp $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/FillStyle.st Tue Mar 03 03:55:48 2015 +0000
@@ -0,0 +1,41 @@
+"{ Package: 'stx:libview' }"
+
+Object subclass:#FillStyle
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Compatibility-Squeak-Balloon-Fills'
+!
+
+!FillStyle class methodsFor:'documentation'!
+
+documentation
+"
+ an as-yet unused class.
+ For now, this is present as compatibility class (for Squeak),
+ but we may move change the fill/drawing code in the view hierarchy to use it later.
+
+ [author:]
+ cg
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+
+"
+! !
+
+
+
+!FillStyle class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/FillStyle.st,v 1.3 2014-12-19 21:31:26 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/FillStyle.st,v 1.3 2014-12-19 21:31:26 cg Exp $'
+! !
+
--- a/FontDescription.st Thu Feb 19 06:21:17 2015 +0000
+++ b/FontDescription.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
Object subclass:#FontDescription
instanceVariableNames:'family face style size encoding manufacturer name flags masks
sizeUnit pixelSize'
@@ -850,6 +852,16 @@
masks := something.
!
+name
+ "the name (typically filename) if known"
+
+ ^ name
+!
+
+name:aString
+ name := aString.
+!
+
sizeUnit
"currently returns one of #pt or #px (internal use only)"
@@ -1730,11 +1742,11 @@
!FontDescription class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/FontDescription.st,v 1.97 2014-11-27 00:10:50 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/FontDescription.st,v 1.98 2015-01-07 23:09:42 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/FontDescription.st,v 1.97 2014-11-27 00:10:50 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/FontDescription.st,v 1.98 2015-01-07 23:09:42 cg Exp $'
! !
--- a/GradientBackground.st Thu Feb 19 06:21:17 2015 +0000
+++ b/GradientBackground.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
AbstractBackground subclass:#GradientBackground
instanceVariableNames:'color1 color2 direction cachedForm usedLength'
classVariableNames:''
@@ -85,6 +87,12 @@
"
! !
+!GradientBackground class methodsFor:'queries'!
+
+possibleDirections
+ ^ #(#'northSouth' #'eastWest' )
+! !
+
!GradientBackground methodsFor:'accessing'!
color1
@@ -330,10 +338,10 @@
!GradientBackground class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/GradientBackground.st,v 1.17 2014-01-16 14:31:54 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/GradientBackground.st,v 1.18 2015-02-14 21:30:18 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/GradientBackground.st,v 1.17 2014-01-16 14:31:54 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/GradientBackground.st,v 1.18 2015-02-14 21:30:18 cg Exp $'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/GradientFillStyle.st Tue Mar 03 03:55:48 2015 +0000
@@ -0,0 +1,41 @@
+"{ Package: 'stx:libview' }"
+
+FillStyle subclass:#GradientFillStyle
+ instanceVariableNames:'colorRamp radial origin direction'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Compatibility-Squeak-Balloon-Fills'
+!
+
+!GradientFillStyle class methodsFor:'documentation'!
+
+documentation
+"
+ an as-yet unused class.
+ For now, this is present as compatibility class (for Squeak),
+ but we may move change the fill/drawing code in the view hierarchy to use it later.
+
+ [author:]
+ cg
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+
+"
+! !
+
+
+
+!GradientFillStyle class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/GradientFillStyle.st,v 1.3 2014-12-19 21:31:27 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/GradientFillStyle.st,v 1.3 2014-12-19 21:31:27 cg Exp $'
+! !
+
--- a/Image.st Thu Feb 19 06:21:17 2015 +0000
+++ b/Image.st Tue Mar 03 03:55:48 2015 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
@@ -11,6 +13,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
Object subclass:#Image
instanceVariableNames:'pixelFunction bytes width height bitsPerPixel depth colorMap
maxPixelValue rowByteSize bitsPerSample samplesPerPixel
@@ -1934,6 +1938,15 @@
"
!
+defaultImageFileWriter
+ "only used, if a file is saved with no particular extension
+ or explicit writer given.
+ For now, default to tiff format.
+ Will change to png, as soon as all mask formats are fully supported by it"
+
+ ^ TIFFReader
+!
+
defaultPhotometric
"return the default photometric pixel interpretation.
This may be a somewhat old leftover from times, when tiff was the first image file type to be read.
@@ -12921,7 +12934,7 @@
!
brightness
- "return the (average) brightness of the image.
+ "return the (average) brightness of the image as number in 0..1.
This usually only makes sense for textures and patterns
(i.e. to compute shadow & light colors for viewBackgrounds).
Notice, that for the above purpose, only a subimage is inspected here"
@@ -13791,16 +13804,15 @@
suffix := aFileName asFilename suffix.
readerClass := MIMETypes imageReaderForSuffix:suffix.
readerClass notNil ifTrue:[
- ^ self saveOn:aFileName using:readerClass
+ ^ self saveOn:aFileName using:readerClass
].
"/
"/ no known extension - could ask user for the format here.
"/ currently default to tiff format.
"/
- 'Image [warning]: unknown extension - cannot figure out format - using tiff' errorPrintCR.
-
- ^ self saveOn:aFileName using:TIFFReader
+ 'Image [warning]: unknown extension - cannot figure out format - using default (tiff)' errorPrintCR.
+ ^ self saveOn:aFileName using:(self class defaultImageFileWriter)
"
|image|
@@ -14486,11 +14498,11 @@
!Image class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.464 2014-12-09 15:29:45 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.466 2015-03-01 15:41:31 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.464 2014-12-09 15:29:45 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.466 2015-03-01 15:41:31 cg Exp $'
! !
--- a/ImageBackground.st Thu Feb 19 06:21:17 2015 +0000
+++ b/ImageBackground.st Tue Mar 03 03:55:48 2015 +0000
@@ -12,7 +12,7 @@
"{ Package: 'stx:libview' }"
AbstractBackground subclass:#ImageBackground
- instanceVariableNames:'image'
+ instanceVariableNames:'image align cachedMagnifiedImage'
classVariableNames:''
poolDictionaries:''
category:'Graphics-Support'
@@ -32,10 +32,74 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+!
+
+examples
+"
+ [exBegin]
+ |v|
+
+ v := View new.
+ v viewBackground:(ImageBackground new image:(Image fromFile:'~/work/stx/hsv.png')).
+ v open.
+ [exEnd]
+
+ [exBegin]
+ |v|
+
+ v := View new.
+ v viewBackground:(ImageBackground new
+ image:(Image fromFile:'~/work/stx/hsv.png');
+ align:#fit).
+ v open.
+ [exEnd]
+"
+! !
+
+!ImageBackground methodsFor:'accessing'!
+
+align:something
+ align := something.
+!
+
+image:something
+ image := something.
+! !
+
+!ImageBackground methodsFor:'drawing'!
+
+fillRectangleX:x y:y width:w height:h in:aView
+ align == #right ifTrue:[
+ image displayOn:aView x:(aView right - image width) y:0.
+ ^ self
+ ].
+ align == #center ifTrue:[
+ image displayOn:aView x:(aView right - image width)//2 y:(aView bottom - image height)//2.
+ ^ self
+ ].
+ align == #fit ifTrue:[
+ (cachedMagnifiedImage notNil
+ and:[ cachedMagnifiedImage width == aView width
+ and:[ cachedMagnifiedImage height == aView height ]]) ifFalse:[
+ cachedMagnifiedImage := image magnifiedTo:aView extent.
+ aView invalidate.
+ ^ self.
+ ].
+ cachedMagnifiedImage displayOn:aView x:0 y:0.
+ ^ self
+ ].
+
+ "/ align == #left
+ x < image width ifTrue:[
+ y < image height ifTrue:[
+ image displayOn:aView x:0 y:0
+ ]
+ ]
! !
!ImageBackground class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/ImageBackground.st,v 1.2 2009-11-04 14:31:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/ImageBackground.st,v 1.3 2014-12-21 15:51:43 cg Exp $'
! !
+
--- a/ImageReader.st Thu Feb 19 06:21:17 2015 +0000
+++ b/ImageReader.st Tue Mar 03 03:55:48 2015 +0000
@@ -270,7 +270,7 @@
/* -------------------------------- */
};
-static
+static void
initCCITTTables() {
register cnt, bits, value;
int nBits, index;
@@ -2108,10 +2108,10 @@
!ImageReader class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/ImageReader.st,v 1.113 2014-11-26 15:03:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/ImageReader.st,v 1.114 2015-02-09 16:58:13 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/ImageReader.st,v 1.113 2014-11-26 15:03:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/ImageReader.st,v 1.114 2015-02-09 16:58:13 cg Exp $'
! !
--- a/KeyboardMap.st Thu Feb 19 06:21:17 2015 +0000
+++ b/KeyboardMap.st Tue Mar 03 03:55:48 2015 +0000
@@ -42,7 +42,7 @@
variable of Display.
The setup of this map is done in the 'smalltalk.rc' or one of the
- 'display.rc' files during startup.
+ 'keyboard.rc' files during startup.
To add a mapping (for example, to attach the logical function 'DoIt' to
the key-combination Cmd-'d'):
@@ -146,6 +146,6 @@
!KeyboardMap class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/KeyboardMap.st,v 1.14 2014-07-29 19:26:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/KeyboardMap.st,v 1.15 2014-12-18 16:13:06 cg Exp $'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MacButtonBorder.st Tue Mar 03 03:55:48 2015 +0000
@@ -0,0 +1,289 @@
+"{ Package: 'stx:libview' }"
+
+"{ NameSpace: Smalltalk }"
+
+AbstractBorder subclass:#MacButtonBorder
+ instanceVariableNames:''
+ classVariableNames:'TopLeftEdge TopRightEdge BottomLeftEdge BottomRightEdge'
+ poolDictionaries:''
+ category:'Graphics-Support'
+!
+
+!MacButtonBorder class methodsFor:'documentation'!
+
+documentation
+"
+ an as yet unused and unfinished attempt to provide a mac-osx like
+ button border.
+ To be continued.
+"
+!
+
+examples
+"
+ [exBegin]
+ |top v b|
+
+
+ top := StandardSystemView extent:100@100.
+ v := View origin:10@10 corner:90@30 in:top.
+ top openAndWait.
+
+ b := MacButtonBorder new.
+ v border:b.
+ [exEnd]
+
+ [exBegin]
+ |top v1 v2 b|
+
+ top := StandardSystemView extent:100@200.
+ v1 := View origin:10@10 corner:90@30 in:top.
+ v2 := View origin:10@100 corner:90@150 in:top.
+ top openAndWait.
+
+ b := MacButtonBorder new.
+ v1 border:b.
+ v2 border:b.
+ [exEnd]
+"
+! !
+
+!MacButtonBorder class methodsFor:'initialization'!
+
+initialize
+ TopLeftEdge := self topLeftImage2.
+ TopRightEdge := self topRightImage2.
+ BottomLeftEdge := self bottomLeftImage2.
+ BottomRightEdge := self bottomRightImage2.
+! !
+
+!MacButtonBorder class methodsFor:'image specs'!
+
+bottomLeftImage
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self bottomLeftImage inspect
+ ImageEditor openOnClass:self andSelector:#bottomLeftImage
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:'MacButtonBorder bottomLeftImage'
+ ifAbsentPut:[(Depth8Image new) width:4; height:4; bits:(ByteArray fromPackedString:'BP A@P@F@PD@APXH@@@DA0@a') ; colorMapFromArray:#[184 184 184 255 255 255 226 226 226 224 224 224 181 181 181 162 162 162 211 211 211 158 158 158 248 248 248 159 159 159]; mask:((Depth1Image new) width:4; height:4; bits:(ByteArray fromPackedString:'<OA0L@@a') ; yourself); yourself]
+!
+
+bottomLeftImage2
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self bottomLeftImage2 inspect
+ ImageEditor openOnClass:self andSelector:#bottomLeftImage2
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:'MacButtonBorder bottomLeftImage2'
+ ifAbsentPut:[(Depth8Image new) width:9; height:10; bits:(ByteArray fromPackedString:'E@4VHRD!!HRD!!E0XUHRD!!HRD!!GP0QG"D!!HRD!!H!!@EGBD!!HRD!!IQ,IB!!<!!HRD!!HRLSAP,$HRD!!HRD D@PBFRD!!HRD%HAHH@@LNHRD!!HRHXC0\AHRD!!HRD%HA(T
+') ; colorMapFromArray:#[45 45 45 56 56 56 66 66 66 70 70 70 72 72 72 76 76 76 89 89 89 92 92 92 93 93 93 103 103 103 110 110 110 111 111 111 112 112 112 121 121 121 147 147 147 150 150 150 165 165 165 169 169 169 176 176 176 181 181 181 186 186 186 192 192 192 197 197 197 198 198 198 199 199 199 200 200 200 204 204 204 206 206 206 209 209 209 212 212 212 216 216 216 222 222 222 224 224 224 226 226 226 229 229 229 231 231 231 233 233 233 235 235 235]; mask:((ImageMask new) width:9; height:10; bits:(ByteArray fromPackedString:'8G? _?A?<G?8_71?O''<??0??A?<b') ; yourself); yourself]
+!
+
+bottomRightImage
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self bottomRightImage inspect
+ ImageEditor openOnClass:self andSelector:#bottomRightImage
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:'MacButtonBorder bottomRightImage'
+ ifAbsentPut:[(Depth8Image new) width:4; height:4; bits:(ByteArray fromPackedString:'@PDHBPDAA @HA T@A0P@@@@a') ; colorMapFromArray:#[184 184 184 255 255 255 226 226 226 224 224 224 181 181 181 162 162 162 211 211 211 158 158 158 248 248 248 159 159 159]; mask:((Depth1Image new) width:4; height:4; bits:(ByteArray fromPackedString:'<OC 0@@a') ; yourself); yourself]
+!
+
+bottomRightImage2
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self bottomRightImage2 inspect
+ ImageEditor openOnClass:self andSelector:#bottomRightImage2
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:'MacButtonBorder bottomRightImage2'
+ ifAbsentPut:[(Depth8Image new) width:9; height:10; bits:(ByteArray fromPackedString:'CP4MCP4 F@4TCP4MCP4!!EP\VCP4MCP4]DP,[CP4MCP4\A!!@!!CP4MCR@KB!!(#CP4MI@0ED2HMCP4Y@ PPG04MC L@BQH^CP4M@P OE2DMCP4MEA$^H04MCP4M
+') ; colorMapFromArray:#[45 45 45 56 56 56 68 68 68 70 70 70 72 72 72 76 76 76 78 78 78 89 89 89 92 92 92 93 93 93 103 103 103 112 112 112 115 115 115 122 122 122 148 148 148 150 150 150 165 165 165 175 175 175 176 176 176 181 181 181 186 186 186 196 196 196 198 198 198 199 199 199 200 200 200 204 204 204 206 206 206 212 212 212 214 214 214 220 220 220 224 224 224 226 226 226 228 228 228 229 229 229 231 231 231 235 235 235 237 237 237]; mask:((ImageMask new) width:9; height:10; bits:(ByteArray fromPackedString:'A?<G?0_?A?<O?1=?O''?<_?!!?<G<b') ; yourself); yourself]
+!
+
+topLeftImage
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self topLeftImage inspect
+ ImageEditor openOnClass:self andSelector:#topLeftImage
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:'MacButtonBorder topLeftImage'
+ ifAbsentPut:[(Depth8Image new) width:4; height:4; bits:(ByteArray fromPackedString:'@@@DA0@EA @A DABP A@P@a') ; colorMapFromArray:#[184 184 184 255 255 255 226 226 226 224 224 224 181 181 181 162 162 162 211 211 211 158 158 158 248 248 248 159 159 159]; mask:((Depth1Image new) width:4; height:4; bits:(ByteArray fromPackedString:'LGC0<@@a') ; yourself); yourself]
+!
+
+topLeftImage2
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self topLeftImage2 inspect
+ ImageEditor openOnClass:self andSelector:#topLeftImage2
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:'MacButtonBorder topLeftImage2'
+ ifAbsentPut:[(Depth8Image new) width:9; height:10; bits:(ByteArray fromPackedString:'GQ4]GQ4]GP<BGQ4]GQ4P@@(SGQ4]GPXCGA4]GQ4]B@\^GQ4]GQ4NAQX]GQ4]GQ(AD!!,]GQ4]GP4KFA4]GQ4]G@PQGQ4]GQ4]E0$UGQ4]GQ4]E@0YGQ4]GQ4]
+') ; colorMapFromArray:#[91 91 91 102 102 102 104 104 104 109 109 109 110 110 110 115 115 115 117 117 117 118 118 118 119 119 119 121 121 121 123 123 123 139 139 139 143 143 143 146 146 146 153 153 153 155 155 155 158 158 158 169 169 169 174 174 174 187 187 187 191 191 191 192 192 192 199 199 199 203 203 203 204 204 204 207 207 207 217 217 217 219 219 219 221 221 221 224 224 224 229 229 229]; mask:((ImageMask new) width:9; height:10; bits:(ByteArray fromPackedString:'@_<G?09?GG<8_7!!?\G? _>A?8G<b') ; yourself); yourself]
+!
+
+topRightImage
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self topRightImage inspect
+ ImageEditor openOnClass:self andSelector:#topRightImage
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:'MacButtonBorder topRightImage'
+ ifAbsentPut:[(Depth8Image new) width:4; height:4; bits:(ByteArray fromPackedString:'A0P@@@ FAP@A@PX@@PDHBP@a') ; colorMapFromArray:#[184 184 184 255 255 255 226 226 226 224 224 224 181 181 181 162 162 162 211 211 211 158 158 158 248 248 248 159 159 159]; mask:((Depth1Image new) width:4; height:4; bits:(ByteArray fromPackedString:'0NC0<@@a') ; yourself); yourself]
+!
+
+topRightImage2
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self topRightImage2 inspect
+ ImageEditor openOnClass:self andSelector:#topRightImage2
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:'MacButtonBorder topRightImage2'
+ ifAbsentPut:[(Depth8Image new) width:9; height:10; bits:(ByteArray fromPackedString:'B!!\@@@@@@@@@IPD[I @@@@@@@@@1B!!L@@@@@@@@@KPTI@@@@@@@@@@XI@@@@@@@@@@0QJBL@@@@@@@@HF"8@@@@@@@@@L08@@@@@@@@@IB$O@@@@@@@@GQ<%
+') ; colorMapFromArray:#[153 153 153 127 127 127 227 227 227 254 254 254 242 243 242 115 115 115 202 202 202 229 229 229 205 205 205 119 119 119 106 106 106 237 237 237 215 215 215 220 220 220 114 114 114 203 203 203 241 241 241 177 177 177 233 233 233 116 116 116 236 236 236 212 212 212 250 250 250 155 155 155 246 246 246 231 231 231 145 145 145 90 90 90 221 221 221 208 208 208 224 224 224 147 147 147 216 216 216 243 243 243 230 230 230 217 217 217 195 195 195 191 191 191 156 156 156 245 245 245 108 108 108 126 126 126 235 235 235 240 240 240 247 247 247 223 223 223 148 148 148 228 228 228 226 225 225 222 222 222 249 249 249 174 174 174]; mask:((ImageMask new) width:9; height:10; bits:(ByteArray fromPackedString:'0G?0_3!!?GG<N_0=?A7<C_0O?@?<b') ; yourself); yourself]
+! !
+
+!MacButtonBorder methodsFor:'displaying'!
+
+displayOn:aGC forDisplayBox:aRectangle
+ "display the borders represented by the receiver in the specified rectangle.
+ The gc is restored after the draw."
+
+ |left right top bottom savedPaint|
+
+ left := aRectangle left.
+ right := aRectangle right.
+ top := aRectangle top.
+ bottom := aRectangle bottom.
+
+ savedPaint := aGC paint.
+
+ TopLeftEdge displayOn:aGC x:left y:top.
+ aGC paint:(Color redByte:104 greenByte:104 blueByte:104).
+ aGC displayLineFromX:left+(TopLeftEdge width) y:top toX:right-(TopRightEdge width) y:top.
+ aGC paint:(Color redByte:186 greenByte:186 blueByte:186).
+ aGC displayLineFromX:left+(TopLeftEdge width) y:top+1 toX:right-(TopRightEdge width) y:top+1.
+
+ TopRightEdge displayOn:aGC x:(right-TopRightEdge width) y:top.
+ aGC paint:(Color redByte:208 greenByte:208 blueByte:208).
+ aGC displayLineFromX:right-3 y:(top+TopRightEdge height) toX:right-3 y:(bottom-BottomRightEdge height).
+ aGC paint:(Color redByte:147 greenByte:147 blueByte:147).
+ aGC displayLineFromX:right-2 y:(top+TopRightEdge height) toX:right-2 y:(bottom-BottomRightEdge height).
+ aGC paint:(Color redByte:191 greenByte:191 blueByte:191).
+ aGC displayLineFromX:right-1 y:(top+TopRightEdge height) toX:right-1 y:(bottom-BottomRightEdge height).
+
+ BottomLeftEdge displayOn:aGC x:left y:(bottom-BottomLeftEdge height).
+ aGC paint:(Color redByte:148 greenByte:148 blueByte:148).
+ aGC displayLineFromX:left+(BottomLeftEdge width) y:bottom-1-2 toX:right-(BottomRightEdge width) y:bottom-1-2.
+ aGC paint:(Color redByte:56 greenByte:56 blueByte:56).
+ aGC displayLineFromX:left+(BottomLeftEdge width) y:bottom-1-1 toX:right-(BottomRightEdge width) y:bottom-1-1.
+ aGC paint:(Color redByte:186 greenByte:186 blueByte:186).
+ aGC displayLineFromX:left+(BottomLeftEdge width) y:bottom-1 toX:right-(BottomRightEdge width) y:bottom-1.
+
+ BottomRightEdge displayOn:aGC x:(right-BottomRightEdge width) y:(bottom-BottomRightEdge height).
+ aGC paint:(Color redByte:186 greenByte:186 blueByte:186).
+ aGC displayLineFromX:left y:(top+TopLeftEdge height) toX:left y:(bottom-BottomLeftEdge height).
+ aGC paint:(Color redByte:121 greenByte:121 blueByte:121).
+ aGC displayLineFromX:left+1 y:(top+TopLeftEdge height) toX:left+1 y:(bottom-BottomLeftEdge height).
+
+ aGC paint:savedPaint.
+! !
+
+!MacButtonBorder methodsFor:'queries'!
+
+margin
+ ^ 4
+! !
+
+!MacButtonBorder class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/MacButtonBorder.st,v 1.1 2015-01-12 10:23:17 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/MacButtonBorder.st,v 1.1 2015-01-12 10:23:17 cg Exp $'
+! !
+
+
+MacButtonBorder initialize!
--- a/Make.spec Thu Feb 19 06:21:17 2015 +0000
+++ b/Make.spec Tue Mar 03 03:55:48 2015 +0000
@@ -78,6 +78,8 @@
ResourcePack \
WindowGroup \
WindowSensor \
+ DisplayTransform \
+ ScaleTransform \
WindowingTransformation \
stx_libview \
BeveledBorder \
@@ -154,6 +156,8 @@
$(OUTDIR_SLASH)ResourcePack.$(O) \
$(OUTDIR_SLASH)WindowGroup.$(O) \
$(OUTDIR_SLASH)WindowSensor.$(O) \
+ $(OUTDIR_SLASH)DisplayTransform.$(O) \
+ $(OUTDIR_SLASH)ScaleTransform.$(O) \
$(OUTDIR_SLASH)WindowingTransformation.$(O) \
$(OUTDIR_SLASH)stx_libview.$(O) \
$(OUTDIR_SLASH)BeveledBorder.$(O) \
--- a/ModalBox.st Thu Feb 19 06:21:17 2015 +0000
+++ b/ModalBox.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
StandardSystemView subclass:#ModalBox
instanceVariableNames:'shadowView exclusiveKeyboard escapeIsCancel'
classVariableNames:'UseTransientViews DefaultExtent'
@@ -433,9 +435,10 @@
shown ifTrue:[
delta := width - newExtent x.
newLeft := left + delta.
- (((newLeft @ top) extent:newExtent)
- containsPoint:self graphicsDevice pointerPosition)
- ifFalse:[newLeft := left].
+ (((newLeft @ top) extent:newExtent) containsPoint:self graphicsDevice pointerPosition
+ ) ifFalse:[
+ newLeft := left
+ ].
newLeft < 0 ifTrue:[newLeft := 0].
screenWidth := self graphicsDevice usableWidth.
newLeft + newExtent x > screenWidth ifTrue:[
@@ -904,11 +907,11 @@
!ModalBox class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.111 2014-02-18 14:59:11 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.112 2015-02-20 13:19:24 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.111 2014-02-18 14:59:11 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.112 2015-02-20 13:19:24 cg Exp $'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/OrientedFillStyle.st Tue Mar 03 03:55:48 2015 +0000
@@ -0,0 +1,40 @@
+"{ Package: 'stx:libview' }"
+
+FillStyle subclass:#OrientedFillStyle
+ instanceVariableNames:'form origin direction normal'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Compatibility-Squeak-Balloon-Fills'
+!
+
+!OrientedFillStyle class methodsFor:'documentation'!
+
+documentation
+"
+ an as-yet unused class.
+ For now, this is present as compatibility class (for Squeak),
+ but we may move change the fill/drawing code in the view hierarchy to use it later.
+
+ [author:]
+ cg
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+
+"
+! !
+
+
+!OrientedFillStyle class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/OrientedFillStyle.st,v 1.3 2014-12-19 21:31:33 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/OrientedFillStyle.st,v 1.3 2014-12-19 21:31:33 cg Exp $'
+! !
+
--- a/ResourcePack.st Thu Feb 19 06:21:17 2015 +0000
+++ b/ResourcePack.st Tue Mar 03 03:55:48 2015 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -11,6 +13,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
Dictionary subclass:#ResourcePack
instanceVariableNames:'packsClassName packsFileName fileReadFailed superPack projectPack'
classVariableNames:'Packs FailedToLoadPacks DebugModifications'
@@ -81,7 +85,7 @@
all those strings. (find the keys by looking at users of resource or senders
of 'string:*').
Notice, that the grammar of different languages may imply a reordering,
- so the above string becomes the german 'wollen Sie %1 wirklich löschen';
+ so the above string becomes the german 'wollen Sie %1 wirklich löschen';
so using percent-placeholders is much better than simple concatenations of
arguments to the question.
@@ -230,6 +234,7 @@
ResourcePack for:View
ResourcePack for:ErrorLogger
ResourcePack for:NewLauncher
+ ResourcePack for:SmallSense::SettingsAppl
Workspace classResources
"
@@ -664,6 +669,89 @@
]
"Modified: / 06-02-2014 / 15:33:03 / cg"
+!
+
+resourceFileEntryFor:keyString to:nationalString
+ "generate a line for a translation file, which defines a translation
+ from keyString to nationalString.
+ Naivly, this could be a simple line containing the two storeStrings
+ separated by a space. However, it is better to first cut of any leading
+ and trailing spaces and special characters, such as ':*.,' etc."
+
+ ^ (self resourceFileStringFor:keyString),' ',(self resourceFileStringFor:nationalString)
+!
+
+resourceFileStringFor:aString
+ "generate a key or value entry for a translation file, for aString.
+ Naivly, this could be a simple the storeString.
+ However, it is better to first cut of any leading
+ and trailing spaces and special characters, sch as ':*.,' etc."
+
+ ^ (self shortenedKeyFor:aString) storeString
+
+ "
+ self resourceFileStringFor:' foo: '
+ self resourceFileStringFor:' foo bar: '
+ "
+!
+
+shortenedKeyFor:aKey
+ "if
+ aKey is '(...)', then return '...'
+ if aKey is '[...]', then return '...'
+ if aKey is '{...}', then return '...'
+ if aKey starts or ends with any of '\:=.,?!! ', then return aKey without it
+
+ This means, that only a single translation is required to provide local translations for
+ things like
+ 'search'
+ 'search:'
+ 'search...'
+ "
+
+ |idx idx1 idx2 first last keySize|
+
+ first := aKey first.
+ last := aKey last.
+ keySize := aKey size.
+
+ ((first == $( and:[last == $) ])
+ or:[ (first == $[ and:[last == $] ])
+ or:[ (first == ${ and:[last == $} ]) ]]) ifTrue:[
+ ^ self shortenedKeyFor:(aKey copyFrom:2 to:keySize-1).
+ ].
+
+ idx1 := aKey findFirst:[:ch | ch isSeparator not].
+ idx2 := aKey findLast:[:ch | ch isSeparator not] ifNone:keySize.
+ (idx1 > 1 or:[idx2 < keySize]) ifTrue:[
+ ^ self shortenedKeyFor:(aKey copyFrom:idx1 to:idx2)
+ ].
+
+ idx1 := aKey findFirst:[:ch | ('*:=.?!!,-><\' includes:ch) not].
+ idx2 := aKey findLast:[:ch | ('*:=.?!!,-><\' includes:ch) not] ifNone:keySize.
+ (idx1 > 1 or:[idx2 < keySize]) ifTrue:[
+ ^ self shortenedKeyFor:(aKey copyFrom:idx1 to:idx2)
+ ].
+
+ "/ change duplicated &'s to single
+ (idx := aKey indexOf:$&) ~~ 0 ifTrue:[
+ (aKey at:idx+1 ifAbsent:nil) ~~ $& ifTrue:[
+ ^ self shortenedKeyFor:(aKey copyTo:idx-1),(aKey copyFrom:idx+1).
+ ].
+ ].
+ ^ aKey.
+
+ "
+ 'abcde' findFirst:[:ch | 'bcd' includes:ch]
+ 'abcde' indexOfAny:'bcd'
+
+ self shortenedKeyFor:'abc'
+ self shortenedKeyFor:' abc '
+ self shortenedKeyFor:'(abc)'
+ self shortenedKeyFor:'abc...'
+ self shortenedKeyFor:'(abc...)'
+ self shortenedKeyFor:'abc:*'
+ "
! !
!ResourcePack methodsFor:'accessing'!
@@ -803,7 +891,7 @@
val notNil ifTrue:[^ first asString,val,last asString].
].
- last = $. ifTrue:[
+ last == $. ifTrue:[
(aKey endsWith:' ...') ifTrue:[
usedKey := aKey copyButLast:4.
@@ -848,7 +936,7 @@
].
].
- (first = $( and:[last = $)]) ifTrue:[
+ (first == $( and:[last == $)]) ifTrue:[
usedKey := aKey copyFrom:2 to:(aKey size - 1).
val := self localAt:usedKey. "/ recursion
@@ -1478,11 +1566,11 @@
!ResourcePack class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.159 2014-12-06 13:10:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.162 2015-03-01 21:54:21 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.159 2014-12-06 13:10:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.162 2015-03-01 21:54:21 cg Exp $'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ScaleTransform.st Tue Mar 03 03:55:48 2015 +0000
@@ -0,0 +1,317 @@
+"{ Package: 'stx:libview' }"
+
+"{ NameSpace: Smalltalk }"
+
+DisplayTransform variableFloatSubclass:#ScaleTransform
+ instanceVariableNames:'scale'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Transformations'
+!
+
+!ScaleTransform class methodsFor:'documentation'!
+
+documentation
+"
+ instances of ScaleTransform can be used to scale other objects in 2D space.
+ This one is used, if only a scale is applied, but no translation.
+
+ All 2-D objects are supposed to be able to be transformed using instances of me.
+ Multiple instances of me can also be combined to form a single composite transformation.
+
+ [Instance variables:]
+ scale <Number> or <Point> representing a linear scaling factor.
+ nil is interpreted as 1@1
+
+ [author:]
+ Claus Gittinger
+"
+!
+
+examples
+"
+ example :
+ [exBegin]
+ |v|
+
+ v := View new extent:200@200; openAndWait.
+ v paint:Color green.
+ v fillRectangle:(10@10 corner:40@40).
+ v displayLineFrom:50@50 to:75@100.
+
+ v transformation:(ScaleTransform withScale:2).
+ v paint:Color red.
+ v fillRectangle:(10@10 corner:40@40).
+ v displayLineFrom:50@50 to:75@100.
+ [exEnd]
+
+"
+! !
+
+!ScaleTransform class methodsFor:'instance creation'!
+
+scale:scaleFactor
+ ^ self new scale:scaleFactor
+!
+
+withScale:scaleFactor
+ ^ self new scale:scaleFactor
+! !
+
+!ScaleTransform methodsFor:'accessing'!
+
+inverseTransformation
+ "Return the inverse transformation of the receiver"
+
+ ^ ScaleTransform withScale:(1 / scale)
+!
+
+scale
+ "return a copy of the Point that represents the
+ current scale of the receiver."
+
+ scale isNil ifTrue:[^ Point x:1 y:1 ].
+ ^ scale copy
+!
+
+scale:aScale
+ "Set the receiver's scale to aScale, a Point or Number."
+
+ aScale isNil ifTrue:[
+ scale := aScale
+ ] ifFalse:[
+ aScale = 1 ifTrue:[
+ scale := nil
+ ] ifFalse:[
+ scale := aScale asPoint.
+ (scale x = 1 and:[scale y = 1]) ifTrue:[
+ scale := nil
+ ].
+ ]
+ ].
+
+ "Modified: / 13.6.1998 / 14:04:51 / cg"
+!
+
+scaleOfOne
+ "Set the scale of the receiver to the identity scale"
+
+ scale := nil
+!
+
+scaleX
+ "return the current x-scale of the receiver."
+
+ scale isNil ifTrue:[^ 1].
+ ^ scale x
+
+ "Created: 21.5.1996 / 21:13:49 / cg"
+!
+
+scaleY
+ "return the current x-scale of the receiver."
+
+ scale isNil ifTrue:[^ 1].
+ ^ scale y
+
+ "Created: 21.5.1996 / 21:13:59 / cg"
+!
+
+translation
+ "return a copy of the receiver's translation."
+
+ ^ Point x:0 y:0
+!
+
+translationX
+ "return the x part of the receiver's translation."
+
+ ^ 0
+!
+
+translationY
+ "return the y part of the receiver's translation."
+
+ ^ 0
+! !
+
+!ScaleTransform methodsFor:'applying transform'!
+
+applyInverseScaleX:aNumber
+ "apply the scale only (if widths are to be transformed)"
+
+ scale isNil ifTrue:[^ aNumber].
+ ^ aNumber / scale x
+!
+
+applyInverseScaleY:aNumber
+ "apply the scale only (if heights are to be transformed)"
+
+ scale isNil ifTrue:[^ aNumber].
+ ^ aNumber / scale y
+!
+
+applyInverseTo:anObject
+ "Apply the inverse of the receiver to anObject
+ and return the result. This can be used to map back from logical
+ to physical coordinates, for example."
+
+ scale isNil ifTrue:[
+ ^ anObject
+ ].
+ ^ anObject scaledBy:self inverseScale
+!
+
+applyInverseToX:aNumber
+ "Apply the receiver to a number representing an x-coordinate
+ and return the result."
+
+ |s|
+
+ scale isNil ifTrue:[s := 1] ifFalse:[s := scale x].
+ ^ aNumber / s
+!
+
+applyInverseToY:aNumber
+ "Apply the receiver to a number representing an y-coordinate
+ and return the result."
+
+ |s|
+
+ scale isNil ifTrue:[s := 1] ifFalse:[s := scale y].
+ ^ aNumber / s
+!
+
+applyScaleX:aNumber
+ "apply the scale only (if widths are to be transformed)"
+
+ scale isNil ifTrue:[^ aNumber].
+ ^ aNumber * scale x
+!
+
+applyScaleY:aNumber
+ "apply the scale only (if heights are to be transformed)"
+
+ scale isNil ifTrue:[^ aNumber].
+ ^ aNumber * scale y
+!
+
+transformPoint:p
+ "Apply the receiver to a point, returning a new point."
+
+ scale isNil ifTrue:[
+ ^ p
+ ].
+ ^ p * scale
+! !
+
+!ScaleTransform methodsFor:'printing & storing'!
+
+printOn:aStream
+ "append a user printed representation of the receiver to aStream.
+ The format is suitable for a human - not meant to be read back."
+
+ aStream nextPutAll:self class name.
+ aStream nextPutAll:' scale: '.
+ scale printOn:aStream.
+! !
+
+!ScaleTransform methodsFor:'private'!
+
+checkScale:aScale
+ "Converts aScale to the internal format of a floating-point Point."
+
+ |checkedScale|
+
+ checkedScale := aScale asPoint.
+ ^ (checkedScale x asFloat) @ (checkedScale y asFloat)
+
+ "Modified: / 22-01-2015 / 14:21:11 / az"
+!
+
+inverseScale
+ "return with a Point representing the inverse of my
+ scale."
+
+ |newScale|
+
+ newScale := self checkScale:scale.
+ ^ (1.0 / newScale x) @ (1.0 / newScale y)
+! !
+
+!ScaleTransform methodsFor:'testing'!
+
+isNoScale
+ "return true if the identity scale is in effect (i.e. saleFactor is 1);
+ return false, otherwise."
+
+ scale isNil ifTrue:[^ true].
+ ^ scale x = 1 and:[scale y = 1]
+! !
+
+!ScaleTransform methodsFor:'transformations'!
+
+scaleBy:aScale
+ "scale the receiver.
+ This is a destructive operation, modifying the transformation
+ represented by the receiver"
+
+ |newScale|
+
+ aScale isNil ifTrue:[^ self].
+
+ scale isNil ifTrue:[
+ newScale := aScale asPoint
+ ] ifFalse:[
+ newScale := scale * aScale
+ ].
+ self scale:newScale.
+!
+
+scaledBy:aScale
+ "return a new WindowingTransformation with the scale and translation of
+ the receiver both scaled by aScale."
+
+ |checkedScale newScale|
+
+ aScale isNil ifTrue:[
+ newScale := scale.
+ ] ifFalse:[
+ checkedScale := self checkScale:aScale.
+ scale isNil ifTrue:[
+ newScale := checkedScale
+ ] ifFalse:[
+ newScale := scale * checkedScale
+ ].
+ ].
+ ^ (self class) withScale:newScale
+!
+
+translateBy:aTranslation
+ "translate the receiver.
+ This is a destructive operation, modifying the transformation
+ represented by the receiver"
+
+ self error:'not allowed'
+!
+
+translatedBy:aPoint
+ "return a new WindowingTransformation with the same scale and
+ rotations as the receiver and with a translation of the current
+ translation plus aPoint."
+
+ ^ WindowingTransformation
+ scale:scale
+ translation:aPoint
+! !
+
+!ScaleTransform class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/ScaleTransform.st,v 1.3 2015-01-22 14:23:48 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/ScaleTransform.st,v 1.3 2015-01-22 14:23:48 cg Exp $'
+! !
+
--- a/SimpleBorder.st Thu Feb 19 06:21:17 2015 +0000
+++ b/SimpleBorder.st Tue Mar 03 03:55:48 2015 +0000
@@ -12,6 +12,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
AbstractBorder subclass:#SimpleBorder
instanceVariableNames:'color'
classVariableNames:''
@@ -43,6 +45,19 @@
[author:]
Claus Gittinger
"
+!
+
+examples
+"
+ [exBegin]
+ |v1 v2 b|
+
+ v1 := View new extent:100@100.
+ v2 := View origin:10@10 corner:90@20 in:v2.
+ v2 border:(SimpleBorder new color:Color red).
+ v1 openAndWait.
+ [exEnd]
+"
! !
!SimpleBorder methodsFor:'accessing'!
@@ -109,5 +124,6 @@
!SimpleBorder class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/SimpleBorder.st,v 1.6 2009-10-29 15:59:43 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/SimpleBorder.st,v 1.7 2015-01-05 20:35:12 cg Exp $'
! !
+
--- a/SimpleView.st Thu Feb 19 06:21:17 2015 +0000
+++ b/SimpleView.st Tue Mar 03 03:55:48 2015 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -11,6 +13,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
DisplaySurface subclass:#SimpleView
instanceVariableNames:'superView subViews components styleSheet resources border unused
viewShape top left flagBits relativeOrigin relativeExtent
@@ -762,18 +766,7 @@
top open.
"
-!
-
-version
- ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.751.2.2 2015-01-29 09:54:04 stefan Exp $'
-!
-
-version_CVS
- ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.751.2.2 2015-01-29 09:54:04 stefan Exp $'
-!
-
-version_SVN
- ^ '$ Id $'
+
! !
!SimpleView class methodsFor:'initialization'!
@@ -847,14 +840,14 @@
newView := self basicNew.
aView notNil ifTrue:[
- newView initializeForDevice:(aView graphicsDevice).
+ newView initializeForDevice:(aView graphicsDevice).
"/ newView container:aView.
] ifFalse:[
- newView initializeForDevice:Screen current
+ newView initializeForDevice:Screen current
].
(newView device supportsNativeWidgetType:newView nativeWindowType) ifTrue:[
- newView beNativeWidget.
- device := Screen current
+ newView beNativeWidget.
+ device := Screen current
].
aView notNil ifTrue:[aView addSubView:newView].
^ newView
@@ -1075,17 +1068,17 @@
DefaultFont notNil ifTrue:[^ DefaultFont].
self == SimpleView ifTrue:[
- f := super defaultFont
+ f := super defaultFont
] ifFalse:[
- f := self superclass defaultFont.
+ 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
@@ -1099,10 +1092,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"
@@ -1122,6 +1115,11 @@
"set the view style for new views"
DefaultStyle := aStyle.
+
+ MIMETypeIconLibrary notNil ifTrue:[
+ MIMETypeIconLibrary flushIcons
+ ].
+
"/ no need to read the stylesheet always here
"/ done later if the system is not already up and running
"/ (which is the case, if there is already a styleSheet)
@@ -1285,33 +1283,33 @@
self changed:#style.
SimpleView updateStyleCache.
SimpleView allSubclassesDo:[:aClass |
- "JV@2010-12-02: Removed to avoid lost of preferred fonts on image restart"
- "/ cg: no, this is required!!!!!!
- "/ otherwise, we get ugly courier fonts on windows
- "/ updateStyleCache MUST clear any previously
- "/ cached font values, otherwise you cannot load a style's font.
- "/ if you want to keep your fonts, do it elsewhere (keep some userFontPrefs and restore from there)
-
- "/ JV: Font preferences ARE already saved in user's setting.rc/setting.stx, but they
- "/ are not reloaded on snapshot restart (which is correct, I think).
- "/ This just discard such fonts. I would say calling this upon snapshot restart
- "/ is a bad idea. Workaround it only for me is not a solution as all other
- "/ Linux users are ... off. Let's workaround it:
- (Smalltalk isInitialized not and:
- [OperatingSystem getOSType == #linux and:
- [UserPreferences current linuxFontWorkaround]])
- ifFalse:[
- aClass defaultFont:nil.
- ].
-
- (aClass class includesSelector:#updateStyleCache) ifTrue:[
- aClass updateStyleCache
- ].
+ "JV@2010-12-02: Removed to avoid lost of preferred fonts on image restart"
+ "/ cg: no, this is required!!!!!!
+ "/ otherwise, we get ugly courier fonts on windows
+ "/ updateStyleCache MUST clear any previously
+ "/ cached font values, otherwise you cannot load a style's font.
+ "/ if you want to keep your fonts, do it elsewhere (keep some userFontPrefs and restore from there)
+
+ "/ JV: Font preferences ARE already saved in user's setting.rc/setting.stx, but they
+ "/ are not reloaded on snapshot restart (which is correct, I think).
+ "/ This just discard such fonts. I would say calling this upon snapshot restart
+ "/ is a bad idea. Workaround it only for me is not a solution as all other
+ "/ Linux users are ... off. Let's workaround it:
+ (Smalltalk isInitialized not and:
+ [OperatingSystem getOSType == #linux and:
+ [UserPreferences current linuxFontWorkaround]])
+ ifFalse:[
+ aClass defaultFont:nil.
+ ].
+
+ (aClass class includesSelector:#updateStyleCache) ifTrue:[
+ aClass updateStyleCache
+ ].
].
"/ use #at: to avoid introducing a depency to libview2
(Smalltalk at:#MIMETypeIconLibrary) notNil ifTrue:[
- (Smalltalk at:#MIMETypeIconLibrary) flushIcons
+ (Smalltalk at:#MIMETypeIconLibrary) flushIcons
].
@@ -1333,8 +1331,8 @@
anyway."
<resource: #style (#viewSpacing #font #borderWidth #borderColor
- #viewBackground #shadowColor #lightColor
- #focusColor #focusBorderWidth)>
+ #viewBackground #shadowColor #lightColor
+ #focusColor #focusBorderWidth)>
|styleSheet bgGrey currentScreen|
@@ -1345,67 +1343,67 @@
and keep the values in fast class variables
"
styleSheet isNil ifTrue:[
- self setDefaultStyle.
- self readStyleSheet.
- styleSheet := StyleSheet.
+ self setDefaultStyle.
+ self readStyleSheet.
+ styleSheet := StyleSheet.
].
currentScreen := Screen current ? Screen default.
Grey := styleSheet viewGrey.
Grey isNil ifTrue:[
- Grey := Color gray
+ Grey := Color gray
].
Grey := Grey onDevice:currentScreen.
styleSheet fileReadFailed ifTrue:[
- bgGrey := Color white
+ bgGrey := Color white
] ifFalse:[
- currentScreen hasGrayscales ifTrue:[
- bgGrey := Grey
- ] ifFalse:[
- bgGrey := Color white.
- ]
+ currentScreen hasGrayscales ifTrue:[
+ bgGrey := Grey
+ ] ifFalse:[
+ bgGrey := Color white.
+ ]
].
bgGrey := bgGrey onDevice:currentScreen.
ViewSpacing := styleSheet at:#viewSpacing.
ViewSpacing isNil ifTrue:[
- ViewSpacing := currentScreen defaultStyleValueFor:#viewSpacing.
+ ViewSpacing := currentScreen defaultStyleValueFor:#viewSpacing.
].
DefaultBorderColor := styleSheet colorAt:#borderColor.
DefaultBorderColor isNil ifTrue:[
- DefaultBorderColor := currentScreen defaultStyleValueFor:#borderColor
+ DefaultBorderColor := currentScreen defaultStyleValueFor:#borderColor
].
styleSheet fileReadFailed ifTrue:[
- DefaultBorderWidth := 1.
- DefaultFocusColor := DefaultShadowColor := Color black.
- DefaultViewBackgroundColor := DefaultLightColor := Color white.
- DefaultFocusBorderWidth := 1.
+ DefaultBorderWidth := 1.
+ DefaultFocusColor := DefaultShadowColor := Color black.
+ DefaultViewBackgroundColor := DefaultLightColor := Color white.
+ DefaultFocusBorderWidth := 1.
] ifFalse:[
- DefaultBorderWidth := styleSheet at:#borderWidth default:0.
- DefaultViewBackgroundColor := styleSheet colorAt:#viewBackground default:bgGrey.
- DefaultShadowColor := styleSheet colorAt:#shadowColor.
- DefaultLightColor := styleSheet colorAt:#lightColor.
- DefaultFocusColor := styleSheet colorAt:#focusColor default:Color red.
- DefaultFocusBorderWidth := styleSheet at:'focusBorderWidth' default:2.
+ DefaultBorderWidth := styleSheet at:#borderWidth default:0.
+ DefaultViewBackgroundColor := styleSheet colorAt:#viewBackground default:bgGrey.
+ DefaultShadowColor := styleSheet colorAt:#shadowColor.
+ DefaultLightColor := styleSheet colorAt:#lightColor.
+ DefaultFocusColor := styleSheet colorAt:#focusColor default:Color red.
+ DefaultFocusBorderWidth := styleSheet at:'focusBorderWidth' default:2.
].
self == SimpleView ifTrue:[
- DefaultFont := styleSheet at:#font.
- DefaultFont isNil ifTrue:[
- DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12.
- ].
- DefaultFont := DefaultFont onDevice:currentScreen.
+ DefaultFont := styleSheet at:#font.
+ DefaultFont isNil ifTrue:[
+ DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12.
+ ].
+ DefaultFont := DefaultFont onDevice:currentScreen.
] ifFalse:[
- DefaultFont := nil
+ DefaultFont := nil
].
DefaultViewBackgroundColor isNil ifTrue:[
- 'SimpleView [warning]: bad viewBackground in style - using white' errorPrintCR.
- DefaultViewBackgroundColor := Color white
+ 'SimpleView [warning]: bad viewBackground in style - using white' errorPrintCR.
+ DefaultViewBackgroundColor := Color white
].
"Modified: / 29-04-1997 / 11:16:52 / dq"
@@ -1551,7 +1549,7 @@
"/ what a kludge - Dolphin and Squeak mean: printOn:;
"/ ST/X (and some old ST80's) mean: draw-yourself on.
(aGCOrStream isStream) ifTrue:[
- ^ super displayOn:aGCOrStream
+ ^ super displayOn:aGCOrStream
].
self redraw
@@ -1661,25 +1659,25 @@
isApplicationModel := true.
(builder := aBuilder) isNil ifTrue:[
- "/ problem: anApplication could have no builder
- "/ or anApplication could be a non-appModel (theoretically - only providing a spec)
- builder := anApplication perform:#builder ifNotUnderstood:[isApplicationModel := false. nil].
- builder isNil ifTrue:[
- isApplicationModel ifTrue:[
- anApplication createBuilder.
- builder := anApplication builder
- ] ifFalse:[
- builder := UIBuilder new.
- ]
- ]
+ "/ problem: anApplication could have no builder
+ "/ or anApplication could be a non-appModel (theoretically - only providing a spec)
+ builder := anApplication perform:#builder ifNotUnderstood:[isApplicationModel := false. nil].
+ builder isNil ifTrue:[
+ isApplicationModel ifTrue:[
+ anApplication createBuilder.
+ builder := anApplication builder
+ ] ifFalse:[
+ builder := UIBuilder new.
+ ]
+ ]
].
(subSpec := aWindowSpecOrSpecSymbol) isSymbol ifTrue:[
- anApplication isNil ifTrue:[^ self].
- subSpec := anApplication interfaceSpecFor:aWindowSpecOrSpecSymbol.
- subSpec isNil ifTrue:[
- ^ self
- ].
+ anApplication isNil ifTrue:[^ self].
+ subSpec := anApplication interfaceSpecFor:aWindowSpecOrSpecSymbol.
+ subSpec isNil ifTrue:[
+ ^ self
+ ].
].
"/ if the appl is not the master, but the masters builder is used,
@@ -1687,35 +1685,35 @@
masterApp := anApplication perform:#masterApplication ifNotUnderstood:[isApplicationModel := false. nil].
masterApp isNil ifTrue:[
- isApplicationModel := false.
+ isApplicationModel := false.
].
thisApp := builder application.
(isApplicationModel and:[anApplication ~~ thisApp]) ifTrue:[
- masterApp ~~ thisApp ifTrue:[
- self error:'should not happen' mayProceed:true.
- masterApp isNil ifTrue:[
- anApplication masterApplication:thisApp.
- ].
- ].
-
- builder application:anApplication.
- savedView := builder window.
- builder window:self.
- [
- anApplication buildSubCanvas:subSpec withMenu:withMenuBoolean withBuilder:builder.
- ] ensure:[
- builder window:savedView.
- builder application:thisApp.
- ].
+ masterApp ~~ thisApp ifTrue:[
+ self error:'should not happen' mayProceed:true.
+ masterApp isNil ifTrue:[
+ anApplication masterApplication:thisApp.
+ ].
+ ].
+
+ builder application:anApplication.
+ savedView := builder window.
+ builder window:self.
+ [
+ anApplication buildSubCanvas:subSpec withMenu:withMenuBoolean withBuilder:builder.
+ ] ensure:[
+ builder window:savedView.
+ builder application:thisApp.
+ ].
] ifFalse:[
- thisIsANewBuild := builder window isNil.
- thisIsANewBuild ifTrue:[
- builder window:self.
- anApplication buildSubCanvas:subSpec withMenu:withMenuBoolean withBuilder:builder.
- ] ifFalse:[
- "/ WARNING: in case of rebuilding, we do NOT invoke pre- and postBuilds
- builder buildFromSpec:subSpec in:self.
- ]
+ thisIsANewBuild := builder window isNil.
+ thisIsANewBuild ifTrue:[
+ builder window:self.
+ anApplication buildSubCanvas:subSpec withMenu:withMenuBoolean withBuilder:builder.
+ ] ifFalse:[
+ "/ WARNING: in case of rebuilding, we do NOT invoke pre- and postBuilds
+ builder buildFromSpec:subSpec in:self.
+ ]
].
"/ postBuildWith: will be called twice if code below is enabled
@@ -1898,8 +1896,18 @@
border:aBorder
"set my border"
+ |prevMargin m|
+
+ prevMargin := margin.
border := aBorder.
self computeMargin.
+ realized ifTrue:[
+ m := prevMargin max:margin.
+ self invalidate:(0@0 corner:width@m). "/ top margin
+ self invalidate:((width-m)@m corner:width@height). "/ right margin
+ self invalidate:(0@(height-m) corner:width@height). "/ bottom margin
+ self invalidate:(0@m corner:m@(height-m)). "/ left margin
+ ].
!
borderColor
@@ -1994,25 +2002,25 @@
aNumber := aNumberOrNil.
aNumber notNil ifTrue:[
- self assert:(aNumber >= 0).
- aNumber := aNumber max: 0
+ self assert:(aNumber >= 0).
+ aNumber := aNumber max: 0
].
"/ backward compatibility
"/ superView will be renamed to container soon.
(superView notNil and:[superView isBorderedWrapper]) ifTrue:[
- ^ superView borderWidth:aNumber
+ ^ superView borderWidth:aNumber
].
(aNumber == 0 or:[aNumber isNil]) ifTrue:[
- border isNil ifTrue:[^ self].
- self border:nil.
+ border isNil ifTrue:[^ self].
+ self border:nil.
] ifFalse:[
- border notNil ifTrue:[
- self border:(border copy width:aNumber)
- ] ifFalse:[
- self border:(SimpleBorder new width:aNumber color:(self borderColor)).
- ]
+ border notNil ifTrue:[
+ self border:(border copy width:aNumber)
+ ] ifFalse:[
+ self border:(SimpleBorder new width:aNumber color:(self borderColor)).
+ ]
].
"/ (aNumber ~~ borderWidth) ifTrue:[
@@ -2205,10 +2213,10 @@
in myself and recursively in all of my subviews"
(condition value:self) ifTrue:[
- viewBackground ~~ something ifTrue:[
- self viewBackground:something.
- self invalidate
- ].
+ viewBackground ~~ something ifTrue:[
+ self viewBackground:something.
+ self invalidate
+ ].
].
!
@@ -2853,8 +2861,8 @@
"set the layout object which controls my geometry."
layout = aLayoutObject ifFalse:[
- layout := aLayoutObject.
- self layoutChanged.
+ layout := aLayoutObject.
+ self layoutChanged.
].
"Modified: 19.9.1995 / 16:17:25 / claus"
@@ -2926,20 +2934,22 @@
"make sure, that the view is fully visible by shifting it
into the visible screen area if nescessary."
- |originVisible cornerVisible newTop newLeft deviceBounds
+ |myDevice originVisible cornerVisible newTop newLeft deviceBounds
deviceLeft deviceRight deviceTop deviceBottom origin corner
referencePoint|
+ myDevice := self graphicsDevice.
+
newTop := top.
newLeft := left.
origin := left@top.
corner := (left + width)@(top + height).
- originVisible := self graphicsDevice pointIsVisible:origin.
- cornerVisible := self graphicsDevice pointIsVisible:corner.
-
- (self graphicsDevice pointsAreOnSameMonitor:origin and:corner) ifTrue:[
+ originVisible := myDevice pointIsVisible:origin.
+ cornerVisible := myDevice pointIsVisible:corner.
+
+ (myDevice pointsAreOnSameMonitor:origin and:corner) ifTrue:[
referencePoint := origin.
] ifFalse:[
originVisible ifTrue:[
@@ -2954,15 +2964,15 @@
].
].
].
- deviceBounds := self graphicsDevice monitorBoundsAt:referencePoint.
+ deviceBounds := myDevice monitorBoundsAt:referencePoint.
deviceLeft := deviceBounds left.
deviceRight := deviceBounds right.
deviceTop := deviceBounds top.
deviceBottom := deviceBounds bottom.
- originVisible ifTrue:[ deviceBottom := deviceBottom min:(self graphicsDevice usableHeightAt:origin) ].
- cornerVisible ifTrue:[ deviceBottom := deviceBottom min:(self graphicsDevice usableHeightAt:corner) ].
+ originVisible ifTrue:[ deviceBottom := deviceBottom min:(myDevice usableHeightAt:origin) ].
+ cornerVisible ifTrue:[ deviceBottom := deviceBottom min:(myDevice usableHeightAt:corner) ].
corner y > deviceBottom ifTrue:[
cornerVisible := false.
@@ -3311,7 +3321,7 @@
"MB:added {" "needed if layout is used e.g. POUEditor"
layout notNil ifTrue:[
- ^(layout rightFraction) @ (layout bottomFraction)
+ ^(layout rightFraction) @ (layout bottomFraction)
].
"MB:added }"
@@ -3324,9 +3334,9 @@
aPoint notNil ifTrue:[relativeExtent := nil].
relativeCorner := aPoint.
"MB:added {" "needed if layout is used e.g. POUEditor"
- layout notNil ifTrue:[
- layout rightFraction: aPoint x.
- layout bottomFraction: aPoint y.
+ layout notNil ifTrue:[
+ layout rightFraction: aPoint x.
+ layout bottomFraction: aPoint y.
].
"MB:added }"
!
@@ -3351,7 +3361,7 @@
"MB:added {" "needed if layout is used e.g. POUEditor"
layout notNil ifTrue:[
- ^(layout leftFraction) @ (layout topFraction)
+ ^(layout leftFraction) @ (layout topFraction)
].
"MB:added }"
^relativeOrigin
@@ -3363,8 +3373,8 @@
relativeOrigin := aPoint.
"MB:added {" "needed if layout is used e.g. POUEditor"
layout notNil ifTrue:[
- layout leftFraction: aPoint x.
- layout topFraction: aPoint y.
+ layout leftFraction: aPoint x.
+ layout topFraction: aPoint y.
].
"MB:added }"
!
@@ -3802,10 +3812,10 @@
n := 1.
v := self.
[v notNil] whileTrue:[
- (next := v container) isNil ifTrue:[^ v].
- v := next.
- n := n + 1.
- n > 1000 ifTrue:[self error:'circular superView chain'].
+ (next := v container) isNil ifTrue:[^ v].
+ v := next.
+ n := n + 1.
+ n > 1000 ifTrue:[self error:'circular superView chain'].
].
^ nil
@@ -3917,53 +3927,59 @@
currentClippingBounds := gc clippingBoundsOrNil.
(currentClippingBounds = aRectangleOrNil) ifTrue:[
- ^ self
+ ^ 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
- ].
- (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.
+ |currentTransformation pO pC|
+
+ x := aRectangleOrNil left.
+ y := aRectangleOrNil top.
+ w := aRectangleOrNil width.
+ h := aRectangleOrNil height.
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
+ pO := currentTransformation transformPoint:x@y.
+ pC := currentTransformation transformPoint:(x+w-1)@(y+h-1).
+ x := pO x.
+ y := pO y.
+ w := pC x - x + 1.
+ h := pC y - y + 1.
+"/ 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.
+ newBounds := Rectangle left:x top:y width:w height:h.
].
gc deviceClippingBounds:newBounds
@@ -4202,14 +4218,14 @@
currentTransformation := gc transformation.
currentTransformation isNil ifTrue:[
- (aPoint x ~~ 0 or:[aPoint y ~~ 0]) ifTrue:[
- gc transformation:(WindowingTransformation scale:1 translation:aPoint negated).
- ].
+ (aPoint x ~~ 0 or:[aPoint y ~~ 0]) ifTrue:[
+ gc transformation:(WindowingTransformation scale:1 translation:aPoint negated).
+ ].
] ifFalse:[
- currentTransformation translation:aPoint negated.
+ currentTransformation translation:aPoint negated.
].
self clippingBoundsOrNil notNil ifTrue:[
- self setInnerClip.
+ self setInnerClip.
].
!
@@ -4775,7 +4791,8 @@
aspect == #sizeOfView ifTrue:[
"one of the views we depend on changed its size"
- ^ self containerChangedSize.
+ "/ cg: #containerChangedSize has already been sent by the caller
+ ^ self "containerChangedSize".
].
super update:aspect with:aParameter from:changedObject
@@ -4796,50 +4813,50 @@
ok := true.
bitmaps := #('wheel1' 'wheel2' 'wheel3' 'wheel4')
- collect:[:name |
- |f|
-
- f := Smalltalk imageFromFileNamed:(name , '.xbm') forClass:self class.
- f isNil ifTrue:[
- ('SimpleView [warning]: no bitmap file: ' , name , '.xbm') errorPrintCR.
- ok := false
- ].
- f
- ].
+ collect:[:name |
+ |f|
+
+ f := Smalltalk imageFromFileNamed:(name , '.xbm') forClass:self class.
+ f isNil ifTrue:[
+ ('SimpleView [warning]: no bitmap file: ' , name , '.xbm') errorPrintCR.
+ ok := false
+ ].
+ f
+ ].
ok ifTrue:[
- maskForm := Smalltalk imageFromFileNamed:'wheelm.xbm' forClass:self class.
- maskForm isNil ifTrue:[
- ('SimpleView [warning]: no bitmap file: wheelm.xbm') errorPrintCR.
- ok := false
- ].
+ maskForm := Smalltalk imageFromFileNamed:'wheelm.xbm' forClass:self class.
+ maskForm isNil ifTrue:[
+ ('SimpleView [warning]: no bitmap file: wheelm.xbm') errorPrintCR.
+ ok := false
+ ].
].
ok ifFalse:[
- self cursor:Cursor wait.
- aBlock ensure:[
- self cursor:oldCursor
- ]
+ self cursor:Cursor wait.
+ aBlock ensure:[
+ self cursor:oldCursor
+ ]
] ifTrue:[
- cursors := bitmaps collect:[:form | (Cursor sourceForm:form
- maskForm:maskForm
- hotX:8
- hotY:8) onDevice:self graphicsDevice].
-
- process := [
- Delay waitForSeconds:0.25.
- [
- cursors do:[:curs |
- self cursor:curs.
- Delay waitForSeconds:0.05.
- ]
- ] loop.
- ] forkAt:(Processor activeProcess priority + 1).
-
- aBlock ensure:[
- process terminate.
- self cursor:oldCursor
- ]
+ cursors := bitmaps collect:[:form | (Cursor sourceForm:form
+ maskForm:maskForm
+ hotX:8
+ hotY:8) onDevice:self graphicsDevice].
+
+ process := [
+ Delay waitForSeconds:0.25.
+ [
+ cursors do:[:curs |
+ self cursor:curs.
+ Delay waitForSeconds:0.05.
+ ]
+ ] loop.
+ ] forkAt:(Processor activeProcess priority + 1).
+
+ aBlock ensure:[
+ process terminate.
+ self cursor:oldCursor
+ ]
].
"
@@ -5357,11 +5374,11 @@
"redraw my edges (if any)"
(level ~~ 0) ifTrue:[
- shown ifTrue:[
- gc clippingBounds:nil.
- self drawEdges.
- gc deviceClippingBounds:innerClipRect
- ]
+ shown ifTrue:[
+ gc clippingBounds:nil.
+ self drawEdges.
+ gc deviceClippingBounds:innerClipRect
+ ]
]
"Modified: / 25.5.1999 / 14:50:25 / cg"
@@ -5374,13 +5391,13 @@
If there is none, return the value from exceptionValue"
subViews notNil ifTrue:[
- subViews do:[:aSubview |
- |v|
-
- (aBlock value:aSubview) ifTrue:[ ^ aSubview ].
- v := aSubview allSubViewsDetect:aBlock ifNone:nil.
- v notNil ifTrue:[^ v].
- ]
+ subViews do:[:aSubview |
+ |v|
+
+ (aBlock value:aSubview) ifTrue:[ ^ aSubview ].
+ v := aSubview allSubViewsDetect:aBlock ifNone:nil.
+ v notNil ifTrue:[^ v].
+ ]
].
^ exceptionValue value.
@@ -5407,8 +5424,8 @@
v := self container.
[v notNil] whileTrue:[
- (aBlock value:v) ifTrue:[^ v].
- v := v container.
+ (aBlock value:v) ifTrue:[^ v].
+ v := v container.
].
^ exceptionValue value
!
@@ -5420,8 +5437,8 @@
v := self container.
[v notNil] whileTrue:[
- aBlock value:v.
- v := v container.
+ aBlock value:v.
+ v := v container.
].
!
@@ -5949,10 +5966,10 @@
"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 old oldPaint|
+ |leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh dx dy dh dw old oldPaint|
shown ifFalse:[
- ^ self
+ ^ self
].
nw := w.
@@ -5966,110 +5983,122 @@
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
- ].
-
- (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:[
+ |pO pC|
+
+ "
+ need device coordinates for this test
+ "
+ pO := currentTransformation transformPoint:x@y.
+ pC := currentTransformation transformPoint:(x+w-1)@(y+h-1).
+ nx := pO x.
+ ny := pO y.
+ nw := pC x - nx + 1.
+ nh := pC y - ny + 1.
+"/ 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.
+ ].
].
(nw > 0 and:[nh > 0]) ifTrue:[
- "
- redraw inside area
- "
- self
- clippingBounds:(Rectangle left:nx top:ny width:nw height:nh);
- 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 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.
+ 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.
@@ -6092,7 +6121,7 @@
"notification from the windowGroup that I got the keyboardFocus."
delegate notNil ifTrue:[
- delegate perform:#hasKeyboardFocus: with:aBoolean ifNotUnderstood:nil
+ delegate perform:#hasKeyboardFocus: with:aBoolean ifNotUnderstood:nil
].
^ self
!
@@ -6220,6 +6249,12 @@
shownBefore ~~ true ifTrue:[
self changed:#visibility.
].
+ self takeFocusWhenMapped ifTrue:[
+ "/ this is a one-shot!!
+ self takeFocusWhenMapped:false.
+ self assignKeyboardFocusToFirstKeyboardConsumer.
+ "/ self requestFocus
+ ].
]
"Modified: / 09-12-2010 / 18:12:24 / cg"
@@ -6239,34 +6274,34 @@
sensor := self sensor.
UserPreferences current allowMouseWheelZoom ifTrue:[
- zoomInOrOut := sensor ctrlDown or:[sensor metaDown].
- zoomInOrOut ifTrue:[
- self mouseWheelZoom:amount.
- ^ self.
- ].
+ zoomInOrOut := sensor ctrlDown or:[sensor metaDown].
+ 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"
@@ -6369,49 +6404,49 @@
|subViews|
(subViews := self subViews) notEmptyOrNil ifTrue:[
- (how isNil "false"
- or:[how == #smaller]) ifTrue:[
- subViews do:[:view |
- view notNil ifTrue:[
- view containerChangedSize
- ]
- ]
- ] ifFalse:[
- "doing it reverse speeds up resizing - usually subviews
- are created from top-left to bottom-right; therefore
- bottom-right views will be moved/resized first, then top-left ones;
- this avoids multiple redraws of subviews"
-
- subViews reverseDo:[:view |
- view notNil ifTrue:[
- view containerChangedSize
- ]
- ]
- ]
+ (how isNil "false"
+ or:[how == #smaller]) ifTrue:[
+ subViews do:[:view |
+ view notNil ifTrue:[
+ view containerChangedSize
+ ]
+ ]
+ ] ifFalse:[
+ "doing it reverse speeds up resizing - usually subviews
+ are created from top-left to bottom-right; therefore
+ bottom-right views will be moved/resized first, then top-left ones;
+ this avoids multiple redraws of subviews"
+
+ subViews reverseDo:[:view |
+ view notNil ifTrue:[
+ view containerChangedSize
+ ]
+ ]
+ ]
].
components notNil ifTrue:[
- (how isNil "false"
- or:[how == #smaller]) ifTrue:[
- components do:[:view |
- view containerChangedSize
- ]
- ] ifFalse:[
- "doing it reverse speeds up resizing - usually subviews
- are created from top-left to bottom-right; therefore
- bottom-right views will be moved/resized first, then top-left ones;
- this avoids multiple redraws of subviews"
-
- components reverseDo:[:view |
- view containerChangedSize
- ]
- ]
+ (how isNil "false"
+ or:[how == #smaller]) ifTrue:[
+ components do:[:view |
+ view containerChangedSize
+ ]
+ ] ifFalse:[
+ "doing it reverse speeds up resizing - usually subviews
+ are created from top-left to bottom-right; therefore
+ bottom-right views will be moved/resized first, then top-left ones;
+ this avoids multiple redraws of subviews"
+
+ components reverseDo:[:view |
+ view containerChangedSize
+ ]
+ ]
].
self changed:#sizeOfView with:how.
superView notNil ifTrue:[
- superView subViewChangedSize
+ superView subViewChangedSize
]
"Modified: / 2.4.1998 / 13:59:59 / cg"
@@ -6708,6 +6743,62 @@
!SimpleView methodsFor:'focus handling'!
+assignKeyboardFocusTo:aConsumer
+ |wg|
+
+ wg := self windowGroup.
+ wg notNil ifTrue:[
+ self graphicsDevice isWindowsPlatform ifTrue:[
+ wg focusView:aConsumer byTab:true.
+ ] ifFalse:[
+ aConsumer requestFocus.
+ "/ consumer requestFocus. - could be denied; but we force it here
+ wg focusView:aConsumer byTab:false.
+ ].
+ ].
+!
+
+assignKeyboardFocusToFirstInputField
+ "assign the keyboard focus to the first first keyboardConsumer.
+ (in older versions, this used to favour inputfields over editFields;
+ see (or redefine) preferFirstInputFieldWhenAssigningInitialFocus)"
+
+ self obsoleteMethodWarning.
+ self assignKeyboardFocusToFirstKeyboardConsumer
+!
+
+assignKeyboardFocusToFirstKeyboardConsumer
+ "assign the keyboard focus to the first first keyboardConsumer.
+ (in older versions, this used to favour inputfields over editFields;
+ see (or redefine) preferFirstInputFieldWhenAssigningInitialFocus)"
+
+ |firstInputField firstConsumer firstCursorConsumer consumer|
+
+ self withAllSubViewsDo:[:v |
+ v shown ifTrue:[
+ (firstInputField isNil and:[v isInputField]) ifTrue:[
+ firstInputField := v
+ ].
+ (firstConsumer isNil and:[v isKeyboardConsumer]) ifTrue:[
+ firstConsumer := v
+ ].
+ (firstCursorConsumer isNil and:[v isCursorKeyConsumer]) ifTrue:[
+ firstCursorConsumer := v
+ ].
+ ].
+ ].
+ (firstInputField notNil and:[self preferFirstInputFieldWhenAssigningInitialFocus]) ifTrue:[
+ consumer := firstInputField.
+ ].
+ consumer := (consumer ? firstConsumer ? firstCursorConsumer).
+ "/ Transcript showCR:consumer.
+ consumer notNil ifTrue:[
+ self assignKeyboardFocusTo:consumer
+ ].
+
+ "Modified: / 29-08-2006 / 14:32:30 / cg"
+!
+
canTab
"returns true if the widget is tabable"
@@ -6923,34 +7014,34 @@
|delta clrId bd graphicsDevice|
explicit ifTrue:[
- (self drawableId notNil
- and:[superView notNil
- and:[styleSheet notNil]]) ifTrue:[
- (styleSheet at:#'focus.showBorder' default:true) ifTrue:[
- graphicsDevice := self graphicsDevice.
-
- (graphicsDevice supportsWindowBorder:(bd := DefaultFocusBorderWidth)) ifFalse:[
- (graphicsDevice supportsWindowBorder:(bd := 1)) ifFalse:[
- bd := 0.
- ]
- ].
- delta := bd - self borderWidth.
- delta ~~ 0 ifTrue:[
- (left == 0 or:[top == 0]) ifTrue:[
- graphicsDevice resizeWindow:self drawableId width:width-delta-delta height:height-delta-delta.
- ] ifFalse:[
- graphicsDevice moveWindow:self drawableId x:left-delta y:top-delta.
- ].
- graphicsDevice setWindowBorderWidth:bd in:self drawableId.
- ].
-
- clrId := (DefaultFocusColor onDevice:graphicsDevice) colorId.
- clrId isNil ifTrue:[
- clrId := graphicsDevice blackpixel
- ].
- graphicsDevice setWindowBorderColor:clrId in:self drawableId.
- ]
- ]
+ (self drawableId notNil
+ and:[superView notNil
+ and:[styleSheet notNil]]) ifTrue:[
+ (styleSheet at:#'focus.showBorder' default:true) ifTrue:[
+ graphicsDevice := self graphicsDevice.
+
+ (graphicsDevice supportsWindowBorder:(bd := DefaultFocusBorderWidth)) ifFalse:[
+ (graphicsDevice supportsWindowBorder:(bd := 1)) ifFalse:[
+ bd := 0.
+ ]
+ ].
+ delta := bd - self borderWidth.
+ delta ~~ 0 ifTrue:[
+ (left == 0 or:[top == 0]) ifTrue:[
+ graphicsDevice resizeWindow:self drawableId width:width-delta-delta height:height-delta-delta.
+ ] ifFalse:[
+ graphicsDevice moveWindow:self drawableId x:left-delta y:top-delta.
+ ].
+ graphicsDevice setWindowBorderWidth:bd in:self drawableId.
+ ].
+
+ clrId := (DefaultFocusColor onDevice:graphicsDevice) colorId.
+ clrId isNil ifTrue:[
+ clrId := graphicsDevice blackpixel
+ ].
+ graphicsDevice setWindowBorderColor:clrId in:self drawableId.
+ ]
+ ]
] ifFalse:[
"/ superView notNil ifTrue:[
"/ superView showFocus:explicit
@@ -6969,24 +7060,24 @@
|delta bd graphicsDevice|
explicit ifTrue:[
- (self drawableId notNil and:[superView notNil]) ifTrue:[
- (styleSheet at:#'focus.showBorder' default:true) ifTrue:[
- graphicsDevice := self graphicsDevice.
-
- (graphicsDevice supportsWindowBorder:(bd := self borderWidth)) ifFalse:[
- (graphicsDevice supportsWindowBorder:(bd := 1)) ifFalse:[
- bd := 0.
- ]
- ].
- delta := DefaultFocusBorderWidth - bd.
- delta ~~ 0 ifTrue:[
- graphicsDevice setWindowBorderWidth:bd in:self drawableId.
- graphicsDevice moveWindow:self drawableId x:left y:top.
- graphicsDevice resizeWindow:self drawableId width:width height:height.
- ].
- self setBorderColor.
- ]
- ]
+ (self drawableId notNil and:[superView notNil]) ifTrue:[
+ (styleSheet at:#'focus.showBorder' default:true) ifTrue:[
+ graphicsDevice := self graphicsDevice.
+
+ (graphicsDevice supportsWindowBorder:(bd := self borderWidth)) ifFalse:[
+ (graphicsDevice supportsWindowBorder:(bd := 1)) ifFalse:[
+ bd := 0.
+ ]
+ ].
+ delta := DefaultFocusBorderWidth - bd.
+ delta ~~ 0 ifTrue:[
+ graphicsDevice setWindowBorderWidth:bd in:self drawableId.
+ graphicsDevice moveWindow:self drawableId x:left y:top.
+ graphicsDevice resizeWindow:self drawableId width:width height:height.
+ ].
+ self setBorderColor.
+ ]
+ ]
]
"Modified: / 17.9.1998 / 15:08:02 / cg"
@@ -7377,15 +7468,15 @@
"/ self originChangedFlag:false extentChangedFlag:false cornerChangedFlag:false.
name isNil ifTrue:[
- name := self class name.
+ name := self class name.
].
bitGravity := #NorthWest. "/ nil.
viewGravity := nil.
controllerClass := self defaultControllerClass.
controllerClass notNil ifTrue:[
- controller := controllerClass new.
- controller view:self.
+ controller := controllerClass new.
+ controller view:self.
].
self initializeMiddleButtonMenu.
@@ -7405,7 +7496,7 @@
prepareForReinit
super prepareForReinit.
windowGroup notNil ifTrue:[
- windowGroup reinitialize
+ windowGroup reinitialize
]
!
@@ -7416,11 +7507,11 @@
self initStyle.
(self drawableId notNil and:[self gcId notNil]) ifTrue:[
- "force a change"
- t := self borderWidth. self borderWidth:nil. self borderWidth:t.
- t := viewBackground. viewBackground := nil. self viewBackground:t.
- self clearView.
- self invalidate.
+ "force a change"
+ t := self borderWidth. self borderWidth:nil. self borderWidth:t.
+ t := viewBackground. viewBackground := nil. self viewBackground:t.
+ self clearView.
+ self invalidate.
].
"Modified: / 18.9.1998 / 21:15:33 / cg"
@@ -7605,33 +7696,33 @@
s := aString readStream.
[s atEnd] whileFalse:[
- c := s next.
- c == $& ifTrue:[
- n := s peek.
- (n notNil and:[n isLetter]) ifTrue:[
- c := s next.
- pos := xLatedString size + 1.
- ] ifFalse:[
- n == $& ifTrue:[
- s next.
- ]
- ]
- ].
- c notNil ifTrue:[
- xLatedString nextPut:c
- ]
+ c := s next.
+ c == $& ifTrue:[
+ n := s peek.
+ (n notNil and:[n isLetter]) ifTrue:[
+ c := s next.
+ pos := xLatedString size + 1.
+ ] ifFalse:[
+ n == $& ifTrue:[
+ s next.
+ ]
+ ]
+ ].
+ c notNil ifTrue:[
+ xLatedString nextPut:c
+ ]
].
xLatedString := xLatedString contents.
pos notNil ifTrue:[
- shortcutCharacter := xLatedString at:pos ifAbsent:nil.
-
- xLatedString isText ifFalse:[
- xLatedString := xLatedString asText
- ].
- xLatedString emphasisAt:pos add:#underline.
-
- shortcut := ('Cmd' , shortcutCharacter asLowercase) asSymbol.
+ shortcutCharacter := xLatedString at:pos ifAbsent:nil.
+
+ xLatedString isText ifFalse:[
+ xLatedString := xLatedString asText
+ ].
+ xLatedString emphasisAt:pos add:#underline.
+
+ shortcut := ('Cmd' , shortcutCharacter asLowercase) asSymbol.
].
^ Array with:shortcut with:xLatedString
@@ -7871,24 +7962,24 @@
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"
@@ -8404,10 +8495,10 @@
|form|
(form := viewShape borderShapeForm) notNil ifTrue:[
- gc windowBorderShape:form.
+ gc windowBorderShape:form.
].
(form := viewShape viewShapeForm) notNil ifTrue:[
- gc windowShape:form.
+ gc windowShape:form.
].
"Created: 18.9.1997 / 11:09:00 / cg"
@@ -9379,28 +9470,28 @@
"/ ]
"/ ].
(viewGravity notNil "and:[viewGravity ~~ #NorthWest]") ifTrue:[
- gc viewGravity:viewGravity.
+ gc viewGravity:viewGravity.
].
(bitGravity notNil "and:[bitGravity ~~ #NorthWest]") ifTrue:[
- isInputOnly ifFalse:[
- gc 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"
@@ -9777,11 +9868,11 @@
drawFocusFrame
self hasFocus ifTrue:[
- (styleSheet at:#focusHighlightStyle) == #win95 ifTrue:[
- self windowGroup focusCameByTab ifTrue:[
- self drawWin95FocusFrame
- ]
- ].
+ (styleSheet at:#focusHighlightStyle) == #win95 ifTrue:[
+ self windowGroup focusCameByTab ifTrue:[
+ self drawWin95FocusFrame
+ ]
+ ].
]
!
@@ -9816,16 +9907,16 @@
self fill:self blackColor.
messageOrNil notNil ifTrue:[
- self withForeground:Color white do:[
- self displayString:messageOrNil centeredAt:(self center).
- ].
+ self withForeground:Color white do:[
+ self displayString:messageOrNil centeredAt:(self center).
+ ].
].
Delay waitForSeconds:0.1.
self fill:self whiteColor.
messageOrNil notNil ifTrue:[
- self withForeground:Color black do:[
- self displayString:messageOrNil centeredAt:(self center).
- ].
+ self withForeground:Color black do:[
+ self displayString:messageOrNil centeredAt:(self center).
+ ].
].
Delay waitForSeconds:0.1.
self fill:viewBackground.
@@ -9906,11 +9997,12 @@
r := aRectangle.
currentTransformation := gc transformation.
currentTransformation notNil ifTrue:[
- r := currentTransformation applyTo:r.
+ r := (currentTransformation transformPoint:r origin) corner:(currentTransformation transformPoint:r corner).
].
self invalidateDeviceRectangle:r repairNow:doRepairNow
- "Modified: / 10.11.1998 / 01:55:03 / cg"
+ "Modified: / 10-11-1998 / 01:55:03 / cg"
+ "Modified: / 22-01-2015 / 14:23:09 / az"
!
invalidateDeviceRectangle:aRectangle repairNow:doRepairNow
@@ -9920,17 +10012,17 @@
The given rectangle is in device coordinate space."
shown ifFalse:[
- "/ no need to add damage - will get a full-redraw anyway,
- "/ when I will be shown again.
- ^ self
+ "/ no need to add damage - will get a full-redraw anyway,
+ "/ when I will be shown again.
+ ^ self
].
(aRectangle width <= 0 or:[aRectangle height <= 0]) ifTrue:[
- "/ no need to add damages with extent <= 0
- ^ self
+ "/ no need to add damages with extent <= 0
+ ^ self
].
self sensor addDamage:aRectangle view:self.
doRepairNow ifTrue:[
- self repairDamage
+ self repairDamage
]
"Modified: / 10.11.1998 / 01:55:03 / cg"
@@ -10739,8 +10831,8 @@
isPopup := self isPopUpView.
aWindowGroup notNil ifTrue:[
- mainGroup := aWindowGroup mainGroup.
- mainView := mainGroup mainView.
+ mainGroup := aWindowGroup mainGroup.
+ mainView := mainGroup mainView.
].
"/ set the windowgroup BEFORE sending the aboutToOpen notification
@@ -10748,144 +10840,144 @@
"/ this allows for the handler to enqueue an event,
"/ or to add event hooks.
Processor activeProcessIsSystemProcess ifTrue:[
- "
- put myself into the modal group, let it handle events for
- me as well. This is only a half way solution, since the view
- is not modal at all ... however, the only situation
- where this happens is with modal boxes popped while in a
- modal browser. You will forgive me for that inconvenience.
- "
- windowGroup := aWindowGroup.
- aWindowGroup notNil ifTrue:[aWindowGroup addTopView:self].
+ "
+ put myself into the modal group, let it handle events for
+ me as well. This is only a half way solution, since the view
+ is not modal at all ... however, the only situation
+ where this happens is with modal boxes popped while in a
+ modal browser. You will forgive me for that inconvenience.
+ "
+ windowGroup := aWindowGroup.
+ aWindowGroup notNil ifTrue:[aWindowGroup addTopView:self].
] ifFalse:[
- previousGroup := WindowGroup activeGroup.
-
- "/ create a new window group put myself into it
- windowGroup := self windowGroupClass new
- addTopView:self;
- setPreviousGroup:previousGroup.
-
- superView notNil ifTrue:[
- "/
- "/ special: this is a modal subview,
- "/ prevent the view from reassigning its windowGroup when realized
- "/ (subviews normaly place themself into the superviews group)
- "/
- windowGroup isForModalSubview:true.
- ].
+ previousGroup := WindowGroup activeGroup.
+
+ "/ create a new window group put myself into it
+ windowGroup := self windowGroupClass new
+ addTopView:self;
+ setPreviousGroup:previousGroup.
+
+ superView notNil ifTrue:[
+ "/
+ "/ special: this is a modal subview,
+ "/ prevent the view from reassigning its windowGroup when realized
+ "/ (subviews normaly place themself into the superviews group)
+ "/
+ windowGroup isForModalSubview:true.
+ ].
].
makeTransient := true.
isPopup ifFalse:[
- "/ the following allows for knowledgable programmers to suppress dialog boxes,
- "/ or to patch common controls right before opening...
- (Dialog aboutToOpenBoxNotificationSignal raiseRequestWith:self) == #abort ifTrue:[
- ^ self
- ].
- "/ the following allows for hooks to add a bell sound or other whenever a dialog opens
- self graphicsDevice modalWindowListenersDo:[:listener | listener aboutToOpenWindow:self].
-
- "/ the following raises the corresponding mainview, so the dialog shows above
- "/ any currently covered view. However, be careful if being debugged, or if this dialog
- "/ is opened by an already open dialog.
- mainView notNil ifTrue:[
- (mainView windowGroup isInModalLoop
- or:[ mainView windowGroup isDebugged
- or:[ WindowGroup activeGroup isDebugged
- ]]) ifFalse:[
- self tracePoint:#cg message:'activate'.
- self debuggingCodeFor:#cg is:[ Transcript showCR:mainView; showCR:mainView windowGroup. ].
- mainView activate; setForegroundWindow.
- ] ifTrue:[
- makeTransient := false.
- ]
- ].
+ "/ the following allows for knowledgable programmers to suppress dialog boxes,
+ "/ or to patch common controls right before opening...
+ (Dialog aboutToOpenBoxNotificationSignal raiseRequestWith:self) == #abort ifTrue:[
+ ^ self
+ ].
+ "/ the following allows for hooks to add a bell sound or other whenever a dialog opens
+ self graphicsDevice modalWindowListenersDo:[:listener | listener aboutToOpenWindow:self].
+
+ "/ the following raises the corresponding mainview, so the dialog shows above
+ "/ any currently covered view. However, be careful if being debugged, or if this dialog
+ "/ is opened by an already open dialog.
+ mainView notNil ifTrue:[
+ (mainView windowGroup isInModalLoop
+ or:[ mainView windowGroup isDebugged
+ or:[ WindowGroup activeGroup isDebugged
+ ]]) ifFalse:[
+ self tracePoint:#cg message:'activate'.
+ self debuggingCodeFor:#cg is:[ Transcript showCR:mainView; showCR:mainView windowGroup. ].
+ mainView activate; setForegroundWindow.
+ ] ifTrue:[
+ makeTransient := false.
+ ]
+ ].
].
makeTransient ifTrue:[
- mainView notNil ifTrue:[
- "set the transient property.
- This is currently used for X, to tell the Window Manager
- That this view should be always on top of the mainView"
- self drawableId isNil ifTrue:[self create].
- self graphicsDevice setTransient:self drawableId for:mainView id.
- ]
+ mainView notNil ifTrue:[
+ "set the transient property.
+ This is currently used for X, to tell the Window Manager
+ That this view should be always on top of the mainView"
+ self drawableId isNil ifTrue:[self create].
+ self graphicsDevice setTransient:self drawableId for:mainView id.
+ ]
].
self raise.
Processor activeProcessIsSystemProcess ifTrue:[
- self realize
+ self realize
] ifFalse:[
- "
- show a stop-cursor in the suspended window groups
- "
- (mainGroup notNil and:[isPopup not]) ifTrue:[
- mainGroup showCursor:(Cursor stop).
- previousGroup ~~ mainGroup ifTrue:[
- previousGroup showCursor:(Cursor stop).
- ].
- cursorChanged := true.
- ].
-
- "
- go dispatch events in this new group
- (thus current windowgroup is blocked from interaction)
- "
- AbortOperationRequest handle:[:ex |
- "/ the dialog/popup is aborted - hide it. Care for another abort during the hide.
- AbortOperationRequest handle:[:ex2 |
- "/ an aborted hide (possibly due to a cancelled user confirmation or similar)
- self breakPoint:#cg.
- ex exit.
- ] do:[
- self hide.
- realized ifTrue:[
- "/ self halt. "/ hide handled and closeRequest not wanted:
- ex exit.
- ].
- ].
- ] do:[
- [
- [
- windowGroup startupModal:[realized and:aBlock] forGroup:aWindowGroup
- ] ifCurtailed:[
- self hide.
- ]
- ] ensure:[
- aWindowGroup notNil ifTrue:[
- aWindowGroup graphicsDevice sync. "thats a round trip - make sure that all drawing has been processed"
- "/ ensure that eventListener runs here ...
- Delay waitForSeconds:0.05.
- aWindowGroup processExposeEvents.
-
- (self isPopUpView or:[ ReturnFocusWhenClosingModalBoxes ]) ifTrue:[
- "
- return the input focus to the previously active group's top.
- This helps with window managers which need an explicit click
- on the view for the focus.
- Only do this, if the previous group is still having the focus.
- (i.e. no other view was opened in the meantime)
- "
- aWindowGroup graphicsDevice focusView isNil ifTrue:[
- tops := aWindowGroup topViews.
- (tops notEmptyOrNil) ifTrue:[
- tops first getKeyboardFocus
- ].
- ].
- ].
-
- "
- restore cursors in the changed groups
- "
- cursorChanged notNil ifTrue:[
- mainGroup restoreCursors.
- previousGroup ~~ mainGroup ifTrue:[
- previousGroup restoreCursors.
- ].
- ].
- ].
- ]
- ].
+ "
+ show a stop-cursor in the suspended window groups
+ "
+ (mainGroup notNil and:[isPopup not]) ifTrue:[
+ mainGroup showCursor:(Cursor stop).
+ previousGroup ~~ mainGroup ifTrue:[
+ previousGroup showCursor:(Cursor stop).
+ ].
+ cursorChanged := true.
+ ].
+
+ "
+ go dispatch events in this new group
+ (thus current windowgroup is blocked from interaction)
+ "
+ AbortOperationRequest handle:[:ex |
+ "/ the dialog/popup is aborted - hide it. Care for another abort during the hide.
+ AbortOperationRequest handle:[:ex2 |
+ "/ an aborted hide (possibly due to a cancelled user confirmation or similar)
+ self breakPoint:#cg.
+ ex exit.
+ ] do:[
+ self hide.
+ realized ifTrue:[
+ "/ self halt. "/ hide handled and closeRequest not wanted:
+ ex exit.
+ ].
+ ].
+ ] do:[
+ [
+ [
+ windowGroup startupModal:[realized and:aBlock] forGroup:aWindowGroup
+ ] ifCurtailed:[
+ self hide.
+ ]
+ ] ensure:[
+ aWindowGroup notNil ifTrue:[
+ aWindowGroup graphicsDevice sync. "thats a round trip - make sure that all drawing has been processed"
+ "/ ensure that eventListener runs here ...
+ Delay waitForSeconds:0.05.
+ aWindowGroup processExposeEvents.
+
+ (self isPopUpView or:[ ReturnFocusWhenClosingModalBoxes ]) ifTrue:[
+ "
+ return the input focus to the previously active group's top.
+ This helps with window managers which need an explicit click
+ on the view for the focus.
+ Only do this, if the previous group is still having the focus.
+ (i.e. no other view was opened in the meantime)
+ "
+ aWindowGroup graphicsDevice focusView isNil ifTrue:[
+ tops := aWindowGroup topViews.
+ (tops notEmptyOrNil) ifTrue:[
+ tops first getKeyboardFocus
+ ].
+ ].
+ ].
+
+ "
+ restore cursors in the changed groups
+ "
+ cursorChanged notNil ifTrue:[
+ mainGroup restoreCursors.
+ previousGroup ~~ mainGroup ifTrue:[
+ previousGroup restoreCursors.
+ ].
+ ].
+ ].
+ ]
+ ].
]
"Created: / 10-12-1995 / 14:06:14 / cg"
@@ -11291,5 +11383,15 @@
"Created: 18.9.1997 / 11:04:29 / cg"
! !
+!SimpleView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.782 2015-03-01 16:55:39 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.782 2015-03-01 16:55:39 cg Exp $'
+
+! !
SimpleView initialize!
--- a/SolidBackground.st Thu Feb 19 06:21:17 2015 +0000
+++ b/SolidBackground.st Tue Mar 03 03:55:48 2015 +0000
@@ -32,6 +32,16 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+!
+
+examples
+"
+ |v|
+
+ v := View new.
+ v viewBackground:(SolidBackground new color:Color red).
+ v open.
+"
! !
!SolidBackground methodsFor:'accessing'!
@@ -56,5 +66,6 @@
!SolidBackground class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/SolidBackground.st,v 1.3 2011-01-23 01:43:01 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/SolidBackground.st,v 1.4 2014-12-21 15:38:34 cg Exp $'
! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SolidFillStyle.st Tue Mar 03 03:55:48 2015 +0000
@@ -0,0 +1,41 @@
+"{ Package: 'stx:libview' }"
+
+FillStyle subclass:#SolidFillStyle
+ instanceVariableNames:'color'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Compatibility-Squeak-Balloon-Fills'
+!
+
+!SolidFillStyle class methodsFor:'documentation'!
+
+documentation
+"
+ an as-yet unused class.
+ For now, this is present as compatibility class (for Squeak),
+ but we may move change the fill/drawing code in the view hierarchy to use it later.
+
+ [author:]
+ cg
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+
+"
+! !
+
+
+
+!SolidFillStyle class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/SolidFillStyle.st,v 1.4 2014-12-19 21:31:29 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/SolidFillStyle.st,v 1.4 2014-12-19 21:31:29 cg Exp $'
+! !
+
--- a/StandardSystemView.st Thu Feb 19 06:21:17 2015 +0000
+++ b/StandardSystemView.st Tue Mar 03 03:55:48 2015 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -13,6 +15,8 @@
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
TopView subclass:#StandardSystemView
instanceVariableNames:'label icon iconView iconLabel minExtent maxExtent sizeFixed
application windowEventsForApplication deviceIcon labelChannel'
@@ -1054,9 +1058,24 @@
I.e. the mouse was moved out into the topView area - restore the
focus to the previous focusView.."
- |v ms|
+ |viewToGetFocus viewUnderMousePointer ms|
windowGroup notNil ifTrue:[
+ "/ a hack for window managers, which do not honor the
+ "/ WMTransientFor attribute (i.e. XQuartz).
+ "/ This flag would prevent a popup (dialog or notification) from being
+ "/ covered by its underlying regular view. But on MAC, it does not.
+ "/ However, focus is coming in, when doing this, so we manually fix this
+ "/ here. Should not hurt on other systems, where the view is already on top.
+ "/ if it does, add some conditional check here (device WMTransientForBroken or similar)
+ "/ You can check for you WM to be correct, by disabling the line below,
+ "/ then click on a smallLint-note icon, to see the smallLint info,
+ "/ then click on the underlying codeView, to raise it.
+ "/ if the smallLint view can be covered, your WM is broken.
+ "/ cg: turns out to be a bad idea - it does help solve the above problem (on mac),
+ "/ but raises unwanted topViews (for example, if a modal dialog's popup menu closes)
+ "/ windowGroup topViews first raise.
+
"/ I got the focus - tell the current focus-windowgroup
"/ that its focus is gone elsewhere ...
"/ 'focusIn ' print. windowGroup process name printCR.
@@ -1066,33 +1085,44 @@
"/ there are situations where this does not happen;
"/ I am not sure if that is a WM bug or an ST/X bug, but sometimes (with popups),
"/ I only get a focus in. Could be a race, when the loosing view is already destroyed,
- "/ when the focus event arrives.
- "/ Anyway: it does not matter to take it again...
+ "/ at the time the focus event arrives.
+ "/ Anyway: it should not matter to take it again...
WindowGroup takeFocusFromDevice:self graphicsDevice.
+ windowGroup isInModalLoop ifTrue:[
+ windowGroup allTopViewsDo:[:t |
+ t ~~ self ifTrue:[
+ t focusIn.
+ t raise.
+ ^ self.
+ ].
+ ]
+ ].
+
"/ Transcript show:self; show:' focus in '; showCR:windowGroup isInModalLoop.
- v := windowGroup focusView.
- v isNil ifTrue:[
+ viewToGetFocus := windowGroup focusView.
+ viewToGetFocus isNil ifTrue:[
UserPreferences current focusFollowsMouse ~~ false ifTrue:[
- v := windowGroup pointerView.
- "/ 'pointerView is ' print. v printCR.
- (v notNil
- and:[v isKeyboardConsumer not
- and:[v wantsFocusWithPointerEnter not]]) ifTrue:[
- "/ no - not this one
- "/ 'not a kbdConsumer' printCR.
- v := nil.
+ viewUnderMousePointer := windowGroup pointerView.
+ "/ 'viewUnderMousePointer is ' print. viewUnderMousePointer printCR.
+ (viewUnderMousePointer notNil
+ and:[viewUnderMousePointer isKeyboardConsumer
+ and:[viewUnderMousePointer wantsFocusWithPointerEnter]]) ifTrue:[
+ viewToGetFocus := viewUnderMousePointer.
]
- ]
+ ].
].
- v isNil ifTrue:[
- self assignInitialKeyboardFocus.
+ viewToGetFocus isNil ifTrue:[
+ windowGroup focusBackToPreviousFocusView.
+ windowGroup focusView isNil ifTrue:[
+ self assignInitialKeyboardFocus.
+ ].
] ifFalse:[
"/ v requestFocus. - will be denied; but we must force it here
"/ to force a change...
windowGroup setFocusView:nil.
- windowGroup focusView:v byTab:nil.
+ windowGroup focusView:viewToGetFocus byTab:nil.
].
"/ optionally bring the window to the front after some delay.
@@ -1110,18 +1140,17 @@
"the top-view lost the keyboard focus (via the window manager).
I.e. the mouse was moved out of the topView area."
- |v|
+ |v wg|
"/ 'fout ' print. self printCR.
- windowGroup notNil ifTrue:[
+ (wg := windowGroup) notNil ifTrue:[
"/ ' fout-focusView: ' print. windowGroup focusView printCR.
- (v := windowGroup focusView) notNil ifTrue:[
+ (v := wg focusView) notNil ifTrue:[
+ "/ wg focusView:nil. "/ -- let windowGroup do it.
v showNoFocus:(windowGroup explicitFocusView == v).
"/ ' send-has-nofocus to: ' print. v printCR.
v hasKeyboardFocus:false.
-
- windowGroup focusView:nil.
]
].
super focusOut
@@ -1637,11 +1666,12 @@
(UserPreferences current icccm20Compliant) ifTrue:[
"/ICCCM 2.0 compliant name & class. See ICCCM 2.0 section 4.1.2.5.
- | lastSepIndex |
+ | commandName lastSepIndex |
- lastSepIndex := Smalltalk commandName lastIndexOf: Filename separator.
- windowNameString := Smalltalk commandName copyFrom: lastSepIndex + 1.
- windowClassNameString := windowNameString capitalized.
+ commandName := Smalltalk commandName.
+ lastSepIndex := commandName lastIndexOf: Filename separator.
+ windowNameString := commandName copyFrom: lastSepIndex + 1.
+ windowClassNameString := windowNameString asUppercaseFirst.
"/ Also, set _NET_WM_PID
self setWindowPid: nil.
@@ -1721,11 +1751,11 @@
!StandardSystemView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.223 2014-12-03 14:40:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.231 2015-02-27 13:33:16 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.223 2014-12-03 14:40:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.231 2015-02-27 13:33:16 cg Exp $'
! !
--- a/TopView.st Thu Feb 19 06:21:17 2015 +0000
+++ b/TopView.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
View subclass:#TopView
instanceVariableNames:'type iconified keyboardProcessor'
classVariableNames:'TakeFocusWhenMapped ForceModalBoxesToOpenAtCenter
@@ -766,9 +768,9 @@
(windowGroup notNil
and:[(componentWithInitialFocus := windowGroup defaultKeyboardConsumer) notNil]) ifTrue:[
- windowGroup focusView:componentWithInitialFocus byTab:true "false".
+ windowGroup focusView:componentWithInitialFocus byTab:true "false".
] ifFalse:[
- self assignKeyboardFocusToFirstInputField.
+ self assignKeyboardFocusToFirstKeyboardConsumer.
].
!
@@ -1478,11 +1480,11 @@
!TopView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/TopView.st,v 1.152 2014-12-03 14:42:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/TopView.st,v 1.153 2015-02-24 15:47:12 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/TopView.st,v 1.152 2014-12-03 14:42:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/TopView.st,v 1.153 2015-02-24 15:47:12 cg Exp $'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TranslationTransform.st Tue Mar 03 03:55:48 2015 +0000
@@ -0,0 +1,385 @@
+"
+ COPYRIGHT (c) 1992 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libview' }"
+
+DisplayTransform variableFloatSubclass:#TranslationTransform
+ instanceVariableNames:'translation'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Transformations'
+!
+
+!TranslationTransform class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1992 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ instances of WindowingTransformation can be used to scale, translate or
+ generally transform other objects in 2D space.
+ They can also be set as the translation in a graphic context,
+ which will then apply this to all of its drawing operations
+ (see GraphicContext>>transformation:).
+
+ All 2-D objects are supposed to be able to be transformed using
+ instances of me. Multiple instances of me can also be combined to form a
+ single composite transformation.
+
+ [Instance variables:]
+ scale <Number> or <Point> representing a linear scaling factor.
+ nil is interpreted as 1@1
+
+ translation <Number> or <Point> representing a translation in 2-D.
+ nil is interpreted as 0@0
+
+
+ [author:]
+ Claus Gittinger
+"
+
+ "Modified: 25.4.1996 / 16:53:07 / cg"
+!
+
+examples
+"
+ example (drawing in inches):
+ [exBegin]
+ |v|
+
+ v := View new realize.
+ (Delay forSeconds:3) wait.
+ v transformation:(WindowingTransformation unit:#inch on:Display).
+ 'now, we can think of drawing in inches ...'.
+ v displayLineFrom:0.5@0.5 to:1@1
+ [exEnd]
+
+
+ example (drawing in millimeters):
+ [exBegin]
+ |v|
+
+ v := View new realize.
+ (Delay forSeconds:3) wait.
+ v transformation:(WindowingTransformation unit:#mm on:Display).
+ 'now, we can think of drawing in millimeters ...'.
+ v displayLineFrom:5@5 to:20@5
+ [exEnd]
+
+
+ example (drawing magnified):
+ [exBegin]
+ |v|
+
+ v := View new realize.
+ (Delay forSeconds:3) wait.
+ v transformation:(WindowingTransformation scale:2 translation:0).
+ 'now, everything is magnfied by 2'.
+ v displayLineFrom:10@10 to:30@30
+ [exEnd]
+
+ example (drawing shrunk):
+ [exBegin]
+ |v|
+
+ v := View new realize.
+ (Delay forSeconds:3) wait.
+ v transformation:(WindowingTransformation scale:0.5 translation:0).
+ 'now, everything is shrunk by 2'.
+ v displayLineFrom:10@10 to:30@30
+ [exEnd]
+"
+
+ "Modified: 27.4.1996 / 19:45:43 / cg"
+! !
+
+!TranslationTransform class methodsFor:'instance creation'!
+
+identity
+ "returns a windowing transformation with no scaling (1@1)
+ and no translation (0@0)."
+
+ ^ self basicNew "/ scale:nil translation:nil
+
+ "
+ WindowingTransformation identity
+ "
+
+ "Modified: 30.12.1996 / 16:59:27 / cg"
+!
+
+translation:aTranslation
+ "returns a windowing transformation with no scaling and a translation offset of aTranslation."
+
+ ^ self basicNew translation:aTranslation
+
+ "
+ |v|
+
+ v := View new openAndWait.
+ v displayLineFrom:10@10 to:30@30.
+ v transformation:(WindowingTransformation scale:2 translation:0).
+ 'now, everything is magnfied by 2'.
+ v displayLineFrom:10@10 to:30@30.
+ "
+ "
+ |v|
+
+ v := View new openAndWait.
+ v displayLineFrom:10@10 to:30@30.
+ v transformation:(WindowingTransformation translation:50).
+ 'now, everything is offset by 50 pixels'.
+ v displayLineFrom:10@10 to:30@30.
+ "
+! !
+
+!TranslationTransform methodsFor:'accessing'!
+
+translation
+ "return a copy of the receiver's translation."
+
+ translation isNil ifTrue:[^ Point x:0 y:0 ].
+ ^ translation copy
+!
+
+translation:aTranslation
+ "Set the receiver's translation to aTranslation, a Point or Number."
+
+ aTranslation isNil ifTrue:[
+ translation := aTranslation
+ ] ifFalse:[
+ aTranslation = 0 ifTrue:[
+ translation := nil
+ ] ifFalse:[
+ translation := aTranslation asPoint
+ ]
+ ]
+
+ "Modified: / 13.6.1998 / 14:04:15 / cg"
+!
+
+translationX
+ "return the receiver's x-translation."
+
+ translation isNil ifTrue:[^ 0].
+ ^ translation x
+
+ "Created: 21.5.1996 / 21:13:10 / cg"
+!
+
+translationY
+ "return the receiver's x-translation."
+
+ translation isNil ifTrue:[^ 0].
+ ^ translation y
+
+ "Created: 21.5.1996 / 21:13:21 / cg"
+! !
+
+!TranslationTransform methodsFor:'applying transform'!
+
+applyInverseTo:anObject
+ "Apply the inverse of the receiver to anObject
+ and return the result. This can be used to map back from logical
+ to physical coordinates, for example."
+
+ translation isNil ifTrue:[
+ ^ anObject
+ ].
+ ^ anObject translatedBy:(self inverseTranslation).
+!
+
+applyInverseToX:aNumber
+ "Apply the receiver to a number representing an x-coordinate
+ and return the result."
+
+ |t|
+
+ translation isNil ifTrue:[t := 0] ifFalse:[t := translation x].
+ ^ (aNumber - t)
+!
+
+applyInverseToY:aNumber
+ "Apply the receiver to a number representing an y-coordinate
+ and return the result."
+
+ |t|
+
+ translation isNil ifTrue:[t := 0] ifFalse:[t := translation y].
+ ^ (aNumber - t)
+!
+
+applyTo:anObject
+ "Apply the receiver to anObject and return the result."
+
+ translation isNil ifTrue:[
+ ^ anObject
+ ].
+ ^ anObject translatedBy:translation
+!
+
+applyToX:aNumber
+ "Apply the receiver to a number representing an x-coordinate
+ and return the result."
+
+ |t|
+
+ translation isNil ifTrue:[t := 0] ifFalse:[t := translation x].
+ ^ aNumber + t
+!
+
+applyToY:aNumber
+ "Apply the receiver to a number representing an y-coordinate
+ and return the result."
+
+ |t|
+
+ translation isNil ifTrue:[t := 0] ifFalse:[t := translation y].
+ ^ aNumber + t
+!
+
+compose:aTransformation
+ "return a new WindowingTransformation that is the
+ composition of the receiver and aTransformation.
+ The effect of applying the resulting WindowingTransformation
+ to an object is the same as that of first applying
+ aTransformation to the object and then applying the
+ receiver to its result."
+
+ |aTransformationScale newScale newTranslation|
+
+ aTransformationScale := aTransformation scale.
+ aTransformation isNoScale ifTrue:[
+ newScale := nil
+ ] ifFalse:[
+ newScale := aTransformationScale
+ ].
+ newTranslation := (translation ? 0) + aTransformation translation.
+
+ ^ (self class)
+ scale:newScale
+ translation:newTranslation
+!
+
+composedWithLocal: aTransformation
+ ^ self compose:aTransformation
+!
+
+transformPoint:p
+ "Apply the receiver to a point, returning a new point."
+
+ translation isNil ifTrue:[
+ ^ p
+ ].
+ ^ p + translation
+! !
+
+!TranslationTransform methodsFor:'printing & storing'!
+
+printOn:aStream
+ "append a user printed representation of the receiver to aStream.
+ The format is suitable for a human - not meant to be read back."
+
+ aStream nextPutAll:self class name.
+ aStream nextPutAll:' translation: '.
+ translation printOn:aStream
+! !
+
+!TranslationTransform methodsFor:'private'!
+
+inverseTranslation
+ "return with a Point representing the inverse of my translation."
+
+ |trans|
+
+ trans := translation asPoint.
+ ^ Point x:(trans x negated) y:trans y negated
+! !
+
+!TranslationTransform methodsFor:'testing'!
+
+isIdentityTransformation
+ "return true if this is an identity transformation;
+ return false, otherwise."
+
+ ^ translation isNil or:[translation x = 0 and:[translation y = 0]]
+!
+
+isNoScale
+ "return true if the identity scale is in effect (i.e. saleFactor is 1);
+ return false, otherwise."
+
+ ^ true
+! !
+
+!TranslationTransform methodsFor:'transformations'!
+
+scaleBy:aScale
+ "scale the receiver.
+ This is a destructive operation, modifying the transformation
+ represented by the receiver"
+
+ self error:'not allowed'
+!
+
+scaledBy:aScale
+ "return a new WindowingTransformation with the scale and translation of
+ the receiver both scaled by aScale."
+
+ ^ WindowingTransformation
+ scale:aScale
+ translation:translation
+!
+
+translateBy:aTranslation
+ "translate the receiver.
+ This is a destructive operation, modifying the transformation
+ represented by the receiver"
+
+ aTranslation isNil ifTrue:[^ self].
+
+ translation isNil ifTrue:[
+ translation := 0@0
+ ].
+ translation := translation + aTranslation asPoint
+!
+
+translatedBy:aPoint
+ "return a new WindowingTransformation with the same scale and
+ rotations as the receiver and with a translation of the current
+ translation plus aPoint."
+
+ ^ (self class)
+ translation:(translation + aPoint)
+! !
+
+!TranslationTransform class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/TranslationTransform.st,v 1.1 2014-12-21 22:24:09 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/TranslationTransform.st,v 1.1 2014-12-21 22:24:09 cg Exp $'
+! !
+
--- a/View.st Thu Feb 19 06:21:17 2015 +0000
+++ b/View.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
SimpleView subclass:#View
instanceVariableNames:'model aspectMsg changeMsg menuMsg menuHolder menuPerformer
enableChannel foregroundChannel backgroundChannel'
@@ -736,48 +738,6 @@
!View methodsFor:'initialization & release'!
-assignKeyboardFocusTo:aConsumer
- |wg|
-
- wg := self windowGroup .
- self graphicsDevice isWindowsPlatform ifTrue:[
- wg focusView:aConsumer byTab:true.
- ] ifFalse:[
- aConsumer requestFocus.
- "/ consumer requestFocus. - could be denied; but we force it here
- wg focusView:aConsumer byTab:false.
- ].
-!
-
-assignKeyboardFocusToFirstInputField
- "assign the keyboard focus to the first first keyboardConsumer.
- (in older versions, this used to favour inputfields over editFields;
- see (or redefine) preferFirstInputFieldWhenAssigningInitialFocus)"
-
- |firstInputField firstConsumer firstCursorConsumer consumer|
-
- self allSubViewsDo:[:v |
- (firstInputField isNil and:[v isInputField]) ifTrue:[
- firstInputField := v
- ].
- (firstConsumer isNil and:[v isKeyboardConsumer]) ifTrue:[
- firstConsumer := v
- ].
- (firstCursorConsumer isNil and:[v isCursorKeyConsumer]) ifTrue:[
- firstCursorConsumer := v
- ].
- ].
- self preferFirstInputFieldWhenAssigningInitialFocus ifTrue:[
- consumer := firstInputField.
- ].
- consumer := (consumer ? firstConsumer ? firstCursorConsumer).
- consumer notNil ifTrue:[
- self assignKeyboardFocusTo:consumer
- ].
-
- "Modified: / 29-08-2006 / 14:32:30 / cg"
-!
-
initialize
super initialize.
@@ -821,6 +781,10 @@
!View class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/View.st,v 1.86 2014-11-21 13:59:49 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/View.st,v 1.89 2015-02-24 15:45:44 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/View.st,v 1.89 2015-02-24 15:45:44 cg Exp $'
! !
--- a/WindowGroup.st Thu Feb 19 06:21:17 2015 +0000
+++ b/WindowGroup.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
Object subclass:#WindowGroup
instanceVariableNames:'graphicsDevice views topViews myProcess mySensor isModal
previousGroup focusView focusSequence preEventHook postEventHook
@@ -1991,7 +1993,8 @@
previousFocusView notNil ifTrue:[
previousFocusView isVisible ifTrue:[
- self focusToView:previousFocusView
+ "/ self focusToView:previousFocusView
+ self focusView:previousFocusView
]
]
!
@@ -2246,6 +2249,9 @@
that the user has explicitely tabbed into the view to force focus to it)"
|prevFocusView myDisplay|
+"/(aViewOrNil notNil and:[aViewOrNil shown not]) ifTrue:[
+"/aViewOrNil topView shown ifTrue:[self halt].
+"/].
"/'focusToView:' print. aViewOrNil print.
"/' (prev: ' print. focusView print. ')' printCR.
@@ -2272,9 +2278,11 @@
focusCameViaTabOrNil notNil ifTrue:[
focusByTab := focusCameViaTabOrNil "or:[focusByTab]".
].
- false ifTrue:[
+ true ifTrue:[
focusView showFocus:focusByTab.
- 'give focus to ' print. aViewOrNil printCR.
+ ].
+ true ifTrue:[
+ "/ 'give focus to ' print. aViewOrNil printCR.
self class sendKeyboardFocusEventTo:aViewOrNil withArgument:true.
].
].
@@ -2285,6 +2293,7 @@
"/ lost explicit focus
focusView == aViewOrNil ifTrue:[
"/'give focus to ' print. aViewOrNil printCR.
+ aViewOrNil showFocus:(focusCameViaTabOrNil ? true).
self class sendKeyboardFocusEventTo:aViewOrNil withArgument:true.
^ self
].
@@ -2768,41 +2777,35 @@
get mapping of view->cursor for all of my subviews
"
oldCursors := IdentityDictionary new.
- self allViewsDo:[:eachView |
- |old|
-
- old := eachView cursor.
- old ~~ deviceCursor ifTrue:[
- oldCursors at:eachView put:old.
- eachView cursor:deviceCursor now:false
- ]
- ].
-
- oldCursors isEmpty ifTrue:[
- ^ aBlock value.
- ] ifFalse:[
+ [
+ inWithCursorDoBlock := true.
+
+ self allViewsDo:[:eachView |
+ |old|
+
+ old := eachView cursor.
+ old ~~ deviceCursor ifTrue:[
+ oldCursors at:eachView put:old.
+ eachView cursor:deviceCursor now:false
+ ]
+ ].
+
+ aBlock value.
+
"used to do a sync here to make the cursor visible,
but everything is so fast nowaday, that it doesn't make a difference"
dev flush.
- inWithCursorDoBlock := true.
- ^ aBlock ensure:[
- "
- restore cursors from the mapping
- "
- oldCursors keysAndValuesDo:[:eachView :eachCursor |
- eachView cursor:eachCursor now:false.
- ].
- dev flush.
- inWithCursorDoBlock := false.
- ].
+ ] ensure:[
+ "
+ restore cursors from the mapping
+ "
+ oldCursors keysAndValuesDo:[:eachView :eachCursor |
+ eachView cursor:eachCursor now:false.
+ ].
+ dev flush.
+ inWithCursorDoBlock := false.
].
-"/ (self isModal and:[previousGroup notNil]) ifTrue:[
-"/ "/ pass the work to my parentGroup
-"/ ^ previousGroup withCursor:aCursor do:action
-"/ ].
-
-
"Modified: / 22.4.1998 / 14:36:47 / cg"
!
@@ -2849,11 +2852,11 @@
!WindowGroup class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.335 2014-11-28 12:03:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.339 2015-02-15 17:22:28 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.335 2014-11-28 12:03:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.339 2015-02-15 17:22:28 cg Exp $'
! !
--- a/WindowSensor.st Thu Feb 19 06:21:17 2015 +0000
+++ b/WindowSensor.st Tue Mar 03 03:55:48 2015 +0000
@@ -9,12 +9,8 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-'From Smalltalk/X, Version:6.2.5.0 on 10-02-2015 at 14:41:27' !
-
"{ Package: 'stx:libview' }"
-"{ NameSpace: Smalltalk }"
-
Object subclass:#WindowSensor
instanceVariableNames:'eventSemaphore damage mouseAndKeyboard compressMotionEvents
ignoreUserInput exposeEventSemaphore catchExpose gotExpose
@@ -223,6 +219,14 @@
WindowEvent KeyboardMap KeyboardForwarder EventListener
GraphicsDevice DeviceWorkstation View
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.292 2015-02-05 08:54:11 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.292 2015-02-05 08:54:11 cg Exp $'
! !
!WindowSensor class methodsFor:'initialization'!
@@ -3338,15 +3342,5 @@
"Modified: 10.2.1997 / 13:30:43 / cg"
! !
-!WindowSensor class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.292 2015/02/05 08:54:11 cg Exp $'
-!
-
-version_CVS
- ^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.284.2.3 2015-02-12 15:13:03 stefan Exp $'
-! !
-
WindowSensor initialize!
--- a/WindowingTransformation.st Thu Feb 19 06:21:17 2015 +0000
+++ b/WindowingTransformation.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,8 +11,10 @@
"
"{ Package: 'stx:libview' }"
-Object subclass:#WindowingTransformation
- instanceVariableNames:'scale translation'
+"{ NameSpace: Smalltalk }"
+
+ScaleTransform variableFloatSubclass:#WindowingTransformation
+ instanceVariableNames:'translation'
classVariableNames:''
poolDictionaries:''
category:'Graphics-Transformations'
@@ -128,6 +130,31 @@
"Modified: 30.12.1996 / 16:59:27 / cg"
!
+scale:aScale
+ "returns a windowing transformation with a scale factor of aScale and no translation"
+
+ ^ self basicNew scale:aScale translation:0
+
+ "
+ |v|
+
+ v := View new realize.
+ (Delay forSeconds:3) wait.
+ v transformation:(WindowingTransformation scale:2 translation:0).
+ 'now, everything is magnfied by 2'.
+ v displayLineFrom:10@10 to:30@30
+ "
+ "
+ |v|
+
+ v := View new realize.
+ (Delay forSeconds:3) wait.
+ v transformation:(WindowingTransformation scale:0.5 translation:0).
+ 'now, everything is shrunk by 2'.
+ v displayLineFrom:10@10 to:30@30
+ "
+!
+
scale:aScale translation:aTranslation
"returns a windowing transformation with a scale factor of
aScale and a translation offset of aTranslation."
@@ -154,6 +181,31 @@
"
!
+translation:aTranslation
+ "returns a windowing transformation with no scaling and a translation offset of aTranslation."
+
+ ^ self basicNew scale:nil translation:aTranslation
+
+ "
+ |v|
+
+ v := View new openAndWait.
+ v displayLineFrom:10@10 to:30@30.
+ v transformation:(WindowingTransformation scale:2 translation:0).
+ 'now, everything is magnfied by 2'.
+ v displayLineFrom:10@10 to:30@30.
+ "
+ "
+ |v|
+
+ v := View new openAndWait.
+ v displayLineFrom:10@10 to:30@30.
+ v transformation:(WindowingTransformation translation:50).
+ 'now, everything is offset by 50 pixels'.
+ v displayLineFrom:10@10 to:30@30.
+ "
+!
+
unit:unitSymbol on:device
"returns a windowing transformation with scaling
for unitSymbol and no translation (0@0).
@@ -252,34 +304,14 @@
'now, we can think of drawing in 0..1/0..1 coordinates'.
v displayLineFrom:0.1@0.1 to:0.9@0.9
"
+!
+
+withAngle:angle
+ ^ MatrixTransform2x3 withAngle:angle
! !
!WindowingTransformation methodsFor:'accessing'!
-scale
- "return a copy of the Point that represents the
- current scale of the receiver."
-
- scale isNil ifTrue:[^ (1@1) copy].
- ^ scale copy
-!
-
-scale:aScale
- "Set the receiver's scale to aScale, a Point or Number."
-
- aScale isNil ifTrue:[
- scale := aScale
- ] ifFalse:[
- aScale = 1 ifTrue:[
- scale := nil
- ] ifFalse:[
- scale := aScale asPoint.
- ]
- ].
-
- "Modified: / 13.6.1998 / 14:04:51 / cg"
-!
-
scale:aScale translation:aTranslation
"sets the scale to aScale and the translation to aTranslation."
@@ -305,34 +337,10 @@
"Modified: / 13.6.1998 / 14:04:42 / cg"
!
-scaleOfOne
- "Set the scale of the receiver to the identity scale"
-
- scale := nil
-!
-
-scaleX
- "return the current x-scale of the receiver."
-
- scale isNil ifTrue:[^ 1].
- ^ scale x
-
- "Created: 21.5.1996 / 21:13:49 / cg"
-!
-
-scaleY
- "return the current x-scale of the receiver."
-
- scale isNil ifTrue:[^ 1].
- ^ scale y
-
- "Created: 21.5.1996 / 21:13:59 / cg"
-!
-
translation
"return a copy of the receiver's translation."
- translation isNil ifTrue:[^ (0@0) copy].
+ translation isNil ifTrue:[^ Point x:0 y:0 ].
^ translation copy
!
@@ -372,20 +380,6 @@
!WindowingTransformation methodsFor:'applying transform'!
-applyInverseScaleX:aNumber
- "apply the scale only (if widths are to be transformed)"
-
- scale isNil ifTrue:[^ aNumber].
- ^ aNumber / scale x
-!
-
-applyInverseScaleY:aNumber
- "apply the scale only (if heights are to be transformed)"
-
- scale isNil ifTrue:[^ aNumber].
- ^ aNumber / scale y
-!
-
applyInverseTo:anObject
"Apply the inverse of the receiver to anObject
and return the result. This can be used to map back from logical
@@ -428,20 +422,6 @@
^ (aNumber - t) / s
!
-applyScaleX:aNumber
- "apply the scale only (if widths are to be transformed)"
-
- scale isNil ifTrue:[^ aNumber].
- ^ aNumber * scale x
-!
-
-applyScaleY:aNumber
- "apply the scale only (if heights are to be transformed)"
-
- scale isNil ifTrue:[^ aNumber].
- ^ aNumber * scale y
-!
-
applyTo:anObject
"Apply the receiver to anObject and return the result."
@@ -494,28 +474,32 @@
aTransformationScale := aTransformation scale.
scale isNil ifTrue:[
- aTransformation noScale ifTrue:[
- newScale := nil
- ] ifFalse:[
- newScale := aTransformationScale
- ].
- newTranslation := translation + aTransformation translation
+ aTransformation isNoScale ifTrue:[
+ newScale := nil
+ ] ifFalse:[
+ newScale := aTransformationScale
+ ].
+ newTranslation := (translation ? 0) + aTransformation translation
] ifFalse:[
- aTransformation noScale ifTrue:[
- newScale := scale
- ] ifFalse:[
- newScale := scale * aTransformationScale
- ].
- newTranslation := translation
- + (scale * aTransformation translation)
+ aTransformation isNoScale ifTrue:[
+ newScale := scale
+ ] ifFalse:[
+ newScale := scale * aTransformationScale
+ ].
+ newTranslation := (translation ? 0)
+ + (scale * aTransformation translation)
].
^ (self class)
- scale:newScale
- translation:newTranslation
+ scale:newScale
+ translation:newTranslation
+!
+
+composedWithLocal: aTransformation
+ ^ self compose:aTransformation
!
transformPoint:p
- "Apply the receiver to a point."
+ "Apply the receiver to a point, returning a new point."
scale isNil ifTrue:[
translation isNil ifTrue:[
@@ -544,27 +528,6 @@
!WindowingTransformation methodsFor:'private'!
-checkScale:aScale
- "Converts aScale to the internal format of a floating-point Point."
-
- |checkedScale|
-
- checkedScale := aScale asPoint.
- ^ Point x:checkedScale x asFloat
- y:checkedScale y asFloat
-!
-
-inverseScale
- "return with a Point representing the inverse of my
- scale."
-
- |newScale|
-
- newScale := self checkScale:scale.
- ^ Point x:(1.0 / newScale x)
- y:(1.0 / newScale y)
-!
-
inverseTranslation
"return with a Point representing the inverse of my
translation."
@@ -572,8 +535,7 @@
|trans|
trans := translation asPoint.
- ^ Point x:trans x negated
- y:trans y negated
+ ^ Point x:(trans x negated) y:(trans y negated)
! !
!WindowingTransformation methodsFor:'testing'!
@@ -584,16 +546,6 @@
^ (scale isNil or:[scale x = 1 and:[scale y = 1]])
and:[translation isNil or:[translation x = 0 and:[translation y = 0]]]
-!
-
-noScale
- "return true if the identity scale is in effect;
- return false, otherwise."
-
- scale isNil ifTrue:[^ true].
- ^ scale x = 1 and:[scale y = 1]
-
- "Modified: 21.5.1996 / 21:15:21 / cg"
! !
!WindowingTransformation methodsFor:'transformations'!
@@ -673,6 +625,10 @@
!WindowingTransformation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/WindowingTransformation.st,v 1.24 2014-03-24 19:18:28 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/WindowingTransformation.st,v 1.27 2015-01-22 14:23:53 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/WindowingTransformation.st,v 1.27 2015-01-22 14:23:53 cg Exp $'
! !
--- a/XWorkstation.st Thu Feb 19 06:21:17 2015 +0000
+++ b/XWorkstation.st Tue Mar 03 03:55:48 2015 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
DeviceWorkstation subclass:#XWorkstation
instanceVariableNames:'hasShapeExtension hasShmExtension hasDPSExtension
hasMbufExtension hasXVideoExtension hasSaveUnder hasPEXExtension
@@ -50,6 +52,13 @@
privateIn:XWorkstation
!
+DeviceGraphicsContext subclass:#X11GraphicsContext
+ instanceVariableNames:'useXftFont xftDrawId'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:XWorkstation
+!
+
!XWorkstation primitiveDefinitions!
%{
@@ -1258,6 +1267,19 @@
"
!
+hasXftLibrary
+%{
+#ifdef XFT
+ RETURN(true);
+#else
+ RETURN(false);
+#endif
+%}
+ "
+ Display hasXftLibrary
+ "
+!
+
hasXVideo
"return true, if this workstation supports the XVideo extension.
Both the server must support it, and the feature must have been
@@ -1616,14 +1638,12 @@
!
supportsXFTFonts
- "return true, if this device supports xft font rendering.
- Xft support is being cleaned up, as it is currently a big hack,
- of which too many others need to know about currently."
-
- ^ XftFontDescription notNil
-
- "
- Screen current supportsXFTFonts
+ "return true, if this device supports xft (truetype) fonts."
+
+ ^ self hasRenderExtension and:[self hasXftLibrary]
+
+ "
+ Display supportsXFTFonts
"
!
@@ -7538,7 +7558,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')
"
!
@@ -7552,27 +7572,27 @@
|names listOfXftFonts|
listOfXFonts isNil ifTrue:[
- names := self getAvailableFontsMatching:'*'.
- names isNil ifTrue:[
- "no names returned ..."
- ^ nil
- ].
- listOfXFonts := names collect:[:aName | self fontDescriptionFromXFontName:aName].
- listOfXFonts := FontDescription genericFonts, listOfXFonts.
+ names := self getAvailableFontsMatching:'*'.
+ names isNil ifTrue:[
+ "no names returned ..."
+ ^ nil
+ ].
+ listOfXFonts := names collect:[:aName | self fontDescriptionFromXFontName:aName].
+ listOfXFonts := FontDescription genericFonts, listOfXFonts.
].
(XftFontDescription notNil
- and:[ XftFontDescription isLoaded
- and:[ self supportsXFTFonts ]]
+ and:[ XftFontDescription isLoaded
+ and:[ self supportsXFTFonts ]]
) ifTrue:[
- UserPreferences current useXFontsOnly ifFalse:[
- listOfXftFonts := XftFontDescription listOfAvailableFonts.
-
- UserPreferences current useXftFontsOnly ifTrue:[
- ^ listOfXftFonts
- ].
- ^ listOfXftFonts , listOfXFonts.
- ].
+ UserPreferences current useXFontsOnly ifFalse:[
+ listOfXftFonts := XftFontDescription listOfAvailableFonts.
+
+ UserPreferences current useXftFontsOnly ifTrue:[
+ ^ listOfXftFonts
+ ].
+ ^ listOfXftFonts , listOfXFonts.
+ ].
].
^ listOfXFonts
@@ -8626,8 +8646,8 @@
%{
int x_style, x_cap, x_join;
- static char dashList[2] = { 4,4 };
- static char dotList[2] = { 1,1 };
+ static char dotList[2] = { 1,1 };
+ static char dashList[2] = { 4,4 };
static char dashDotList[4] = { 4,1 , 1,1 };
static char dashDotDotList[6] = { 4,1 , 1,1 , 1,1 };
char *x_dashes = 0;
@@ -9261,12 +9281,12 @@
%{ /* NOCONTEXT */
if (ISCONNECTED) {
- Display *dpy;
- Visual *visual;
-
- dpy = myDpy;
- visual = DefaultVisualOfScreen(DefaultScreenOfDisplay(dpy));
- RETURN ( __MKEXTERNALADDRESS( visual ) );
+ Display *dpy;
+ Visual *visual;
+
+ dpy = myDpy;
+ visual = DefaultVisualOfScreen(DefaultScreenOfDisplay(dpy));
+ RETURN ( __MKEXTERNALADDRESS( visual ) );
}
%}.
^ nil
@@ -9930,6 +9950,10 @@
self beep:0 volume:50
]
+ "
+ Screen current beep
+ "
+
"Modified: / 3.12.1999 / 17:13:59 / ps"
!
@@ -13463,19 +13487,142 @@
^ true
! !
+!XWorkstation::X11GraphicsContext methodsFor:'displaying'!
+
+displayString:aString x:x y:y opaque:opaque
+ "draw a string - if opaque is false, draw foreground only; otherwise, draw both
+ foreground and background characters.
+ If the coordinates are not integers, an error is triggered."
+
+ <context: #return>
+
+ |displayId|
+
+ device flushIfAppropriate.
+ displayId := device displayIdOrErrorIfBroken.
+
+%{
+#if 0
+ GC gc;
+ Window win;
+ char *cp;
+ int n;
+ OBJ cls;
+# define NLOCALBUFFER 200
+ XChar2b xlatebuffer[NLOCALBUFFER];
+ int nInstBytes;
+
+ if (displayId != nil
+ && __isExternalAddress(__INST(gcId))
+ && __isExternalAddress(__INST(drawableId))
+ && __isNonNilObject(aString)
+ && __bothSmallInteger(x, y)) {
+ int lMax = __intVal(@global(XWorkstation:MaxStringLength));
+ Display *dpy = __DisplayVal(displayId);
+ gc = __GCVal(__INST(gcId));
+ win = __WindowVal(__INST(drawableId));
+
+ cp = (char *) __stringVal(aString);
+
+ if (__isStringLike(aString)) {
+ n = __stringSize(aString);
+ if (n > lMax) n = lMax;
+ ENTER_XLIB();
+ if (opaque == true)
+ XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
+ else
+ XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+
+ cls = __qClass(aString);
+ nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ cp += nInstBytes;
+
+ if (__isBytes(aString)) {
+ n = __byteArraySize(aString) - nInstBytes - 1;
+
+ if (n > lMax) n = lMax;
+ ENTER_XLIB();
+ if (opaque == true)
+ XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
+ else
+ XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+
+ /* TWOBYTESTRINGS */
+ if (__isWords(aString)) {
+ union {
+ char b[2];
+ unsigned short s;
+ } u;
+ int i;
+ XChar2b *cp2;
+ int mustFree = 0;
+
+ n = (__byteArraySize(aString) - nInstBytes) / 2;
+ if (n > lMax) n = lMax;
+
+#if defined(MSBFIRST) || defined(__MSBFIRST)
+ /*
+ * chars already in correct order
+ */
+#else
+# if ! (defined(LSBFIRST) || defined(__LSBFIRST))
+ /*
+ * ST/X TwoByteStrings store the asciiValue in native byteOrder;
+ * X expects them MSB first
+ * convert as required
+ */
+ u.s = 0x1234;
+ if (u.b[0] != 0x12)
+# endif
+ {
+ if (n <= NLOCALBUFFER) {
+ cp2 = xlatebuffer;
+ } else {
+ cp2 = (XChar2b *)(malloc(n * 2));
+ mustFree = 1;
+ }
+
+ for (i=0; i<n; i++) {
+ cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
+ cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
+ }
+ cp = (char *) cp2;
+ }
+#endif
+ ENTER_XLIB();
+ if (opaque == true)
+ XDrawImageString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, n);
+ else
+ XDrawString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, n);
+ LEAVE_XLIB();
+
+ if (mustFree) {
+ free(cp2);
+ }
+
+ RETURN ( self );
+ }
+ }
+#undef NLOCALBUFFER
+#endif
+%}.
+ ^ super displayString:aString x:x y:y opaque:opaque
+! !
+
!XWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.592.2.3 2014-11-26 16:03:51 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.604 2015-02-14 20:17:43 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.592.2.3 2014-11-26 16:03:51 stefan Exp $'
-!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
+ ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.604 2015-02-14 20:17:43 cg Exp $'
!
version_SVN
--- a/XftFontDescription.st Thu Feb 19 06:21:17 2015 +0000
+++ b/XftFontDescription.st Tue Mar 03 03:55:48 2015 +0000
@@ -1,7 +1,8 @@
"{ Package: 'stx:libview' }"
FontDescription subclass:#XftFontDescription
- instanceVariableNames:'device fontId sharedDrawId closestFont minCode maxCode'
+ instanceVariableNames:'device fontId sharedDrawId closestFont minCode maxCode ascent
+ descent height'
classVariableNames:'FC_FAMILY FC_STYLE FC_SLANT FC_WEIGHT FC_SIZE FC_ASPECT
FC_PIXEL_SIZE FC_SPACING FC_FOUNDRY FC_ANTIALIAS FC_HINTING
FC_HINT_STYLE FC_VERTICAL_LAYOUT FC_AUTOHINT FC_WIDTH FC_FILE
@@ -152,6 +153,19 @@
[see also:]
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.68 2014-12-22 00:44:58 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.68 2014-12-22 00:44:58 cg Exp $'
+!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
! !
!XftFontDescription class methodsFor:'initialization'!
@@ -309,6 +323,21 @@
|proto|
+ RecentlyUsedFonts notNil ifTrue:[
+ proto := RecentlyUsedFonts
+ detect:[:fn |
+ fn family = familyString
+ and:[ fn size = size and:[fn sizeUnit = sizeUnit
+ and:[ fn face = faceString
+ and:[ (fn style = styleString
+ or:[ (fn style = 'oblique' and:[styleString = 'italic'])
+ or:[ (fn style = 'italic' and:[styleString = 'oblique']) ]]) ]]]]]
+ ifNone:nil.
+ proto notNil ifTrue:[
+ ^ proto
+ ].
+ ].
+
CachedFontList notNil ifTrue:[
proto := CachedFontList
detect:[:fn |
@@ -534,15 +563,15 @@
asNonXftFont
|newFont|
- newFont := FontDescription
- family:family
- face:face
- style:style
- size:(sizeUnit == #px ifTrue:[pixelSize] ifFalse:[size])
- sizeUnit:sizeUnit
- encoding:encoding.
+ newFont := FontDescription
+ family:family
+ face:face
+ style:style
+ size:(sizeUnit == #px ifTrue:[pixelSize] ifFalse:[size])
+ sizeUnit:sizeUnit
+ encoding:encoding.
- ^ newFont
+ ^ newFont
! !
!XftFontDescription methodsFor:'displaying'!
@@ -551,41 +580,48 @@
"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 drawId drawIdIsShared error stringLen|
+ bg bgR bgG bgB bgA bgPixel drawX drawY displayId screen drawableId drawId drawIdIsShared error stringLen drawPnt clipPnt |
+
"limit the string len, otherwise bad output is generated"
stringLen := index2Arg - index1 + 1.
stringLen > 8000 ifTrue:[
- index2 := index1 + 8000 - 1.
+ index2 := index1 + 8000 - 1.
] ifFalse:[
- stringLen <= 0 ifTrue:[^ self].
- index2 := index2Arg.
+ stringLen <= 0 ifTrue:[^ self].
+ index2 := index2Arg.
].
bytesPerCharacter := aString bitsPerCharacter // 8.
transformation := aGC transformation.
clipR := aGC deviceClippingBoundsOrNil.
clipR notNil ifTrue:[
- clipX := clipR left.
- clipY := clipR top.
- clipW := clipR width.
- clipH := clipR height.
+ 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.].
- "/ YES YES YES: this MUST be transformed!!
- "/ (see htmlView) fix the notebook, please.
- transformation notNil ifTrue:[
- clipX := (transformation applyToX:clipX) ceiling.
- clipY := (transformation applyToY:clipY) ceiling.
- ].
+ "/ YES YES YES: this MUST be transformed!!
+ "/ (see htmlView) fix the notebook, please.
+ transformation notNil ifTrue:[
+ clipPnt := transformation transformPoint:(clipX @ clipY).
+ clipX := clipPnt x ceiling.
+ clipY := clipPnt y ceiling.
+"/ clipX := (transformation applyToX:clipX) ceiling.
+"/ clipY := (transformation applyToY:clipY) ceiling.
+ ].
].
transformation isNil ifTrue:[
- drawX := xArg.
- drawY := yArg.
+ drawX := xArg.
+ drawY := yArg.
] ifFalse:[
- drawX := (transformation applyToX:xArg) ceiling.
- drawY := (transformation applyToY:yArg) ceiling.
+ drawPnt := transformation transformPoint:(xArg @ yArg).
+ drawX := drawPnt x ceiling.
+ drawY := drawPnt y ceiling.
+"/ drawX := (transformation applyToX:xArg) ceiling.
+"/ drawY := (transformation applyToY:yArg) ceiling.
].
fg := aGC paint.
@@ -593,58 +629,58 @@
fgA := fg scaledAlpha.
fgR := fg scaledRed.
fgR notNil ifTrue:[
- fgG := fg scaledGreen.
- fgB := fg scaledBlue.
+ fgG := fg scaledGreen.
+ fgB := fg scaledBlue.
] ifFalse:[
- "/ when drawing into a pixmap...
- fgPixel == 0 ifTrue:[
- fgR := fgG := fgB := 0.
- ] ifFalse:[
- fgR := fgG := fgB := 16rFFFF.
- ]
+ "/ 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.
- 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.
- ]
- ].
+ 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.
aGC class == XGraphicsContext ifTrue:[
- "/ TODO: Following should be done atomically together with drawing...
- drawId := aGC xftDrawId.
- drawIdIsShared := false.
- drawId isNil ifTrue:[
+ "/ TODO: Following should be done atomically together with drawing...
+ drawId := aGC xftDrawId.
+ drawIdIsShared := false.
+ drawId isNil ifTrue:[
%{
- drawId = XFT_DRAW_HANDLE_NEW ( XftDrawCreate ( DISPLAY( displayId ) ,
- DRAWABLE( drawableId ) ,
- DefaultVisual( DISPLAY( displayId), SCREEN (screen) ) ,
- DefaultColormap( DISPLAY( displayId), SCREEN (screen) ) ) );
+ drawId = XFT_DRAW_HANDLE_NEW ( XftDrawCreate ( DISPLAY( displayId ) ,
+ DRAWABLE( drawableId ) ,
+ DefaultVisual( DISPLAY( displayId), SCREEN (screen) ) ,
+ DefaultColormap( DISPLAY( displayId), SCREEN (screen) ) ) );
%}.
- aGC xftDrawId: drawId.
- ].
- ] ifFalse:[
- Logger log: 'GC passed to XftGraphicsContext is not an XGraphicsContext!!' severity: #error.
- drawId := sharedDrawId.
- drawIdIsShared := true.
+ aGC xftDrawId: drawId.
+ ].
+ ] ifFalse:[
+ Logger log: 'GC passed to XftGraphicsContext is not an XGraphicsContext!!' severity: #error.
+ drawId := sharedDrawId.
+ drawIdIsShared := true.
].
%{
@@ -659,100 +695,100 @@
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 (drawIdIsShared == true) {
- if ( __INST(sharedDrawId) == nil ) {
- drawId = __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 ) );
- }
+ if ( __INST(sharedDrawId) == nil ) {
+ drawId = __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 ) );
+ }
}
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( drawId ) , 0, 0, &clipRX, 1);
+ clipRX.x = __intVal(clipX);
+ clipRX.y = __intVal(clipY);
+ clipRX.width = __intVal(clipW);
+ clipRX.height = __intVal(clipH);
+ XftDrawSetClipRectangles( XFT_DRAW( drawId ) , 0, 0, &clipRX, 1);
} else {
- XftDrawSetClip( XFT_DRAW( drawId ) , 0);
+ XftDrawSetClip( XFT_DRAW( drawId ) , 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 ( drawId ), &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;
+ }
+ XftDrawRect( XFT_DRAW ( drawId ), &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 ( drawId ), &color, XFT_FONT( __INST( fontId ) ),
- __intVal(drawX),
- __intVal(drawY),
- (FcChar8*)string,
- len);
- RETURN ( self );
- break;
+ XftDrawString8( XFT_DRAW ( drawId ), &color, XFT_FONT( __INST( fontId ) ),
+ __intVal(drawX),
+ __intVal(drawY),
+ (FcChar8*)string,
+ len);
+ RETURN ( self );
+ break;
case 2:
- XftDrawString16( XFT_DRAW ( drawId ), &color, XFT_FONT( __INST( fontId ) ),
- __intVal(drawX),
- __intVal(drawY),
- (FcChar16*)string,
- len);
- RETURN ( self );
- break;
+ XftDrawString16( XFT_DRAW ( drawId ), &color, XFT_FONT( __INST( fontId ) ),
+ __intVal(drawX),
+ __intVal(drawY),
+ (FcChar16*)string,
+ len);
+ RETURN ( self );
+ break;
case 4:
- XftDrawString32( XFT_DRAW ( drawId ), &color, XFT_FONT( __INST( fontId ) ),
- __intVal(drawX),
- __intVal(drawY),
- (FcChar32*)string,
- len);
- RETURN ( self );
- break;
+ XftDrawString32( XFT_DRAW ( drawId ), &color, XFT_FONT( __INST( fontId ) ),
+ __intVal(drawX),
+ __intVal(drawY),
+ (FcChar32*)string,
+ len);
+ RETURN ( self );
+ break;
}
#endif
err:;
@@ -801,101 +837,101 @@
(device == aGraphicsDevice) ifTrue:[^ self].
(aGraphicsDevice isNil and:[device notNil]) ifTrue:[
- ^ self
+ ^ self
].
aGraphicsDevice supportsXFTFonts ifFalse:[
- ^ super onDevice:aGraphicsDevice
+ ^ super onDevice:aGraphicsDevice
].
(closestFont notNil and:[closestFont graphicsDevice == aGraphicsDevice]) ifTrue:[
- ^ closestFont onDevice: aGraphicsDevice.
+ ^ closestFont onDevice: aGraphicsDevice.
].
RecentlyUsedFonts isNil ifTrue:[
- RecentlyUsedFonts := OrderedCollection new:10.
+ RecentlyUsedFonts := OrderedCollection new:10.
].
RecentlyUsedFonts keysAndValuesDo:[:index :aFont |
- ((aFont class == self class) and:[(self sameDeviceFontAs:aFont) and:[aFont getFontId notNil]]) ifTrue:[
- "/ Transcript showCR:'hit'.
- RecentlyUsedFonts removeIndex:index.
- RecentlyUsedFonts addFirst:aFont.
- ^ aFont
- ]
+ ((aFont class == self class) and:[(self sameDeviceFontAs:aFont) and:[aFont getFontId notNil]]) ifTrue:[
+ "/ Transcript showCR:'hit'.
+ RecentlyUsedFonts removeIndex:index.
+ RecentlyUsedFonts addFirst:aFont.
+ ^ aFont
+ ]
].
RecentlyUsedFonts size > 20 ifTrue:[
- RecentlyUsedFonts removeLast.
+ RecentlyUsedFonts removeLast.
].
aGraphicsDevice deviceFonts do:[:aFont |
- ((aFont class == self class) and:[self sameDeviceFontAs:aFont]) ifTrue:[
- RecentlyUsedFonts addFirst:aFont.
- ^ aFont
- ].
+ ((aFont class == self class) and:[self sameDeviceFontAs:aFont]) ifTrue:[
+ RecentlyUsedFonts addFirst:aFont.
+ ^ aFont
+ ].
].
[
- Error handle:[:ex |
- ^ self asNonXftFont onDevice:aGraphicsDevice
- ] do:[
- myPatternId := self xftPatternCreate.
- ].
- self xftPatternAdd: myPatternId attribute: FC_FAMILY value: family.
- pixelSize notNil ifTrue:[
- self xftPatternAdd: myPatternId attribute: FC_PIXEL_SIZE value: pixelSize.
- ] ifFalse:[
- self xftPatternAdd: myPatternId attribute: FC_SIZE value: size.
- ].
- self xftPatternAdd: myPatternId attribute: FC_WEIGHT value: (StXFace2FCWeightMap at: (face ? 'regular')).
- self xftPatternAdd: myPatternId attribute: FC_SLANT value: (StXStyle2FCSlantMap at: (style ? 'roman') ifAbsent:[StXStyle2FCSlantMap at: (style ? 'roman') asLowercase]).
+ Error handle:[:ex |
+ ^ self asNonXftFont onDevice:aGraphicsDevice
+ ] do:[
+ myPatternId := self xftPatternCreate.
+ ].
+ self xftPatternAdd: myPatternId attribute: FC_FAMILY value: family.
+ pixelSize notNil ifTrue:[
+ self xftPatternAdd: myPatternId attribute: FC_PIXEL_SIZE value: pixelSize.
+ ] ifFalse:[
+ self xftPatternAdd: myPatternId attribute: FC_SIZE value: size.
+ ].
+ self xftPatternAdd: myPatternId attribute: FC_WEIGHT value: (StXFace2FCWeightMap at: (face ? 'regular')).
+ self xftPatternAdd: myPatternId attribute: FC_SLANT value: (StXStyle2FCSlantMap at: (style ? 'roman') ifAbsent:[StXStyle2FCSlantMap at: (style ? 'roman') asLowercase]).
- newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: myPatternId.
- newFontId notNil ifTrue:[
- "/ Good, this font exists!!
- fontId := newFontId.
- device := aGraphicsDevice.
- aGraphicsDevice registerFont:self.
- RecentlyUsedFonts addFirst:self.
- ^ self.
- ] ifFalse:[
- closestPatternId1 := self xftFontMatch: aGraphicsDevice displayId screen: aGraphicsDevice screen pattern: myPatternId.
- closestPatternId1 isNil ifTrue:[
- self error: 'No font matches'.
- ].
- "
- self xftPatternGet: closestPatternId attribute: 'family' index: 0.
- self xftPatternGet: closestPatternId attribute: 'size' index: 0.
- "
- closestPatternId2 := self xftPatternDuplicate: closestPatternId1.
- newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: closestPatternId1.
- "/ !!!!!!!! closestPatternId is no longer valid !!!!!!!!
- closestPatternId1 := nil.
- newFontId isNil ifTrue:[
- self error: 'Pattern matched, but font could not be opened (should not happen)'.
- ].
+ newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: myPatternId.
+ newFontId notNil ifTrue:[
+ "/ Good, this font exists!!
+ fontId := newFontId.
+ device := aGraphicsDevice.
+ aGraphicsDevice registerFont:self.
+ RecentlyUsedFonts addFirst:self.
+ ^ self.
+ ] ifFalse:[
+ closestPatternId1 := self xftFontMatch: aGraphicsDevice displayId screen: aGraphicsDevice screen pattern: myPatternId.
+ closestPatternId1 isNil ifTrue:[
+ self error: 'No font matches'.
+ ].
+ "
+ self xftPatternGet: closestPatternId attribute: 'family' index: 0.
+ self xftPatternGet: closestPatternId attribute: 'size' index: 0.
+ "
+ closestPatternId2 := self xftPatternDuplicate: closestPatternId1.
+ newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: closestPatternId1.
+ "/ !!!!!!!! closestPatternId is no longer valid !!!!!!!!
+ closestPatternId1 := nil.
+ newFontId isNil ifTrue:[
+ self error: 'Pattern matched, but font could not be opened (should not happen)'.
+ ].
- "/ Search for existing registered font. Note, that XftFont instances
- "/ are shared (and refcounted) so newFontId = aFont getFontId is enough
- "/ to check whether some other font instance represents the same font...
- aGraphicsDevice deviceFonts do:[:aFont |
- ((self class == aFont class) and:[newFontId = aFont getFontId]) ifTrue:[
- closestFont := aFont.
- ^ closestFont
- ].
- ].
+ "/ Search for existing registered font. Note, that XftFont instances
+ "/ are shared (and refcounted) so newFontId = aFont getFontId is enough
+ "/ to check whether some other font instance represents the same font...
+ aGraphicsDevice deviceFonts do:[:aFont |
+ ((self class == aFont class) and:[newFontId = aFont getFontId]) ifTrue:[
+ closestFont := aFont.
+ ^ closestFont
+ ].
+ ].
- closestFont := self shallowCopy
- setDevice: aGraphicsDevice patternId: closestPatternId2 fontId: newFontId;
- yourself.
- aGraphicsDevice registerFont: closestFont.
- RecentlyUsedFonts addFirst:closestFont.
- ^ closestFont
- ].
+ closestFont := self shallowCopy
+ setDevice: aGraphicsDevice patternId: closestPatternId2 fontId: newFontId;
+ yourself.
+ aGraphicsDevice registerFont: closestFont.
+ RecentlyUsedFonts addFirst:closestFont.
+ ^ closestFont
+ ].
] ensure:[
- myPatternId notNil ifTrue:[self xftPatternDestroy: myPatternId].
- closestPatternId1 notNil ifTrue:[self xftPatternDestroy: closestPatternId1].
- closestPatternId2 notNil ifTrue:[self xftPatternDestroy: closestPatternId2].
+ myPatternId notNil ifTrue:[self xftPatternDestroy: myPatternId].
+ closestPatternId1 notNil ifTrue:[self xftPatternDestroy: closestPatternId1].
+ closestPatternId2 notNil ifTrue:[self xftPatternDestroy: closestPatternId2].
].
"
@@ -923,17 +959,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 notNil ifTrue:[encoding := encoding asSymbol].
+ 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>"
@@ -1126,7 +1162,7 @@
%{
#ifdef XFT
int _start, _stop;
- int _x, _y;
+ int __x, __y;
XftColor clr;
if ( ! __isExternalAddressLike(drawIdArg) ) {
error = @symbol(BadArg1);
@@ -1140,12 +1176,12 @@
error = @symbol(BadArg4);
goto err;
}
- _x = __intVal(x);
+ __x = __intVal(x);
if ( ! __isSmallInteger(y) ) {
error = @symbol(BadArg5);
goto err;
}
- _y = __intVal(y);
+ __y = __intVal(y);
if ( ! __isSmallInteger(start) ) {
@@ -1167,7 +1203,7 @@
if ( __isStringLike(text) ) {
XftDrawString8(XFT_DRAW(drawIdArg), &clr, XFT_FONT(fontIdArg),
- _x, _y,
+ __x, __y,
__stringVal(text) + (_start - 1), _stop - _start + 1);
RETURN ( self );
} else {
@@ -1633,8 +1669,10 @@
ascent
"return the ascent - the number of pixels above the baseLine."
-
- ^ self xftFontGetAscent: fontId
+ ascent isNil ifTrue:[
+ ascent := self xftFontGetAscent: fontId
+ ].
+ ^ ascent
"Created: / 21-12-2013 / 01:19:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -1642,7 +1680,10 @@
descent
"return the descent - the number of pixels below the baseLine."
- ^ self xftFontGetDescent: fontId
+ descent isNil ifTrue:[
+ descent := self xftFontGetDescent: fontId
+ ].
+ ^ descent
"Created: / 21-12-2013 / 01:20:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -1673,7 +1714,10 @@
height
"return the height - the number of pixels above plus below the baseLine."
- ^ self xftFontGetHeight: fontId
+ height isNil ifTrue:[
+ height := self xftFontGetHeight: fontId
+ ].
+ ^ height
"Created: / 21-12-2013 / 01:20:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -1724,18 +1768,18 @@
"xOff from XFTTextExtents is a signed short.
Work arond for long strings"
(stop - start + 1) * maxWidthOfSingleGlyph > 32767 ifTrue:[
- |total chunkSize|
+ |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.
- ].
+ 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.
@@ -1814,51 +1858,51 @@
list := OrderedCollection new.
readEntry :=
- [
- |key|
+ [
+ |key|
- [l startsWith:'Pattern has'] whileFalse:[
- l := pipeStream nextLine. Transcript showCR:l.
- ].
+ [l startsWith:'Pattern has'] whileFalse:[
+ l := pipeStream nextLine. Transcript showCR:l.
+ ].
- currentDescription := XftFontDescription new.
- [ l := pipeStream nextLine. l notEmptyOrNil ] whileTrue:[
- "/ Transcript showCR:l.
- lineStream := l readStream. lineStream skipSeparators.
- key := lineStream upToSeparator.
- (
- #('family:' 'style:' 'slant:' 'weight:' 'width:'
- 'pixelsize:' 'spacing:' 'foundry:' 'antialias:'
- 'file:' 'outline' 'scalable:' 'charset:' 'lang:'
- 'fontversion:' 'fontformat:' 'decorative:' 'index:'
- 'outline:' 'familylang:' 'stylelang:' 'fullname:'
- 'fullnamelang:' 'capability:' 'hash:' 'postscriptname:'
- ) includes:key
- ) ifTrue:[
- self perform:('fc_',(key allButLast)) asSymbol
- ] ifFalse:[
- Transcript show:'Xft ignored line: '; showCR:l.
- self breakPoint:#cg.
- ].
- ].
- list add:currentDescription
- ].
+ currentDescription := XftFontDescription new.
+ [ l := pipeStream nextLine. l notEmptyOrNil ] whileTrue:[
+ "/ Transcript showCR:l.
+ lineStream := l readStream. lineStream skipSeparators.
+ key := lineStream upToSeparator.
+ (
+ #('family:' 'style:' 'slant:' 'weight:' 'width:'
+ 'pixelsize:' 'spacing:' 'foundry:' 'antialias:'
+ 'file:' 'outline' 'scalable:' 'charset:' 'lang:'
+ 'fontversion:' 'fontformat:' 'decorative:' 'index:'
+ 'outline:' 'familylang:' 'stylelang:' 'fullname:'
+ 'fullnamelang:' 'capability:' 'hash:' 'postscriptname:'
+ ) includes:key
+ ) ifTrue:[
+ self perform:('fc_',(key allButLast)) asSymbol
+ ] ifFalse:[
+ Transcript show:'Xft ignored line: '; showCR:l.
+ self breakPoint:#cg.
+ ].
+ ].
+ list add:currentDescription
+ ].
fcListProg := #('/usr/bin/fc-list' '/usr/X11/bin/fc-list') detect:[:eachProg|
- eachProg asFilename isExecutableProgram
- ] ifNone:[
- 'XftFontDescription [warning]: fc-list program not found - no XFT fonts' errorPrintCR.
- ^ list.
- ].
+ eachProg asFilename isExecutableProgram
+ ] ifNone:[
+ 'XftFontDescription [warning]: fc-list program not found - no XFT fonts' errorPrintCR.
+ ^ list.
+ ].
pipeStream := PipeStream readingFrom:fcListProg, ' -v'.
[
- [pipeStream atEnd] whileFalse:[
- l := pipeStream nextLine.
- readEntry value.
- ]
+ [pipeStream atEnd] whileFalse:[
+ l := pipeStream nextLine.
+ readEntry value.
+ ]
] ensure:[
- pipeStream close
+ pipeStream close
].
^ list
@@ -2100,20 +2144,5 @@
^ (lineStream upTo:$").
! !
-!XftFontDescription class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.51.2.2 2015-01-29 09:54:04 stefan Exp $'
-!
-
-version_CVS
- ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.51.2.2 2015-01-29 09:54:04 stefan Exp $'
-!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
-! !
-
XftFontDescription initialize!
--- a/libInit.cc Thu Feb 19 06:21:17 2015 +0000
+++ b/libInit.cc Tue Mar 03 03:55:48 2015 +0000
@@ -46,6 +46,8 @@
_ResourcePack_Init(pass,__pRT__,snd);
_WindowGroup_Init(pass,__pRT__,snd);
_WindowSensor_Init(pass,__pRT__,snd);
+_DisplayTransform_Init(pass,__pRT__,snd);
+_ScaleTransform_Init(pass,__pRT__,snd);
_WindowingTransformation_Init(pass,__pRT__,snd);
_stx_137libview_Init(pass,__pRT__,snd);
_BeveledBorder_Init(pass,__pRT__,snd);
--- a/resources/cs.rs Thu Feb 19 06:21:17 2015 +0000
+++ b/resources/cs.rs Tue Mar 03 03:55:48 2015 +0000
@@ -6,7 +6,7 @@
; while cz/sk are codes for the countries.
; cs used to be also country-code for Czechoslovakia, which is withdrawn
;
-; $Header: /cvs/stx/stx/libview/resources/cs.rs,v 1.9 2008-10-10 11:34:54 cg Exp $
+; $Header: /cvs/stx/stx/libview/resources/cs.rs,v 1.10 2014-12-12 19:14:27 cg Exp $
;
; this file contains 8bit national characters;
; DONT EDIT this file with an old vi !
@@ -17,6 +17,7 @@
yes 'ano'
no 'ne'
'yes to all' 'ano pro všechny'
+'Yes to All' 'Ano pro všechny'
'no to all' 'ne pro všechny'
all 'všechny'
--- a/resources/da.rs Thu Feb 19 06:21:17 2015 +0000
+++ b/resources/da.rs Tue Mar 03 03:55:48 2015 +0000
@@ -3,7 +3,7 @@
;
; Danish
;
-; $Header: /cvs/stx/stx/libview/resources/da.rs,v 1.4 2006-10-20 15:34:31 cg Exp $
+; $Header: /cvs/stx/stx/libview/resources/da.rs,v 1.5 2014-12-12 19:14:27 cg Exp $
;
; this file may contain 8bit national characters;
; DONT EDIT this file with an old vi !
@@ -14,6 +14,7 @@
yes 'ja'
no 'nej'
'yes to all' 'ja til alt'
+'Yes to All' 'Ja til alt'
'no to all' 'nej til alt'
all 'alt'
--- a/resources/de.rs Thu Feb 19 06:21:17 2015 +0000
+++ b/resources/de.rs Tue Mar 03 03:55:48 2015 +0000
@@ -3,7 +3,7 @@
;
; German
;
-; $Header: /cvs/stx/stx/libview/resources/de.rs,v 1.52 2014-04-08 16:31:35 cg Exp $
+; $Header: /cvs/stx/stx/libview/resources/de.rs,v 1.53 2015-02-21 01:05:23 cg Exp $
;
; this file contains 8bit national characters;
; DONT EDIT this file with an old vi !
@@ -236,6 +236,7 @@
'Select Lines' 'Zeilen selektieren'
'Replace With' 'Ersetzen durch'
'Global Replace With' 'Alle ersetzen durch'
+'At Begin of Line Only' 'Nur am Zeilenanfang'
'Save contents in:' 'Inhalt sichern als:'
'Save Contents In:' 'Inhalt sichern als:'
--- a/resources/el.rs Thu Feb 19 06:21:17 2015 +0000
+++ b/resources/el.rs Tue Mar 03 03:55:48 2015 +0000
@@ -3,7 +3,7 @@
;
; Greek
;
-; $Header: /cvs/stx/stx/libview/resources/el.rs,v 1.6 2005-04-29 14:48:18 cg Exp $
+; $Header: /cvs/stx/stx/libview/resources/el.rs,v 1.7 2014-12-12 19:14:27 cg Exp $
;
; this file contains 8bit national characters;
; DONT EDIT this file with an old vi !
@@ -12,6 +12,7 @@
'no' 'ü÷é'
'no to all' 'ü÷é óå üëá'
'yes to all' 'íáß óå üëá'
+'Yes to All' 'íáß óå üëá'
; ok 'åíôÜîåé'
undo 'áíáßñåóç'
--- a/resources/eo.rs Thu Feb 19 06:21:17 2015 +0000
+++ b/resources/eo.rs Tue Mar 03 03:55:48 2015 +0000
@@ -3,13 +3,13 @@
;
; Esperanto
;
-; $Header: /cvs/stx/stx/libview/resources/eo.rs,v 1.6 2004-03-13 18:26:35 cg Exp $
+; $Header: /cvs/stx/stx/libview/resources/eo.rs,v 1.7 2014-12-12 19:14:27 cg Exp $
;
; this file contains 8bit national characters;
; DONT EDIT this file with an old vi !
-abort 'nuligu'
-cancel 'nuligu'
+abort 'nuligu'
+cancel 'nuligu'
yes 'jeso'
no 'ne'
OK 'Bone'
@@ -25,6 +25,7 @@
'no to all' 'ne por ĉiuj'
'yes to all' 'jes por ĉiuj'
+'Yes to All' 'Jes por ĉiuj'
directory 'arkivo'
folder 'ujo'
--- a/resources/fr.rs Thu Feb 19 06:21:17 2015 +0000
+++ b/resources/fr.rs Tue Mar 03 03:55:48 2015 +0000
@@ -3,16 +3,21 @@
;
; French
;
-; $Header: /cvs/stx/stx/libview/resources/fr.rs,v 1.10 2010-09-21 14:44:08 cg Exp $
+; $Header: /cvs/stx/stx/libview/resources/fr.rs,v 1.12 2014-12-12 20:08:24 cg Exp $
;
; this file contains 8bit national characters;
; DONT EDIT this file with an old vi !
+; hacked in by cg.
+; please excuse my "school"-french.
+; if you are fluid in french, I'd be happy to get
+; corrections, additions and improvements...
'yes' 'oui'
'no' 'non'
'no to all' 'non pour tous'
'yes to all' 'oui pour tous'
+'Yes to All' 'Oui pour tous'
; ok 'ok'
Ok 'D''accord'
--- a/resources/hu.rs Thu Feb 19 06:21:17 2015 +0000
+++ b/resources/hu.rs Tue Mar 03 03:55:48 2015 +0000
@@ -30,6 +30,7 @@
'yes' 'igen'
'yes to all' 'igen, mindet'
+'Yes to All' 'Igen, mindet'
'no' 'nem'
'no to all' 'Egyiket sem'
'OK' 'Rendben'
--- a/resources/pl.rs Thu Feb 19 06:21:17 2015 +0000
+++ b/resources/pl.rs Tue Mar 03 03:55:48 2015 +0000
@@ -3,7 +3,7 @@
;
; Poland
;
-; $Header: /cvs/stx/stx/libview/resources/pl.rs,v 1.3 2004-03-13 18:26:36 cg Exp $
+; $Header: /cvs/stx/stx/libview/resources/pl.rs,v 1.4 2014-12-12 19:14:27 cg Exp $
;
; this file may contain 8bit national characters;
; DONT EDIT this file with an old vi !
@@ -15,6 +15,7 @@
yes 'tak'
no 'nie'
'yes to all' 'tak na wszystko'
+'Yes to All' 'Tak na wszystko'
'no to all' 'nie na wszystko'
abort 'anuluj'
@@ -34,7 +35,7 @@
delete 'usuń'
all 'wszystko'
-; none 'nada'
+; none 'nada'
edit 'edycja'
file 'plik'
@@ -61,10 +62,10 @@
'search again' 'znajdź ponownie'
'search back' 'znajdź wstecz&e'
find 'znajdź'
-'save' 'zapisz'
-'Save Contents In' 'zapisz jako'
-'Save As' 'zapisz jako'
-'Save as' 'zapisz jako'
+'save' 'zapisz'
+'Save Contents In' 'zapisz jako'
+'Save As' 'zapisz jako'
+'Save as' 'zapisz jako'
'print' 'wydrukuj'
'SearchPattern' 'wzorzec'
--- a/resources/pt.rs Thu Feb 19 06:21:17 2015 +0000
+++ b/resources/pt.rs Tue Mar 03 03:55:48 2015 +0000
@@ -3,7 +3,7 @@
;
; Portuguese
;
-; $Header: /cvs/stx/stx/libview/resources/pt.rs,v 1.3 2004-03-12 21:57:42 cg Exp $
+; $Header: /cvs/stx/stx/libview/resources/pt.rs,v 1.4 2014-12-12 19:14:27 cg Exp $
;
; this file may contain 8bit national characters;
; DONT EDIT this file with an old vi !
@@ -14,6 +14,7 @@
yes 'sim'
no 'não'
'yes to all' 'sim para todos'
+'Yes to All' 'Sim para todos'
'no to all' 'não para todos'
abort 'cancelar'
@@ -68,9 +69,9 @@
find 'localizar'
; 'indent' 'indent'
'save' 'gravar' "/ 'guardar'
-'Save Contents In' 'gravar como' "/ 'guardar como:'
-'Save As' 'gravar como' "/ 'Guardar como'
-'Save as' 'gravar como' "/ 'Guardar como'
+'Save Contents In' 'gravar como' "/ 'guardar como:'
+'Save As' 'gravar como' "/ 'Guardar como'
+'Save as' 'gravar como' "/ 'Guardar como'
'print' 'imprimir'
'fileIn' 'leér'
; 'DoIt' 'DoIt'
--- a/resources/ro.rs Thu Feb 19 06:21:17 2015 +0000
+++ b/resources/ro.rs Tue Mar 03 03:55:48 2015 +0000
@@ -3,7 +3,7 @@
;
; Romania
;
-; $Header: /cvs/stx/stx/libview/resources/ro.rs,v 1.1 2005-04-26 07:59:16 cg Exp $
+; $Header: /cvs/stx/stx/libview/resources/ro.rs,v 1.2 2014-12-12 19:14:27 cg Exp $
;
; this file may contain 8bit national characters;
; DONT EDIT this file with an old vi !
@@ -15,6 +15,7 @@
yes 'yes'
no 'no'
'yes to all' 'yes to all'
+'Yes to All' 'Yes to all'
'no to all' 'no to all'
'ok' 'ok'
--- a/resources/sv.rs Thu Feb 19 06:21:17 2015 +0000
+++ b/resources/sv.rs Tue Mar 03 03:55:48 2015 +0000
@@ -3,7 +3,7 @@
;
; Swedish
;
-; $Header: /cvs/stx/stx/libview/resources/sv.rs,v 1.3 2004-03-12 21:57:42 cg Exp $
+; $Header: /cvs/stx/stx/libview/resources/sv.rs,v 1.4 2014-12-12 19:14:27 cg Exp $
;
; this file may contain 8bit national characters;
; DONT EDIT this file with an old vi !
@@ -41,8 +41,9 @@
'select all' 'markera allt'
'all' 'alla' "/ 'allt' ???
-'no to all' 'nej till alla'
-'yes to all' 'ja till alla'
+'no to all' 'nej till alla'
+'yes to all' 'ja till alla'
+'Yes to All' 'Ja till alla'
'edit' 'redigera'
'file' 'filer'
@@ -66,8 +67,8 @@
'save' 'lagra' "/ 'spara' ?
'save as' 'lagra som'
'Save As' 'lagra som'
-'save contents in' 'lagra som'
-'Save Contents In' 'Lagra som'
+'save contents in' 'lagra som'
+'Save Contents In' 'Lagra som'
'print' 'skriv ut'
'bold' 'fet'
--- a/resources/tr.rs Thu Feb 19 06:21:17 2015 +0000
+++ b/resources/tr.rs Tue Mar 03 03:55:48 2015 +0000
@@ -3,7 +3,7 @@
;
; Turkish
;
-; $Header: /cvs/stx/stx/libview/resources/tr.rs,v 1.3 2004-03-15 16:34:43 cg Exp $
+; $Header: /cvs/stx/stx/libview/resources/tr.rs,v 1.4 2014-12-18 15:55:56 cg Exp $
;
; this file contains 8bit national characters;
; DONT EDIT this file with an old vi !
@@ -12,7 +12,7 @@
; can someone help me ?
;
yes 'evet'
-no 'hayır'
+no 'hayır'
; abort 'abort'
; cancel 'cancel'
@@ -21,7 +21,7 @@
copy 'kopyalamak'
; cut 'cut'
-; paste 'paste'
+paste 'eklemek'
all 'hepsi'
--- a/stx_libview.st Thu Feb 19 06:21:17 2015 +0000
+++ b/stx_libview.st Tue Mar 03 03:55:48 2015 +0000
@@ -36,10 +36,31 @@
documentation
"
- Build- and package information for creation of the st/x standard library: stx_libview.
+ Package Documentation
+
This library contains low level interfaces to the underlying graphic system
- and representations of windows, colors, bitmaps etc.
+ and representations of windows, fonts, colors, bitmaps etc.
+
+ It does not contain medium level widget classes or applications/tools,
+ but instead provides a device- and operating system independent layer on top of which
+ GUI frameworks can be built.
+
+ It currently supports X11 and Windows-API.
+ Native OSX support may be an option if there is sufficient demand for it
+ (i.e. someone is willing to pay for its development).
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/stx_libview.st,v 1.82 2015-02-21 12:08:24 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/stx_libview.st,v 1.82 2015-02-21 12:08:24 cg Exp $'
+!
+
+version_HG
+ ^ '$Changeset: <not expanded> $'
! !
!stx_libview class methodsFor:'accessing - hg - settings'!
@@ -502,17 +523,3 @@
^ 'Smalltalk/X'
! !
-!stx_libview class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libview/stx_libview.st,v 1.76 2014-11-18 14:26:53 cg Exp $'
-!
-
-version_CVS
- ^ '$Header: /cvs/stx/stx/libview/stx_libview.st,v 1.76 2014-11-18 14:26:53 cg Exp $'
-!
-
-version_HG
- ^ '$Changeset: <not expanded> $'
-! !
-
--- a/styles/Adwaita.style Thu Feb 19 06:21:17 2015 +0000
+++ b/styles/Adwaita.style Tue Mar 03 03:55:48 2015 +0000
@@ -1,6 +1,6 @@
; View defaultStyle:#Adwaita
;
-; $Header: /cvs/stx/stx/libview/styles/Adwaita.style,v 1.4 2015/02/19 06:16:11 vrany Exp $
+; $Header: /cvs/stx/stx/libview/styles/Adwaita.style,v 1.8 2015-02-27 16:11:03 cg Exp $
name #Adwaita
scroller.vista3DStyle false
@@ -9,15 +9,15 @@
previewFileName 'viewStyleSample_adwaita.png'
#if (Language == #german) or:[Language == #de]
-comment 'an GNOME3 Adwaita angelehnter Stil (unvollständig)'
+comment 'an GNOME3 Adwaita angelehnter Stil (unvollstndig)'
#endif
#if (Language == #french) or:[Language == #fr]
-comment 'Un style qui résemble GNOME3 Adwaita (incomplet)'
+comment 'Un style qui rsemble GNOME3 Adwaita (incomplet)'
#endif
-ToolbarIconLibrary ?(Smalltalk at:#VistaToolbarIconLibrary) ? (Smalltalk at:#XPToolbarIconLibrary) ? GenericToolbarIconLibrary
+ToolbarIconLibrary ?(Smalltalk at:#AdwaitaToolbarIconLibrary) ? (Smalltalk at:#VistaToolbarIconLibrary) ? (Smalltalk at:#XPToolbarIconLibrary) ? GenericToolbarIconLibrary
useQuestForHelp false
;
@@ -69,17 +69,17 @@
menu.enteredForegroundColor =menu.hilightForegroundColor
menu.iconIndicationOn.bitmapFile 'CheckOn_xp.xpm'
menu.iconIndicationOff.bitmapFile 'CheckOff_xp.xpm'
-menu.iconRadioOn.bitmap (VistaToolbarIconLibrary radioOn12x12Icon)
-menu.iconRadioOff.bitmap (VistaToolbarIconLibrary radioOff12x12Icon)
+menu.iconRadioOn.bitmap (ToolbarIconLibrary radioOnIcon)
+menu.iconRadioOff.bitmap (ToolbarIconLibrary radioOffIcon)
menu.iconDisabledIndicationOn.bitmapFile 'CheckOn_disabled_xp.xpm'
menu.iconDisabledIndicationOff.bitmapFile 'CheckOff_disabled_xp.xpm'
-menu.iconDisabledRadioOn.bitmap (VistaToolbarIconLibrary radioOnDisabled12x12Icon)
-menu.iconDisabledRadioOff.bitmap (VistaToolbarIconLibrary radioOffDisabled12x12Icon)
+menu.iconDisabledRadioOn.bitmap (ToolbarIconLibrary radioOnDisabledIcon)
+menu.iconDisabledRadioOff.bitmap (ToolbarIconLibrary radioOffDisabledIcon)
-menu.iconIndicationOn [VistaToolbarIconLibrary checkToggleOnIcon]
-menu.iconIndicationOff [VistaToolbarIconLibrary checkToggleOffIcon]
-menu.iconDisabledIndicationOn [VistaToolbarIconLibrary checkToggleOffDisabledIcon]
-menu.iconDisabledIndicationOff [VistaToolbarIconLibrary checkToggleOffIcon]
+menu.iconIndicationOn [ToolbarIconLibrary checkToggleOnIcon]
+menu.iconIndicationOff [ToolbarIconLibrary checkToggleOffIcon]
+menu.iconDisabledIndicationOn [ToolbarIconLibrary checkToggleOffDisabledIcon]
+menu.iconDisabledIndicationOff [ToolbarIconLibrary checkToggleOffIcon]
pullDownMenu.level 0
@@ -89,10 +89,10 @@
;button.passiveLevel 3
;button.enteredBackgroundColor [ (Screen current getSystemColor:#'COLOR_BTNFACE') lightened ]
-comboView.downForm [VistaToolbarIconLibrary scrollDownOffIcon]
-comboView.disabledDownForm [VistaToolbarIconLibrary scrollDownOffIcon]
-comboView.enteredDownForm [VistaToolbarIconLibrary scrollDownOffEntered2Icon]
-comboView.activeDownForm [VistaToolbarIconLibrary scrollDownActiveIcon]
+comboView.downForm [ToolbarIconLibrary scrollDownOffIcon]
+comboView.disabledDownForm [ToolbarIconLibrary scrollDownOffIcon]
+comboView.enteredDownForm [ToolbarIconLibrary scrollDownOffEntered2Icon]
+comboView.activeDownForm [ToolbarIconLibrary scrollDownActiveIcon]
; comboView.downFormFile 'ComboDn_xp.xpm'.
; comboView.disabledDownFormFile 'ComboDn_disabled_xp.xpm'.
; comboView.activeDownFormFile 'ComboDn_active_xp.xpm'.
@@ -131,25 +131,25 @@
miniScroller.size 3 "/ in millimeters
-arrowButton.upForm [VistaToolbarIconLibrary scrollUpOffIcon]
-arrowButton.enteredUpForm [VistaToolbarIconLibrary scrollUpOffEntered2Icon]
-arrowButton.activeUpForm [VistaToolbarIconLibrary scrollUpActiveIcon]
-arrowButton.disabledUpForm [VistaToolbarIconLibrary scrollUpOffIcon]
+arrowButton.upForm [ToolbarIconLibrary scrollUpOffIcon]
+arrowButton.enteredUpForm [ToolbarIconLibrary scrollUpOffEntered2Icon]
+arrowButton.activeUpForm [ToolbarIconLibrary scrollUpActiveIcon]
+arrowButton.disabledUpForm [ToolbarIconLibrary scrollUpOffIcon]
-arrowButton.downForm [VistaToolbarIconLibrary scrollDownOffIcon]
-arrowButton.enteredDownForm [VistaToolbarIconLibrary scrollDownOffEntered2Icon]
-arrowButton.activeDownForm [VistaToolbarIconLibrary scrollDownActiveIcon]
-arrowButton.disabledDownForm [VistaToolbarIconLibrary scrollDownOffIcon]
+arrowButton.downForm [ToolbarIconLibrary scrollDownOffIcon]
+arrowButton.enteredDownForm [ToolbarIconLibrary scrollDownOffEntered2Icon]
+arrowButton.activeDownForm [ToolbarIconLibrary scrollDownActiveIcon]
+arrowButton.disabledDownForm [ToolbarIconLibrary scrollDownOffIcon]
-arrowButton.leftForm [VistaToolbarIconLibrary scrollLeftOffIcon]
-arrowButton.enteredLeftForm [VistaToolbarIconLibrary scrollLeftOffEntered2Icon]
-arrowButton.activeLeftForm [VistaToolbarIconLibrary scrollLeftActiveIcon]
-arrowButton.disabledLeftForm [VistaToolbarIconLibrary scrollLeftOffIcon]
+arrowButton.leftForm [ToolbarIconLibrary scrollLeftOffIcon]
+arrowButton.enteredLeftForm [ToolbarIconLibrary scrollLeftOffEntered2Icon]
+arrowButton.activeLeftForm [ToolbarIconLibrary scrollLeftActiveIcon]
+arrowButton.disabledLeftForm [ToolbarIconLibrary scrollLeftOffIcon]
-arrowButton.rightForm [VistaToolbarIconLibrary scrollRightOffIcon]
-arrowButton.enteredRightForm [VistaToolbarIconLibrary scrollRightOffEntered2Icon]
-arrowButton.activeRightForm [VistaToolbarIconLibrary scrollRightActiveIcon]
-arrowButton.disabledRightForm [VistaToolbarIconLibrary scrollRightOffIcon]
+arrowButton.rightForm [ToolbarIconLibrary scrollRightOffIcon]
+arrowButton.enteredRightForm [ToolbarIconLibrary scrollRightOffEntered2Icon]
+arrowButton.activeRightForm [ToolbarIconLibrary scrollRightActiveIcon]
+arrowButton.disabledRightForm [ToolbarIconLibrary scrollRightOffIcon]
arrowButton.leftFormFile 'ScrollLt.xp.xpm'
@@ -179,18 +179,18 @@
checkToggle.bitmapFile 'CheckOn10_xp.xpm'
-radioButton.passiveImage [VistaToolbarIconLibrary radioOff12x12Icon]
-radioButton.activeImage [VistaToolbarIconLibrary radioOn12x12Icon]
-radioButton.enteredPassiveImage [VistaToolbarIconLibrary radioOffEntered12x12Icon]
-radioButton.enteredActiveImage [VistaToolbarIconLibrary radioOnEntered12x12Icon]
-radioButton.disabledPassiveImage [VistaToolbarIconLibrary radioOffDisabled12x12Icon]
-radioButton.disabledActiveImage [VistaToolbarIconLibrary radioOnDisabled12x12Icon]
-checkToggle.disabledActiveImage [VistaToolbarIconLibrary checkToggleOnDisabledIcon]
-checkToggle.disabledPassiveImage [VistaToolbarIconLibrary checkToggleOffDisabledIcon]
-checkToggle.activeImage [VistaToolbarIconLibrary checkToggleOnIcon]
-checkToggle.passiveImage [VistaToolbarIconLibrary checkToggleOffIcon]
-checkToggle.enteredPassiveImage [VistaToolbarIconLibrary checkToggleOffEnteredIcon]
-checkToggle.enteredActiveImage [VistaToolbarIconLibrary checkToggleOnEnteredIcon]
+radioButton.passiveImage [ToolbarIconLibrary radioOffIcon]
+radioButton.activeImage [ToolbarIconLibrary radioOnIcon]
+radioButton.enteredPassiveImage [ToolbarIconLibrary radioOffEnteredIcon]
+radioButton.enteredActiveImage [ToolbarIconLibrary radioOnEnteredIcon]
+radioButton.disabledPassiveImage [ToolbarIconLibrary radioOffDisabledIcon]
+radioButton.disabledActiveImage [ToolbarIconLibrary radioOnDisabledIcon]
+checkToggle.disabledActiveImage [ToolbarIconLibrary checkToggleOnDisabledIcon]
+checkToggle.disabledPassiveImage [ToolbarIconLibrary checkToggleOffDisabledIcon]
+checkToggle.activeImage [ToolbarIconLibrary checkToggleOnIcon]
+checkToggle.passiveImage [ToolbarIconLibrary checkToggleOffIcon]
+checkToggle.enteredPassiveImage [ToolbarIconLibrary checkToggleOffEnteredIcon]
+checkToggle.enteredActiveImage [ToolbarIconLibrary checkToggleOnEnteredIcon]
checkToggle.activeLevel 0
checkToggle.passiveLevel 0
checkToggle.disabledBackgroundColor =viewGrey
@@ -241,5 +241,5 @@
scrolledView.level 0
; See https://developer.gnome.org/hig/stable/dialogs.html.en
-dialogBox.okAtLeft false
+dialogBox.okAtLeft (OperatingSystem isOSXlike) "false"
horizontalPanel.okCancelBox #fitSpace