TranslucentColor.st
author Claus Gittinger <cg@exept.de>
Thu, 28 Apr 2016 14:18:50 +0200
changeset 7319 a7aeb15d709f
parent 6354 e9f481f14de0
child 6528 62c1dbef0b84
child 7784 6ec54c62f889
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4791
68d25975161e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2946
diff changeset
     1
"{ Package: 'stx:libview' }"
68d25975161e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2946
diff changeset
     2
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
Color subclass:#TranslucentColor
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	instanceVariableNames:'alpha'
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	classVariableNames:''
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	poolDictionaries:''
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	category:'Graphics-Support'
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
!TranslucentColor class methodsFor:'documentation'!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
documentation
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
    TranslucentColor represents colors with an alpha (transparency)
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
    channel.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
    This is experimental and not yet used by the system.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
    [Instance variables:]
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
4791
68d25975161e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2946
diff changeset
    20
      alpha           <Integer>       the internal alpha value (0..255)
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
! !
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
!TranslucentColor class methodsFor:'instance creation'!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
red:r green:g blue:b alpha:alpha
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
    alpha = 1 ifTrue:[
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    28
	^ super red:r green:g blue:b
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
    ].
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    30
    ^ (super
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    31
	   scaledRed:(r * MaxValue // 100)
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    32
	   scaledGreen:(g * MaxValue // 100)
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    33
	   scaledBlue:(b * MaxValue // 100)) alpha:alpha
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
! !
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
!TranslucentColor methodsFor:'accessing'!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
alpha
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
    "return the alpha value (0..1),
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
     where 0 is completely transparent and 1 is completely opaque"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    ^ alpha asFloat / 255.0
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
alpha:alphaFraction
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
    "set the alpha value (0..1),
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
     where 0 is completely transparent and 1 is completely opaque"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
    alpha := (alphaFraction * 255) rounded
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
6279
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
    55
alphaByte
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
    56
    "return the alpha value as byte 0..255,
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
    57
     where 0 is completely transparent and 255 is completely opaque"
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
    58
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    59
    ^ alpha
6279
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
    60
!
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
    61
2946
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    62
privateAlpha
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    63
    "return the internal alpha value (0..255),
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    64
     where 0 is completely transparent and 255 is completely opaque"
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    65
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    66
    ^ alpha
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    67
!
2946
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    68
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    69
scaledAlpha
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    70
    "return the alpha value (0..16rFFFF),
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    71
     where 0 is completely transparent and 16rFFFF is completely opaque"
2946
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    72
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    73
    ^ alpha * 16rFFFF // 255
2946
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    74
!
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    75
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    76
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
setAlphaByte:aByteValuedInteger
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
    "set the alpha value (0..255),
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
     where 0 is completely transparent and 255 is completely opaque"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
    alpha := aByteValuedInteger
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
! !
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
!TranslucentColor methodsFor:'printing & storing'!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
storeOn:aStream
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
    "append a string representing an expression to reconstruct the receiver
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
     to the argument, aStream"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
    |clsName|
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
    clsName := self class name.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
    aStream nextPutAll:'(' , clsName , ' red:'.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
    (self red) storeOn:aStream.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
    aStream nextPutAll:' green:'.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
    (self green) storeOn:aStream.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
    aStream nextPutAll:' blue:'.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
    (self blue) storeOn:aStream.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
    aStream nextPutAll:' alpha:'.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
    (self alpha) storeOn:aStream.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
    aStream nextPut:$).
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
    "
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
     (self red:100 green:100 blue:0 alpha:1) storeOn:Transcript
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
    "
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
! !
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
!TranslucentColor methodsFor:'queries'!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
isOpaque
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
    "return true, if I represent an opaque color"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
    ^ alpha == 255
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
isTranslucent
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
    "return true, if I represent a translucent color;
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
     that is: not completely opaque"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
    ^ alpha < 255
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
2946
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   128
isTranslucentColor
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   129
    "return true, if I represent a translucent color;
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   130
     This means: self isTranslucent, but isTransparent not"
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   131
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   132
    ^ alpha > 0
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   133
!
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   134
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
isTransparent
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
    "return true, if I represent a completely transparent color"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
    ^ alpha == 0
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
! !
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
!TranslucentColor class methodsFor:'documentation'!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
version
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
   144
    ^ '$Header: /cvs/stx/stx/libview/TranslucentColor.st,v 1.5 2014-03-22 09:26:53 cg Exp $'
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
! !
6279
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
   146