author | Claus Gittinger <cg@exept.de> |
Fri, 20 Jan 2017 23:06:27 +0100 | |
changeset 7778 | b88c63d76636 |
parent 7585 | 5c5e44bad956 |
child 7599 | 84f6853ec60d |
child 7792 | 36150f514d6a |
permissions | -rw-r--r-- |
7428 | 1 |
"{ Encoding: utf8 }" |
2 |
||
0 | 3 |
" |
6 | 4 |
COPYRIGHT (c) 1991 by Claus Gittinger |
72 | 5 |
All Rights Reserved |
0 | 6 |
|
7 |
This software is furnished under a license and may be used |
|
8 |
only in accordance with the terms of that license and with the |
|
9 |
inclusion of the above copyright notice. This software may not |
|
10 |
be provided or otherwise made available to, or used by, any |
|
11 |
other person. No title to or ownership of the software is |
|
12 |
hereby transferred. |
|
13 |
" |
|
3292 | 14 |
"{ Package: 'stx:libview' }" |
15 |
||
7267 | 16 |
"{ NameSpace: Smalltalk }" |
17 |
||
135 | 18 |
SimpleView subclass:#ShadowView |
616 | 19 |
instanceVariableNames:'myView shadowLength shadowClr imageUnderShadow' |
20 |
classVariableNames:'' |
|
21 |
poolDictionaries:'' |
|
626 | 22 |
category:'Views-Special' |
0 | 23 |
! |
24 |
||
1292 | 25 |
!ShadowView class methodsFor:'documentation'! |
46 | 26 |
|
27 |
copyright |
|
28 |
" |
|
29 |
COPYRIGHT (c) 1991 by Claus Gittinger |
|
72 | 30 |
All Rights Reserved |
0 | 31 |
|
46 | 32 |
This software is furnished under a license and may be used |
33 |
only in accordance with the terms of that license and with the |
|
34 |
inclusion of the above copyright notice. This software may not |
|
35 |
be provided or otherwise made available to, or used by, any |
|
36 |
other person. No title to or ownership of the software is |
|
37 |
hereby transferred. |
|
38 |
" |
|
39 |
! |
|
0 | 40 |
|
46 | 41 |
documentation |
42 |
" |
|
676 | 43 |
ShadowView exists just to give PopUps and ModalBoxes a shadow. |
44 |
||
72 | 45 |
If shadowClr is nil, the shadowView reads the screen-contents under |
46 |
itself before realization, and uses a greyed version of these pixels |
|
47 |
for its background. If shadowClr is non-nil, that color is used |
|
48 |
as shadow (can be used for solid-black shadows). |
|
49 |
||
50 |
The instance variable myView is the view, for which the shadow is for. |
|
616 | 51 |
|
52 |
[author:] |
|
53 |
Claus Gittinger |
|
46 | 54 |
" |
55 |
! ! |
|
0 | 56 |
|
269 | 57 |
!ShadowView methodsFor:'accessing'! |
58 |
||
59 |
for:aView |
|
676 | 60 |
"set the view I am a shadow for" |
269 | 61 |
|
62 |
myView := aView |
|
676 | 63 |
|
64 |
"Modified: 12.5.1996 / 21:59:17 / cg" |
|
269 | 65 |
! |
66 |
||
67 |
isPopUpView |
|
676 | 68 |
"return true, since I want to come up without decoration" |
69 |
||
269 | 70 |
^ true |
676 | 71 |
|
72 |
"Modified: 12.5.1996 / 21:57:23 / cg" |
|
269 | 73 |
! |
74 |
||
75 |
shadowColor:aColor |
|
676 | 76 |
"set the shadow color" |
269 | 77 |
|
78 |
shadowClr := aColor |
|
676 | 79 |
|
80 |
"Modified: 12.5.1996 / 21:59:25 / cg" |
|
269 | 81 |
! ! |
82 |
||
83 |
!ShadowView methodsFor:'event handling'! |
|
84 |
||
85 |
redraw |
|
676 | 86 |
"if I have a shadowColor, fill all of myself with it; |
87 |
otherwise, draw the saved image under myself." |
|
269 | 88 |
|
89 |
|ws hs| |
|
90 |
||
274 | 91 |
ws := shadowLength x. |
92 |
hs := shadowLength y. |
|
269 | 93 |
shadowClr isNil ifTrue:[ |
676 | 94 |
imageUnderShadow isNil ifTrue:[^ self]. |
269 | 95 |
|
676 | 96 |
self copyFrom:imageUnderShadow x:(width - ws) y:0 |
97 |
toX:(width - ws) y:0 |
|
98 |
width:ws height:height. |
|
99 |
self copyFrom:imageUnderShadow x:0 y:(height - hs) |
|
100 |
toX:0 y:(height - hs) |
|
101 |
width:width height:hs. |
|
269 | 102 |
|
103 |
] ifFalse:[ |
|
676 | 104 |
self paint:shadowClr. |
105 |
self fillRectangleX:(width - ws) y:0 width:ws height:height |
|
269 | 106 |
] |
676 | 107 |
|
108 |
"Modified: 12.5.1996 / 22:00:05 / cg" |
|
269 | 109 |
! ! |
110 |
||
0 | 111 |
!ShadowView methodsFor:'initialization'! |
112 |
||
269 | 113 |
create |
676 | 114 |
"enable saveUnder of the covered view(s). |
115 |
This may not be supported by all devices - these have to redraw then" |
|
116 |
||
269 | 117 |
super create. |
118 |
self backingStore:false. |
|
119 |
self saveUnder:true |
|
676 | 120 |
|
121 |
"Modified: 12.5.1996 / 22:00:47 / cg" |
|
269 | 122 |
! |
123 |
||
0 | 124 |
initialize |
125 |
super initialize. |
|
5415 | 126 |
self borderWidth:0. |
72 | 127 |
|
274 | 128 |
shadowClr := StyleSheet at:#popUpShadowColor. |
0 | 129 |
|
130 |
"the length of the shadow from myView" |
|
7267 | 131 |
shadowLength := device pixelPerMillimeter. |
6274 | 132 |
"/ shadowLength := (self graphicsDevice pixelPerMillimeter * 2.0) rounded. |
0 | 133 |
! |
134 |
||
135 |
realize |
|
54 | 136 |
"realize the shadowView some distance away from myView, |
137 |
get the pixels under the shadow from the screen" |
|
0 | 138 |
|
3490 | 139 |
|root shW shH right bot kludge clr1 clr0 org blackIs0 img |
6274 | 140 |
rS gS bS rM gM bM rSN gSN bSN pix r g b graphicsDevice| |
0 | 141 |
|
142 |
myView notNil ifTrue:[ |
|
7267 | 143 |
graphicsDevice := device. |
2916 | 144 |
|
743 | 145 |
self origin:(myView origin + (myView borderWidth * 2) + shadowLength) |
146 |
extent:(myView extent). |
|
0 | 147 |
|
743 | 148 |
shadowClr isNil ifTrue:[ |
149 |
" |
|
150 |
get the pixels under the shadow |
|
151 |
(copy from root-view into the 'imageUnderShadow'-form) |
|
152 |
" |
|
6274 | 153 |
imageUnderShadow := Form width:width height:height depth:graphicsDevice depth onDevice:graphicsDevice. |
1727
c2140507ab19
oops - X needs clippedByChildren:false.
Claus Gittinger <cg@exept.de>
parents:
1722
diff
changeset
|
154 |
imageUnderShadow clippedByChildren:false. |
0 | 155 |
|
743 | 156 |
shW := shadowLength x. |
157 |
shH := shadowLength y. |
|
158 |
right := width - shW. |
|
159 |
bot := height - shH. |
|
54 | 160 |
|
6274 | 161 |
root := graphicsDevice rootView. |
743 | 162 |
|
163 |
clr0 := Color colorId:0. |
|
164 |
clr1 := Color colorId:1. |
|
2 | 165 |
|
6274 | 166 |
kludge := graphicsDevice depth == 1. |
167 |
blackIs0 := (graphicsDevice blackpixel == 0). |
|
743 | 168 |
(kludge and:[blackIs0]) ifTrue:[ |
1727
c2140507ab19
oops - X needs clippedByChildren:false.
Claus Gittinger <cg@exept.de>
parents:
1722
diff
changeset
|
169 |
imageUnderShadow foreground:clr0 background:clr1. |
743 | 170 |
]. |
2 | 171 |
|
743 | 172 |
org := self origin. |
0 | 173 |
|
743 | 174 |
imageUnderShadow copyFrom:root x:(org x + right) y:org y |
175 |
toX:right y:0 width:shW height:height. |
|
0 | 176 |
|
743 | 177 |
imageUnderShadow copyFrom:root x:org x y:(org y + bot) |
178 |
toX:0 y:bot width:width height:shH. |
|
72 | 179 |
|
6274 | 180 |
false "graphicsDevice visualType == #TrueColor" ifTrue:[ |
2916 | 181 |
" |
182 |
grey out the image (by darkening the pixels) |
|
7585 | 183 |
(that's expensive ...) |
2916 | 184 |
" |
3490 | 185 |
|
2916 | 186 |
img := Image fromForm:imageUnderShadow. |
3490 | 187 |
|
188 |
rS := img redShiftForPixelValue. |
|
189 |
gS := img greenShiftForPixelValue. |
|
190 |
bS := img blueShiftForPixelValue. |
|
191 |
rSN := rS negated. |
|
192 |
gSN := gS negated. |
|
193 |
bSN := bS negated. |
|
194 |
rM := img redMaskForPixelValue. |
|
195 |
gM := img greenMaskForPixelValue. |
|
196 |
bM := img blueMaskForPixelValue. |
|
197 |
||
198 |
right to:right+shW-1 do:[:x | |
|
199 |
0 to:height-1-shH do:[:y | |
|
2916 | 200 |
pix := img pixelAtX:x y:y. |
3490 | 201 |
r := (pix bitShift:rS) bitAnd:rM. "/ img redBitsOf:pix. |
202 |
g := (pix bitShift:gS) bitAnd:gM. "/ img greenBitsOf:pix. |
|
203 |
b := (pix bitShift:bS) bitAnd:bM. "/ img blueBitsOf:pix. |
|
204 |
r := (r * 0.7) rounded. |
|
205 |
g := (g * 0.7) rounded. |
|
206 |
b := (b * 0.7) rounded. |
|
207 |
pix := ((r bitShift:rSN) "/ pix := img valueFromRedBits:r greenBits:g blueBits:b. |
|
208 |
bitOr:(g bitShift:gSN)) |
|
209 |
bitOr:(b bitShift:bSN). |
|
210 |
||
2916 | 211 |
img pixelAtX:x y:y put:pix. |
212 |
]. |
|
213 |
]. |
|
3490 | 214 |
bot to:bot+shH-1 do:[:y | |
215 |
0 to:width-1 do:[:x | |
|
2916 | 216 |
pix := img pixelAtX:x y:y. |
3490 | 217 |
r := (pix bitShift:rS) bitAnd:rM. "/ img redBitsOf:pix. |
218 |
g := (pix bitShift:gS) bitAnd:gM. "/ img greenBitsOf:pix. |
|
219 |
b := (pix bitShift:bS) bitAnd:bM. "/ img blueBitsOf:pix. |
|
220 |
r := (r * 0.7) rounded. |
|
221 |
g := (g * 0.7) rounded. |
|
222 |
b := (b * 0.7) rounded. |
|
223 |
pix := ((r bitShift:rSN) "/ pix := img valueFromRedBits:r greenBits:g blueBits:b. |
|
224 |
bitOr:(g bitShift:gSN)) |
|
225 |
bitOr:(b bitShift:bSN). |
|
2916 | 226 |
img pixelAtX:x y:y put:pix. |
227 |
]. |
|
228 |
]. |
|
6274 | 229 |
imageUnderShadow := img asFormOn:graphicsDevice. |
2916 | 230 |
] ifFalse:[ |
231 |
" |
|
232 |
grey out the image (by oring-in a grey pattern) |
|
233 |
(sometimes we are lucky, and can do it with one raster-op) |
|
234 |
" |
|
0 | 235 |
|
2916 | 236 |
(kludge and:[blackIs0]) ifFalse:[ |
237 |
imageUnderShadow foreground:clr0 background:(Color colorId:-1). |
|
6274 | 238 |
imageUnderShadow mask:(Form mediumGreyFormOn:graphicsDevice). |
2916 | 239 |
imageUnderShadow function:#and. |
240 |
imageUnderShadow fillRectangleX:right y:0 width:shW height:height. |
|
241 |
imageUnderShadow fillRectangleX:0 y:bot width:width height:shH. |
|
242 |
||
243 |
blackIs0 ifFalse:[ |
|
7428 | 244 |
imageUnderShadow foreground:self blackColor background:clr0. |
2916 | 245 |
imageUnderShadow function:#or. |
246 |
imageUnderShadow fillRectangleX:right y:0 width:shW height:height. |
|
247 |
imageUnderShadow fillRectangleX:0 y:bot width:width height:shH. |
|
248 |
] |
|
249 |
] ifTrue:[ |
|
250 |
imageUnderShadow foreground:clr1 background:clr0. |
|
6274 | 251 |
imageUnderShadow mask:(Form mediumGreyFormOn:graphicsDevice). |
743 | 252 |
imageUnderShadow function:#or. |
253 |
imageUnderShadow fillRectangleX:right y:0 width:shW height:height. |
|
254 |
imageUnderShadow fillRectangleX:0 y:bot width:width height:shH. |
|
2916 | 255 |
]. |
743 | 256 |
]. |
257 |
]. |
|
258 |
super realize. |
|
259 |
self raise |
|
0 | 260 |
] |
743 | 261 |
|
1727
c2140507ab19
oops - X needs clippedByChildren:false.
Claus Gittinger <cg@exept.de>
parents:
1722
diff
changeset
|
262 |
"Modified: 12.5.1997 / 21:38:04 / cg" |
0 | 263 |
! |
264 |
||
12 | 265 |
recreate |
3301 | 266 |
"sent after a snapin or a migration, reinit for new device" |
3292 | 267 |
|
72 | 268 |
shadowClr notNil ifTrue:[ |
7267 | 269 |
shadowClr := shadowClr onDevice:device |
72 | 270 |
]. |
12 | 271 |
|
272 |
"the length of the shadow from myView" |
|
7267 | 273 |
shadowLength := device pixelPerMillimeter. |
12 | 274 |
|
275 |
super recreate. |
|
276 |
self backingStore:false. |
|
277 |
self saveUnder:true |
|
269 | 278 |
! |
279 |
||
642 | 280 |
unmap |
2575 | 281 |
"unmap the view - the view stays created (but invisible), and can be remapped again later. |
282 |
relase the saved image of the covered view" |
|
676 | 283 |
|
269 | 284 |
imageUnderShadow := nil. |
642 | 285 |
super unmap. |
286 |
||
287 |
"Modified: 3.5.1996 / 23:45:23 / stefan" |
|
676 | 288 |
"Modified: 12.5.1996 / 22:01:17 / cg" |
0 | 289 |
! ! |
290 |
||
1292 | 291 |
!ShadowView class methodsFor:'documentation'! |
0 | 292 |
|
269 | 293 |
version |
7267 | 294 |
^ '$Header$' |
5389
6f57b1596bab
no more direct accesses to borderWidth and borderColor
Claus Gittinger <cg@exept.de>
parents:
4782
diff
changeset
|
295 |
! |
6f57b1596bab
no more direct accesses to borderWidth and borderColor
Claus Gittinger <cg@exept.de>
parents:
4782
diff
changeset
|
296 |
|
6f57b1596bab
no more direct accesses to borderWidth and borderColor
Claus Gittinger <cg@exept.de>
parents:
4782
diff
changeset
|
297 |
version_CVS |
7267 | 298 |
^ '$Header$' |
0 | 299 |
! ! |
6274 | 300 |