GraphicsContext.st
changeset 71 6a42b2b115f8
parent 54 29a6b2f8e042
child 76 db983d8d7e53
--- a/GraphicsContext.st	Tue Oct 04 19:10:54 1994 +0100
+++ b/GraphicsContext.st	Mon Oct 10 03:30:48 1994 +0100
@@ -1,6 +1,6 @@
 "
  COPYRIGHT (c) 1992 by Claus Gittinger
-              All Rights Reserved
+	      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
@@ -12,30 +12,28 @@
 
 Object subclass:#GraphicsContext
        instanceVariableNames:'foreground background paint bgPaint
-                              function font
-                              lineStyle lineWidth
-                              joinStyle capStyle
-                              mask maskOrigin'
-       classVariableNames:'White Black' 
+			      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
+	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.10 1994-08-05 01:14:14 claus Exp $
+$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.11 1994-10-10 02:30:38 claus Exp $
 '!
 
-GraphicsContext class instanceVariableNames:'DefaultFont'!
-
 !GraphicsContext class methodsFor:'documentation'!
 
 copyright
 "
  COPYRIGHT (c) 1992 by Claus Gittinger
-              All Rights Reserved
+	      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
@@ -48,7 +46,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.10 1994-08-05 01:14:14 claus Exp $
+$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.11 1994-10-10 02:30:38 claus Exp $
 "
 !
 
