colors: move mixing words to colors.mix.

db4
John Benediktsson 2013-04-03 16:33:33 -07:00
parent c124725a85
commit d43b252da2
4 changed files with 20 additions and 21 deletions

View File

@ -32,11 +32,6 @@ $nl
{ $subsections >rgba }
"Extracting RGBA components of colors:"
{ $subsections >rgba-components }
"Mixing colors:"
{ $subsections
linear-gradient
sample-linear-gradient
}
"Further topics:"
{ $subsections
"colors.protocol"

View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2009 Slava Pestov.
! Copyright (C) 2008 Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators kernel locals math sequences ;
USING: accessors combinators kernel math ;
IN: colors
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 }
: 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' )
>rgba-components [ [ 1.0 swap - ] tri@ ] dip <rgba> ;

View File

@ -1,5 +1,5 @@
USING: colors.constants kernel tools.test ;
IN: colors
IN: colors.mix
{ COLOR: blue } [ COLOR: blue COLOR: red 0.0 linear-gradient ] unit-test
{ COLOR: red } [ COLOR: blue COLOR: red 1.0 linear-gradient ] unit-test

View File

@ -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 ;