GraphicsMedium.st
author Claus Gittinger <cg@exept.de>
Tue, 28 May 1996 16:36:26 +0200
changeset 721 ba7861418087
child 727 bf23a306b6f2
permissions -rw-r--r--
renamed DisplayMedium to Graphicsmedium & changed inheritance

"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

DeviceDrawable subclass:#GraphicsMedium
	instanceVariableNames:'width height'
	classVariableNames:''
	poolDictionaries:''
	category:'Graphics-Support'
!

!GraphicsMedium class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    this is an abstract superclass for all kinds of drawables which
    have a physical representation (i.e. have an extent). Dont use messages
    from here - it will vanish soon.

    [Instance variables:]

        width           <SmallInteger>  the width (device dependent, usually pixels or inches)
        height          <SmallInteger>  the height (device dependent, usually pixels or inches)

    [author:]
        Claus Gittinger
"
! !

!GraphicsMedium methodsFor:'GC access'!

at:aPoint
    "return pixel value at coordinate"

    ^ self subclassResponsibility
!

drawPattern:aPattern
    "set the pattern to be drawn with - the pattern may be a color,
     a bitmap or pixmap"

    aPattern isColor ifTrue:[
	self paint:aPattern
    ] ifFalse:[
	self mask:aPattern
    ]
!

gc
    "ST-80 compatibility;
     in STX a displayMedium is its own graphicsContext"

    ^ self
! !

!GraphicsMedium methodsFor:'accessing'!

bottomCenter
    "return the topCenter point"

    ^ (self left + (width//2) - 1) @ (self top + height - 1)
!

bottomLeft
    "return the bottomLeft point"

    ^ (self left) @ (self top + height - 1)
!

center
    "return the point at the center of the receiver"

    ^ (self left + (width // 2)) @ (self top + (height // 2))
!

corner
    "return the corner point i.e. the bottom-right point"

    ^ (self left + width - 1) @ (self top + height - 1)
!

corner:aPoint
    "set the corner point i.e. change extent so that corner will be
     aPoint while leaving the origin unchanging "

    self extent:(aPoint x - self left + 1)
		@
		(aPoint y - self top + 1)
!

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
!

height
    "return the height of the receiver"

    ^ height
!

height:anInteger
    "set the height of the receiver"

    height := anInteger
!

isView
    "return true, if the receiver is a view"

    ^ false
!

left
    "return the left i.e. x-coordinate of top-left of the receiver"

    ^ 0
!

leftCenter
    "return the leftCenter point"

    ^ (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
!

top
    "return the top i.e. y-coordinate of top-left of the receiver"

    ^ 0
!

topCenter
    "return the topCenter point"

    ^ (self left + (width//2) - 1) @ (self top)
!

topRight
    "return the topRight point"

    ^ (self left + width - 1) @ (self top)
!

width
    "return the width of the receiver"

    ^ width
!

width:anInteger
    "set the width of the receiver"

    width := anInteger
!

width:w height:h
    "set both width and height of the receiver"

    width := w.
    height := h
! !

!GraphicsMedium methodsFor:'evaluating in another context'!

clippedTo:aRectangle do:aBlock
    "evaluate aBlock with clipping rectangle set to aRectangle"

    |oldClip|
    
    oldClip := clipRect.
    self clipRect:aRectangle.
    aBlock value.
    self clipRect:oldClip
!

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:[
	old := paint.
	self paint:aPattern.
	aBlock value.
	self paint:old
    ] ifFalse:[
	old := mask.
	self mask:aPattern.
	aBlock value.
	self mask:old
    ]
! !

!GraphicsMedium methodsFor:'filling'!

black
    "fill the receiver with black"

    self fill:Black
!

clear
    "clear the receiver with background"

    "currently need this kludge for form ..."
    transformation isNil ifTrue:[
	self clearRectangleX:0 y:0 width:width height:height
    ] ifFalse:[
	self clearDeviceRectangleX:0 y:0 width:width height:height
    ]
!

clearInside
    "clear the receiver with background - ST-80 compatibility"

    ^ self clear
!

clearRectangle:aRectangle
    "clear the rectangular area in the receiver to background"

    self clearRectangleX:(aRectangle left)
		       y:(aRectangle top)
		   width:(aRectangle width)
		  height:(aRectangle height)
!

clearRectangleX:left y:top width:w height:h
    "clear the rectangular area in the receiver to background"

    self fillRectangleX:left
		      y:top
		  width:w
		 height:h
		   with:bgPaint
!

fill:something
    "fill the receiver with something;
     something may be a Form, Color or colorIndex"

    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 obsoleteMethodWarning:'use #fillArcX:y:width:height:from:angle:with:'.
    self fillArcX:x y:y width:w height:h from:startAngle angle:angle with:aPattern

    "Modified: 8.5.1996 / 08:41:26 / cg"
!

fillArcX:x y:y width:w height: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 width:w height:h from:startAngle angle:angle
    ]

    "Created: 8.5.1996 / 08:40:41 / cg"
!

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)
           width:d
          height:d
            from:0
           angle:360
            with:aPattern

    "Modified: 8.5.1996 / 08:40:14 / cg"
!

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"

    self fillRectangleX:(aRectangle left)
		      y:(aRectangle top)
		  width:(aRectangle width)
		 height:(aRectangle height)
		   with:something
!

fillRectangleX:x y:y width:w height:h with:aPattern
    "fill the rectangular area in the receiver with aPattern,
     which may be a Form or Color"

    self withPattern:aPattern do:[
	self fillRectangleX:x y:y width:w height:h
    ]

    "
     Display rootView 
	fillRectangleX:0
		     y:0
		 width:50
		height:50
		  with:(Color grey:50)
    "
!

invertRectangle:aRectangle
    "invert a rectangle in the receiver"

    self xoring:[
	self fillRectangle:aRectangle
    ]
!

white
    "fill the receiver with white"

    self fill:White
! !

!GraphicsMedium methodsFor:'initialization'!

initialize
    "set up some useful default values"

    super initialize.

    width := 0.
    height := 0
! !

!GraphicsMedium class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview/GraphicsMedium.st,v 1.1 1996-05-28 14:36:26 cg Exp $'
! !