@@ -59,13 +57,24 @@
     this class (even drawables not at all associated with any device would do so).
 
     Drawing is done somewhat silly (due to being both backward compatible
-    and supporting ST-80 messages). The paint instance describes the paint
-    color, which can be (on monos) a dither pixmap drawn in foreground/background
-    colors.
-    Foreground and background are the underlying basic-colors, which must be
-    real colors (i.e. non dithered). Direct access to fg/bg is discouraged, since
-    in the future, foreground / background will be totally replaced by
-    paint/bgPaint.
+    and supporting ST-80 messages). The paint/bgPaint instance variables are
+    the colors to draw with (drawing is donw as 'paint on bgPaint'.
+    both can be dithered colors.
+
+    The actual drawing colors used are foreground and background; these are the
+    real (i.e. non dithered) colors supported by the device. Direct access to 
+    fg/bg is discouraged, since in the future, these will be totally replaced by
+    paint/bgPaint (there are some operation, for which dithered drawing is not (yet)
+    supported - for example bitmap drawing cannot currently handle a dithered
+    background color.
+
+    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
@@ -73,34 +82,31 @@
 
     Instance variables:
 
-        paint           <Color>         the paint used for drawing
-        bgPaint         <Color>         the background used for drawing texts and bitmaps
-        foreground      <Color>         the device foreground color used for drawing
-        background      <Color>         the device background color used for drawing
-        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 font currently 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
+	paint           <Color>         the paint used for drawing
+	bgPaint         <Color>         the background used for drawing texts and bitmaps
+	foreground      <Color>         the device foreground color used for drawing
+	background      <Color>         the device background color used for drawing
+	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 font currently 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
+	White           <Color>         cached white color - its needed so often
+	Black           <Color>         cached black color - its needed so often
 
-    Class instance variables:
-
-        DefaultFont     <Font>          default font to use
+	DefaultFont     <Font>          default font to use
 "
 ! !
 
@@ -131,6 +137,9 @@
 defaultFont
     "get the default font used for drawing"
 
+    DefaultFont isNil ifTrue:[
+	DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12
+    ].
     ^ DefaultFont
 ! !
 
@@ -173,7 +182,7 @@
 !
 
 capButt
-    "return a  constant to specify butt cap"
+    "return a constant to specify butt cap"
 
     ^ #butt
 ! !
@@ -189,38 +198,14 @@
 initialize
     "set up some useful default values"
 
-    "default is drawing black-on-white;
-     since these two colors are needed very often, cache them here"
-
-"
-    White isNil ifTrue:[White := Color white].
-    Black isNil ifTrue:[Black := Color black].
-"
-    paint := Black.
-    bgPaint := White.
-    foreground := Black.
-    background := White.
+    paint := foreground := Black.
+    bgPaint := background := White.
     function := #copy.
     lineWidth := 1.
     lineStyle := #solid.
     joinStyle := #miter.
     capStyle := #butt.
-
-    self initFont
-!
-
-initFont
-    |aFont|
-
-    aFont := self class defaultFont.
-    "this is a kludge"
-    aFont isNil ifTrue:[
-        self class initialize.
-        aFont := self class defaultFont.
-    ].
-    aFont notNil ifTrue:[
-        font := aFont
-    ]
+    font := DefaultFont.
 ! !
 
 !GraphicsContext methodsFor:'misc'!
@@ -249,7 +234,7 @@
     "set the paint used for text and bitmaps, both colors may be
      dithered colors"
 
-    paint := fgColor.
+    self paint:fgColor.
     bgPaint := bgColor
 !
 
@@ -268,27 +253,31 @@
 !
 
 foreground
-    "return the current foreground drawing color"
+    "return the current foreground drawing color.
+     OBSOLETE: use paint:/paint:on:"
 
     ^ foreground
 !
 
 foreground:aColor
     "set the drawing foreground color.
-     aColor MUST be a real (i.e. device-) color"
+     aColor must be a real (i.e. device-) color.
+     OBSOLETE: use paint:/paint:on:"
 
     foreground := aColor
 !
 
 background
-    "return the current background drawing color"
+    "return the current background drawing color.
+     OBSOLETE: use paint:/paint:on:"
 
     ^ background
 !
 
 background:aColor
     "set the drawing background color.
-     aColor MUST be a real (i.e. device-) color"
+     aColor  must be a real (i.e. device-) color.
+     OBSOLETE: use paint:/paint:on:"
 
     background := aColor
 !
@@ -306,14 +295,16 @@
 !
 
 foreground:fgColor background:bgColor 
-    "set both foreground and background colors"
+    "set both foreground and background colors.
+     OBSOLETE: use paint:/paint:on:"
 
     self foreground:fgColor.
     self background:bgColor
 !
 
 foreground:fgColor background:bgColor function:f
-    "set foreground, background colors and function"
+    "set foreground, background colors and function.
+     OBSOLETE: use paint:/paint:on:"
 
     self foreground:fgColor.
     self background:bgColor.
@@ -422,11 +413,19 @@
 !
 
 withPattern:aForm do:aBlock
-    'pattern drawing not implemented' errorPrintNewline.
+    'pattern drawing not implemented' errorPrintNL.
+
     aBlock value
 ! !
 
-!GraphicsContext methodsFor:'displaying'!
+!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"
@@ -434,13 +433,6 @@
     self displayRectangle:(aRectangle translateBy:aPoint)
 !
 
-displayLineFrom:startPoint to:endPoint translateBy:anOffset
-    "draw a line - ST-80 compatibility"
-
-    self displayLineFrom:(startPoint + anOffset)
-                      to:(endPoint + anOffset)
-!
-
 displayPolyline:aPolygon
     "draw a polygon - ST-80 compatibility"
 
@@ -450,40 +442,103 @@
     self displayPolygon:poly 
 !
 
+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
+		    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
+		 y:(boundingBox top + origin y)
+	     width:(boundingBox width)
+	    height:(boundingBox height)
+	      from:startAngle
+	     angle:sweepAngle
 ! !
 
 !GraphicsContext methodsFor:'bit-blitting'!
 
-copyFrom:aGraphicContext x:srcX y:srcY toX:dstX y:dstY width:w height:h
+copyFrom:aGC x:srcX y:srcY toX:dstX y:dstY width:w height:h
     "copy from a drawable - maybe self"
 
     ^ self subclassResponsibility
 !
 
-copyFrom:aGraphicContext x:dstX y:dstY width:w height:h
+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:aGraphicContext x:0 y:0 toX:dstX y:dstY width:w height:h
+    self copyFrom:aGC x:0 y:0 toX:dstX y:dstY width:aGC width height:aGC height
+! !
+
+!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)
+!
+
+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
+    ]
+!
+
+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'!
@@ -500,38 +555,19 @@
     ^ self subclassResponsibility
 !
 
