From 26c1a2f4ba805a136d0c83dc3bac1c953c9daeb9 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Mon, 27 Nov 2006 01:36:17 +0000
Subject: [PATCH] Color picker example

---
 TODO.FACTOR.txt              |  7 ++++---
 examples/color-picker.factor | 39 ++++++++++++++++++++++++++++++++++++
 2 files changed, 43 insertions(+), 3 deletions(-)
 create mode 100644 examples/color-picker.factor

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index de932ebb18..6bdb559827 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,9 +1,10 @@
 + 0.87:
 
-- better error handling in early startup
-- slider needs to be modelized
+- module operations on module-links, etc
+- empty search list, handle
+- change file, reload it manually, then reload modules; shouldn't this
+  work?
 - overhaul models, set-model* is crap
-- color picker example
 - variable width word wrap
 - graphical crossref tool
 - http://paste.lisp.org/display/30426
diff --git a/examples/color-picker.factor b/examples/color-picker.factor
new file mode 100644
index 0000000000..1e57749ab4
--- /dev/null
+++ b/examples/color-picker.factor
@@ -0,0 +1,39 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: color-picker
+USING: gadgets-sliders gadgets-labels gadgets models arrays
+namespaces kernel math prettyprint sequences ;
+
+! Simple example demonstrating the use of models.
+
+: <color-slider> ( -- gadget )
+    <x-slider>
+    1 over set-slider-line
+    255 over set-slider-max ;
+
+: <color-preview> ( model -- gadget )
+    <gadget> { 100 100 } over set-rect-dim
+    [ set-gadget-interior ] <control> ;
+
+: <color-model> ( model -- model )
+    [ [ 256 /f ] map 1 add <solid> ] <filter> ;
+
+: <color-sliders> ( -- model gadget )
+    [
+        <color-slider> dup , control-model
+        <color-slider> dup , control-model
+        <color-slider> dup , control-model
+        3array <compose>
+    ] { } make make-pile 1 over set-pack-fill ;
+
+: <color-picker> ( -- gadget )
+    {
+        { [ <color-sliders> ] f f @top }
+        { [ dup <color-model> <color-preview> ] f f @center }
+        { [ [ unparse ] <filter> <label-control> ] f f @bottom }
+    } make-frame ;
+
+PROVIDE: examples/color-picker ;
+
+MAIN: examples/color-picker
+    <color-picker> "Color Picker" open-titled-window ;