steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

colors: adding sample-linear-gradient and some tests.

db4
John Benediktsson 2013-04-03 16:09:06 -07:00
parent 482ea99628
commit 5426b75d99
2 changed files with 16 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/colors/colors-docs.factor
View File

@ -32,6 +32,11 @@ $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"
@ -40,4 +45,4 @@ $nl
{ $vocab-subsection "Grayscale colors" "colors.gray" } { $vocab-subsection "Grayscale colors" "colors.gray" }
{ $vocab-subsection "HSV colors" "colors.hsv" } ; { $vocab-subsection "HSV colors" "colors.hsv" } ;
ABOUT: "colors" ABOUT: "colors"

11
basis/colors/colors.factor
View File

@ -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 math ; USING: accessors combinators kernel locals math sequences ;
IN: colors IN: colors
TUPLE: color ; 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@ [ [ >rgba-components drop ] [ tri@ ] bi* ] 2bi@
[ + ] tri-curry@ tri* 1.0 <rgba> ; [ + ] 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> ;