TranslucentColor.st
author HG Automerge
Wed, 25 Jan 2017 17:20:12 +0000
branchjv
changeset 7803 14d6df784ebb
parent 6528 62c1dbef0b84
parent 7784 6ec54c62f889
child 7855 46203abe7d57
permissions -rw-r--r--
Merge
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
7784
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
     1
"
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
     2
 COPYRIGHT (c) 1999 by eXept Software AG
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
     3
              All Rights Reserved
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
     4
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
     5
 This software is furnished under a license and may be used
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
     6
 only in accordance with the terms of that license and with the
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
     8
 be provided or otherwise made available to, or used by, any
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
     9
 other person.  No title to or ownership of the software is
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    10
 hereby transferred.
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    11
"
4791
68d25975161e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2946
diff changeset
    12
"{ Package: 'stx:libview' }"
68d25975161e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2946
diff changeset
    13
7784
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    14
"{ NameSpace: Smalltalk }"
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    15
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
Color subclass:#TranslucentColor
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	instanceVariableNames:'alpha'
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	classVariableNames:''
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	poolDictionaries:''
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
	category:'Graphics-Support'
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
!TranslucentColor class methodsFor:'documentation'!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
7784
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    25
copyright
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    26
"
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    27
 COPYRIGHT (c) 1999 by eXept Software AG
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    28
              All Rights Reserved
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    29
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    30
 This software is furnished under a license and may be used
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    31
 only in accordance with the terms of that license and with the
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    32
 inclusion of the above copyright notice.   This software may not
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    33
 be provided or otherwise made available to, or used by, any
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    34
 other person.  No title to or ownership of the software is
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    35
 hereby transferred.
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    36
"
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    37
!
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
    38
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
documentation
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
    TranslucentColor represents colors with an alpha (transparency)
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
    channel.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    This is experimental and not yet used by the system.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
    [Instance variables:]
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
4791
68d25975161e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2946
diff changeset
    47
      alpha           <Integer>       the internal alpha value (0..255)
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
! !
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
!TranslucentColor class methodsFor:'instance creation'!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
red:r green:g blue:b alpha:alpha
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
    alpha = 1 ifTrue:[
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    55
	^ super red:r green:g blue:b
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
    ].
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    57
    ^ (super
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    58
	   scaledRed:(r * MaxValue // 100)
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    59
	   scaledGreen:(g * MaxValue // 100)
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    60
	   scaledBlue:(b * MaxValue // 100)) alpha:alpha
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
! !
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
!TranslucentColor methodsFor:'accessing'!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
alpha
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
    "return the alpha value (0..1),
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
     where 0 is completely transparent and 1 is completely opaque"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
    ^ alpha asFloat / 255.0
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
alpha:alphaFraction
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
    "set the alpha value (0..1),
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
     where 0 is completely transparent and 1 is completely opaque"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
    alpha := (alphaFraction * 255) rounded
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
6279
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
    82
alphaByte
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
    83
    "return the alpha value as byte 0..255,
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
    84
     where 0 is completely transparent and 255 is completely opaque"
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
    85
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    86
    ^ alpha
6279
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
    87
!
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
    88
2946
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    89
privateAlpha
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    90
    "return the internal alpha value (0..255),
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    91
     where 0 is completely transparent and 255 is completely opaque"
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    92
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    93
    ^ alpha
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    94
!
2946
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    95
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    96
scaledAlpha
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    97
    "return the alpha value (0..16rFFFF),
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
    98
     where 0 is completely transparent and 16rFFFF is completely opaque"
2946
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
    99
6354
e9f481f14de0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6279
diff changeset
   100
    ^ alpha * 16rFFFF // 255
2946
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   101
!
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   102
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
setAlphaByte:aByteValuedInteger
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
    "set the alpha value (0..255),
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
     where 0 is completely transparent and 255 is completely opaque"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
    alpha := aByteValuedInteger
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
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
!TranslucentColor methodsFor:'printing & storing'!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
storeOn:aStream
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
    "append a string representing an expression to reconstruct the receiver
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
     to the argument, aStream"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
    |clsName|
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
    clsName := self class name.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
    aStream nextPutAll:'(' , clsName , ' red:'.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
    (self red) storeOn:aStream.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
    aStream nextPutAll:' green:'.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
    (self green) storeOn:aStream.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
    aStream nextPutAll:' blue:'.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
    (self blue) storeOn:aStream.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
    aStream nextPutAll:' alpha:'.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
    (self alpha) storeOn:aStream.
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
    aStream nextPut:$).
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
    "
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
     (self red:100 green:100 blue:0 alpha:1) storeOn:Transcript
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
    "
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
! !
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
!TranslucentColor methodsFor:'queries'!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
isOpaque
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
    "return true, if I represent an opaque color"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
    ^ alpha == 255
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
isTranslucent
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
    "return true, if I represent a translucent color;
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
     that is: not completely opaque"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
    ^ alpha < 255
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
2946
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   154
isTranslucentColor
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   155
    "return true, if I represent a translucent color;
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   156
     This means: self isTranslucent, but isTransparent not"
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   157
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   158
    ^ alpha > 0
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   159
!
5417aafa7ac9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2941
diff changeset
   160
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
isTransparent
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
    "return true, if I represent a completely transparent color"
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
    ^ alpha == 0
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
! !
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
!TranslucentColor class methodsFor:'documentation'!
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
version
7784
6ec54c62f889 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 6354
diff changeset
   170
    ^ '$Header$'
2941
0a6baceacefb initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
! !
6279
a2c65ff821a4 class: TranslucentColor
Claus Gittinger <cg@exept.de>
parents: 4791
diff changeset
   172