--- a/Form.st Fri Oct 28 04:16:56 1994 +0100
+++ b/Form.st Fri Oct 28 04:20:20 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -13,20 +13,20 @@
DeviceDrawable subclass:#Form
instanceVariableNames:'depth localColorMap offset data fileName'
classVariableNames:'VeryLightGreyForm LightGreyForm GreyForm
- DarkGreyForm VeryDarkGreyForm
+ DarkGreyForm VeryDarkGreyForm
- AdditionalBitmapDirectoryNames
- BlackAndWhiteColorMap DitherPatternArray
- Lobby'
+ AdditionalBitmapDirectoryNames
+ BlackAndWhiteColorMap DitherPatternArray
+ Lobby'
poolDictionaries:''
category:'Graphics-Display Objects'
!
Form comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview/Form.st,v 1.12 1994-10-10 02:30:26 claus Exp $
+$Header: /cvs/stx/stx/libview/Form.st,v 1.13 1994-10-28 03:18:55 claus Exp $
'!
!Form class methodsFor:'documentation'!
@@ -34,7 +34,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Form.st,v 1.12 1994-10-10 02:30:26 claus Exp $
+$Header: /cvs/stx/stx/libview/Form.st,v 1.13 1994-10-28 03:18:55 claus Exp $
"
!
@@ -66,14 +66,14 @@
and Lobby to keep track of dead forms"
AdditionalBitmapDirectoryNames isNil ifTrue:[
- super initialize.
+ super initialize.
- AdditionalBitmapDirectoryNames := #('/usr/lib/X11/bitmaps').
+ AdditionalBitmapDirectoryNames := #('/usr/lib/X11/bitmaps').
- Lobby := Registry new.
+ Lobby := Registry new.
- "want to be informed when returning from snapshot"
- ObjectMemory addDependent:self.
+ "want to be informed when returning from snapshot"
+ ObjectMemory addDependent:self.
]
!
@@ -82,11 +82,11 @@
have all background bitmaps at hand, when views are restored"
Lobby contentsDo:[:aForm |
- (aForm device == aDevice) ifTrue:[
- "now, try to recreate it"
- aForm recreate.
- Lobby changed:aForm
- ]
+ (aForm device == aDevice) ifTrue:[
+ "now, try to recreate it"
+ aForm recreate.
+ Lobby changed:aForm
+ ]
]
!
@@ -94,17 +94,17 @@
"sent just before snapOut and just after a snapIn"
(something == #save) ifTrue:[
- "get all bits from the device into saveable arrays"
- Lobby contentsDo:[:aForm |
- aForm getBits
- ]
+ "get all bits from the device into saveable arrays"
+ Lobby contentsDo:[:aForm |
+ aForm getBits
+ ]
].
(something == #restarted) ifTrue:[
- "remove all left-over device info"
- Lobby contentsDo:[:aForm |
- aForm restored.
- Lobby changed:self
- ]
+ "remove all left-over device info"
+ Lobby contentsDo:[:aForm |
+ aForm restored.
+ Lobby changed:self
+ ]
]
! !
@@ -141,10 +141,10 @@
"some Form has been collected - tell it to the x-server"
drawableId notNil ifTrue:[
- device destroyPixmap:drawableId.
- gcId notNil ifTrue:[
- device destroyGC:gcId
- ]
+ device destroyPixmap:drawableId.
+ gcId notNil ifTrue:[
+ device destroyGC:gcId
+ ]
]
! !
@@ -162,17 +162,17 @@
aStream := Smalltalk systemFileStreamFor:('bitmaps/' , fileName).
aStream notNil ifTrue:[
- path := aStream pathName.
- aStream close.
- ^ path
+ path := aStream pathName.
+ aStream close.
+ ^ path
].
AdditionalBitmapDirectoryNames notNil ifTrue:[
- AdditionalBitmapDirectoryNames do:[:aPath |
- path := aPath , '/' , fileName.
- (OperatingSystem isReadable:path) ifTrue:[
- ^ path
- ]
- ]
+ AdditionalBitmapDirectoryNames do:[:aPath |
+ path := aPath , '/' , fileName.
+ (OperatingSystem isReadable:path) ifTrue:[
+ ^ path
+ ]
+ ]
].
^ nil
! !
@@ -195,12 +195,12 @@
|f|
((aDevice == Display) and:[GreyForm notNil]) ifTrue:[
- ^ GreyForm
+ ^ GreyForm
].
f := self width:8 height:4 fromArray:(self greyFormBits) on:aDevice.
(aDevice == Display) ifTrue:[
- GreyForm := f
+ GreyForm := f
].
^ f
!
@@ -211,12 +211,12 @@
|f|
((aDevice == Display) and:[VeryLightGreyForm notNil]) ifTrue:[
- ^ VeryLightGreyForm
+ ^ VeryLightGreyForm
].
f := self width:8 height:4 fromArray:(self veryLightGreyFormBits) on:aDevice.
(aDevice == Display) ifTrue:[
- VeryLightGreyForm := f
+ VeryLightGreyForm := f
].
^ f
!
@@ -227,12 +227,12 @@
|f|
((aDevice == Display) and:[LightGreyForm notNil]) ifTrue:[
- ^ LightGreyForm
+ ^ LightGreyForm
].
f := self width:8 height:4 fromArray:(self lightGreyFormBits) on:aDevice.
(aDevice == Display) ifTrue:[
- LightGreyForm := f
+ LightGreyForm := f
].
^ f
!
@@ -243,12 +243,12 @@
|f|
((aDevice == Display) and:[DarkGreyForm notNil]) ifTrue:[
- ^ DarkGreyForm
+ ^ DarkGreyForm
].
f := self width:8 height:4 fromArray:(self darkGreyFormBits) on:aDevice.
(aDevice == Display) ifTrue:[
- DarkGreyForm := f
+ DarkGreyForm := f
].
^ f
!
@@ -259,12 +259,12 @@
|f|
((aDevice == Display) and:[VeryDarkGreyForm notNil]) ifTrue:[
- ^ VeryDarkGreyForm
+ ^ VeryDarkGreyForm
].
f := self width:8 height:4 fromArray:(self veryDarkGreyFormBits) on:aDevice.
(aDevice == Display) ifTrue:[
- VeryDarkGreyForm := f
+ VeryDarkGreyForm := f
].
^ f
! !
@@ -410,14 +410,14 @@
|sel|
DitherPatternArray isNil ifTrue:[
- DitherPatternArray := Array new:63.
- 1 to:63 do:[:i |
- "
- compute the selector as #'dither<n>in64'
- "
- sel := ('dither' , i printString , 'in64') asSymbol.
- DitherPatternArray at:i put:(self perform:sel)
- ]
+ DitherPatternArray := Array new:63.
+ 1 to:63 do:[:i |
+ "
+ compute the selector as #'dither<n>in64'
+ "
+ sel := ('dither' , i printString , 'in64') asSymbol.
+ DitherPatternArray at:i put:(self perform:sel)
+ ]
].
^ DitherPatternArray at:x
!
@@ -426,910 +426,910 @@
"return a pattern for dithering"
^ #[2r10000000
- 2r00000000
- 2r00000000
- 2r00000000
- 2r00000000
- 2r00000000
- 2r00000000
- 2r00000000]
+ 2r00000000
+ 2r00000000
+ 2r00000000
+ 2r00000000
+ 2r00000000
+ 2r00000000
+ 2r00000000]
!
dither2in64
"return a pattern for dithering"
^ #[2r10000000
- 2r00000000
- 2r00000000
- 2r00000000
- 2r00001000
- 2r00000000
- 2r00000000
- 2r00000000]
+ 2r00000000
+ 2r00000000
+ 2r00000000
+ 2r00001000
+ 2r00000000
+ 2r00000000
+ 2r00000000]
!
dither3in64
"return a pattern for dithering"
^ #[2r10000000
- 2r00000000
- 2r00000000
- 2r00000000
- 2r10001000
- 2r00000000
- 2r00000000
- 2r00000000]
+ 2r00000000
+ 2r00000000
+ 2r00000000
+ 2r10001000
+ 2r00000000
+ 2r00000000
+ 2r00000000]
!
dither4in64
"return a pattern for dithering"
^ #[2r10001000
- 2r00000000
- 2r00000000
- 2r00000000
- 2r10001000
- 2r00000000
- 2r00000000
- 2r00000000]
+ 2r00000000
+ 2r00000000
+ 2r00000000
+ 2r10001000
+ 2r00000000
+ 2r00000000
+ 2r00000000]
!
dither5in64
"return a pattern for dithering"
^ #[2r10001000
- 2r00000000
- 2r00000000
- 2r00000000
- 2r10001000
- 2r00000000
- 2r00000010
- 2r00000000]
+ 2r00000000
+ 2r00000000
+ 2r00000000
+ 2r10001000
+ 2r00000000
+ 2r00000010
+ 2r00000000]
!
dither6in64
"return a pattern for dithering"
^ #[2r10001000
- 2r00000000
- 2r00100000
- 2r00000000
- 2r10001000
- 2r00000000
- 2r00000010
- 2r00000000]
+ 2r00000000
+ 2r00100000
+ 2r00000000
+ 2r10001000
+ 2r00000000
+ 2r00000010
+ 2r00000000]
!
dither7in64
"return a pattern for dithering"
^ #[2r10001000
- 2r00000000
- 2r00100010
- 2r00000000
- 2r10001000
- 2r00000000
- 2r00000010
- 2r00000000]
+ 2r00000000
+ 2r00100010
+ 2r00000000
+ 2r10001000
+ 2r00000000
+ 2r00000010
+ 2r00000000]
!
dither8in64
"return a pattern for dithering"
^ #[2r10001000
- 2r00000000
- 2r00100010
- 2r00000000
- 2r10001000
- 2r00000000
- 2r00100010
- 2r00000000]
+ 2r00000000
+ 2r00100010
+ 2r00000000
+ 2r10001000
+ 2r00000000
+ 2r00100010
+ 2r00000000]
!
dither9in64
"return a pattern for dithering"
^ #[2r10001000
- 2r00000000
- 2r00100010
- 2r00000000
- 2r10001000
- 2r00000000
- 2r10100010
- 2r00000000]
+ 2r00000000
+ 2r00100010
+ 2r00000000
+ 2r10001000
+ 2r00000000
+ 2r10100010
+ 2r00000000]
!
dither10in64
"return a pattern for dithering"
^ #[2r10001000
- 2r00000000
- 2r00101010
- 2r00000000
- 2r10001000
- 2r00000000
- 2r10100010
- 2r00000000]
+ 2r00000000
+ 2r00101010
+ 2r00000000
+ 2r10001000
+ 2r00000000
+ 2r10100010
+ 2r00000000]
!
dither11in64
"return a pattern for dithering"
^ #[2r10001000
- 2r00000000
- 2r00101010
- 2r00000000
- 2r10001000
- 2r00000000
- 2r10101010
- 2r00000000]
+ 2r00000000
+ 2r00101010
+ 2r00000000
+ 2r10001000
+ 2r00000000
+ 2r10101010
+ 2r00000000]
!
dither12in64
"return a pattern for dithering"
^ #[2r10001000
- 2r00000000
- 2r10101010
- 2r00000000
- 2r10001000
- 2r00000000
- 2r10101010
- 2r00000000]
+ 2r00000000
+ 2r10101010
+ 2r00000000
+ 2r10001000
+ 2r00000000
+ 2r10101010
+ 2r00000000]
!
dither13in64
"return a pattern for dithering"
^ #[2r10001000
- 2r00000000
- 2r10101010
- 2r00000000
- 2r10101000
- 2r00000000
- 2r10101010
- 2r00000000]
+ 2r00000000
+ 2r10101010
+ 2r00000000
+ 2r10101000
+ 2r00000000
+ 2r10101010
+ 2r00000000]
!
dither14in64
"return a pattern for dithering"
^ #[2r10001010
- 2r00000000
- 2r10101010
- 2r00000000
- 2r10101000
- 2r00000000
- 2r10101010
- 2r00000000]
+ 2r00000000
+ 2r10101010
+ 2r00000000
+ 2r10101000
+ 2r00000000
+ 2r10101010
+ 2r00000000]
!
dither15in64
"return a pattern for dithering"
^ #[2r10001010
- 2r00000000
- 2r10101010
- 2r00000000
- 2r10101010
- 2r00000000
- 2r10101010
- 2r00000000]
+ 2r00000000
+ 2r10101010
+ 2r00000000
+ 2r10101010
+ 2r00000000
+ 2r10101010
+ 2r00000000]
!
dither16in64
"return a pattern for dithering"
^ #[2r10101010
- 2r00000000
- 2r10101010
- 2r00000000
- 2r10101010
- 2r00000000
- 2r10101010
- 2r00000000]
+ 2r00000000
+ 2r10101010
+ 2r00000000
+ 2r10101010
+ 2r00000000
+ 2r10101010
+ 2r00000000]
!
dither17in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000000
- 2r10101010
- 2r00000000
- 2r10101010
- 2r00000000
- 2r10101010
- 2r00000000]
+ 2r01000000
+ 2r10101010
+ 2r00000000
+ 2r10101010
+ 2r00000000
+ 2r10101010
+ 2r00000000]
!
dither18in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000000
- 2r10101010
- 2r00000000
- 2r10101010
- 2r00000100
- 2r10101010
- 2r00000000]
+ 2r01000000
+ 2r10101010
+ 2r00000000
+ 2r10101010
+ 2r00000100
+ 2r10101010
+ 2r00000000]
!
dither19in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000000
- 2r10101010
- 2r00000000
- 2r10101010
- 2r01000100
- 2r10101010
- 2r00000000]
+ 2r01000000
+ 2r10101010
+ 2r00000000
+ 2r10101010
+ 2r01000100
+ 2r10101010
+ 2r00000000]
!
dither20in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000100
- 2r10101010
- 2r00000000
- 2r10101010
- 2r01000100
- 2r10101010
- 2r00000000]
+ 2r01000100
+ 2r10101010
+ 2r00000000
+ 2r10101010
+ 2r01000100
+ 2r10101010
+ 2r00000000]
!
dither21in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000100
- 2r10101010
- 2r00000000
- 2r10101010
- 2r01000100
- 2r10101010
- 2r00000001]
+ 2r01000100
+ 2r10101010
+ 2r00000000
+ 2r10101010
+ 2r01000100
+ 2r10101010
+ 2r00000001]
!
dither22in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000100
- 2r10101010
- 2r00010000
- 2r10101010
- 2r01000100
- 2r10101010
- 2r00000001]
+ 2r01000100
+ 2r10101010
+ 2r00010000
+ 2r10101010
+ 2r01000100
+ 2r10101010
+ 2r00000001]
!
dither23in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000100
- 2r10101010
- 2r00010001
- 2r10101010
- 2r01000100
- 2r10101010
- 2r00000001]
+ 2r01000100
+ 2r10101010
+ 2r00010001
+ 2r10101010
+ 2r01000100
+ 2r10101010
+ 2r00000001]
!
dither24in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000100
- 2r10101010
- 2r00010001
- 2r10101010
- 2r01000100
- 2r10101010
- 2r00010001]
+ 2r01000100
+ 2r10101010
+ 2r00010001
+ 2r10101010
+ 2r01000100
+ 2r10101010
+ 2r00010001]
!
dither25in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000100
- 2r10101010
- 2r00010001
- 2r10101010
- 2r01000100
- 2r10101010
- 2r01010001]
+ 2r01000100
+ 2r10101010
+ 2r00010001
+ 2r10101010
+ 2r01000100
+ 2r10101010
+ 2r01010001]
!
dither26in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000100
- 2r10101010
- 2r00010101
- 2r10101010
- 2r01000100
- 2r10101010
- 2r01010001]
+ 2r01000100
+ 2r10101010
+ 2r00010101
+ 2r10101010
+ 2r01000100
+ 2r10101010
+ 2r01010001]
!
dither27in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000100
- 2r10101010
- 2r00010101
- 2r10101010
- 2r01000100
- 2r10101010
- 2r01010101]
+ 2r01000100
+ 2r10101010
+ 2r00010101
+ 2r10101010
+ 2r01000100
+ 2r10101010
+ 2r01010101]
!
dither28in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000100
- 2r10101010
- 2r01010101
- 2r10101010
- 2r01000100
- 2r10101010
- 2r01010101]
+ 2r01000100
+ 2r10101010
+ 2r01010101
+ 2r10101010
+ 2r01000100
+ 2r10101010
+ 2r01010101]
!
dither29in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000100
- 2r10101010
- 2r01010101
- 2r10101010
- 2r01010100
- 2r10101010
- 2r01010101]
+ 2r01000100
+ 2r10101010
+ 2r01010101
+ 2r10101010
+ 2r01010100
+ 2r10101010
+ 2r01010101]
!
dither30in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000101
- 2r10101010
- 2r01010101
- 2r10101010
- 2r01010100
- 2r10101010
- 2r01010101]
+ 2r01000101
+ 2r10101010
+ 2r01010101
+ 2r10101010
+ 2r01010100
+ 2r10101010
+ 2r01010101]
!
dither31in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01000101
- 2r10101010
- 2r01010101
- 2r10101010
- 2r01010101
- 2r10101010
- 2r01010101]
+ 2r01000101
+ 2r10101010
+ 2r01010101
+ 2r10101010
+ 2r01010101
+ 2r10101010
+ 2r01010101]
!
dither32in64
"return a pattern for dithering"
^ #[2r10101010
- 2r01010101
- 2r10101010
- 2r01010101
- 2r10101010
- 2r01010101
- 2r10101010
- 2r01010101]
+ 2r01010101
+ 2r10101010
+ 2r01010101
+ 2r10101010
+ 2r01010101
+ 2r10101010
+ 2r01010101]
!
dither33in64
"return a pattern for dithering"
^ #[2r11101010
- 2r01010101
- 2r10101010
- 2r01010101
- 2r10101010
- 2r01010101
- 2r10101010
- 2r01010101]
+ 2r01010101
+ 2r10101010
+ 2r01010101
+ 2r10101010
+ 2r01010101
+ 2r10101010
+ 2r01010101]
!
dither34in64
"return a pattern for dithering"
^ #[2r11101010
- 2r01010101
- 2r10101010
- 2r01010101
- 2r10101110
- 2r01010101
- 2r10101010
- 2r01010101]
+ 2r01010101
+ 2r10101010
+ 2r01010101
+ 2r10101110
+ 2r01010101
+ 2r10101010
+ 2r01010101]
!
dither35in64
"return a pattern for dithering"
^ #[2r11101010
- 2r01010101
- 2r10101010
- 2r01010101
- 2r11101110
- 2r01010101
- 2r10101010
- 2r01010101]
+ 2r01010101
+ 2r10101010
+ 2r01010101
+ 2r11101110
+ 2r01010101
+ 2r10101010
+ 2r01010101]
!
dither36in64
"return a pattern for dithering"
^ #[2r11101110
- 2r01010101
- 2r10101010
- 2r01010101
- 2r11101110
- 2r01010101
- 2r10101010
- 2r01010101]
+ 2r01010101
+ 2r10101010
+ 2r01010101
+ 2r11101110
+ 2r01010101
+ 2r10101010
+ 2r01010101]
!
dither37in64
"return a pattern for dithering"
^ #[2r11101110
- 2r01010101
- 2r10101010
- 2r01010101
- 2r11101110
- 2r01010101
- 2r10101011
- 2r01010101]
+ 2r01010101
+ 2r10101010
+ 2r01010101
+ 2r11101110
+ 2r01010101
+ 2r10101011
+ 2r01010101]
!
dither38in64
"return a pattern for dithering"
^ #[2r11101110
- 2r01010101
- 2r10111010
- 2r01010101
- 2r11101110
- 2r01010101
- 2r10101011
- 2r01010101]
+ 2r01010101
+ 2r10111010
+ 2r01010101
+ 2r11101110
+ 2r01010101
+ 2r10101011
+ 2r01010101]
!
dither39in64
"return a pattern for dithering"
^ #[2r11101110
- 2r01010101
- 2r10111011
- 2r01010101
- 2r11101110
- 2r01010101
- 2r10101011
- 2r01010101]
+ 2r01010101
+ 2r10111011
+ 2r01010101
+ 2r11101110
+ 2r01010101
+ 2r10101011
+ 2r01010101]
!
dither40in64
"return a pattern for dithering"
^ #[2r11101110
- 2r01010101
- 2r10111011
- 2r01010101
- 2r11101110
- 2r01010101
- 2r10111011
- 2r01010101]
+ 2r01010101
+ 2r10111011
+ 2r01010101
+ 2r11101110
+ 2r01010101
+ 2r10111011
+ 2r01010101]
!
dither41in64
"return a pattern for dithering"
^ #[2r11101110
- 2r01010101
- 2r10111011
- 2r01010101
- 2r11101110
- 2r01010101
- 2r11111011
- 2r01010101]
+ 2r01010101
+ 2r10111011
+ 2r01010101
+ 2r11101110
+ 2r01010101
+ 2r11111011
+ 2r01010101]
!
dither42in64
"return a pattern for dithering"
^ #[2r11101110
- 2r01010101
- 2r10111111
- 2r01010101
- 2r11101110
- 2r01010101
- 2r11111011
- 2r01010101]
+ 2r01010101
+ 2r10111111
+ 2r01010101
+ 2r11101110
+ 2r01010101
+ 2r11111011
+ 2r01010101]
!
dither43in64
"return a pattern for dithering"
^ #[2r11101110
- 2r01010101
- 2r10111111
- 2r01010101
- 2r11101110
- 2r01010101
- 2r11111111
- 2r01010101]
+ 2r01010101
+ 2r10111111
+ 2r01010101
+ 2r11101110
+ 2r01010101
+ 2r11111111
+ 2r01010101]
!
dither44in64
"return a pattern for dithering"
^ #[2r11101110
- 2r01010101
- 2r11111111
- 2r01010101
- 2r11101110
- 2r01010101
- 2r11111111
- 2r01010101]
+ 2r01010101
+ 2r11111111
+ 2r01010101
+ 2r11101110
+ 2r01010101
+ 2r11111111
+ 2r01010101]
!
dither45in64
"return a pattern for dithering"
^ #[2r11101110
- 2r01010101
- 2r11111111
- 2r01010101
- 2r11111110
- 2r01010101
- 2r11111111
- 2r01010101]
+ 2r01010101
+ 2r11111111
+ 2r01010101
+ 2r11111110
+ 2r01010101
+ 2r11111111
+ 2r01010101]
!
dither46in64
"return a pattern for dithering"
^ #[2r11101111
- 2r01010101
- 2r11111111
- 2r01010101
- 2r11111110
- 2r01010101
- 2r11111111
- 2r01010101]
+ 2r01010101
+ 2r11111111
+ 2r01010101
+ 2r11111110
+ 2r01010101
+ 2r11111111
+ 2r01010101]
!
dither47in64
"return a pattern for dithering"
^ #[2r11101111
- 2r01010101
- 2r11111111
- 2r01010101
- 2r11111111
- 2r01010101
- 2r11111111
- 2r01010101]
+ 2r01010101
+ 2r11111111
+ 2r01010101
+ 2r11111111
+ 2r01010101
+ 2r11111111
+ 2r01010101]
!
dither48in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01010101
- 2r11111111
- 2r01010101
- 2r11111111
- 2r01010101
- 2r11111111
- 2r01010101]
+ 2r01010101
+ 2r11111111
+ 2r01010101
+ 2r11111111
+ 2r01010101
+ 2r11111111
+ 2r01010101]
!
dither49in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110101
- 2r11111111
- 2r01010101
- 2r11111111
- 2r01010101
- 2r11111111
- 2r01010101]
+ 2r01110101
+ 2r11111111
+ 2r01010101
+ 2r11111111
+ 2r01010101
+ 2r11111111
+ 2r01010101]
!
dither50in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110101
- 2r11111111
- 2r01010101
- 2r11111111
- 2r01010111
- 2r11111111
- 2r01010101]
+ 2r01110101
+ 2r11111111
+ 2r01010101
+ 2r11111111
+ 2r01010111
+ 2r11111111
+ 2r01010101]
!
dither51in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110101
- 2r11111111
- 2r01010101
- 2r11111111
- 2r01110111
- 2r11111111
- 2r01010101]
+ 2r01110101
+ 2r11111111
+ 2r01010101
+ 2r11111111
+ 2r01110111
+ 2r11111111
+ 2r01010101]
!
dither52in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110111
- 2r11111111
- 2r01010101
- 2r11111111
- 2r01110111
- 2r11111111
- 2r01010101]
+ 2r01110111
+ 2r11111111
+ 2r01010101
+ 2r11111111
+ 2r01110111
+ 2r11111111
+ 2r01010101]
!
dither53in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110111
- 2r11111111
- 2r01010101
- 2r11111111
- 2r01110111
- 2r11111111
- 2r11010101]
+ 2r01110111
+ 2r11111111
+ 2r01010101
+ 2r11111111
+ 2r01110111
+ 2r11111111
+ 2r11010101]
!
dither54in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110111
- 2r11111111
- 2r01011101
- 2r11111111
- 2r01110111
- 2r11111111
- 2r11010101]
+ 2r01110111
+ 2r11111111
+ 2r01011101
+ 2r11111111
+ 2r01110111
+ 2r11111111
+ 2r11010101]
!
dither55in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110111
- 2r11111111
- 2r11011101
- 2r11111111
- 2r01110111
- 2r11111111
- 2r11010101]
+ 2r01110111
+ 2r11111111
+ 2r11011101
+ 2r11111111
+ 2r01110111
+ 2r11111111
+ 2r11010101]
!
dither56in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110111
- 2r11111111
- 2r11011101
- 2r11111111
- 2r01110111
- 2r11111111
- 2r11011101]
+ 2r01110111
+ 2r11111111
+ 2r11011101
+ 2r11111111
+ 2r01110111
+ 2r11111111
+ 2r11011101]
!
dither57in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110111
- 2r11111111
- 2r11011101
- 2r11111111
- 2r01110111
- 2r11111111
- 2r11111101]
+ 2r01110111
+ 2r11111111
+ 2r11011101
+ 2r11111111
+ 2r01110111
+ 2r11111111
+ 2r11111101]
!
dither58in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110111
- 2r11111111
- 2r11011111
- 2r11111111
- 2r01110111
- 2r11111111
- 2r11111101]
+ 2r01110111
+ 2r11111111
+ 2r11011111
+ 2r11111111
+ 2r01110111
+ 2r11111111
+ 2r11111101]
!
dither59in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110111
- 2r11111111
- 2r11011111
- 2r11111111
- 2r01110111
- 2r11111111
- 2r11111111]
+ 2r01110111
+ 2r11111111
+ 2r11011111
+ 2r11111111
+ 2r01110111
+ 2r11111111
+ 2r11111111]
!
dither60in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r01110111
- 2r11111111
- 2r11111111]
+ 2r01110111
+ 2r11111111
+ 2r11111111
+ 2r11111111
+ 2r01110111
+ 2r11111111
+ 2r11111111]
!
dither61in64
"return a pattern for dithering"
^ #[2r11111111
- 2r01110111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r01111111
- 2r11111111
- 2r11111111]
+ 2r01110111
+ 2r11111111
+ 2r11111111
+ 2r11111111
+ 2r01111111
+ 2r11111111
+ 2r11111111]
!
dither62in64
"return a pattern for dithering"
^ #[2r11111111
- 2r11110111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r01111111
- 2r11111111
- 2r11111111]
+ 2r11110111
+ 2r11111111
+ 2r11111111
+ 2r11111111
+ 2r01111111
+ 2r11111111
+ 2r11111111]
!
dither63in64
"return a pattern for dithering"
^ #[2r11111111
- 2r11110111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r11111111]
+ 2r11110111
+ 2r11111111
+ 2r11111111
+ 2r11111111
+ 2r11111111
+ 2r11111111
+ 2r11111111]
!
grey6Bits
"return a pattern with 6% grey, usable for dithering"
^ #(2r00000001
- 2r00000000
- 2r00010000
- 2r00000000)
+ 2r00000000
+ 2r00010000
+ 2r00000000)
!
grey12Bits
"return a pattern with 12% grey, usable for dithering"
^ #(2r00010001
- 2r00000000
- 2r01000100
- 2r00000000)
+ 2r00000000
+ 2r01000100
+ 2r00000000)
!
grey25Bits
"return a pattern with 25% grey, usable for dithering"
^ #(2r00010001
- 2r01000100
- 2r00010001
- 2r01000100)
+ 2r01000100
+ 2r00010001
+ 2r01000100)
!
grey37Bits
"return a pattern with 37% grey, usable for dithering"
^ #(2r00010001
- 2r10101010
- 2r01000100
- 2r10101010)
+ 2r10101010
+ 2r01000100
+ 2r10101010)
!
grey50Bits
"return a pattern with 50% grey, usable for dithering"
^ #(2r01010101
- 2r10101010
- 2r01010101
- 2r10101010)
+ 2r10101010
+ 2r01010101
+ 2r10101010)
!
veryLightGreyFormBits
"return a pattern usable to simulate veryDarkGray on monochrome device"
^ #(2r10001000
- 2r00000000
- 2r00100010
- 2r00000000)
+ 2r00000000
+ 2r00100010
+ 2r00000000)
!
lightGreyFormBits
"return a pattern usable to simulate lightGray on monochrome device"
^ #(2r01000100
- 2r00010001
- 2r01000100
- 2r00010001
- 2r01000100)
+ 2r00010001
+ 2r01000100
+ 2r00010001
+ 2r01000100)
!
greyFormBits
"return a pattern usable to simulate gray on monochrome device"
^ #(2r01010101
- 2r10101010
- 2r01010101
- 2r10101010)
+ 2r10101010
+ 2r01010101
+ 2r10101010)
!
darkGreyFormBits
"return a pattern usable to simulate darkGray on monochrome device"
^ #(2r10111011
- 2r11101110
- 2r10111011
- 2r11101110)
+ 2r11101110
+ 2r10111011
+ 2r11101110)
!
veryDarkGreyFormBits
"return a pattern usable to simulate veryDarkGray on monochrome device"
^ #(2r01110111
- 2r11111111
- 2r11011101
- 2r11111111)
+ 2r11111111
+ 2r11011101
+ 2r11111111)
! !
!Form methodsFor:'initialization'!
@@ -1337,8 +1337,8 @@
initialize
super initialize.
depth := 1.
- foreground := Color colorId:1.
- background := Color colorId:0
+ foreground := paint := Color colorId:1.
+ background := bgPaint := Color colorId:0
!
initGC
@@ -1354,22 +1354,22 @@
"reconstruct the form after a snapin"
data notNil ifTrue:[
- (depth == 1 or:[depth == device depth]) ifTrue:[
- drawableId := device createBitmapFromArray:data width:width height:height.
- ^ self
- ].
- data := nil.
+ (depth == 1 or:[depth == device depth]) ifTrue:[
+ drawableId := device createBitmapFromArray:data width:width height:height.
+ ^ self
+ ].
+ data := nil.
].
fileName notNil ifTrue:[
- drawableId := device createBitmapFromFile:fileName for:self.
- ^ self
+ drawableId := device createBitmapFromFile:fileName for:self.
+ ^ self
].
'FORM: cannot recreate form' errorPrintNewline.
"create an empty one"
depth == 1 ifTrue:[
- drawableId := device createBitmapWidth:width height:height
+ drawableId := device createBitmapWidth:width height:height
] ifFalse:[
- drawableId := device createPixmapWidth:width height:height depth:device depth
+ drawableId := device createPixmapWidth:width height:height depth:device depth
]
! !
@@ -1390,9 +1390,9 @@
(instead of the default InspectorView)."
ImageInspectorView isNil ifTrue:[
- super inspect
+ super inspect
] ifFalse:[
- ImageInspectorView openOn:self
+ ImageInspectorView openOn:self
]
! !
@@ -1400,16 +1400,16 @@
on:aDevice
aDevice == device ifTrue:[
- ^ self
+ ^ self
].
^ nil
!
asMonochromeFormOn:aDevice
aDevice == device ifTrue:[
- depth == 1 ifTrue:[
- ^ self
- ].
+ depth == 1 ifTrue:[
+ ^ self
+ ].
].
^ nil
!
@@ -1420,7 +1420,7 @@
asFormOn:aDevice
aDevice == device ifTrue:[
- ^ self
+ ^ self
].
^ nil
! !
@@ -1443,7 +1443,7 @@
the information present in the device is lost after restart/reload"
(data isNil and:[fileName isNil]) ifTrue:[
- data := self bits
+ data := self bits
]
!
@@ -1451,8 +1451,8 @@
"actual create of a monochrome form"
((w == 0) or:[h == 0]) ifTrue:[
- self error:'invalid form extent'.
- ^ nil
+ self error:'invalid form extent'.
+ ^ nil
].
width := w.
height := h.
@@ -1461,7 +1461,7 @@
drawableId := device createBitmapWidth:w height:h.
drawableId isNil ifTrue:[^ nil].
BlackAndWhiteColorMap isNil ifTrue:[
- BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
+ BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
].
localColorMap := BlackAndWhiteColorMap.
realized := true.
@@ -1493,29 +1493,29 @@
bytes := anArray.
anArray size ~~ (((w + 7) // 8) * h) ifTrue:[
- anArray size == (((w + 15) // 16) * h) ifTrue:[
- "I want the bytes but got shorts (ST-80)"
- bytes := ByteArray uninitializedNew:(((w + 7) // 8) * h).
- srcPerRow := (w + 15) // 16.
- dstPerRow := (w + 7) // 8.
- srcStart := 1.
- dstIndex := 1.
- 1 to:h do:[:hi |
- srcIndex := srcStart.
- bits := anArray at:srcIndex.
- 1 to:dstPerRow do:[:di |
- di odd ifTrue:[
- bits := anArray at:srcIndex.
- bytes at:dstIndex put:(bits bitShift:-8)
- ] ifFalse:[
- bytes at:dstIndex put:(bits bitAnd:16rFF).
- srcIndex := srcIndex + 1
- ].
- dstIndex := dstIndex + 1
- ].
- srcStart := srcStart + srcPerRow
- ]
- ]
+ anArray size == (((w + 15) // 16) * h) ifTrue:[
+ "I want the bytes but got shorts (ST-80)"
+ bytes := ByteArray uninitializedNew:(((w + 7) // 8) * h).
+ srcPerRow := (w + 15) // 16.
+ dstPerRow := (w + 7) // 8.
+ srcStart := 1.
+ dstIndex := 1.
+ 1 to:h do:[:hi |
+ srcIndex := srcStart.
+ bits := anArray at:srcIndex.
+ 1 to:dstPerRow do:[:di |
+ di odd ifTrue:[
+ bits := anArray at:srcIndex.
+ bytes at:dstIndex put:(bits bitShift:-8)
+ ] ifFalse:[
+ bytes at:dstIndex put:(bits bitAnd:16rFF).
+ srcIndex := srcIndex + 1
+ ].
+ dstIndex := dstIndex + 1
+ ].
+ srcStart := srcStart + srcPerRow
+ ]
+ ]
].
width := w.
height := h.
@@ -1526,7 +1526,7 @@
data := bytes.
BlackAndWhiteColorMap isNil ifTrue:[
- BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
+ BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
].
localColorMap := BlackAndWhiteColorMap.
realized := true.
@@ -1547,18 +1547,18 @@
pathName := self class findBitmapFile:filename.
pathName notNil ifTrue:[
- drawableId := device createBitmapFromFile:pathName for:self.
- drawableId isNil ifTrue:[^ nil].
+ drawableId := device createBitmapFromFile:pathName for:self.
+ drawableId isNil ifTrue:[^ nil].
- fileName := pathName.
- offset := 0@0.
- realized := true.
- BlackAndWhiteColorMap isNil ifTrue:[
- BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
- ].
- localColorMap := BlackAndWhiteColorMap.
- Lobby register:self.
- ^ self
+ fileName := pathName.
+ offset := 0@0.
+ realized := true.
+ BlackAndWhiteColorMap isNil ifTrue:[
+ BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
+ ].
+ localColorMap := BlackAndWhiteColorMap.
+ Lobby register:self.
+ ^ self
].
^ nil
!
@@ -1576,7 +1576,7 @@
((dpi >= (dpiH * 0.75)) and:[dpi <= (dpiH * 1.5)]) ifTrue:[^ self].
mag := (dpiH / dpi) rounded.
mag == 0 ifTrue:[
- ^ self
+ ^ self
].
^ self magnifyBy:(mag @ mag)
@@ -1641,13 +1641,13 @@
dstIndex "{ Class: SmallInteger }"|
data notNil ifTrue:[
- ^ data
+ ^ data
].
drawableId isNil ifTrue:[
- fileName notNil ifTrue:[
- ^ (self on:Display) bits
- ].
- ^ nil
+ fileName notNil ifTrue:[
+ ^ (self on:Display) bits
+ ].
+ ^ nil
].
bytesPerLine := (width * depth + 31) // 32 * 4.
@@ -1659,25 +1659,25 @@
"
different padding - have to copy over row-wise
"
- tmpData := inData.
- inData := ByteArray uninitializedNew:(bytesPerLine * height).
- srcIndex := 1.
- dstIndex := 1.
- 1 to:height do:[:hi |
- inData replaceFrom:dstIndex to:(dstIndex + bytesPerLine - 1)
- with:tmpData startingAt:srcIndex.
- dstIndex := dstIndex + bytesPerLine.
- srcIndex := srcIndex + bytesPerLineIn
- ]
+ tmpData := inData.
+ inData := ByteArray uninitializedNew:(bytesPerLine * height).
+ srcIndex := 1.
+ dstIndex := 1.
+ 1 to:height do:[:hi |
+ inData replaceFrom:dstIndex to:(dstIndex + bytesPerLine - 1)
+ with:tmpData startingAt:srcIndex.
+ dstIndex := dstIndex + bytesPerLine.
+ srcIndex := srcIndex + bytesPerLineIn
+ ]
] ifFalse:[
"
same padding - copy over all in one chunk
"
- (bytesPerLine * height) ~~ inData size ifTrue:[
- tmpData := inData.
- inData := ByteArray uninitializedNew:(bytesPerLine * height).
- inData replaceFrom:1 to:bytesPerLine * height with:tmpData startingAt:1
- ]
+ (bytesPerLine * height) ~~ inData size ifTrue:[
+ tmpData := inData.
+ inData := ByteArray uninitializedNew:(bytesPerLine * height).
+ inData replaceFrom:1 to:bytesPerLine * height with:tmpData startingAt:1
+ ]
].
^ inData.
!
@@ -1693,16 +1693,16 @@
"for compatibility with Image class ..."
depth == 1 ifTrue:[
- ((localColorMap at:1) = Color white) ifTrue:[
- ((localColorMap at:1) = Color black) ifTrue:[
- ^ #whiteIs0
- ].
- ].
- ((localColorMap at:1) = Color black) ifTrue:[
- ((localColorMap at:1) = Color white) ifTrue:[
- ^ #blackIs0
- ].
- ].
+ ((localColorMap at:1) = Color white) ifTrue:[
+ ((localColorMap at:1) = Color black) ifTrue:[
+ ^ #whiteIs0
+ ].
+ ].
+ ((localColorMap at:1) = Color black) ifTrue:[
+ ((localColorMap at:1) = Color white) ifTrue:[
+ ^ #blackIs0
+ ].
+ ].
].
^ #palette
!
@@ -1753,40 +1753,40 @@
((mX = 1) and:[mY = 1]) ifTrue:[^ self].
((mX isMemberOf:SmallInteger) and:[mY isMemberOf:SmallInteger]) ifFalse:[
- ^ self hardMagnifyBy:extent
+ ^ self hardMagnifyBy:extent
].
newForm := ((self class) on:device)
- width:(width * mX)
- height:(height * mY)
- depth:depth.
+ width:(width * mX)
+ height:(height * mY)
+ depth:depth.
"expand rows"
(mY > 1) ifTrue:[
- dstY := 0.
- 0 to:(height - 1) do:[:srcY |
- 1 to:mY do:[:i |
- newForm copyFrom:self
- x:0 y:srcY
- toX:0 y:dstY
- width:width height:1.
- dstY := dstY + 1
- ]
- ]
+ dstY := 0.
+ 0 to:(height - 1) do:[:srcY |
+ 1 to:mY do:[:i |
+ newForm copyFrom:self
+ x:0 y:srcY
+ toX:0 y:dstY
+ width:width height:1.
+ dstY := dstY + 1
+ ]
+ ]
].
"expand cols"
(mX > 1) ifTrue:[
- dstX := (width * mX) - 1.
- (width - 1) to:0 by:-1 do:[:srcX |
- 1 to:mX do:[:i |
- newForm copyFrom:newForm
- x:srcX y:0
- toX:dstX y:0
- width:1 height:(height * mY).
- dstX := dstX - 1
- ]
- ]
+ dstX := (width * mX) - 1.
+ (width - 1) to:0 by:-1 do:[:srcX |
+ 1 to:mX do:[:i |
+ newForm copyFrom:newForm
+ x:srcX y:0
+ toX:dstX y:0
+ width:1 height:(height * mY).
+ dstX := dstX - 1
+ ]
+ ]
].
newForm colorMap:localColorMap.
^ newForm
@@ -1799,17 +1799,17 @@
|dstX newForm|
newForm := ((self class) on:device)
- width:width
- height:height
- depth:depth.
+ width:width
+ height:height
+ depth:depth.
"expand cols"
dstX := width - 1.
0 to:((width - 1) // 2) do:[:srcX |
- newForm copyFrom:self
- x:srcX y:0
- toX:dstX y:0
- width:1 height:height.
- dstX := dstX - 1
+ newForm copyFrom:self
+ x:srcX y:0
+ toX:dstX y:0
+ width:1 height:height.
+ dstX := dstX - 1
].
newForm colorMap:localColorMap.
^ newForm
@@ -1821,17 +1821,17 @@
|dstY newForm|
newForm := ((self class) on:device)
- width:width
- height:height
- depth:depth.
+ width:width
+ height:height
+ depth:depth.
"expand rows"
dstY = height - 1.
0 to:((height - 1) // 2) do:[:srcY |
- newForm copyFrom:self
- x:0 y:srcY
- toX:0 y:dstY
- width:width height:1.
- dstY := dstY - 1
+ newForm copyFrom:self
+ x:0 y:srcY
+ toX:0 y:dstY
+ width:width height:1.
+ dstY := dstY - 1
].
newForm colorMap:localColorMap.
^ newForm
--- a/Make.proto Fri Oct 28 04:16:56 1994 +0100
+++ b/Make.proto Fri Oct 28 04:20:20 1994 +0100
@@ -103,8 +103,14 @@
(cd $(TOP); tar cvf DISTRIB/libview.tar \
libview/*.st \
libview/Make.proto \
+ libview/styles \
libview/resources)
- compress $(TOP)/DISTRIB/libview.tar
+ gzip $(TOP)/DISTRIB/libview.tar
+
+uutar:
+ $(MAKE) tar
+ (cd $(TOP)/DISTRIB; uuencode libview.tar.gz libview.tar.gz > libview.tar.gz.uue)
+
#
# special BIG-rule (kludge for HP)
--- a/StandardSystemView.st Fri Oct 28 04:16:56 1994 +0100
+++ b/StandardSystemView.st Fri Oct 28 04:20:20 1994 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.11 1994-10-10 02:33:15 claus Exp $
+$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.12 1994-10-28 03:19:27 claus Exp $
'!
!StandardSystemView class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.11 1994-10-10 02:33:15 claus Exp $
+$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.12 1994-10-28 03:19:27 claus Exp $
"
!
@@ -423,6 +423,8 @@
windowGroup notNil ifTrue:[
windowGroup withCursor:aCursor do:aBlock
+ ] ifFalse:[
+ super withCursor:aCursor do:aBlock
]
! !
--- a/StdSysV.st Fri Oct 28 04:16:56 1994 +0100
+++ b/StdSysV.st Fri Oct 28 04:20:20 1994 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.11 1994-10-10 02:33:15 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.12 1994-10-28 03:19:27 claus Exp $
'!
!StandardSystemView class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.11 1994-10-10 02:33:15 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.12 1994-10-28 03:19:27 claus Exp $
"
!
@@ -423,6 +423,8 @@
windowGroup notNil ifTrue:[
windowGroup withCursor:aCursor do:aBlock
+ ] ifFalse:[
+ super withCursor:aCursor do:aBlock
]
! !
--- a/View.st Fri Oct 28 04:16:56 1994 +0100
+++ b/View.st Fri Oct 28 04:20:20 1994 +0100
@@ -46,7 +46,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/View.st,v 1.19 1994-10-10 02:33:27 claus Exp $
+$Header: /cvs/stx/stx/libview/View.st,v 1.20 1994-10-28 03:18:02 claus Exp $
'!
"this flag controls (globally) how views look"
@@ -71,7 +71,7 @@
version
"
-$Header: /cvs/stx/stx/libview/View.st,v 1.19 1994-10-10 02:33:27 claus Exp $
+$Header: /cvs/stx/stx/libview/View.st,v 1.20 1994-10-28 03:18:02 claus Exp $
"
!
@@ -293,34 +293,17 @@
].
DefaultBorderWidth := StyleSheet at:'borderWidth' default:0.
- DefaultBorderColor := StyleSheet at:'borderColor' default:Black.
- DefaultViewBackgroundColor := StyleSheet at:'viewBackground' default:bgGrey.
- DefaultShadowColor := StyleSheet at:'shadowColor'.
- DefaultLightColor := StyleSheet at:'lightColor'.
- DefaultHalfShadowColor := StyleSheet at:'halfShadowColor'.
- DefaultHalfLightColor := StyleSheet at:'halfLightColor'.
+ DefaultBorderColor := StyleSheet colorAt:'borderColor' default:Black.
+ DefaultViewBackgroundColor := StyleSheet colorAt:'viewBackground' default:bgGrey.
+ DefaultShadowColor := StyleSheet colorAt:'shadowColor'.
+ DefaultLightColor := StyleSheet colorAt:'lightColor'.
+ DefaultHalfShadowColor := StyleSheet colorAt:'halfShadowColor'.
+ DefaultHalfLightColor := StyleSheet colorAt:'halfLightColor'.
DefaultFont := StyleSheet at:'font'.
DefaultFont isNil ifTrue:[
DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12.
].
- "
- get device colors - avoid repeated device conversions later
- "
- DefaultViewBackgroundColor := DefaultViewBackgroundColor on:Display.
- DefaultLightColor notNil ifTrue:[
- DefaultLightColor := DefaultLightColor on:Display.
- ].
- DefaultShadowColor notNil ifTrue:[
- DefaultShadowColor := DefaultShadowColor on:Display.
- ].
- DefaultHalfShadowColor notNil ifTrue:[
- DefaultHalfShadowColor := DefaultHalfShadowColor on:Display.
- ].
- DefaultLightShadowColor notNil ifTrue:[
- DefaultHalfLightColor := DefaultHalfLightColor on:Display.
- ].
- DefaultBorderColor := DefaultBorderColor on:Display.
DefaultFont := DefaultFont on:Display.
! !
@@ -1256,15 +1239,16 @@
"return the transformation"
transformation isNil ifTrue:[
- superView isNil ifTrue:[
- transformation := WindowingTransformation
+ "
+ fake a transformation, if I have a non-nil window
+ "
+ window notNil ifTrue:[
+ superView isNil ifTrue:[
+ ^ WindowingTransformation
window:window
viewport:(0@0 extent:self extent)
- ] ifFalse:[
- window isNil ifTrue:[
- window := (0 @ 0) corner:(1 @ 1)
].
- transformation := WindowingTransformation
+ ^ WindowingTransformation
window:window
viewport:(self origin extent:self extent)
]
@@ -2986,11 +2970,17 @@
go dispatch events in this new group
(thus current windowgroup is blocked from interaction)
"
- (Object abortSignal catch:[
+ Object abortSignal handle:[:ex |
+ self hide.
+ ex return.
+ ] do:[
windowGroup startupModal:[realized and:aBlock]
- ]) ifTrue:[
- self hide
].
+"/ (Object abortSignal catch:[
+"/ windowGroup startupModal:[realized and:aBlock]
+"/ ]) ifTrue:[
+"/ self hide
+"/ ].
] ifTrue:[
self realize
]
@@ -3073,20 +3063,20 @@
].
0 to:(count - 1) do:[:i |
run := y + i.
- super displayLineFromX:x y:run toX:r y:run. "top"
+ super displayDeviceLineFromX:x y:run toX:r y:run. "top"
run := x + i.
- super displayLineFromX:run y:y toX:run y:b "left"
+ super displayDeviceLineFromX:run y:y toX:run y:b "left"
].
softEdge ifTrue:[
"
super paint:topLeftFg.
- super displayLineFromX:x y:y toX:r y:y.
- super displayLineFromX:x y:y toX:x y:b
+ super displayDeviceLineFromX:x y:y toX:r y:y.
+ super displayDeviceLineFromX:x y:y toX:x y:b
"
(l > 2) ifTrue:[
super paint:Black.
- super displayLineFromX:x y:y toX:r y:y.
- super displayLineFromX:x y:y toX:x y:b.
+ super displayDeviceLineFromX:x y:y toX:r y:y.
+ super displayDeviceLineFromX:x y:y toX:x y:b.
]
].
@@ -3106,16 +3096,16 @@
].
0 to:(count - 1) do:[:i |
run := b - i.
- super displayLineFromX:xi-1 y:run toX:r y:run. "bottom"
+ super displayDeviceLineFromX:xi-1 y:run toX:r y:run. "bottom"
run := r - i.
- super displayLineFromX:run y:yi-1 toX:run y:b. "right"
+ super displayDeviceLineFromX:run y:yi-1 toX:run y:b. "right"
xi := xi + 1.
yi := yi + 1
].
(softEdge and:[l > 1]) ifTrue:[
super paint:Black "shadowColor".
- super displayLineFromX:(x + 1-1) y:b toX:r y:b.
- super displayLineFromX:r y:(y + 1 - 1) toX:r y:b
+ super displayDeviceLineFromX:(x + 1-1) y:b toX:r y:b.
+ super displayDeviceLineFromX:r y:(y + 1 - 1) toX:r y:b
]
!
@@ -3150,11 +3140,11 @@
super paint:leftFg
].
0 to:(count - 1) do:[:i |
- super displayLineFromX:i y:i toX:i y:(height - 1 - i)
+ super displayDeviceLineFromX:i y:i toX:i y:(height - 1 - i)
].
(softEdge and:[level > 2]) ifTrue:[
super paint:Black.
- super displayLineFromX:0 y:0 toX:0 y:height-1.
+ super displayDeviceLineFromX:0 y:0 toX:0 y:height-1.
]
!
@@ -3181,11 +3171,11 @@
super paint:rightFg.
0 to:(count - 1) do:[:i |
r := width - 1 - i.
- super displayLineFromX:r y:i toX:r y:(height - 1 - i)
+ super displayDeviceLineFromX:r y:i toX:r y:(height - 1 - i)
].
(softEdge and:[level > 1]) ifTrue:[
super paint:shadowColor.
- super displayLineFromX:width-1 y:1 toX:width-1 y:height-1.
+ super displayDeviceLineFromX:width-1 y:1 toX:width-1 y:height-1.
]
!
@@ -3212,11 +3202,11 @@
super paint:topFg
].
0 to:(count - 1) do:[:i |
- super displayLineFromX:i y:i toX:(width - 1 - i) y:i
+ super displayDeviceLineFromX:i y:i toX:(width - 1 - i) y:i
].
(softEdge and:[level > 2]) ifTrue:[
super paint:Black.
- super displayLineFromX:0 y:0 toX:width-1 y:0.
+ super displayDeviceLineFromX:0 y:0 toX:width-1 y:0.
]
!
@@ -3243,11 +3233,11 @@
super paint:botFg.
0 to:(count - 1) do:[:i |
b := height - 1 - i.
- super displayLineFromX:i y:b toX:(width "- 1" - i) y:b
+ super displayDeviceLineFromX:i y:b toX:(width "- 1" - i) y:b
].
(softEdge and:[level > 1]) ifTrue:[
super paint:shadowColor.
- super displayLineFromX:1 y:height-1 toX:width-1 y:height-1.
+ super displayDeviceLineFromX:1 y:height-1 toX:width-1 y:height-1.
]
!
--- a/ViewStyle.st Fri Oct 28 04:16:56 1994 +0100
+++ b/ViewStyle.st Fri Oct 28 04:20:20 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/ViewStyle.st,v 1.2 1994-10-10 02:33:46 claus Exp $
+$Header: /cvs/stx/stx/libview/ViewStyle.st,v 1.3 1994-10-28 03:18:29 claus Exp $
'!
!ViewStyle class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/ViewStyle.st,v 1.2 1994-10-10 02:33:46 claus Exp $
+$Header: /cvs/stx/stx/libview/ViewStyle.st,v 1.3 1994-10-28 03:18:29 claus Exp $
"
!
@@ -85,6 +85,47 @@
!ViewStyle methodsFor:'accessing'!
+deviceResourceAt:aKey default:default
+ "retrieve a resource - also aquire a device version
+ to avoid repeated allocations later"
+
+ |aResource|
+
+ aResource := self at:aKey default:default.
+ aResource notNil ifTrue:[
+ ^ aResource on:Display
+ ].
+ ^ nil
+!
+
+colorAt:aKey default:default
+ "retrieve a color resource - also aquire a device color
+ to avoid repeated color allocations later"
+
+ ^ self deviceResourceAt:aKey default:default
+!
+
+colorAt:aKey
+ "retrieve a color resource - also aquire a device color
+ to avoid repeated color allocations later"
+
+ ^ self deviceResourceAt:aKey default:nil
+!
+
+fontAt:aKey default:default
+ "retrieve a font resource - also aquire a device font
+ to avoid repeated font allocations later"
+
+ ^ self deviceResourceAt:aKey default:default
+!
+
+fontAt:aKey
+ "retrieve a font resource - also aquire a device font
+ to avoid repeated font allocations later"
+
+ ^ self deviceResourceAt:aKey default:nil
+!
+
at:aKey
^ self at:aKey default:nil
!
--- a/WEvent.st Fri Oct 28 04:16:56 1994 +0100
+++ b/WEvent.st Fri Oct 28 04:20:20 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.7 1994-10-10 02:33:48 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.8 1994-10-28 03:18:27 claus Exp $
'!
!WindowEvent class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.7 1994-10-10 02:33:48 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.8 1994-10-28 03:18:27 claus Exp $
"
!
@@ -135,39 +135,55 @@
sendEvent
"forward the event represented by the receiver to the view
- or delegate"
+ or delegate, if there is one.
+ Delegated messages get the original view as an extra argument."
|delegate selector|
-"/ type == #keyPress:x:y: ifTrue:[
- "/
- "/ send it via the device, which does the key-mapping
- "/
-"/ view device sendKeyPress:(arguments at:1)
-"/ x:(arguments at:2)
-"/ y:(arguments at:3)
-"/ to:view
-"/ ] ifFalse:[
- delegate := view delegate.
- delegate notNil ifTrue:[
- "what a kludge - sending to delegate needs another
- selector and an additional argument.
- have to edit the selector ..."
-
- (type endsWith:':') ifTrue:[
- selector := (type , 'view:') asSymbol.
- ] ifFalse:[
- selector := (type , 'View:') asSymbol.
- ].
- arguments isNil ifTrue:[
- delegate perform:selector with:view
- ] ifFalse:[
- delegate perform:selector withArguments:(arguments copyWith:view)
- ]
+ selector := type.
+ delegate := view delegate.
+ delegate notNil ifTrue:[
+ "
+ what a kludge - sending to delegate needs another
+ selector and an additional argument.
+ have to edit the selector ...
+ "
+ (selector endsWith:':') ifTrue:[
+ selector := (selector , 'view:') asSymbol.
+ ] ifFalse:[
+ selector := (selector , 'View:') asSymbol.
+ ].
+ arguments isNil ifTrue:[
+ delegate perform:selector with:view
] ifFalse:[
- view perform:type withArguments:arguments
+ delegate perform:selector withArguments:(arguments copyWith:view)
]
-"/ ]
+ ] ifFalse:[
+ "
+ another bad kludge:
+ if the view has a transformation, send edit the selector to
+ from #foo to #basicFoo...
+ This allows the view to handle the event either in device or
+ logical coordinates. (since the basicFoo-messages default implementation
+ in PseudoView translates and resends).
+ "
+ view transformation notNil ifTrue:[
+ (#(#'buttonPress:x:y:'
+ #'buttonRelease:x:y:'
+ #'buttonShiftPress:x:y:'
+ #'buttonMultiPress:x:y:'
+ #'keyPress:x:y:'
+ #'keyRelease:x:y:'
+ #'expose:x:y:width:height:'
+ #'graphicExpose:x:y:width:height:'
+ #'pointerEnter:x:y:') includes:selector) ifTrue:[
+ selector := selector asString.
+ selector at:1 put:(selector at:1) asUppercase.
+ selector := ('basic' , selector) asSymbol
+ ]
+ ].
+ view perform:selector withArguments:arguments
+ ]
! !
!WindowEvent methodsFor:'private accessing'!
--- a/WGroup.st Fri Oct 28 04:16:56 1994 +0100
+++ b/WGroup.st Fri Oct 28 04:20:20 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.12 1994-10-10 02:33:56 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.13 1994-10-28 03:18:25 claus Exp $
'!
!WindowGroup class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.12 1994-10-10 02:33:56 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.13 1994-10-28 03:18:25 claus Exp $
"
!
@@ -283,15 +283,17 @@
ActiveGroup := self.
[mySensor hasDamage] whileTrue:[
event := mySensor nextDamage.
- (views isNil and:[topViews isNil]) ifFalse:[
- event isDamage ifTrue:[
- view := event view.
- rect := event rectangle.
- view shown ifTrue:[
- view exposeX:(rect left) y:(rect top) width:(rect width) height:(rect height)
+ event notNil ifTrue:[
+ (views isNil and:[topViews isNil]) ifFalse:[
+ event isDamage ifTrue:[
+ view := event view.
+ rect := event rectangle.
+ view shown ifTrue:[
+ view exposeX:(rect left) y:(rect top) width:(rect width) height:(rect height)
+ ]
+ ] ifFalse:[
+ event sendEvent.
]
- ] ifFalse:[
- event sendEvent.
]
]
].
@@ -308,13 +310,20 @@
eventLoopWhile:aBlock
"wait-for and process events while aBlock evaluates to true."
+ |abortSignal|
+
+ abortSignal := Object abortSignal.
"/ ScheduledWindowGroups add:self.
-"/ LeaveSignal
- (SignalSet with:LeaveSignal with:(Object abortSignal))
+
+ (SignalSet with:LeaveSignal with:abortSignal)
handle:[:ex |
ex return
] do:[
- |p g oldActive|
+ |p g oldActive mainGroup|
+
+ isModal ifTrue:[
+ mainGroup := self mainGroup.
+ ].
aBlock whileTrue:[
(views isNil and:[topViews isNil]) ifTrue:[
@@ -331,7 +340,7 @@
"
^ self
].
- Object abortSignal handle:[:ex |
+ abortSignal handle:[:ex |
ex return
] do:[
"
@@ -342,6 +351,7 @@
isModal ifTrue:[
mySensor eventSemaphore waitWithTimeout:0.2.
] ifFalse:[
+ Processor activeProcess setStateTo:#eventWait if:#active.
mySensor eventSemaphore wait.
].
oldActive := ActiveGroup.
@@ -352,12 +362,11 @@
"
if modal, also check for redraw events in my maingroup
- (this is a kludge, since it only handles exposures there
- when events arrive for myself - but at least updates sometimes)
+ (we arrive here after every event for myself or after the
+ above timeout)
"
- isModal ifTrue:[
- g := self mainGroup.
- g notNil ifTrue:[g processExposeEvents].
+ mainGroup notNil ifTrue:[
+ mainGroup processExposeEvents.
]
]
].
--- a/WSensor.st Fri Oct 28 04:16:56 1994 +0100
+++ b/WSensor.st Fri Oct 28 04:20:20 1994 +0100
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.12 1994-10-10 02:34:01 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.13 1994-10-28 03:18:11 claus Exp $
'!
!WindowSensor class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.12 1994-10-10 02:34:01 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.13 1994-10-28 03:18:11 claus Exp $
"
!
@@ -273,31 +273,6 @@
catchExpose := false
!
-flushEventsFor:aView
- "throw away all events for aView"
-
- 1 to: damage size do:[:i |
- |aDamage|
-
- aDamage := damage at:i.
- aDamage notNil ifTrue:[
- aDamage view == aView ifTrue:[
- damage at:i put:nil
- ]
- ]
- ].
- 1 to: mouseAndKeyboard size do:[:i |
- |anEvent|
-
- anEvent := mouseAndKeyboard at:i.
- anEvent notNil ifTrue:[
- anEvent view == aView ifTrue:[
- mouseAndKeyboard at:i put:nil
- ]
- ]
- ].
-!
-
flushUserEvents
"throw away all pending user events"
@@ -316,6 +291,50 @@
].
!
+flushExposeEventsFor:aView
+ "throw away all pending expose events for aView;
+ this can be done after a full redraw
+ (or in views, which are always doing full redraws -
+ instead of drawing the clip-area only)"
+
+ damage notNil ifTrue:[
+ 1 to:damage size do:[:index |
+ |aDamage|
+
+ aDamage := damage at:index.
+ aDamage notNil ifTrue:[
+ aDamage view == aView ifTrue:[
+ damage at:index put:nil
+ ]
+ ]
+ ]
+ ].
+!
+
+flushUserEventsFor:aView
+ "throw away all pending user events for aView"
+
+ mouseAndKeyboard notNil ifTrue:[
+ 1 to:mouseAndKeyboard size do:[:i |
+ |anEvent|
+
+ anEvent := mouseAndKeyboard at:i.
+ anEvent notNil ifTrue:[
+ anEvent view == aView ifTrue:[
+ mouseAndKeyboard at:i put:nil
+ ]
+ ]
+ ]
+ ].
+!
+
+flushEventsFor:aView
+ "throw away all events for aView"
+
+ self flushExposeEventsFor:aView.
+ self flushUserEventsFor:aView.
+!
+
pushUserEvent:anEvent
"manually put an event into the queue - this allows
simulation of events (implementation of recorders & playback)."
@@ -370,7 +389,7 @@
!WindowSensor methodsFor:'event processing'!
notifyEventArrival
- "an event arrived - if there is an eventsemaphore,
+ "an event arrived - if there is an eventSemaphore,
signal it, to wake up any controller process"
catchExpose == true ifTrue:[
--- a/WTrans.st Fri Oct 28 04:16:56 1994 +0100
+++ b/WTrans.st Fri Oct 28 04:20:20 1994 +0100
@@ -23,9 +23,106 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/WTrans.st,v 1.6 1994-10-10 02:34:07 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WTrans.st,v 1.7 1994-10-28 03:18:22 claus Exp $
'!
+!WindowingTransformation 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libview/Attic/WTrans.st,v 1.7 1994-10-28 03:18:22 claus Exp $
+"
+!
+
+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 are:
+ 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
+
+
+ example (drawing in inches):
+
+ |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
+
+
+ example (drawing in millimeters):
+
+ |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
+
+
+ example (drawing magnified):
+
+ |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
+
+
+ example (drawing shrunk):
+
+ |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
+
+
+ example (transforming Points, Rectangles etc.)
+
+
+ |p pNew|
+
+ p := 10@10.
+ pNew := (WindowingTransformation scale:2 translation:10) applyTo:p.
+ pNew
+"
+! !
+
!WindowingTransformation class methodsFor:'instance creation'!
unit:unitSymbol on:device
@@ -61,20 +158,49 @@
pixelPerUnitH := device horizontalPixelPerInch
] ifFalse:[
"sorry: unknown unit is taken as pixel"
- ^ self new scale:nil translation:(0 @ 0)
+ ^ self new scale:nil translation:nil
]
]
]
]
].
- ^ self new scale:(pixelPerUnitH @ pixelPerUnitV) translation:0
+ ^ self basicNew scale:(pixelPerUnitH @ pixelPerUnitV) translation:nil
+
+ "
+ |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
+ "
!
scale:aScale translation:aTranslation
"returns a windowing transformation with a scale factor of
aScale and a translation offset of aTranslation."
- ^ self new scale:aScale translation:aTranslation
+ ^ self basicNew scale:aScale translation:aTranslation
+
+ "
+ |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
+ "
!
window:sourceRectangle viewport:destinationRectangle
@@ -85,61 +211,42 @@
represents the logical coordinateSpace while destinationRectangle
represents the device coordinateSpace."
- |sX sY tX tY newScale|
+ |sX sY tX tY newScale newTranslation|
sX := destinationRectangle width / sourceRectangle width.
sY := destinationRectangle height / sourceRectangle height.
tX := destinationRectangle left - sourceRectangle left.
tY := destinationRectangle top - sourceRectangle top.
+ ((tX = 1.0) and:[tY = 1.0]) ifTrue:[
+ newTranslation := nil
+ ] ifFalse:[
+ newTranslation := tX @ tY
+ ].
((sX = 1.0) and:[sY = 1.0]) ifTrue:[
- newScale := 1 @ 1
+ newScale := nil
] ifFalse:[
newScale := sX @ sY
].
- ^ self new scale:newScale translation:(tX @ tY)
+ ^ self basicNew scale:newScale translation:newTranslation
+
+ "
+ |v|
+
+ v := View new realize.
+ (Delay forSeconds:3) wait.
+ v transformation:(WindowingTransformation
+ window:(0@0 corner:1@1)
+ viewport:(0@0 corner:100@100)).
+ 'now, we can think of drawing in 0..1/0..1 coordinates'.
+ v displayLineFrom:0.1@0.1 to:0.9@0.9
+ "
!
identity
- "returns a windowing transformation with no scaling (nil)
+ "returns a windowing transformation with no scaling (1@1)
and no translation (0@0)."
- ^ self new scale:1 translation:0
-! !
-
-!WindowingTransformation 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.
-"
-!
-
-version
-"
-$Header: /cvs/stx/stx/libview/Attic/WTrans.st,v 1.6 1994-10-10 02:34:07 claus Exp $
-"
-!
-
-documentation
-"
- I represent the ability to perform transformations in 2-D space.
-
- Instance variables are:
- scale <Number> or <Point> representing a linear scaling factor.
- translation <Number> or <Point> representing a translation in 2-D.
-
- All 2-D objects are supposed to be able to be transformed using
- instances of me. Instances of me can also be combined to form a
- single composite transformation.
-"
+ ^ self basicNew scale:nil translation:nil
! !
!WindowingTransformation methodsFor:'applying transform'!
@@ -148,47 +255,36 @@
"Apply the receiver to a number representing an x-coordinate
and return the result."
- scale isNil ifTrue:[
- ^ aNumber + translation x
- ].
- ^ (aNumber * scale x + translation x) asInteger
+ |t s|
+
+ scale isNil ifTrue:[s := 1] ifFalse:[s := scale x].
+ translation isNil ifTrue:[t := 0] ifFalse:[t := translation x].
+ ^ aNumber * s + t
!
applyToY:aNumber
"Apply the receiver to a number representing an y-coordinate
and return the result."
- scale isNil ifTrue:[
- ^ aNumber + translation y
- ].
- ^ (aNumber * scale y + translation y) asInteger
+ |t s|
+
+ scale isNil ifTrue:[s := 1] ifFalse:[s := scale y].
+ translation isNil ifTrue:[t := 0] ifFalse:[t := translation y].
+ ^ aNumber * s + t
+!
+
+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) asInteger
-!
-
-applyScaleX:aNumber
- "apply the scale only (if widths are to be transformed)"
-
- scale isNil ifTrue:[^ aNumber].
- ^ (aNumber * scale x) asInteger
-!
-
-applyInverseTo:anObject
- "Apply the inverse of the receiver to anObject
- and return the result."
-
- |transformedObject|
-
- transformedObject := anObject translatedBy:(self inverseTranslation).
- scale == nil ifFalse:[
- transformedObject scaleBy:(self inverseScale)
- ].
- ^ transformedObject
+ ^ aNumber * scale y
!
applyTo:anObject
@@ -196,14 +292,92 @@
|transformedObject|
- scale == nil ifTrue:[
- ^ anObject translateBy:translation.
+ scale isNil ifTrue:[
+ translation isNil ifTrue:[
+ ^ anObject
+ ].
+ ^ anObject translatedBy:translation
+ ].
+ transformedObject := anObject scaledBy:scale.
+ translation notNil ifTrue:[
+ transformedObject translateBy:translation.
].
- transformedObject := anObject scaledBy:scale
- transformedObject translateBy:translation.
^ transformedObject
!
+applyInverseToX:aNumber
+ "Apply the receiver to a number representing an x-coordinate
+ and return the result."
+
+ |t s|
+
+ scale isNil ifTrue:[s := 1] ifFalse:[s := scale x].
+ translation isNil ifTrue:[t := 0] ifFalse:[t := translation x].
+ ^ (aNumber - t) / s
+!
+
+applyInverseToY:aNumber
+ "Apply the receiver to a number representing an y-coordinate
+ and return the result."
+
+ |t s|
+
+ scale isNil ifTrue:[s := 1] ifFalse:[s := scale y].
+ translation isNil ifTrue:[t := 0] ifFalse:[t := translation y].
+ ^ (aNumber - t) / s
+!
+
+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."
+
+ |transformedObject|
+
+ translation isNil ifTrue:[
+ scale isNil ifTrue:[
+ ^ anObject
+ ].
+ ^ anObject scaledBy:self inverseScale
+ ].
+ transformedObject := anObject translatedBy:(self inverseTranslation).
+ scale notNil ifTrue:[
+ transformedObject scaleBy:(self inverseScale).
+ ].
+ ^ transformedObject
+!
+
+transformPoint:p
+ "Apply the receiver to a point.
+ This is destructive in that the point is being modified,
+ not a copy."
+
+ scale isNil ifTrue:[
+ translation isNil ifTrue:[
+ ^ p
+ ].
+ ^ p + translation
+ ].
+ translation isNil ifTrue:[
+ ^ p * scale
+ ].
+ ^ (p * scale + translation)
+!
+
compose:aTransformation
"return a new WindowingTransformation that is the
composition of the receiver and aTransformation.
@@ -215,7 +389,7 @@
|aTransformationScale newScale newTranslation|
aTransformationScale := aTransformation scale.
- scale == nil ifTrue:[
+ scale isNil ifTrue:[
aTransformation noScale ifTrue:[
newScale := nil
] ifFalse:[
@@ -243,7 +417,7 @@
This is a destructive operation, modifying the transformation
represented by the receiver"
- |newScale newTranslation|
+ |newScale|
aScale isNil ifTrue:[^ self].
@@ -252,7 +426,9 @@
] ifFalse:[
newScale := scale * aScale
].
- translation := translation * aScale.
+ translation notNil ifTrue:[
+ translation := translation * aScale.
+ ].
scale := newScale.
!
@@ -279,17 +455,19 @@
|checkedScale newScale newTranslation|
- aScale == nil ifTrue:[
+ aScale isNil ifTrue:[
newScale := scale.
newTranslation := translation
] ifFalse:[
checkedScale := self checkScale:aScale.
- scale == nil ifTrue:[
+ scale isNil ifTrue:[
newScale := checkedScale
] ifFalse:[
newScale := scale * checkedScale
].
- newTranslation := checkedScale * translation
+ translation notNil ifTrue:[
+ newTranslation := checkedScale * translation
+ ]
].
^ (self class)
scale:newScale
@@ -345,35 +523,50 @@
scale:aScale translation:aTranslation
"sets the scale to aScale and the translation to aTranslation."
- scale := aScale asPoint.
- translation := aTranslation asPoint
+ aScale isNil ifTrue:[
+ scale := aScale
+ ] ifFalse:[
+ scale := aScale asPoint.
+ ].
+ aTranslation isNil ifTrue:[
+ translation := aTranslation
+ ] ifFalse:[
+ translation := aTranslation asPoint
+ ]
!
-translation:aValue
- "Set the receiver's translation to aValue, a Point or Number."
+translation:aTranslation
+ "Set the receiver's translation to aTranslation, a Point or Number."
- translation := aValue asPoint
+ aTranslation isNil ifTrue:[
+ translation := aTranslation
+ ] ifFalse:[
+ translation := aTranslation asPoint
+ ]
!
-scale:aValue
- "Set the receiver's scale to aValue, a Point or Number."
+scale:aScale
+ "Set the receiver's scale to aScale, a Point or Number."
- scale := aValue asPoint
+ aScale isNil ifTrue:[
+ scale := aScale
+ ] ifFalse:[
+ scale := aScale asPoint.
+ ].
!
scale
"return a copy of the Point that represents the
current scale of the receiver."
- scale == nil ifTrue:[
- ^ Point x:1 y:1
- ].
+ scale isNil ifTrue:[^ (1@1) copy].
^ scale copy
!
translation
"return a copy of the receiver's translation."
+ translation isNil ifTrue:[^ (0@0) copy].
^ translation copy
!
@@ -397,7 +590,7 @@
printOn:aStream
aStream nextPutAll:self class name.
aStream nextPutAll:' scale: '.
- scale printOn:aStream
+ scale printOn:aStream.
aStream nextPutAll:' translation: '.
translation printOn:aStream
! !
--- a/WindowEvent.st Fri Oct 28 04:16:56 1994 +0100
+++ b/WindowEvent.st Fri Oct 28 04:20:20 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.7 1994-10-10 02:33:48 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.8 1994-10-28 03:18:27 claus Exp $
'!
!WindowEvent class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.7 1994-10-10 02:33:48 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.8 1994-10-28 03:18:27 claus Exp $
"
!
@@ -135,39 +135,55 @@
sendEvent
"forward the event represented by the receiver to the view
- or delegate"
+ or delegate, if there is one.
+ Delegated messages get the original view as an extra argument."
|delegate selector|
-"/ type == #keyPress:x:y: ifTrue:[
- "/
- "/ send it via the device, which does the key-mapping
- "/
-"/ view device sendKeyPress:(arguments at:1)
-"/ x:(arguments at:2)
-"/ y:(arguments at:3)
-"/ to:view
-"/ ] ifFalse:[
- delegate := view delegate.
- delegate notNil ifTrue:[
- "what a kludge - sending to delegate needs another
- selector and an additional argument.
- have to edit the selector ..."
-
- (type endsWith:':') ifTrue:[
- selector := (type , 'view:') asSymbol.
- ] ifFalse:[
- selector := (type , 'View:') asSymbol.
- ].
- arguments isNil ifTrue:[
- delegate perform:selector with:view
- ] ifFalse:[
- delegate perform:selector withArguments:(arguments copyWith:view)
- ]
+ selector := type.
+ delegate := view delegate.
+ delegate notNil ifTrue:[
+ "
+ what a kludge - sending to delegate needs another
+ selector and an additional argument.
+ have to edit the selector ...
+ "
+ (selector endsWith:':') ifTrue:[
+ selector := (selector , 'view:') asSymbol.
+ ] ifFalse:[
+ selector := (selector , 'View:') asSymbol.
+ ].
+ arguments isNil ifTrue:[
+ delegate perform:selector with:view
] ifFalse:[
- view perform:type withArguments:arguments
+ delegate perform:selector withArguments:(arguments copyWith:view)
]
-"/ ]
+ ] ifFalse:[
+ "
+ another bad kludge:
+ if the view has a transformation, send edit the selector to
+ from #foo to #basicFoo...
+ This allows the view to handle the event either in device or
+ logical coordinates. (since the basicFoo-messages default implementation
+ in PseudoView translates and resends).
+ "
+ view transformation notNil ifTrue:[
+ (#(#'buttonPress:x:y:'
+ #'buttonRelease:x:y:'
+ #'buttonShiftPress:x:y:'
+ #'buttonMultiPress:x:y:'
+ #'keyPress:x:y:'
+ #'keyRelease:x:y:'
+ #'expose:x:y:width:height:'
+ #'graphicExpose:x:y:width:height:'
+ #'pointerEnter:x:y:') includes:selector) ifTrue:[
+ selector := selector asString.
+ selector at:1 put:(selector at:1) asUppercase.
+ selector := ('basic' , selector) asSymbol
+ ]
+ ].
+ view perform:selector withArguments:arguments
+ ]
! !
!WindowEvent methodsFor:'private accessing'!
--- a/WindowGroup.st Fri Oct 28 04:16:56 1994 +0100
+++ b/WindowGroup.st Fri Oct 28 04:20:20 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.12 1994-10-10 02:33:56 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.13 1994-10-28 03:18:25 claus Exp $
'!
!WindowGroup class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.12 1994-10-10 02:33:56 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.13 1994-10-28 03:18:25 claus Exp $
"
!
@@ -283,15 +283,17 @@
ActiveGroup := self.
[mySensor hasDamage] whileTrue:[
event := mySensor nextDamage.
- (views isNil and:[topViews isNil]) ifFalse:[
- event isDamage ifTrue:[
- view := event view.
- rect := event rectangle.
- view shown ifTrue:[
- view exposeX:(rect left) y:(rect top) width:(rect width) height:(rect height)
+ event notNil ifTrue:[
+ (views isNil and:[topViews isNil]) ifFalse:[
+ event isDamage ifTrue:[
+ view := event view.
+ rect := event rectangle.
+ view shown ifTrue:[
+ view exposeX:(rect left) y:(rect top) width:(rect width) height:(rect height)
+ ]
+ ] ifFalse:[
+ event sendEvent.
]
- ] ifFalse:[
- event sendEvent.
]
]
].
@@ -308,13 +310,20 @@
eventLoopWhile:aBlock
"wait-for and process events while aBlock evaluates to true."
+ |abortSignal|
+
+ abortSignal := Object abortSignal.
"/ ScheduledWindowGroups add:self.
-"/ LeaveSignal
- (SignalSet with:LeaveSignal with:(Object abortSignal))
+
+ (SignalSet with:LeaveSignal with:abortSignal)
handle:[:ex |
ex return
] do:[
- |p g oldActive|
+ |p g oldActive mainGroup|
+
+ isModal ifTrue:[
+ mainGroup := self mainGroup.
+ ].
aBlock whileTrue:[
(views isNil and:[topViews isNil]) ifTrue:[
@@ -331,7 +340,7 @@
"
^ self
].
- Object abortSignal handle:[:ex |
+ abortSignal handle:[:ex |
ex return
] do:[
"
@@ -342,6 +351,7 @@
isModal ifTrue:[
mySensor eventSemaphore waitWithTimeout:0.2.
] ifFalse:[
+ Processor activeProcess setStateTo:#eventWait if:#active.
mySensor eventSemaphore wait.
].
oldActive := ActiveGroup.
@@ -352,12 +362,11 @@
"
if modal, also check for redraw events in my maingroup
- (this is a kludge, since it only handles exposures there
- when events arrive for myself - but at least updates sometimes)
+ (we arrive here after every event for myself or after the
+ above timeout)
"
- isModal ifTrue:[
- g := self mainGroup.
- g notNil ifTrue:[g processExposeEvents].
+ mainGroup notNil ifTrue:[
+ mainGroup processExposeEvents.
]
]
].
--- a/WindowSensor.st Fri Oct 28 04:16:56 1994 +0100
+++ b/WindowSensor.st Fri Oct 28 04:20:20 1994 +0100
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.12 1994-10-10 02:34:01 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.13 1994-10-28 03:18:11 claus Exp $
'!
!WindowSensor class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.12 1994-10-10 02:34:01 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.13 1994-10-28 03:18:11 claus Exp $
"
!
@@ -273,31 +273,6 @@
catchExpose := false
!
-flushEventsFor:aView
- "throw away all events for aView"
-
- 1 to: damage size do:[:i |
- |aDamage|
-
- aDamage := damage at:i.
- aDamage notNil ifTrue:[
- aDamage view == aView ifTrue:[
- damage at:i put:nil
- ]
- ]
- ].
- 1 to: mouseAndKeyboard size do:[:i |
- |anEvent|
-
- anEvent := mouseAndKeyboard at:i.
- anEvent notNil ifTrue:[
- anEvent view == aView ifTrue:[
- mouseAndKeyboard at:i put:nil
- ]
- ]
- ].
-!
-
flushUserEvents
"throw away all pending user events"
@@ -316,6 +291,50 @@
].
!
+flushExposeEventsFor:aView
+ "throw away all pending expose events for aView;
+ this can be done after a full redraw
+ (or in views, which are always doing full redraws -
+ instead of drawing the clip-area only)"
+
+ damage notNil ifTrue:[
+ 1 to:damage size do:[:index |
+ |aDamage|
+
+ aDamage := damage at:index.
+ aDamage notNil ifTrue:[
+ aDamage view == aView ifTrue:[
+ damage at:index put:nil
+ ]
+ ]
+ ]
+ ].
+!
+
+flushUserEventsFor:aView
+ "throw away all pending user events for aView"
+
+ mouseAndKeyboard notNil ifTrue:[
+ 1 to:mouseAndKeyboard size do:[:i |
+ |anEvent|
+
+ anEvent := mouseAndKeyboard at:i.
+ anEvent notNil ifTrue:[
+ anEvent view == aView ifTrue:[
+ mouseAndKeyboard at:i put:nil
+ ]
+ ]
+ ]
+ ].
+!
+
+flushEventsFor:aView
+ "throw away all events for aView"
+
+ self flushExposeEventsFor:aView.
+ self flushUserEventsFor:aView.
+!
+
pushUserEvent:anEvent
"manually put an event into the queue - this allows
simulation of events (implementation of recorders & playback)."
@@ -370,7 +389,7 @@
!WindowSensor methodsFor:'event processing'!
notifyEventArrival
- "an event arrived - if there is an eventsemaphore,
+ "an event arrived - if there is an eventSemaphore,
signal it, to wake up any controller process"
catchExpose == true ifTrue:[
--- a/WindowingTransformation.st Fri Oct 28 04:16:56 1994 +0100
+++ b/WindowingTransformation.st Fri Oct 28 04:20:20 1994 +0100
@@ -23,9 +23,106 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/WindowingTransformation.st,v 1.6 1994-10-10 02:34:07 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowingTransformation.st,v 1.7 1994-10-28 03:18:22 claus Exp $
'!
+!WindowingTransformation 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libview/WindowingTransformation.st,v 1.7 1994-10-28 03:18:22 claus Exp $
+"
+!
+
+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 are:
+ 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
+
+
+ example (drawing in inches):
+
+ |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
+
+
+ example (drawing in millimeters):
+
+ |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
+
+
+ example (drawing magnified):
+
+ |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
+
+
+ example (drawing shrunk):
+
+ |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
+
+
+ example (transforming Points, Rectangles etc.)
+
+
+ |p pNew|
+
+ p := 10@10.
+ pNew := (WindowingTransformation scale:2 translation:10) applyTo:p.
+ pNew
+"
+! !
+
!WindowingTransformation class methodsFor:'instance creation'!
unit:unitSymbol on:device
@@ -61,20 +158,49 @@
pixelPerUnitH := device horizontalPixelPerInch
] ifFalse:[
"sorry: unknown unit is taken as pixel"
- ^ self new scale:nil translation:(0 @ 0)
+ ^ self new scale:nil translation:nil
]
]
]
]
].
- ^ self new scale:(pixelPerUnitH @ pixelPerUnitV) translation:0
+ ^ self basicNew scale:(pixelPerUnitH @ pixelPerUnitV) translation:nil
+
+ "
+ |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
+ "
!
scale:aScale translation:aTranslation
"returns a windowing transformation with a scale factor of
aScale and a translation offset of aTranslation."
- ^ self new scale:aScale translation:aTranslation
+ ^ self basicNew scale:aScale translation:aTranslation
+
+ "
+ |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
+ "
!
window:sourceRectangle viewport:destinationRectangle
@@ -85,61 +211,42 @@
represents the logical coordinateSpace while destinationRectangle
represents the device coordinateSpace."
- |sX sY tX tY newScale|
+ |sX sY tX tY newScale newTranslation|
sX := destinationRectangle width / sourceRectangle width.
sY := destinationRectangle height / sourceRectangle height.
tX := destinationRectangle left - sourceRectangle left.
tY := destinationRectangle top - sourceRectangle top.
+ ((tX = 1.0) and:[tY = 1.0]) ifTrue:[
+ newTranslation := nil
+ ] ifFalse:[
+ newTranslation := tX @ tY
+ ].
((sX = 1.0) and:[sY = 1.0]) ifTrue:[
- newScale := 1 @ 1
+ newScale := nil
] ifFalse:[
newScale := sX @ sY
].
- ^ self new scale:newScale translation:(tX @ tY)
+ ^ self basicNew scale:newScale translation:newTranslation
+
+ "
+ |v|
+
+ v := View new realize.
+ (Delay forSeconds:3) wait.
+ v transformation:(WindowingTransformation
+ window:(0@0 corner:1@1)
+ viewport:(0@0 corner:100@100)).
+ 'now, we can think of drawing in 0..1/0..1 coordinates'.
+ v displayLineFrom:0.1@0.1 to:0.9@0.9
+ "
!
identity
- "returns a windowing transformation with no scaling (nil)
+ "returns a windowing transformation with no scaling (1@1)
and no translation (0@0)."
- ^ self new scale:1 translation:0
-! !
-
-!WindowingTransformation 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.
-"
-!
-
-version
-"
-$Header: /cvs/stx/stx/libview/WindowingTransformation.st,v 1.6 1994-10-10 02:34:07 claus Exp $
-"
-!
-
-documentation
-"
- I represent the ability to perform transformations in 2-D space.
-
- Instance variables are:
- scale <Number> or <Point> representing a linear scaling factor.
- translation <Number> or <Point> representing a translation in 2-D.
-
- All 2-D objects are supposed to be able to be transformed using
- instances of me. Instances of me can also be combined to form a
- single composite transformation.
-"
+ ^ self basicNew scale:nil translation:nil
! !
!WindowingTransformation methodsFor:'applying transform'!
@@ -148,47 +255,36 @@
"Apply the receiver to a number representing an x-coordinate
and return the result."
- scale isNil ifTrue:[
- ^ aNumber + translation x
- ].
- ^ (aNumber * scale x + translation x) asInteger
+ |t s|
+
+ scale isNil ifTrue:[s := 1] ifFalse:[s := scale x].
+ translation isNil ifTrue:[t := 0] ifFalse:[t := translation x].
+ ^ aNumber * s + t
!
applyToY:aNumber
"Apply the receiver to a number representing an y-coordinate
and return the result."
- scale isNil ifTrue:[
- ^ aNumber + translation y
- ].
- ^ (aNumber * scale y + translation y) asInteger
+ |t s|
+
+ scale isNil ifTrue:[s := 1] ifFalse:[s := scale y].
+ translation isNil ifTrue:[t := 0] ifFalse:[t := translation y].
+ ^ aNumber * s + t
+!
+
+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) asInteger
-!
-
-applyScaleX:aNumber
- "apply the scale only (if widths are to be transformed)"
-
- scale isNil ifTrue:[^ aNumber].
- ^ (aNumber * scale x) asInteger
-!
-
-applyInverseTo:anObject
- "Apply the inverse of the receiver to anObject
- and return the result."
-
- |transformedObject|
-
- transformedObject := anObject translatedBy:(self inverseTranslation).
- scale == nil ifFalse:[
- transformedObject scaleBy:(self inverseScale)
- ].
- ^ transformedObject
+ ^ aNumber * scale y
!
applyTo:anObject
@@ -196,14 +292,92 @@
|transformedObject|
- scale == nil ifTrue:[
- ^ anObject translateBy:translation.
+ scale isNil ifTrue:[
+ translation isNil ifTrue:[
+ ^ anObject
+ ].
+ ^ anObject translatedBy:translation
+ ].
+ transformedObject := anObject scaledBy:scale.
+ translation notNil ifTrue:[
+ transformedObject translateBy:translation.
].
- transformedObject := anObject scaledBy:scale
- transformedObject translateBy:translation.
^ transformedObject
!
+applyInverseToX:aNumber
+ "Apply the receiver to a number representing an x-coordinate
+ and return the result."
+
+ |t s|
+
+ scale isNil ifTrue:[s := 1] ifFalse:[s := scale x].
+ translation isNil ifTrue:[t := 0] ifFalse:[t := translation x].
+ ^ (aNumber - t) / s
+!
+
+applyInverseToY:aNumber
+ "Apply the receiver to a number representing an y-coordinate
+ and return the result."
+
+ |t s|
+
+ scale isNil ifTrue:[s := 1] ifFalse:[s := scale y].
+ translation isNil ifTrue:[t := 0] ifFalse:[t := translation y].
+ ^ (aNumber - t) / s
+!
+
+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."
+
+ |transformedObject|
+
+ translation isNil ifTrue:[
+ scale isNil ifTrue:[
+ ^ anObject
+ ].
+ ^ anObject scaledBy:self inverseScale
+ ].
+ transformedObject := anObject translatedBy:(self inverseTranslation).
+ scale notNil ifTrue:[
+ transformedObject scaleBy:(self inverseScale).
+ ].
+ ^ transformedObject
+!
+
+transformPoint:p
+ "Apply the receiver to a point.
+ This is destructive in that the point is being modified,
+ not a copy."
+
+ scale isNil ifTrue:[
+ translation isNil ifTrue:[
+ ^ p
+ ].
+ ^ p + translation
+ ].
+ translation isNil ifTrue:[
+ ^ p * scale
+ ].
+ ^ (p * scale + translation)
+!
+
compose:aTransformation
"return a new WindowingTransformation that is the
composition of the receiver and aTransformation.
@@ -215,7 +389,7 @@
|aTransformationScale newScale newTranslation|
aTransformationScale := aTransformation scale.
- scale == nil ifTrue:[
+ scale isNil ifTrue:[
aTransformation noScale ifTrue:[
newScale := nil
] ifFalse:[
@@ -243,7 +417,7 @@
This is a destructive operation, modifying the transformation
represented by the receiver"
- |newScale newTranslation|
+ |newScale|
aScale isNil ifTrue:[^ self].
@@ -252,7 +426,9 @@
] ifFalse:[
newScale := scale * aScale
].
- translation := translation * aScale.
+ translation notNil ifTrue:[
+ translation := translation * aScale.
+ ].
scale := newScale.
!
@@ -279,17 +455,19 @@
|checkedScale newScale newTranslation|
- aScale == nil ifTrue:[
+ aScale isNil ifTrue:[
newScale := scale.
newTranslation := translation
] ifFalse:[
checkedScale := self checkScale:aScale.
- scale == nil ifTrue:[
+ scale isNil ifTrue:[
newScale := checkedScale
] ifFalse:[
newScale := scale * checkedScale
].
- newTranslation := checkedScale * translation
+ translation notNil ifTrue:[
+ newTranslation := checkedScale * translation
+ ]
].
^ (self class)
scale:newScale
@@ -345,35 +523,50 @@
scale:aScale translation:aTranslation
"sets the scale to aScale and the translation to aTranslation."
- scale := aScale asPoint.
- translation := aTranslation asPoint
+ aScale isNil ifTrue:[
+ scale := aScale
+ ] ifFalse:[
+ scale := aScale asPoint.
+ ].
+ aTranslation isNil ifTrue:[
+ translation := aTranslation
+ ] ifFalse:[
+ translation := aTranslation asPoint
+ ]
!
-translation:aValue
- "Set the receiver's translation to aValue, a Point or Number."
+translation:aTranslation
+ "Set the receiver's translation to aTranslation, a Point or Number."
- translation := aValue asPoint
+ aTranslation isNil ifTrue:[
+ translation := aTranslation
+ ] ifFalse:[
+ translation := aTranslation asPoint
+ ]
!
-scale:aValue
- "Set the receiver's scale to aValue, a Point or Number."
+scale:aScale
+ "Set the receiver's scale to aScale, a Point or Number."
- scale := aValue asPoint
+ aScale isNil ifTrue:[
+ scale := aScale
+ ] ifFalse:[
+ scale := aScale asPoint.
+ ].
!
scale
"return a copy of the Point that represents the
current scale of the receiver."
- scale == nil ifTrue:[
- ^ Point x:1 y:1
- ].
+ scale isNil ifTrue:[^ (1@1) copy].
^ scale copy
!
translation
"return a copy of the receiver's translation."
+ translation isNil ifTrue:[^ (0@0) copy].
^ translation copy
!
@@ -397,7 +590,7 @@
printOn:aStream
aStream nextPutAll:self class name.
aStream nextPutAll:' scale: '.
- scale printOn:aStream
+ scale printOn:aStream.
aStream nextPutAll:' translation: '.
translation printOn:aStream
! !
--- a/XWorkstat.st Fri Oct 28 04:16:56 1994 +0100
+++ b/XWorkstat.st Fri Oct 28 04:20:20 1994 +0100
@@ -30,7 +30,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.23 1994-10-21 16:19:44 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.24 1994-10-28 03:18:15 claus Exp $
'!
!XWorkstation class methodsFor:'documentation'!
@@ -51,7 +51,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.23 1994-10-21 16:19:44 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.24 1994-10-28 03:18:15 claus Exp $
"
!
@@ -61,6 +61,8 @@
"
! !
+!XWorkstation primitiveDefinitions!
+
%{
/*
* x does a typedef Time - I need Object Time ...
@@ -124,6 +126,63 @@
# endif
#endif
+/*
+ * some defines - tired of typing ...
+ */
+#if defined(hpux) && defined(POSITIVE_ADDRESSES)
+# define _DisplayVal(o) (Display *)((int)(o) & ~TAG_INT)
+# define _WindowVal(o) (Window)((int)(o) & ~TAG_INT)
+# define _PixmapVal(o) (Pixmap)((int)(o) & ~TAG_INT)
+# define _GCVal(o) (GC)((int)(o) & ~TAG_INT)
+# define _CursorVal(o) (Cursor)((int)(o) & ~TAG_INT)
+# define _FontVal(o) (XFontStruct *)((int)(o) & ~TAG_INT)
+# define _AtomVal(o) (Atom)((int)(o) & ~TAG_INT)
+# define _DPSContextVal(o) (DPSContext)((int)(o) & ~TAG_INT)
+#else
+# define _DisplayVal(o) (Display *)(_intVal(o))
+# define _WindowVal(o) (Window)(_intVal(o))
+# define _PixmapVal(o) (Pixmap)(_intVal(o))
+# define _GCVal(o) (GC)(_intVal(o))
+# define _CursorVal(o) (Cursor)(_intVal(o))
+# define _FontVal(o) (XFontStruct *)(_intVal(o))
+# define _AtomVal(o) (Atom)(_intVal(o))
+# define _DPSContextVal(o) (DPSContext)(_intVal(o))
+#endif
+
+#define myDpy _DisplayVal(_INST(displayId))
+
+#ifndef THISCONTEXT_IN_REGISTER
+# define BLOCKINTERRUPTS() /* */
+# define UNBLOCKINTERRUPTS() /* */
+# define BEGIN_INTERRUPTSBLOCKED /* */
+# define END_INTERRUPTSBLOCKED /* */
+#else
+extern int __interruptsBlocked;
+# define BEGIN_INTERRUPTSBLOCKED \
+ { \
+ int needUnblock = 0; \
+ extern OBJ __thisContext__; \
+ \
+ __thisContext__ = __thisContext;\
+ if (!__interruptsBlocked) { \
+ BLOCKINTERRUPTS(); \
+ needUnblock = 1; \
+ }
+
+# define END_INTERRUPTSBLOCKED \
+ if (needUnblock) { \
+ UNBLOCKINTERRUPTS(); \
+ } \
+ __thisContext__ = 0; \
+ }
+
+#endif
+%}
+! !
+
+!XWorkstation primitiveVariables!
+
+%{
static XEvent __ev__;
/*
@@ -133,10 +192,18 @@
static unsigned lastRequestCode = 0;
static unsigned lastMinorCode = 0;
static unsigned lastResource = 0;
-
+%}
+! !
+
+!XWorkstation primitiveFunctions!
+
+%{
/*
* catch X-errors and forward as errorInterrupt,
* (which itself raises an exceptionSignal)
+ * the implementation below is soewhat wrong: it will
+ * report all errors for Display, even though there could be
+ * more than one display connection.
*/
__XErrorHandler__(dpy, event)
Display *dpy;
@@ -205,60 +272,8 @@
#endif
return root;
}
-
-/*
- * some defines - tired of typing ...
- */
-#if defined(hpux) && defined(POSITIVE_ADDRESSES)
-# define _DisplayVal(o) (Display *)((int)(o) & ~TAG_INT)
-# define _WindowVal(o) (Window)((int)(o) & ~TAG_INT)
-# define _PixmapVal(o) (Pixmap)((int)(o) & ~TAG_INT)
-# define _GCVal(o) (GC)((int)(o) & ~TAG_INT)
-# define _CursorVal(o) (Cursor)((int)(o) & ~TAG_INT)
-# define _FontVal(o) (XFontStruct *)((int)(o) & ~TAG_INT)
-# define _AtomVal(o) (Atom)((int)(o) & ~TAG_INT)
-# define _DPSContextVal(o) (DPSContext)((int)(o) & ~TAG_INT)
-#else
-# define _DisplayVal(o) (Display *)(_intVal(o))
-# define _WindowVal(o) (Window)(_intVal(o))
-# define _PixmapVal(o) (Pixmap)(_intVal(o))
-# define _GCVal(o) (GC)(_intVal(o))
-# define _CursorVal(o) (Cursor)(_intVal(o))
-# define _FontVal(o) (XFontStruct *)(_intVal(o))
-# define _AtomVal(o) (Atom)(_intVal(o))
-# define _DPSContextVal(o) (DPSContext)(_intVal(o))
-#endif
-
-#define myDpy _DisplayVal(_INST(displayId))
-
-#ifndef THISCONTEXT_IN_REGISTER
-# define BLOCKINTERRUPTS() /* */
-# define UNBLOCKINTERRUPTS() /* */
-# define BEGIN_INTERRUPTSBLOCKED /* */
-# define END_INTERRUPTSBLOCKED /* */
-#else
-extern int __interruptsBlocked;
-# define BEGIN_INTERRUPTSBLOCKED \
- { \
- int needUnblock = 0; \
- extern OBJ __thisContext__; \
- \
- __thisContext__ = __thisContext;\
- if (!__interruptsBlocked) { \
- BLOCKINTERRUPTS(); \
- needUnblock = 1; \
- }
-
-# define END_INTERRUPTSBLOCKED \
- if (needUnblock) { \
- UNBLOCKINTERRUPTS(); \
- } \
- __thisContext__ = 0; \
- }
-
-#endif
-
%}
+! !
!XWorkstation class methodsFor:'initialization'!
@@ -289,14 +304,35 @@
%}
!
+errorStringOfLastError
+%{
+ RETURN ( _MKSTRING(lastErrorMsg, __context) );
+%}
+!
+
lastError
"return the last X-error string -
when buffering is on, this may be
an error for a long-ago operation"
-%{
-
- RETURN ( _MKSTRING(lastErrorMsg, __context) );
-%}
+
+ |string requestCode s match line|
+
+ string := self errorStringOfLastError.
+ requestCode := self requestCodeOfLastError.
+ "
+ X specific: search the requestCode in '/usr/lib/X11/XErrorDB',
+ and append the name of the corresponding X-request
+ "
+ s := '/usr/lib/X11/XErrorDB' asFilename readStream.
+ s notNil ifTrue:[
+ match := 'XRequest.' , requestCode printString.
+ line := s peekForLineStartingWith:match.
+ line notNil ifTrue:[
+ string := string , ' in ' , (line copyFrom:(line indexOf:$:)+1)
+ ].
+ s close.
+ ].
+ ^ string
! !
!XWorkstation methodsFor:'initialize / release'!
@@ -713,7 +749,7 @@
^ formatArray
"
- Display supportedFormats
+ Display supportedImageFormats
"
!
@@ -2317,7 +2353,7 @@
%{ /* NOCONTEXT */
- int result;
+ int result, ok;
Window confineWin;
Cursor curs;
int pointer_mode, keyboard_mode;
@@ -2354,21 +2390,29 @@
CurrentTime);
END_INTERRUPTSBLOCKED
+ ok = 0;
switch (result) {
case AlreadyGrabbed:
printf("grab pointer: AlreadyGrabbed\n");
- RETURN (false);
+ break;
case GrabNotViewable:
printf("grab pointer: GrabNotViewable\n");
- RETURN (false);
+ break;
case GrabInvalidTime:
printf("grab pointer: InvalidTime\n");
- RETURN (false);
+ break;
case GrabFrozen:
printf("grab pointer: Frozen\n");
- RETURN (false);
+ break;
+ default:
+ ok = 1;
+ break;
}
+ if (! ok) {
+ XUngrabPointer(myDpy, CurrentTime);
+ RETURN (false);
+ }
RETURN ( true );
}
%}
--- a/XWorkstation.st Fri Oct 28 04:16:56 1994 +0100
+++ b/XWorkstation.st Fri Oct 28 04:20:20 1994 +0100
@@ -30,7 +30,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.23 1994-10-21 16:19:44 claus Exp $
+$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.24 1994-10-28 03:18:15 claus Exp $
'!
!XWorkstation class methodsFor:'documentation'!
@@ -51,7 +51,7 @@
version
"
-$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.23 1994-10-21 16:19:44 claus Exp $
+$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.24 1994-10-28 03:18:15 claus Exp $
"
!
@@ -61,6 +61,8 @@
"
! !
+!XWorkstation primitiveDefinitions!
+
%{
/*
* x does a typedef Time - I need Object Time ...
@@ -124,6 +126,63 @@
# endif
#endif
+/*
+ * some defines - tired of typing ...
+ */
+#if defined(hpux) && defined(POSITIVE_ADDRESSES)
+# define _DisplayVal(o) (Display *)((int)(o) & ~TAG_INT)
+# define _WindowVal(o) (Window)((int)(o) & ~TAG_INT)
+# define _PixmapVal(o) (Pixmap)((int)(o) & ~TAG_INT)
+# define _GCVal(o) (GC)((int)(o) & ~TAG_INT)
+# define _CursorVal(o) (Cursor)((int)(o) & ~TAG_INT)
+# define _FontVal(o) (XFontStruct *)((int)(o) & ~TAG_INT)
+# define _AtomVal(o) (Atom)((int)(o) & ~TAG_INT)
+# define _DPSContextVal(o) (DPSContext)((int)(o) & ~TAG_INT)
+#else
+# define _DisplayVal(o) (Display *)(_intVal(o))
+# define _WindowVal(o) (Window)(_intVal(o))
+# define _PixmapVal(o) (Pixmap)(_intVal(o))
+# define _GCVal(o) (GC)(_intVal(o))
+# define _CursorVal(o) (Cursor)(_intVal(o))
+# define _FontVal(o) (XFontStruct *)(_intVal(o))
+# define _AtomVal(o) (Atom)(_intVal(o))
+# define _DPSContextVal(o) (DPSContext)(_intVal(o))
+#endif
+
+#define myDpy _DisplayVal(_INST(displayId))
+
+#ifndef THISCONTEXT_IN_REGISTER
+# define BLOCKINTERRUPTS() /* */
+# define UNBLOCKINTERRUPTS() /* */
+# define BEGIN_INTERRUPTSBLOCKED /* */
+# define END_INTERRUPTSBLOCKED /* */
+#else
+extern int __interruptsBlocked;
+# define BEGIN_INTERRUPTSBLOCKED \
+ { \
+ int needUnblock = 0; \
+ extern OBJ __thisContext__; \
+ \
+ __thisContext__ = __thisContext;\
+ if (!__interruptsBlocked) { \
+ BLOCKINTERRUPTS(); \
+ needUnblock = 1; \
+ }
+
+# define END_INTERRUPTSBLOCKED \
+ if (needUnblock) { \
+ UNBLOCKINTERRUPTS(); \
+ } \
+ __thisContext__ = 0; \
+ }
+
+#endif
+%}
+! !
+
+!XWorkstation primitiveVariables!
+
+%{
static XEvent __ev__;
/*
@@ -133,10 +192,18 @@
static unsigned lastRequestCode = 0;
static unsigned lastMinorCode = 0;
static unsigned lastResource = 0;
-
+%}
+! !
+
+!XWorkstation primitiveFunctions!
+
+%{
/*
* catch X-errors and forward as errorInterrupt,
* (which itself raises an exceptionSignal)
+ * the implementation below is soewhat wrong: it will
+ * report all errors for Display, even though there could be
+ * more than one display connection.
*/
__XErrorHandler__(dpy, event)
Display *dpy;
@@ -205,60 +272,8 @@
#endif
return root;
}
-
-/*
- * some defines - tired of typing ...
- */
-#if defined(hpux) && defined(POSITIVE_ADDRESSES)
-# define _DisplayVal(o) (Display *)((int)(o) & ~TAG_INT)
-# define _WindowVal(o) (Window)((int)(o) & ~TAG_INT)
-# define _PixmapVal(o) (Pixmap)((int)(o) & ~TAG_INT)
-# define _GCVal(o) (GC)((int)(o) & ~TAG_INT)
-# define _CursorVal(o) (Cursor)((int)(o) & ~TAG_INT)
-# define _FontVal(o) (XFontStruct *)((int)(o) & ~TAG_INT)
-# define _AtomVal(o) (Atom)((int)(o) & ~TAG_INT)
-# define _DPSContextVal(o) (DPSContext)((int)(o) & ~TAG_INT)
-#else
-# define _DisplayVal(o) (Display *)(_intVal(o))
-# define _WindowVal(o) (Window)(_intVal(o))
-# define _PixmapVal(o) (Pixmap)(_intVal(o))
-# define _GCVal(o) (GC)(_intVal(o))
-# define _CursorVal(o) (Cursor)(_intVal(o))
-# define _FontVal(o) (XFontStruct *)(_intVal(o))
-# define _AtomVal(o) (Atom)(_intVal(o))
-# define _DPSContextVal(o) (DPSContext)(_intVal(o))
-#endif
-
-#define myDpy _DisplayVal(_INST(displayId))
-
-#ifndef THISCONTEXT_IN_REGISTER
-# define BLOCKINTERRUPTS() /* */
-# define UNBLOCKINTERRUPTS() /* */
-# define BEGIN_INTERRUPTSBLOCKED /* */
-# define END_INTERRUPTSBLOCKED /* */
-#else
-extern int __interruptsBlocked;
-# define BEGIN_INTERRUPTSBLOCKED \
- { \
- int needUnblock = 0; \
- extern OBJ __thisContext__; \
- \
- __thisContext__ = __thisContext;\
- if (!__interruptsBlocked) { \
- BLOCKINTERRUPTS(); \
- needUnblock = 1; \
- }
-
-# define END_INTERRUPTSBLOCKED \
- if (needUnblock) { \
- UNBLOCKINTERRUPTS(); \
- } \
- __thisContext__ = 0; \
- }
-
-#endif
-
%}
+! !
!XWorkstation class methodsFor:'initialization'!
@@ -289,14 +304,35 @@
%}
!
+errorStringOfLastError
+%{
+ RETURN ( _MKSTRING(lastErrorMsg, __context) );
+%}
+!
+
lastError
"return the last X-error string -
when buffering is on, this may be
an error for a long-ago operation"
-%{
-
- RETURN ( _MKSTRING(lastErrorMsg, __context) );
-%}
+
+ |string requestCode s match line|
+
+ string := self errorStringOfLastError.
+ requestCode := self requestCodeOfLastError.
+ "
+ X specific: search the requestCode in '/usr/lib/X11/XErrorDB',
+ and append the name of the corresponding X-request
+ "
+ s := '/usr/lib/X11/XErrorDB' asFilename readStream.
+ s notNil ifTrue:[
+ match := 'XRequest.' , requestCode printString.
+ line := s peekForLineStartingWith:match.
+ line notNil ifTrue:[
+ string := string , ' in ' , (line copyFrom:(line indexOf:$:)+1)
+ ].
+ s close.
+ ].
+ ^ string
! !
!XWorkstation methodsFor:'initialize / release'!
@@ -713,7 +749,7 @@
^ formatArray
"
- Display supportedFormats
+ Display supportedImageFormats
"
!
@@ -2317,7 +2353,7 @@
%{ /* NOCONTEXT */
- int result;
+ int result, ok;
Window confineWin;
Cursor curs;
int pointer_mode, keyboard_mode;
@@ -2354,21 +2390,29 @@
CurrentTime);
END_INTERRUPTSBLOCKED
+ ok = 0;
switch (result) {
case AlreadyGrabbed:
printf("grab pointer: AlreadyGrabbed\n");
- RETURN (false);
+ break;
case GrabNotViewable:
printf("grab pointer: GrabNotViewable\n");
- RETURN (false);
+ break;
case GrabInvalidTime:
printf("grab pointer: InvalidTime\n");
- RETURN (false);
+ break;
case GrabFrozen:
printf("grab pointer: Frozen\n");
- RETURN (false);
+ break;
+ default:
+ ok = 1;
+ break;
}
+ if (! ok) {
+ XUngrabPointer(myDpy, CurrentTime);
+ RETURN (false);
+ }
RETURN ( true );
}
%}