hg/stx-libview: comparison GraphicsMedium.st

equal deleted inserted replaced

-:69b0ea8c4b30
+:39940e2446a5
 "{ Package: 'stx:libview' }"
 "{ NameSpace: Smalltalk }"
 Object subclass:#GraphicsMedium
-	instanceVariableNames:'gc device width height realized'
+	instanceVariableNames:'device gc width height realized'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Graphics-Support'
 !
 "Modified: 28.5.1996 / 20:22:29 / cg"
 !
 key
-^ self id
+^ self drawableId
 !
 phase
 "return the origin within the mask (used to draw with patterns).
 This is an alias for ST/X's #maskOrigin"
 widthOfString:aString
 "given a string, return its width in pixels if
 drawn on the receivers device."
-gc == self ifTrue:[
-^ super widthOfString:aString.
-].
 ^ gc widthOfString:aString.
 "Modified: 28.5.1996 / 20:22:22 / cg"
 !
 widthOfString:aString from:start to:stop
 "given a string, return the width in pixels if
 a substring is drawn on the receivers device."
-gc == self ifTrue:[
-^ super widthOfString:aString from:start to:stop.
-].
 ^ gc widthOfString:aString from:start to:stop.
 "Modified: 28.5.1996 / 20:22:18 / cg"
 ! !
 copyBits:aRectangle from:aForm at:srcOrigin clippingBox:clippingBox rule:rule fillColor:fillColor
 |f oldClip oldFunction|
 (f := rule) isInteger ifTrue:[
-	"/ ST-80 compatibility: numeric rule
+"/ ST-80 compatibility: numeric rule
-	f := #(clear and andReverse  copy andInverted noop xor or nor equiv invert orInverted copyInverted
+f := #(clear and andReverse  copy andInverted noop xor or nor equiv invert orInverted copyInverted
-	       orReverse nand set) at:(rule + 1).
+orReverse nand set) at:(rule + 1).
 ].
 oldFunction := gc function.
-oldClip := gc clippingRectangleOrNil.
+oldClip := gc clippingBoundsOrNil.
-gc clippingRectangle:clippingBox.
+gc clippingBounds:clippingBox.
 gc function:f.
 gc
-	copyFrom:aForm
+copyFrom:aForm
-	x:srcOrigin x y:srcOrigin y
+x:srcOrigin x y:srcOrigin y
-	toX:aRectangle left y:aRectangle top
+toX:aRectangle left y:aRectangle top
-	width:aRectangle width height:aRectangle height.
+width:aRectangle width height:aRectangle height.
-gc clippingRectangle:oldClip.
+gc clippingBounds:oldClip.
 gc function:oldFunction.
 "
 |dst src|
 dst := Form width:8 height:8 fromArray:#[
-					      2r00000000
+2r00000000
-					      2r00000000
+2r00000000
-					      2r00000000
+2r00000000
-					      2r00000000
+2r00000000
-					      2r11111111
+2r11111111
-					      2r11111111
+2r11111111
-					      2r11111111
+2r11111111
-					      2r11111111
+2r11111111
-					     ].
+].
 src := Form width:8 height:8 fromArray:#[
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					     ].
+].
 dst copyBits:(0@0 corner:8@8) from:src at:0@0 clippingBox:(0@0 corner:8@8) rule:15 fillColor:Color black.
 dst inspect
 "
 "
 |dst src|
 dst := Form width:8 height:8 fromArray:#[
-					      2r00000000
+2r00000000
-					      2r00000000
+2r00000000
-					      2r00000000
+2r00000000
-					      2r00000000
+2r00000000
-					      2r11111111
+2r11111111
-					      2r11111111
+2r11111111
-					      2r11111111
+2r11111111
-					      2r11111111
+2r11111111
-					     ].
+].
 src := Form width:8 height:8 fromArray:#[
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					      2r00001111
+2r00001111
-					     ].
+].
 dst copyBits:(0@0 corner:8@8) from:src at:0@0 clippingBox:(0@0 corner:8@8) rule:15 fillColor:Color black.
 dst inspect
 "
 !
 fill:aRectangle fillColor:aColor
 "fill the rectangular area specified by aRectangle with the black color"
-gc == self ifTrue:[
-	super fill:aRectangle fillColor:aColor.
-	^ self.
-].
 gc fill:aRectangle fillColor:aColor
 !
 fillBlack:aRectangle
 "fill the rectangular area specified by aRectangle with the black color"
-self fill:aRectangle fillColor:Color black
+self fill:aRectangle fillColor:self blackColor
 !
 fillColor:something
 "fill the receiver with something;
 something may be a Form, Color or colorIndex"
 !
 fillRectangle:aRectangle color:aColor
 "fill a rectangle with the given paint color"
-gc == self ifTrue:[
-	super fillRectangle:aRectangle color:aColor.
-	^ self.
-].
 gc fillRectangle:aRectangle color:aColor
 !
 fillWhite
 "fill all of the receiver with the white color"
-self fill:Color white
+self fill:self whiteColor
 !
 fillWhite:aRectangle
 "fill the rectangular area specified by aRectangle with the white color"
-self fill:aRectangle fillColor:Color white
+self fill:aRectangle fillColor:self whiteColor
 ! !
 !GraphicsMedium methodsFor:'Compatibility-VW'!
 displayBackgroundIfNeededOn: aGraphicsContext
 !
 atX:x y:y
 "return the pixel at the coordinate given by x/y"
-gc == self ifTrue:[
-	^ super atX:x y:y
-].
 ^ gc atX:x y:y
 !
 atX:x y:y put:aPixelColor
 "set a pixel"
-gc == self ifTrue:[
-	super atX:x y:y put:aPixelColor.
-	^ self.
-].
 gc atX:x y:y put:aPixelColor.
 !
 backgroundPaint
 "return the background paint color.
 (used for opaqueForms and opaqueStrings)"
-gc == self ifTrue:[
-	^ super backgroundPaint.
-].
 ^ gc backgroundPaint
 !
 backgroundPaint:aColor
 "set the background-paint color; this is used in opaque-draw
 operations"
-gc == self ifTrue:[
-	super backgroundPaint:aColor.
-	^ self.
-].
 gc backgroundPaint:aColor
 !
 basicFont
 "return the font for drawing"
-gc == self ifTrue:[
-	^ super basicFont.
-].
 ^ gc basicFont
 !
 basicFont:aFont
 "set the font for drawing if it has changed.
 This is a low level entry, which is not to be redefined
 (i.e. it must not imply a redraw operation)"
-gc == self ifTrue:[
-	super basicFont:aFont.
-	^ self.
-].
 gc basicFont:aFont
 !
 blackColor
 gc isNil ifTrue:[
 ^ Color black.
 ].
-gc == self ifTrue:[
+^ gc blackColor
-^ super device blackColor.
-].
-^ gc device blackColor
 !
 bottomCenter
 "return the topCenter point"
 capStyle
 "return the current cap-style for line-drawing.
 possible styles are: #notLast, #butt, #round, #projecting"
-gc == self ifTrue:[
-	^ super capStyle.
-].
 ^ gc capStyle
 !
 capStyle:aStyleSymbol
 "set the cap-style for line-drawing;
 possible styles are: #notLast, #butt, #round, #projecting"
