Merge branch 'master' of git://factorcode.org/git/factor

.gitignore

@@ -11,6 +11,7 @@ Factor/factor
 *.image
 *.dylib
 factor
+factor.com
 *#*#
 .DS_Store
 .gdb_history

Makefile

@@ -17,12 +17,12 @@ else
 	CFLAGS += -O3 $(SITE_CFLAGS)
 endif
 
+ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
+
 ifdef CONFIG
 	include $(CONFIG)
 endif
 
-ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
-
 DLL_OBJS = $(PLAF_DLL_OBJS) \
 	vm/alien.o \
 	vm/bignum.o \
@@ -129,15 +129,7 @@ solaris-x86-32:
 solaris-x86-64:
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.64
 
-freetype6.dll:
+winnt-x86-32:
-	wget http://factorcode.org/dlls/freetype6.dll
-	chmod 755 freetype6.dll
-
-zlib1.dll:
-	wget http://factorcode.org/dlls/zlib1.dll
-	chmod 755 zlib1.dll
-
-winnt-x86-32: freetype6.dll zlib1.dll
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
 	$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
 
@@ -167,7 +159,7 @@ factor: $(DLL_OBJS) $(EXE_OBJS)
 factor-console: $(DLL_OBJS) $(EXE_OBJS)
 	$(LINKER) $(ENGINE) $(DLL_OBJS)
 	$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
