working on visibile-children*

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index a5ddefcf95fbd37c2518331d49f3f28a55b6207b..4748801f3cee6c0d4901455d1030c2ce80ee7bcd 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -22,7 +22,6 @@
 - icons\r
 - use incremental strategy for all pack layouts where possible\r
 - multiline editing in listener\r
-- sort out clipping off-by-one flaw when filling rectangles\r
 - better menu positioning\r
 - only redraw dirty gadgets\r
 - get stuff in examples dir running in the ui\r

diff --git a/library/alien/aliens.factor b/library/alien/aliens.factor
index 7f721127b5f47088f87dc75519768295664e4276..ee26571d7467410aa2e41e5ea24fb5b8884b9fc8 100644 (file)
--- a/library/alien/aliens.factor
+++ b/library/alien/aliens.factor
@@ -41,4 +41,6 @@ M: alien = ( obj obj -- ? )
 : library-abi ( library -- abi )
     library [ [ "abi" get ] bind ] [ "cdecl" ] ifte* ;
 
+: DLL" skip-blank parse-string dlopen swons ; parsing
+
 : ALIEN: scan-word <alien> swons ; parsing

diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor
index 0eea452912f1fcea65998af1c613aee70b3349b4..35eb0d91208b59a02ab3c55e1eccfdec03cddc4f 100644 (file)
--- a/library/alien/compiler.factor
+++ b/library/alien/compiler.factor
@@ -3,7 +3,7 @@
 IN: alien
 USING: assembler compiler compiler-backend compiler-frontend
 errors generic hashtables inference io kernel lists math
-namespaces prettyprint sequences strings words ;
+namespaces prettyprint sequences strings words parser ;
 
 ! ! ! WARNING ! ! !
 ! Reloading this file into a running Factor instance on Win32
@@ -130,6 +130,23 @@ M: alien-node linearize-node* ( node -- )
     [ dup parameters stack-space %cleanup , ] unless
     linearize-return ;
 
+: unpair ( seq -- odds evens )
+    2 swap group flip dup empty?
+    [ drop { } { } ] [ 2unseq ] ifte ;
+
+: parse-arglist ( lst -- types stack effect )
+    unpair [
+        " " % [ "," ?tail drop % " " % ] each "-- " %
+    ] make-string ;
+
+: (define-c-word) ( type lib func types stack-effect -- )
+    >r over create-in >r 
+    [ alien-invoke ] cons cons cons cons r> swap define-compound
+    word r> "stack-effect" set-word-prop ;
+
+: define-c-word ( type lib func function-args -- )
+    [ "()" subseq? not ] subset parse-arglist (define-c-word) ;
+
 \ alien-invoke [ [ string object string general-list ] [ ] ]
 "infer-effect" set-word-prop
 

diff --git a/library/alien/enums.factor b/library/alien/enums.factor
deleted file mode 100644 (file)
index 03aa175..0000000
--- a/library/alien/enums.factor
+++ /dev/null
@@ -1,23 +0,0 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: alien
-USING: kernel lists math parser words ;
-
-: BEGIN-ENUM:
-    #! C-style enumerations. Their use is not encouraged unless
-    #! it is for C library interfaces. Used like this:
-    #!
-    #! BEGIN-ENUM 0
-    #!     ENUM: x
-    #!     ENUM: y
-    #!     ENUM: z
-    #! END-ENUM
-    #!
-    #! This is the same as : x 0 ; : y 1 ; : z 2 ;.
-    scan string>number ; parsing
-
-: ENUM:
-    dup CREATE swap unit define-compound 1 + ; parsing
-
-: END-ENUM
-    drop ; parsing

diff --git a/library/alien/structs.factor b/library/alien/structs.factor
index 35311dd35c5a01091f7bdcc20dfe312e83ab103f..42c8d290884fac7e7edeabbf9419e56e459a9424 100644 (file)
--- a/library/alien/structs.factor
+++ b/library/alien/structs.factor
@@ -38,21 +38,3 @@ math namespaces parser sequences strings words ;
     ]
     "struct-name" get define-c-type
     "struct-name" get "in" get init-c-type ;
