extra/color-picker/color-picker.factor

   1 ! Copyright (C) 2006, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel math math.functions math.parser models
   4        models.filter models.range models.compose sequences ui
   5        ui.gadgets ui.gadgets.frames ui.gadgets.labels ui.gadgets.packs
   6        ui.gadgets.sliders ui.render math.geometry.rect accessors
   7        ui.gadgets.grids colors ;
   8 IN: color-picker
   9
  10 ! Simple example demonstrating the use of models.
  11
  12 : <color-slider> ( model -- gadget )
  13     <x-slider> 1 >>line ;
  14
  15 TUPLE: color-preview < gadget ;
  16
  17 : <color-preview> ( model -- gadget )
  18     color-preview new-gadget
  19       swap        >>model
  20       { 100 100 } >>dim ;
  21
  22 M: color-preview model-changed
  23     swap value>> >>interior relayout-1 ;
  24
  25 : <color-model> ( model -- model )
  26     [ first3 [ 256 /f ] tri@ 1 <rgba> <solid> ] <filter> ;
  27
  28 : <color-sliders> ( -- model gadget )
  29     3 [ 0 0 0 255 <range> ] replicate
  30     dup [ range-model ] map <compose>
  31     swap
  32     <filled-pile>
  33     swap
  34       [ <color-slider> add-gadget ] each ;
  35
  36 : <color-picker> ( -- gadget )
  37   <frame>
  38     <color-sliders>
  39       swap dup
  40       [                               @top    grid-add ]
  41       [ <color-model> <color-preview> @center grid-add ]
  42       [
  43         [ [ truncate number>string ] map " " join ] <filter> <label-control>
  44         @bottom grid-add
  45       ]
  46       tri* ;
  47
  48 : color-picker-window ( -- )
  49     [ <color-picker> "Color Picker" open-window ] with-ui ;
  50
  51 MAIN: color-picker-window