-		$(CFLAGS) $(CFLAGS_CONSOLE) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
+		$(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS)
 
 clean:
 	rm -f vm/*.o

basis/io/launcher/windows/nt/nt-tests.factor

@@ -1,7 +1,7 @@
 USING: io.launcher tools.test calendar accessors environment
 namespaces kernel system arrays io io.files io.encodings.ascii
 sequences parser assocs hashtables math continuations eval
-io.files.temp io.directories io.pathnames ;
+io.files.temp io.directories io.pathnames splitting ;
 IN: io.launcher.windows.nt.tests
 
 [ ] [
@@ -23,9 +23,12 @@ IN: io.launcher.windows.nt.tests
 
 [ f ] [ "notepad" get process-running? ] unit-test
 
+: console-vm ( -- path )
+    vm ".exe" ?tail [ ".com" append ] when ;
+
 [ ] [
     <process>
-        vm "-quiet" "-run=hello-world" 3array >>command
+        console-vm "-quiet" "-run=hello-world" 3array >>command
         "out.txt" temp-file >>stdout
     try-process
 ] unit-test
@@ -36,7 +39,7 @@ IN: io.launcher.windows.nt.tests
 
 [ ] [
     <process>
-        vm "-run=listener" 2array >>command
+        console-vm "-run=listener" 2array >>command
         +closed+ >>stdin
     try-process
 ] unit-test
@@ -47,7 +50,7 @@ IN: io.launcher.windows.nt.tests
 [ ] [
     launcher-test-path [
         <process>
-            vm "-script" "stderr.factor" 3array >>command
+            console-vm "-script" "stderr.factor" 3array >>command
             "out.txt" temp-file >>stdout
             "err.txt" temp-file >>stderr
         try-process
@@ -65,7 +68,7 @@ IN: io.launcher.windows.nt.tests
 [ ] [
     launcher-test-path [
         <process>
-            vm "-script" "stderr.factor" 3array >>command
+            console-vm "-script" "stderr.factor" 3array >>command
             "out.txt" temp-file >>stdout
             +stdout+ >>stderr
         try-process
@@ -79,7 +82,7 @@ IN: io.launcher.windows.nt.tests
 [ "output" ] [
     launcher-test-path [
         <process>
-            vm "-script" "stderr.factor" 3array >>command
+            console-vm "-script" "stderr.factor" 3array >>command
             "err2.txt" temp-file >>stderr
         ascii <process-reader> lines first
     ] with-directory
@@ -92,7 +95,7 @@ IN: io.launcher.windows.nt.tests
 [ t ] [
     launcher-test-path [
         <process>
-            vm "-script" "env.factor" 3array >>command
+            console-vm "-script" "env.factor" 3array >>command
         ascii <process-reader> contents
     ] with-directory eval
 
@@ -102,7 +105,7 @@ IN: io.launcher.windows.nt.tests
 [ t ] [
     launcher-test-path [
         <process>
-            vm "-script" "env.factor" 3array >>command
+            console-vm "-script" "env.factor" 3array >>command
             +replace-environment+ >>environment-mode
             os-envs >>environment
         ascii <process-reader> contents
@@ -114,7 +117,7 @@ IN: io.launcher.windows.nt.tests
 [ "B" ] [
     launcher-test-path [
         <process>
-            vm "-script" "env.factor" 3array >>command
+            console-vm "-script" "env.factor" 3array >>command
             { { "A" "B" } } >>environment
         ascii <process-reader> contents
     ] with-directory eval
@@ -125,7 +128,7 @@ IN: io.launcher.windows.nt.tests
 [ f ] [
     launcher-test-path [
         <process>
-            vm "-script" "env.factor" 3array >>command
+            console-vm "-script" "env.factor" 3array >>command
             { { "USERPROFILE" "XXX" } } >>environment
             +prepend-environment+ >>environment-mode
         ascii <process-reader> contents
@@ -151,7 +154,7 @@ IN: io.launcher.windows.nt.tests
     2 [
         launcher-test-path [
             <process>
-                vm "-script" "append.factor" 3array >>command
+                console-vm "-script" "append.factor" 3array >>command
                 "append-test" temp-file <appender> >>stdout
             try-process
         ] with-directory

basis/math/geometry/rect/rect.factor

@@ -60,9 +60,14 @@ M: rect set-height! ( rect height -- rect ) over dim>> set-second ;
 M: rect set-x! ( rect x -- rect ) over loc>> set-first  ;
 M: rect set-y! ( rect y -- rect ) over loc>> set-second ;
 
+: rect-containing ( points -- rect )
+    [ vleast ] [ vgreatest ] bi
+    [ drop ] [ swap v- ] 2bi <rect> ;
+
 ! Accessing corners
 
 : top-left     ( rect -- point ) loc>> ;
 : top-right    ( rect -- point ) [ loc>> ] [ width  1 - ] bi v+x ;
 : bottom-left  ( rect -- point ) [ loc>> ] [ height 1 - ] bi v+y ;
 : bottom-right ( rect -- point ) [ loc>> ] [ dim>> ] bi v+ { 1 1 } v- ;
+

basis/math/vectors/vectors.factor

@@ -19,6 +19,9 @@ IN: math.vectors
 : vmax ( u v -- w ) [ max ] 2map ;
 : vmin ( u v -- w ) [ min ] 2map ;
 
+: vgreatest ( array -- vmax ) { -1.0/0.0 -1.0/0.0 } [ vmax ] reduce ; 
+: vleast    ( array -- vmax ) {  1.0/0.0  1.0/0.0 } [ vmin ] reduce ; 
+
 : v. ( u v -- x ) [ * ] [ + ] 2map-reduce ;
 : norm-sq ( v -- x ) [ absq ] [ + ] map-reduce ;
 : norm ( v -- x ) norm-sq sqrt ;

build-support/factor.sh

@@ -236,7 +236,7 @@ find_word_size() {
 
 set_factor_binary() {
     case $OS in
-        winnt) FACTOR_BINARY=factor-console.exe;;
+        winnt) FACTOR_BINARY=factor.com;;
         *) FACTOR_BINARY=factor;;
     esac
 }
@@ -295,6 +295,9 @@ set_build_info() {
     elif [[ $OS == winnt && $ARCH == x86 && $WORD == 64 ]] ; then
         MAKE_IMAGE_TARGET=winnt-x86.64
         MAKE_TARGET=winnt-x86-64
+    elif [[ $OS == winnt && $ARCH == x86 && $WORD == 32 ]] ; then
+        MAKE_IMAGE_TARGET=winnt-x86.32
+        MAKE_TARGET=winnt-x86-32
     elif [[ $ARCH == x86 && $WORD == 64 ]] ; then
         MAKE_IMAGE_TARGET=unix-x86.64
         MAKE_TARGET=$OS-x86-64

extra/quadtrees/quadtrees-docs.factor

@@ -2,17 +2,25 @@ USING: arrays assocs help.markup help.syntax math.geometry.rect quadtrees quotat
 IN: quadtrees
 
 ARTICLE: "quadtrees" "Quadtrees"
-"The " { $snippet "quadtrees" } " vocabulary implements the quadtree structure in Factor. Quadtrees follow the " { $link "assocs-protocol" } " for insertion, deletion, and querying of exact points, using two-dimensional vectors as keys. Additional words are provided for spatial queries and pruning the tree structure:"
+"The " { $snippet "quadtrees" } " vocabulary implements the quadtree data structure in Factor."
-{ $subsection prune }
+{ $subsection <quadtree> }
+"Quadtrees follow the " { $link "assocs-protocol" } " for insertion, deletion, and querying of exact points, using two-dimensional vectors as keys. Additional words are provided for spatial queries and pruning the tree structure:"
 { $subsection in-rect }
+{ $subsection prune-quadtree }
 "The following words are provided to help write quadtree algorithms:"
 { $subsection descend }
 { $subsection each-quadrant }
-{ $subsection map-quadrant } ;
+{ $subsection map-quadrant }
+"Quadtrees can be used to \"swizzle\" a sequence to improve the locality of spatial data in memory:"
+{ $subsection swizzle } ;
 
 ABOUT: "quadtrees"
 
-HELP: prune
+HELP: <quadtree>
+{ $values { "bounds" rect } { "quadtree" quadtree } }
+{ $description "Constructs an empty quadtree covering the axis-aligned rectangle indicated by " { $snippet "bounds" } ". All the keys of " { $snippet "quadtree" } " must be two-dimensional vectors lying inside " { $snippet "bounds" } "." } ;
+
+HELP: prune-quadtree
 { $values { "tree" quadtree } }
 { $description "Removes empty nodes from " { $snippet "tree" } "." } ;
 
@@ -32,3 +40,6 @@ HELP: map-quadrant
 { $values { "node" quadtree } { "quot" quotation } { "array" array } }
 { $description "Calls " { $snippet "quot" } " with each subnode of " { $snippet "node" } " on the top of the stack in turn, collecting the four results into " { $snippet "array" } "." } ;
 
+HELP: swizzle
+{ $values { "sequence" sequence } { "quot" quotation } { "sequence'" sequence } }
+{ $description "Swizzles " { $snippet "sequence" } " based on the two-dimensional vector values returned by calling " { $snippet "quot" } " on each element of " { $snippet "sequence" } "." } ;

extra/quadtrees/quadtrees-tests.factor

@@ -1,5 +1,5 @@
 ! (c) 2009 Joe Groff, see BSD license
-USING: assocs kernel tools.test quadtrees math.geometry.rect sorting ;
+USING: accessors assocs kernel tools.test quadtrees math.geometry.rect sorting ;
 IN: quadtrees.tests
 
 : unit-bounds ( -- rect ) { -1.0 -1.0 } { 2.0 2.0 } <rect> ;
@@ -98,7 +98,7 @@ IN: quadtrees.tests
         "d" {  0.75  0.25 } value>>key
 
         {  0.25  0.25 } delete>>key
-        prune
+        prune-quadtree
 ] unit-test
 
 [ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
@@ -116,7 +116,7 @@ IN: quadtrees.tests
 
         {  0.25  0.25 } delete>>key
         {  0.75  0.25 } delete>>key
-        prune
+        prune-quadtree
 ] unit-test
 
 [ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
@@ -160,7 +160,7 @@ IN: quadtrees.tests
         "g" {  0.25  0.25 } value>>key
         "h" {  0.75  0.75 } value>>key
 
-        prune
+        prune-quadtree
 ] unit-test
 
 [ 8 ] [
@@ -200,3 +200,42 @@ IN: quadtrees.tests
         >alist natural-sort
 ] unit-test
 
+TUPLE: pointy-thing center ;
+
+[ {
+    T{ pointy-thing f { 0 0 } }
+    T{ pointy-thing f { 1 0 } }
+    T{ pointy-thing f { 0 1 } }
+    T{ pointy-thing f { 1 1 } }
+    T{ pointy-thing f { 2 0 } }
+    T{ pointy-thing f { 3 0 } }
+    T{ pointy-thing f { 2 1 } }
+    T{ pointy-thing f { 3 1 } }
+    T{ pointy-thing f { 0 2 } }
+    T{ pointy-thing f { 1 2 } }
+    T{ pointy-thing f { 0 3 } }
+    T{ pointy-thing f { 1 3 } }
+    T{ pointy-thing f { 2 2 } }
+    T{ pointy-thing f { 3 2 } }
+    T{ pointy-thing f { 2 3 } }
+    T{ pointy-thing f { 3 3 } }
+} ] [
+    {
+        T{ pointy-thing f { 3 1 } }
+        T{ pointy-thing f { 2 3 } }
+        T{ pointy-thing f { 3 2 } }
+        T{ pointy-thing f { 0 1 } }
+        T{ pointy-thing f { 2 2 } }
+        T{ pointy-thing f { 1 1 } }
+        T{ pointy-thing f { 3 0 } }
+        T{ pointy-thing f { 3 3 } }
+        T{ pointy-thing f { 1 3 } }
+        T{ pointy-thing f { 2 1 } }
+        T{ pointy-thing f { 0 0 } }
+        T{ pointy-thing f { 2 0 } }
+        T{ pointy-thing f { 1 0 } }
+        T{ pointy-thing f { 0 2 } }
+        T{ pointy-thing f { 1 2 } }
+        T{ pointy-thing f { 0 3 } }
+    } [ center>> ] swizzle
+] unit-test

extra/quadtrees/quadtrees.factor

@@ -1,12 +1,15 @@
 ! (c) 2009 Joe Groff, see BSD license
 USING: assocs kernel math.geometry.rect combinators accessors
 math.vectors vectors sequences math math.points math.geometry
-combinators.short-circuit arrays fry locals ;
+combinators.short-circuit arrays fry ;
 IN: quadtrees
 
 TUPLE: quadtree { bounds rect } point value ll lr ul ur leaf? ;
 
-: <quadtree> ( bounds -- quadtree ) f f f f f f t quadtree boa ;
+: <quadtree> ( bounds -- quadtree )
+    quadtree new
+        swap >>bounds
+        t >>leaf? ;
 
 : rect-ll ( rect -- point ) loc>> ;
 : rect-lr ( rect -- point ) [ loc>> ] [ width  ] bi v+x ;
@@ -26,11 +29,13 @@ TUPLE: quadtree { bounds rect } point value ll lr ul ur leaf? ;
 : descend ( pt node -- pt subnode )
     [ drop ] [ quadrant ] 2bi ; inline
 
-:: each-quadrant ( node quot -- )
+: each-quadrant ( node quot -- )
-    node ll>> quot call
+    {
-    node lr>> quot call
+        [ [ ll>> ] [ call ] bi* ] 
-    node ul>> quot call
+        [ [ lr>> ] [ call ] bi* ] 
-    node ur>> quot call ; inline
+        [ [ ul>> ] [ call ] bi* ] 
+        [ [ ur>> ] [ call ] bi* ] 
+    } 2cleave ; inline
 : map-quadrant ( node quot: ( child-node -- x ) -- array )
     each-quadrant 4array ; inline
 
@@ -73,6 +78,7 @@ DEFER: in-rect*
     [ node-insert ] [ node-insert ] bi ;
 
 : leaf-replaceable? ( pt leaf -- ? ) point>> { [ nip not ] [ = ] } 2|| ;
+
 : leaf-insert ( value point leaf -- )
     2dup leaf-replaceable?
     [ [ (>>point) ] [ (>>value) ] bi ]
@@ -165,7 +171,7 @@ DEFER: in-rect*
 
 PRIVATE>
 
-: prune ( tree -- tree ) [ (prune) ] keep ;
+: prune-quadtree ( tree -- tree ) [ (prune) ] keep ;
 
 : in-rect ( tree rect -- values )
     [ 16 <vector> ] 2dip in-rect* ;
@@ -186,3 +192,8 @@ M: quadtree clear-assoc ( assoc -- )
     f >>value
     drop ;
 
+: swizzle ( sequence quot -- sequence' )
+    [ dup ] dip map
+    [ zip ] [ rect-containing <quadtree> ] bi
+    [ '[ first2 _ set-at ] each ] [ values ] bi ;
+

vm/Config.windows

@@ -2,6 +2,7 @@ CFLAGS += -DWINDOWS -mno-cygwin
 LIBS = -lm
 PLAF_DLL_OBJS += vm/os-windows.o
 EXE_EXTENSION=.exe
+CONSOLE_EXTENSION=.com
 DLL_EXTENSION=.dll
 LINKER = $(CC) -shared -mno-cygwin -o 
 LINK_WITH_ENGINE = -l$(DLL_PREFIX)factor$(DLL_SUFFIX)

vm/Config.windows.nt

@@ -6,4 +6,5 @@ PLAF_EXE_OBJS += vm/resources.o
 PLAF_EXE_OBJS += vm/main-windows-nt.o
 CFLAGS += -mwindows
 CFLAGS_CONSOLE += -mconsole
+CONSOLE_EXTENSION = .com
 include vm/Config.windows

vm/Config.windows.nt.x86.32

@@ -1,3 +1,4 @@
+DLL_PATH=http://factorcode.org/dlls
 WINDRES=windres
 include vm/Config.windows.nt
 include vm/Config.x86.32

vm/Config.windows.nt.x86.64

@@ -1,3 +1,5 @@
+#error "lol"
+DLL_PATH=http://factorcode.org/dlls/64
 CC=$(WIN64_PATH)-gcc.exe
 WINDRES=$(WIN64_PATH)-windres.exe
 include vm/Config.windows.nt

vm/os-windows.c

@@ -109,17 +109,6 @@ const F_CHAR *default_image_path(void)
 	snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path); 
 	temp_path[sizeof(temp_path) - 1] = 0;
 
-	if(!windows_stat(temp_path)) {
-		unsigned int len = wcslen(full_path);
-		F_CHAR magic[] = L"-console";
-		unsigned int magic_len = wcslen(magic);
-
-		if(!wcsncmp(full_path + len - magic_len, magic, MIN(len, magic_len)))
-			full_path[len - magic_len] = 0;
-		snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path); 
-		temp_path[sizeof(temp_path) - 1] = 0;
-	}
-
 	return safe_strdup(temp_path);
 }