-
-: BEGIN-STRUCT: ( -- offset )
-    scan "struct-name" set  0 ; parsing
-
-: FIELD: ( offset -- offset )
-    scan scan define-field ; parsing
-
-: END-STRUCT ( length -- )
-    define-struct-type ; parsing
-
-: BEGIN-UNION: ( -- max )
-    scan "struct-name" set  0 ; parsing
-
-: MEMBER: ( max -- max )
-    scan define-member ; parsing
-
-: END-UNION ( max -- )
-    define-struct-type ; parsing

diff --git a/library/alien/syntax.factor b/library/alien/syntax.factor
index d5f6944c1ae7589fe312cc1a569cc8e72ed004df..610b808b5ee5f4acc43ac847533140c714900a91 100644 (file)
--- a/library/alien/syntax.factor
+++ b/library/alien/syntax.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Alex Chapman.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: alien
-USING: compiler kernel lists namespaces parser sequences words ;
+USING: compiler kernel lists math namespaces parser
+sequences words ;
 
 ! usage of 'LIBRARY:' and 'FUNCTION:' :
 !
@@ -22,23 +23,6 @@ USING: compiler kernel lists namespaces parser sequences words ;
 
 : LIBRARY: scan "c-library" set ; parsing
 
-: unpair ( seq -- odds evens )
-    2 swap group flip dup empty?
-    [ drop { } { } ] [ 2unseq ] ifte ;
-
-: parse-arglist ( lst -- types stack effect )
-    unpair [
-        " " % [ "," ?tail drop % " " % ] each "-- " %
-    ] make-string ;
-
-: (define-c-word) ( type lib func types stack-effect -- )
-    >r over create-in >r 
-    [ alien-invoke ] cons cons cons cons r> swap define-compound
-    word r> "stack-effect" set-word-prop ;
-
-: define-c-word ( type lib func function-args -- )
-    [ "()" subseq? not ] subset parse-arglist (define-c-word) ;
-
 : FUNCTION:
     scan "c-library" get scan string-mode on
     [ string-mode off define-c-word ] [ ] ; parsing
@@ -47,4 +31,39 @@ USING: compiler kernel lists namespaces parser sequences words ;
     #! TYPEDEF: old new
     scan scan typedef ; parsing
 
-: DLL" skip-blank parse-string dlopen swons ; parsing
+: BEGIN-STRUCT: ( -- offset )
+    scan "struct-name" set  0 ; parsing
+
+: FIELD: ( offset -- offset )
+    scan scan define-field ; parsing
+
+: END-STRUCT ( length -- )
+    define-struct-type ; parsing
+
+: BEGIN-UNION: ( -- max )
+    scan "struct-name" set  0 ; parsing
+
+: MEMBER: ( max -- max )
+    scan define-member ; parsing
+
+: END-UNION ( max -- )
+    define-struct-type ; parsing
+
+: BEGIN-ENUM:
+    #! C-style enumerations. Their use is not encouraged unless
+    #! it is for C library interfaces. Used like this:
+    #!
+    #! BEGIN-ENUM 0
+    #!     ENUM: x
+    #!     ENUM: y
+    #!     ENUM: z
+    #! END-ENUM
+    #!
+    #! This is the same as : x 0 ; : y 1 ; : z 2 ;.
+    scan string>number ; parsing
+
+: ENUM:
+    dup CREATE swap unit define-compound 1 + ; parsing
+
+: END-ENUM
+    drop ; parsing

diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor
index 4ee4d27ee3ef7cd753bb03b4e5d7adbf97280787..d7e7ef76ebf26f2c7db1e95398ee98f4aa994f13 100644 (file)
--- a/library/bootstrap/boot-stage1.factor
+++ b/library/bootstrap/boot-stage1.factor
@@ -142,7 +142,6 @@ sequences io vectors words ;
         "/library/compiler/compiler.factor"
 
         "/library/alien/c-types.factor"
-        "/library/alien/enums.factor"
         "/library/alien/structs.factor"
         "/library/alien/compiler.factor"
         "/library/alien/syntax.factor"

diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor
index 444a7136274bb78bda7c30fcca4c4a24bcbf33ed..0126522b47f2fe2ee36c6d1b2393922bf07d7056 100644 (file)
--- a/library/bootstrap/image.factor
+++ b/library/bootstrap/image.factor
@@ -14,6 +14,9 @@ USING: errors generic hashtables kernel lists
 math namespaces parser prettyprint sequences sequences io
 strings vectors words ;
 
+! If true in current namespace, we are bootstrapping.
+SYMBOL: bootstrapping?
+
 ! The image being constructed; a vector of word-size integers
 SYMBOL: image
 
@@ -278,8 +281,9 @@ M: hashtable ' ( hashtable -- pointer )
     "Writing image to " write dup write "..." print
     <file-writer> [ (write-image) ] with-stream ;
 
-: with-minimal-image ( quot -- image )
+: with-image ( quot -- image )
     [
+        bootstrapping? on
         800000 <vector> image set
         20000 <hashtable> objects set
         call
@@ -288,15 +292,13 @@ M: hashtable ' ( hashtable -- pointer )
         image get
     ] with-scope ;
 
-: with-image ( quot -- image )
-    #! The quotation leaves a boot quotation on the stack.
-    [ begin call end ] with-minimal-image ;
-
 : make-image ( name -- )
     #! Make a bootstrap image.
     [
+        begin
         "/library/bootstrap/boot-stage1.factor" run-resource
         namespace global [ "foobar" set ] bind
+        end
     ] with-image
 
     swap write-image ;

diff --git a/library/collections/sequence-sort.factor b/library/collections/sequence-sort.factor
index adc77ef4bb1ec577a956fe243a2ebe69a7d25da6..43225c709f26543019e99a5b36f3ebabad77c893 100644 (file)
--- a/library/collections/sequence-sort.factor
+++ b/library/collections/sequence-sort.factor
@@ -78,6 +78,10 @@ IN: sequences
 : sort ( seq quot -- seq | quot: elt elt -- -1/0/1 )
     swap [ swap nsort ] immutable ; inline
 
+: number-sort ( seq -- seq ) [ - ] sort ;
+
+: string-sort ( seq -- seq ) [ lexi ] sort ;
+
 : binsearch ( elt seq quot -- i | quot: elt elt -- -1/0/1 )
     swap dup empty?
     [ 3drop -1 ] [ binsearch-slice (binsearch) ] ifte ;

diff --git a/library/generic/generic.factor b/library/generic/generic.factor
index 8571568259283dd0808eb53b78c0186c54b277f9..c3989f01b5e012126371c4fc5ec5bc4e0839922b 100644 (file)
--- a/library/generic/generic.factor
+++ b/library/generic/generic.factor
@@ -101,7 +101,7 @@ PREDICATE: compound generic ( word -- ? )
 M: generic definer drop \ G: ;
 
 : lookup-union ( typelist -- class )
-    [ - ] sort typemap get hash [ object ] unless* ;
+    number-sort typemap get hash [ object ] unless* ;
 
 : class-or ( class class -- class )
     #! Return a class that both classes are subclasses of.
@@ -139,4 +139,4 @@ M: generic definer drop \ G: ;
 
 : define-class ( class metaclass -- )
     dupd "metaclass" set-word-prop
-    dup types [ - ] sort typemap get set-hash ;
+    dup types number-sort typemap get set-hash ;

diff --git a/library/httpd/load.factor b/library/httpd/load.factor
new file mode 100644 (file)
index 0000000..3d78266
--- /dev/null
+++ b/library/httpd/load.factor
@@ -0,0 +1,18 @@
+USING: kernel parser sequences io ;
+[
+    "/library/httpd/http-common.factor"
+    "/library/httpd/mime.factor"
+    "/library/httpd/html-tags.factor"
+    "/library/httpd/html.factor"
+    "/library/httpd/responder.factor"
+    "/library/httpd/httpd.factor"
+    "/library/httpd/file-responder.factor"
+    "/library/httpd/test-responder.factor"
+    "/library/httpd/resource-responder.factor"
+    "/library/httpd/cont-responder.factor"
+    "/library/httpd/browser-responder.factor"
+    "/library/httpd/default-responders.factor"
+    "/library/httpd/http-client.factor"
+] [
+    dup print run-resource
+] each

