--- 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 $'
! !