UI fixes

TODO.FACTOR.txt

@@ -8,18 +8,18 @@
 - support USING:
 - special completion for USE:/IN:
 - vectors: ensure its ok with bignum indices
-- if gadgets are moved, added or deleted, update hand.
 - code gc
 - type inference fails with some assembler words;
   displaced, register and other predicates need to inherit from list
   not cons, and need stronger branch partial eval
 - print warning on null class
 - optimize away dispatch
-- layouts with gaps
 - alignment of gadgets inside their bounding boxes needs thought
 - faster completion
 - ppc register decls
 
+- begin-scan, next-object, end-scan primitives
+- each-object, each-slot combinators
 - port leak
 - references primitive
 - ditch % for tuples?

examples/gadget-test.factor

@@ -66,8 +66,8 @@ USE: words
 : make-shapes ( -- )
     f world get set-gadget-children
     
-    100 20 0 0 <rectangle> <pile> "pile" set
+    default-gap <pile> "pile" set
-    0 0 0 0 <rectangle> <shelf> "shelf" set
+    default-gap <shelf> "shelf" set
     "Close" [ "dialog" get world get remove-gadget ] <button> "shelf" get add-gadget
     "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

library/bootstrap/boot-stage2.factor

@@ -50,87 +50,102 @@ USING: kernel lists parser stdio words namespaces ;
     "/library/io/presentation.factor"
     "/library/io/vocabulary-style.factor"
     "/library/syntax/prettyprint.factor"
-    "/library/syntax/see.factor"
     "/library/tools/debugger.factor"
 
-    "/library/math/constants.factor"
-    "/library/math/pow.factor"
-    "/library/math/trig-hyp.factor"
-    "/library/math/arc-trig-hyp.factor"
-
-    "/library/in-thread.factor"
-    "/library/io/network.factor"
-    "/library/io/logging.factor"
-    "/library/random.factor"
-    "/library/io/stdio-binary.factor"
     "/library/io/files.factor"
     "/library/eval-catch.factor"
     "/library/tools/heap-stats.factor"
     "/library/tools/listener.factor"
-    "/library/tools/word-tools.factor"
-    "/library/test/test.factor"
-    "/library/io/ansi.factor"
-    "/library/tools/telnetd.factor"
-    "/library/tools/jedit-wire.factor"
-    "/library/tools/profiler.factor"
-    "/library/gensym.factor"
-    "/library/tools/interpreter.factor"
-
-    ! Inference needs to know primitive stack effects at load time
-    "/library/primitives.factor"
-
-    "/library/inference/dataflow.factor"
-    "/library/inference/inference.factor"
-    "/library/inference/branches.factor"
-    "/library/inference/words.factor"
-    "/library/inference/stack.factor"
-    "/library/inference/types.factor"
-    "/library/inference/test.factor"
-
-    "/library/compiler/assembler.factor"
-    "/library/compiler/xt.factor"
-    "/library/compiler/optimizer.factor"
-    "/library/compiler/linearizer.factor"
-    "/library/compiler/simplifier.factor"
-    "/library/compiler/generator.factor"
-    "/library/compiler/compiler.factor"
-    "/library/compiler/alien-types.factor"
-    "/library/compiler/alien.factor"
-
-    "/library/sdl/sdl.factor"
-    "/library/sdl/sdl-video.factor"
-    "/library/sdl/sdl-event.factor"
-    "/library/sdl/sdl-gfx.factor"
-    "/library/sdl/sdl-keysym.factor"
-    "/library/sdl/sdl-keyboard.factor"
-    "/library/sdl/sdl-ttf.factor"
-    "/library/sdl/sdl-utils.factor"
-    "/library/sdl/hsv.factor"
-
-    "/library/bootstrap/image.factor"
-
-    "/library/httpd/url-encoding.factor"
-    "/library/httpd/html-tags.factor"
-    "/library/httpd/html.factor"
-    "/library/httpd/http-common.factor"
-    "/library/httpd/responder.factor"
-    "/library/httpd/httpd.factor"
-    "/library/httpd/file-responder.factor"
-    "/library/httpd/test-responder.factor"
-    "/library/httpd/quit-responder.factor"
-    "/library/httpd/resource-responder.factor"
-    "/library/httpd/cont-responder.factor"
-    "/library/httpd/browser-responder.factor"
-    "/library/httpd/default-responders.factor"
-
-    "/library/tools/jedit.factor"
-
     "/library/cli.factor"
 ] [
-    dup print
+    dup print run-resource
-    run-resource
 ] each
 
