-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions math.parser models
- models.filter models.range models.compose sequences ui
- ui.gadgets ui.gadgets.frames ui.gadgets.labels ui.gadgets.packs
- ui.gadgets.sliders ui.render math.geometry.rect accessors
- ui.gadgets.grids colors ;
+USING: accessors colors formatting kernel math math.vectors
+models models.arrow models.product models.range sequences ui
+ui.gadgets ui.gadgets.labels ui.gadgets.packs ui.gadgets.sliders
+ui.gadgets.tracks ui.pens.solid ui.tools.common ;
IN: color-picker
! Simple example demonstrating the use of models.
-: <color-slider> ( model -- gadget )
- <x-slider> 1 >>line ;
-
TUPLE: color-preview < gadget ;
: <color-preview> ( model -- gadget )
- color-preview new-gadget
- swap >>model
- { 100 100 } >>dim ;
+ color-preview new
+ swap >>model
+ { 200 200 } >>dim ;
M: color-preview model-changed
swap value>> >>interior relayout-1 ;
: <color-model> ( model -- model )
- [ first3 [ 256 /f ] tri@ 1 <rgba> <solid> ] <filter> ;
+ [ first3 [ 256 /f ] tri@ 1 <rgba> <solid> ] <arrow> ;
+
+: <color-slider> ( model -- gadget )
+ horizontal <slider> 1 >>line ;
+
+: <color-sliders> ( -- gadget model )
+ 3 [ 0 0 0 255 1 <range> ] replicate
+ [ <filled-pile> { 5 5 } >>gap [ <color-slider> add-gadget ] reduce ]
+ [ [ range-model ] map <product> ]
+ bi ;
-: <color-sliders> ( -- model gadget )
- 3 [ 0 0 0 255 <range> ] replicate
- dup [ range-model ] map <compose>
- swap
- <filled-pile>
- swap
- [ <color-slider> add-gadget ] each ;
+: color>str ( seq -- str )
+ vtruncate v>integer first3 3dup "%d %d %d #%02x%02x%02x" sprintf ;
: <color-picker> ( -- gadget )
- <frame>
+ vertical <track> { 5 5 } >>gap
<color-sliders>
- swap dup
- [ @top grid-add ]
- [ <color-model> <color-preview> @center grid-add ]
- [
- [ [ truncate number>string ] map " " join ] <filter> <label-control>
- @bottom grid-add
- ]
- tri* ;
-
-: color-picker-window ( -- )
- [ <color-picker> "Color Picker" open-window ] with-ui ;
-
-MAIN: color-picker-window
+ [ f track-add ]
+ [
+ [ <color-model> <color-preview> 1 track-add ]
+ [ [ color>str ] <arrow> <label-control> white-interior f track-add ] bi
+ ] bi* ;
+
+MAIN-WINDOW: color-picker-window { { title "Color Picker" } }
+ <color-picker> >>gadgets ;