diff --git a/basis/colors/colors-docs.factor b/basis/colors/colors-docs.factor index bef12c6e37..5d6a2d268a 100644 --- a/basis/colors/colors-docs.factor +++ b/basis/colors/colors-docs.factor @@ -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" diff --git a/basis/colors/colors.factor b/basis/colors/colors.factor index ff4fe0539d..5932d0ff15 100644 --- a/basis/colors/colors.factor +++ b/basis/colors/colors.factor @@ -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 ; - -:: 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 ; diff --git a/basis/colors/colors-tests.factor b/basis/colors/mix/mix-tests.factor similarity index 97% rename from basis/colors/colors-tests.factor rename to basis/colors/mix/mix-tests.factor index d316c2a763..536f8ae568 100644 --- a/basis/colors/colors-tests.factor +++ b/basis/colors/mix/mix-tests.factor @@ -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 diff --git a/basis/colors/mix/mix.factor b/basis/colors/mix/mix.factor new file mode 100644 index 0000000000..459c119308 --- /dev/null +++ b/basis/colors/mix/mix.factor @@ -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 ; + +:: 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 ;