GC.st
author claus
Fri, 28 Oct 1994 04:14:43 +0100
changeset 76 db983d8d7e53
parent 71 6a42b2b115f8
child 81 4ba554473294
permissions -rw-r--r--
scaling

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

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

Object subclass:#GraphicsContext
       instanceVariableNames:'paint bgPaint
			      function font
			      lineStyle lineWidth
			      joinStyle capStyle
			      mask maskOrigin transformation'
       classVariableNames:'White Black DefaultFont' 
       poolDictionaries:''
       category:'Graphics-Support'
!

GraphicsContext comment:'
COPYRIGHT (c) 1992 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libview/Attic/GC.st,v 1.12 1994-10-28 03:14:43 claus Exp $
'!

!GraphicsContext class methodsFor:'documentation'!

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

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

version
"
$Header: /cvs/stx/stx/libview/Attic/GC.st,v 1.12 1994-10-28 03:14:43 claus Exp $
"
!

documentation
"
    this is an abstract superclass for all kinds of graphic drawables -
    both windows and printed pages (i.e. printers) are inheriting from
    this class (even drawables not at all associated with any device would do so).

    Drawing is done in paint/bgPaint colors, which can be true colors (i.e.
    directly supported by the underlying hardware) or simulated colors
    (i.e. dithered colors or images).
    The paint/bgPaint instance variables are set to the logical colors,
    device specific drawable may like to keep actual colors in addition.

    The transformation instance variable is typically nil, for a 1-to-1
    coordinate mapping (i.e. x/y coordinates are pixels in the drawable).
    If nonNil, the transformation must be an  instance of WindowingTransformation
    and offers both a scale-factor and a translation.
    Also, drawing in metric- or inch-units can be done using transformations.
    (see instance creation methods of WindowingTransformation, and examples
     in 'doc/coding').

    All drawing is defined upon a few basic drawing methods, which must be 
    implemented by subclasses (some subclasses also redefine the others for
    more performance)

    Instance variables:

	paint           <Color>         the paint used for drawing
	bgPaint         <Color>         the background used for drawing texts and bitmaps
	function        <Symbol>        the drawing function (i.e. #copy, #or, #xor ...)
					- not all Drawables support every function
					(i.e. paper only allows #copy)
	font            <Font>          the current font to be used for drawing
	lineStyle       <Symbol>        the lineStyle (i.e. #solid, #dashed, #doubleDashed)
	lineWidth       <SmallInteger>  the lineWidth (device dependent, usually pixels)
	joinStyle       <Symbol>        the style in which lines (in polygons)
					are joined (i.e. #miter, #bevel, #round)
	capStyle        <Symbol>        the style in which the last point of a line is drawn
					(i.e. #notLast, #butt, #round, #projecting)
	mask            <Form>          a mask used for drawing
					- not all Drawables support it
	maskOrigin      <Point>         the origin of the mask relative to
					the drawables origin

    Class variables:

	White           <Color>         cached white color - its needed so often
	Black           <Color>         cached black color - its needed so often

	DefaultFont     <Font>          default font to use
"
! !

!GraphicsContext class methodsFor:'initialization'!

initialize
    "setup some defaults - these are usually redefined
     during startup."

    Color isNil ifTrue:[^ self].
    Color initialize.

    White := Color white on:Display.
    Black := Color black on:Display.

    Font initialize.
    DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12
! !

!GraphicsContext class methodsFor:'accessing defaults'!

defaultFont:aFont
    "set the default font used for drawing"

    DefaultFont := aFont
!

defaultFont
    "get the default font used for drawing"

    DefaultFont isNil ifTrue:[
	DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12
    ].
    ^ DefaultFont
! !

!GraphicsContext class methodsFor:'constants'!

joinRound
    "return a constant to specify round join"

    ^ #round
!

joinMiter
    "return a constant to specify miter join"

    ^ #miter
!

joinBevel
    "return a constant to specify bevel join"

    ^ #bevel
!

capNotLast
    "return a constant to specify not-last cap"

    ^ #notLast
!

capProjecting
    "return a constant to specify projecting cap"

    ^ #projecting
!

capRound
    "return a constant to specify round cap"

    ^ #round
!

capButt
    "return a constant to specify butt cap"

    ^ #butt
! !

!GraphicsContext class methodsFor:'instance creation'!

new
    ^ self basicNew initialize
! !

!GraphicsContext methodsFor:'initialization'!

initialize
    "set up some useful default values"

    paint := Black.
    bgPaint := White.
    function := #copy.
    lineWidth := 1.
    lineStyle := #solid.
    joinStyle := #miter.
    capStyle := #butt.
    font := DefaultFont.
! !

!GraphicsContext methodsFor:'misc'!

flush
    "st-80 compatibility"

    ^ self
! !

!GraphicsContext methodsFor:'accessing'!

paint
    "return the current paint drawing color"

    ^ paint
!

paint:aColor
    "set the drawing painting color, aColor can be a dithered one"

    paint := aColor
!

paint:fgColor on:bgColor
    "set the paint used for text and bitmaps, both colors may be
     dithered colors"

    self paint:fgColor.
    bgPaint := bgColor
!

backgroundPaint
    "return the background paint color.
     (used for opaqueForms and opaqueStrings)"

    ^ bgPaint
!

backgroundPaint:aColor
    "set the background painting color (which is used for
     opaqueForms and opaqueStrings). aColor can be a dithered one."

    ^ self subclassResponsibility
!

function
    "return the current drawing function"

    ^ function
!

function:aFunctionSymbol
    "set the drawing function"

    ^ self subclassResponsibility
!

lineWidth
    "return the current drawing linewidth"

    ^ lineWidth
!

lineWidth:aNumber
    "set the line drawing width in pixels"

    lineWidth := aNumber
!

lineStyle
    "return the current line-drawing-style"

    ^ lineStyle
!

lineStyle:aStyleSymbol
    "set the line-drawing-style;
     possible styles are: #solid, #dashed, #doubleDashed"

    lineStyle := aStyleSymbol
!

capStyle
    "return the current cap-style for line-drawing"

    ^ capStyle
!

capStyle:aStyleSymbol
    "set the cap-style for line-drawing;
     possible styles are: #notLast, #butt, #round, #projecting"

    ^ self subclassResponsibility
!

joinStyle
    "return the current join-style for polygon-drawing"

    ^ joinStyle
!

joinStyle:aStyleSymbol
    "set the join-style of lines in polygon-drawing;
     possible styles are: #miter, #bevel, #round"

    ^ self subclassResponsibility
!

mask
    "return the current drawing mask"

    ^ mask
!

mask:aForm
    "set the drawing mask"

    ^ self subclassResponsibility
!

font
    "return the current drawing font"

    ^ font
!

font:aFont
    "set the drawing font"

    ^ self subclassResponsibility
!

clipRect
    "return the drawing clip-rectangle"

    ^ self subclassResponsibility
!

clipRect:aRectangle
    "set the drawing clip-rectangle"

    ^ self subclassResponsibility
!

clippingBounds
    "for ST-80 compatibility"

    ^ self clipRect
!

graphicsContext
    "for ST-80 compatibility"

    ^ self
!

viewOrigin
    "return the drawables visible origin (for scrolling)"

    ^ 0@0
!

setMaskOrigin:aPoint
    ^ self
!

setMaskOriginX:x y:y
    ^ self
!

withPattern:aForm do:aBlock
    'pattern drawing not implemented' errorPrintNL.

    aBlock value
!

transformation 
    "return the transformation"

    ^ transformation
!

transformation:aTransformation 
    "set the transformation"

    transformation := aTransformation
! !

!GraphicsContext methodsFor:'ST-80 displaying'!

displayLineFrom:startPoint to:endPoint translateBy:anOffset
    "draw a line - ST-80 compatibility"

    self displayLineFrom:(startPoint + anOffset)
		      to:(endPoint + anOffset)
!

displayRectangularBorder:aRectangle at:aPoint
    "draw a rectangle - ST-80 compatibility"

    self displayRectangle:(aRectangle translateBy:aPoint)
!

displayPolyline:aPolygon
    "draw a polygon - ST-80 compatibility"

"/    |poly|

"/    poly := aPolygon collect:[:pount | pount rounded].
    ^ self displayPolygon:aPolygon 
!

displayArc:origin radius:radius from:startAngle angle:angle
    "draw an arc around a point"

    self displayArcX:(origin x - radius)
		   y:(origin y - radius)
		   w:(radius * 2) 
		   h:(radius * 2)
		from:startAngle angle:angle
!

displayArcBoundedBy:boundingBox startAngle:startAngle sweepAngle:sweepAngle at:origin
   "draw an arc/circle/ellipse - ST-80 compatibility"                                

   ^ self displayArcX:(boundingBox left + origin x)
		    y:(boundingBox top + origin y)
		width:(boundingBox width)
	       height:(boundingBox height)
		 from:startAngle
		angle:sweepAngle
!

displayWedgeBoundedBy:boundingBox startAngle:startAngle sweepAngle:sweepAngle at:origin
   "fill an arc/circle/ellipse - ST-80 compatibility"

   ^ self fillArcX:(boundingBox left + origin x)
		 y:(boundingBox top + origin y)
	     width:(boundingBox width)
	    height:(boundingBox height)
	      from:startAngle
	     angle:sweepAngle
! !

!GraphicsContext methodsFor:'bit-blitting'!

copyFrom:aGC x:srcX y:srcY toX:dstX y:dstY width:w height:h
    "copy from a drawable - maybe self"

    ^ self subclassResponsibility
!

copyFrom:aGC x:dstX y:dstY width:w height:h
    "copy from a drawable - maybe self"

    self copyFrom:aGC x:0 y:0 toX:dstX y:dstY width:w height:h
!

copyFrom:aGC toX:dstX y:dstY
    "copy from a drawable - maybe self"

    self copyFrom:aGC x:0 y:0 toX:dstX y:dstY width:aGC width height:aGC height
! !

!GraphicsContext methodsFor:'drawing in device coordinates'!

fillDeviceRectangleX: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. Use device coordinates."

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

fillDeviceRectangleX:x y:y width:w height:h
    "fill a rectangle with current paint color (device coordinates)"

    |sav|

    sav := transformation.
    transformation := nil.
    self fillRectangleX:x y:y width:w height:h.
    transformation := sav
!

displayDeviceLineFromX:x1 y:y1 toX:x2 y:y2
    "draw a line in device coordinates"

    |sav|

    sav := transformation.
    transformation := nil.
    self displayLineFromX:x1 y:y1 toX:x2 y:y2.
    transformation := sav
! !

!GraphicsContext methodsFor:'filling'!

fillRectangle:aRectangle
    "fill a rectangle with current paint color"

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

fillArc:origin radius:r from:startAngle angle:angle
    "draw a filled arc around a point"

    |d|
    d := 2 * r.
    self fillArcX:(origin x - r) y:(origin y - r)
		w:d h:d
	     from:startAngle angle:angle
!

fillCircle:aPoint radius:aNumber
    "draw a filled circle around aPoint"

    self fillCircleX:(aPoint x) y:(aPoint y) radius:aNumber
!

fillCircleX:x y:y radius:r
    "draw a filled circle around x@y"

    |d|

    d := 2 * r.
    self fillArcX:(x - r) y:(y - r) 
		w:d h:d 
	     from:0 angle:360
! !

!GraphicsContext methodsFor:'basic filling'!

fillPolygon:points
    "fill a polygon with current paint color"

    ^ self subclassResponsibility
!

fillRectangleX:x y:y width:w height:h
    "fill a rectangle with current paint color"

    ^ self subclassResponsibility
!

fillArcX:x y:y w:w h:h from:start angle:angle
    "fill an arc with current paint color"

    ^ self subclassResponsibility
! !

!GraphicsContext methodsFor:'basic displaying'!

displayPolygon:aPolygon
    "draw a polygon
     - this could be recoded to draw using displayLine"

    ^ self subclassResponsibility
!

displayArcX:x y:y w:width h:height from:startAngle angle:angle
    "draw an arc in a box
     - this could be recoded to draw using displayLine"

    ^ self subclassResponsibility
!

displayRectangleX:x y:y width:w height:h
    "draw a rectangle
     - this could be recoded to draw using displayLine"

    ^ self subclassResponsibility
!

displayForm: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 are ignored.
     If the form has depth ~~ 1, the result is undefined"

    |fg bg f noColor|

    fg := paint.
    bg := bgPaint.
    f := function.

    f ~~ #copy ifTrue:[
	self error:'function not supported'.
	^ self
    ].

    noColor := Color noColor.
    "
     stamp out fg-pixels
    "
    self paint:noColor on:Color allColor function:#and.
    self displayOpaqueForm:aForm x:x y:y.
    "
     or-in fg-pixels
    "
    self paint:fg on:Color noColor function:#or.
    self displayOpaqueForm:aForm x:x y:y.
    self paint:fg on:fg function:f.
!

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"

    ^ self subclassResponsibility
!

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"

    ^ self subclassResponsibility
!

displayString:aString from:index1 to:index2 x:x y:y
    "draw part of a string with fg at x/y in current font"

    ^ self subclassResponsibility
! !

!GraphicsContext methodsFor:'drawing'!

displayOpaqueString:aString x:x y:y
    "draw a string with both fg and bg"

    self displayOpaqueString:aString from:1 to:(aString size) x:x y:y
!

displayOpaqueString:aString at:aPoint
    "draw a string with both fg and bg"

    self displayOpaqueString:aString x:(aPoint x) y:(aPoint y)
!

displayString:aString x:x y:y
    "draw a string - drawing fg only"

    self displayString:aString from:1 to:(aString size) x:x y:y
!

displayString:aString at:aPoint
    "draw a string - drawing fg only"

    self displayString:aString x:aPoint x y:aPoint y
!

displayPointX:x y:y
    "draw a point at x/y"

    self displayLineFromX:x y:y toX:x y:y
!

displayPoint:aPoint
    "draw a pixel"

    self displayPointX:(aPoint x) y:(aPoint y)
!

displayLineFrom:point1 to:point2
    "draw a line"

    self displayLineFromX:(point1 x) y:(point1 y)
		      toX:(point2 x) y:(point2 y)
!

displayRectangle:aRectangle
    "draw a rectangle"

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

displayRectangleOrigin:origin corner:corner
    "draw a rectangle"

    |top left|

    left := origin x.
    top := origin y.
    self displayRectangleX:left y:top 
		     width:(corner x - left)
		    height:(corner y - top)
!

displayForm:aForm at:aPoint
    "draw a form"

    self displayForm:aForm x:(aPoint x) y:(aPoint y)
!

displayArcIn:aRectangle from:startAngle angle:angle
    "draw an arc in a box"

    self displayArcX:(aRectangle left)
		   y:(aRectangle top)
		   w:(aRectangle width)
		   h:(aRectangle height)
		from:startAngle
	       angle:angle
!

displayArcOrigin:origin corner:corner from:startAngle angle:angle
    "draw an arc in a box"

    |left top right bot|

    left := origin x.
    top := origin y.
    right := corner x.
    bot := corner y.
    self displayArcX:left y:top
		   w:(right - left + 1) h:(bot - top + 1)
		from:startAngle angle:angle
!

displayCircleIn:aRectangle
    "draw a circle in a box"

    self
	displayArcX:(aRectangle left)
		  y:(aRectangle top)
		  w:(aRectangle width)
		  h:(aRectangle height)
	       from:0 angle:360
!

displayCircle:aPoint radius:r
    "draw a circle around a center point"

    self displayCircleX:(aPoint x) y:(aPoint y) radius:r
!

displayCircleX:x y:y radius:r
    "draw a circle around a center point"

    |d|
    d := 2 * r.
    self displayArcX:(x - r) y:(y - r)
		   w:d h:d
		from:0 angle:360
! !