diff --git a/library/io/files.factor b/library/io/files.factor
index 53443ee1bc7113954d576722a51cc8b363cd98ab..373e52c0b9e1a6d8ba14f5d40dc0cd19b0c27d15 100644 (file)
--- a/library/io/files.factor
+++ b/library/io/files.factor
@@ -8,7 +8,7 @@ USING: kernel lists namespaces sequences strings ;
 : path+ ( path path -- path ) "/" swap append3 ;
 : exists? ( file -- ? ) stat >boolean ;
 : directory? ( file -- ? ) stat car ;
-: directory ( dir -- list ) (directory) [ lexi ] sort ;
+: directory ( dir -- list ) (directory) string-sort ;
 : file-length ( file -- length ) stat third ;
 : file-extension ( filename -- extension )
     "." split cdr dup [ peek ] when ;

diff --git a/library/sdl/sdl-gfx.factor b/library/sdl/sdl-gfx.factor
index c20827da603779f75602e5124717fce65cf32351..6318679c54290a51c18c5c4ba4b6b74509808a12 100644 (file)
--- a/library/sdl/sdl-gfx.factor
+++ b/library/sdl/sdl-gfx.factor
@@ -67,16 +67,6 @@ IN: sdl USING: alien ;
     [ "surface*" "short" "short" "short" "short" "uint" ]
     alien-invoke ;
 
