colors: move mixing words to colors.mix.
parent
c124725a85
commit
d43b252da2
|
@ -32,11 +32,6 @@ $nl
|
||||||
{ $subsections >rgba }
|
{ $subsections >rgba }
|
||||||
"Extracting RGBA components of colors:"
|
"Extracting RGBA components of colors:"
|
||||||
{ $subsections >rgba-components }
|
{ $subsections >rgba-components }
|
||||||
"Mixing colors:"
|
|
||||||
{ $subsections
|
|
||||||
linear-gradient
|
|
||||||
sample-linear-gradient
|
|
||||||
}
|
|
||||||
"Further topics:"
|
"Further topics:"
|
||||||
{ $subsections
|
{ $subsections
|
||||||
"colors.protocol"
|
"colors.protocol"
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2003, 2009 Slava Pestov.
|
! Copyright (C) 2003, 2009 Slava Pestov.
|
||||||
! Copyright (C) 2008 Eduardo Cavazos.
|
! Copyright (C) 2008 Eduardo Cavazos.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors combinators kernel locals math sequences ;
|
USING: accessors combinators kernel math ;
|
||||||
IN: colors
|
IN: colors
|
||||||
|
|
||||||
TUPLE: color ;
|
TUPLE: color ;
|
||||||
|
@ -29,19 +29,5 @@ M: color blue>> ( color -- blue ) >rgba blue>> ;
|
||||||
|
|
||||||
CONSTANT: transparent T{ rgba f 0.0 0.0 0.0 0.0 }
|
CONSTANT: transparent T{ rgba f 0.0 0.0 0.0 0.0 }
|
||||||
|
|
||||||
: linear-gradient ( color1 color2 percent -- color )
|
|
||||||
[ 1.0 swap - * ] [ * ] bi-curry swapd
|
|
||||||
[ [ >rgba-components drop ] [ tri@ ] bi* ] 2bi@
|
|
||||||
[ + ] tri-curry@ tri* 1.0 <rgba> ;
|
|
||||||
|
|
||||||
:: sample-linear-gradient ( colors percent -- color )
|
|
||||||
colors length :> num-colors
|
|
||||||
num-colors 1 - percent * >integer :> left-index
|
|
||||||
1.0 num-colors 1 - / :> cell-range
|
|
||||||
percent left-index cell-range * - cell-range / :> alpha
|
|
||||||
left-index colors nth :> left-color
|
|
||||||
left-index 1 + num-colors mod colors nth :> right-color
|
|
||||||
left-color right-color alpha linear-gradient ;
|
|
||||||
|
|
||||||
: inverse-color ( color -- color' )
|
: inverse-color ( color -- color' )
|
||||||
>rgba-components [ [ 1.0 swap - ] tri@ ] dip <rgba> ;
|
>rgba-components [ [ 1.0 swap - ] tri@ ] dip <rgba> ;
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
USING: colors.constants kernel tools.test ;
|
USING: colors.constants kernel tools.test ;
|
||||||
IN: colors
|
IN: colors.mix
|
||||||
|
|
||||||
{ COLOR: blue } [ COLOR: blue COLOR: red 0.0 linear-gradient ] unit-test
|
{ COLOR: blue } [ COLOR: blue COLOR: red 0.0 linear-gradient ] unit-test
|
||||||
{ COLOR: red } [ COLOR: blue COLOR: red 1.0 linear-gradient ] unit-test
|
{ COLOR: red } [ COLOR: blue COLOR: red 1.0 linear-gradient ] unit-test
|
|
@ -0,0 +1,18 @@
|
||||||
|
! Copyright (C) 2013 John Benediktsson
|
||||||
|
! See http://factorcode.org/license.txt for BSD license
|
||||||
|
USING: colors kernel locals math sequences ;
|
||||||
|
IN: colors.mix
|
||||||
|
|
||||||
|
: linear-gradient ( color1 color2 percent -- color )
|
||||||
|
[ 1.0 swap - * ] [ * ] bi-curry swapd
|
||||||
|
[ [ >rgba-components drop ] [ tri@ ] bi* ] 2bi@
|
||||||
|
[ + ] tri-curry@ tri* 1.0 <rgba> ;
|
||||||
|
|
||||||
|
:: sample-linear-gradient ( colors percent -- color )
|
||||||
|
colors length :> num-colors
|
||||||
|
num-colors 1 - percent * >integer :> left-index
|
||||||
|
1.0 num-colors 1 - / :> cell-range
|
||||||
|
percent left-index cell-range * - cell-range / :> alpha
|
||||||
|
left-index colors nth :> left-color
|
||||||
|
left-index 1 + num-colors mod colors nth :> right-color
|
||||||
|
left-color right-color alpha linear-gradient ;
|
Loading…
Reference in New Issue