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