From de64b18158bf358eca853f3906f92296a7d998d1 Mon Sep 17 00:00:00 2001 From: James Cash Date: Sun, 16 Nov 2008 17:34:53 -0500 Subject: [PATCH 01/40] Missing in extra/webapps/user-admin/new-user.xml --- extra/webapps/user-admin/new-user.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/user-admin/new-user.xml b/extra/webapps/user-admin/new-user.xml index d3cf681165..313c8e2702 100644 --- a/extra/webapps/user-admin/new-user.xml +++ b/extra/webapps/user-admin/new-user.xml @@ -37,7 +37,7 @@ Capabilities: -

  • +

    • From 7815560f30c19699d44e251acf18b4f69d937651 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 17:28:44 -0600 Subject: [PATCH 02/40] Fix index paths --- basis/help/html/html.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index d2d0725a1e..82e83e60e0 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -115,10 +115,10 @@ M: result link-href href>> ; [ [ title>> ] compare ] sort ; : article-apropos ( string -- results ) - "articles.idx" temp-file offline-apropos ; + "docs/articles.idx" temp-file offline-apropos ; : word-apropos ( string -- results ) - "words.idx" temp-file offline-apropos ; + "docs/words.idx" temp-file offline-apropos ; : vocab-apropos ( string -- results ) - "vocabs.idx" temp-file offline-apropos ; + "docs/vocabs.idx" temp-file offline-apropos ; From b50d4c9b36621be6e96eff3d935d48454e49c39f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 17:30:47 -0600 Subject: [PATCH 03/40] Fix help search again --- basis/help/html/html.factor | 6 +++--- extra/webapps/help/help.factor | 8 +++++--- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index 82e83e60e0..6b90ba6937 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -115,10 +115,10 @@ M: result link-href href>> ; [ [ title>> ] compare ] sort ; : article-apropos ( string -- results ) - "docs/articles.idx" temp-file offline-apropos ; + "articles.idx" offline-apropos ; : word-apropos ( string -- results ) - "docs/words.idx" temp-file offline-apropos ; + "words.idx" offline-apropos ; : vocab-apropos ( string -- results ) - "docs/vocabs.idx" temp-file offline-apropos ; + "vocabs.idx" offline-apropos ; diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor index c209fe222e..3072f5d024 100644 --- a/extra/webapps/help/help.factor +++ b/extra/webapps/help/help.factor @@ -18,9 +18,11 @@ TUPLE: help-webapp < dispatcher ; help-dir set-current-directory - "search" value article-apropos "articles" set-value - "search" value word-apropos "words" set-value - "search" value vocab-apropos "vocabs" set-value + help-dir [ + "search" value article-apropos "articles" set-value + "search" value word-apropos "words" set-value + "search" value vocab-apropos "vocabs" set-value + ] with-directory { help-webapp "search" } ] >>submit ; From 4d0b5cf7e74c793b1a1b75ff3ea052b24c3b9348 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 17:35:39 -0600 Subject: [PATCH 04/40] Clean up --- extra/webapps/help/help.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor index 3072f5d024..6f2c4f0042 100644 --- a/extra/webapps/help/help.factor +++ b/extra/webapps/help/help.factor @@ -16,8 +16,6 @@ TUPLE: help-webapp < dispatcher ; { "search" [ 1 v-min-length 50 v-max-length v-one-line ] } } validate-params - help-dir set-current-directory - help-dir [ "search" value article-apropos "articles" set-value "search" value word-apropos "words" set-value From ff7358beb31d6eac72073ca8aa5bb31e2ede13d0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 17:48:06 -0600 Subject: [PATCH 05/40] Fix typo --- basis/compiler/compiler-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/compiler/compiler-docs.factor b/basis/compiler/compiler-docs.factor index 6cb860d33f..512d26f4bf 100644 --- a/basis/compiler/compiler-docs.factor +++ b/basis/compiler/compiler-docs.factor @@ -6,7 +6,7 @@ HELP: enable-compiler { $description "Enables the optimizing compiler." } ; HELP: disable-compiler -{ $description "Enables the optimizing compiler." } ; +{ $description "Disable the optimizing compiler." } ; ARTICLE: "compiler-usage" "Calling the optimizing compiler" "Normally, new word definitions are recompiled automatically. This can be changed:" From eea93234d05abd58a8512d05985541f436ff4652 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:41:53 -0600 Subject: [PATCH 06/40] Fix some types for Win64 --- basis/windows/kernel32/kernel32.factor | 10 +++++----- basis/windows/types/types.factor | 9 +++++---- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 462377e85c..96301dbbe4 100644 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -199,11 +199,11 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION : THREAD_PRIORITY_TIME_CRITICAL 15 ; inline C-STRUCT: OVERLAPPED - { "int" "internal" } - { "int" "internal-high" } - { "int" "offset" } - { "int" "offset-high" } - { "void*" "event" } ; + { "UINT_PTR" "internal" } + { "UINT_PTR" "internal-high" } + { "DWORD" "offset" } + { "DWORD" "offset-high" } + { "HANDLE" "event" } ; C-STRUCT: SYSTEMTIME { "WORD" "wYear" } diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index 0ac8409016..6b1a57a098 100644 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -40,10 +40,11 @@ TYPEDEF: void* LPVOID TYPEDEF: void* LPCVOID TYPEDEF: float FLOAT -TYPEDEF: short HALF_PTR -TYPEDEF: ushort UHALF_PTR -TYPEDEF: int INT_PTR -TYPEDEF: uint UINT_PTR + +TYPEDEF: intptr_t HALF_PTR +TYPEDEF: intptr_t UHALF_PTR +TYPEDEF: intptr_t INT_PTR +TYPEDEF: intptr_t UINT_PTR TYPEDEF: int LONG_PTR TYPEDEF: ulong ULONG_PTR From ccd13ce975fe4461de7ffe903b8fd4b8cd1408b5 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:42:10 -0600 Subject: [PATCH 07/40] Define intptr_t type --- basis/alien/c-types/c-types.factor | 2 +- basis/cpu/x86/64/winnt/winnt.factor | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index b4e4d05f2e..543af8dee8 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -436,6 +436,6 @@ M: long-long-type box-return ( type -- ) "double" define-primitive-type "long" "ptrdiff_t" typedef - + "long" "intptr_t" typedef "ulong" "size_t" typedef ] with-compilation-unit diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index 92560ef5e9..9108c0e8f7 100644 --- a/basis/cpu/x86/64/winnt/winnt.factor +++ b/basis/cpu/x86/64/winnt/winnt.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel layouts system math alien.c-types +USING: kernel layouts system math alien.c-types sequences compiler.cfg.registers cpu.architecture cpu.x86.assembler cpu.x86 ; IN: cpu.x86.64.winnt @@ -22,6 +22,7 @@ M: x86.64 dummy-fp-params? t ; << "longlong" "ptrdiff_t" typedef +"longlong" "intptr_t" typedef "int" "long" typedef "uint" "ulong" typedef >> From efb2e49c50c318f598508d6e62da53ebcf056a21 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:42:21 -0600 Subject: [PATCH 08/40] Fix freetype for Win64 --- basis/freetype/freetype.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/freetype/freetype.factor b/basis/freetype/freetype.factor index 8572a8bd91..683169e394 100644 --- a/basis/freetype/freetype.factor +++ b/basis/freetype/freetype.factor @@ -64,7 +64,7 @@ C-STRUCT: glyph { "FT_Pos" "advance-x" } { "FT_Pos" "advance-y" } - { "long" "format" } + { "intptr_t" "format" } { "int" "bitmap-rows" } { "int" "bitmap-width" } From d0139671802d194732d31d3ef60f202e9e33af88 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:42:44 -0600 Subject: [PATCH 09/40] Make io.servers.connection work if SSL is not available --- basis/io/servers/connection/connection.factor | 30 ++++++++++++------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index 674ed8803c..942bdb041d 100644 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -114,19 +114,29 @@ M: threaded-server handle-client* handler>> call ; ] when* ] unless ; +: (start-server) ( threaded-server -- ) + init-server + dup threaded-server [ + dup name>> [ + [ listen-on [ start-accept-loop ] parallel-each ] + [ ready>> raise-flag ] + bi + ] with-logging + ] with-variable ; + PRIVATE> : start-server ( threaded-server -- ) - init-server - dup secure-config>> [ - dup threaded-server [ - dup name>> [ - [ listen-on [ start-accept-loop ] parallel-each ] - [ ready>> raise-flag ] - bi - ] with-logging - ] with-variable - ] with-secure-context ; + #! Only create a secure-context if we want to listen on + #! a secure port, otherwise start-server won't work at + #! all if SSL is not available. + dup secure>> [ + dup secure-config>> [ + (start-server) + ] with-secure-context + ] [ + (start-server) + ] if ; : wait-for-server ( threaded-server -- ) ready>> wait-for-flag ; From 1c33e993daa0093db9efcff32a577e9d2f0c4251 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:43:10 -0600 Subject: [PATCH 10/40] Tweak launcher test: it failed without cygwin --- .../windows/nt/launcher/launcher-tests.factor | 314 +++++++++--------- 1 file changed, 157 insertions(+), 157 deletions(-) diff --git a/basis/io/windows/nt/launcher/launcher-tests.factor b/basis/io/windows/nt/launcher/launcher-tests.factor index 949b0a7961..cbae2f5eca 100644 --- a/basis/io/windows/nt/launcher/launcher-tests.factor +++ b/basis/io/windows/nt/launcher/launcher-tests.factor @@ -1,157 +1,157 @@ -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 ; -IN: io.windows.launcher.nt.tests - -[ ] [ - - "notepad" >>command - 1/2 seconds >>timeout - "notepad" set -] unit-test - -[ f ] [ "notepad" get process-running? ] unit-test - -[ f ] [ "notepad" get process-started? ] unit-test - -[ ] [ "notepad" [ run-detached ] change ] unit-test - -[ "notepad" get wait-for-process ] must-fail - -[ t ] [ "notepad" get killed>> ] unit-test - -[ f ] [ "notepad" get process-running? ] unit-test - -[ ] [ - - vm "-quiet" "-run=hello-world" 3array >>command - "out.txt" temp-file >>stdout - try-process -] unit-test - -[ "Hello world" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ ] [ - - vm "-run=listener" 2array >>command - +closed+ >>stdin - try-process -] unit-test - -[ ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "out.txt" temp-file >>stdout - "err.txt" temp-file >>stderr - try-process - ] with-directory -] unit-test - -[ "output" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "error" ] [ - "err.txt" temp-file ascii file-lines first -] unit-test - -[ ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "out.txt" temp-file >>stdout - +stdout+ >>stderr - try-process - ] with-directory -] unit-test - -[ "outputerror" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "output" ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "err2.txt" temp-file >>stderr - ascii lines first - ] with-directory -] unit-test - -[ "error" ] [ - "err2.txt" temp-file ascii file-lines first -] unit-test - -[ t ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - ascii contents - ] with-directory eval - - os-envs = -] unit-test - -[ t ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - +replace-environment+ >>environment-mode - os-envs >>environment - ascii contents - ] with-directory eval - - os-envs = -] unit-test - -[ "B" ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - { { "A" "B" } } >>environment - ascii contents - ] with-directory eval - - "A" swap at -] unit-test - -[ f ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - { { "HOME" "XXX" } } >>environment - +prepend-environment+ >>environment-mode - ascii contents - ] with-directory eval - - "HOME" swap at "XXX" = -] unit-test - -2 [ - [ ] [ - - "cmd.exe /c dir" >>command - "dir.txt" temp-file >>stdout - try-process - ] unit-test - - [ ] [ "dir.txt" temp-file delete-file ] unit-test -] times - -[ "append-test" temp-file delete-file ] ignore-errors - -[ "Hello appender\r\nHello appender\r\n" ] [ - 2 [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "append.factor" 3array >>command - "append-test" temp-file >>stdout - try-process - ] with-directory - ] times - - "append-test" temp-file ascii file-contents -] unit-test +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 ; +IN: io.windows.launcher.nt.tests + +[ ] [ + + "notepad" >>command + 1/2 seconds >>timeout + "notepad" set +] unit-test + +[ f ] [ "notepad" get process-running? ] unit-test + +[ f ] [ "notepad" get process-started? ] unit-test + +[ ] [ "notepad" [ run-detached ] change ] unit-test + +[ "notepad" get wait-for-process ] must-fail + +[ t ] [ "notepad" get killed>> ] unit-test + +[ f ] [ "notepad" get process-running? ] unit-test + +[ ] [ + + vm "-quiet" "-run=hello-world" 3array >>command + "out.txt" temp-file >>stdout + try-process +] unit-test + +[ "Hello world" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ ] [ + + vm "-run=listener" 2array >>command + +closed+ >>stdin + try-process +] unit-test + +[ ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "stderr.factor" 3array >>command + "out.txt" temp-file >>stdout + "err.txt" temp-file >>stderr + try-process + ] with-directory +] unit-test + +[ "output" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "error" ] [ + "err.txt" temp-file ascii file-lines first +] unit-test + +[ ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "stderr.factor" 3array >>command + "out.txt" temp-file >>stdout + +stdout+ >>stderr + try-process + ] with-directory +] unit-test + +[ "outputerror" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "output" ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "stderr.factor" 3array >>command + "err2.txt" temp-file >>stderr + ascii lines first + ] with-directory +] unit-test + +[ "error" ] [ + "err2.txt" temp-file ascii file-lines first +] unit-test + +[ t ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + ascii contents + ] with-directory eval + + os-envs = +] unit-test + +[ t ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + +replace-environment+ >>environment-mode + os-envs >>environment + ascii contents + ] with-directory eval + + os-envs = +] unit-test + +[ "B" ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + { { "A" "B" } } >>environment + ascii contents + ] with-directory eval + + "A" swap at +] unit-test + +[ f ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + { { "USERPROFILE" "XXX" } } >>environment + +prepend-environment+ >>environment-mode + ascii contents + ] with-directory eval + + "USERPROFILE" swap at "XXX" = +] unit-test + +2 [ + [ ] [ + + "cmd.exe /c dir" >>command + "dir.txt" temp-file >>stdout + try-process + ] unit-test + + [ ] [ "dir.txt" temp-file delete-file ] unit-test +] times + +[ "append-test" temp-file delete-file ] ignore-errors + +[ "Hello appender\r\nHello appender\r\n" ] [ + 2 [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "append.factor" 3array >>command + "append-test" temp-file >>stdout + try-process + ] with-directory + ] times + + "append-test" temp-file ascii file-contents +] unit-test From b8487ffcb0c1bbb8bdb134017a17fd457a66e152 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:43:33 -0600 Subject: [PATCH 11/40] Download Windows DLLs from builder, so that we don't need wget to build Factor --- extra/mason/child/child.factor | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor index 2bc6b191c4..0c9669ed5a 100644 --- a/extra/mason/child/child.factor +++ b/extra/mason/child/child.factor @@ -2,14 +2,26 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces make debugger sequences io.files io.launcher arrays accessors calendar continuations -combinators.short-circuit mason.common mason.report mason.platform ; +combinators.short-circuit mason.common mason.report +mason.platform mason.config http.client ; IN: mason.child : make-cmd ( -- args ) - [ gnu-make , "clean" , platform , ] { } make ; + gnu-make platform 2array ; + +: download-dlls ( -- ) + target-os get "winnt" = [ + "http://factorcode.org/dlls/" + target-cpu get "x86.64" = [ "64/" append ] when + [ "freetype6.dll" append ] + [ "zlib1.dll" append ] bi + [ download ] bi@ + ] when ; : make-vm ( -- ) "factor" [ + download-dlls + make-cmd >>command "../compile-log" >>stdout From 93c8f5a2f4ad2448018c7ce715495ab678661525 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:43:59 -0600 Subject: [PATCH 12/40] Use our MD5 library instead of OpenSSL so that we can run builder without OpenSSL being installed --- basis/bootstrap/image/download/download.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/bootstrap/image/download/download.factor b/basis/bootstrap/image/download/download.factor index 71aa2e8adc..f9b7b56779 100644 --- a/basis/bootstrap/image/download/download.factor +++ b/basis/bootstrap/image/download/download.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: http.client checksums checksums.openssl splitting assocs +USING: http.client checksums checksums.md5 splitting assocs kernel io.files bootstrap.image sequences io urls ; IN: bootstrap.image.download @@ -13,7 +13,7 @@ IN: bootstrap.image.download : need-new-image? ( image -- ? ) dup exists? [ - [ openssl-md5 checksum-file hex-string ] + [ md5 checksum-file hex-string ] [ download-checksums at ] bi = not ] [ drop t ] if ; From ddd28c7d12fff8bf6ed4fa757e63c9eb24f9247c Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:44:06 -0600 Subject: [PATCH 13/40] Fix Win64 type issue --- vm/math.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vm/math.c b/vm/math.c index 388a472f2e..c6b91bc8f7 100644 --- a/vm/math.c +++ b/vm/math.c @@ -109,7 +109,7 @@ void primitive_fixnum_shift(void) } else if(y < WORD_SIZE - TAG_BITS) { - F_FIXNUM mask = -(1L << (WORD_SIZE - 1 - TAG_BITS - y)); + F_FIXNUM mask = -((F_FIXNUM)1 << (WORD_SIZE - 1 - TAG_BITS - y)); if((x > 0 && (x & mask) == 0) || (x & mask) == mask) { dpush(tag_fixnum(x << y)); From a9a28a3231e08a5eff92e0ad033d1d70a02c3b48 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 20:28:52 -0600 Subject: [PATCH 14/40] Trying to blindly fix Win64 unit tests --- basis/html/templates/fhtml/fhtml-tests.factor | 6 ++++-- core/io/io-tests.factor | 7 ++++++- core/io/test/separator-test.txt | 1 - extra/benchmark/regex-dna/regex-dna-tests.factor | 6 +++--- extra/contributors/contributors.factor | 2 +- extra/mason/child/child-tests.factor | 6 +++--- 6 files changed, 17 insertions(+), 11 deletions(-) delete mode 100644 core/io/test/separator-test.txt diff --git a/basis/html/templates/fhtml/fhtml-tests.factor b/basis/html/templates/fhtml/fhtml-tests.factor index b863087a92..d314a60124 100644 --- a/basis/html/templates/fhtml/fhtml-tests.factor +++ b/basis/html/templates/fhtml/fhtml-tests.factor @@ -1,6 +1,6 @@ USING: io io.files io.streams.string io.encodings.utf8 html.templates html.templates.fhtml kernel -tools.test sequences parser ; +tools.test sequences parser splitting prettyprint ; IN: html.templates.fhtml.tests : test-template ( path -- ? ) @@ -8,8 +8,10 @@ IN: html.templates.fhtml.tests prepend [ ".fhtml" append [ call-template ] with-string-writer + lines ] keep - ".html" append utf8 file-contents = ; + ".html" append utf8 file-lines + [ . . ] [ = ] 2bi ; [ t ] [ "example" test-template ] unit-test [ t ] [ "bug" test-template ] unit-test diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index c38a7c9ebc..18cde1a35c 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -25,6 +25,11 @@ IN: io.tests ! Make sure we use correct to_c_string form when writing [ ] [ "\0" write ] unit-test +[ ] [ + "It seems Jobs has lost his grasp on reality again.\n" + "separator-test.txt" temp-file latin1 set-file-contents +] unit-test + [ { { "It seems " CHAR: J } @@ -33,7 +38,7 @@ IN: io.tests } ] [ [ - "resource:core/io/test/separator-test.txt" + "separator-test.txt" temp-file latin1 [ "J" read-until 2array , "i" read-until 2array , diff --git a/core/io/test/separator-test.txt b/core/io/test/separator-test.txt deleted file mode 100644 index c3568f6ea0..0000000000 --- a/core/io/test/separator-test.txt +++ /dev/null @@ -1 +0,0 @@ -It seems Jobs has lost his grasp on reality again. diff --git a/extra/benchmark/regex-dna/regex-dna-tests.factor b/extra/benchmark/regex-dna/regex-dna-tests.factor index f1d4b7f627..79765849b5 100644 --- a/extra/benchmark/regex-dna/regex-dna-tests.factor +++ b/extra/benchmark/regex-dna/regex-dna-tests.factor @@ -1,10 +1,10 @@ USING: benchmark.regex-dna io io.files io.encodings.ascii -io.streams.string kernel tools.test ; +io.streams.string kernel tools.test splitting ; IN: benchmark.regex-dna.tests [ t ] [ "resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" - [ regex-dna ] with-string-writer + [ regex-dna ] with-string-writer string-lines "resource:extra/benchmark/regex-dna/regex-dna-test-out.txt" - ascii file-contents = + ascii file-lines = ] unit-test diff --git a/extra/contributors/contributors.factor b/extra/contributors/contributors.factor index 9f2d5a55fa..f6fcac5297 100755 --- a/extra/contributors/contributors.factor +++ b/extra/contributors/contributors.factor @@ -7,7 +7,7 @@ IN: contributors : changelog ( -- authors ) image parent-directory [ - "git-log --pretty=format:%an" ascii lines + "git log --pretty=format:%an" ascii lines ] with-directory ; : patch-counts ( authors -- assoc ) diff --git a/extra/mason/child/child-tests.factor b/extra/mason/child/child-tests.factor index 7913d05b26..104360e1fa 100644 --- a/extra/mason/child/child-tests.factor +++ b/extra/mason/child/child-tests.factor @@ -1,7 +1,7 @@ IN: mason.child.tests USING: mason.child mason.config tools.test namespaces ; -[ { "make" "clean" "winnt-x86-32" } ] [ +[ { "make" "winnt-x86-32" } ] [ [ "winnt" target-os set "x86.32" target-cpu set @@ -9,7 +9,7 @@ USING: mason.child mason.config tools.test namespaces ; ] with-scope ] unit-test -[ { "make" "clean" "macosx-x86-32" } ] [ +[ { "make" "macosx-x86-32" } ] [ [ "macosx" target-os set "x86.32" target-cpu set @@ -17,7 +17,7 @@ USING: mason.child mason.config tools.test namespaces ; ] with-scope ] unit-test -[ { "gmake" "clean" "netbsd-ppc" } ] [ +[ { "gmake" "netbsd-ppc" } ] [ [ "netbsd" target-os set "ppc" target-cpu set From 116ad2f04b4905952d2747d1841dc408a28f1eac Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Mon, 17 Nov 2008 20:40:53 -0600 Subject: [PATCH 15/40] Fix compile errors in hardware-info.windows --- extra/hardware-info/windows/windows.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/hardware-info/windows/windows.factor b/extra/hardware-info/windows/windows.factor index 3162496974..3aa6824ff6 100755 --- a/extra/hardware-info/windows/windows.factor +++ b/extra/hardware-info/windows/windows.factor @@ -18,7 +18,7 @@ IN: hardware-info.windows : processor-architecture ( -- n ) system-info SYSTEM_INFO-dwOemId HEX: ffff0000 bitand ; -: os-version +: os-version ( -- os-version ) "OSVERSIONINFO" "OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize [ GetVersionEx ] keep swap zero? [ win32-error ] when ; @@ -67,4 +67,4 @@ IN: hardware-info.windows { { [ os wince? ] [ "hardware-info.windows.ce" ] } { [ os winnt? ] [ "hardware-info.windows.nt" ] } -} cond [ require ] when* >> +} cond require >> From b0821229a1debae326f568c108e90541bda7eb23 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 18 Nov 2008 03:47:13 +0100 Subject: [PATCH 16/40] Emacs factor mode: indentation improvements. --- misc/factor.el | 107 +++++++++++++++++++++++++++++++------------------ 1 file changed, 67 insertions(+), 40 deletions(-) diff --git a/misc/factor.el b/misc/factor.el index 393ed26ae0..6204bdbef6 100644 --- a/misc/factor.el +++ b/misc/factor.el @@ -317,10 +317,9 @@ value from the existing code in the buffer." ;;; Factor mode indentation: -(defvar factor-indent-width factor-default-indent-width - "Indentation width in factor buffers. A local variable.") - -(make-variable-buffer-local 'factor-indent-width) +(make-variable-buffer-local + (defvar factor-indent-width factor-default-indent-width + "Indentation width in factor buffers. A local variable.")) (defconst factor--regexp-word-start (let ((sws '("" ":" "TUPLE" "MACRO" "MACRO:" "M"))) @@ -340,45 +339,67 @@ value from the existing code in the buffer." (setq iw (current-indentation)))))) iw)) -(defun factor--brackets-depth () - "Returns number of brackets, not closed on previous lines." - (syntax-ppss-depth - (save-excursion - (syntax-ppss (line-beginning-position))))) +(defsubst factor--ppss-brackets-depth () + (nth 0 (syntax-ppss))) + +(defsubst factor--ppss-brackets-start () + (nth 1 (syntax-ppss))) + +(defsubst factor--line-indent (pos) + (save-excursion (goto-char pos) (current-indentation))) + +(defconst factor--regex-closing-paren "[])}]") +(defsubst factor--at-closing-paren-p () + (looking-at factor--regex-closing-paren)) + +(defsubst factor--at-first-char-p () + (= (- (point) (line-beginning-position)) (current-indentation))) + +(defconst factor--regex-single-liner + (format "^%s" (regexp-opt '("USE:" "IN:" "PRIVATE>" " (factor--ppss-brackets-depth) 0)) + (let ((op (factor--ppss-brackets-start))) + (when (> (line-number-at-pos) (line-number-at-pos op)) + (if (factor--at-closing-paren-p) + (factor--line-indent op) + (+ (factor--line-indent op) factor-indent-width))))))) + +(defun factor--indent-definition () + (save-excursion + (beginning-of-line) + (when (looking-at "\\([^ ]\\|^\\)+:") 0))) + +(defun factor--indent-continuation () + (save-excursion + (forward-line -1) + (beginning-of-line) + (if (bobp) 0 + (if (looking-at "^[ \t]*$") + (factor--indent-continuation) + (if (factor--at-end-of-def) + (- (current-indentation) factor-indent-width) + (if (factor--indent-definition) + (+ (current-indentation) factor-indent-width) + (current-indentation))))))) (defun factor--calculate-indentation () "Calculate Factor indentation for line at point." - (let ((not-indented t) - (cur-indent 0)) - (save-excursion - (beginning-of-line) - (if (bobp) - (setq cur-indent 0) - (save-excursion - (while not-indented - ;; Check that we are inside open brackets - (save-excursion - (let ((cur-depth (factor--brackets-depth))) - (forward-line -1) - (setq cur-indent (+ (current-indentation) - (* factor-indent-width - (- cur-depth (factor--brackets-depth))))) - (setq not-indented nil))) - (forward-line -1) - ;; Check that we are after the end of previous word - (if (looking-at ".*;[ \t]*$") - (progn - (setq cur-indent (- (current-indentation) factor-indent-width)) - (setq not-indented nil)) - ;; Check that we are after the start of word - (if (looking-at factor--regexp-word-start) - (progn - (message "inword") - (setq cur-indent (+ (current-indentation) factor-indent-width)) - (setq not-indented nil)) - (if (bobp) - (setq not-indented nil)))))))) - cur-indent)) + (or (and (bobp) 0) + (factor--indent-definition) + (factor--indent-in-brackets) + (factor--indent-continuation) + 0)) (defun factor-indent-line () "Indent current line as Factor code" @@ -420,11 +441,15 @@ value from the existing code in the buffer." ;;; Factor listener mode +;;;###autoload (define-derived-mode factor-listener-mode comint-mode "Factor Listener") (define-key factor-listener-mode-map [f8] 'factor-refresh-all) +;;;###autoload (defun run-factor () + "Start a factor listener inside emacs, or switch to it if it +already exists." (interactive) (switch-to-buffer (make-comint-in-buffer "factor" nil (expand-file-name factor-binary) nil @@ -433,6 +458,8 @@ value from the existing code in the buffer." (factor-listener-mode)) (defun factor-refresh-all () + "Reload source files and documentation for all loaded +vocabularies which have been modified on disk." (interactive) (comint-send-string "*factor*" "refresh-all\n")) From 5697b75394ca218ed6041b3a4411d19dfddb9d46 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 20:48:02 -0600 Subject: [PATCH 17/40] Fix user-admin/new-user template --- extra/webapps/user-admin/new-user.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/user-admin/new-user.xml b/extra/webapps/user-admin/new-user.xml index 313c8e2702..0820dbcb64 100644 --- a/extra/webapps/user-admin/new-user.xml +++ b/extra/webapps/user-admin/new-user.xml @@ -37,7 +37,7 @@ Capabilities: -

    • +
    From d6dd9ea2a31bda9e6d6613945883e2f88cdcef5d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 21:21:57 -0600 Subject: [PATCH 18/40] Add workaround for Windows bttray.exe issue --- vm/os-windows-nt.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/vm/os-windows-nt.c b/vm/os-windows-nt.c index 54afd1c147..e22ea1446b 100755 --- a/vm/os-windows-nt.c +++ b/vm/os-windows-nt.c @@ -29,7 +29,13 @@ long exception_handler(PEXCEPTION_POINTERS pe) signal_number = ERROR_DIVIDE_BY_ZERO; c->EIP = (CELL)divide_by_zero_signal_handler_impl; } - else + /* If the Widcomm bluetooth stack is installed, the BTTray.exe process + injects code into running programs. For some reason this results in + random SEH exceptions with this (undocumented) exception code being + raised. The workaround seems to be ignoring this altogether, since that + is what happens if SEH is not enabled. Don't really have any idea what + this exception means. */ + else if(e->ExceptionCode != 0x40010006) { signal_number = 11; c->EIP = (CELL)misc_signal_handler_impl; From 930f3d0edc786e42c23ff352722f0d452b33e7a7 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 17 Nov 2008 21:26:16 -0600 Subject: [PATCH 19/40] locals: Allow 'local-reader' in literals --- basis/locals/locals.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index e74ecf3dc9..7de9d10436 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -229,6 +229,8 @@ M: tuple rewrite-element M: local rewrite-element , ; +M: local-reader rewrite-element , ; + M: word rewrite-element literalize , ; M: object rewrite-element , ; From 5c51d9fd2cef229c4a729e4e54e8328688187981 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 21:42:59 -0600 Subject: [PATCH 20/40] Get regexp words to infer --- basis/regexp/parser/parser.factor | 2 +- basis/regexp/regexp-tests.factor | 3 +++ basis/regexp/traversal/traversal.factor | 3 ++- basis/regexp/utils/utils-tests.factor | 4 ++++ basis/regexp/utils/utils.factor | 4 +--- 5 files changed, 11 insertions(+), 5 deletions(-) create mode 100644 basis/regexp/utils/utils-tests.factor diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor index d04016b93a..b7716d8580 100644 --- a/basis/regexp/parser/parser.factor +++ b/basis/regexp/parser/parser.factor @@ -137,7 +137,7 @@ ERROR: bad-special-group string ; DEFER: (parse-regexp) : nested-parse-regexp ( token ? -- ) [ push-stack (parse-regexp) pop-stack ] dip - [ ] when pop-stack boa push-stack ; + [ ] when pop-stack new swap >>term push-stack ; ! non-capturing groups : (parse-special-group) ( -- ) diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor index 2339628801..2a6c0dc16f 100644 --- a/basis/regexp/regexp-tests.factor +++ b/basis/regexp/regexp-tests.factor @@ -2,6 +2,9 @@ USING: regexp tools.test kernel sequences regexp.parser regexp.traversal eval ; IN: regexp-tests +\ must-infer +\ matches? must-infer + [ f ] [ "b" "a*" matches? ] unit-test [ t ] [ "" "a*" matches? ] unit-test [ t ] [ "a" "a*" matches? ] unit-test diff --git a/basis/regexp/traversal/traversal.factor b/basis/regexp/traversal/traversal.factor index 91c7ce16dc..c9e8a54348 100644 --- a/basis/regexp/traversal/traversal.factor +++ b/basis/regexp/traversal/traversal.factor @@ -107,7 +107,8 @@ M: capture-group-off flag-action ( dfa-traverser flag -- ) : increment-state ( dfa-traverser state -- dfa-traverser ) [ dup traverse-forward>> - [ 1+ ] [ 1- ] ? change-current-index + [ [ 1+ ] change-current-index ] + [ [ 1- ] change-current-index ] if dup current-state>> >>last-state ] dip first >>current-state ; diff --git a/basis/regexp/utils/utils-tests.factor b/basis/regexp/utils/utils-tests.factor new file mode 100644 index 0000000000..d048ad4be1 --- /dev/null +++ b/basis/regexp/utils/utils-tests.factor @@ -0,0 +1,4 @@ +USING: regexp.utils tools.test ; +IN: regexp.utils.tests + +[ [ ] [ ] while-changes ] must-infer diff --git a/basis/regexp/utils/utils.factor b/basis/regexp/utils/utils.factor index fb058ecf92..5116dd2b7e 100644 --- a/basis/regexp/utils/utils.factor +++ b/basis/regexp/utils/utils.factor @@ -5,9 +5,7 @@ namespaces regexp.backend sequences unicode.categories math.ranges fry combinators.short-circuit vectors ; IN: regexp.utils -: (while-changes) ( obj quot pred pred-ret -- obj ) - ! quot: ( obj -- obj' ) - ! pred: ( obj -- <=> ) +: (while-changes) ( obj quot: ( obj -- obj' ) pred: ( obj -- <=> ) pred-ret -- obj ) [ [ dup slip ] dip pick over call ] dip dupd = [ 3drop ] [ (while-changes) ] if ; inline recursive From b3e63a2b1a67458670a0e1aed0c583216dac0d23 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 21:45:23 -0600 Subject: [PATCH 21/40] Fix gradient in slides --- extra/galois-talk/authors.txt | 1 + extra/galois-talk/summary.txt | 1 + extra/galois-talk/tags.txt | 1 + extra/google-tech-talk/authors.txt | 1 + extra/google-tech-talk/summary.txt | 1 + extra/google-tech-talk/tags.txt | 1 + extra/slides/slides.factor | 12 +++++------- extra/vpri-talk/authors.txt | 1 + extra/vpri-talk/summary.txt | 1 + extra/vpri-talk/tags.txt | 1 + 10 files changed, 14 insertions(+), 7 deletions(-) create mode 100644 extra/galois-talk/authors.txt create mode 100644 extra/galois-talk/summary.txt create mode 100644 extra/galois-talk/tags.txt create mode 100644 extra/google-tech-talk/authors.txt create mode 100644 extra/google-tech-talk/summary.txt create mode 100644 extra/google-tech-talk/tags.txt create mode 100644 extra/vpri-talk/authors.txt create mode 100644 extra/vpri-talk/summary.txt create mode 100644 extra/vpri-talk/tags.txt diff --git a/extra/galois-talk/authors.txt b/extra/galois-talk/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/galois-talk/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/galois-talk/summary.txt b/extra/galois-talk/summary.txt new file mode 100644 index 0000000000..00f30acf8d --- /dev/null +++ b/extra/galois-talk/summary.txt @@ -0,0 +1 @@ +Slides from a talk at Galois by Slava Pestov, October 2008 diff --git a/extra/galois-talk/tags.txt b/extra/galois-talk/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/galois-talk/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/google-tech-talk/authors.txt b/extra/google-tech-talk/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/google-tech-talk/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/google-tech-talk/summary.txt b/extra/google-tech-talk/summary.txt new file mode 100644 index 0000000000..1747a569c9 --- /dev/null +++ b/extra/google-tech-talk/summary.txt @@ -0,0 +1 @@ +Slides from Google Tech Talk by Slava Pestov, October 2008 diff --git a/extra/google-tech-talk/tags.txt b/extra/google-tech-talk/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/google-tech-talk/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor index 2940bcbfcb..dc8bdd4576 100755 --- a/extra/slides/slides.factor +++ b/extra/slides/slides.factor @@ -48,19 +48,17 @@ IN: slides : $divider ( -- ) [ - T{ gradient f - { - T{ rgba f 0.25 0.25 0.25 1.0 } - T{ rgba f 1.0 1.0 1.0 0.0 } - } - } >>interior + { + T{ rgba f 0.25 0.25 0.25 1.0 } + T{ rgba f 1.0 1.0 1.0 0.0 } + } >>interior { 800 10 } >>dim { 1 0 } >>orientation gadget. ] ($block) ; : page-theme ( gadget -- ) - T{ gradient f { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } } + { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } >>interior drop ; : ( list -- gadget ) diff --git a/extra/vpri-talk/authors.txt b/extra/vpri-talk/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/vpri-talk/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/vpri-talk/summary.txt b/extra/vpri-talk/summary.txt new file mode 100644 index 0000000000..1ebcc4b114 --- /dev/null +++ b/extra/vpri-talk/summary.txt @@ -0,0 +1 @@ +Slides from a talk at VPRI by Slava Pestov, October 2008 diff --git a/extra/vpri-talk/tags.txt b/extra/vpri-talk/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/vpri-talk/tags.txt @@ -0,0 +1 @@ +demos From 1fa0fb6258bc39e8e5d145f2b6c0a9d2a9984381 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 21:53:38 -0600 Subject: [PATCH 22/40] Add unit test for Ed's fix --- basis/locals/locals-tests.factor | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index 003ef459e3..ca6697be1c 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -346,7 +346,6 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; { 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as - :: literal-identity-test ( -- a b ) { } V{ } ; @@ -356,6 +355,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; swapd [ eq? ] [ eq? ] 2bi* ] unit-test +:: mutable-local-in-literal-test ( a! -- b ) a 1 + a! { a } ; + +[ { 4 } ] [ 3 mutable-local-in-literal-test ] unit-test + :: compare-case ( obj1 obj2 lt-quot eq-quot gt-quot -- ) obj1 obj2 <=> { { +lt+ [ lt-quot call ] } From 4df50bc6411f1bd11dadccad4430d721f2dd2ac5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 21:56:59 -0600 Subject: [PATCH 23/40] Fix benchmark.regex-dna --- extra/benchmark/regex-dna/regex-dna-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/benchmark/regex-dna/regex-dna-tests.factor b/extra/benchmark/regex-dna/regex-dna-tests.factor index 79765849b5..9f64d438c7 100644 --- a/extra/benchmark/regex-dna/regex-dna-tests.factor +++ b/extra/benchmark/regex-dna/regex-dna-tests.factor @@ -4,7 +4,7 @@ IN: benchmark.regex-dna.tests [ t ] [ "resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" - [ regex-dna ] with-string-writer string-lines + [ regex-dna ] with-string-writer lines "resource:extra/benchmark/regex-dna/regex-dna-test-out.txt" ascii file-lines = ] unit-test From 91df21a8cfc0bd50a02e63038dd1388e17d67dd3 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 17 Nov 2008 21:57:46 -0600 Subject: [PATCH 24/40] boids: Fix indendation --- extra/boids/boids.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index 193582524c..9956df9982 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -83,7 +83,7 @@ VAR: separation-radius : relative-position ( self other -- v ) swap [ pos>> ] bi@ v- ; : relative-angle ( self other -- angle ) -over vel>> -rot relative-position angle-between ; + over vel>> -rot relative-position angle-between ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 79b80baae826f1f4fbeffe88ca371a656132351e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 18 Nov 2008 01:10:00 -0600 Subject: [PATCH 25/40] remove storing the user in ftp server --- extra/ftp/server/server.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/ftp/server/server.factor b/extra/ftp/server/server.factor index f8ab04ed00..c5c854ba92 100644 --- a/extra/ftp/server/server.factor +++ b/extra/ftp/server/server.factor @@ -75,7 +75,7 @@ C: ftp-list : handle-USER ( ftp-command -- ) [ - tokenized>> second client get (>>user) + drop 331 "Please specify the password." server-response ] [ 2drop "bad USER" ftp-error From bb3fee58e390a81cb734ff2bd8bbd3cb247b2302 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 18 Nov 2008 01:38:29 -0600 Subject: [PATCH 26/40] update.latest: Use 'http' protocol for git commands (git daemon on factorcode.org is flakey lately) --- extra/update/latest/latest.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/update/latest/latest.factor b/extra/update/latest/latest.factor index 7cc2fac853..9546379223 100644 --- a/extra/update/latest/latest.factor +++ b/extra/update/latest/latest.factor @@ -9,7 +9,7 @@ IN: update.latest : git-pull-master ( -- ) image parent-directory [ - { "git" "pull" "git://factorcode.org/git/factor.git" "master" } + { "git" "pull" "http://factorcode.org/git/factor.git" "master" } run-command ] with-directory ; From a79107695ebd0ef0420d2a04463527089ee8dbca Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 18 Nov 2008 08:57:20 -0600 Subject: [PATCH 27/40] boids: more indentation fixes --- extra/boids/boids.factor | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index 9956df9982..3d4cd392ca 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -189,13 +189,12 @@ boids> [ within-alignment-neighborhood? ] with filter ; : above? ( n a b -- ? ) nip > ; : wrap ( n a b -- n ) -{ { [ 3dup below? ] - [ 2nip ] } - { [ 3dup above? ] - [ drop nip ] } - { [ t ] - [ 2drop ] } } -cond ; + { + { [ 3dup below? ] [ 2nip ] } + { [ 3dup above? ] [ drop nip ] } + { [ t ] [ 2drop ] } + } + cond ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From f44d8f4cf51b7073fd3eb99de4f21291ef079f5c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 11:45:55 -0600 Subject: [PATCH 28/40] Fix combinators so that directory. can infer on Unix --- basis/unix/groups/groups.factor | 6 ++++-- basis/unix/users/users.factor | 6 ++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index b8edf7fa36..177949aec9 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -76,9 +76,11 @@ M: integer user-groups ( id -- seq ) : all-groups ( -- seq ) [ getgrent dup ] [ group-struct>group ] [ drop ] produce ; +: ( -- assoc ) + all-groups [ [ id>> ] keep ] H{ } map>assoc ; + : with-group-cache ( quot -- ) - all-groups [ [ id>> ] keep ] H{ } map>assoc - group-cache rot with-variable ; inline + [ group-cache ] dip with-variable ; inline : real-group-id ( -- id ) getgid ; inline diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor index f76fbd5388..8487d5adf2 100644 --- a/basis/unix/users/users.factor +++ b/basis/unix/users/users.factor @@ -41,9 +41,11 @@ PRIVATE> SYMBOL: user-cache +: ( -- assoc ) + all-users [ [ uid>> ] keep ] H{ } map>assoc ; + : with-user-cache ( quot -- ) - all-users [ [ uid>> ] keep ] H{ } map>assoc - user-cache rot with-variable ; inline + [ user-cache ] dip with-variable ; inline GENERIC: user-passwd ( obj -- passwd ) From bec8cc423939ef5184700def9959e41c7c6a1e83 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 11:46:51 -0600 Subject: [PATCH 29/40] Add unit test to assert that directory. can infeR --- basis/io/files/listing/listing-tests.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/basis/io/files/listing/listing-tests.factor b/basis/io/files/listing/listing-tests.factor index a2347c8db9..8c2dc28559 100644 --- a/basis/io/files/listing/listing-tests.factor +++ b/basis/io/files/listing/listing-tests.factor @@ -3,4 +3,6 @@ USING: tools.test io.files.listing strings kernel ; IN: io.files.listing.tests +\ directory. must-infer + [ ] [ "" directory. ] unit-test From b609ca7d01a07425dcb84b6669f93f7ac5529886 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 11:48:06 -0600 Subject: [PATCH 30/40] Tweak gl-rect to generate the correct output on Windows with Intel graphics --- basis/opengl/opengl.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index aec7960857..21fe663c44 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -72,9 +72,9 @@ MACRO: all-enabled-client-state ( seq quot -- ) : (rect-vertices) ( dim -- vertices ) { [ drop 0.5 0.5 ] - [ first 0.5 - 0.5 ] - [ [ first 0.5 - ] [ second 0.5 - ] bi ] - [ second 0.5 - 0.5 swap ] + [ first 0.3 - 0.5 ] + [ [ first 0.3 - ] [ second 0.3 - ] bi ] + [ second 0.3 - 0.5 swap ] } cleave 8 narray >c-float-array ; : rect-vertices ( dim -- ) From f8a6e3b0d8148a605d8bd2b48eb0369fbb5434d7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 11:50:02 -0600 Subject: [PATCH 31/40] Don't use the obscure CLEAR key --- basis/ui/tools/listener/listener.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 68bf765295..d842bf8a68 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -181,8 +181,8 @@ M: stack-display tool-scroller listener-gadget "toolbar" f { { f restart-listener } - { T{ key-down f f "CLEAR" } clear-output } - { T{ key-down f { C+ } "CLEAR" } clear-stack } + { T{ key-down f { A+ } "c" } clear-output } + { T{ key-down f { A+ } "C" } clear-stack } { T{ key-down f { C+ } "d" } com-end } { T{ key-down f f "F1" } listener-help } } define-command-map From 0a124677675d849f384752a5118e23dff4aa3350 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 18 Nov 2008 13:31:43 -0600 Subject: [PATCH 32/40] fix compile errors in ftp.server --- extra/ftp/server/server.factor | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/extra/ftp/server/server.factor b/extra/ftp/server/server.factor index c5c854ba92..9095dedf35 100644 --- a/extra/ftp/server/server.factor +++ b/extra/ftp/server/server.factor @@ -7,10 +7,11 @@ namespaces make sequences ftp io.unix.launcher.parser unicode.case splitting assocs classes io.servers.connection destructors calendar io.timeouts io.streams.duplex threads continuations math concurrency.promises byte-arrays -io.backend sequences.lib tools.hexdump io.files.listing ; +io.backend sequences.lib tools.hexdump io.files.listing +io.streams.string ; IN: ftp.server -TUPLE: ftp-client url mode state command-promise ; +TUPLE: ftp-client url mode state command-promise user password ; : ( url -- ftp-client ) ftp-client new @@ -75,7 +76,7 @@ C: ftp-list : handle-USER ( ftp-command -- ) [ - drop + tokenized>> second client get (>>user) 331 "Please specify the password." server-response ] [ 2drop "bad USER" ftp-error @@ -140,16 +141,16 @@ ERROR: type-error type ; 150 "Here comes the directory listing." server-response ; : finish-directory ( -- ) - 226 "Opening " server-response ; + 226 "Directory send OK." server-response ; GENERIC: service-command ( stream obj -- ) M: ftp-list service-command ( stream obj -- ) drop - start-directory - [ + start-directory [ utf8 encode-output - directory. [ ftp-send ] each + [ current-directory get directory. ] with-string-writer string-lines + harvest [ ftp-send ] each ] with-output-stream finish-directory ; From 054dce145ccc6e06285e0dd6c9ca0a3b15baf56d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 18 Nov 2008 14:00:27 -0600 Subject: [PATCH 33/40] fix polynomial help lint --- extra/math/polynomials/polynomials-docs.factor | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/extra/math/polynomials/polynomials-docs.factor b/extra/math/polynomials/polynomials-docs.factor index 08b7ca7c4d..f97ae308e1 100644 --- a/extra/math/polynomials/polynomials-docs.factor +++ b/extra/math/polynomials/polynomials-docs.factor @@ -40,7 +40,7 @@ HELP: ptrim HELP: 2ptrim { $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } { $description "Trims excess zeros from two polynomials." } -{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim swap . ." "{ 0 1 }\n{ 1 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim swap . ." "{ 0 1 }\n{ 1 }" } } ; HELP: p+ { $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } @@ -60,7 +60,7 @@ HELP: n*p HELP: pextend-conv { $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } { $description "Convulution, extending to " { $snippet "p_m + q_n - 1" } "." } -{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv swap . ." "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv swap . ." "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ; HELP: p* { $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } @@ -75,13 +75,18 @@ HELP: p-sq HELP: p/mod { $values { "p" "a polynomial" } { "q" "a polynomial" } { "z" "a polynomial" } { "w" "a polynomial" } } { $description "Computes to quotient " { $snippet "z" } " and remainder " { $snippet "w" } " of dividing " { $snippet "p" } " by " { $snippet "q" } "." } -{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod swap . ." "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod swap . ." "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ; HELP: pgcd { $values { "p" "a polynomial" } { "q" "a polynomial" } { "a" "a polynomial" } { "d" "a polynomial" } } { $description "Computes the greatest common divisor " { $snippet "d" } " of " { $snippet "p" } " and " { $snippet "q" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*q = d mod p" } } { $notes "GCD in the case of polynomials is a monic polynomial of the highest possible degree that divides into both " { $snippet "p" } " and " { $snippet "q" } "." } -{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1} { 1 1 } pgcd swap . ." "{ 0 0 }\n{ 1 1 }" } } ; +{ $examples + { $example "USING: kernel math.polynomials prettyprint ;" + "{ 1 1 1 1 } { 1 1 } pgcd [ . ] bi@" + "{ 0 0 }\n{ 1 1 }" + } +} ; HELP: pdiff { $values { "p" "a polynomial" } { "p'" "a polynomial" } } From 46e7978371b97f000bd1e866b032228b1cc186d9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 18 Nov 2008 14:00:43 -0600 Subject: [PATCH 34/40] fix typo --- basis/furnace/furnace-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/furnace/furnace-docs.factor b/basis/furnace/furnace-docs.factor index b86d4c3295..911433d100 100644 --- a/basis/furnace/furnace-docs.factor +++ b/basis/furnace/furnace-docs.factor @@ -97,7 +97,7 @@ HELP: with-exit-continuation { $notes "Furnace actions and authentication realms wrap their execution in this combinator, allowing form validation failures and login requests, respectively, to immediately return an HTTP response to the client without running any more responder code." } ; ARTICLE: "furnace.extension-points" "Furnace extension points" -"Furnace features such as session management, conversation scope and asides need to modify URLs in links and redirects, and insert hidden form fields, to implement state on top of the setateless HTTP protocol. In order to decouple the server-side state management code from the HTML templating code, a series of hooks are used." +"Furnace features such as session management, conversation scope and asides need to modify URLs in links and redirects, and insert hidden form fields, to implement state on top of the stateless HTTP protocol. In order to decouple the server-side state management code from the HTML templating code, a series of hooks are used." $nl "Responders can implement methods on the following generic words:" { $subsection modify-query } From cba8f2a8605eec3a0f743f442870929602957433 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 18 Nov 2008 14:09:50 -0600 Subject: [PATCH 35/40] swap . . -> [ . ] bi@ --- extra/math/polynomials/polynomials-docs.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/math/polynomials/polynomials-docs.factor b/extra/math/polynomials/polynomials-docs.factor index f97ae308e1..edffa5377d 100644 --- a/extra/math/polynomials/polynomials-docs.factor +++ b/extra/math/polynomials/polynomials-docs.factor @@ -40,7 +40,7 @@ HELP: ptrim HELP: 2ptrim { $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } { $description "Trims excess zeros from two polynomials." } -{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim swap . ." "{ 0 1 }\n{ 1 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim [ . ] bi@" "{ 0 1 }\n{ 1 }" } } ; HELP: p+ { $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } @@ -60,7 +60,7 @@ HELP: n*p HELP: pextend-conv { $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } { $description "Convulution, extending to " { $snippet "p_m + q_n - 1" } "." } -{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv swap . ." "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv [ . ] bi@" "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ; HELP: p* { $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } @@ -75,7 +75,7 @@ HELP: p-sq HELP: p/mod { $values { "p" "a polynomial" } { "q" "a polynomial" } { "z" "a polynomial" } { "w" "a polynomial" } } { $description "Computes to quotient " { $snippet "z" } " and remainder " { $snippet "w" } " of dividing " { $snippet "p" } " by " { $snippet "q" } "." } -{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod swap . ." "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod [ . ] bi@" "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ; HELP: pgcd { $values { "p" "a polynomial" } { "q" "a polynomial" } { "a" "a polynomial" } { "d" "a polynomial" } } From aee589190b1e8911eda3565d0086ff721bd388e2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 14:10:21 -0600 Subject: [PATCH 36/40] Add signed-le> and signed-be> wordS --- basis/math/bitwise/bitwise.factor | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor index ad1907fcb0..afd83d4458 100644 --- a/basis/math/bitwise/bitwise.factor +++ b/basis/math/bitwise/bitwise.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel math math.functions sequences sequences.private words namespaces macros hints -combinators fry ; +combinators fry io.binary ; IN: math.bitwise ! utilities @@ -93,3 +93,11 @@ PRIVATE> : bit-count ( x -- n ) dup 0 < [ bitnot ] when (bit-count) ; inline + +! Signed byte array to integer conversion +: signed-le> ( bytes -- x ) + [ le> ] [ length 8 * 1- on-bits ] bi + 2dup > [ bitnot bitor ] [ drop ] if ; + +: signed-be> ( bytes -- x ) + signed-le> ; From f32908f502ebb82a1d807e6bb5ba19a65f87348f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 14:10:31 -0600 Subject: [PATCH 37/40] Fix load-bitmap to work with negative height --- extra/graphics/bitmap/bitmap.factor | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index 4d83300934..4c35e3d7d0 100755 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien arrays byte-arrays combinators summary -io.backend graphics.viewer io io.binary io.files kernel libc -math math.functions namespaces opengl opengl.gl prettyprint -sequences strings ui ui.gadgets.panes io.encodings.binary -accessors grouping ; +USING: alien arrays byte-arrays combinators summary io.backend +graphics.viewer io io.binary io.files kernel libc math +math.functions math.bitwise namespaces opengl opengl.gl +prettyprint sequences strings ui ui.gadgets.panes +io.encodings.binary accessors grouping ; IN: graphics.bitmap ! Currently can only handle 24bit bitmaps. @@ -56,8 +56,8 @@ M: bitmap-magic summary : parse-bitmap-header ( bitmap -- ) 4 read le> >>header-length - 4 read le> >>width - 4 read le> >>height + 4 read signed-le> >>width + 4 read signed-le> >>height 2 read le> >>planes 2 read le> >>bit-count 4 read le> >>compression From d0e53db5fc9415250170748d01e81fea8c48fb1c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 14:15:38 -0600 Subject: [PATCH 38/40] Rendering tweaks --- basis/opengl/opengl.factor | 3 ++- basis/ui/gadgets/buttons/buttons.factor | 4 ++-- basis/ui/gadgets/editors/editors.factor | 2 +- basis/ui/gadgets/grid-lines/grid-lines.factor | 2 +- 4 files changed, 6 insertions(+), 5 deletions(-) diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 21fe663c44..ecb4c4a08c 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -64,7 +64,8 @@ MACRO: all-enabled-client-state ( seq quot -- ) [ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline : line-vertices ( a b -- ) - append >c-float-array gl-vertex-pointer ; + [ first2 [ 0.5 + ] bi@ ] bi@ 4 narray + >c-float-array gl-vertex-pointer ; : gl-line ( a b -- ) line-vertices GL_LINES 0 2 glDrawArrays ; diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index 11fb69fc7d..c975e64b12 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -111,8 +111,8 @@ TUPLE: checkmark-paint < caching-pen color last-vertices ; : checkmark-points ( dim -- points ) { - [ { 0 0 } v* { 0 1 } v+ ] - [ { 1 1 } v* { 0 1 } v+ ] + [ { 0 0 } v* ] + [ { 1 1 } v* ] [ { 0 1 } v* ] [ { 1 0 } v* ] } cleave 4array ; diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 74647a6afb..2cf6d24154 100644 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -112,7 +112,7 @@ M: editor ungraft* line-height * ; : caret-loc ( editor -- loc ) - [ editor-caret* ] keep 2dup loc>x 1+ + [ editor-caret* ] keep 2dup loc>x rot first rot line>y 2array ; : caret-dim ( editor -- dim ) diff --git a/basis/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor index d7844e3fa3..adfdd16f69 100644 --- a/basis/ui/gadgets/grid-lines/grid-lines.factor +++ b/basis/ui/gadgets/grid-lines/grid-lines.factor @@ -27,7 +27,7 @@ M: grid-lines draw-boundary dup grid set dup rect-dim half-gap v- grid-dim set compute-grid - [ { 1 0 } draw-grid-lines ] + [ { -0.5 -0.5 } gl-translate { 1 0 } draw-grid-lines ] [ { 0.5 -0.5 } gl-translate { 0 1 } draw-grid-lines From 9fb6224e301a7bb2851169057da13e991457d730 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 14:15:48 -0600 Subject: [PATCH 39/40] Add UI render test tool --- extra/ui/render/test/reference.bmp | Bin 0 -> 73554 bytes extra/ui/render/test/reference.bmp.2 | Bin 0 -> 89322 bytes extra/ui/render/test/test.factor | 70 +++++++++++++++++++++++++++ 3 files changed, 70 insertions(+) create mode 100644 extra/ui/render/test/reference.bmp create mode 100644 extra/ui/render/test/reference.bmp.2 create mode 100644 extra/ui/render/test/test.factor diff --git a/extra/ui/render/test/reference.bmp b/extra/ui/render/test/reference.bmp new file mode 100644 index 0000000000000000000000000000000000000000..0740fcc8173f0a6fc4fcfa76802b5146e5a7c59b GIT binary patch literal 73554 zcmeIwu?Ye}7=+RPx-bw-t-u1zO{~HGGvjlWD?&cr!Y&*a&CI($o|kRD=eF*3-S@h$ zb+?xW#gNHaszyq*OiTL2FeZaU0zo?xW#gNH zaszyq*OiTL2FeZaU0zo?xW#gNHaszyq*OiTL O2FeZaU0(OkvwZ-#zpe-X literal 0 HcmV?d00001 diff --git a/extra/ui/render/test/reference.bmp.2 b/extra/ui/render/test/reference.bmp.2 new file mode 100644 index 0000000000000000000000000000000000000000..630563a5c7d6bc7838e122b7207ff3ad83cf5102 GIT binary patch literal 89322 zcmeI5L6X}x5JlzkGP|50XYt-Q$TG_;vd&3nPUpQZp|HhJ`oa(xN@Am7_M0+Hh>!^2 z_kRsQQ!an|{`1c-C;Rz#Dt}Mq$5j5B%9qn0r?1oXpQ-)#-%gh@z5M^@d^*j4?Dctm z!rZi_e)-V(d^%Hx(cltL3o2y@4ZPWyY31)|1uV|SoOir={x*$!#3I^r^gk;Ad)t`k zl{;WB51A!<@9*!YT6ueWtG3lXqxboIUB88G*vrk{;sdUI)aT&-OIz9&eYh_T&q5SJAdv>W7S+^;ibREpL(1Eu-AvL7Duob=l{r_ zVGs5q{g=7#l07~5w{kUY`!UP9my^JfJ@o;6?Z;P3OU-wj_wsNEdwuw7v8VYC_F%8& z725XY754J*rZZ*T+n1wf@)CPab!478?8URkx|fGHohj_Wp8A1$KLub9_WHSvo>YO7 zJw1C^8^vD(_MGa-JoS=2^#R=Zb7vZ>=KPKU_Ta7$cd(a-wQ{Bwd(E|)gW<0af4a}t zSa|7QdVtq43cy|;zFHh)*1eq0kDqnP zo}T-yjpDBX>s~wu5hEzsQy;*cKX<0F<~zP?iJ%~+PuT0jS1XTczJt9O4kCJmJ=lxz z9ewgWXKOv`)yAGPCyA_kta~|~A3tl@gS~hc<{Sa+!Cp@1$IrTCPtP9KM)B8x?>XZ+ zh!{c1p85dp{JArYRdasF5J5pqpRm`5uT~y|y%_ID_X>OQ?CCzAbuXHTe*MEDC!Jw1C^8^vD(_MAN(KTcmId+GzY^XJYqR?Ybx z!#Hesj|BGm@YTv=RraRf&;LW)4p-U3czcTHZ&LvF;@Q)E{@uD~>^0Xt*z-mp?D??wYp_>a4_hBy#wGSP`ULU?%c}(-& zUX0bA1A8A32)hA$uoq^&CaJbUapb3zDv@$9kZggxU>ePFLC{u-#}wR75D_vc)j z)9a(ndXB}-U+M$6yXoSog=$`7?5_XGM0c;39J%rSXdcWu9*d#IThAV=@m=D~b>06@ z=mL8==_}b&AHd!K>)s_ZT6TP~NKVM<^zmj5dwuw7@lF z91-lrv#0xf*vrEq?8URUW!`SaNavIVfDF{?5Pjn&YwHeSo7VZ-<>@A{yE-tKhV-o0od!qS1XTc zzI&9VN8b;7{n+}fC)k6%&pblAj{>k4&mMbDA8(KTRM?AWk3Hw;l=zGf_I?faEKb)l zS>alL;=YfQcl^PUwE2)zwzz4$)d$y@uEm*q>;8X27u8&2 z!N1=d5}Dlw1$*)5J>BQm*xT#=9Pi!i!-HN>0QTb9+p_M#-U}ul^rNr`dxKi@@WX;V z*gL$*2c017!QPKA|Gskptvt2CUH??7?2c9yB>B0DJN5vFCI&_`r{by?FMv>^Ut? z*E0F(T7TmHz;;YEv^Dn33rn$_{8@czU%T@8ZTc-N)y{QG`{fFIhhVg1?=HrgQ>m}7 zH9PC_fj#4Fk0RqdgmDir3D}dpocJ>;2i>tZz<8o`$kOjlnRSos%rmA{&eM1Q0k)Uf A1ONa4 literal 0 HcmV?d00001 diff --git a/extra/ui/render/test/test.factor b/extra/ui/render/test/test.factor new file mode 100644 index 0000000000..01b5b65bcf --- /dev/null +++ b/extra/ui/render/test/test.factor @@ -0,0 +1,70 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors colors arrays kernel sequences math byte-arrays +namespaces cap graphics.bitmap +ui.gadgets ui.gadgets.packs ui.gadgets.borders ui.gadgets.grids +ui.gadgets.grid-lines ui.gadgets.labels ui.gadgets.buttons +ui.render ui opengl opengl.gl ; +IN: ui.render.test + +SINGLETON: line-test + +M: line-test draw-interior + 2drop { 0 0 } { 0 10 } gl-line ; + +: ( -- gadget ) + + line-test >>interior + { 1 10 } >>dim ; + +TUPLE: ui-render-test < pack { first-time? initial: t } ; + +: message-window ( text -- ) +