extra/color-picker/color-picker.factor

   1 ! Copyright (C) 2006, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel math math.parser models sequences ui ui.gadgets
   4 ui.gadgets.controls ui.gadgets.frames ui.gadgets.labels
   5 ui.gadgets.packs ui.gadgets.sliders ui.render ;
   6 IN: color-picker
   7
   8 ! Simple example demonstrating the use of models.
   9
  10 : <color-slider> ( model -- gadget )
  11     <x-slider> 1 over set-slider-line ;
  12
  13 : <color-preview> ( model -- gadget )
  14     <gadget> { 100 100 } over set-rect-dim
  15     [ set-gadget-interior ] <control> ;
  16
  17 : <color-model> ( model -- model )
  18     [ [ 256 /f ] map 1 add <solid> ] <filter> ;
  19
  20 : <color-sliders> ( -- model gadget )
  21     3 [ drop 0 0 0 255 <range> ] map
  22     dup [ range-model ] map <compose>
  23     swap [ [ <color-slider> gadget, ] each ] make-filled-pile ;
  24
  25 : <color-picker> ( -- gadget )
  26     [
  27         <color-sliders> @top frame,
  28         dup <color-model> <color-preview> @center frame,
  29         [ [ truncate number>string ] map " " join ] <filter>
  30         <label-control> @bottom frame,
  31     ] make-frame ;
  32
  33 : color-picker-window ( -- )
  34     [ <color-picker> "Color Picker" open-window ] with-ui ;
  35
  36 MAIN: color-picker-window