+fillDeviceRectangleX:x y:y width:w height:h
+    "fill a rectangle with current paint color (device coordinates)"
+
+    ^ 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:'filling'!
-
-fillRectangle:aRectangle
-    "fill a rectangle with current paint color"
-
-    self fillRectangleX:(aRectangle left)
-                      y:(aRectangle top)
-                  width:(aRectangle width)
-                 height:(aRectangle height)
-!
-
-fillCircle:aPoint radius:aNumber
-    "draw a filled circle"
-
-    self fillCircleX:(aPoint x) y:(aPoint y) radius:aNumber
-!
-
-fillCircleX:x y:y radius:r
-    "draw a filled circle"
-
-    |d|
-    d := 2 * r.
-    self fillArcX:(x - r) y:(y - r) w:d  h:d from:0 angle:360
-! !
-
-!GraphicsContext methodsFor:'basic drawing'!
+!GraphicsContext methodsFor:'basic displaying'!
 
 displayPolygon:aPolygon
     "draw a polygon
@@ -559,17 +595,29 @@
      drawn in current fg, 0's are ignored.
      If the form has depth ~~ 1, the result is undefined"
 
-    |fg bg f|
+    |fg bg f noColor|
 
-    fg := foreground.
-    bg := background.
+    fg := paint.
+    bg := bgPaint.
     f := function.
 
-    self foreground:(Color noColor) background:(Color allColor) function:#and.
+    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.
-    self foreground:fg background:(Color noColor) function:#or.
+    "
+     or-in fg-pixels
+    "
+    self paint:fg on:Color noColor function:#or.
     self displayOpaqueForm:aForm x:x y:y.
-    self foreground:fg background:fg function:f.
+    self paint:fg on:fg function:f.
 !
 
 displayOpaqueForm:aForm x:x y:y
@@ -634,16 +682,16 @@
     "draw a line"
 
     self displayLineFromX:(point1 x) y:(point1 y)
-                      toX:(point2 x) y:(point2 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)
+			 y:(aRectangle top)
+		     width:(aRectangle width)
+		    height:(aRectangle height)
 !
 
 displayRectangleOrigin:origin corner:corner
@@ -654,8 +702,8 @@
     left := origin x.
     top := origin y.
     self displayRectangleX:left y:top 
-                     width:(corner x - left)
-                    height:(corner y - top)
+		     width:(corner x - left)
+		    height:(corner y - top)
 !
 
 displayForm:aForm at:aPoint
@@ -668,11 +716,11 @@
     "draw an arc in a box"
 
     self displayArcX:(aRectangle left)
-                   y:(aRectangle top)
-                   w:(aRectangle width)
-                   h:(aRectangle height)
-                from:startAngle
-               angle:angle
+		   y:(aRectangle top)
+		   w:(aRectangle width)
+		   h:(aRectangle height)
+		from:startAngle
+	       angle:angle
 !
 
 displayArcOrigin:origin corner:corner from:startAngle angle:angle
@@ -685,19 +733,19 @@
     right := corner x.
     bot := corner y.
     self displayArcX:left y:top
-                   w:(right - left + 1) h:(bot - top + 1)
-                from:startAngle angle:angle
+		   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
+	displayArcX:(aRectangle left)
+		  y:(aRectangle top)
+		  w:(aRectangle width)
+		  h:(aRectangle height)
+	       from:0 angle:360
 !
 
 displayCircle:aPoint radius:r
@@ -712,6 +760,6 @@
     |d|
     d := 2 * r.
     self displayArcX:(x - r) y:(y - r)
-                   w:d h:d
-                from:0 angle:360
+		   w:d h:d
+		from:0 angle:360
 ! !