+IN: command-line DEFER: parse-command-line
+parse-command-line
+
+! Dummy defs for mini bootstrap
+IN: compiler : compile-all ;
+IN: assembler : init-assembler ;
+IN: alien : add-library 3drop ;
+
+"mini" get [
+    [
+        "/library/math/constants.factor"
+        "/library/math/pow.factor"
+        "/library/math/trig-hyp.factor"
+        "/library/math/arc-trig-hyp.factor"
+
+        "/library/syntax/see.factor"
+
+        "/library/gensym.factor"
+        "/library/in-thread.factor"
+        "/library/io/network.factor"
+        "/library/io/logging.factor"
+        "/library/random.factor"
+        "/library/io/stdio-binary.factor"
+
+        "/library/tools/word-tools.factor"
+        "/library/test/test.factor"
+        "/library/io/ansi.factor"
+        "/library/tools/telnetd.factor"
+        "/library/tools/jedit-wire.factor"
+        "/library/tools/profiler.factor"
+        "/library/tools/interpreter.factor"
+    
+        ! Inference needs to know primitive stack effects at load time
+        "/library/primitives.factor"
+    
+        "/library/inference/dataflow.factor"
+        "/library/inference/inference.factor"
+        "/library/inference/branches.factor"
+        "/library/inference/words.factor"
+        "/library/inference/stack.factor"
+        "/library/inference/types.factor"
+        "/library/inference/test.factor"
+    
+        "/library/compiler/assembler.factor"
+        "/library/compiler/xt.factor"
+        "/library/compiler/optimizer.factor"
+        "/library/compiler/linearizer.factor"
+        "/library/compiler/simplifier.factor"
+        "/library/compiler/generator.factor"
+        "/library/compiler/compiler.factor"
+        "/library/compiler/alien-types.factor"
+        "/library/compiler/alien.factor"
+    
+        "/library/sdl/sdl.factor"
+        "/library/sdl/sdl-video.factor"
+        "/library/sdl/sdl-event.factor"
+        "/library/sdl/sdl-gfx.factor"
+        "/library/sdl/sdl-keysym.factor"
+        "/library/sdl/sdl-keyboard.factor"
+        "/library/sdl/sdl-ttf.factor"
+        "/library/sdl/sdl-utils.factor"
+        "/library/sdl/hsv.factor"
+    
+        "/library/bootstrap/image.factor"
+    
+        "/library/httpd/url-encoding.factor"
+        "/library/httpd/html-tags.factor"
+        "/library/httpd/html.factor"
+        "/library/httpd/http-common.factor"
+        "/library/httpd/responder.factor"
+        "/library/httpd/httpd.factor"
+        "/library/httpd/file-responder.factor"
+        "/library/httpd/test-responder.factor"
+        "/library/httpd/quit-responder.factor"
+        "/library/httpd/resource-responder.factor"
+        "/library/httpd/cont-responder.factor"
+        "/library/httpd/browser-responder.factor"
+        "/library/httpd/default-responders.factor"
+    
+        "/library/tools/jedit.factor"
+    ] [
+        dup print run-resource
+    ] each
+] unless
+
 os "win32" = [
     [
         "/library/io/buffer.factor"
@@ -146,7 +161,7 @@ os "win32" = [
     ] each
 ] when
 
-cpu "x86" = [
+cpu "x86" = "mini" get not and [
     [
         "/library/compiler/x86/assembler.factor"
         "/library/compiler/x86/stack.factor"

library/ui/buttons.factor

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

library/ui/hand.factor

@@ -85,6 +85,10 @@ C: hand ( world -- hand )
     dup fire-motion
     r> swap fire-enter ;
 
+: update-hand ( hand -- )
+    #! Called when a gadget is removed or added.
+    [ dup shape-x swap shape-y ] keep move-hand ;
+
 : request-focus ( gadget hand -- )
     dup >r hand-focus
     2dup lose-focus

library/ui/layouts.factor

@@ -21,27 +21,31 @@ M: gadget layout* drop ;
         drop
     ] ifte ;
 
-! A pile is a box that lays out its contents vertically.
+: default-gap 3 ;
-TUPLE: pile delegate ;
 
-C: pile ( shape -- pile )
+! A pile is a box that lays out its contents vertically.
-    [ >r <gadget> r> set-pile-delegate ] keep ;
+TUPLE: pile gap delegate ;
+
+C: pile ( gap -- pile )
+    0 0 0 0 <rectangle> <gadget> over set-pile-delegate
+    [ set-pile-gap ] keep ;
 
 M: pile layout* ( pile -- )
-    dup gadget-children run-heights >r >r
+    dup pile-gap over gadget-children run-heights >r >r
     dup gadget-children max-width r> pick resize-gadget
     gadget-children r> zip [
         uncons 0 swap rot move-gadget
     ] each ;
 
 ! A shelf is a box that lays out its contents horizontally.
-TUPLE: shelf delegate ;
+TUPLE: shelf gap delegate ;
 
-C: shelf ( shape -- pile )
+C: shelf ( gap -- pile )
-    [ >r <gadget> r> set-shelf-delegate ] keep ;
+    0 0 0 0 <rectangle> <gadget> over set-shelf-delegate
+    [ set-shelf-gap ] keep ;
 
 M: shelf layout* ( pile -- )
-    dup gadget-children run-widths >r >r
+    dup shelf-gap over gadget-children run-widths >r >r
     dup gadget-children max-height r> swap pick resize-gadget
     gadget-children r> zip [
         uncons 0 rot move-gadget

library/ui/shapes.factor

@@ -41,13 +41,18 @@ GENERIC: resize-shape ( w h shape -- )
     #! The height of the tallest shape.
     [ [ shape-h ] map [ > ] top ] [ 0 ] ifte* ;
 
-: run-widths ( list -- w list )
+: accumilate ( gap list -- n list )
-    #! Compute a list of running sums of widths of shapes.
+    #! The nth element of the resulting list is the sum of the
-    [ 0 swap [ over , shape-w + ] each ] make-list ;
+    #! first n elements of the given list plus gap, n times.
+    [ 0 swap [ over , + over + ] each ] make-list >r swap - r> ;
 
-: run-heights ( list -- h list )
+: run-widths ( gap list -- w list )
+    #! Compute a list of running sums of widths of shapes.
+    [ shape-w ] map accumilate ;
+
+: run-heights ( gap list -- h list )
     #! Compute a list of running sums of heights of shapes.
-    [ 0 swap [ over , shape-h + ] each ] make-list ;
+    [ shape-h ] map accumilate ;
 
 ! A point, represented as a complex number, is the simplest
 ! shape. It is not mutable and cannot be used as the delegate of

library/ui/world.factor

@@ -23,7 +23,7 @@ M: world inside? ( point world -- ? ) 2drop t ;
 
 : draw-world ( -- )
     world get dup gadget-redraw? [
-        [
+        dup world-hand update-hand [
             f over set-gadget-redraw?
             dup draw-gadget
             dup gadget-paint [ world-hand draw-gadget ] bind
@@ -34,7 +34,7 @@ M: world inside? ( point world -- ? ) 2drop t ;
 
 DEFER: handle-event
 
-: layout-world world get layout ;
+: layout-world world get dup layout world-hand update-hand ;
 
 : eat-events ( event -- )
     #! Keep polling for events until there are no more events in

native/unix/io.c

@@ -279,6 +279,10 @@ void primitive_close(void)
 	F_PORT* port = untag_port(dpop());
 	close(port->fd);
 	port->closed = true;
+	port->buffer = F;
+	port->buf_fill = 0;
+	port->buf_pos = 0;
+	port->line = F;
 }
 
 void collect_io_tasks(void)