GraphicsMedium.st
changeset 721 ba7861418087
child 727 bf23a306b6f2
equal deleted inserted replaced
720:a582a7af45f4 721:ba7861418087
       
     1 "
       
     2  COPYRIGHT (c) 1989 by Claus Gittinger
       
     3 	      All Rights Reserved
       
     4 
       
     5  This software is furnished under a license and may be used
       
     6  only in accordance with the terms of that license and with the
       
     7  inclusion of the above copyright notice.   This software may not
       
     8  be provided or otherwise made available to, or used by, any
       
     9  other person.  No title to or ownership of the software is
       
    10  hereby transferred.
       
    11 "
       
    12 
       
    13 DeviceDrawable subclass:#GraphicsMedium
       
    14 	instanceVariableNames:'width height'
       
    15 	classVariableNames:''
       
    16 	poolDictionaries:''
       
    17 	category:'Graphics-Support'
       
    18 !
       
    19 
       
    20 !GraphicsMedium class methodsFor:'documentation'!
       
    21 
       
    22 copyright
       
    23 "
       
    24  COPYRIGHT (c) 1989 by Claus Gittinger
       
    25 	      All Rights Reserved
       
    26 
       
    27  This software is furnished under a license and may be used
       
    28  only in accordance with the terms of that license and with the
       
    29  inclusion of the above copyright notice.   This software may not
       
    30  be provided or otherwise made available to, or used by, any
       
    31  other person.  No title to or ownership of the software is
       
    32  hereby transferred.
       
    33 "
       
    34 !
       
    35 
       
    36 documentation
       
    37 "
       
    38     this is an abstract superclass for all kinds of drawables which
       
    39     have a physical representation (i.e. have an extent). Dont use messages
       
    40     from here - it will vanish soon.
       
    41 
       
    42     [Instance variables:]
       
    43 
       
    44         width           <SmallInteger>  the width (device dependent, usually pixels or inches)
       
    45         height          <SmallInteger>  the height (device dependent, usually pixels or inches)
       
    46 
       
    47     [author:]
       
    48         Claus Gittinger
       
    49 "
       
    50 ! !
       
    51 
       
    52 !GraphicsMedium methodsFor:'GC access'!
       
    53 
       
    54 at:aPoint
       
    55     "return pixel value at coordinate"
       
    56 
       
    57     ^ self subclassResponsibility
       
    58 !
       
    59 
       
    60 drawPattern:aPattern
       
    61     "set the pattern to be drawn with - the pattern may be a color,
       
    62      a bitmap or pixmap"
       
    63 
       
    64     aPattern isColor ifTrue:[
       
    65 	self paint:aPattern
       
    66     ] ifFalse:[
       
    67 	self mask:aPattern
       
    68     ]
       
    69 !
       
    70 
       
    71 gc
       
    72     "ST-80 compatibility;
       
    73      in STX a displayMedium is its own graphicsContext"
       
    74 
       
    75     ^ self
       
    76 ! !
       
    77 
       
    78 !GraphicsMedium methodsFor:'accessing'!
       
    79 
       
    80 bottomCenter
       
    81     "return the topCenter point"
       
    82 
       
    83     ^ (self left + (width//2) - 1) @ (self top + height - 1)
       
    84 !
       
    85 
       
    86 bottomLeft
       
    87     "return the bottomLeft point"
       
    88 
       
    89     ^ (self left) @ (self top + height - 1)
       
    90 !
       
    91 
       
    92 center
       
    93     "return the point at the center of the receiver"
       
    94 
       
    95     ^ (self left + (width // 2)) @ (self top + (height // 2))
       
    96 !
       
    97 
       
    98 corner
       
    99     "return the corner point i.e. the bottom-right point"
       
   100 
       
   101     ^ (self left + width - 1) @ (self top + height - 1)
       
   102 !
       
   103 
       
   104 corner:aPoint
       
   105     "set the corner point i.e. change extent so that corner will be
       
   106      aPoint while leaving the origin unchanging "
       
   107 
       
   108     self extent:(aPoint x - self left + 1)
       
   109 		@
       
   110 		(aPoint y - self top + 1)
       
   111 !
       
   112 
       
   113 extent
       
   114     "return the extent i.e. a point with width as x, height as y
       
   115      coordinate"
       
   116 
       
   117     ^ width @ height
       
   118 !
       
   119 
       
   120 extent:extent
       
   121     "set the extent"
       
   122 
       
   123     width := extent x.
       
   124     height := extent y
       
   125 !
       
   126 
       
   127 height
       
   128     "return the height of the receiver"
       
   129 
       
   130     ^ height
       
   131 !
       
   132 
       
   133 height:anInteger
       
   134     "set the height of the receiver"
       
   135 
       
   136     height := anInteger
       
   137 !
       
   138 
       
   139 isView
       
   140     "return true, if the receiver is a view"
       
   141 
       
   142     ^ false
       
   143 !
       
   144 
       
   145 left
       
   146     "return the left i.e. x-coordinate of top-left of the receiver"
       
   147 
       
   148     ^ 0
       
   149 !
       
   150 
       
   151 leftCenter
       
   152     "return the leftCenter point"
       
   153 
       
   154     ^ (self left) @ (self top + (height // 2) - 1)
       
   155 !
       
   156 
       
   157 origin
       
   158     "return the origin i.e. coordinate of top-left of the receiver"
       
   159 
       
   160     ^ 0 @ 0
       
   161 !
       
   162 
       
   163 rightCenter
       
   164     "return the leftCenter point"
       
   165 
       
   166     ^ (self left + width - 1) @ (self top + (height // 2) - 1)
       
   167 !
       
   168 
       
   169 setWidth:w height:h
       
   170     "set both width and height - not to be redefined"
       
   171 
       
   172     width := w.
       
   173     height := h
       
   174 !
       
   175 
       
   176 top
       
   177     "return the top i.e. y-coordinate of top-left of the receiver"
       
   178 
       
   179     ^ 0
       
   180 !
       
   181 
       
   182 topCenter
       
   183     "return the topCenter point"
       
   184 
       
   185     ^ (self left + (width//2) - 1) @ (self top)
       
   186 !
       
   187 
       
   188 topRight
       
   189     "return the topRight point"
       
   190 
       
   191     ^ (self left + width - 1) @ (self top)
       
   192 !
       
   193 
       
   194 width
       
   195     "return the width of the receiver"
       
   196 
       
   197     ^ width
       
   198 !
       
   199 
       
   200 width:anInteger
       
   201     "set the width of the receiver"
       
   202 
       
   203     width := anInteger
       
   204 !
       
   205 
       
   206 width:w height:h
       
   207     "set both width and height of the receiver"
       
   208 
       
   209     width := w.
       
   210     height := h
       
   211 ! !
       
   212 
       
   213 !GraphicsMedium methodsFor:'evaluating in another context'!
       
   214 
       
   215 clippedTo:aRectangle do:aBlock
       
   216     "evaluate aBlock with clipping rectangle set to aRectangle"
       
   217 
       
   218     |oldClip|
       
   219     
       
   220     oldClip := clipRect.
       
   221     self clipRect:aRectangle.
       
   222     aBlock value.
       
   223     self clipRect:oldClip
       
   224 !
       
   225 
       
   226 withFunction:aFunction do:aBlock
       
   227     "evaluate aBlock with function set to aFunction"
       
   228 
       
   229     |oldFun|
       
   230 
       
   231     oldFun := function.
       
   232     self function:aFunction.
       
   233     aBlock value.
       
   234     self function:oldFun
       
   235 !
       
   236 
       
   237 withMask:aMask do:aBlock
       
   238     "evaluate aBlock with mask set to aMask"
       
   239 
       
   240     |oldMask|
       
   241 
       
   242     oldMask := mask.
       
   243     self mask:aMask.
       
   244     aBlock value.
       
   245     self mask:oldMask
       
   246 !
       
   247 
       
   248 withPattern:aPattern do:aBlock
       
   249     |old|
       
   250 
       
   251     aPattern isColor ifTrue:[
       
   252 	old := paint.
       
   253 	self paint:aPattern.
       
   254 	aBlock value.
       
   255 	self paint:old
       
   256     ] ifFalse:[
       
   257 	old := mask.
       
   258 	self mask:aPattern.
       
   259 	aBlock value.
       
   260 	self mask:old
       
   261     ]
       
   262 ! !
       
   263 
       
   264 !GraphicsMedium methodsFor:'filling'!
       
   265 
       
   266 black
       
   267     "fill the receiver with black"
       
   268 
       
   269     self fill:Black
       
   270 !
       
   271 
       
   272 clear
       
   273     "clear the receiver with background"
       
   274 
       
   275     "currently need this kludge for form ..."
       
   276     transformation isNil ifTrue:[
       
   277 	self clearRectangleX:0 y:0 width:width height:height
       
   278     ] ifFalse:[
       
   279 	self clearDeviceRectangleX:0 y:0 width:width height:height
       
   280     ]
       
   281 !
       
   282 
       
   283 clearInside
       
   284     "clear the receiver with background - ST-80 compatibility"
       
   285 
       
   286     ^ self clear
       
   287 !
       
   288 
       
   289 clearRectangle:aRectangle
       
   290     "clear the rectangular area in the receiver to background"
       
   291 
       
   292     self clearRectangleX:(aRectangle left)
       
   293 		       y:(aRectangle top)
       
   294 		   width:(aRectangle width)
       
   295 		  height:(aRectangle height)
       
   296 !
       
   297 
       
   298 clearRectangleX:left y:top width:w height:h
       
   299     "clear the rectangular area in the receiver to background"
       
   300 
       
   301     self fillRectangleX:left
       
   302 		      y:top
       
   303 		  width:w
       
   304 		 height:h
       
   305 		   with:bgPaint
       
   306 !
       
   307 
       
   308 fill:something
       
   309     "fill the receiver with something;
       
   310      something may be a Form, Color or colorIndex"
       
   311 
       
   312     self fillRectangleX:0 y:0 width:width height:height with:something
       
   313 !
       
   314 
       
   315 fillArcX:x y:y w:w h:h from:startAngle angle:angle with:aPattern
       
   316     "fill an arc in the receiver with aPattern,
       
   317      which may be a Color or Form"
       
   318 
       
   319     self obsoleteMethodWarning:'use #fillArcX:y:width:height:from:angle:with:'.
       
   320     self fillArcX:x y:y width:w height:h from:startAngle angle:angle with:aPattern
       
   321 
       
   322     "Modified: 8.5.1996 / 08:41:26 / cg"
       
   323 !
       
   324 
       
   325 fillArcX:x y:y width:w height:h from:startAngle angle:angle with:aPattern
       
   326     "fill an arc in the receiver with aPattern,
       
   327      which may be a Color or Form"
       
   328 
       
   329     self withPattern:aPattern do:[
       
   330         self fillArcX:x y:y width:w height:h from:startAngle angle:angle
       
   331     ]
       
   332 
       
   333     "Created: 8.5.1996 / 08:40:41 / cg"
       
   334 !
       
   335 
       
   336 fillCircle:aPoint radius:aNumber with:aPattern
       
   337     "fill a circle in the receiver with aPattern,
       
   338      which may be a Color or Form"
       
   339 
       
   340     self fillCircleX:(aPoint x) y:(aPoint y) radius:aNumber with:aPattern
       
   341 !
       
   342 
       
   343 fillCircleX:x y:y radius:r with:aPattern
       
   344     "fill a circle with aPattern,
       
   345      which may be a Color or Form"
       
   346 
       
   347     |d|
       
   348     d := 2 * r.
       
   349     self 
       
   350         fillArcX:(x - r) 
       
   351                y:(y - r)
       
   352            width:d
       
   353           height:d
       
   354             from:0
       
   355            angle:360
       
   356             with:aPattern
       
   357 
       
   358     "Modified: 8.5.1996 / 08:40:14 / cg"
       
   359 !
       
   360 
       
   361 fillPolygon:aPolygon with:aPattern
       
   362     "fill a polygon in the receiver with aPattern,
       
   363      which may be a Form or Color"
       
   364 
       
   365     self withPattern:aPattern do:[
       
   366 	self fillPolygon:aPolygon
       
   367     ]
       
   368 !
       
   369 
       
   370 fillRectangle:aRectangle with:something
       
   371     "fill the rectangular area in the receiver with something;
       
   372      something may be a Form, Color or colorIndex"
       
   373 
       
   374     self fillRectangleX:(aRectangle left)
       
   375 		      y:(aRectangle top)
       
   376 		  width:(aRectangle width)
       
   377 		 height:(aRectangle height)
       
   378 		   with:something
       
   379 !
       
   380 
       
   381 fillRectangleX:x y:y width:w height:h with:aPattern
       
   382     "fill the rectangular area in the receiver with aPattern,
       
   383      which may be a Form or Color"
       
   384 
       
   385     self withPattern:aPattern do:[
       
   386 	self fillRectangleX:x y:y width:w height:h
       
   387     ]
       
   388 
       
   389     "
       
   390      Display rootView 
       
   391 	fillRectangleX:0
       
   392 		     y:0
       
   393 		 width:50
       
   394 		height:50
       
   395 		  with:(Color grey:50)
       
   396     "
       
   397 !
       
   398 
       
   399 invertRectangle:aRectangle
       
   400     "invert a rectangle in the receiver"
       
   401 
       
   402     self xoring:[
       
   403 	self fillRectangle:aRectangle
       
   404     ]
       
   405 !
       
   406 
       
   407 white
       
   408     "fill the receiver with white"
       
   409 
       
   410     self fill:White
       
   411 ! !
       
   412 
       
   413 !GraphicsMedium methodsFor:'initialization'!
       
   414 
       
   415 initialize
       
   416     "set up some useful default values"
       
   417 
       
   418     super initialize.
       
   419 
       
   420     width := 0.
       
   421     height := 0
       
   422 ! !
       
   423 
       
   424 !GraphicsMedium class methodsFor:'documentation'!
       
   425 
       
   426 version
       
   427     ^ '$Header: /cvs/stx/stx/libview/GraphicsMedium.st,v 1.1 1996-05-28 14:36:26 cg Exp $'
       
   428 ! !