diff --git a/basis/colors/colors-docs.factor b/basis/colors/colors-docs.factor index 53cca50b7a..bef12c6e37 100644 --- a/basis/colors/colors-docs.factor +++ b/basis/colors/colors-docs.factor @@ -32,6 +32,11 @@ $nl { $subsections >rgba } "Extracting RGBA components of colors:" { $subsections >rgba-components } +"Mixing colors:" +{ $subsections + linear-gradient + sample-linear-gradient +} "Further topics:" { $subsections "colors.protocol" @@ -40,4 +45,4 @@ $nl { $vocab-subsection "Grayscale colors" "colors.gray" } { $vocab-subsection "HSV colors" "colors.hsv" } ; -ABOUT: "colors" \ No newline at end of file +ABOUT: "colors" diff --git a/basis/colors/colors.factor b/basis/colors/colors.factor index 499fab7375..ff4fe0539d 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 math ; +USING: accessors combinators kernel locals math sequences ; IN: colors TUPLE: color ; @@ -34,5 +34,14 @@ CONSTANT: transparent T{ rgba f 0.0 0.0 0.0 0.0 } [ [ >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 ;