demos/color-picker.factor

   1 ! Copyright (C) 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: color-picker
   4 USING: gadgets-sliders gadgets-labels gadgets models arrays
   5 namespaces kernel math prettyprint sequences ;
   6
   7 ! Simple example demonstrating the use of models.
   8
   9 : <color-slider> ( -- gadget )
  10     <x-slider>
  11     1 over set-slider-line
  12     255 over set-slider-max ;
  13
  14 : <color-preview> ( model -- gadget )
  15     <gadget> { 100 100 } over set-rect-dim
  16     [ set-gadget-interior ] <control> ;
  17
  18 : <color-model> ( model -- model )
  19     [ [ 256 /f ] map 1 add <solid> ] <filter> ;
  20
  21 : <color-sliders> ( -- model gadget )
  22     [
  23         <color-slider> dup , control-model
  24         <color-slider> dup , control-model
  25         <color-slider> dup , control-model
  26         3array <compose>
  27     ] { } make make-pile 1 over set-pack-fill ;
  28
  29 : <color-picker> ( -- gadget )
  30     {
  31         { [ <color-sliders> ] f f @top }
  32         { [ dup <color-model> <color-preview> ] f f @center }
  33         { [ [ unparse ] <filter> <label-control> ] f f @bottom }
  34     } make-frame ;
  35
  36 PROVIDE: demos/color-picker ;
  37
  38 MAIN: demos/color-picker
  39     <color-picker> "Color Picker" open-titled-window ;