1 ! Copyright (C) 2006, 2009 Slava Pestov.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors colors formatting kernel math math.vectors
4 models models.arrow models.product models.range sequences ui
5 ui.gadgets ui.gadgets.labels ui.gadgets.packs ui.gadgets.sliders
6 ui.gadgets.tracks ui.pens.solid ui.tools.common ;
9 ! Simple example demonstrating the use of models.
11 TUPLE: color-preview < gadget ;
13 : <color-preview> ( model -- gadget )
18 M: color-preview model-changed
19 swap value>> >>interior relayout-1 ;
21 : <color-model> ( model -- model )
22 [ first3 [ 256 /f ] tri@ 1 <rgba> <solid> ] <arrow> ;
24 : <color-slider> ( model -- gadget )
25 horizontal <slider> 1 >>line ;
27 : <color-sliders> ( -- gadget model )
28 3 [ 0 0 0 255 1 <range> ] replicate
29 [ <filled-pile> { 5 5 } >>gap [ <color-slider> add-gadget ] reduce ]
30 [ [ range-model ] map <product> ]
33 : color>str ( seq -- str )
34 vtruncate v>integer first3 3dup "%d %d %d #%02x%02x%02x" sprintf ;
36 : <color-picker> ( -- gadget )
37 vertical <track> { 5 5 } >>gap
41 [ <color-model> <color-preview> 1 track-add ]
42 [ [ color>str ] <arrow> <label-control> white-interior f track-add ] bi
45 MAIN-WINDOW: color-picker-window { { title "Color Picker" } }
46 <color-picker> >>gadgets ;