--- a/Color.st Tue Apr 23 22:06:00 1996 +0200
+++ b/Color.st Tue Apr 23 22:12:21 1996 +0200
@@ -62,7 +62,7 @@
However, doing so may make things worse when displaying bitmap images, since this
preallocated table may steal colors from the image ...
- Instance variables:
+ [Instance variables:]
redVal <Number> the red component (0..100)
greenVal <Number> the green component (0..100)
@@ -72,10 +72,10 @@
ditherForm <Form> the Form to dither this color (if non-nil)
writable <Boolean> true if this is for a writable color cell
- Class variables:
+ [Class variables:]
Lobby <Registry> all colors in use - keeps track of already allocated
- colors for reuse and finalization.
+ colors for reuse and finalization.
Cells <Registry> keeps track of allocated writable color cells
FixColors <Array> preallocated colors for dithering on Display
@@ -98,31 +98,36 @@
Blue <Color> blue, for dithering
DitherColors <Collection> some preallocated colors for dithering
- (kept, so they are available when needed)
+ (kept, so they are available when needed)
RetryAllocation <Boolean> this flag controls how a request for a
- color should be handled which failed previously.
- I.e. a color is asked for, which was dithered
- the last time. Since it could happen, that in
- the meantime more colors became free, the request
- might succeed this time - however, your screen may
- look a bit funny, due to having both dithered and
- undithered versions around.
- The default is true, which means: do retry
+ color should be handled which failed previously.
+ I.e. a color is asked for, which was dithered
+ the last time. Since it could happen, that in
+ the meantime more colors became free, the request
+ might succeed this time - however, your screen may
+ look a bit funny, due to having both dithered and
+ undithered versions around.
+ The default is true, which means: do retry
compatibility issues:
- ST-80 seems to represent colors internally with scaled smallInteger
- components (this can be guessed from uses of
- scaledRed:scaledGreen:scaledBlue:). The main instance creation method is
- via 'ColorValue red:green:blue:', passing components in 0..1.
- In ST/X, component are internally represented as percent.
- For more compatibility (when subclassing color), these internals may
- change in the near future. For migration, a compatibility subclass
- called ColorValue is provided.
- After the change, Color will be renamed to ColorValue and Color
- be made a subclass of ColorValue (offering the 0..100 interface for
- backward compatibility).
+ ST-80 seems to represent colors internally with scaled smallInteger
+ components (this can be guessed from uses of
+ scaledRed:scaledGreen:scaledBlue:). The main instance creation method is
+ via 'ColorValue red:green:blue:', passing components in 0..1.
+ In ST/X, component are internally represented as percent.
+ For more compatibility (when subclassing color), these internals may
+ change in the near future. For migration, a compatibility subclass
+ called ColorValue is provided.
+ After the change, Color will be renamed to ColorValue and Color
+ be made a subclass of ColorValue (offering the 0..100 interface for
+ backward compatibility).
+
+ [see also:]
+ DeviceWorkstation
+ GraphicsContext DeviceDrawable Form Image Colormap
+ Font Cursor
"
! !
@@ -2726,6 +2731,6 @@
!Color class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Color.st,v 1.39 1996-04-23 11:40:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Color.st,v 1.40 1996-04-23 20:12:21 cg Exp $'
! !
Color initialize!
--- a/Cursor.st Tue Apr 23 22:06:00 1996 +0200
+++ b/Cursor.st Tue Apr 23 22:12:21 1996 +0200
@@ -42,28 +42,33 @@
"
I represents cursors in a device independent manner.
Normally, cursors are defined at view creation time,
- via 'aView cursor:aCursor'.
+ via
+ 'aView cursor:aCursor'.
+
+ [Instance variables:]
- Instance variables:
+ shape <Symbol> a shape (i.e. #arrow, #hand, ...) or nil
+ sourceForm <Form> if shape is nil, the source bits
+ maskForm <Form> if shape is nil, the mask bits
+ hotX <SmallInteger> if shape is nil, the hotSpot x of the cursor
+ hotY <SmallInteger> if shape is nil, the hotSpot y of the cursor
+ device <aDevice> the device, if associated to one
+ cursorId <anObject> the device-specific id if device is nonNil
- shape <Symbol> a shape (i.e. #arrow, #hand, ...) or nil
- sourceForm <Form> if shape is nil, the source bits
- maskForm <Form> if shape is nil, the mask bits
- hotX <SmallInteger> if shape is nil, the hotSpot x of the cursor
- hotY <SmallInteger> if shape is nil, the hotSpot y of the cursor
- device <aDevice> the device, if associated to one
- cursorId <anObject> the device-specific id if device is nonNil
+ [class variables:]
+
+ Lobby <Registry> keeps track of known device cursors
+
+ DefaultFgColor <Color> default foreground color for cursors (usually black)
+ DefaultBgColor <Color> default background color for cursors (usually white)
- class variables:
-
- Lobby <Registry> keeps track of known device cursors
+ NormalCursor <Cursor> cached instance of normal (arrow) cursor
+ ...
- DefaultFgColor <Color> default foreground color for cursors (usually black)
- DefaultBgColor <Color> default background color for cursors (usually white)
-
- NormalCursor <Cursor> cached instance of normal (arrow) cursor
- ...
-
+ [see also:]
+ DeviceWorkstation
+ PseudoView
+ Font Cursor Color
"
!
@@ -1265,7 +1270,7 @@
2r0001111111110000
2r0000011111000000
)
- offset: -8 @ -8).
+ offset: -8 @-8).
EyeCursor := (Cursor
extent: 16@16
@@ -1305,7 +1310,7 @@
2r0000000000000000
2r0000000000000000
)
- offset: -8 @ -8).
+ offset: -8 @-8).
device := Display.
@@ -1923,6 +1928,6 @@
!Cursor class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Cursor.st,v 1.27 1996-04-20 21:24:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Cursor.st,v 1.28 1996-04-23 20:11:54 cg Exp $'
! !
Cursor initialize!
--- a/DMedium.st Tue Apr 23 22:06:00 1996 +0200
+++ b/DMedium.st Tue Apr 23 22:12:21 1996 +0200
@@ -11,11 +11,10 @@
"
GraphicsContext subclass:#DisplayMedium
- instanceVariableNames:'width height
- clipRect window'
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:'width height clipRect window'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
!DisplayMedium class methodsFor:'documentation'!
@@ -34,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/DMedium.st,v 1.14 1996-01-24 15:37:00 ah Exp $'
-!
-
documentation
"
this is an abstract superclass for all kinds of drawables which
@@ -52,123 +47,44 @@
"
! !
-!DisplayMedium methodsFor:'initialization'!
-
-initialize
- "set up some useful default values"
-
- super initialize.
+!DisplayMedium methodsFor:'GC access'!
- width := 0.
- height := 0
-! !
-
-!DisplayMedium ignoredMethodsFor:'accessing'!
+at:aPoint
+ "return pixel value at coordinate"
-insideWidth
- "return the usable width for drawing in the receiver;
- this is width here, but Views/Pages may subtract margins"
-
- ^ width
+ ^ self subclassResponsibility
!
-insideHeight
- "return the usable height for drawing in the receiver;
- this is height here, but Views/Pages may subtract margins"
+drawPattern:aPattern
+ "set the pattern to be drawn with - the pattern may be a color,
+ a bitmap or pixmap"
- ^ height
+ aPattern isColor ifTrue:[
+ self paint:aPattern
+ ] ifFalse:[
+ self mask:aPattern
+ ]
!
-insideLeftOffset
- "return the left offset for drawing in the receiver;
- this is 0 here, but Views/Pages may add margins"
+gc
+ "ST-80 compatibility;
+ in STX a displayMedium is its own graphicsContext"
- ^ 0
-!
-
-insideTopOffset
- "return the top offset for drawing in the receiver;
- this is 0 here, but Views/Pages may add margins"
-
- ^ 0
+ ^ self
! !
!DisplayMedium methodsFor:'accessing'!
-isView
- "return true, if the receiver is a view"
-
- ^ false
-!
-
-origin
- "return the origin i.e. coordinate of top-left of the receiver"
-
- ^ 0 @ 0
-!
-
-left
- "return the left i.e. x-coordinate of top-left of the receiver"
+bottomCenter
+ "return the topCenter point"
- ^ 0
-!
-
-top
- "return the top i.e. y-coordinate of top-left of the receiver"
-
- ^ 0
-!
-
-width
- "return the width of the receiver"
-
- ^ width
-!
-
-width:anInteger
- "set the width of the receiver"
-
- width := anInteger
+ ^ (self left + (width//2) - 1) @ (self top + height - 1)
!
-height
- "return the height of the receiver"
-
- ^ height
-!
-
-height:anInteger
- "set the height of the receiver"
-
- height := anInteger
-!
-
-width:w height:h
- "set both width and height of the receiver"
-
- width := w.
- height := h
-!
+bottomLeft
+ "return the bottomLeft point"
-setWidth:w height:h
- "set both width and height - not to be redefined"
-
- width := w.
- height := h
-!
-
-extent
- "return the extent i.e. a point with width as x, height as y
- coordinate"
-
- ^ width @ height
-!
-
-extent:extent
- "set the extent"
-
- width := extent x.
- height := extent y
+ ^ (self left) @ (self top + height - 1)
!
center
@@ -192,28 +108,42 @@
(aPoint y - self top + 1)
!
-topRight
- "return the topRight point"
+extent
+ "return the extent i.e. a point with width as x, height as y
+ coordinate"
- ^ (self left + width - 1) @ (self top)
+ ^ width @ height
+!
+
+extent:extent
+ "set the extent"
+
+ width := extent x.
+ height := extent y
!
-bottomLeft
- "return the bottomLeft point"
+height
+ "return the height of the receiver"
- ^ (self left) @ (self top + height - 1)
+ ^ height
!
-topCenter
- "return the topCenter point"
+height:anInteger
+ "set the height of the receiver"
- ^ (self left + (width//2) - 1) @ (self top)
+ height := anInteger
!
-bottomCenter
- "return the topCenter point"
+isView
+ "return true, if the receiver is a view"
- ^ (self left + (width//2) - 1) @ (self top + height - 1)
+ ^ false
+!
+
+left
+ "return the left i.e. x-coordinate of top-left of the receiver"
+
+ ^ 0
!
leftCenter
@@ -222,35 +152,110 @@
^ (self left) @ (self top + (height // 2) - 1)
!
+origin
+ "return the origin i.e. coordinate of top-left of the receiver"
+
+ ^ 0 @ 0
+!
+
rightCenter
"return the leftCenter point"
^ (self left + width - 1) @ (self top + (height // 2) - 1)
-! !
+!
+
+setWidth:w height:h
+ "set both width and height - not to be redefined"
+
+ width := w.
+ height := h
+!
-!DisplayMedium methodsFor:'GC access'!
+top
+ "return the top i.e. y-coordinate of top-left of the receiver"
+
+ ^ 0
+!
+
+topCenter
+ "return the topCenter point"
-gc
- "ST-80 compatibility;
- in STX a displayMedium is its own graphicsContext"
+ ^ (self left + (width//2) - 1) @ (self top)
+!
+
+topRight
+ "return the topRight point"
+
+ ^ (self left + width - 1) @ (self top)
+!
- ^ self
+width
+ "return the width of the receiver"
+
+ ^ width
+!
+
+width:anInteger
+ "set the width of the receiver"
+
+ width := anInteger
!
-at:aPoint
- "return pixel value at coordinate"
+width:w height:h
+ "set both width and height of the receiver"
+
+ width := w.
+ height := h
+! !
+
+!DisplayMedium methodsFor:'evaluating in another context'!
- ^ self subclassResponsibility
+clippedTo:aRectangle do:aBlock
+ "evaluate aBlock with clipping rectangle set to aRectangle"
+
+ |oldClip|
+
+ oldClip := clipRect.
+ self clipRect:aRectangle.
+ aBlock value.
+ self clipRect:oldClip
!
-drawPattern:aPattern
- "set the pattern to be drawn with - the pattern may be a color,
- a bitmap or pixmap"
+withFunction:aFunction do:aBlock
+ "evaluate aBlock with function set to aFunction"
+
+ |oldFun|
+
+ oldFun := function.
+ self function:aFunction.
+ aBlock value.
+ self function:oldFun
+!
+
+withMask:aMask do:aBlock
+ "evaluate aBlock with mask set to aMask"
+
+ |oldMask|
+
+ oldMask := mask.
+ self mask:aMask.
+ aBlock value.
+ self mask:oldMask
+!
+
+withPattern:aPattern do:aBlock
+ |old|
aPattern isColor ifTrue:[
- self paint:aPattern
+ old := paint.
+ self paint:aPattern.
+ aBlock value.
+ self paint:old
] ifFalse:[
- self mask:aPattern
+ old := mask.
+ self mask:aPattern.
+ aBlock value.
+ self mask:old
]
! !
@@ -262,18 +267,6 @@
self fill:Black
!
-white
- "fill the receiver with white"
-
- self fill:White
-!
-
-clearInside
- "clear the receiver with background - ST-80 compatibility"
-
- ^ self clear
-!
-
clear
"clear the receiver with background"
@@ -285,6 +278,12 @@
]
!
+clearInside
+ "clear the receiver with background - ST-80 compatibility"
+
+ ^ self clear
+!
+
clearRectangle:aRectangle
"clear the rectangular area in the receiver to background"
@@ -311,6 +310,40 @@
self fillRectangleX:0 y:0 width:width height:height with:something
!
+fillArcX:x y:y w:w h:h from:startAngle angle:angle with:aPattern
+ "fill an arc in the receiver with aPattern,
+ which may be a Color or Form"
+
+ self withPattern:aPattern do:[
+ self fillArcX:x y:y w:w h:h from:startAngle angle:angle
+ ]
+!
+
+fillCircle:aPoint radius:aNumber with:aPattern
+ "fill a circle in the receiver with aPattern,
+ which may be a Color or Form"
+
+ self fillCircleX:(aPoint x) y:(aPoint y) radius:aNumber with:aPattern
+!
+
+fillCircleX:x y:y radius:r with:aPattern
+ "fill a circle with aPattern,
+ which may be a Color or Form"
+
+ |d|
+ d := 2 * r.
+ self fillArcX:(x - r) y:(y - r) w:d h:d from:0 angle:360 with:aPattern
+!
+
+fillPolygon:aPolygon with:aPattern
+ "fill a polygon in the receiver with aPattern,
+ which may be a Form or Color"
+
+ self withPattern:aPattern do:[
+ self fillPolygon:aPolygon
+ ]
+!
+
fillRectangle:aRectangle with:something
"fill the rectangular area in the receiver with something;
something may be a Form, Color or colorIndex"
@@ -340,15 +373,6 @@
"
!
-fillPolygon:aPolygon with:aPattern
- "fill a polygon in the receiver with aPattern,
- which may be a Form or Color"
-
- self withPattern:aPattern do:[
- self fillPolygon:aPolygon
- ]
-!
-
invertRectangle:aRectangle
"invert a rectangle in the receiver"
@@ -357,78 +381,25 @@
]
!
-fillCircle:aPoint radius:aNumber with:aPattern
- "fill a circle in the receiver with aPattern,
- which may be a Color or Form"
-
- self fillCircleX:(aPoint x) y:(aPoint y) radius:aNumber with:aPattern
-!
-
-fillCircleX:x y:y radius:r with:aPattern
- "fill a circle with aPattern,
- which may be a Color or Form"
+white
+ "fill the receiver with white"
- |d|
- d := 2 * r.
- self fillArcX:(x - r) y:(y - r) w:d h:d from:0 angle:360 with:aPattern
-!
-
-fillArcX:x y:y w:w h:h from:startAngle angle:angle with:aPattern
- "fill an arc in the receiver with aPattern,
- which may be a Color or Form"
-
- self withPattern:aPattern do:[
- self fillArcX:x y:y w:w h:h from:startAngle angle:angle
- ]
+ self fill:White
! !
-!DisplayMedium methodsFor:'evaluating in another context'!
-
-withPattern:aPattern do:aBlock
- |old|
+!DisplayMedium methodsFor:'initialization'!
- aPattern isColor ifTrue:[
- old := paint.
- self paint:aPattern.
- aBlock value.
- self paint:old
- ] ifFalse:[
- old := mask.
- self mask:aPattern.
- aBlock value.
- self mask:old
- ]
-!
+initialize
+ "set up some useful default values"
-withMask:aMask do:aBlock
- "evaluate aBlock with mask set to aMask"
-
- |oldMask|
+ super initialize.
- oldMask := mask.
- self mask:aMask.
- aBlock value.
- self mask:oldMask
-!
-
-withFunction:aFunction do:aBlock
- "evaluate aBlock with function set to aFunction"
-
- |oldFun|
+ width := 0.
+ height := 0
+! !
- oldFun := function.
- self function:aFunction.
- aBlock value.
- self function:oldFun
-!
+!DisplayMedium class methodsFor:'documentation'!
-clippedTo:aRectangle do:aBlock
- "evaluate aBlock with clipping rectangle set to aRectangle"
-
- |oldClip|
-
- oldClip := clipRect.
- self clipRect:aRectangle.
- aBlock value.
- self clipRect:oldClip
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/DMedium.st,v 1.15 1996-04-23 20:11:45 cg Exp $'
! !
--- a/DevDraw.st Tue Apr 23 22:06:00 1996 +0200
+++ b/DevDraw.st Tue Apr 23 22:12:21 1996 +0200
@@ -50,17 +50,21 @@
(there are some operations and special cases, for which a direct access to
fg/bg makes sense)
- Instance variables:
-
- device <Device> the device this drawable is on
- drawableId <SmallInteger> my drawableId on the device
- gcId <SmallInteger> my gcs ID on the device
- realized <Boolean> true if visible (i.e. mapped)
- - for bit/pixmaps this is always true
-
- deviceFont <Font> the actual font, currently set in the device
- foreground <Color> the device foreground color used for drawing
- background <Color> the device background color used for drawing
+ [Instance variables:]
+
+ device <Device> the device this drawable is on
+ drawableId <SmallInteger> my drawableId on the device
+ gcId <SmallInteger> my gcs ID on the device
+ realized <Boolean> true if visible (i.e. mapped)
+ - for bit/pixmaps this is always true
+
+ deviceFont <Font> the actual font, currently set in the device
+ foreground <Color> the device foreground color used for drawing
+ background <Color> the device background color used for drawing
+
+ [see also:]
+ DeviceWorkstation
+ Color Font Cursor
"
! !
@@ -3013,6 +3017,6 @@
!DeviceDrawable class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.42 1996-04-18 14:49:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.43 1996-04-23 20:11:01 cg Exp $'
! !
DeviceDrawable initialize!
--- a/DevFormH.st Tue Apr 23 22:06:00 1996 +0200
+++ b/DevFormH.st Tue Apr 23 22:12:21 1996 +0200
@@ -10,13 +10,11 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 25-may-1995 at 7:37:41 am'!
-
DeviceHandle subclass:#DeviceFormHandle
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
!DeviceFormHandle class methodsFor:'documentation'!
@@ -42,11 +40,10 @@
devices bitmap. To make the memory requirements smaller and to speed up
bitmap creation a bit, this lightweight class is used now, which only
keeps the device handle for finalization.
+
+ [see also:]
+ Form
"
-!
-
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/DevFormH.st,v 1.5 1995-12-03 14:29:20 cg Exp $'
! !
!DeviceFormHandle methodsFor:'finalization'!
@@ -63,3 +60,9 @@
drawableId := nil
]
! !
+
+!DeviceFormHandle class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/DevFormH.st,v 1.6 1996-04-23 20:11:33 cg Exp $'
+! !
--- a/DevHandle.st Tue Apr 23 22:06:00 1996 +0200
+++ b/DevHandle.st Tue Apr 23 22:12:21 1996 +0200
@@ -10,13 +10,11 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 25-may-1995 at 7:37:35 am'!
-
Object subclass:#DeviceHandle
- instanceVariableNames:'device drawableId gcId'
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:'device drawableId gcId'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
!DeviceHandle class methodsFor:'documentation'!
@@ -44,17 +42,26 @@
fonts could also make use of this class - however, for historical reasons,
they continue to use their own private finalization machanisms. This may
change in future versions).
+
+ [see also:]
+ DeviceDrawable
"
-!
-
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/DevHandle.st,v 1.4 1995-11-11 15:49:54 cg Exp $'
! !
!DeviceHandle methodsFor:'accessing'!
setDevice:aDevice id:aDrawableId gcId:aGCId
- device := aDevice.
- drawableId := aDrawableId.
- gcId := aGCId
+ "set the handles contents"
+
+ device := aDevice.
+ drawableId := aDrawableId.
+ gcId := aGCId
+
+ "Modified: 23.4.1996 / 22:10:26 / cg"
! !
+
+!DeviceHandle class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/DevHandle.st,v 1.5 1996-04-23 20:11:40 cg Exp $'
+! !
--- a/DevViewH.st Tue Apr 23 22:06:00 1996 +0200
+++ b/DevViewH.st Tue Apr 23 22:12:21 1996 +0200
@@ -10,13 +10,11 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 25-may-1995 at 7:37:38 am'!
-
DeviceHandle subclass:#DeviceViewHandle
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
!DeviceViewHandle class methodsFor:'documentation'!
@@ -42,11 +40,10 @@
devices view. To make the memory requirements smaller and to speed up
view creation a bit, this lightweight class is used now, which only
keeps the device handle for finalization.
+
+ [see also:]
+ PseudoView
"
-!
-
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/DevViewH.st,v 1.5 1995-12-03 14:28:46 cg Exp $'
! !
!DeviceViewHandle methodsFor:'finalization'!
@@ -66,3 +63,9 @@
! !
+
+!DeviceViewHandle class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/DevViewH.st,v 1.6 1996-04-23 20:11:36 cg Exp $'
+! !
--- a/DeviceHandle.st Tue Apr 23 22:06:00 1996 +0200
+++ b/DeviceHandle.st Tue Apr 23 22:12:21 1996 +0200
@@ -10,13 +10,11 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 25-may-1995 at 7:37:35 am'!
-
Object subclass:#DeviceHandle
- instanceVariableNames:'device drawableId gcId'
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:'device drawableId gcId'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
!DeviceHandle class methodsFor:'documentation'!
@@ -44,17 +42,26 @@
fonts could also make use of this class - however, for historical reasons,
they continue to use their own private finalization machanisms. This may
change in future versions).
+
+ [see also:]
+ DeviceDrawable
"
-!
-
-version
- ^ '$Header: /cvs/stx/stx/libview/DeviceHandle.st,v 1.4 1995-11-11 15:49:54 cg Exp $'
! !
!DeviceHandle methodsFor:'accessing'!
setDevice:aDevice id:aDrawableId gcId:aGCId
- device := aDevice.
- drawableId := aDrawableId.
- gcId := aGCId
+ "set the handles contents"
+
+ device := aDevice.
+ drawableId := aDrawableId.
+ gcId := aGCId
+
+ "Modified: 23.4.1996 / 22:10:26 / cg"
! !
+
+!DeviceHandle class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/DeviceHandle.st,v 1.5 1996-04-23 20:11:40 cg Exp $'
+! !
--- a/DisplayMedium.st Tue Apr 23 22:06:00 1996 +0200
+++ b/DisplayMedium.st Tue Apr 23 22:12:21 1996 +0200
@@ -11,11 +11,10 @@
"
GraphicsContext subclass:#DisplayMedium
- instanceVariableNames:'width height
- clipRect window'
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:'width height clipRect window'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
!DisplayMedium class methodsFor:'documentation'!
@@ -34,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/DisplayMedium.st,v 1.14 1996-01-24 15:37:00 ah Exp $'
-!
-
documentation
"
this is an abstract superclass for all kinds of drawables which
@@ -52,123 +47,44 @@
"
! !
-!DisplayMedium methodsFor:'initialization'!
-
-initialize
- "set up some useful default values"
-
- super initialize.
+!DisplayMedium methodsFor:'GC access'!
- width := 0.
- height := 0
-! !
-
-!DisplayMedium ignoredMethodsFor:'accessing'!
+at:aPoint
+ "return pixel value at coordinate"
-insideWidth
- "return the usable width for drawing in the receiver;
- this is width here, but Views/Pages may subtract margins"
-
- ^ width
+ ^ self subclassResponsibility
!
-insideHeight
- "return the usable height for drawing in the receiver;
- this is height here, but Views/Pages may subtract margins"
+drawPattern:aPattern
+ "set the pattern to be drawn with - the pattern may be a color,
+ a bitmap or pixmap"
- ^ height
+ aPattern isColor ifTrue:[
+ self paint:aPattern
+ ] ifFalse:[
+ self mask:aPattern
+ ]
!
-insideLeftOffset
- "return the left offset for drawing in the receiver;
- this is 0 here, but Views/Pages may add margins"
+gc
+ "ST-80 compatibility;
+ in STX a displayMedium is its own graphicsContext"
- ^ 0
-!
-
-insideTopOffset
- "return the top offset for drawing in the receiver;
- this is 0 here, but Views/Pages may add margins"
-
- ^ 0
+ ^ self
! !
!DisplayMedium methodsFor:'accessing'!
-isView
- "return true, if the receiver is a view"
-
- ^ false
-!
-
-origin
- "return the origin i.e. coordinate of top-left of the receiver"
-
- ^ 0 @ 0
-!
-
-left
- "return the left i.e. x-coordinate of top-left of the receiver"
+bottomCenter
+ "return the topCenter point"
- ^ 0
-!
-
-top
- "return the top i.e. y-coordinate of top-left of the receiver"
-
- ^ 0
-!
-
-width
- "return the width of the receiver"
-
- ^ width
-!
-
-width:anInteger
- "set the width of the receiver"
-
- width := anInteger
+ ^ (self left + (width//2) - 1) @ (self top + height - 1)
!
-height
- "return the height of the receiver"
-
- ^ height
-!
-
-height:anInteger
- "set the height of the receiver"
-
- height := anInteger
-!
-
-width:w height:h
- "set both width and height of the receiver"
-
- width := w.
- height := h
-!
+bottomLeft
+ "return the bottomLeft point"
-setWidth:w height:h
- "set both width and height - not to be redefined"
-
- width := w.
- height := h
-!
-
-extent
- "return the extent i.e. a point with width as x, height as y
- coordinate"
-
- ^ width @ height
-!
-
-extent:extent
- "set the extent"
-
- width := extent x.
- height := extent y
+ ^ (self left) @ (self top + height - 1)
!
center
@@ -192,28 +108,42 @@
(aPoint y - self top + 1)
!
-topRight
- "return the topRight point"
+extent
+ "return the extent i.e. a point with width as x, height as y
+ coordinate"
- ^ (self left + width - 1) @ (self top)
+ ^ width @ height
+!
+
+extent:extent
+ "set the extent"
+
+ width := extent x.
+ height := extent y
!
-bottomLeft
- "return the bottomLeft point"
+height
+ "return the height of the receiver"
- ^ (self left) @ (self top + height - 1)
+ ^ height
!
-topCenter
- "return the topCenter point"
+height:anInteger
+ "set the height of the receiver"
- ^ (self left + (width//2) - 1) @ (self top)
+ height := anInteger
!
-bottomCenter
- "return the topCenter point"
+isView
+ "return true, if the receiver is a view"
- ^ (self left + (width//2) - 1) @ (self top + height - 1)
+ ^ false
+!
+
+left
+ "return the left i.e. x-coordinate of top-left of the receiver"
+
+ ^ 0
!
leftCenter
@@ -222,35 +152,110 @@
^ (self left) @ (self top + (height // 2) - 1)
!
+origin
+ "return the origin i.e. coordinate of top-left of the receiver"
+
+ ^ 0 @ 0
+!
+
rightCenter
"return the leftCenter point"
^ (self left + width - 1) @ (self top + (height // 2) - 1)
-! !
+!
+
+setWidth:w height:h
+ "set both width and height - not to be redefined"
+
+ width := w.
+ height := h
+!
-!DisplayMedium methodsFor:'GC access'!
+top
+ "return the top i.e. y-coordinate of top-left of the receiver"
+
+ ^ 0
+!
+
+topCenter
+ "return the topCenter point"
-gc
- "ST-80 compatibility;
- in STX a displayMedium is its own graphicsContext"
+ ^ (self left + (width//2) - 1) @ (self top)
+!
+
+topRight
+ "return the topRight point"
+
+ ^ (self left + width - 1) @ (self top)
+!
- ^ self
+width
+ "return the width of the receiver"
+
+ ^ width
+!
+
+width:anInteger
+ "set the width of the receiver"
+
+ width := anInteger
!
-at:aPoint
- "return pixel value at coordinate"
+width:w height:h
+ "set both width and height of the receiver"
+
+ width := w.
+ height := h
+! !
+
+!DisplayMedium methodsFor:'evaluating in another context'!
- ^ self subclassResponsibility
+clippedTo:aRectangle do:aBlock
+ "evaluate aBlock with clipping rectangle set to aRectangle"
+
+ |oldClip|
+
+ oldClip := clipRect.
+ self clipRect:aRectangle.
+ aBlock value.
+ self clipRect:oldClip
!
-drawPattern:aPattern
- "set the pattern to be drawn with - the pattern may be a color,
- a bitmap or pixmap"
+withFunction:aFunction do:aBlock
+ "evaluate aBlock with function set to aFunction"
+
+ |oldFun|
+
+ oldFun := function.
+ self function:aFunction.
+ aBlock value.
+ self function:oldFun
+!
+
+withMask:aMask do:aBlock
+ "evaluate aBlock with mask set to aMask"
+
+ |oldMask|
+
+ oldMask := mask.
+ self mask:aMask.
+ aBlock value.
+ self mask:oldMask
+!
+
+withPattern:aPattern do:aBlock
+ |old|
aPattern isColor ifTrue:[
- self paint:aPattern
+ old := paint.
+ self paint:aPattern.
+ aBlock value.
+ self paint:old
] ifFalse:[
- self mask:aPattern
+ old := mask.
+ self mask:aPattern.
+ aBlock value.
+ self mask:old
]
! !
@@ -262,18 +267,6 @@
self fill:Black
!
-white
- "fill the receiver with white"
-
- self fill:White
-!
-
-clearInside
- "clear the receiver with background - ST-80 compatibility"
-
- ^ self clear
-!
-
clear
"clear the receiver with background"
@@ -285,6 +278,12 @@
]
!
+clearInside
+ "clear the receiver with background - ST-80 compatibility"
+
+ ^ self clear
+!
+
clearRectangle:aRectangle
"clear the rectangular area in the receiver to background"
@@ -311,6 +310,40 @@
self fillRectangleX:0 y:0 width:width height:height with:something
!
+fillArcX:x y:y w:w h:h from:startAngle angle:angle with:aPattern
+ "fill an arc in the receiver with aPattern,
+ which may be a Color or Form"
+
+ self withPattern:aPattern do:[
+ self fillArcX:x y:y w:w h:h from:startAngle angle:angle
+ ]
+!
+
+fillCircle:aPoint radius:aNumber with:aPattern
+ "fill a circle in the receiver with aPattern,
+ which may be a Color or Form"
+
+ self fillCircleX:(aPoint x) y:(aPoint y) radius:aNumber with:aPattern
+!
+
+fillCircleX:x y:y radius:r with:aPattern
+ "fill a circle with aPattern,
+ which may be a Color or Form"
+
+ |d|
+ d := 2 * r.
+ self fillArcX:(x - r) y:(y - r) w:d h:d from:0 angle:360 with:aPattern
+!
+
+fillPolygon:aPolygon with:aPattern
+ "fill a polygon in the receiver with aPattern,
+ which may be a Form or Color"
+
+ self withPattern:aPattern do:[
+ self fillPolygon:aPolygon
+ ]
+!
+
fillRectangle:aRectangle with:something
"fill the rectangular area in the receiver with something;
something may be a Form, Color or colorIndex"
@@ -340,15 +373,6 @@
"
!
-fillPolygon:aPolygon with:aPattern
- "fill a polygon in the receiver with aPattern,
- which may be a Form or Color"
-
- self withPattern:aPattern do:[
- self fillPolygon:aPolygon
- ]
-!
-
invertRectangle:aRectangle
"invert a rectangle in the receiver"
@@ -357,78 +381,25 @@
]
!
-fillCircle:aPoint radius:aNumber with:aPattern
- "fill a circle in the receiver with aPattern,
- which may be a Color or Form"
-
- self fillCircleX:(aPoint x) y:(aPoint y) radius:aNumber with:aPattern
-!
-
-fillCircleX:x y:y radius:r with:aPattern
- "fill a circle with aPattern,
- which may be a Color or Form"
+white
+ "fill the receiver with white"
- |d|
- d := 2 * r.
- self fillArcX:(x - r) y:(y - r) w:d h:d from:0 angle:360 with:aPattern
-!
-
-fillArcX:x y:y w:w h:h from:startAngle angle:angle with:aPattern
- "fill an arc in the receiver with aPattern,
- which may be a Color or Form"
-
- self withPattern:aPattern do:[
- self fillArcX:x y:y w:w h:h from:startAngle angle:angle
- ]
+ self fill:White
! !
-!DisplayMedium methodsFor:'evaluating in another context'!
-
-withPattern:aPattern do:aBlock
- |old|
+!DisplayMedium methodsFor:'initialization'!
- aPattern isColor ifTrue:[
- old := paint.
- self paint:aPattern.
- aBlock value.
- self paint:old
- ] ifFalse:[
- old := mask.
- self mask:aPattern.
- aBlock value.
- self mask:old
- ]
-!
+initialize
+ "set up some useful default values"
-withMask:aMask do:aBlock
- "evaluate aBlock with mask set to aMask"
-
- |oldMask|
+ super initialize.
- oldMask := mask.
- self mask:aMask.
- aBlock value.
- self mask:oldMask
-!
-
-withFunction:aFunction do:aBlock
- "evaluate aBlock with function set to aFunction"
-
- |oldFun|
+ width := 0.
+ height := 0
+! !
- oldFun := function.
- self function:aFunction.
- aBlock value.
- self function:oldFun
-!
+!DisplayMedium class methodsFor:'documentation'!
-clippedTo:aRectangle do:aBlock
- "evaluate aBlock with clipping rectangle set to aRectangle"
-
- |oldClip|
-
- oldClip := clipRect.
- self clipRect:aRectangle.
- aBlock value.
- self clipRect:oldClip
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/DisplayMedium.st,v 1.15 1996-04-23 20:11:45 cg Exp $'
! !
--- a/Font.st Tue Apr 23 22:06:00 1996 +0200
+++ b/Font.st Tue Apr 23 22:12:21 1996 +0200
@@ -90,7 +90,7 @@
garbage collected.
- Instance variables:
+ [Instance variables:]
family <String> the fonts family ('courier', 'helvetica' etc)
face <String> the fonts face ('bold', 'medium' etc)
@@ -112,11 +112,16 @@
maxWidth <Integer> width of the largest-width character in
in device units on device
- class variables:
+ [class variables:]
Lobby <Registry> keeps track of all known fonts
Replacements <Dictionary> replacement fonts
+
+ [see also:]
+ DeviceWorkstation
+ DeviceDrawable
+ Cursor Color
"
! !
@@ -883,6 +888,6 @@
!Font class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Font.st,v 1.38 1996-04-20 21:27:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Font.st,v 1.39 1996-04-23 20:12:05 cg Exp $'
! !
Font initialize!
--- a/WTrans.st Tue Apr 23 22:06:00 1996 +0200
+++ b/WTrans.st Tue Apr 23 22:12:21 1996 +0200
@@ -10,15 +10,139 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.3 on 20-sep-1994 at 0:15:56'!
+Object subclass:#WindowingTransformation
+ instanceVariableNames:'scale translation'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
+!
+
+!WindowingTransformation class methodsFor:'instance creation'!
+
+identity
+ "returns a windowing transformation with no scaling (1@1)
+ and no translation (0@0)."
+
+ ^ self basicNew scale:nil translation:nil
+!
+
+scale:aScale translation:aTranslation
+ "returns a windowing transformation with a scale factor of
+ aScale and a translation offset of 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
+ "
+!
+
+unit:unitSymbol on:device
+ "returns a windowing transformation with scaling
+ for unitSymbol and no translation (0@0).
+ With such a transformation, you can draw in your preferred
+ units.
+ UnitSymbol may be #mm, #cm, #inch, #point, #twip or #pixel (default).
+ Twip is 1/20th of a point, point is 1/72th of an inch
+ (i.e. the print-unit which is also used for font sizes etc.)
+ - not to confuse with device pixels."
+
+ |pixelPerUnitV pixelPerUnitH|
-Object subclass:#WindowingTransformation
- instanceVariableNames:'scale translation'
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ unitSymbol == #mm ifTrue:[
+ pixelPerUnitV := device verticalPixelPerMillimeter.
+ pixelPerUnitH := device horizontalPixelPerMillimeter
+ ] ifFalse:[
+ unitSymbol == #cm ifTrue:[
+ pixelPerUnitV := device verticalPixelPerMillimeter * 10.
+ pixelPerUnitH := device horizontalPixelPerMillimeter * 10
+ ] ifFalse:[
+ unitSymbol == #twip ifTrue:[
+ pixelPerUnitV := device verticalPixelPerInch / 1440.
+ pixelPerUnitH := device horizontalPixelPerInch / 1440
+ ] ifFalse:[
+ unitSymbol == #point ifTrue:[
+ pixelPerUnitV := device verticalPixelPerInch / 72.
+ pixelPerUnitH := device horizontalPixelPerInch / 72
+ ] ifFalse:[
+ unitSymbol == #inch ifTrue:[
+ pixelPerUnitV := device verticalPixelPerInch.
+ pixelPerUnitH := device horizontalPixelPerInch
+ ] ifFalse:[
+ "sorry: unknown unit is taken as pixel"
+ ^ self new scale:nil translation:nil
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ 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
+ "
!
+window:sourceRectangle viewport:destinationRectangle
+ "returns a windowing transformation with a scale and
+ translation computed from sourceRectangle and destinationRectangle.
+ The scale and transformation are computed such that sourceRectangle
+ is transformed to destinationRectangle. Typically sourceRectangle
+ represents the logical coordinateSpace while destinationRectangle
+ represents the device coordinateSpace."
+
+ |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 := nil
+ ] ifFalse:[
+ newScale := sX @ sY
+ ].
+ ^ 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
+ "
+! !
+
!WindowingTransformation class methodsFor:'documentation '!
copyright
@@ -35,10 +159,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/WTrans.st,v 1.10 1995-11-11 15:53:42 cg Exp $'
-!
-
documentation
"
instances of WindowingTransformation can be used to scale, translate or
@@ -107,212 +227,72 @@
v displayLineFrom:10@10 to:30@30
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/WTrans.st,v 1.11 1996-04-23 20:10:42 cg Exp $'
! !
-!WindowingTransformation class methodsFor:'instance creation'!
+!WindowingTransformation methodsFor:'accessing'!
+
+scale
+ "return a copy of the Point that represents the
+ current scale of the receiver."
-unit:unitSymbol on:device
- "returns a windowing transformation with scaling
- for unitSymbol and no translation (0@0).
- With such a transformation, you can draw in your preferred
- units.
- UnitSymbol may be #mm, #cm, #inch, #point, #twip or #pixel (default).
- Twip is 1/20th of a point, point is 1/72th of an inch
- (i.e. the print-unit which is also used for font sizes etc.)
- - not to confuse with device pixels."
+ scale isNil ifTrue:[^ (1@1) copy].
+ ^ scale copy
+!
- |pixelPerUnitV pixelPerUnitH|
+scale:aScale
+ "Set the receiver's scale to aScale, a Point or Number."
- unitSymbol == #mm ifTrue:[
- pixelPerUnitV := device verticalPixelPerMillimeter.
- pixelPerUnitH := device horizontalPixelPerMillimeter
+ aScale isNil ifTrue:[
+ scale := aScale
] ifFalse:[
- unitSymbol == #cm ifTrue:[
- pixelPerUnitV := device verticalPixelPerMillimeter * 10.
- pixelPerUnitH := device horizontalPixelPerMillimeter * 10
- ] ifFalse:[
- unitSymbol == #twip ifTrue:[
- pixelPerUnitV := device verticalPixelPerInch / 1440.
- pixelPerUnitH := device horizontalPixelPerInch / 1440
- ] ifFalse:[
- unitSymbol == #point ifTrue:[
- pixelPerUnitV := device verticalPixelPerInch / 72.
- pixelPerUnitH := device horizontalPixelPerInch / 72
- ] ifFalse:[
- unitSymbol == #inch ifTrue:[
- pixelPerUnitV := device verticalPixelPerInch.
- pixelPerUnitH := device horizontalPixelPerInch
- ] ifFalse:[
- "sorry: unknown unit is taken as pixel"
- ^ self new scale:nil translation:nil
- ]
- ]
- ]
- ]
+ scale := aScale asPoint.
].
- ^ 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 basicNew scale:aScale translation:aTranslation
-
- "
- |v|
+scale:aScale translation:aTranslation
+ "sets the scale to aScale and the translation to aTranslation."
- 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
- "
+ aScale isNil ifTrue:[
+ scale := aScale
+ ] ifFalse:[
+ scale := aScale asPoint.
+ ].
+ aTranslation isNil ifTrue:[
+ translation := aTranslation
+ ] ifFalse:[
+ translation := aTranslation asPoint
+ ]
!
-window:sourceRectangle viewport:destinationRectangle
- "returns a windowing transformation with a scale and
- translation computed from sourceRectangle and destinationRectangle.
- The scale and transformation are computed such that sourceRectangle
- is transformed to destinationRectangle. Typically sourceRectangle
- represents the logical coordinateSpace while destinationRectangle
- represents the device coordinateSpace."
-
- |sX sY tX tY newScale newTranslation|
+scaleOfOne
+ "Set the scale of the receiver to the identity scale"
- 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 := nil
- ] ifFalse:[
- newScale := sX @ sY
- ].
- ^ 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
- "
+ scale := nil
!
-identity
- "returns a windowing transformation with no scaling (1@1)
- and no translation (0@0)."
+translation
+ "return a copy of the receiver's translation."
+
+ translation isNil ifTrue:[^ (0@0) copy].
+ ^ translation copy
+!
- ^ self basicNew scale:nil translation:nil
+translation:aTranslation
+ "Set the receiver's translation to aTranslation, a Point or Number."
+
+ aTranslation isNil ifTrue:[
+ translation := aTranslation
+ ] ifFalse:[
+ translation := aTranslation asPoint
+ ]
! !
!WindowingTransformation methodsFor:'applying transform'!
-applyToX: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 * s + t
-!
-
-applyToY: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 * 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
-!
-
-applyTo:anObject
- "Apply the receiver to anObject and return the result."
-
- |transformedObject|
-
- scale isNil ifTrue:[
- translation isNil ifTrue:[
- ^ anObject
- ].
- ^ anObject translatedBy:translation
- ].
- transformedObject := anObject scaledBy:scale.
- translation notNil ifTrue:[
- 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)"
@@ -347,21 +327,80 @@
^ transformedObject
!
-transformPoint:p
- "Apply the receiver to a point.
- This is destructive in that the point is being modified,
- not a copy."
+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
+!
+
+applyScaleX:aNumber
+ "apply the scale only (if widths are to be transformed)"
+
+ scale isNil ifTrue:[^ aNumber].
+ ^ aNumber * scale x
+!
+
+applyScaleY:aNumber
+ "apply the scale only (if heights are to be transformed)"
+
+ scale isNil ifTrue:[^ aNumber].
+ ^ aNumber * scale y
+!
+
+applyTo:anObject
+ "Apply the receiver to anObject and return the result."
+
+ |transformedObject|
scale isNil ifTrue:[
translation isNil ifTrue:[
- ^ p
+ ^ anObject
].
- ^ p + translation
+ ^ anObject translatedBy:translation
+ ].
+ transformedObject := anObject scaledBy:scale.
+ translation notNil ifTrue:[
+ transformedObject translateBy:translation.
].
- translation isNil ifTrue:[
- ^ p * scale
- ].
- ^ (p * scale + translation)
+ ^ transformedObject
+!
+
+applyToX: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 * s + t
+!
+
+applyToY: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 * s + t
!
compose:aTransformation
@@ -394,80 +433,33 @@
^ (self class)
scale:newScale
translation:newTranslation
-! !
-
-!WindowingTransformation methodsFor:'transforming'!
-
-scaleBy:aScale
- "scale the receiver.
- This is a destructive operation, modifying the transformation
- represented by the receiver"
-
- |newScale|
-
- aScale isNil ifTrue:[^ self].
-
- scale isNil ifTrue:[
- newScale := aScale asPoint
- ] ifFalse:[
- newScale := scale * aScale
- ].
- translation notNil ifTrue:[
- translation := translation * aScale.
- ].
- scale := newScale.
!
-translateBy:aTranslation
- "translate the receiver.
- This is a destructive operation, modifying the transformation
- represented by the receiver"
-
- aTranslation isNil ifTrue:[^ self].
-
- translation isNil ifTrue:[
- translation := 0@0
- ].
- scale isNil ifTrue:[
- translation := translation + aTranslation asPoint
- ] ifFalse:[
- translation := translation + (scale * aTranslation)
- ].
-!
-
-scaledBy:aScale
- "return a new WindowingTransformation with the scale and translation of
- the receiver both scaled by aScale."
-
- |checkedScale newScale newTranslation|
+transformPoint:p
+ "Apply the receiver to a point.
+ This is destructive in that the point is being modified,
+ not a copy."
- aScale isNil ifTrue:[
- newScale := scale.
- newTranslation := translation
- ] ifFalse:[
- checkedScale := self checkScale:aScale.
- scale isNil ifTrue:[
- newScale := checkedScale
- ] ifFalse:[
- newScale := scale * checkedScale
+ scale isNil ifTrue:[
+ translation isNil ifTrue:[
+ ^ p
].
- translation notNil ifTrue:[
- newTranslation := checkedScale * translation
- ]
+ ^ p + translation
+ ].
+ translation isNil ifTrue:[
+ ^ p * scale
].
- ^ (self class)
- scale:newScale
- translation:newTranslation
-!
+ ^ (p * scale + translation)
+! !
+
+!WindowingTransformation methodsFor:'printing'!
-translatedBy:aPoint
- "return a new WindowingTransformation with the same scale and
- rotations as the receiver and with a translation of the current
- translation plus aPoint."
-
- ^ (self class)
- scale:scale
- translation:(translation + aPoint)
+printOn:aStream
+ aStream nextPutAll:self class name.
+ aStream nextPutAll:' scale: '.
+ scale printOn:aStream.
+ aStream nextPutAll:' translation: '.
+ translation printOn:aStream
! !
!WindowingTransformation methodsFor:'private'!
@@ -504,64 +496,6 @@
y:trans y negated
! !
-!WindowingTransformation methodsFor:'accessing'!
-
-scale:aScale translation:aTranslation
- "sets the scale to aScale and the translation to aTranslation."
-
- aScale isNil ifTrue:[
- scale := aScale
- ] ifFalse:[
- scale := aScale asPoint.
- ].
- aTranslation isNil ifTrue:[
- translation := aTranslation
- ] ifFalse:[
- translation := aTranslation asPoint
- ]
-!
-
-translation:aTranslation
- "Set the receiver's translation to aTranslation, a Point or Number."
-
- aTranslation isNil ifTrue:[
- translation := aTranslation
- ] ifFalse:[
- translation := aTranslation asPoint
- ]
-!
-
-scale:aScale
- "Set the receiver's scale to aScale, a Point or Number."
-
- 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 isNil ifTrue:[^ (1@1) copy].
- ^ scale copy
-!
-
-translation
- "return a copy of the receiver's translation."
-
- translation isNil ifTrue:[^ (0@0) copy].
- ^ translation copy
-!
-
-scaleOfOne
- "Set the scale of the receiver to the identity scale"
-
- scale := nil
-! !
-
!WindowingTransformation methodsFor:'testing'!
noScale
@@ -571,13 +505,77 @@
^ scale == nil
! !
-!WindowingTransformation methodsFor:'printing'!
+!WindowingTransformation methodsFor:'transforming'!
+
+scaleBy:aScale
+ "scale the receiver.
+ This is a destructive operation, modifying the transformation
+ represented by the receiver"
+
+ |newScale|
+
+ aScale isNil ifTrue:[^ self].
+
+ scale isNil ifTrue:[
+ newScale := aScale asPoint
+ ] ifFalse:[
+ newScale := scale * aScale
+ ].
+ translation notNil ifTrue:[
+ translation := translation * aScale.
+ ].
+ scale := newScale.
+!
+
+scaledBy:aScale
+ "return a new WindowingTransformation with the scale and translation of
+ the receiver both scaled by aScale."
+
+ |checkedScale newScale newTranslation|
-printOn:aStream
- aStream nextPutAll:self class name.
- aStream nextPutAll:' scale: '.
- scale printOn:aStream.
- aStream nextPutAll:' translation: '.
- translation printOn:aStream
+ aScale isNil ifTrue:[
+ newScale := scale.
+ newTranslation := translation
+ ] ifFalse:[
+ checkedScale := self checkScale:aScale.
+ scale isNil ifTrue:[
+ newScale := checkedScale
+ ] ifFalse:[
+ newScale := scale * checkedScale
+ ].
+ translation notNil ifTrue:[
+ newTranslation := checkedScale * translation
+ ]
+ ].
+ ^ (self class)
+ scale:newScale
+ translation:newTranslation
+!
+
+translateBy:aTranslation
+ "translate the receiver.
+ This is a destructive operation, modifying the transformation
+ represented by the receiver"
+
+ aTranslation isNil ifTrue:[^ self].
+
+ translation isNil ifTrue:[
+ translation := 0@0
+ ].
+ scale isNil ifTrue:[
+ translation := translation + aTranslation asPoint
+ ] ifFalse:[
+ translation := translation + (scale * aTranslation)
+ ].
+!
+
+translatedBy:aPoint
+ "return a new WindowingTransformation with the same scale and
+ rotations as the receiver and with a translation of the current
+ translation plus aPoint."
+
+ ^ (self class)
+ scale:scale
+ translation:(translation + aPoint)
! !
--- a/WindowingTransformation.st Tue Apr 23 22:06:00 1996 +0200
+++ b/WindowingTransformation.st Tue Apr 23 22:12:21 1996 +0200
@@ -10,15 +10,139 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.3 on 20-sep-1994 at 0:15:56'!
+Object subclass:#WindowingTransformation
+ instanceVariableNames:'scale translation'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
+!
+
+!WindowingTransformation class methodsFor:'instance creation'!
+
+identity
+ "returns a windowing transformation with no scaling (1@1)
+ and no translation (0@0)."
+
+ ^ self basicNew scale:nil translation:nil
+!
+
+scale:aScale translation:aTranslation
+ "returns a windowing transformation with a scale factor of
+ aScale and a translation offset of 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
+ "
+!
+
+unit:unitSymbol on:device
+ "returns a windowing transformation with scaling
+ for unitSymbol and no translation (0@0).
+ With such a transformation, you can draw in your preferred
+ units.
+ UnitSymbol may be #mm, #cm, #inch, #point, #twip or #pixel (default).
+ Twip is 1/20th of a point, point is 1/72th of an inch
+ (i.e. the print-unit which is also used for font sizes etc.)
+ - not to confuse with device pixels."
+
+ |pixelPerUnitV pixelPerUnitH|
-Object subclass:#WindowingTransformation
- instanceVariableNames:'scale translation'
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ unitSymbol == #mm ifTrue:[
+ pixelPerUnitV := device verticalPixelPerMillimeter.
+ pixelPerUnitH := device horizontalPixelPerMillimeter
+ ] ifFalse:[
+ unitSymbol == #cm ifTrue:[
+ pixelPerUnitV := device verticalPixelPerMillimeter * 10.
+ pixelPerUnitH := device horizontalPixelPerMillimeter * 10
+ ] ifFalse:[
+ unitSymbol == #twip ifTrue:[
+ pixelPerUnitV := device verticalPixelPerInch / 1440.
+ pixelPerUnitH := device horizontalPixelPerInch / 1440
+ ] ifFalse:[
+ unitSymbol == #point ifTrue:[
+ pixelPerUnitV := device verticalPixelPerInch / 72.
+ pixelPerUnitH := device horizontalPixelPerInch / 72
+ ] ifFalse:[
+ unitSymbol == #inch ifTrue:[
+ pixelPerUnitV := device verticalPixelPerInch.
+ pixelPerUnitH := device horizontalPixelPerInch
+ ] ifFalse:[
+ "sorry: unknown unit is taken as pixel"
+ ^ self new scale:nil translation:nil
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ 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
+ "
!
+window:sourceRectangle viewport:destinationRectangle
+ "returns a windowing transformation with a scale and
+ translation computed from sourceRectangle and destinationRectangle.
+ The scale and transformation are computed such that sourceRectangle
+ is transformed to destinationRectangle. Typically sourceRectangle
+ represents the logical coordinateSpace while destinationRectangle
+ represents the device coordinateSpace."
+
+ |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 := nil
+ ] ifFalse:[
+ newScale := sX @ sY
+ ].
+ ^ 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
+ "
+! !
+
!WindowingTransformation class methodsFor:'documentation '!
copyright
@@ -35,10 +159,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/WindowingTransformation.st,v 1.10 1995-11-11 15:53:42 cg Exp $'
-!
-
documentation
"
instances of WindowingTransformation can be used to scale, translate or
@@ -107,212 +227,72 @@
v displayLineFrom:10@10 to:30@30
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/WindowingTransformation.st,v 1.11 1996-04-23 20:10:42 cg Exp $'
! !
-!WindowingTransformation class methodsFor:'instance creation'!
+!WindowingTransformation methodsFor:'accessing'!
+
+scale
+ "return a copy of the Point that represents the
+ current scale of the receiver."
-unit:unitSymbol on:device
- "returns a windowing transformation with scaling
- for unitSymbol and no translation (0@0).
- With such a transformation, you can draw in your preferred
- units.
- UnitSymbol may be #mm, #cm, #inch, #point, #twip or #pixel (default).
- Twip is 1/20th of a point, point is 1/72th of an inch
- (i.e. the print-unit which is also used for font sizes etc.)
- - not to confuse with device pixels."
+ scale isNil ifTrue:[^ (1@1) copy].
+ ^ scale copy
+!
- |pixelPerUnitV pixelPerUnitH|
+scale:aScale
+ "Set the receiver's scale to aScale, a Point or Number."
- unitSymbol == #mm ifTrue:[
- pixelPerUnitV := device verticalPixelPerMillimeter.
- pixelPerUnitH := device horizontalPixelPerMillimeter
+ aScale isNil ifTrue:[
+ scale := aScale
] ifFalse:[
- unitSymbol == #cm ifTrue:[
- pixelPerUnitV := device verticalPixelPerMillimeter * 10.
- pixelPerUnitH := device horizontalPixelPerMillimeter * 10
- ] ifFalse:[
- unitSymbol == #twip ifTrue:[
- pixelPerUnitV := device verticalPixelPerInch / 1440.
- pixelPerUnitH := device horizontalPixelPerInch / 1440
- ] ifFalse:[
- unitSymbol == #point ifTrue:[
- pixelPerUnitV := device verticalPixelPerInch / 72.
- pixelPerUnitH := device horizontalPixelPerInch / 72
- ] ifFalse:[
- unitSymbol == #inch ifTrue:[
- pixelPerUnitV := device verticalPixelPerInch.
- pixelPerUnitH := device horizontalPixelPerInch
- ] ifFalse:[
- "sorry: unknown unit is taken as pixel"
- ^ self new scale:nil translation:nil
- ]
- ]
- ]
- ]
+ scale := aScale asPoint.
].
- ^ 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 basicNew scale:aScale translation:aTranslation
-
- "
- |v|
+scale:aScale translation:aTranslation
+ "sets the scale to aScale and the translation to aTranslation."
- 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
- "
+ aScale isNil ifTrue:[
+ scale := aScale
+ ] ifFalse:[
+ scale := aScale asPoint.
+ ].
+ aTranslation isNil ifTrue:[
+ translation := aTranslation
+ ] ifFalse:[
+ translation := aTranslation asPoint
+ ]
!
-window:sourceRectangle viewport:destinationRectangle
- "returns a windowing transformation with a scale and
- translation computed from sourceRectangle and destinationRectangle.
- The scale and transformation are computed such that sourceRectangle
- is transformed to destinationRectangle. Typically sourceRectangle
- represents the logical coordinateSpace while destinationRectangle
- represents the device coordinateSpace."
-
- |sX sY tX tY newScale newTranslation|
+scaleOfOne
+ "Set the scale of the receiver to the identity scale"
- 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 := nil
- ] ifFalse:[
- newScale := sX @ sY
- ].
- ^ 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
- "
+ scale := nil
!
-identity
- "returns a windowing transformation with no scaling (1@1)
- and no translation (0@0)."
+translation
+ "return a copy of the receiver's translation."
+
+ translation isNil ifTrue:[^ (0@0) copy].
+ ^ translation copy
+!
- ^ self basicNew scale:nil translation:nil
+translation:aTranslation
+ "Set the receiver's translation to aTranslation, a Point or Number."
+
+ aTranslation isNil ifTrue:[
+ translation := aTranslation
+ ] ifFalse:[
+ translation := aTranslation asPoint
+ ]
! !
!WindowingTransformation methodsFor:'applying transform'!
-applyToX: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 * s + t
-!
-
-applyToY: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 * 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
-!
-
-applyTo:anObject
- "Apply the receiver to anObject and return the result."
-
- |transformedObject|
-
- scale isNil ifTrue:[
- translation isNil ifTrue:[
- ^ anObject
- ].
- ^ anObject translatedBy:translation
- ].
- transformedObject := anObject scaledBy:scale.
- translation notNil ifTrue:[
- 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)"
@@ -347,21 +327,80 @@
^ transformedObject
!
-transformPoint:p
- "Apply the receiver to a point.
- This is destructive in that the point is being modified,
- not a copy."
+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
+!
+
+applyScaleX:aNumber
+ "apply the scale only (if widths are to be transformed)"
+
+ scale isNil ifTrue:[^ aNumber].
+ ^ aNumber * scale x
+!
+
+applyScaleY:aNumber
+ "apply the scale only (if heights are to be transformed)"
+
+ scale isNil ifTrue:[^ aNumber].
+ ^ aNumber * scale y
+!
+
+applyTo:anObject
+ "Apply the receiver to anObject and return the result."
+
+ |transformedObject|
scale isNil ifTrue:[
translation isNil ifTrue:[
- ^ p
+ ^ anObject
].
- ^ p + translation
+ ^ anObject translatedBy:translation
+ ].
+ transformedObject := anObject scaledBy:scale.
+ translation notNil ifTrue:[
+ transformedObject translateBy:translation.
].
- translation isNil ifTrue:[
- ^ p * scale
- ].
- ^ (p * scale + translation)
+ ^ transformedObject
+!
+
+applyToX: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 * s + t
+!
+
+applyToY: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 * s + t
!
compose:aTransformation
@@ -394,80 +433,33 @@
^ (self class)
scale:newScale
translation:newTranslation
-! !
-
-!WindowingTransformation methodsFor:'transforming'!
-
-scaleBy:aScale
- "scale the receiver.
- This is a destructive operation, modifying the transformation
- represented by the receiver"
-
- |newScale|
-
- aScale isNil ifTrue:[^ self].
-
- scale isNil ifTrue:[
- newScale := aScale asPoint
- ] ifFalse:[
- newScale := scale * aScale
- ].
- translation notNil ifTrue:[
- translation := translation * aScale.
- ].
- scale := newScale.
!
-translateBy:aTranslation
- "translate the receiver.
- This is a destructive operation, modifying the transformation
- represented by the receiver"
-
- aTranslation isNil ifTrue:[^ self].
-
- translation isNil ifTrue:[
- translation := 0@0
- ].
- scale isNil ifTrue:[
- translation := translation + aTranslation asPoint
- ] ifFalse:[
- translation := translation + (scale * aTranslation)
- ].
-!
-
-scaledBy:aScale
- "return a new WindowingTransformation with the scale and translation of
- the receiver both scaled by aScale."
-
- |checkedScale newScale newTranslation|
+transformPoint:p
+ "Apply the receiver to a point.
+ This is destructive in that the point is being modified,
+ not a copy."
- aScale isNil ifTrue:[
- newScale := scale.
- newTranslation := translation
- ] ifFalse:[
- checkedScale := self checkScale:aScale.
- scale isNil ifTrue:[
- newScale := checkedScale
- ] ifFalse:[
- newScale := scale * checkedScale
+ scale isNil ifTrue:[
+ translation isNil ifTrue:[
+ ^ p
].
- translation notNil ifTrue:[
- newTranslation := checkedScale * translation
- ]
+ ^ p + translation
+ ].
+ translation isNil ifTrue:[
+ ^ p * scale
].
- ^ (self class)
- scale:newScale
- translation:newTranslation
-!
+ ^ (p * scale + translation)
+! !
+
+!WindowingTransformation methodsFor:'printing'!
-translatedBy:aPoint
- "return a new WindowingTransformation with the same scale and
- rotations as the receiver and with a translation of the current
- translation plus aPoint."
-
- ^ (self class)
- scale:scale
- translation:(translation + aPoint)
+printOn:aStream
+ aStream nextPutAll:self class name.
+ aStream nextPutAll:' scale: '.
+ scale printOn:aStream.
+ aStream nextPutAll:' translation: '.
+ translation printOn:aStream
! !
!WindowingTransformation methodsFor:'private'!
@@ -504,64 +496,6 @@
y:trans y negated
! !
-!WindowingTransformation methodsFor:'accessing'!
-
-scale:aScale translation:aTranslation
- "sets the scale to aScale and the translation to aTranslation."
-
- aScale isNil ifTrue:[
- scale := aScale
- ] ifFalse:[
- scale := aScale asPoint.
- ].
- aTranslation isNil ifTrue:[
- translation := aTranslation
- ] ifFalse:[
- translation := aTranslation asPoint
- ]
-!
-
-translation:aTranslation
- "Set the receiver's translation to aTranslation, a Point or Number."
-
- aTranslation isNil ifTrue:[
- translation := aTranslation
- ] ifFalse:[
- translation := aTranslation asPoint
- ]
-!
-
-scale:aScale
- "Set the receiver's scale to aScale, a Point or Number."
-
- 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 isNil ifTrue:[^ (1@1) copy].
- ^ scale copy
-!
-
-translation
- "return a copy of the receiver's translation."
-
- translation isNil ifTrue:[^ (0@0) copy].
- ^ translation copy
-!
-
-scaleOfOne
- "Set the scale of the receiver to the identity scale"
-
- scale := nil
-! !
-
!WindowingTransformation methodsFor:'testing'!
noScale
@@ -571,13 +505,77 @@
^ scale == nil
! !
-!WindowingTransformation methodsFor:'printing'!
+!WindowingTransformation methodsFor:'transforming'!
+
+scaleBy:aScale
+ "scale the receiver.
+ This is a destructive operation, modifying the transformation
+ represented by the receiver"
+
+ |newScale|
+
+ aScale isNil ifTrue:[^ self].
+
+ scale isNil ifTrue:[
+ newScale := aScale asPoint
+ ] ifFalse:[
+ newScale := scale * aScale
+ ].
+ translation notNil ifTrue:[
+ translation := translation * aScale.
+ ].
+ scale := newScale.
+!
+
+scaledBy:aScale
+ "return a new WindowingTransformation with the scale and translation of
+ the receiver both scaled by aScale."
+
+ |checkedScale newScale newTranslation|
-printOn:aStream
- aStream nextPutAll:self class name.
- aStream nextPutAll:' scale: '.
- scale printOn:aStream.
- aStream nextPutAll:' translation: '.
- translation printOn:aStream
+ aScale isNil ifTrue:[
+ newScale := scale.
+ newTranslation := translation
+ ] ifFalse:[
+ checkedScale := self checkScale:aScale.
+ scale isNil ifTrue:[
+ newScale := checkedScale
+ ] ifFalse:[
+ newScale := scale * checkedScale
+ ].
+ translation notNil ifTrue:[
+ newTranslation := checkedScale * translation
+ ]
+ ].
+ ^ (self class)
+ scale:newScale
+ translation:newTranslation
+!
+
+translateBy:aTranslation
+ "translate the receiver.
+ This is a destructive operation, modifying the transformation
+ represented by the receiver"
+
+ aTranslation isNil ifTrue:[^ self].
+
+ translation isNil ifTrue:[
+ translation := 0@0
+ ].
+ scale isNil ifTrue:[
+ translation := translation + aTranslation asPoint
+ ] ifFalse:[
+ translation := translation + (scale * aTranslation)
+ ].
+!
+
+translatedBy:aPoint
+ "return a new WindowingTransformation with the same scale and
+ rotations as the receiver and with a translation of the current
+ translation plus aPoint."
+
+ ^ (self class)
+ scale:scale
+ translation:(translation + aPoint)
! !