dialogs

examples/gadget-test.factor

@@ -36,22 +36,6 @@ USE: stdio
 USE: prettyprint
 USE: words
 
-: grab ( gadget hand -- )
-    [ swap screen-pos swap screen-pos - >rect ] 2keep
-    >r [ move-gadget ] keep r> add-gadget ;
-
-: release ( gadget world -- )
-    >r dup screen-pos >r
-    dup unparent
-    r> >rect pick move-gadget
-    r> add-gadget ;
-
-: moving-actions
-    {{
-            [[ [ button-down 1 ] [ my-hand grab ] ]]
-        [[ [ button-up 1 ] [ world get release ] ]]
-    }} swap set-gadget-gestures ;
-
 : filled? "filled" get checkbox-selected? ;
 
 : <funny-rect>
@@ -72,6 +56,7 @@ USE: words
     "New Rectangle" [ drop 100 100 100 100 <funny-rect> dup [ 255 255 0 ] background set-paint-property world get add-gadget ] <button> "shelf" get add-gadget
     "New Ellipse" [ drop 100 100 200 100 <funny-ellipse> dup [ 0 255 0 ] background set-paint-property world get add-gadget ] <button> "shelf" get add-gadget
     "New Line" [ drop 100 100 200 100 <funny-line> dup [ 255 0 0 ] background set-paint-property world get add-gadget ] <button> "shelf" get add-gadget
+    "Prompt" [ drop "Enter input text:" input-dialog . flush ] <button> "shelf" get add-gadget
     "Filled?" <checkbox> dup "filled" set "shelf" get add-gadget
     "shelf" get "pile" get add-gadget
     "Welcome to Factor " version cat2 <label> "pile" get add-gadget

factor/DefaultVocabularyLookup.java

@@ -121,19 +121,19 @@ public class DefaultVocabularyLookup implements VocabularyLookup
 		pushWord.parsing = new PushWord(pushWord);
 
 		/* OOP */
-		FactorWord generic = define("generic","GENERIC:");
+		FactorWord generic = define("syntax","GENERIC:");
 		generic.parsing = new Definer(generic);
-		FactorWord traits = define("generic","TRAITS:");
+		FactorWord traits = define("syntax","TRAITS:");
 		traits.parsing = new Definer(traits);
-		FactorWord beginMethod = define("generic","M:");
+		FactorWord beginMethod = define("syntax","M:");
 		beginMethod.parsing = new BeginMethod(beginMethod);
-		FactorWord beginConstructor = define("generic","C:");
+		FactorWord beginConstructor = define("syntax","C:");
 		beginConstructor.parsing = new BeginConstructor(beginConstructor);
-		FactorWord beginPredicate = define("generic","PREDICATE:");
+		FactorWord beginPredicate = define("syntax","PREDICATE:");
 		beginPredicate.parsing = new BeginPredicate(beginPredicate);
-		FactorWord beginUnion = define("generic","UNION:");
+		FactorWord beginUnion = define("syntax","UNION:");
 		beginUnion.parsing = new BeginUnion(beginUnion);
-		FactorWord tuple = define("generic","TUPLE:");
+		FactorWord tuple = define("syntax","TUPLE:");
 		tuple.parsing = new Tuple(tuple);
 	} //}}}
 

factor/FactorReader.java

@@ -204,6 +204,8 @@ public class FactorReader
 	//{{{ addUse() method
 	public void addUse(String name)
 	{
+		if(name.equals("!syntax"))
+			return;
 		setUse(new Cons(name,getUse()));
 	} //}}}
 

factor/jedit/FactorPlugin.java

@@ -116,6 +116,7 @@ public class FactorPlugin extends EditPlugin
 				List args = new ArrayList();
 				args.add(exePath);
 				args.add(imagePath);