-gc == self ifTrue:[
-	super capStyle:aStyleSymbol.
-	^ self.
-].
 gc capStyle:aStyleSymbol
 "Modified: 12.5.1996 / 22:24:30 / cg"
 !
 occur when drawing).
 This is (currently) only passed down from the fileBrowser,
 and required when japanese/chinese/korean text is edited.
 (encoding is something like #'iso8859-5' #euc, #sjis, #jis7, #gb, #big5 or #ksc)"
-gc == self ifTrue:[
-	^ super characterEncoding.
-].
 ^ gc characterEncoding
 !
 characterEncoding:encodingArg
 "define how the contents is encoded internally.
 The possibility to change the characterEncoding is provided as
 a backward compatibility hook for programs which want to use
 another encoding internally. One such view is the CharacterSetView,
 which wants to show character as they are actually present in a font."
-gc == self ifTrue:[
-	super characterEncoding:encodingArg.
-	^ self.
-].
 gc characterEncoding:encodingArg
 !
 clipByChildren
 "drawing shall be done into my view only (default)"
 If on, a superview may draw 'over' its children.
 If off (the default), drawing is 'under' its children.
 Only useful for the rootView, to draw over any visible views.
 (for example, when dragging a rubber-line)"
-gc == self ifTrue:[
-super clippedByChildren:aBoolean.
-^ self.
-].
 gc clippedByChildren:aBoolean.
 "Created: 17.7.1996 / 13:25:16 / cg"
 "Modified: 29.4.1997 / 15:33:55 / dq"
 !
 clippingBounds
 "return the clipping rectangle for drawing, nil if there is none."
-gc == self ifTrue:[
-^ super clippingBounds.
-].
 ^ gc clippingBounds
 !
 clippingBounds:aRectangleOrNil
 "set the clipping rectangle for drawing (in logical coordinates);
 a nil argument turn off clipping (i.e. whole view is drawable)"
-gc == self ifTrue:[
-super clippingBounds:aRectangleOrNil.
-^ self.
-].
 gc clippingBounds:aRectangleOrNil
 !
 clippingBoundsOrNil
 "return the clipping rectangle for drawing, nil if there is none."
-gc == self ifTrue:[
-^ super clippingBoundsOrNil.
-].
 ^ gc clippingBoundsOrNil
 !
 clippingRectangle:aRectangleOrNil
 "set the clipping rectangle for drawing (in logical coordinates);
 !
 colorAtX:x y:y
 "return the color of the pixel at the coordinate given by aPoint"
-gc == self ifTrue:[
-	^ super colorAtX:x y:y.
-].
 ^ gc colorAtX:x y:y
 !
 container
 "return my container - for protocol compatibility"
 defines 4on-4off dashing;
 Setting it to [1 2 4 2] defines 1on-2off-4on-2off dashes.
 The dashOffset specifies where in the dashList the dashing starts.
 Ignored here - this may not be supported by all graphics devices."
-gc == self ifTrue:[
-	^ super dashStyle:aDashList offset:dashOffset.
-].
 ^ gc dashStyle:aDashList offset:dashOffset
+!
+depth
+^ self subclassResponsibility
 !
 device
 "return the device, the receiver is associated with"
-gc == self ifTrue:[
+^ device
-^ super device.
-].
-gc isNil ifTrue:[
-^ nil.
-].
-^ gc device
 !
 device:aDevice
 "set the device"
-aDevice isNil ifTrue:[
+(aDevice isNil or:[device == aDevice]) ifTrue:[
 ^ self.
 ].
 gc isNil ifTrue:[
-gc := aDevice newGraphicsContextFor:self.
+self initializeForDevice:aDevice.
-device := aDevice.
 ^ self.
 ].
-gc device:aDevice.
 device := aDevice.
+gc device:aDevice
-"Modified: / 03-04-2016 / 16:03:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
-!
+deviceClippingBounds:aRectangleOrNil
-deviceClippingRectangle:aRectangleOrNil
 "set the clipping rectangle for drawing (in device coordinates);
 a nil argument turns off clipping (i.e. whole view is drawable - incl. margins)"
-gc == self ifTrue:[
+gc deviceClippingBounds:aRectangleOrNil
-	super deviceClippingRectangle:aRectangleOrNil.
+!
-	^ self.
-].
+deviceClippingBoundsOrNil
-gc deviceClippingRectangle:aRectangleOrNil
+"return the clipping rectangle as physical coordinated for drawing, nil if there is none."
+^ gc deviceClippingBoundsOrNil
+!
+deviceClippingRectangle:aRectangleOrNil
+<resource: #obsolete>
+"set the clipping rectangle for drawing (in device coordinates);
+a nil argument turns off clipping (i.e. whole view is drawable - incl. margins)"
+gc deviceClippingBounds:aRectangleOrNil
 !
 drawableId
 "return the id of the drawable on the device"
-gc == self ifTrue:[
-^ super drawableId.
-].
 gc isNil ifTrue:[
 ^ nil.
 ].
 ^ gc drawableId
 !
 !
 font
 "return the current drawing font"
-gc == self ifTrue:[
-	^ super font.
-].
 ^ gc font
 !
 font:aFont
 "set the font for drawing if it has changed.
 This should be redefined in some widget to perform an automatic
 redraw. See also: #basicFont:"
-gc == self ifTrue:[
+gc font:aFont.
-super font:aFont.
-] ifFalse:[
-gc font:aFont.
-].
 self changed:#font.
 !
 function
 "return the current drawing function"
-gc == self ifTrue:[
-	^ super function.
-].
 ^ gc function
 !
 function:aSymbol
 "set the drawing function if it has changed"
-gc == self ifTrue:[
-	super function:aSymbol.
-	^ self.
-].
 gc function:aSymbol
 !
 gcId
 "return the receivers graphic context id on the device"
-gc == self ifTrue:[
-^ super gcId.
-].
 gc isNil ifTrue:[
 ^ nil.
 ].
 ^ gc gcId.
 !
 graphicsContext
-"for ST-80 compatibility"
 ^ gc
+!
+graphicsContext:newGc
+"set the graphics context"
+gc == newGc ifTrue:[
+^ self.
+].
+gc := newGc.
+device := newGc device.
 !
 graphicsDevice
 "same as #device, for ST-80 compatibility"
-gc == self ifTrue:[
+^ device
-^ super graphicsDevice.
-].
-gc isNil ifTrue:[
-^ nil.
-].
-^ gc graphicsDevice
 !
 height
 "return the height of the receiver"
 joinStyle
 "return the current join-style for polygon-drawing.
 possible styles are: #miter, #bevel, #round"
-gc == self ifTrue:[
-	^ super joinStyle.
-].
 ^ gc joinStyle
 !
 joinStyle:aStyleSymbol
 "set the join-style of lines in polygon-drawing;
 possible styles are: #miter, #bevel, #round"
-gc == self ifTrue:[
-	super joinStyle:aStyleSymbol.
-	^ self.
-].
 gc joinStyle:aStyleSymbol
 !
 left
 "return the left i.e. x-coordinate of top-left of the receiver"
 lineStyle
 "return the current line-drawing-style.
 possible styles are: #solid, #dashed, #doubleDashed,
 #dotted, #dashDot or #dashDotDot."
-gc == self ifTrue:[
-	^ super lineStyle.
-].
 ^ gc lineStyle
 !
 lineStyle:aStyleSymbol
 "set the line-drawing-style;
 possible styles are: #solid, #dashed, #doubleDashed,
 #dotted, #dashDot or #dashDotDot."
-gc == self ifTrue:[
-	super lineStyle:aStyleSymbol.
-	^ self.
-].
 gc lineStyle:aStyleSymbol
 !
 lineWidth
 "return the current drawing linewidth"
-gc == self ifTrue:[
-	^ super lineWidth.
-].
 ^ gc lineWidth
 !
 lineWidth:aNumber
 "set the line drawing width in pixels"
-gc == self ifTrue:[
-	super lineWidth:aNumber.
-	^ self.
-].
 gc lineWidth:aNumber
 !
 mask
 "return the current drawing mask"
-gc == self ifTrue:[
-	^ super mask.
-].
 ^ gc mask
 !
 mask:aForm
 "set the drawing mask"
-gc == self ifTrue:[
-	super mask:aForm.
-	^ self.
-].
 gc mask:aForm
 !
 maskOrigin
 "return the origin within the mask (used to draw with patterns).
 Should be redefined in classes which support it.
 This is an alias for ST-80's #phase"
-gc == self ifTrue:[
-	^ super maskOrigin.
-].
 ^ gc maskOrigin
 !
 maskOrigin:aPoint
 "set the origin within the mask (used to draw with patterns).
 Should be redefined in classes which support it.
 This is an alias for ST-80's #phase:"
-gc == self ifTrue:[
-	super maskOrigin:aPoint.
-	^ self.
-].
 gc maskOrigin:aPoint
 !
 maskOriginX:x y:y
 "set the origin within the mask (used to draw with patterns).
 !
 medium
 "return the destination medium i.e. the underlying graphics device"
-gc == self ifTrue:[
-^ super graphicsDevice.
-].
 ^ gc graphicsDevice
 !
 noClipByChildren
 "drawing shall also be done into subviews"
 !
 paint
 "return the current paint drawing color"
-gc == self ifTrue:[
-	^ super paint.
-].
 ^ gc paint
 !
 paint:aColor
 "set the drawing painting color, aColor can be a dithered one"
-gc == self ifTrue:[
-	super paint:aColor.
-	^ self.
-].
 gc paint:aColor
 !
 paint:fgColor on:bgColor
 "set the paint and backgroundPaint, used for text and bitmaps.
 Both colors may be dithered colors"
-gc == self ifTrue:[
-	super paint:fgColor on:bgColor.
-	^ self.
-].
 gc paint:fgColor on:bgColor
 !
 paint:fgColor on:bgColor function:f
 "set paint, background-paint and function"
 ^ (self left + width - 1) @ (self top + (height // 2) - 1)
 !
 setClippingBounds:aRectangleOrNil
-gc == self ifTrue:[
-super setClippingBounds:aRectangleOrNil.
-^ self.
-].
 gc setClippingBounds:aRectangleOrNil
 !
 setGraphicsExposures:aBoolean
 "want to if aBoolean is true - or don't want to be notified
 of graphics exposures"
-gc == self ifTrue:[
-	super setGraphicsExposures:aBoolean.
-	^ self.
-].
 gc setGraphicsExposures:aBoolean
 !
 setMaskOrigin:aPoint
 <resource: #obsolete>
 whiteColor
 gc isNil ifTrue:[
 ^ Color white.
 ].
-gc == self ifTrue:[
+^ gc whiteColor
-^ super graphicsDevice whiteColor.
-].
-^ gc graphicsDevice whiteColor
 !
 width
 "return the width of the receiver"
 background
 <resource: #obsolete>
 "return the current background drawing color.
 OBSOLETE: use #paint: / #backgroundPaint: / #paint:on:"
-gc == self ifTrue:[
-	^ super background.
-].
 ^ gc background
 "Modified: 12.5.1996 / 22:28:09 / cg"
 !
 background:aColor
 <resource: #obsolete>
 "set the internal background color for drawing - aColor must be a real color.
 OBSOLETE: this method will vanish; use #paint: / #backgroundPaint: / #paint:on:"
-gc == self ifTrue:[
-	super background:aColor.
-	^ self.
-].
 gc background:aColor
 !
 foreground
 <resource: #obsolete>
 "return the current foreground drawing color.
 OBSOLETE: use #paint: / #paint:on:"
-gc == self ifTrue:[
-	^ super foreground.
-].
 ^ gc foreground
 !
 foreground:aColor
 <resource: #obsolete>
 "set the internal foreground color for drawing - aColor must be a real color.
 OBSOLETE: this method will vanish; use #paint: / #paint:on:"
-gc == self ifTrue:[
-	super foreground:aColor.
-	^ self.
-].
 gc foreground:aColor
 !
 foreground:fgColor background:bgColor
 <resource: #obsolete>
 "set both internal foreground and internal background colors
 - these must be real colors.
 OBSOLETE: this method will vanish; use #paint: / #paint:on:"
-gc == self ifTrue:[
-	super foreground:fgColor background:bgColor.
-	^ self.
-].
 gc foreground:fgColor background:bgColor
 !
 foreground:fgColor background:bgColor function:fun
 <resource: #obsolete>
 "set foreground, background colors and function.
 OBSOLETE: this method will vanish; use #paint: / #paint:on:"
-self foreground:fgColor background:bgColor.
+gc foreground:fgColor background:bgColor.
-self function:fun
+gc function:fun
 "Modified: 12.5.1996 / 22:28:34 / cg"
 !
 foreground:aColor function:fun
 <resource: #obsolete>
 "set the foreground color and function for drawing.
 OBSOLETE: this method will vanish; use #paint: / #paint:on:"
-gc == self ifTrue:[
-	super foreground:aColor function:fun.
-	^ self.
-].
 gc foreground:aColor function:fun
 !
 setRealized:aBoolean
 "low level special interface to manipulate the realized state.
 !GraphicsMedium methodsFor:'accessing-transformation'!
 scale
 "return the scale factor (as point) of the transformation"
-gc == self ifTrue:[
-^ super scale.
-].
 ^ gc scale
 !
 scale:aPoint
 "set the scale factor of the transformation"
-gc == self ifTrue:[
-super scale:aPoint.
-^ self.
-].
 ^ gc scale:aPoint
 !
 transformation
 "return the transformation"
-gc == self ifTrue:[
-^ super transformation.
-].
 ^ gc transformation
 !
 transformation:aTransformation
 "set the transformation"
-gc == self ifTrue:[
-super transformation:aTransformation.
-^ self.
-].
 ^ gc transformation:aTransformation
 !
 translateBy:aPoint
 "add to the translation offset of the transformation"
-gc == self ifTrue:[
-super translateBy:aPoint.
-^ self.
-].
 ^ gc translateBy:aPoint
 !
 translation
 "return the translation factor (as point) of the transformation"
-gc == self ifTrue:[
-^ super translation.
-].
 ^ gc translation
 !
 translation:aPoint
 "set the translation offset of the transformation"
-gc == self ifTrue:[
-super translation:aPoint.
-^ self.
-].
 ^ gc translation:aPoint
 ! !
 !GraphicsMedium methodsFor:'basic drawing'!
 displayArcX:x y:y width:width height:height from:startAngle angle:angle
 "draw an arc in a box
 - this could be recoded to draw using displayLine"
-gc == self ifTrue:[
-	super displayArcX:x y:y width:width height:height from:startAngle angle:angle.
-	^ self.
-].
 gc displayArcX:x y:y width:width height:height from:startAngle angle:angle
 !
 displayDottedRectangleX:x y:y width:w height:h
 "draw a dotted-line rectangle
 A general implementation is found here; deviceGC's
 may reimplement this if directly supported by the device"
-gc == self ifTrue:[
-	super displayDottedRectangleX:x y:y width:w height:h.
-	^ self.
-].
 gc displayDottedRectangleX:x y:y width:w height:h
 !
 displayHorizontalWavelineFromX:x0 y:y0 toX:x1
 "draw a horizontal wave-line from x0/y0 to x1/y0"
-gc == self ifTrue:[
-	super displayHorizontalWavelineFromX:x0 y:y0 toX:x1.
-	^ self.
-].
 gc displayHorizontalWavelineFromX:x0 y:y0 toX:x1
 !
 displayLineFromX:x0 y:y0 toX:x1 y:y1
 "draw a line from x0/y0 to x1/y1"
-gc == self ifTrue:[
-	super displayLineFromX:x0 y:y0 toX:x1 y:y1.
-	^ self.
-].
 gc displayLineFromX:x0 y:y0 toX:x1 y:y1
 !
 displayOpaqueForm:aForm x:x y:y
 "draw a form at x/y; if the form has depth 1, 1's in the form are
 drawn in current fg, 0's in current bg color.
 If the form has depth ~~ 1, it is copied as is onto the receiver"
-gc == self ifTrue:[
-	super displayOpaqueForm:aForm x:x y:y.
-	^ self.
-].
 gc displayOpaqueForm:aForm x:x y:y
 !
 displayOpaqueString:aString from:index1 to:index2 x:x y:y
 "draw part of a string with both fg and bg at x/y in current font"
-gc == self ifTrue:[
-super displayString:aString from:index1 to:index2 x:x y:y opaque:true maxWidth:self width.
-^ self.
-].
 gc displayString:aString from:index1 to:index2 x:x y:y opaque:true maxWidth:self width
 !
 displayPolygon:aPolygon
 "draw a polygon
 - this could be recoded to draw using displayLine"
-gc == self ifTrue:[
-	super displayPolygon:aPolygon.
-	^ self.
-].
 gc displayPolygon:aPolygon
 !
 displayRectangleX:x y:y width:w height:h
 "draw a rectangle
 - this could be recoded to draw using displayLine"
-gc == self ifTrue:[
-	super displayRectangleX:x y:y width:w height:h.
-	^ self.
-].
 gc displayRectangleX:x y:y width:w height:h
 !
 displayString:aString from:index1 to:index2 x:x y:y
 "draw part of a string with fg at x/y in current font"
 !
 displayString:aString from:index1 to:index2 x:x y:y opaque:opaque maxWidth:maxWidth
 "draw part of a string with both fg and bg at x/y in current font"
-gc == self ifTrue:[
-super displayString:aString from:index1 to:index2 x:x y:y opaque:opaque maxWidth:maxWidth.
-^ self.
-].
 gc displayString:aString from:index1 to:index2 x:x y:y opaque:opaque maxWidth:maxWidth
 ! !
 !GraphicsMedium methodsFor:'basic filling'!
 fillArcX:x y:y width:w height:h from:start angle:angle
 "fill an arc with current paint color"
-gc == self ifTrue:[
-	super fillArcX:x y:y width:w height:h from:start angle:angle.
-	^ self.
-].
 gc fillArcX:x y:y width:w height:h from:start angle:angle
 !
 fillPolygon:points
 "fill a polygon with current paint color"
-gc == self ifTrue:[
-	super fillPolygon:points.
-	^ self.
-].
 gc fillPolygon:points
 !
 fillRectangleX:x y:y width:w height:h
 "fill a rectangle with current paint color"
-gc == self ifTrue:[
-	super fillRectangleX:x y:y width:w height:h.
-	^ self.
-].
 gc fillRectangleX:x y:y width:w height:h
 !
 fillRectangleX:x y:y width:w height:h color:aColor
 "fill a rectangle with given color"
-gc == self ifTrue:[
-	super fillRectangleX:x y:y width:w height:h color:aColor.
-	^ self.
-].
 gc fillRectangleX:x y:y width:w height:h color:aColor
 ! !
 !GraphicsMedium methodsFor:'bit blitting'!
 The bits found there are supposed to be in the devices native format (i.e.
 translated to allocated color indices on pseudoColor devices and padded as required.
 The byteOrder is MSB and will be converted as appropriate by the underlying devices
 method to whatever the device needs."
-gc == self ifTrue:[
-	super copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth padding:pad width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY.
-	^ self.
-].
 gc copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth padding:pad width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY
-!
-copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY
-"copy bits from a smalltalk byteArray.
-The bits found there are supposed to be in the devices native format (i.e.
-translated to allocated color indices on pseudoColor devices and padded as required.
-The byteOrder is MSB and will be converted as appropriate by the underlying devices
-method to whatever the device needs.
-Assumes the source bits are in ST/X's natural padding (i.e. 8-bit padded)"
-gc == self ifTrue:[
-	super copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY.
-	^ self.
-].
-gc copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY
 !
 copyFrom:aGC toX:dstX y:dstY
 "copy from a drawable - maybe self"
-gc == self ifTrue:[
+self copyFrom:aGC x:0 y:0 toX:dstX y:dstY width:aGC width height:aGC height async:false
-	super copyFrom:aGC toX:dstX y:dstY.
-	^ self.
-].
-gc copyFrom:aGC toX:dstX y:dstY
 !
 copyFrom:aGC x:srcX y:srcY toX:dstX y:dstY width:w height:h
 "copy from a drawable - maybe self"
-gc == self ifTrue:[
+self copyFrom:aGC x:srcX y:srcY toX:dstX y:dstY width:w height:h async:false
-	super copyFrom:aGC x:srcX y:srcY toX:dstX y:dstY width:w height:h.
-	^ self.
-].
-gc copyFrom:aGC x:srcX y:srcY toX:dstX y:dstY width:w height:h
 !
 copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h async:async
 "copy from aDrawable into the receiver;
 the source may be the receiver as well - in this case its a scroll.
 If the receiver is a view AND async is true, the call returns immediately
 - otherwise, it returns when the scroll operation is finished.
 (not all devices care for this).
 If the receiver is a pixmap, the call always returns immediately."
-|myDevice deviceDrawable asy|
+|deviceDrawable mustWait|
-myDevice := gc graphicsDevice.
+((aDrawable graphicsDevice ~~ device)
-((aDrawable graphicsDevice ~~ myDevice)
 or:[aDrawable isImage]) ifTrue:[
-deviceDrawable := aDrawable asFormOn:myDevice.
+deviceDrawable := aDrawable asFormOn:device.
 ] ifFalse:[
 deviceDrawable := aDrawable
 ].
-asy := async or:[self isView not or:[ deviceDrawable isForm ]].
+mustWait := async not and:[deviceDrawable isView and:[((deviceDrawable depth ~~ 1) or:[device depth == 1])]].
-asy ifFalse:[
+mustWait ifTrue:[
-self catchExpose
+mustWait := self catchExpose.
 ].
-gc == self ifTrue:[
+gc copyFrom:deviceDrawable graphicsContext x:srcX y:srcY toX:dstX y:dstY width:w height:h depth:self depth.
-super copyFrom:deviceDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h async:true.
+mustWait ifTrue:[
-] ifFalse:[
-gc copyFrom:deviceDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h async:true.
-].
-asy ifFalse:[
-myDevice flush.
 self waitForExpose
 ]
-"Modified: / 26-04-2016 / 20:30:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 copyFrom:aGC x:dstX y:dstY width:w height:h
 "copy from a drawable - maybe self"
-gc == self ifTrue:[
+self copyFrom:aGC x:0 y:0 toX:dstX y:dstY width:w height:h async:false
-	super copyFrom:aGC x:dstX y:dstY width:w height:h.
-	^ self.
-].
-gc copyFrom:aGC x:dstX y:dstY width:w height:h
 !
 copyPlaneFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h
 "copy one plane from aDrawable into the receiver. 0's are drawn in
 background, while 1's are drawn with foreground color.
 The depth of aDrawable must (should) be 1.
 The drawable must have been allocated on the same device.
 All coordinates are in device coordinates."
-gc == self ifTrue:[
+|deviceDrawable|
-	super copyPlaneFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h.
-	^ self.
+((aDrawable graphicsDevice ~~ device)
-].
+or:[aDrawable isImage]) ifTrue:[
-gc copyPlaneFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h
+deviceDrawable := aDrawable asFormOn:device.
+] ifFalse:[
+deviceDrawable := aDrawable
+].
+gc copyPlaneFrom:deviceDrawable graphicsContext x:srcX y:srcY toX:dstX y:dstY width:w height:h
 ! !
 !GraphicsMedium methodsFor:'copying'!
 postCopy
 !
 displayCircle:aPoint radius:r
 "draw a circle around a center point"
-gc == self ifTrue:[
-	super displayCircleX:(aPoint x) y:(aPoint y) radius:r.
-	^ self.
-].
 gc displayCircleX:(aPoint x) y:(aPoint y) radius:r
 !
 displayCircleIn:aRectangle
 "draw a circle in a box"
 !
 displayForm:aFormOrImage
 "draw a form (or image) at the origin"
-gc == self ifTrue:[
-	super displayForm:aFormOrImage x:0 y:0.
-	^ self.
-].
 gc displayForm:aFormOrImage x:0 y:0
 "Modified: / 24.4.1997 / 16:00:11 / cg"
 "Created: / 9.11.1997 / 00:50:52 / cg"
 !
 displayForm:aFormOrImage at:aPoint
 "draw a form (or image)"
-gc == self ifTrue:[
-	super displayForm:aFormOrImage x:(aPoint x) y:(aPoint y).
-	^ self.
-].
 gc displayForm:aFormOrImage x:(aPoint x) y:(aPoint y)
 "Modified: 24.4.1997 / 16:00:11 / cg"
 !
 (by sending #on: to the color) before doing so.
 Using functions other than #copy only makes sense if you are
 certain, that the colors are real colors (actually, only for
 noColor or allColor)."
-gc == self ifTrue:[
-	super displayForm:formToDraw x:x y:y.
-	^ self.
-].
 gc displayForm:formToDraw x:x y:y
 !
 displayForm:aFormOrImage x:x y:y opaque:opaque
 "draw a form (or image) at x/y;
 displayImage:aFormOrImage
 "draw an image (or form).
 Provided for ST-80 compatibilty;
 in ST/X, images are also handled by #displayForm:"
-gc == self ifTrue:[
-	super displayForm:aFormOrImage x:0 y:0.
-	^ self.
-].
 gc displayForm:aFormOrImage x:0 y:0
 !
 displayImage:aFormOrImage at:aPoint
 "draw an image (or form).
 Provided for ST-80 compatibilty;
 in ST/X, images are also handled by #displayForm:"
-gc == self ifTrue:[
-	super displayForm:aFormOrImage x:(aPoint x) y:(aPoint y).
-	^ self.
-].
 gc displayForm:aFormOrImage x:(aPoint x) y:(aPoint y)
 "Modified: 24.4.1997 / 16:02:43 / cg"
 !
 displayImage:aFormOrImage x:x y:y
 "draw an image (or form).
 Provided for ST-80 compatibilty;
 in ST/X, images are also handled by #displayForm:"
-gc == self ifTrue:[
-	super displayForm:aFormOrImage x:x y:y.
-	^ self.
-].
 gc displayForm:aFormOrImage x:x y:y
 "Created: 24.4.1997 / 16:03:03 / cg"
 !
 displayLineFrom:point1 to:point2
 "draw a line"
-gc == self ifTrue:[
-	super displayLineFromX:(point1 x) y:(point1 y)
-		      toX:(point2 x) y:(point2 y).
-	^ self.
-].
 gc displayLineFromX:(point1 x) y:(point1 y)
-		      toX:(point2 x) y:(point2 y)
+toX:(point2 x) y:(point2 y)
 !
 displayLineFromX:xStart y:yStart toX:xEnd y:yEnd brush:aForm
 "draw a line using a brush.
 Here, a slow fallback is used, drawing into a
 |deltaX deltaY dx dy px py destX destY p tempForm
 xMin xMax yMin yMax x1 x2 y1 y2|
 xStart < xEnd ifTrue:[
-xMin := xStart.
+	xMin := xStart.
-xMax := xEnd.
+	xMax := xEnd.
 ] ifFalse:[
-xMin := xEnd.
+	xMin := xEnd.
-xMax := xStart
+	xMax := xStart
 ].
 yStart < yEnd ifTrue:[
-yMin := yStart.
+	yMin := yStart.
-yMax := yEnd.
+	yMax := yEnd.
 ] ifFalse:[
-yMin := yEnd.
+	yMin := yEnd.
-yMax := yStart
+	yMax := yStart
 ].
 tempForm := Form width:(xMax-xMin+1+aForm width)
-height:(yMax-yMin+1+aForm height)
+		     height:(yMax-yMin+1+aForm height)
-depth:aForm depth
+		     depth:aForm depth
-onDevice:device.
+		     onDevice:self graphicsDevice.
 tempForm clear.
 tempForm paint:(Color colorId:1) on:(Color colorId:0).
 tempForm function:#or.
 ((yStart = yEnd and:[xStart < xEnd])
 or: [yStart < yEnd]) ifTrue:[
-x1 := xStart. y1 := yStart.
+	x1 := xStart. y1 := yStart.
-x2 := xEnd. y2 := yEnd.
+	x2 := xEnd. y2 := yEnd.
 ] ifFalse:[
-x1 := xEnd. y1 := yEnd.
+	x1 := xEnd. y1 := yEnd.
-x2 := xStart. y2 := yStart.
+	x2 := xStart. y2 := yStart.
 ].
 x1 := x1 - xMin.  x2 := x2 - xMin.
 y1 := y1 - yMin.  y2 := y2 - yMin.
 py := deltaX abs.
 tempForm displayForm:aForm x:destX y:destY.
 py > px ifTrue:[
-"horizontal"
+	"horizontal"
-p := py // 2.
+	p := py // 2.
-py timesRepeat:[
+	py timesRepeat:[
-destX := destX + dx.
+	    destX := destX + dx.
-(p := p - px) < 0 ifTrue:[
+	    (p := p - px) < 0 ifTrue:[
-destY := destY + dy.
+		destY := destY + dy.
-p := p + py
+		p := p + py
-].
+	    ].
-tempForm displayForm:aForm x:destX y:destY.
+	    tempForm displayForm:aForm x:destX y:destY.
-]
+	]
 ] ifFalse:[
-"vertical"
+	"vertical"
-p := px // 2.
+	p := px // 2.
-px timesRepeat:[
+	px timesRepeat:[
-destY := destY + dy.
+	    destY := destY + dy.
-(p := p - py) < 0 ifTrue:[
+	    (p := p - py) < 0 ifTrue:[
-destX := destX + dx.
+		destX := destX + dx.
-p := p + px
+		p := p + px
-].
+	    ].
-tempForm displayForm:aForm x:destX y:destY
+	    tempForm displayForm:aForm x:destX y:destY
-]
+	]
 ].
 self displayForm:tempForm
-x:xMin-aForm offset x
+		   x:xMin-aForm offset x
-y:yMin-aForm offset y.
+		   y:yMin-aForm offset y.
 tempForm close
 "Modified: 1.4.1997 / 21:29:06 / cg"
 !
 displayOpaqueString:aString at:aPoint
 "draw a string with both fg and bg"
-gc == self ifTrue:[
-	super displayOpaqueString:aString x:(aPoint x) y:(aPoint y).
-	^ self.
-].
 gc displayOpaqueString:aString x:(aPoint x) y:(aPoint y)
 !
 displayOpaqueString:aString from:start to:stop at:aPoint
 "draw part of a string - drawing both fg and bg"
 background pixels in bgPaint color. If the transformation involves scaling,
 the fonts point-size is scaled as appropriate.
 Assuming that device can only draw in device colors, we have to handle
 the case where paint and/or bgPaint are dithered colors or images."
-gc == self ifTrue:[
-	super displayOpaqueString:aString x:x y:y.
-	^ self.
-].
 gc displayOpaqueString:aString x:x y:y
 !
 displayOpaqueString:aString x:x y:y angle:drawAngle
 "draw a string along a (possibly non-horizontal) line,
 The angle is in degrees, clock-wise, starting with 0 for
 a horizontal draw.
 Drawing is done by first drawing the string into a temporary bitmap,
 which is rotated and finally drawn as usual.
 NOTICE: due to the rotation of the temporary bitmap, this is a slow
-	     operation - not to be used with cillions of strings ..."
+operation - not to be used with cillions of strings ..."
-gc == self ifTrue:[
-	super displayString:aString x:x y:y angle:drawAngle opaque:true.
-	^ self.
-].
 gc displayString:aString x:x y:y angle:drawAngle opaque:true
 "
 |v|
 v := View new.
 v extent:300@200.
 v openAndWait.
 0 to:360 by:45 do:[:a |
-	 v paint:Color black on:Color red.
+v paint:Color black on:Color red.
-	 v displayOpaqueString:'hello world' x:100 y:100 angle:a.
+v displayOpaqueString:'hello world' x:100 y:100 angle:a.
 ].
 "
 "in contrast to non-opaque draw:
 |v|
 v := View new.
 v extent:300@200.
 v openAndWait.
 0 to:360 by:45 do:[:a |
-	 v paint:Color black on:Color red.
+v paint:Color black on:Color red.
-	 v displayString:'hello world' x:100 y:100 angle:a.
+v displayString:'hello world' x:100 y:100 angle:a.
 ].
 "
 "Modified: 23.4.1997 / 17:50:23 / cg"
 !
 displayPoint:aPoint
 "draw a pixel"
-gc == self ifTrue:[
-	super displayPointX:(aPoint x) y:(aPoint y).
-	^ self.
-].
 gc displayPointX:(aPoint x) y:(aPoint y)
 !
 displayPointX:x y:y
 "draw a point (with current paint-color); apply transformation if nonNil"
-gc == self ifTrue:[
-	super displayPointX:x y:y.
-	^ self.
-].
 gc displayPointX:x y:y
 !
 displayRectangle:aRectangle
 "draw a rectangle"
 self displayRectangleX:(origin x) y:(origin y)
 		     width:(extent x)
 		    height:(extent y)
 !
-displayRoundRectangleX:x y:y width:w height:h wCorner:wCorn hCorner:hCorn
+displayRoundRectangleX:left y:top width:width height:height wCorner:wCorn hCorner:hCorn
-gc displayRoundRectangleX:x y:y width:w height:h wCorner:wCorn hCorner:hCorn
+|right bottom wC hC wHalf hHalf isWin32|
-"Modified: / 07-01-2015 / 20:17:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+"/ BIG KLUDGE WARNING HERE: the code below looks "good" on windows displays;
+"/ (if you change anything under Unix, make it X-platform specific.
+"/ (there seem to be drawing incompatibilities between Win- and XWorkstation)
+isWin32 := self device isWindowsPlatform.
+right := left + width-1.
+bottom := top + height-1.
+wC := wCorn.
+hC := hCorn.
+self scale = 1 ifTrue:[
+	wHalf := wC // 2.
+	hHalf := hC // 2.
+] ifFalse:[
+	wHalf := wC / 2.
+	hHalf := hC / 2.
+].
+"top left arc"
+self displayArcX:left y:top width:wC height:hC from:90 angle:90.
+"top right arc"
+self displayArcX:(right - wC) y:top width:wC height:hC from:0 angle:90.
+"bottom right arc"
+(isWin32 and:[self scale = 1]) ifTrue:[
+	self displayArcX:(right - wC+1) y:(bottom - hC+1) width:wC height:hC from:270 angle:90.
+] ifFalse:[
+	self displayArcX:(right - wC) y:(bottom - hC) width:wC height:hC from:270 angle:90.
+].
+"bottom left arc"
+self displayArcX:left y:(bottom - hC) width:wC height:hC from:180 angle:90.
+"top line"
+self displayLineFromX:(left + wHalf) y:top toX:(right - wHalf-1) y:top.
+"left line"
+self displayLineFromX:left y:(top + hHalf - 1) toX:left y:(bottom - hHalf - 2).
+"bottom line"
+self displayLineFromX:(left + wHalf-1) y:bottom
+		      toX:(right - wHalf ) y:bottom.
+"right line"
+self displayLineFromX:right y:(top + hHalf) toX:right y:(bottom - hHalf).
+"
+|v|
+(v := View new) extent:200@200; openAndWait.
+v displayRoundRectangleX:10 y:10 width:100 height:100 wCorner:20 hCorner:20
+"
 !
 displayString:aString at:aPoint
 "draw a string - drawing fg only"
 The angle is in degrees, clock-wise, starting with 0 for
 a horizontal draw.
 Drawing is done by first drawing the string into a temporary bitmap,
 which is rotated and finally drawn as usual.
 NOTICE: due to the rotation of the temporary bitmap, this is a slow
-	     operation - not to be used with cillions of strings ...
+operation - not to be used with cillions of strings ...
 CAVEAT: if the string is not a real string (i.e. a LabelAndIcon),
-	     this can (currently) only be done opaque"
+this can (currently) only be done opaque"
-gc == self ifTrue:[
-	super displayString:aString x:x y:y angle:drawAngle opaque:opaque.
-	^ self.
-].
 gc displayString:aString x:x y:y angle:drawAngle opaque:opaque
 !
 displayUnscaledForm:formToDraw x:x y:y
 "draw a form or image non opaque and unscaled;
 Using functions other than #copy only makes sense if you are
 certain, that the colors are real colors (actually, only for
 noColor or allColor).
 The origins coordinate is transformed, but the image itself is unscaled."
-gc == self ifTrue:[
-	super displayUnscaledForm:formToDraw x:x y:y.
-	^ self.
-].
 gc displayUnscaledForm:formToDraw x:x y:y
 !
 displayUnscaledOpaqueForm:formToDraw x:x y:y
 "draw a form or image opaque and unscaled;
 current paint-color, 0 bits in background color.
 If its a deep form (i.e. a pixmap) the current paint
 settings are ignored and the form is drawn as-is (opaque).
 The origins coordinate is transformed, but the image itself is unscaled."
-gc == self ifTrue:[
-	super displayUnscaledOpaqueForm:formToDraw x:x y:y.
-	^ self.
-].
 gc displayUnscaledOpaqueForm:formToDraw x:x y:y
 !
 displayUnscaledOpaqueString:aString from:index1 to:index2 x:x y:y
 "draw a substring at the transformed coordinate x/y but do not scale the font.
 Draw foreground pixels in paint-color, background pixels in bgPaint color."
-gc == self ifTrue:[
-	super displayUnscaledOpaqueString:aString from:index1 to:index2 x:x y:y.
-	^ self.
-].
 gc displayUnscaledOpaqueString:aString from:index1 to:index2 x:x y:y
 !
 displayUnscaledOpaqueString:aString x:x y:y
 "draw a string at the transformed coordinate x/y but do not scale the font.
 Draw foreground pixels in paint-color, background pixels in bgPaint color."
-gc == self ifTrue:[
-	super displayUnscaledOpaqueString:aString x:x y:y.
-	^ self.
-].
 gc displayUnscaledOpaqueString:aString x:x y:y
 !
 displayUnscaledString:aString from:index1 to:index2 x:x y:y
 "draw a substring at the transformed coordinate x/y but do not scale the font.
 draw foreground-pixels only (in current paint-color), leaving background as-is."
-gc == self ifTrue:[
-	super displayUnscaledString:aString from:index1 to:index2 x:x y:y.
-	^ self.
-].
 gc displayUnscaledString:aString from:index1 to:index2 x:x y:y
 !
 displayUnscaledString:aString x:x y:y
 "draw a string at the transformed coordinate x/y but do not scale the font.
 draw foreground-pixels only (in current paint-color), leaving background as-is."
-gc == self ifTrue:[
-	super displayUnscaledString:aString x:x y:y.
-	^ self.
-].
 gc displayUnscaledString:aString x:x y:y
 ! !
 !GraphicsMedium methodsFor:'drawing in device coordinates'!
 (by sending #on: to the color) before doing so.
 Using functions other than #copy only makes sense if you are
 certain, that the colors are real colors (actually, only for
 noColor or allColor)."
-gc == self ifTrue:[
-	super displayDeviceForm:aForm x:x y:y.
-	^ self.
-].
 gc displayDeviceForm:aForm x:x y:y
 !
 displayDeviceLineFromX:x1 y:y1 toX:x2 y:y2
 "draw a line in device coordinates"
-gc == self ifTrue:[
-	super displayDeviceLineFromX:x1 y:y1 toX:x2 y:y2.
-	^ self.
-].
 gc displayDeviceLineFromX:x1 y:y1 toX:x2 y:y2
 !
 displayDeviceOpaqueForm:aForm x:x y:y
 "draw a form or image opaque (i.e. both fg and bg is drawn);
 to the colors) before doing so.
 The form should have been allocated on the same device; otherwise,
 its converted here, which slows down the draw.
 Drawing is in device coordinates; no scaling is done."
-gc == self ifTrue:[
-	super displayDeviceOpaqueForm:aForm x:x y:y.
-	^ self.
-].
 gc displayDeviceOpaqueForm:aForm x:x y:y
-!
-displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:x y:y
-"draw a substring at the coordinate x/y - draw foreground pixels in
-paint-color and background pixels in bgPaint-color.
-Assuming that device can only draw in device colors, we have to handle
-the case where paint and/or bgPaint are dithered colors.
-No translation or scaling is done."
-gc == self ifTrue:[
-	super displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:x y:y.
-	^ self.
-].
-gc displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:x y:y
 !
 displayDeviceOpaqueString:aString from:index1 to:index2 x:x y:y
 "draw a substring at the coordinate x/y - draw foreground pixels in
 paint-color and background pixels in bgPaint-color.
 !
 displayDeviceRectangleX:x y:y width:w height:h
 "draw a rectangle in device coordinates"
-gc == self ifTrue:[
-	super displayDeviceRectangleX:x y:y width:w height:h.
-	^ self.
-].
 gc displayDeviceRectangleX:x y:y width:w height:h
 !
 displayDeviceString:aString from:index1 to:index2 in:font x:x y:y
 "draw a substring at the coordinate x/y -
 draw foreground-pixels only (in current paint-color), leaving background as-is.
 No translation or scaling is done"
-gc == self ifTrue:[
-super displayDeviceString:aString from:index1 to:index2 in:font x:x y:y.
-^ self.
-].
 gc displayDeviceString:aString from:index1 to:index2 in:font x:x y:y
 !
 displayDeviceString:aString from:index1 to:index2 x:x y:y
 "draw a substring at the coordinate x/y -
 !
 fillDeviceRectangleX:x y:y width:w height:h
 "fill a rectangle with current paint color (device coordinates)"
-gc == self ifTrue:[
-	super fillDeviceRectangleX:x y:y width:w height:h.
-	^ self.
-].
 gc fillDeviceRectangleX:x y:y width:w height:h
 ! !
 !GraphicsMedium methodsFor:'edge drawing'!
 drawEdgesForX:x y:y width:w height:h level:l
 "draw 3D edges into a rectangle"
 self
-drawEdgesForX:x y:y width:w height:h level:l
+	drawEdgesForX:x y:y width:w height:h level:l
-shadow:self blackColor light:self whiteColor
+	shadow:self blackColor light:self whiteColor
-halfShadow:nil halfLight:nil
+	halfShadow:nil halfLight:nil
-style:nil
+	style:nil
 !
 drawEdgesForX:x y:y width:w height:h level:l
-shadow:shadowColor light:lightColor
+		shadow:shadowColor light:lightColor
-halfShadow:halfShadowColor halfLight:halfLightColor
+		halfShadow:halfShadowColor halfLight:halfLightColor
-style:edgeStyle
+		style:edgeStyle
 "draw 3D edges into a rectangle"
 |topLeftFg botRightFg topLeftHalfFg botRightHalfFg
 count "{ Class: SmallInteger }"
 yi    "{ Class: SmallInteger }"
 run paint|
 count := l.
 (count < 0) ifTrue:[
-topLeftFg := shadowColor.
+	topLeftFg := shadowColor.
-botRightFg := lightColor.
+	botRightFg := lightColor.
-topLeftHalfFg := halfShadowColor.
+	topLeftHalfFg := halfShadowColor.
-botRightHalfFg := halfLightColor.
+	botRightHalfFg := halfLightColor.
-count := count negated
+	count := count negated
 ] ifFalse:[
-topLeftFg := lightColor.
+	topLeftFg := lightColor.
-botRightFg := shadowColor.
+	botRightFg := shadowColor.
-topLeftHalfFg := halfLightColor.
+	topLeftHalfFg := halfLightColor.
-botRightHalfFg := halfShadowColor.
+	botRightHalfFg := halfShadowColor.
 ].
 topLeftHalfFg isNil ifTrue:[
-topLeftHalfFg := topLeftFg
+	topLeftHalfFg := topLeftFg
 ].
 botRightHalfFg isNil ifTrue:[
-botRightHalfFg := botRightFg
+	botRightHalfFg := botRightFg
 ].
 r := x + w - 1. "right"
 b := y + h - 1. "bottom"
 self lineWidth:0.
 "top and left edges"
 ((edgeStyle == #soft or:[edgeStyle == #softWin95]) and:["l" count > 0]) ifTrue:[
-paint := topLeftHalfFg
+	paint := topLeftHalfFg
 ] ifFalse:[
-paint := topLeftFg
+	paint := topLeftFg
 ].
 self paint:paint.
 0 to:(count - 1) do:[:i |
-run := y + i.
+	run := y + i.
-run < b ifTrue:[
+	run < b ifTrue:[
-self displayDeviceLineFromX:x y:run toX:r y:run. "top"
+	    self displayDeviceLineFromX:x y:run toX:r y:run. "top"
-].
+	].
-run := x + i.
+	run := x + i.
-self displayDeviceLineFromX:run y:y toX:run y:b  "left"
+	self displayDeviceLineFromX:run y:y toX:run y:b  "left"
 ].
 (edgeStyle == #soft or:[edgeStyle == #softWin95]) ifTrue:[
 "
-self paint:topLeftFg.
+	self paint:topLeftFg.
-self displayDeviceLineFromX:x y:y toX:r y:y.
+	self displayDeviceLineFromX:x y:y toX:r y:y.
-self displayDeviceLineFromX:x y:y toX:x y:b
+	self displayDeviceLineFromX:x y:y toX:x y:b
 "
-(l > 1) ifTrue:[
+	(l > 1) ifTrue:[
-edgeStyle == #softWin95 ifTrue:[
+	    edgeStyle == #softWin95 ifTrue:[
-self paint:(Color veryLightGrey).
+		self paint:(Color veryLightGrey).
-] ifFalse:[
+	    ] ifFalse:[
-(l > 2 and:[edgeStyle == #soft]) ifTrue:[
+		(l > 2 and:[edgeStyle == #soft]) ifTrue:[
-self paint:(self device blackColor).
+		    self paint:(self device blackColor).
-] ifFalse:[
+		] ifFalse:[
-self paint:halfLightColor.
+		    self paint:halfLightColor.
-]
+		]
-].
+	    ].
-self displayDeviceLineFromX:x y:y toX:r y:y.
+	    self displayDeviceLineFromX:x y:y toX:r y:y.
-self displayDeviceLineFromX:x y:y toX:x y:b.
+	    self displayDeviceLineFromX:x y:y toX:x y:b.
-]
+	]
 ].
 xi := x + 1.
 yi := y + 1.
 "/ ].
 "bottom and right edges"
 ((edgeStyle == #soft or:[edgeStyle == #softWin95])
 "new:" and:[count > 1]) ifTrue:[
-paint := botRightHalfFg
+	paint := botRightHalfFg
 ] ifFalse:[
-paint := botRightFg
+	paint := botRightFg
 ].
 self paint:paint.
 0 to:(count - 1) do:[:i |
-run := b - i.
+	run := b - i.
-run > y ifTrue:[
+	run > y ifTrue:[
-self displayDeviceLineFromX:xi-1 y:run toX:r y:run. "bottom"
+	    self displayDeviceLineFromX:xi-1 y:run toX:r y:run. "bottom"
-].
+	].
-run := r - i.
+	run := r - i.
-self displayDeviceLineFromX:run y:yi-1 toX:run y:b.  "right"
+	self displayDeviceLineFromX:run y:yi-1 toX:run y:b.  "right"
-xi := xi + 1.
+	xi := xi + 1.
-yi := yi + 1
+	yi := yi + 1
 ].
 ((edgeStyle == #soft or:[edgeStyle == #softWin95])
 and:[l > 1]) ifTrue:[
-self paint:(self device blackColor) "shadowColor".
+	self paint:(self device blackColor) "shadowColor".
-self displayDeviceLineFromX:x y:b toX:r y:b.
+	self displayDeviceLineFromX:x y:b toX:r y:b.
-self displayDeviceLineFromX:r y:y toX:r y:b
+	self displayDeviceLineFromX:r y:y toX:r y:b
 ].
 self edgeDrawn:#all
 "Modified: / 24.8.1998 / 18:23:02 / cg"
 reverseDo:aBlock
 "evaluate aBlock with foreground and background interchanged.
 This can be reimplemented here in a faster way."
-gc == self ifTrue:[
-	super reverseDo:aBlock.
-	^ self.
-].
 gc reverseDo:aBlock
 !
 withBackground:fgColor do:aBlock
 "evaluate aBlock with changed background."
-gc == self ifTrue:[
-	super withBackground:fgColor do:aBlock.
-	^ self.
-].
 gc withBackground:fgColor do:aBlock
 !
 withForeground:fgColor background:bgColor do:aBlock
 "evaluate aBlock with changed foreground and background."
-gc == self ifTrue:[
-	super withForeground:fgColor background:bgColor do:aBlock.
-	^ self.
-].
 gc withForeground:fgColor background:bgColor do:aBlock
 !
 withForeground:fgColor background:bgColor function:aFunction do:aBlock
 "evaluate aBlock with foreground, background and function"
-gc == self ifTrue:[
-	super withForeground:fgColor background:bgColor function:aFunction do:aBlock.
-	^ self.
-].
 gc withForeground:fgColor background:bgColor function:aFunction do:aBlock
 !
 withForeground:fgColor background:bgColor mask:aMask do:aBlock
 "evaluate aBlock with foreground, background and mask"
-gc == self ifTrue:[
-	super withForeground:fgColor background:bgColor mask:aMask do:aBlock.
-	^ self.
-].
 gc withForeground:fgColor background:bgColor mask:aMask do:aBlock
 !
 withForeground:fgColor do:aBlock
 "evaluate aBlock with changed foreground."
-gc == self ifTrue:[
-	super withForeground:fgColor do:aBlock.
-	^ self.
-].
 gc withForeground:fgColor do:aBlock
 !
 withForeground:fgColor function:aFunction do:aBlock
 "evaluate aBlock with changed foreground and function."
-gc == self ifTrue:[
-	super withForeground:fgColor function:aFunction do:aBlock.
-	^ self.
-].
 gc withForeground:fgColor function:aFunction do:aBlock
 !
 xoring:aBlock
 "evaluate aBlock with function xoring"
-gc == self ifTrue:[
-	super xoring:aBlock.
-	^ self.
-].
 gc xoring:aBlock
 ! !
+!GraphicsMedium methodsFor:'event handling'!
+catchExpose
+"expose event handling is only required for views."
+^ false.
+!
+waitForExpose
+"expose event handling is only required for views."
+^ self.
+! !
 !GraphicsMedium methodsFor:'filling'!
 black
 "fill the receiver with black"
 self clearView.
 !
 clearDeviceRectangleX:x y:y width:w height:h
-"clear a rectangular area to viewBackground -
+"clear a rectangular area to background"
-redefined since GraphicsMedium fills with background
-- not viewBackground as we want here."
-gc == self ifTrue:[
-	super clearDeviceRectangleX:x y:y width:w height:h.
-	^ self.
-].
 gc clearDeviceRectangleX:x y:y width:w height:h.
 !
 clearInside
 "clear the receiver with background - ST-80 compatibility"
 		       y:(aRectangle top)
 		   width:(aRectangle width)
 		  height:(aRectangle height)
 !
-clearRectangleX:left y:top width:w height:h
+clearRectangleX:x y:y width:w height:h
-"clear the rectangular area in the receiver to background"
+gc clearRectangleX:x y:y width:w height:h.
-|oldPaint|
-oldPaint := gc paint.
-gc paint:gc backgroundPaint.
-gc fillRectangleX:left y:top width:w height:h.
-gc paint:oldPaint
-"Modified: 28.5.1996 / 20:14:11 / cg"
 !
 clearView
 "clear the receiver with background"
-"currently need this kludge for form ..."
+"/    "currently need this kludge for form ..."
-gc transformation isNil ifTrue:[
+"/    gc transformation isNil ifTrue:[
-	self clearRectangleX:0 y:0 width:width height:height
+"/        self clearRectangleX:0 y:0 width:width height:height
-] ifFalse:[
+"/    ] ifFalse:[
-	self clearDeviceRectangleX:0 y:0 width:width height:height
+self clearDeviceRectangleX:0 y:0 width:width height:height
-]
+"/    ]
 !
 fill:something
 "fill the receiver with something;
 something may be a Form, Color or colorIndex"
-|oldPaint|
+gc fillRectangle:self boundingBox color:something
-oldPaint := self paint.
-self paint:something.
-self fillRectangleX:0 y:0 width:width height:height.
-self paint:oldPaint
-"Modified: 28.5.1996 / 20:13:29 / cg"
 !
 fillArc:origin radius:r from:startAngle angle:angle
 "draw a filled arc around a point"
 Notice: the cornerPoint itself is NOT included"
 self fillRectangleX:(origin x) y:(origin y) width:(extent x) height:(extent y)
 !
-fillRoundRectangleX:x y:y width:w height:h wCorner:wCorn hCorner:hCorn
+fillRoundRectangleX:left y:top width:width height:height wCorner:wCorn hCorner:hCorn
-gc fillRoundRectangleX:x y:y width:w height:h wCorner:wCorn hCorner:hCorn
+|right bottom wC hC wHalf hHalf|
-"Modified: / 07-01-2015 / 20:18:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+right := left + width.
+bottom := top + height.
+wC := wCorn.
+hC := hCorn.
+wHalf := wC / 2.
+hHalf := hC / 2.
+self device isWindowsPlatform ifTrue:[
+	"/ bug workaround
+	"top left arc"
+	self fillArcX:left y:top width:wC height:hC from:90 angle:90.
+	"top right arc"
+	self fillArcX:(right - wC - 1) y:top width:wC height:hC from:0 angle:90.
+	"bottom right arc"
+	self fillArcX:(right - wC - 1) y:(bottom - hC - 1) width:wC height:hC from:270 angle:90.
+	"bottom left arc"
+	self fillArcX:left y:(bottom - hC) width:wC height:hC-1 from:180 angle:90.
+	"center rectangle"
+	self fillRectangleX:(left + wHalf) y:top width:(width - wHalf - wHalf+1) height:height-1.
+	"left partial rectangle"
+	self fillRectangleX:left y:top+hHalf width:wHalf height:(height-hHalf-hHalf).
+	"right partial rectangle"
+	self fillRectangleX:right-wHalf y:top+hHalf width:wHalf-1 height:(height-hHalf-hHalf).
+] ifFalse:[
+	"top left arc"
+	self fillArcX:left y:top width:wC height:hC from:90 angle:90.
+	"top right arc"
+	self fillArcX:(right - wC) y:top width:wC height:hC from:0 angle:90.
+	"bottom right arc"
+	self fillArcX:(right - wC - 1) y:(bottom - hC) width:wC height:hC from:270 angle:90.
+	"bottom left arc"
+	self fillArcX:left y:(bottom - hC) width:wC height:hC from:180 angle:90.
+	"center rectangle"
+	self fillRectangleX:(left + wHalf) y:top width:(width - wHalf - wHalf+1) height:height.
+	"left partial rectangle"
+	self fillRectangleX:left y:top+hHalf width:wHalf height:(height-hHalf-hHalf).
+	"right partial rectangle"
+	self fillRectangleX:right-wHalf y:top+hHalf width:wHalf height:(height-hHalf-hHalf).
+].
+"
+|v|
+(v := View new) extent:200@200; openAndWait.
+v fillRoundRectangleX:10 y:10 width:100 height:100 wCorner:20 hCorner:20
+"
 !
 invertRectangle:aRectangle
 "invert a rectangle in the receiver"
 !
 white
 "fill the receiver with white"
-self fill:Color white
+self fill:self whiteColor
 ! !
 !GraphicsMedium methodsFor:'initialization & release'!
 close
 "Created: 2.4.1997 / 19:31:27 / cg"
 !
 destroy
-"destroy a medium - here the fc is completely destroyed"
+"destroy a medium - here the gc is completely destroyed"
 gc notNil ifTrue:[
 gc destroy.
 ].
+device := nil.
 realized := false.
 !
 initGC
 "since we do not need a gc-object for the drawable until something is
 really drawn, none is created.
 This method is sent, when the first drawing happens"
-gc == self ifTrue:[
-	super initGC.
-	^ self.
-].
 gc initGC
 !
 initialize
 super initialize.
 initializeForDevice:aDevice
 "allocate a GraphicsContext for a device"
 aDevice notNil ifTrue:[
+device := aDevice.
 gc := aDevice newGraphicsContextFor:self.
-device := aDevice.
+gc font:self class defaultFont.
 ].
 self initialize.
-"Modified: / 03-04-2016 / 16:03:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 recreate
 "reacreate a medium after snapIn"
 gc notNil ifTrue:[
-gc recreate.
+	gc recreate.
 ].
 !
 releaseGC
 "destroy the associated device GC resource - can be done to be nice to the
 display if you know that you are done with a drawable."
-gc == self ifTrue:[
-super releaseGC.
-^ self.
-].
 gc notNil ifTrue:[
 gc releaseGC.
 ].
 ! !
 oldClip := gc deviceClippingBoundsOrNil.
 gc clippingBounds:aRectangle.
 aBlock
-ensure:[
+	ensure:[
-gc deviceClippingBounds:oldClip
+	    gc deviceClippingBounds:oldClip
-]
+	]
 !
 flush
 "send all buffered drawing to the device."
-gc == self ifTrue:[
-	super flush.
-	^ self.
-].
 gc flush
 !
 setDevice:aDevice id:aDrawbleId gcId:aGCId
 "private"
-gc == self ifTrue:[
+device := aDevice.
-super setDevice:aDevice id:aDrawbleId gcId:aGCId.
-^ self.
-].
 gc notNil ifTrue:[
 gc setDevice:aDevice id:aDrawbleId gcId:aGCId
 ].
-device := aDevice
-!
-setId:aDrawableId
-"private"
-gc == self ifTrue:[
-super setId:aDrawableId.
-^ self.
-].
-gc setId:aDrawableId
 !
 setPaint:fgColor on:bgColor
 "set the paint and background-paint color.
 The bg-paint is used in opaque-draw operations.
 Only set the variables, but do not send it to the device,
 Used on initialization."
-gc == self ifTrue:[
-super setPaint:fgColor on:bgColor.
-^ self.
-].
 gc setPaint:fgColor on:bgColor
 !
 sync
 "send all buffered drawing to the device and wait until the device responds"
-gc == self ifTrue:[
-super sync.
-^ self.
-].
 gc sync
 ! !
 !GraphicsMedium methodsFor:'printing & storing'!
 !GraphicsMedium methodsFor:'queries'!
 fontAscent
 "answer the ascent of the current font on the current device"
-gc == self ifTrue:[
-	^ super fontAscent.
-].
 ^ gc fontAscent
 !
 horizontalIntegerPixelPerMillimeter
 "return the (rounded) number of pixels per millimeter"
 !
 horizontalPixelPerMillimeter
 "return the number of pixels per millimeter (not rounded)"
-gc == self ifTrue:[
-	^ super horizontalPixelPerMillimeter.
-].
 ^ gc horizontalPixelPerMillimeter
 !
 horizontalPixelPerMillimeter:millis
 "return the number of pixels (not rounded) for millis millimeter"
 !
 resolution
 "return a point consisting of pixel-per-inch horizontally and vertically."
-gc == self ifTrue:[
-	^ super resolution.
-].
 ^ gc resolution
 !
 verticalIntegerPixelPerMillimeter
 "return the (rounded) number of pixels per millimeter"
 !
 verticalPixelPerMillimeter
 "return the number of pixels per millimeter (not rounded)"
-gc == self ifTrue:[
-	^ super verticalPixelPerMillimeter.
-].
 ^ gc verticalPixelPerMillimeter
 !
 verticalPixelPerMillimeter:millis
 "return the number of pixels (not rounded) for millis millimeter"
 !GraphicsMedium methodsFor:'view creation'!
 createBitmapFromArray:data width:width height:height
 "create a bitmap from data and set the drawableId"
-gc == self ifTrue:[
-super createBitmapFromArray:data width:width height:height.
-^ self.
-].
 gc createBitmapFromArray:data width:width height:height
 !
 createPixmapWidth:w height:h depth:d
 "create a pixmap and set the drawableId"
-gc == self ifTrue:[
-super createPixmapWidth:w height:h depth:d.
-^ self.
-].
 gc createPixmapWidth:w height:h depth:d
 !
 createRootWindow
-gc == self ifTrue:[
-super createRootWindowFor:self.
-^ self.
-].
 gc createRootWindowFor:self
 !
 createWindowFor:aView type:typeSymbol origin:org extent:ext minExtent:minE maxExtent:maxE borderWidth:bw subViewOf:sv style:styleSymbol inputOnly:inp label:label owner:owner icon:icn iconMask:icnM iconView:icnV
 "create a window and set the drawableId"
-gc == self ifTrue:[
-super createWindowFor:aView type:typeSymbol origin:org extent:ext minExtent:minE maxExtent:maxE borderWidth:bw subViewOf:sv style:styleSymbol inputOnly:inp label:label owner:owner icon:icn iconMask:icnM iconView:icnV.
-^ self.
-].
 gc createWindowFor:aView type:typeSymbol origin:org extent:ext minExtent:minE maxExtent:maxE borderWidth:bw subViewOf:sv style:styleSymbol inputOnly:inp label:label owner:owner icon:icn iconMask:icnM iconView:icnV
 ! !
 !GraphicsMedium class methodsFor:'documentation'!
 version_CVS
-^ '$Header: /cvs/stx/stx/libview/GraphicsMedium.st,v 1.22.2.4 2014-09-26 09:48:32 stefan Exp $'
+^ '$Header$'
-!
-version_HG
-^ '$Changeset: <not expanded> $'
 ! !

branch	jv
changeset 7541	39940e2446a5
parent 7318	83b501bbf3b0
parent 7485	24a3795170f1
child 7542	9e125aa140f9