From 21d7721b7665e76e07b017a86ba7b86af36311b6 Mon Sep 17 00:00:00 2001
From: "wayo.cavazos" <wayo.cavazos@gmail.com>
Date: Fri, 18 Aug 2006 00:40:29 +0000
Subject: [PATCH] Add action-field gadget to contrib

---
 contrib/action-field.factor | 48 +++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)
 create mode 100644 contrib/action-field.factor

diff --git a/contrib/action-field.factor b/contrib/action-field.factor
new file mode 100644
index 0000000000..dc088c7f95
--- /dev/null
+++ b/contrib/action-field.factor
@@ -0,0 +1,48 @@
+
+USING: kernel models namespaces math sequences arrays hashtables gadgets
+       gadgets-text gadgets-buttons ;
+IN: action-field
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+TUPLE: action-field quot ;
+
+C: action-field ( quot -- action-field )
+tuck set-action-field-quot f <model> [ add-connection ] 2keep
+<field> over set-gadget-delegate ;
+
+M: action-field model-changed ( action-field -- ) dup action-field-quot call ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: variable-field ( var -- action-field )
+unit [ editor-text ] swap append [ set ] append <action-field> ;
+
+: number-field ( var -- action-field )
+unit [ editor-text string>number ] swap append [ set ] append <action-field> ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! [bind] [unbind] and [bound?] should probably be in a separate
+! file. But right now boids and automata are the only programs which
+! use this, and I don't want to add a new contrib file just for
+! this. For now they'll live here. Maybe bind-button and
+! bind-action-field should go into a gadgets-utils file eventually.
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: [bind] ( ns quot -- quot ) \ bind 3array >quotation ;
+
+: [unbind] ( quot -- quot ) second ;
+
+: [bound?] ( quot -- ? )
+dup length 3 = [ dup first hashtable? swap third \ bind = and ] [ f ] if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: bind-button ( ns button -- ) tuck button-quot [bind] swap set-button-quot ;
+
+: bind-action-field ( ns action-field -- )
+tuck action-field-quot [bind] swap set-action-field-quot ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+PROVIDE: action-field ;
\ No newline at end of file