+				args.add("-null-stdio");
 				args.add("-shell=telnet");
 				args.add("-telnetd-port=" + PORT);
 				String[] extraArgs = jEdit.getProperty(

library/bootstrap/boot-stage2.factor

@@ -177,6 +177,8 @@ cpu "x86" = "mini" get not and [
         "/library/ui/labels.factor"
         "/library/ui/buttons.factor"
         "/library/ui/fields.factor"
+        "/library/ui/halo.factor"
+        "/library/ui/dialogs.factor"
         "/library/ui/events.factor"
     ] [
         dup print

library/bootstrap/init-stage2.factor

@@ -22,7 +22,8 @@ words unparser kernel-internals console assembler memory ;
     init-error-handler
     init-random
     default-cli-args
-    parse-command-line ;
+    parse-command-line
+    "null-stdio" get [ << null-stream >> stdio set ] when ;
 
 : shell ( str -- )
     #! This handles the -shell:<foo> cli argument.

library/io/stream-impl.factor

@@ -41,9 +41,6 @@ M: fd-stream stream-close ( stream -- )
 : <file-writer> ( path -- stream )
     f t open-file <fd-stream> ;
 
-: init-stdio ( -- )
-    stdin stdout <fd-stream> <stdio-stream> stdio set ;
-
 : (fcopy) ( from to -- )
     #! Copy the contents of the fd-stream 'from' to the
     #! fd-stream 'to'. Use fcopy; this word does not close
@@ -64,3 +61,14 @@ M: fd-stream stream-close ( stream -- )
 
 : <resource-stream> ( path -- stream )
     resource-path swap path+ <file-reader> ;
+
+TUPLE: null-stream ;
+M: null-stream stream-flush drop ;
+M: null-stream stream-auto-flush drop ;
+M: null-stream stream-read 2drop f ;
+M: null-stream stream-readln drop f ;
+M: null-stream stream-write-attr 3drop ;
+M: null-stream stream-close drop ;
+
+: init-stdio ( -- )
+    stdin stdout <fd-stream> <stdio-stream> stdio set ;

library/io/win32-io-internals.factor

@@ -138,14 +138,6 @@ END-STRUCT
     ] ifte* 
     win32-io-thread ;
 
-TUPLE: null-stream ;
-M: null-stream stream-flush drop ;
-M: null-stream stream-auto-flush drop ;
-M: null-stream stream-read 2drop f ;
-M: null-stream stream-readln drop f ;
-M: null-stream stream-write-attr 3drop ;
-M: null-stream stream-close drop ;
-
 : win32-init-stdio ( -- )
     INVALID_HANDLE_VALUE NULL NULL 1 CreateIoCompletionPort
     completion-port set 

library/ui/buttons.factor

@@ -76,7 +76,7 @@ TUPLE: checkbox bevel selected? delegate ;
 
 C: checkbox ( label -- checkbox )
     <default-shelf> over set-checkbox-delegate
-    [ >r <label> r> add-gadget ] keep
     [ f bevel-border swap init-checkbox-bevel ] keep
+    [ >r <label> r> add-gadget ] keep
     dup [ toggle-checkbox ] button-actions
     dup update-checkbox ;

library/ui/dialogs.factor

@@ -0,0 +1,38 @@
+IN: gadgets
+USING: kernel namespaces threads ;
+
+TUPLE: dialog continuation delegate ;
+
+: dialog-ok ( dialog -- )
+    dup unparent t swap dialog-continuation call ;
+
+: dialog-cancel ( dialog -- )
+    dup unparent f swap dialog-continuation call ;
+
+: <dialog-buttons> ( -- gadget )
+    <default-shelf>
+    "OK" [ [ dialog-ok ] swap handle-gesture drop ]
+    <button> over add-gadget
+    "Cancel" [ [ dialog-cancel ] swap handle-gesture drop ]
+    <button> over add-gadget ;
+
+C: dialog ( content continuation -- gadget )
+    [ set-dialog-continuation ] keep
+    <default-pile> over set-dialog-delegate
+    [ add-gadget ] keep
+    [ >r <dialog-buttons> r> add-gadget ] keep
+    ( bevel-border )
+    dup moving-actions
+    dup [ dialog-ok ] dup set-action
+    dup [ dialog-cancel ] dup set-action ;
+
+: <prompt> ( prompt -- gadget )
+    0 default-gap <pile>
+    [ >r <label> r> add-gadget ] keep
+    [ >r "" <field> r> add-gadget ] keep ;
+
+: <input-dialog> ( prompt continuation -- gadget )
+    >r <prompt> r> <dialog> ;
+
+: input-dialog ( prompt -- input )
+    [ <input-dialog> world get add-gadget (yield) ] callcc1 ;

library/ui/fields.factor

@@ -85,7 +85,7 @@ TUPLE: field active? editor delegate ;
     bevel-border dup f bevel-up? set-paint-property ;
 
 M: field user-input* ( ch field -- ? )
-    field-editor [ insert-char ] with-editor f ;
+    field-editor [ insert-char ] with-editor t ;
 
 : field-gestures ( -- hash )
     {{

library/ui/gadgets.factor

@@ -44,7 +44,9 @@ C: gadget ( shape -- gadget )
     f swap set-gadget-parent ;
 
 : (add-gadget) ( gadget box -- )
-    [ gadget-children cons ] keep set-gadget-children ;
+    #! This is inefficient.
+    [ gadget-children swap unit append ] keep
+    set-gadget-children ;
 
 : unparent ( gadget -- )
     dup gadget-parent dup [ remove-gadget ] [ 2drop ] ifte ;
@@ -78,15 +80,17 @@ C: gadget ( shape -- gadget )
     ] ifte ; inline
 
 : each-parent ( gadget quot -- ? )
+    #! Keep executing the quotation on higher and higher
+    #! parents until it returns f.
     >r parent-list r> (each-parent) ; inline
 
-: relative-pos ( g1 g2 -- g2-p1 )
-    shape-pos swap screen-pos - ;
-
 : screen-pos ( gadget -- point )
     #! The position of the gadget on the screen.
     0 swap [ shape-pos + t ] each-parent drop ;
 
+: relative-pos ( g1 g2 -- g2-p1 )
+    shape-pos swap screen-pos - ;
+
 : child? ( parent child -- ? )
     dup [
         2dup eq? [ 2drop t ] [ gadget-parent child? ] ifte

library/ui/gestures.factor

@@ -24,7 +24,7 @@ USING: alien generic hashtables kernel lists math sdl-event ;
     [ dupd handle-gesture* ] each-parent nip ;
 
 GENERIC: user-input* ( ch gadget -- ? )
-M: gadget user-input* 2drop f ;
+M: gadget user-input* 2drop t ;
 
 : user-input ( ch gadget -- ? )
     [ dupd user-input* ] each-parent nip ;

library/ui/halo.factor

@@ -0,0 +1,18 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: gadgets
+USING: kernel math namespaces ;
+
+: grab ( gadget hand -- )
+    [ swap screen-pos swap screen-pos - >rect ] 2keep
+    >r [ move-gadget ] keep r> add-gadget ;
+
+: release ( gadget world -- )
+    >r dup screen-pos >r dup unparent
+    r> >rect pick move-gadget
+    r> add-gadget ;
+
+: moving-actions ( gadget -- )
+    dup
+    [ my-hand grab ] [ button-down 1 ] set-action
+    [ world get release ] [ button-up 1 ] set-action ;

library/ui/world.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: alien generic kernel lists math namespaces sdl sdl-event
-sdl-video ;
+sdl-video threads ;
 
 ! The world gadget is the top level gadget that all (visible)
 ! gadgets are contained in. The current world is stored in the
@@ -52,14 +52,16 @@ DEFER: handle-event
         world get world-step [ SDL_WaitEvent ] [ drop f ] ifte
     ] ifte ;
 
-: run-world ( -- )
+: run-world ( event -- )
     world get world-step [
-        <event> dup eat-events [
+        dup eat-events [
-            handle-event run-world
+            [ handle-event ] in-thread run-world
         ] [
             drop
         ] ifte
-    ] when ;
+    ] [
+        drop
+    ] ifte ;
 
 : start-world ( -- )
     #! Start the Factor graphics subsystem with the given screen
@@ -69,7 +71,7 @@ DEFER: handle-event
     [
         0 x set
         0 y set
-        [ run-world ] with-screen
+        [ <event> run-world ] with-screen
     ] with-scope ;
 
 global [