-: pieColor ( surface x y rad start end color -- )
-    "void" "sdl-gfx" "pieColor"
-    [ "surface*" "short" "short" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: filledPieColor ( surface x y rad start end color -- )
-    "void" "sdl-gfx" "filledPieColor"
-    [ "surface*" "short" "short" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
 : trigonColor ( surface x1 y1 x2 y2 x3 y3 color -- )
     "void" "sdl-gfx" "trigonColor"
     [ "surface*" "short" "short" "short" "short" "short" "short" "uint" ]

diff --git a/library/sdl/sdl-utils.factor b/library/sdl/sdl-utils.factor
index 78b66a63208cf28090da5286fb90b7858f1eecb9..20d79be7de57356c951e15eed660136c177f8e6b 100644 (file)
--- a/library/sdl/sdl-utils.factor
+++ b/library/sdl/sdl-utils.factor
@@ -52,8 +52,8 @@ SYMBOL: bpp
 
 : must-lock-surface? ( surface -- ? )
     #! This is a macro in SDL_video.h.
-    dup sdl-surface-offset 0 = [
-        sdl-surface-flags
+    dup surface-offset 0 = [
+        surface-flags
         SDL_HWSURFACE SDL_ASYNCBLIT bitor SDL_RLEACCEL bitor
         bitand 0 = not
     ] [
@@ -71,5 +71,5 @@ SYMBOL: bpp
         ] ifte SDL_Flip drop
     ] with-scope ; inline
 
-: sdl-surface-rect ( x y surface -- rect )
-    dup sdl-surface-w swap sdl-surface-h make-rect ;
+: surface-rect ( x y surface -- rect )
+    dup surface-w swap surface-h make-rect ;

diff --git a/library/sdl/sdl-video.factor b/library/sdl/sdl-video.factor
index e87654a5afa34c3b678cfac377bba510b3e728ef..ec10633516a5926cb5cfe48575c0742ea4d76568 100644 (file)
--- a/library/sdl/sdl-video.factor
+++ b/library/sdl/sdl-video.factor
@@ -58,7 +58,7 @@ BEGIN-STRUCT: sdl-format
     FIELD: uchar  alpha
 END-STRUCT
 
-BEGIN-STRUCT: sdl-surface
+BEGIN-STRUCT: surface
     FIELD: uint        flags
     FIELD: sdl-format* format
     FIELD: int         w
@@ -120,7 +120,7 @@ END-STRUCT
     "void" "sdl" "SDL_UnlockSurface" [ "surface*" ] alien-invoke ;
 
 : SDL_SetClipRect ( surface rect -- ? )
-    "bool" "sdl" "SDL_SetClipRect" [ "surface*" "rect*" ] alien-invoke ;
+    "bool" "sdl" "SDL_SetClipRect" [ "surface*" "sdl-rect*" ] alien-invoke ;
 
 : SDL_FreeSurface ( surface -- )
     "void" "sdl" "SDL_FreeSurface" [ "surface*" ] alien-invoke ;
@@ -129,14 +129,14 @@ END-STRUCT
     #! The blit function should not be called on a locked
     #! surface.
     "int" "sdl" "SDL_UpperBlit" [
-        "surface*" "rect*"
-        "surface*" "rect*"
+        "surface*" "sdl-rect*"
+        "surface*" "sdl-rect*"
     ] alien-invoke ;
 
 : SDL_FillRect ( surface rect color -- n )
     #! If rect is null, fills entire surface.
     "bool" "sdl" "SDL_FillRect"
-    [ "surface*" "rect*" "uint" ] alien-invoke ;
+    [ "surface*" "sdl-rect*" "uint" ] alien-invoke ;
 
 : SDL_WM_SetCaption ( title icon -- )
     "void" "sdl" "SDL_WM_SetCaption"

diff --git a/library/test/benchmark/sort.factor b/library/test/benchmark/sort.factor
index b64879678527b66d9fdfa82c5baf393d114a151b..ef8cc56d933ea27d99b523d31c135836c1d06a1f 100644 (file)
--- a/library/test/benchmark/sort.factor
+++ b/library/test/benchmark/sort.factor
@@ -2,6 +2,6 @@ IN: temporary
 USING: compiler kernel math sequences test ;
 
 : sort-benchmark
-    100000 [ drop 0 10000 random-int ] map [ - ] sort drop ; compiled
+    100000 [ drop 0 10000 random-int ] map number-sort drop ; compiled
 
 [ ] [ sort-benchmark ] unit-test

diff --git a/library/test/sequences.factor b/library/test/sequences.factor
index 93c0a9f21ffe219ea9b12d25341a8d905daeadd3..b6f0c0d2ce3376c8944222ded3e52825fd6ba3eb 100644 (file)
--- a/library/test/sequences.factor
+++ b/library/test/sequences.factor
@@ -147,7 +147,7 @@ unit-test
     sorter-seq >vector nip
 ] unit-test
 
-[ [ ] ] [ [ ] [ - ] sort ] unit-test
+[ [ ] ] [ [ ] number-sort ] unit-test
 
 : pairs ( seq quot -- )
     swap dup length 1 - [
@@ -166,6 +166,6 @@ unit-test
 [ t ] [
     100 [
         drop
-        1000 [ drop 0 1000 random-int ] map [ - ] sort [ - ] sorted?
+        1000 [ drop 0 1000 random-int ] map number-sort [ - ] sorted?
     ] all?
 ] unit-test

diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index f1ded968ec07f68c610965547890db5a00de9a51..d7fdb1980655f6a4b729570c9e0e9b18ea988e77 100644 (file)
--- a/library/ui/gadgets.factor
+++ b/library/ui/gadgets.factor
@@ -18,14 +18,11 @@ GENERIC: inside? ( loc rect -- ? )
 : rect-extent ( rect -- loc dim )
     dup rect-loc dup rot rect-dim v+ ;
 
-: screen-loc ( rect -- loc )
-    rect-loc origin get v+ ;
-
-: screen-bounds ( rect -- rect )
-    dup screen-loc swap rect-dim <rect> ;
+: >absolute ( rect -- rect )
+    dup rect-loc origin get v+ dup rot rect-dim v+ <rect> ;
 
 M: rect inside? ( loc rect -- ? )
-    screen-bounds rect-bounds { 1 1 1 } v- { 0 0 0 } vmax
+    >absolute rect-bounds { 1 1 1 } v- { 0 0 0 } vmax
     >r v- { 0 0 0 } r> vbetween? conjunction ;
 
 : intersect ( rect rect -- rect )
@@ -114,7 +111,6 @@ M: gadget pick-up* ( point gadget -- gadget )
     #! in any subgadget. If not, see if it is contained in the
     #! box delegate.
     dup gadget-visible? >r 2dup inside? r> drop [
-        [ rect-loc v- ] keep 2dup
         pick-up* [ pick-up ] [ nip ] ?ifte
     ] [
         2drop f

diff --git a/library/ui/layouts.factor b/library/ui/layouts.factor
index 1068413047ae30b4edf31653a744a339c8ab3c4b..84f368b999fe0e1d3f7c650644bc24d80ed14f30 100644 (file)
--- a/library/ui/layouts.factor
+++ b/library/ui/layouts.factor
@@ -83,16 +83,18 @@ M: pack pref-dim ( pack -- dim )
 
 M: pack layout* ( pack -- ) dup pref-dims packed-layout ;
 
+: pack-comparator rect-loc origin get v+ v- over v. ;
+
 : pick-up-fast ( axis point gadgets -- gadget )
-    [ rect-loc v- over v. ] binsearch* nip ;
+    [ pack-comparator ] binsearch* nip ;
 
 M: pack pick-up* ( point pack -- gadget )
     dup pack-vector pick rot gadget-children
     pick-up-fast tuck inside? [ drop f ] unless ;
 
-! M: pack visible-children* ( rect pack -- list )
-!     dup pack-vector -rot gadget-children >r rect-extent r>
-!     [ rect-loc origin get v+ v- over v. ] binsearch-slice nip ;
+M: pack visible-children* ( rect pack -- list )
+    dup pack-vector -rot gadget-children >r rect-extent r>
+    [ pack-comparator ] binsearch-slice nip ;
 
 TUPLE: stack ;
 

diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index cdd1f1f06fef039f14643421d307a6541c8e01c3..2c8ae88756786c2e01087ba2385366bb429dd2e0 100644 (file)
--- a/library/ui/paint.factor
+++ b/library/ui/paint.factor
@@ -18,7 +18,7 @@ SYMBOL: clip
 GENERIC: visible-children* ( rect gadget -- list )
 
 M: gadget visible-children* ( rect gadget -- list )
-    gadget-children [ screen-bounds intersects? ] subset-with ;
+    gadget-children [ >absolute intersects? ] subset-with ;
 
 : visible-children ( gadget -- list )
     clip get swap visible-children* ;
@@ -26,7 +26,7 @@ M: gadget visible-children* ( rect gadget -- list )
 GENERIC: draw-gadget* ( gadget -- )
 
 : translate&clip ( gadget -- )
-    screen-bounds dup rect-loc origin set
+    >absolute dup rect-loc origin set
     clip [ intersect dup ] change set-clip ;
 
 : draw-gadget ( gadget -- )

diff --git a/library/ui/text.factor b/library/ui/text.factor
index a9440420775ee052a265f11d5df3ad2548fd06e5..ca2f9361f26d8ac1fd911329b6e6d822eba8d435 100644 (file)
--- a/library/ui/text.factor
+++ b/library/ui/text.factor
@@ -7,8 +7,8 @@ strings styles io ;
 : draw-surface ( x y surface -- )
     surface get SDL_UnlockSurface
     [
-        [ sdl-surface-rect ] keep swap surface get 0 0
-    ] keep sdl-surface-rect swap rot SDL_UpperBlit drop
+        [ surface-rect ] keep swap surface get 0 0
+    ] keep surface-rect swap rot SDL_UpperBlit drop
     surface get dup must-lock-surface? [
         SDL_LockSurface
     ] when drop ;

diff --git a/library/vocabularies.factor b/library/vocabularies.factor
index a09f26a65f6080f97d4d146c0e0494d4c40db68c..9e701c78bb3d35a0361a0596e1ea129dce510573 100644 (file)
--- a/library/vocabularies.factor
+++ b/library/vocabularies.factor
@@ -11,7 +11,7 @@ SYMBOL: vocabularies
 
 : vocabs ( -- list )
     #! Push a list of vocabularies.
-    vocabularies get hash-keys [ lexi ] sort ;
+    vocabularies get hash-keys string-sort ;
 
 : vocab ( name -- vocab )
     #! Get a vocabulary.