extra/color-table/color-table.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors colors combinators combinators.smart formatting
   4 kernel literals math math.functions models sorting.human
   5 sorting.slots strings ui ui.gadgets.scrollers
   6 ui.gadgets.search-tables ui.gadgets.tables ;
   7 IN: color-table
   8
   9 ! ui.gadgets.tables demo
  10 SINGLETON: color-renderer
  11
  12 <PRIVATE
  13
  14 CONSTANT: full-block-string $[ 10 CHAR: full-block <string> ]
  15
  16 : rgba>hex ( rgba -- hex )
  17     [ red>> ] [ green>> ] [ blue>> ] tri
  18     [ 255 * round >integer ] tri@ "%02X%02X%02X" sprintf ;
  19
  20 PRIVATE>
  21
  22 M: color-renderer filled-column
  23     drop 0 ;
  24
  25 M: color-renderer column-titles
  26     drop { "Color" "Name" "Red" "Green" "Blue" "Hex" } ;
  27
  28 M: color-renderer row-columns
  29     drop [
  30         full-block-string swap
  31         dup named-color {
  32             [ red>> "%.5f" sprintf ]
  33             [ green>> "%.5f" sprintf ]
  34             [ blue>> "%.5f" sprintf ]
  35             [ rgba>hex ]
  36         } cleave
  37     ] output>array ;
  38
  39 M: color-renderer row-color
  40     drop named-color ;
  41
  42 M: color-renderer row-value
  43     drop named-color ;
  44
  45 : <color-table> ( -- table )
  46     named-colors { human<=> } sort-by <model>
  47     color-renderer
  48     [ ] <search-table> dup table>>
  49         5 >>gap
  50         COLOR: dark-gray >>column-line-color
  51         10 >>min-rows
  52         10 >>max-rows drop ;
  53
  54 MAIN-WINDOW: color-table-demo { { title "Colors" } { pref-dim { 500 300 } } }
  55     <color-table> <scroller> >>gadgets ;