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 PRIVATE>
  17
  18 M: color-renderer filled-column
  19     drop 0 ;
  20
  21 M: color-renderer column-titles
  22     drop { "Color" "Name" "Red" "Green" "Blue" "Hex" } ;
  23
  24 M: color-renderer row-columns
  25     drop [
  26         full-block-string swap
  27         dup named-color {
  28             [ red>> "%.5f" sprintf ]
  29             [ green>> "%.5f" sprintf ]
  30             [ blue>> "%.5f" sprintf ]
  31             [ color>hex ]
  32         } cleave
  33     ] output>array ;
  34
  35 M: color-renderer row-color
  36     drop named-color ;
  37
  38 M: color-renderer row-value
  39     drop named-color ;
  40
  41 : <color-table> ( -- table )
  42     named-colors { human<=> } sort-by <model>
  43     color-renderer
  44     [ ] <search-table> dup table>>
  45         5 >>gap
  46         COLOR: dark-gray >>column-line-color
  47         10 >>min-rows
  48         10 >>max-rows drop ;
  49
  50 MAIN-WINDOW: color-table-demo { { title "Colors" } { pref-dim { 500 300 } } }
  51     <color-table> <scroller> >>gadgets ;