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

basis/farkup/farkup.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays combinators html.elements io
 io.streams.string kernel math namespaces peg peg.ebnf
-sequences sequences.deep strings xml.entities xml.interpolate
+sequences sequences.deep strings xml.entities xml.literals
 vectors splitting xmode.code2html urls.encoding xml.data
 xml.writer ;
 IN: farkup

basis/html/components/authors.txt

@@ -1 +1,2 @@
 Slava Pestov
+Daniel Ehrenberg

basis/html/components/components.factor

@@ -1,10 +1,10 @@
-! Copyright (C) 2008 Slava Pestov
+! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces io math.parser assocs classes
 classes.tuple words arrays sequences splitting mirrors
 hashtables combinators continuations math strings inspector
 fry locals calendar calendar.format xml.entities xml.data
-validators urls present xml.writer xml.interpolate xml
+validators urls present xml.writer xml.literals xml
 xmode.code2html lcs.diff2html farkup io.streams.string
 html.elements html.streams html.forms ;
 IN: html.components

basis/html/elements/elements.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io io.styles kernel namespaces prettyprint quotations
 sequences strings words xml.entities compiler.units effects
-xml.data xml.interpolate urls math math.parser combinators
+xml.data xml.literals urls math math.parser combinators
 present fry io.streams.string xml.writer ;
 
 IN: html.elements

basis/lcs/diff2html/diff2html.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: lcs xml.interpolate xml.writer kernel strings ;
+USING: lcs xml.literals xml.writer kernel strings ;
 FROM: accessors => item>> ;
 FROM: io => write ;
 FROM: sequences => each if-empty when-empty map ;

basis/syndication/syndication.factor

@@ -4,7 +4,7 @@
 USING: xml.utilities kernel assocs math.order
     strings sequences xml.data xml.writer
     io.streams.string combinators xml xml.entities.html io.files io
-    http.client namespaces make xml.interpolate hashtables
+    http.client namespaces make xml.literals hashtables
     calendar.format accessors continuations urls present ;
 IN: syndication
 

basis/xml-rpc/xml-rpc.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2005, 2006 Daniel Ehrenberg
+! Copyright (C) 2005, 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel xml arrays math generic http.client
 combinators hashtables namespaces io base64 sequences strings
 calendar xml.data xml.writer xml.utilities assocs math.parser
-debugger calendar.format math.order xml.interpolate xml.dispatch ;
+debugger calendar.format math.order xml.literals xml.dispatch ;
 IN: xml-rpc
 
 ! * Sending RPC requests

basis/xml/autoencoding/autoencoding.factor

@@ -6,11 +6,14 @@ io.encodings.string io.encodings combinators accessors
 xml.data io.encodings.iana ;
 IN: xml.autoencoding
 
+: decode-stream ( encoding -- )
+    spot get [ swap re-decode ] change-stream drop ;
+
 : continue-make-tag ( str -- tag )
     parse-name-starting middle-tag end-tag ;
 
 : start-utf16le ( -- tag )
-    utf16le decode-input
+    utf16le decode-stream
     "?\0" expect
     check instruct ;
 
@@ -22,25 +25,25 @@ IN: xml.autoencoding
     ! that the first letter of the document is < and second is
     ! not ASCII
     ascii?
-    [ utf8 decode-input next make-tag ] [
+    [ utf8 decode-stream next make-tag ] [
         next
         [ get-next 10xxxxxx? not ] take-until
         get-char suffix utf8 decode
-        utf8 decode-input next
+        utf8 decode-stream next
         continue-make-tag
     ] if ;
 
 : prolog-encoding ( prolog -- )
     encoding>> dup "UTF-16" =
-    [ drop ] [ name>encoding [ decode-input ] when* ] if ;
+    [ drop ] [ name>encoding [ decode-stream ] when* ] if ;
 
 : instruct-encoding ( instruct/prolog -- )
     dup prolog?
     [ prolog-encoding ]
-    [ drop utf8 decode-input ] if ;
+    [ drop utf8 decode-stream ] if ;
 
 : go-utf8 ( -- )
-    check utf8 decode-input next next ;
+    check utf8 decode-stream next next ;
 
 : start< ( -- tag )
     ! What if first letter of processing instruction is non-ASCII?
@@ -52,11 +55,11 @@ IN: xml.autoencoding
     } case ;
 
 : skip-utf8-bom ( -- tag )
-    "\u0000bb\u0000bf" expect utf8 decode-input
+    "\u0000bb\u0000bf" expect utf8 decode-stream
     "<" expect check make-tag ;
 
 : decode-expecting ( encoding string -- tag )
-    [ decode-input next ] [ expect ] bi* check make-tag ;
+    [ decode-stream next ] [ expect ] bi* check make-tag ;
 
 : start-utf16be ( -- tag )
     utf16be "<" decode-expecting ;
@@ -74,6 +77,6 @@ IN: xml.autoencoding
         { HEX: EF [ skip-utf8-bom ] }
         { HEX: FF [ skip-utf16le-bom ] }
         { HEX: FE [ skip-utf16be-bom ] }
-        [ drop utf8 decode-input check f ]
+        [ drop utf8 decode-stream check f ]
     } case ;
 

basis/xml/char-classes/char-classes.factor

@@ -1,6 +1,7 @@
-! Copyright (C) 2005, 2007 Daniel Ehrenberg
+! Copyright (C) 2005, 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences unicode.syntax math math.order combinators ;
+USING: kernel sequences unicode.syntax math math.order combinators
+hints ;
 IN: xml.char-classes
 
 CATEGORY: 1.0name-start* Ll Lu Lo Lt Nl \u000559\u0006E5\u0006E6_: ;
@@ -31,3 +32,5 @@ CATEGORY: 1.1name-char Ll Lu Lo Lm Ln Nl Mc Mn Nd Pc Cf _-.\u0000b7: ;
         { [ dup HEX: E000 < ] [ drop f ] }
         [ { HEX: FFFE HEX: FFFF } member? not ]
     } cond ;
+
+HINTS: text? { object fixnum } ;

basis/xml/errors/errors-tests.factor

@@ -6,11 +6,11 @@ IN: xml.errors.tests
     '[ _ string>xml ] swap '[ _ = ] must-fail-with ;
 
 T{ no-entity f 1 10 "nbsp" } "<x>&nbsp;</x>" xml-error-test
-T{ mismatched f 1 8 T{ name f "" "x" "" } T{ name f "" "y" "" } }
+T{ mismatched f 1 7 T{ name f "" "x" "" } T{ name f "" "y" "" } }
     "<x></y>" xml-error-test
-T{ unclosed f 1 4 V{ T{ name f "" "x" "" } } } "<x>" xml-error-test
+T{ unclosed f 1 3 V{ T{ name f "" "x" "" } } } "<x>" xml-error-test
 T{ nonexist-ns f 1 5 "x" } "<x:y/>" xml-error-test
-T{ unopened f 1 5 } "</x>" xml-error-test
+T{ unopened f 1 4 } "</x>" xml-error-test
 T{ not-yes/no f 1 41 "maybe" }
     "<?xml version='1.0' standalone='maybe'?><x/>" xml-error-test
 T{ extra-attrs f 1 32 V{ T{ name f "" "foo" f } }
@@ -19,13 +19,13 @@ T{ bad-version f 1 28 "5 million" }
     "<?xml version='5 million'?><x/>" xml-error-test
 T{ notags f } "" xml-error-test
 T{ multitags } "<x/><y/>" xml-error-test
-T{ bad-prolog  f 1 26 T{ prolog f "1.0" "UTF-8" f } }
+T{ bad-prolog  f 1 25 T{ prolog f "1.0" "UTF-8" f } }
     "<x/><?xml version='1.0'?>" xml-error-test
 T{ capitalized-prolog f 1 6 "XmL" } "<?XmL version='1.0'?><x/>"
     xml-error-test
 T{ pre/post-content f "x" t } "x<y/>" xml-error-test
 T{ versionless-prolog f 1 8 } "<?xml?><x/>" xml-error-test
-T{ unclosed-quote f 1 13 } "<x value='/>" xml-error-test
+T{ unclosed-quote f 1 12 } "<x value='/>" xml-error-test
 T{ bad-name f 1 3 "-" } "<-/>" xml-error-test
 T{ quoteless-attr f 1 12 } "<x value=<->/>" xml-error-test
 T{ quoteless-attr f 1 10 } "<x value=3/>" xml-error-test
@@ -37,6 +37,6 @@ T{ bad-cdata f 1 7 } "<x/><![CDATA[]]>" xml-error-test
 T{ pre/post-content f "&" t } "&#32;<x/>" xml-error-test
 T{ bad-doctype f 1 17 "a" } "<!DOCTYPE foo [ a ]><x/>" xml-error-test
 T{ bad-doctype f 1 22 T{ opener { name T{ name f "" "foo" "" } } { attrs T{ attrs } } } } "<!DOCTYPE foo [ <foo> ]><x/>" xml-error-test
-T{ disallowed-char f 1 3 1 } "<x>\u000001</x>" xml-error-test
+T{ disallowed-char f 1 4 1 } "<x>\u000001</x>" xml-error-test
-T{ missing-close f 1 9 } "<!-- foo" xml-error-test
+T{ missing-close f 1 8 } "<!-- foo" xml-error-test
 T{ misplaced-directive f 1 9 "ENTITY" } "<!ENTITY foo 'bar'><x/>" xml-error-test

basis/xml/literals/literals-docs.factor

@@ -1,29 +1,29 @@
-USING: help.markup help.syntax present multiline ;
+USING: help.markup help.syntax present multiline xml.data ;
-IN: xml.interpolate
+IN: xml.literals
 
-ABOUT: "xml.interpolate"
+ABOUT: "xml.literals"
 
-ARTICLE: "xml.interpolate" "XML literal interpolation"
+ARTICLE: "xml.literals" "XML literals"
-"The " { $vocab-link "xml.interpolate" } " vocabulary provides a convenient syntax for generating XML documents and chunks. It defines the following parsing words:"
+"The " { $vocab-link "xml.literals" } " vocabulary provides a convenient syntax for generating XML documents and chunks. It defines the following parsing words:"
 { $subsection POSTPONE: <XML }
 { $subsection POSTPONE: [XML }
-"For a description of the common syntax of these two, see"
+"These can be used for creating an XML literal, which can be used with variables or a fry-like syntax to interpolate data into XML."
-{ $subsection { "xml.interpolate" "in-depth" } } ;
+{ $subsection { "xml.literals" "interpolation" } } ;
 
 HELP: <XML
 { $syntax "<XML <?xml version=\"1.0\"?><document>...</document> XML>" }
-{ $description "This syntax allows the interpolation of XML documents. When evaluated, there is an XML document on the stack. For more information about XML interpolation, see " { $link { "xml.interpolate" "in-depth" } } "." } ;
+{ $description "This gives syntax for literal XML documents. When evaluated, there is an XML document (" { $link xml } ") on the stack. It can be used for interpolation as well, if interpolation slots are used. For more information about XML interpolation, see " { $link { "xml.literals" "interpolation" } } "." } ;
 
 HELP: [XML
 { $syntax "[XML foo <x>...</x> bar <y>...</y> baz XML]" }
-{ $description "This syntax allows the interpolation of XML chunks. When evaluated, there is a sequence of XML elements (tags, strings, comments, etc) on the stack. For more information about XML interpolation, see " { $link { "xml.interpolate" "in-depth" } } "." } ;
+{ $description "This gives syntax for literal XML documents. When evaluated, there is an XML chunk (" { $link xml-chunk } ") on the stack. For more information about XML interpolation, see " { $link { "xml.literals" "interpolation" } } "." } ;
 
-ARTICLE: { "xml.interpolate" "in-depth" } "XML interpolation syntax"
+ARTICLE: { "xml.literals" "interpolation" } "XML interpolation syntax"
 "XML interpolation has two forms for each of the words " { $link POSTPONE: <XML } " and " { $link POSTPONE: [XML } ": a fry-like form and a locals form. To splice locals in, use the syntax " { $snippet "<-variable->" } ". To splice something in from the stack, in the style of " { $vocab-link "fry" } ", use the syntax " { $snippet "<->" } ". An XML interpolation form may only use one of these styles."
 $nl
 "These forms can be used where a tag might go, as in " { $snippet "[XML <foo><-></foo> XML]" } " or where an attribute might go, as in " { $snippet "[XML <foo bar=<->/> XML]" } ". When an attribute is spliced in, it is not included if the value is " { $snippet "f" } " and if the value is not a string, the value is put through " { $link present } ". Here is an example of the fry style of XML interpolation:"
 { $example 
-{" USING: splitting sequences xml.writer xml.interpolate ;
+{" USING: splitting sequences xml.writer xml.literals ;
 "one two three" " " split
 [ [XML <item><-></item> XML] ] map
 <XML <doc><-></doc> XML> pprint-xml"}
@@ -41,7 +41,7 @@ $nl
 </doc>"} }
 "Here is an example of the locals version:"
 { $example
-{" USING: locals urls xml.interpolate xml.writer ;
+{" USING: locals urls xml.literals xml.writer ;
 [let |
     number [ 3 ]
     false [ f ]

basis/xml/literals/literals-tests.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2009 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test xml.interpolate multiline kernel assocs
+USING: tools.test xml.literals multiline kernel assocs
-sequences accessors xml.writer xml.interpolate.private
+sequences accessors xml.writer xml.literals.private
 locals splitting urls xml.data classes ;
-IN: xml.interpolate.tests
+IN: xml.literals.tests
 
 [ "a" "c" { "a" "c" f } ] [
     "<?xml version='1.0'?><x><-a-><b val=<-c->/><-></x>"

basis/xml/literals/literals.factor

@@ -4,7 +4,7 @@ USING: xml xml.state kernel sequences fry assocs xml.data
 accessors strings make multiline parser namespaces macros
 sequences.deep generalizations words combinators
 math present arrays unicode.categories ;
-IN: xml.interpolate
+IN: xml.literals
 
 <PRIVATE
 

basis/xml/state/state.factor

@@ -1,9 +1,10 @@
 ! Copyright (C) 2005, 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel namespaces io ;
+USING: accessors kernel namespaces io math ;
 IN: xml.state
 
-TUPLE: spot char line column next check version-1.0? ;
+TUPLE: spot
+    char line column next check version-1.0? stream ;
 
 C: <spot> spot
 

basis/xml/tests/state-parser-tests.factor

@@ -11,7 +11,7 @@ IN: xml.test.state
     1string take-to ;
 
 [ "hello" ] [ "hello" [ take-rest ] string-parse ] unit-test
-[ 2 4 ] [ "12\n123" [ take-rest drop get-line get-column ] string-parse ] unit-test
+[ 2 3 ] [ "12\n123" [ take-rest drop get-line get-column ] string-parse ] unit-test
 [ "hi" " how are you?" ] [ "hi how are you?" [ [ get-char blank? ] take-until take-rest ] string-parse ] unit-test
 [ "foo" ";bar" ] [ "foo;bar" [ CHAR: ; take-char take-rest ] string-parse ] unit-test
 [ "foo " " bar" ] [ "foo and bar" [ "and" take-string take-rest ] string-parse ] unit-test

basis/xml/tokenize/tokenize.factor

@@ -2,112 +2,144 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces xml.state kernel sequences accessors
 xml.char-classes xml.errors math io sbufs fry strings ascii
-circular xml.entities assocs make splitting math.parser
+circular xml.entities assocs splitting math.parser
-locals combinators arrays ;
+locals combinators arrays hints ;
 IN: xml.tokenize
 
-: assure-good-char ( ch -- ch )
-    [
-        version-1.0? over text? not get-check and
-        [ disallowed-char ] when
-    ] [ f ] if* ;
-
 ! * Basic utility words
 
-: record ( char -- )
+: assure-good-char ( spot ch -- )
-    CHAR: \n =
+    [
-    [ 0 get-line 1+ set-line ] [ get-column 1+ ] if
+        swap
-    set-column ;
+        [ version-1.0?>> over text? not ]
-
+        [ check>> ] bi and [
-! (next) normalizes \r\n and \r
+            spot get [ 1+ ] change-column drop
-: (next) ( -- char )
+            disallowed-char
-    get-next read1
-    2dup swap CHAR: \r = [
-        CHAR: \n =
-        [ nip read1 ] [ nip CHAR: \n swap ] if
         ] [ drop ] if
-    set-next dup set-char assure-good-char ;
+    ] [ drop ] if* ;
+
+HINTS: assure-good-char { spot fixnum } ;
+
+: record ( spot char -- spot )
+    over char>> [
+        CHAR: \n =
+        [ [ 1+ ] change-line -1 ] [ dup column>> 1+ ] if
+        >>column
+    ] [ drop ] if ;
+
+HINTS: record { spot fixnum } ;
+
+:: (next) ( spot -- spot char )
+    spot next>> :> old-next
+    spot stream>> stream-read1 :> new-next
+    old-next CHAR: \r = [
+        spot CHAR: \n >>char
+        new-next CHAR: \n =
+        [ spot stream>> stream-read1 >>next ]
+        [ new-next >>next ] if
+    ] [ spot old-next >>char new-next >>next ] if
+    spot next>> ; inline
+
+: next* ( spot -- )
+    dup char>> [ unexpected-end ] unless
+    (next) [ record ] keep assure-good-char ;
+
+HINTS: next* { spot } ;
 
 : next ( -- )
-    #! Increment spot.
+    spot get next* ;
-    get-char [ unexpected-end ] unless (next) record ;
 
 : init-parser ( -- )
-    0 1 0 f f t <spot> spot set
+    0 1 0 0 f t f <spot>
+        input-stream get >>stream
+    spot set
     read1 set-next next ;
 
 : with-state ( stream quot -- )
     ! with-input-stream implicitly creates a new scope which we use
     swap [ init-parser call ] with-input-stream ; inline
 
+:: (skip-until) ( quot: ( -- ? ) spot -- )
+    spot char>> [
+        quot call [
+            spot next* quot spot (skip-until)
+        ] unless
+    ] when ; inline recursive
+
 : skip-until ( quot: ( -- ? ) -- )
-    get-char [
+    spot get (skip-until) ; inline
-        [ call ] keep swap [ drop ] [
-            next skip-until
-        ] if
-    ] [ drop ] if ; inline recursive
 
 : take-until ( quot -- string )
     #! Take the substring of a string starting at spot
     #! from code until the quotation given is true and
     #! advance spot to after the substring.
     10 <sbuf> [
-        '[ @ [ t ] [ get-char _ push f ] if ] skip-until
+        spot get swap
+        '[ @ [ t ] [ _ char>> _ push f ] if ] skip-until
     ] keep >string ; inline
 
 : take-to ( seq -- string )
-    '[ get-char _ member? ] take-until ;
+    spot get swap '[ _ char>> _ member? ] take-until ;
 
 : pass-blank ( -- )
     #! Advance code past any whitespace, including newlines
-    [ get-char blank? not ] skip-until ;
+    spot get '[ _ char>> blank? not ] skip-until ;
 
-: string-matches? ( string circular -- ? )
+: string-matches? ( string circular spot -- ? )
-    get-char over push-circular
+    char>> over push-circular sequence= ;
-    sequence= ;
 
 : take-string ( match -- string )
     dup length <circular-string>
-    [ 2dup string-matches? ] take-until nip
+    spot get '[ 2dup _ string-matches? ] take-until nip
     dup length rot length 1- - head
     get-char [ missing-close ] unless next ;
 
 : expect ( string -- )
-    dup [ get-char next ] replicate 2dup =
+    dup spot get '[ _ [ char>> ] keep next* ] replicate
-    [ 2drop ] [ expected ] if ;
+    2dup = [ 2drop ] [ expected ] if ;
 
 ! Suddenly XML-specific
 
-: parse-named-entity ( string -- )
+: parse-named-entity ( accum string -- )
-    dup entities at [ , ] [
+    dup entities at [ swap push ] [
         dup extra-entities get at
-        [ % ] [ no-entity ] ?if
+        [ swap push-all ] [ no-entity ] ?if
     ] ?if ;
 
 : take-; ( -- string )
     next ";" take-to next ;
 
-: parse-entity ( -- )
+: parse-entity ( accum -- )
     take-; "#" ?head [
-        "x" ?head 16 10 ? base> ,
+        "x" ?head 16 10 ? base> swap push
     ] [ parse-named-entity ] if ;
 
-: parse-pe ( -- )
+: parse-pe ( accum -- )
     take-; dup pe-table get at
-    [ % ] [ no-entity ] ?if ;
+    [ swap push-all ] [ no-entity ] ?if ;
 
-:: (parse-char) ( quot: ( ch -- ? ) -- )
+:: (parse-char) ( quot: ( ch -- ? ) accum spot -- )
-    get-char :> char
+    spot char>> :> char
     {
         { [ char not ] [ ] }
-        { [ char quot call ] [ next ] }
+        { [ char quot call ] [ spot next* ] }
-        { [ char CHAR: & = ] [ parse-entity quot (parse-char) ] }
+        { [ char CHAR: & = ] [
-        { [ in-dtd? get char CHAR: % = and ] [ parse-pe quot (parse-char) ] }
+            accum parse-entity
-        [ char , next quot (parse-char) ]
+            quot accum spot (parse-char)
+        ] }
+        { [ in-dtd? get char CHAR: % = and ] [
+            accum parse-pe
+            quot accum spot (parse-char)
+        ] }
+        [
+            char accum push
+            spot next*
+            quot accum spot (parse-char)
+        ]
     } cond ; inline recursive
 
 : parse-char ( quot: ( ch -- ? ) -- seq )
-    [ (parse-char) ] "" make ; inline
+    1024 <sbuf> [ spot get (parse-char) ] keep >string ; inline
 
 : assure-no-]]> ( circular -- )
     "]]>" sequence= [ text-w/]]> ] when ;

basis/xml/writer/writer-docs.factor

@@ -41,7 +41,7 @@ HELP: pprint-xml
 
 HELP: indenter
 { $var-description "Contains the string which is used for indenting in the XML prettyprinter. For example, to print an XML document using " { $snippet "%%%%" } " for indentation, you can use the following:" }
-{ $example {" USING: xml.interpolate xml.writer namespaces ;
+{ $example {" USING: xml.literals xml.writer namespaces ;
 [XML <foo>bar</foo> XML] "%%%%" indenter [ pprint-xml ] with-variable "} {"
 <foo>
 %%%%bar
@@ -49,7 +49,7 @@ HELP: indenter
 
 HELP: sensitive-tags
 { $var-description "Contains a sequence of " { $link name } "s where whitespace should be considered significant for prettyprinting purposes. The sequence can contain " { $link string } "s in place of names. For example, to preserve whitespace inside a " { $snippet "pre" } " tag:" }
-{ $example {" USING: xml.interpolate xml.writer namespaces ;
+{ $example {" USING: xml.literals xml.writer namespaces ;
 [XML <html> <head>   <title> something</title></head><body><pre>bing
 bang
    bong</pre></body></html> XML] { "pre" } sensitive-tags [ pprint-xml ] with-variable "} {"

basis/xmode/code2html/code2html.factor

@@ -1,6 +1,6 @@
 USING: xmode.tokens xmode.marker xmode.catalog kernel locals
 html.elements io io.files sequences words io.encodings.utf8
-namespaces xml.entities accessors xml.interpolate locals xml.writer ;
+namespaces xml.entities accessors xml.literals locals xml.writer ;
 IN: xmode.code2html
 
 : htmlize-tokens ( tokens -- xml )

extra/4DNav/4DNav-docs.factor

@@ -0,0 +1,198 @@
+! Copyright (C) 2008 Jean-François Bigot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel quotations strings multiline ;
+IN: 4DNav
+
+
+HELP: menu-3D
+{ $values
+     { "gadget" "gadget" }
+}
+{ $description "The menu dedicated to 3D movements of the camera" } ;
+
+HELP: menu-4D
+{ $values
+    
+     { "gadget" "gadget" }
+}
+{ $description "The menu dedicated to 4D movements of space" } ;
+
+HELP: menu-bar
+{ $values
+    
+     { "gadget" "gadget" }
+}
+{ $description "return gadget containing menu buttons" } ;
+
+HELP: model-projection
+{ $values
+     { "x" "interger" }
+     { "space" "space" }
+}
+{ $description "Project space following coordinate x" } ;
+
+HELP: mvt-3D-1
+{ $values
+    
+     { "quot" "quotation" }
+}
+{ $description "return a quotation to orientate space to see it from first point of view" } ;
+
+HELP: mvt-3D-2
+{ $values
+    
+     { "quot" "quotation" }
+}
+{ $description "return a quotation to orientate space to see it from second point of view" } ;
+
+HELP: mvt-3D-3
+{ $values
+    
+     { "quot" "quotation" }
+}
+{ $description "return a quotation to orientate space to see it from third point of view" } ;
+
+HELP: mvt-3D-4
+{ $values
+    
+     { "quot" "quotation" }
+}
+{ $description "return a quotation to orientate space to see it from first point of view" } ;
+
+HELP: load-model-file
+{ $description "load space from file" } ;
+
+HELP: rotation-4D
+{ $values
+     { "m" "a rotation matrix" }
+}
+{ $description "Apply a 4D rotation matrix" } ;
+
+HELP: translation-4D
+{ $values
+     { "v" "vector" }
+}
+{ $description "Apply a 4D translation" } ;
+
+
+ARTICLE: "implementation details" "How 4DNav is done"
+"4DNav is build using :"
+
+{ $subsection "4DNav.camera" }
+{ $subsection "adsoda-main-page" }
+;
+
+ARTICLE: "Space file" "Create a new space file"
+"To build a new space, create an XML file using " { $vocab-link "adsoda" } " model description. A solid is not caracterized by its corners but is defined as the intersection of hyperplanes."
+
+$nl
+"An example is:"
+{ $code <"
+<model>
+<space>
+ <dimension>4</dimension>
+ <solid>
+     <name>4cube1</name>
+     <dimension>4</dimension>
+     <face>1,0,0,0,100</face>
+     <face>-1,0,0,0,-150</face>
+     <face>0,1,0,0,100</face>
+     <face>0,-1,0,0,-150</face>
+     <face>0,0,1,0,100</face>
+     <face>0,0,-1,0,-150</face>
+     <face>0,0,0,1,100</face>
+     <face>0,0,0,-1,-150</face>
+     <color>1,0,0</color>
+ </solid>
+ <solid>
+     <name>4triancube</name>
+     <dimension>4</dimension>
+     <face>1,0,0,0,160</face>
+     <face>-0.4999999999999998,-0.8660254037844387,0,0,-130</face>
+     <face>-0.5000000000000004,0.8660254037844384,0,0,-130</face>
+     <face>0,0,1,0,140</face>
+     <face>0,0,-1,0,-180</face>
+     <face>0,0,0,1,110</face>
+     <face>0,0,0,-1,-180</face>
+     <color>0,1,0</color>
+ </solid>
+ <solid>
+     <name>triangone</name>
+     <dimension>4</dimension>
+     <face>1,0,0,0,60</face>
+     <face>0.5,0.8660254037844386,0,0,60</face>
+     <face>-0.5,0.8660254037844387,0,0,-20</face>
+     <face>-1.0,0,0,0,-100</face>
+     <face>-0.5,-0.8660254037844384,0,0,-100</face>
+     <face>0.5,-0.8660254037844387,0,0,-20</face>
+     <face>0,0,1,0,120</face>
+     <face>0,0,-0.4999999999999998,-0.8660254037844387,-120</face>
+     <face>0,0,-0.5000000000000004,0.8660254037844384,-120</face>
+     <color>0,1,1</color>
+ </solid>
+ <light>
+     <direction>1,1,1,1</direction>
+     <color>0.2,0.2,0.6</color>
+ </light>
+ <color>0.8,0.9,0.9</color>
+</space>
+</model> "> } ;
+
+ARTICLE: "TODO" "Todo"
+{ $list 
+    "A vocab to initialize parameters"
+    "an editor mode" 
+        { $list "add a face to a solid"
+                "add a solid to the space"
+                "move a face"
+                "move a solid"
+                "select a solid in a list"
+                "select a face"
+                "display selected face"
+                "edit a solid color"
+                "add a light"
+                "edit a light color"
+                "move a light"
+                }
+    "add a tool wich give an hyperplane normal vector with enought points. Will use adsoda.intersect-hyperplanes with { { 0 } { 0 } { 1 } } "
+    "decorrelate 3D camera and activate them with select buttons"
+
+} ;
+
+
+ARTICLE: "4DNav" "The 4DNav app"
+{ $vocab-link "4DNav" }
+$nl
+{ $heading "4D Navigator" }
+"4DNav is a simple tool to visualize 4 dimensionnal objects."
+$nl
+"It uses " { $vocab-link "adsoda" } " library to display a 4D space and navigate thru it."
+$nl
+"It will display:"
+{ $list
+    { "a menu window" }
+    {  "4 visualization windows" }
+}
+"Each visualization window represents the projection of the 4D space on a particular 3D space."
+
+{ $heading "Start" }
+"type:" { $code "\"4DNav\" run" } 
+
+{ $heading "Navigation" }
+"Menu window is divided in 4 areas"
+{ $list
+    { "a space-file chooser to select the file to display" }
+    { "a parametrization area to select the projection mode" }
+    { "4D submenu to translate and rotate the 4D space" }
+    { "3D submenu to move the camera in 3D space. Cameras in every 3D spaces are manipulated as a single one" }
+    }
+
+{ $heading "Links" }
+{ $subsection "Space file" }
+
+{ $subsection "TODO" }
+{ $subsection "implementation details" }
+
+;
+
+ABOUT: "4DNav"

extra/4DNav/4DNav.factor

@@ -117,26 +117,28 @@ VAR: present-space
   0.0       , 0.0           , 1.0 , 0.0 ,
   0.0       , 0.0          , 0.0 , 1.0 ,  ] 4 make-matrix nip ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! UI
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: button* ( string quot -- button ) closed-quot <repeat-button>  ;
+: button* ( string quot -- button ) 
+    closed-quot <repeat-button>  ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : model-projection-chooser ( -- gadget )
    observer3d> projection-mode>>
-   { { 1 "perspective" } { 0 "orthogonal" }  } <toggle-buttons> ;
+   { { 1 "perspective" } { 0 "orthogonal" } } 
+   <toggle-buttons> ;
 
 : collision-detection-chooser ( -- gadget )
    observer3d> collision-mode>>
-   { { t "on" } { f "off" }  } <toggle-buttons>
+   { { t "on" } { f "off" }  } <toggle-buttons> ;
-;
 
-: model-projection ( x -- space ) present-space>  swap space-project ;
+: model-projection ( x -- space ) 
+    present-space>  swap space-project ;
 
 : update-observer-projections (  -- )
     view1> relayout-1 
@@ -151,14 +153,16 @@ VAR: present-space
     3 model-projection <model> view4> (>>model) ;
 
 : camera-action ( quot -- quot ) 
-    [ drop [ ] observer3d>  with-self update-observer-projections ] 
+    [ drop [ ] observer3d>  
+    with-self update-observer-projections ] 
     make* closed-quot ;
 
-: win3D ( text gadget -- ) "navigateur 4D : " rot append open-window ;
+: win3D ( text gadget -- ) 
+    "navigateur 4D : " rot append open-window ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! 4D object manipulation
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : (mvt-4D) ( quot -- )   
     present-space>  
@@ -168,42 +172,55 @@ VAR: present-space
     update-observer-projections ;
 
 : rotation-4D ( m -- ) 
-    '[ _ [ [ middle-of-space dup vneg ] keep swap space-translate ] dip
+    '[ _ [ [ middle-of-space dup vneg ] keep 
+        swap space-translate ] dip
          space-transform 
          swap space-translate
     ] (mvt-4D) ;
 
 : translation-4D ( v -- ) '[ _ space-translate ] (mvt-4D) ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! menu
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : menu-rotations-4D ( -- gadget )
     <frame>
          <pile> 1 >>fill
-          "XY +" [ drop rotation-step 4D-Rxy rotation-4D ] button* add-gadget
+          "XY +" [ drop rotation-step 4D-Rxy rotation-4D ] 
-          "XY -" [ drop rotation-step neg 4D-Rxy rotation-4D ] button* add-gadget 
+                button* add-gadget
+          "XY -" [ drop rotation-step neg 4D-Rxy rotation-4D ] 
+                button* add-gadget 
        @top-left grid-add    
         <pile> 1 >>fill
-          "XZ +" [ drop rotation-step 4D-Rxz rotation-4D ] button* add-gadget
+          "XZ +" [ drop rotation-step 4D-Rxz rotation-4D ] 
-          "XZ -" [ drop rotation-step neg 4D-Rxz rotation-4D ] button* add-gadget 
+                button* add-gadget
+          "XZ -" [ drop rotation-step neg 4D-Rxz rotation-4D ] 
+                button* add-gadget 
        @top grid-add    
         <pile> 1 >>fill
-          "YZ +" [ drop rotation-step 4D-Ryz rotation-4D ] button* add-gadget
+          "YZ +" [ drop rotation-step 4D-Ryz rotation-4D ] 
-          "YZ -" [ drop rotation-step neg 4D-Ryz rotation-4D ] button* add-gadget 
+                button* add-gadget
+          "YZ -" [ drop rotation-step neg 4D-Ryz rotation-4D ] 
+                button* add-gadget 
         @center grid-add
          <pile> 1 >>fill
-          "XW +" [ drop rotation-step 4D-Rxw rotation-4D ] button* add-gadget
+          "XW +" [ drop rotation-step 4D-Rxw rotation-4D ] 
-          "XW -" [ drop rotation-step neg 4D-Rxw rotation-4D ] button* add-gadget 
+                button* add-gadget
+          "XW -" [ drop rotation-step neg 4D-Rxw rotation-4D ] 
+                button* add-gadget 
         @top-right grid-add   
          <pile> 1 >>fill
-          "YW +" [ drop rotation-step 4D-Ryw rotation-4D ] button* add-gadget
+          "YW +" [ drop rotation-step 4D-Ryw rotation-4D ] 
-          "YW -" [ drop rotation-step neg 4D-Ryw rotation-4D ] button* add-gadget 
+                button* add-gadget
+          "YW -" [ drop rotation-step neg 4D-Ryw rotation-4D ] 
+                button* add-gadget 
        @right grid-add    
          <pile> 1 >>fill
-          "ZW +" [ drop rotation-step 4D-Rzw rotation-4D ] button* add-gadget
+          "ZW +" [ drop rotation-step 4D-Rzw rotation-4D ] 
-          "ZW -" [ drop rotation-step neg 4D-Rzw rotation-4D ] button* add-gadget 
+                button* add-gadget
+          "ZW -" [ drop rotation-step neg 4D-Rzw rotation-4D ] 
+                button* add-gadget 
        @bottom-right grid-add    
 ;
 
@@ -211,9 +228,11 @@ VAR: present-space
     <frame> 
         <pile> 1 >>fill
             <shelf> 1 >>fill  
-                "X+" [ drop {  1 0 0 0 } translation-step v*n translation-4D ] 
+                "X+" [ drop {  1 0 0 0 } translation-step v*n 
+                    translation-4D ] 
                     button* add-gadget
-                "X-" [ drop { -1 0 0 0 } translation-step v*n translation-4D ] 
+                "X-" [ drop { -1 0 0 0 } translation-step v*n 
+                    translation-4D ] 
                     button* add-gadget 
             add-gadget
             "YZW" <label> add-gadget
@@ -221,26 +240,32 @@ VAR: present-space
          <pile> 1 >>fill
             "XZW" <label> add-gadget
             <shelf> 1 >>fill
-                "Y+" [ drop  { 0  1 0 0 } translation-step v*n translation-4D ] 
+                "Y+" [ drop  { 0  1 0 0 } translation-step v*n 
+                    translation-4D ] 
                     button* add-gadget
-                "Y-" [ drop  { 0 -1 0 0 } translation-step v*n translation-4D ] 
+                "Y-" [ drop  { 0 -1 0 0 } translation-step v*n 
+                    translation-4D ] 
                     button* add-gadget 
                 add-gadget
          @top-right grid-add
          <pile> 1 >>fill
             "XYW" <label> add-gadget
             <shelf> 1 >>fill
-                "Z+" [ drop { 0 0  1 0 } translation-step v*n translation-4D ] 
+                "Z+" [ drop { 0 0  1 0 } translation-step v*n 
+                    translation-4D ] 
                     button* add-gadget
-                "Z-" [ drop { 0 0 -1 0 } translation-step v*n translation-4D ] 
+                "Z-" [ drop { 0 0 -1 0 } translation-step v*n 
+                    translation-4D ] 
                     button* add-gadget 
                 add-gadget                 
         @top-left grid-add     
         <pile> 1 >>fill
             <shelf> 1 >>fill
-                "W+" [ drop { 0 0 0 1  } translation-step v*n translation-4D ] 
+                "W+" [ drop { 0 0 0 1  } translation-step v*n 
+                    translation-4D ] 
                     button* add-gadget
-                "W-" [ drop { 0 0 0 -1 } translation-step v*n translation-4D ] 
+                "W-" [ drop { 0 0 0 -1 } translation-step v*n 
+                    translation-4D ] 
                     button* add-gadget 
                 add-gadget
             "XYZ" <label> add-gadget
@@ -267,7 +292,8 @@ VAR: present-space
     update-observer-projections ;
 
 : load-model-file ( -- )
-  selected-file dup selected-file-model> set-model read-model-file 
+  selected-file dup selected-file-model> set-model 
+  read-model-file 
   redraw-model ;
 
 : mvt-3D-X ( turn pitch -- quot )
@@ -305,37 +331,38 @@ VAR: present-space
 
 : menu-rotations-3D ( -- gadget )
     <frame>
-        "Turn\n left"  [ rotation-step  turn-left  ] camera-button      
+        "Turn\n left"  [ rotation-step  turn-left  ] 
-            @left grid-add     
+            camera-button   @left grid-add     
-        "Turn\n right" [ rotation-step turn-right ] camera-button      
+        "Turn\n right" [ rotation-step turn-right ] 
-            @right grid-add     
+            camera-button   @right grid-add     
-        "Pitch down"   [ rotation-step  pitch-down ] camera-button      
+        "Pitch down"   [ rotation-step  pitch-down ] 
-            @bottom grid-add     
+            camera-button   @bottom grid-add     
-        "Pitch up"     [ rotation-step  pitch-up   ] camera-button      
+        "Pitch up"     [ rotation-step  pitch-up   ] 
-            @top grid-add     
+            camera-button   @top grid-add     
         <shelf>  1 >>fill
-            "Roll left\n (ctl)"  [ rotation-step  roll-left  ] camera-button
+            "Roll left\n (ctl)"  [ rotation-step  roll-left  ] 
-                add-gadget  
+                camera-button   add-gadget  
-            "Roll right\n(ctl)"  [ rotation-step  roll-right ] camera-button 
+            "Roll right\n(ctl)"  [ rotation-step  roll-right ] 
-                add-gadget  
+                camera-button   add-gadget  
         @center grid-add 
 ;
 
 : menu-translations-3D ( -- gadget )
     <frame>
-        "left\n(alt)"          [ translation-step  strafe-left  ] camera-button
+        "left\n(alt)"        [ translation-step  strafe-left  ]
-            @left grid-add  
+            camera-button @left grid-add  
-        "right\n(alt)"         [ translation-step  strafe-right ] camera-button
+        "right\n(alt)"       [ translation-step  strafe-right ]
-            @right grid-add     
+            camera-button @right grid-add     
-        "Strafe up \n (alt)"   [ translation-step strafe-up    ] camera-button
+        "Strafe up \n (alt)" [ translation-step strafe-up    ] 
-            @top grid-add
+            camera-button @top grid-add
-        "Strafe down \n (alt)" [ translation-step strafe-down  ] camera-button
+        "Strafe down\n (alt)" [ translation-step strafe-down  ]
-            @bottom grid-add    
+            camera-button @bottom grid-add    
         <pile>  1 >>fill
-            "Forward (ctl)"  [  translation-step step-turtle ] camera-button
+            "Forward (ctl)"  [  translation-step step-turtle ] 
-                add-gadget
+                camera-button add-gadget
-            "Backward (ctl)" [ translation-step neg step-turtle ] camera-button
+            "Backward (ctl)" 
-                add-gadget
+                [ translation-step neg step-turtle ] 
+                camera-button   add-gadget
         @center grid-add
 ;
 
@@ -372,7 +399,8 @@ VAR: present-space
         { T{ key-down f { C+ } "UP" } 
            [ [ translation-step step-turtle ] camera-action ] }
         { T{ key-down f { C+ } "DOWN" } 
-            [ [ translation-step neg step-turtle ] camera-action ] }
+            [ [ translation-step neg step-turtle ] 
+                    camera-action ] }
         { T{ key-down f { C+ } "LEFT" } 
             [ [ rotation-step roll-left ] camera-action ] }
         { T{ key-down f { C+ } "RIGHT" } 
@@ -422,15 +450,18 @@ M: solid adsoda-display-model
         [ name>> "solid called : " pprint . ] 
         [ color>> "color : " pprint . ]
         [ dimension>> "dimension : " pprint . ]
-        [ faces>> "composed of faces : " pprint [ adsoda-display-model ] each ]
+        [ faces>> "composed of faces : " pprint 
+            [ adsoda-display-model ] each ]
     }   cleave
     ;
 M: space adsoda-display-model 
      {
         [ dimension>> "dimension : " pprint . ] 
         [ ambient-color>> "ambient-color : " pprint . ]
-        [ solids>> "composed of solids : " pprint [ adsoda-display-model ] each ]
+        [ solids>> "composed of solids : " pprint 
-        [ lights>> "composed of lights : " pprint [ adsoda-display-model ] each ] 
+            [ adsoda-display-model ] each ]
+        [ lights>> "composed of lights : " pprint 
+            [ adsoda-display-model ] each ] 
     }   cleave
     ;
 
@@ -454,7 +485,8 @@ M: space adsoda-display-model
             model-projection-chooser add-gadget
         f track-add
         <shelf>
-            "Collision detection (slow and buggy ) : " <label> add-gadget
+            "Collision detection (slow and buggy ) : " 
+                <label> add-gadget
             collision-detection-chooser add-gadget
         f track-add
         <pile>

extra/4DNav/camera/camera-docs.factor

@@ -6,41 +6,41 @@ IN: 4DNav.camera
 HELP: camera-eye
 { $values
     
-     { "point" null }
+     { "point" "position" }
 }
 { $description "return the position of the camera" } ;
 
 HELP: camera-focus
 { $values
     
-     { "point" null }
+     { "point" "position" }
 }
 { $description "return the point the camera looks at" } ;
 
 HELP: camera-up
 { $values
     
-     { "dirvec" null }
+     { "dirvec" "upside direction" }
 }
 { $description "In order to precise the roling position of camera give an upward vector" } ;
 
 HELP: do-look-at
 { $values
-     { "camera" null }
+     { "camera" "direction" }
 }
 { $description "Word to use in replacement of gl-look-at when using a camera" } ;
 
-ARTICLE: "4DNav.camera" "4DNav.camera"
+ARTICLE: "4DNav.camera" "Camera"
 { $vocab-link "4DNav.camera" }
-"\n"
+$nl
 "A camera is defined by:"
 { $list
 { "a position (" { $link camera-eye } ")" }
-{ "a focus direction (" { $link camera-focus } ")\n" }
+{ "a focus direction (" { $link camera-focus } ")" }
-{ "an attitude information (" { $link camera-up } ")\n" }
+{ "an attitude information (" { $link camera-up } ")" }
 }
-"\nUse " { $link do-look-at } " in opengl statement in placement of gl-look-at"
+"Use " { $link do-look-at } " in opengl statement in placement of gl-look-at"
-"\n\n"
+$nl
 "A camera is a " { $vocab-link "4DNav.turtle" } " object. Its a special vocab to handle mouvements of a 3D object:"
 { $list
 { "To define a camera"

extra/4DNav/camera/camera.factor

@@ -0,0 +1,19 @@
+USING: kernel namespaces math.vectors opengl 4DNav.turtle 
+self ;
+
+IN: 4DNav.camera
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: camera-eye ( -- point ) turtle-pos> ;
+
+: camera-focus ( -- point ) 
+    [ 1 step-turtle turtle-pos> ] save-self ;
+
+: camera-up ( -- dirvec )
+[ 90 pitch-up turtle-pos> 1 step-turtle turtle-pos> swap v- ] 
+    save-self ;
+
+: do-look-at ( camera -- )
+[ >self camera-eye camera-focus camera-up gl-look-at ] 
+    with-scope ;

extra/4DNav/deep/deep-docs.factor

@@ -24,7 +24,7 @@ IN: 4DNav.deep
 ! } }
 ! ;
 
-ARTICLE: "4DNav.deep" "4DNav.deep"
+ARTICLE: "4DNav.deep" "Deep"
 { $vocab-link "4DNav.deep" }
 ;
 

extra/4DNav/deep/deep.factor

@@ -0,0 +1,13 @@
+USING: macros quotations math math.functions math.trig 
+sequences.deep kernel make fry combinators grouping ;
+IN: 4DNav.deep
+
+! USING: bake ;
+! MACRO: deep-cleave-quots ( seq -- quot )
+!    [ [ quotation? ] deep-filter ]
+!    [ [ dup quotation? [ drop , ] when ] deep-map ]
+!    bi '[ _ cleave _ bake ] ;
+
+: make-matrix ( quot width -- matrix ) 
+    [ { } make ] dip group ; inline
+

extra/4DNav/file-chooser/file-chooser.factor

@@ -45,18 +45,26 @@ TUPLE: file-chooser < track
     [ file-chooser? ] find-parent list>> ;
 
 file-chooser H{
-    { T{ key-down f f "UP" } [ find-file-list select-previous ] }
+    { T{ key-down f f "UP" } 
-    { T{ key-down f f "DOWN" } [ find-file-list select-next ] }
+        [ find-file-list select-previous ] }
-    { T{ key-down f f "PAGE_UP" } [ find-file-list list-page-up ] }
+    { T{ key-down f f "DOWN" } 
-    { T{ key-down f f "PAGE_DOWN" } [ find-file-list list-page-down ] }
+        [ find-file-list select-next ] }
-    { T{ key-down f f "RET" } [ find-file-list invoke-value-action ] }
+    { T{ key-down f f "PAGE_UP" } 
-    { T{ button-down } request-focus }
+        [ find-file-list list-page-up ] }
-    { T{ button-down f 1 } [ find-file-list invoke-value-action ]  }
+    { T{ key-down f f "PAGE_DOWN" } 
+        [ find-file-list list-page-down ] }
+    { T{ key-down f f "RET" } 
+        [ find-file-list invoke-value-action ] }
+    { T{ button-down } 
+        request-focus }
+    { T{ button-down f 1 } 
+        [ find-file-list invoke-value-action ]  }
 } set-gestures
 
 : list-of-files ( file-chooser -- seq )
      [ path>> value>> directory-entries ] [ extension>> ] bi
-     '[ [ name>> _ [ tail? ] with contains? ] [ directory? ] bi or ]  filter
+     '[ [ name>> _ [ tail? ] with any? ] 
+     [ directory? ] bi or ]  filter
 ;
 
 : update-filelist-model ( file-chooser -- file-chooser )
@@ -123,15 +131,19 @@ file-chooser H{
     dup <file-list> >>list
     "choose a file in directory " <label> f track-add
     dup path>> <label-control> f track-add
-    dup extension>> ", " join "limited to : " prepend <label> f track-add
+    dup extension>> ", " join "limited to : " prepend 
+        <label> f track-add
     <shelf> 
         "selected file : " <label> add-gadget
         over selected-file>> <label-control> add-gadget
     f track-add
     <shelf> 
-        over [  swap fc-go-parent ] curry  "go up" swap <bevel-button> add-gadget
+        over [  swap fc-go-parent ] curry  "go up" 
-        over [  swap fc-go-home ] curry  "go home" swap <bevel-button> add-gadget
+            swap <bevel-button> add-gadget
-    !    over [ swap fc-ok-action ] curry "OK" swap <bevel-button> add-gadget
+        over [  swap fc-go-home ] curry  "go home" 
+            swap <bevel-button> add-gadget
+    !    over [ swap fc-ok-action ] curry "OK" 
+    !    swap <bevel-button> add-gadget
     !    [ drop ]  "Cancel" swap <bevel-button> add-gadget
     f track-add
     dup list>> <scroller> 1 track-add
@@ -140,5 +152,6 @@ file-chooser H{
 M: file-chooser pref-dim* drop { 400 200 } ;
 
 : file-chooser-window ( -- )
-[ . ] home { "xml" "txt" }   <file-chooser> "Choose a file" open-window ;
+    [ . ] home { "xml" "txt" }   <file-chooser> 
+    "Choose a file" open-window ;
 

extra/4DNav/space-file-decoder/space-file-decoder-docs.factor

@@ -3,28 +3,17 @@
 USING: help.markup help.syntax kernel ;
 IN: 4DNav.space-file-decoder
 
-HELP: adsoda-read-model
-{ $values
-     { "tag" null }
-}
-{ $description "" } ;
 
-HELP: decode-number-array
-{ $values
-     { "x" null }
-     { "y" null }
-}
-{ $description "" } ;
 
 HELP: read-model-file
 { $values
     
      { "path" "path to the file to read" }
-     { "x" null }
+     { "x" "value" }
 }
-{ $description "" } ;
+{ $description "Read a file containing the xml description of the model" } ;
 
-ARTICLE: "4DNav.space-file-decoder" "4DNav.space-file-decoder"
+ARTICLE: "4DNav.space-file-decoder" "Space XMLfile decoder"
 { $vocab-link "4DNav.space-file-decoder" }
 ;
 

extra/4DNav/space-file-decoder/space-file-decoder.factor

@@ -0,0 +1,66 @@
+! Copyright (C) 2008 Jeff Bigot
+! See http://factorcode.org/license.txt for BSD license.
+USING: adsoda xml xml.utilities xml.dispatch accessors 
+combinators sequences math.parser kernel splitting values 
+continuations ;
+IN: 4DNav.space-file-decoder
+
+: decode-number-array ( x -- y )  
+    "," split [ string>number ] map ;
+
+PROCESS: adsoda-read-model ( tag -- )
+
+TAG: dimension adsoda-read-model 
+    children>> first string>number ;
+TAG: direction adsoda-read-model 
+    children>> first decode-number-array ;
+TAG: color     adsoda-read-model 
+    children>> first decode-number-array ;
+TAG: name      adsoda-read-model 
+    children>> first ;
+TAG: face      adsoda-read-model 
+    children>> first decode-number-array ;
+
+TAG: solid adsoda-read-model 
+    <solid> swap  
+    { 
+        [ "dimension" tag-named adsoda-read-model >>dimension ]
+        [ "name"      tag-named adsoda-read-model >>name ] 
+        [ "color"     tag-named adsoda-read-model >>color ] 
+        [ "face"      
+            tags-named [ adsoda-read-model cut-solid ] each ] 
+    } cleave
+    ensure-adjacencies
+;
+
+TAG: light adsoda-read-model 
+   <light> swap  
+    { 
+        [ "direction" tag-named adsoda-read-model >>direction ]
+        [ "color"     tag-named adsoda-read-model >>color ] 
+    } cleave
+;
+
+TAG: space adsoda-read-model 
+    <space> swap  
+    { 
+        [ "dimension" tag-named adsoda-read-model >>dimension ]
+        [ "name"      tag-named adsoda-read-model >>name ] 
+        [ "color"     tag-named 
+            adsoda-read-model >>ambient-color ] 
+        [ "solid"     tags-named 
+            [ adsoda-read-model suffix-solids ] each ] 
+        [ "light"     tags-named 
+            [ adsoda-read-model suffix-lights ] each ]
+    } cleave
+;
+
+: read-model-file ( path -- x )
+  dup
+  [
+    [ file>xml "space" tags-named first adsoda-read-model ] 
+    [ drop <space> ] recover 
+  ] [  drop <space> ] if 
+
+;
+

extra/4DNav/turtle/turtle-docs.factor

@@ -0,0 +1,11 @@
+! Copyright (C) 2008 Jean-François Bigot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays help.markup help.syntax kernel sequences ;
+IN: 4DNav.turtle
+
+
+ARTICLE: "4DNav.turtle" "Turtle"
+{ $vocab-link "4DNav.turtle" }
+;
+
+ABOUT: "4DNav.turtle"

extra/4DNav/turtle/turtle.factor

@@ -6,7 +6,7 @@ splitting grouping self math.trig
   sequences accessors 4DNav.deep models ;
 IN: 4DNav.turtle
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 TUPLE: turtle pos ori ;
 
@@ -32,7 +32,7 @@ TUPLE: observer < turtle projection-mode collision-mode ;
 : turtle-ori> ( -- val ) self> ori>> ;
 : >turtle-ori ( val -- ) self> (>>ori) ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 ! These rotation matrices are from
 ! `Computer Graphics: Principles and Practice'
@@ -74,15 +74,15 @@ TUPLE: observer < turtle projection-mode collision-mode ;
   0 ,           dup sin ,       dup cos , ] 3 make-matrix nip ;
 
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: apply-rotation ( rotation -- ) turtle-ori> swap m. >turtle-ori ;
 
+: apply-rotation ( rotation -- ) 
+    turtle-ori> swap m. >turtle-ori ;
 : rotate-x ( angle -- ) Rx apply-rotation ;
 : rotate-y ( angle -- ) Ry apply-rotation ;
 : rotate-z ( angle -- ) Rz apply-rotation ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : pitch-up   ( angle -- ) neg rotate-x ;
 : pitch-down ( angle -- )     rotate-x ;
@@ -93,9 +93,9 @@ TUPLE: observer < turtle projection-mode collision-mode ;
 : roll-left  ( angle -- ) neg rotate-z ;
 : roll-right ( angle -- )     rotate-z ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! roll-until-horizontal
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : V ( -- V ) { 0 1 0 } ;
 
@@ -111,25 +111,27 @@ TUPLE: observer < turtle projection-mode collision-mode ;
     V Z cross normalize set-X
     Z X cross normalize set-Y ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: distance ( turtle turtle -- n ) pos>> swap pos>> v- [ sq ] map sum sqrt ;
+: distance ( turtle turtle -- n ) 
+    pos>> swap pos>> v- [ sq ] map sum sqrt ;
 
 : move-by ( point -- ) turtle-pos> v+ >turtle-pos ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : reset-turtle ( -- ) 
     { 0 0 0 } clone >turtle-pos 3 identity-matrix >turtle-ori ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : step-vector ( length -- array ) { 0 0 1 } n*v ;
 
 : step-turtle ( length -- ) 
-    step-vector turtle-ori> swap m.v turtle-pos> v+ >turtle-pos ;
+    step-vector turtle-ori> swap m.v 
+    turtle-pos> v+ >turtle-pos ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : strafe-up ( length -- )
     90 pitch-up

extra/4DNav/window3D/window3D-docs.factor

@@ -3,17 +3,9 @@
 USING: help.markup help.syntax kernel ;
 IN: 4DNav.window3D
 
-HELP: <window3D>
-{ $values
-     { "model" null } { "observer" null }
-     { "gadget" null }
-}
-{ $description "" } ;
 
-HELP: window3D
-{ $description "" } ;
 
-ARTICLE: "4DNav.window3D" "4DNav.window3D"
+ARTICLE: "4DNav.window3D" "Window3D"
 { $vocab-link "4DNav.window3D" }
 ;
 

extra/4DNav/window3D/window3D.factor

@@ -21,9 +21,9 @@ prettyprint
 
 IN: 4DNav.window3D
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! drawing functions 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 TUPLE: window3D  < gadget observer ; 
 
@@ -63,7 +63,8 @@ M: window3D draw-gadget* ( gadget -- )
             GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
             GL_LINE_SMOOTH_HINT GL_NICEST glHint
             1.25 glLineWidth
-            GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
+            GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor 
+                glClear
             glLoadIdentity
             GL_LIGHTING glEnable
             GL_LIGHT0 glEnable

extra/adsoda/adsoda-docs.factor

@@ -1,23 +1,19 @@
 ! Copyright (C) 2008 Jeff Bigot
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax ;
+USING: help.markup help.syntax multiline ;
-
 IN: adsoda
 
-
-
 ! --------------------------------------------------------------
 ! faces
 ! --------------------------------------------------------------
-ARTICLE: "face-page" "face in ADSODA"
+ARTICLE: "face-page" "Face in ADSODA"
 "explanation of faces"
 $nl
-"link to functions"
+"link to functions" $nl
-"what is an halfspace"
+"what is an halfspace" $nl
-"halfspace touching-corners adjacent-faces"
+"halfspace touching-corners adjacent-faces" $nl
-"touching-corners list of pointers to the corners which touch this face\n"
+"touching-corners list of pointers to the corners which touch this face" $nl
-
+"adjacent-faces list of pointers to the faces which touch this face"
-"adjacent-faces list of pointers to the faces which touch this face\n"
 { $subsection face }
 { $subsection <face> }
 "test relative position"
@@ -65,7 +61,7 @@ HELP: face-transform
 ! --------------------------------
 ! solid
 ! --------------------------------------------------------------
-ARTICLE: "solid-page" "solid in ADSODA"
+ARTICLE: "solid-page" "Solid in ADSODA"
 "explanation of solids"
 $nl
 "link to functions"
@@ -133,13 +129,13 @@ $nl
 
 HELP: subtract 
 { $values { "solid1" "initial shape" } { "solid2" "shape to remove" } { "solids" "resulting shape" } }
-{ $description  " " } ;
+{ $description  "Substract solid2 from solid1" } ;
 
 
 ! --------------------------------------------------------------
 ! space 
 ! --------------------------------------------------------------
-ARTICLE: "space-page" "space in ADSODA"
+ARTICLE: "space-page" "Space in ADSODA"
 "A space is a collection of solids and lights."
 $nl
 "link to functions"
@@ -211,7 +207,7 @@ HELP: space-project
 ! --------------------------------------------------------------
 ! 3D rendering
 ! --------------------------------------------------------------
-ARTICLE: "3D-rendering-page" "3D rendering in ADSODA"
+ARTICLE: "3D-rendering-page" "The 3D rendering in ADSODA"
 "explanation of 3D rendering"
 $nl
 "link to functions"
@@ -223,58 +219,53 @@ $nl
 
 HELP: face->GL 
 { $values { "face" "a face" } { "color" "3 3 values array" } }
-{ $description "" } ;
+{ $description "display a face" } ;
 
 HELP: solid->GL 
 { $values { "solid" "a solid" } }
-{ $description "" } ;
+{ $description "display a solid" } ;
 
 HELP: space->GL 
 { $values { "space" "a space" } }
-{ $description "" } ;
+{ $description "display a space" } ;
 
 ! --------------------------------------------------------------
 ! light
 ! --------------------------------------------------------------
 
-ARTICLE: "light-page" "light in ADSODA"
+ARTICLE: "light-page" "Light in ADSODA"
 "explanation of light"
 $nl
 "link to functions"
 ;
 
 ARTICLE: { "adsoda" "light" } "ADSODA : lights"
-"! HELP: light position color" 
+{ $code <"
-"! <light> ( -- tuple ) light new ;"
+! HELP: light position color
-
+! <light> ( -- tuple ) light new ;
-"! light est un vecteur avec 3 variables pour les couleurs\n"
+! light est un vecteur avec 3 variables pour les couleurs\n
-
+ void Light::Apply(Vector& normal, double &cRed, double &cGreen, double &cBlue)\n
-" void Light::Apply(Vector& normal, double &cRed, double &cGreen, double &cBlue)\n"
+ { \n
-" { \n"
+   // Dot the light direction with the normalized normal of Face.
-"   // Dot the light direction with the normalized normal of Face."
+   register double intensity = -(normal * (*this));
-"   register double intensity = -(normal * (*this));"
+   // Face is a backface, from light's perspective
-
+   if (intensity < 0)
-"   // Face is a backface, from light's perspective"
+     return;
-"   if (intensity < 0)"
-"     return;"
-"   "
-"   // Add the intensity componentwise"
-"   cRed += red * intensity;"
-"   cGreen += green * intensity;"
-"   cBlue += blue * intensity;"
-
-"   // Clip to unit range"
-"  if (cRed > 1.0) cRed = 1.0;"
-"   if (cGreen > 1.0) cGreen = 1.0;"
-"   if (cBlue > 1.0) cBlue = 1.0;"
-
    
+   // Add the intensity componentwise
+   cRed += red * intensity;
+   cGreen += green * intensity;
+   cBlue += blue * intensity;
+   // Clip to unit range
+  if (cRed > 1.0) cRed = 1.0;
+   if (cGreen > 1.0) cGreen = 1.0;
+   if (cBlue > 1.0) cBlue = 1.0;
+"> }
 ;
 
 
 
 ARTICLE: { "adsoda" "halfspace" } "ADSODA : halfspace"
-"! demi espace défini par un vecteur normal et une constante"
 " defined by the concatenation of the normal vector and a constant"  
  ;
 

extra/adsoda/adsoda.factor

@@ -41,7 +41,7 @@ DEFER: combinations
 VAR: pv
 
 
-! ---------------------------------------------------------------------
+! -------------------------------------------------------------
 ! global values
 VALUE: remove-hidden-solids?
 VALUE: VERY-SMALL-NUM
@@ -52,25 +52,26 @@ t to: remove-hidden-solids?
 0.0000001 to: VERY-SMALL-NUM
 0.0000001 to: ZERO-VALUE
 4 to: MAX-FACE-PER-CORNER
-! ---------------------------------------------------------------------
+! -------------------------------------------------------------
 ! sequence complement
 
 : with-pv ( i quot -- ) [ swap >pv call ] with-scope  ; inline
 
 : dimension ( array -- x )      length 1- ; inline 
 : last ( seq -- x )           [ dimension ] [ nth ] bi ; inline
-: change-last ( seq quot --  )  [ [ dimension ] keep ] dip change-nth  ; 
+: change-last ( seq quot -- ) 
+    [ [ dimension ] keep ] dip change-nth  ; 
 
-! --------------------------------------------------------------
+! -------------------------------------------------------------
 ! light
-! --------------------------------------------------------------
+! -------------------------------------------------------------
 
 TUPLE: light name { direction array } color ;
 : <light> ( -- tuple ) light new ;
 
-! -----------------------------------------------------------------------
+! -------------------------------------------------------------
 ! halfspace manipulation
-! -----------------------------------------------------------------------
+! -------------------------------------------------------------
 
 : constant+ ( v x -- w )  '[ [ _ + ] change-last ] keep ;
 : translate ( u v -- w )   dupd     v* sum     constant+ ; 
@@ -78,7 +79,8 @@ TUPLE: light name { direction array } color ;
 : transform ( u matrix -- w )
     [ swap m.v ] 2keep ! compute new normal vector    
     [
-        [ [ abs ZERO-VALUE > ] find ] keep ! find a point on the frontier
+        [ [ abs ZERO-VALUE > ] find ] keep 
+        ! find a point on the frontier
         ! be sure it's not null vector
         last ! get constant
         swap /f neg swap ! intercept value
@@ -97,8 +99,10 @@ TUPLE: light name { direction array } color ;
     position-point VERY-SMALL-NUM  > ; 
 : point-inside-or-on-halfspace? ( halfspace v -- ? ) 
     position-point VERY-SMALL-NUM neg > ;
-: project-vector (  seq -- seq )     pv> [ head ] [ 1+  tail ] 2bi append ; 
+: project-vector (  seq -- seq )     
-: get-intersection ( matrice -- seq )     [ 1 tail* ] map     flip first ;
+    pv> [ head ] [ 1+  tail ] 2bi append ; 
+: get-intersection ( matrice -- seq )     
+    [ 1 tail* ] map     flip first ;
 
 : islenght=? ( seq n -- seq n ? ) 2dup [ length ] [ = ] bi*  ;
 
@@ -117,15 +121,18 @@ TUPLE: light name { direction array } color ;
     [ solution dup ] [ first dimension ] bi
     valid-solution?     [ get-intersection ] [ drop f ] if ;
 
-! --------------------------------------------------------------
+! -------------------------------------------------------------
 ! faces
-! --------------------------------------------------------------
+! -------------------------------------------------------------
 
-TUPLE: face { halfspace array } touching-corners adjacent-faces ;
+TUPLE: face { halfspace array } 
+    touching-corners adjacent-faces ;
 : <face> ( v -- tuple )       face new swap >>halfspace ;
 : flip-face ( face -- face ) [ vneg ] change-halfspace ;
-: erase-face-touching-corners ( face -- face ) f >>touching-corners ;
+: erase-face-touching-corners ( face -- face ) 
-: erase-face-adjacent-faces ( face -- face )   f >>adjacent-faces ;
+    f >>touching-corners ;
+: erase-face-adjacent-faces ( face -- face )   
+    f >>adjacent-faces ;
 : faces-intersection ( faces -- v )  
     [ halfspace>> ] map intersect-hyperplanes ;
 : face-translate ( face v -- face ) 
@@ -139,7 +146,8 @@ TUPLE: face { halfspace array } touching-corners adjacent-faces ;
 : suffix-touching-corner ( face corner -- face ) 
     [ suffix ] curry   change-touching-corners ; inline
 : real-face? ( face -- ? )
-    [ touching-corners>> length ] [ halfspace>> dimension ] bi >= ;
+    [ touching-corners>> length ] 
+    [ halfspace>> dimension ] bi >= ;
 
 : (add-to-adjacent-faces) ( face face -- face )
     over adjacent-faces>> 2dup member?
@@ -203,7 +211,8 @@ TUPLE: face { halfspace array } touching-corners adjacent-faces ;
     [ ] (intersection-into-face) ;
 
 : intersections-into-faces ( face -- faces )
-    clone dup  adjacent-faces>> [ intersection-into-face ] with map 
+    clone dup  
+    adjacent-faces>> [ intersection-into-face ] with map 
     [ ] filter ;
 
 : (face-silhouette) ( face -- faces )
@@ -219,30 +228,32 @@ TUPLE: face { halfspace array } touching-corners adjacent-faces ;
 
 ! --------------------------------
 ! solid
-! --------------------------------------------------------------
+! -------------------------------------------------------------
-TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
+TUPLE: solid dimension silhouettes 
+    faces corners adjacencies-valid color name ;
 
 : <solid> ( -- tuple ) solid new ;
 
 : suffix-silhouettes ( solid silhouette -- solid )  
     [ suffix ] curry change-silhouettes ;
 
-: suffix-face ( solid face -- solid )     [ suffix ] curry change-faces ;
+: suffix-face ( solid face -- solid )     
-
+    [ suffix ] curry change-faces ;
-: suffix-corner ( solid corner -- solid ) [ suffix ] curry change-corners ; 
+: suffix-corner ( solid corner -- solid ) 
-
+    [ suffix ] curry change-corners ; 
 : erase-solid-corners ( solid -- solid )  f >>corners ;
 
-: erase-silhouettes ( solid -- solid ) dup dimension>> f <array> >>silhouettes ;
+: erase-silhouettes ( solid -- solid ) 
-
+    dup dimension>> f <array> >>silhouettes ;
-: filter-real-faces ( solid -- solid ) [ [ real-face? ] filter ] change-faces ;
+: filter-real-faces ( solid -- solid ) 
-
+    [ [ real-face? ] filter ] change-faces ;
 : initiate-solid-from-face ( face -- solid ) 
     face-project-dim  <solid> swap >>dimension ;
 
 : erase-old-adjacencies ( solid -- solid )
     erase-solid-corners
-    [ dup [ erase-face-touching-corners erase-face-adjacent-faces drop ] each ]
+    [ dup [ erase-face-touching-corners 
+        erase-face-adjacent-faces drop ] each ]
     change-faces ;
 
 : point-inside-or-on-face? ( face v -- ? ) 
@@ -255,10 +266,12 @@ TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
     [ faces>> ] dip [ point-inside-face? ] curry all? ; inline
 
 : point-inside-or-on-solid? ( solid point -- ? )
-    [ faces>> ] dip [ point-inside-or-on-face? ] curry  all?   ; inline
+    [ faces>> ] dip 
+    [ point-inside-or-on-face? ] curry  all?   ; inline
 
 : unvalid-adjacencies ( solid -- solid )  
-    erase-old-adjacencies f >>adjacencies-valid erase-silhouettes ;
+    erase-old-adjacencies f >>adjacencies-valid 
+    erase-silhouettes ;
 
 : add-face ( solid face -- solid ) 
     suffix-face unvalid-adjacencies ; 
@@ -338,8 +351,10 @@ TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
     ensure-silhouettes
     ;
 
-: (non-empty-solid?) ( solid -- ? ) [ dimension>> ] [ corners>> length ] bi < ;
+: (non-empty-solid?) ( solid -- ? ) 
-: non-empty-solid? ( solid -- ? )   ensure-adjacencies (non-empty-solid?) ;
+    [ dimension>> ] [ corners>> length ] bi < ;
+: non-empty-solid? ( solid -- ? )   
+    ensure-adjacencies (non-empty-solid?) ;
 
 : compare-corners-roughly ( corner corner -- ? )
     2drop t ;
@@ -367,8 +382,10 @@ TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
    [ dup faces>> ] dip call drop  
    unvalid-adjacencies ; inline
 
-: solid-translate ( solid v -- solid ) [ face-translate ] (solid-move) ; 
+: solid-translate ( solid v -- solid ) 
-: solid-transform ( solid m -- solid ) [ face-transform ] (solid-move) ; 
+    [ face-translate ] (solid-move) ; 
+: solid-transform ( solid m -- solid ) 
+    [ face-transform ] (solid-move) ; 
 
 : find-corner-in-silhouette ( s1 s2 -- elt bool )
     pv> swap silhouettes>> nth     
@@ -402,13 +419,15 @@ TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
     [ ensure-adjacencies ] map
 ; inline
 
-! --------------------------------------------------------------
+! -------------------------------------------------------------
 ! space 
-! --------------------------------------------------------------
+! -------------------------------------------------------------
 TUPLE: space name dimension solids ambient-color lights ;
 : <space> ( -- space )      space new ;
-: suffix-solids ( space solid -- space ) [ suffix ] curry change-solids ; inline
+: suffix-solids ( space solid -- space ) 
-: suffix-lights ( space light -- space ) [ suffix ] curry change-lights ; inline
+    [ suffix ] curry change-solids ; inline
+: suffix-lights ( space light -- space ) 
+    [ suffix ] curry change-lights ; inline
 : clear-space-solids ( space -- space )     f >>solids ;
 
 : space-ensure-solids ( space -- space ) 
@@ -417,19 +436,24 @@ TUPLE: space name dimension solids ambient-color lights ;
     [ [ non-empty-solid? ] filter ] change-solids ;
 
 : projected-space ( space solids -- space ) 
-   swap dimension>> 1-  <space>    swap >>dimension    swap  >>solids ;
+   swap dimension>> 1-  <space>    
+   swap >>dimension    swap  >>solids ;
 
-: get-silhouette ( solid -- silhouette )    silhouettes>> pv> swap nth ;
+: get-silhouette ( solid -- silhouette )    
+    silhouettes>> pv> swap nth ;
 : solid= ( solid solid -- ? )            [ corners>> ]  bi@ = ;
 
 : space-apply ( space m quot -- space ) 
         curry [ map ] curry [ dup solids>> ] dip
         [ call ] [ drop ] recover drop ;
-: space-transform ( space m -- space ) [ solid-transform ] space-apply ;
+: space-transform ( space m -- space ) 
-: space-translate ( space v -- space ) [ solid-translate ] space-apply ; 
+    [ solid-transform ] space-apply ;
+: space-translate ( space v -- space ) 
+    [ solid-translate ] space-apply ; 
 
 : describe-space ( space -- ) 
-    solids>>  [  [ corners>>  [ pprint ] each ] [ name>> . ] bi ] each ;
+    solids>>  
+    [  [ corners>>  [ pprint ] each ] [ name>> . ] bi ] each ;
 
 : clip-solid ( solid solid -- solids )
     [ ]
@@ -451,7 +475,8 @@ TUPLE: space name dimension solids ambient-color lights ;
 ; inline 
 
 : remove-hidden-solids ( space -- space ) 
-! We must include each solid in a sequence because during substration 
+! We must include each solid in a sequence because 
+! during substration 
 ! a solid can be divided in more than on solid
     [ 
         [ [ 1array ] map ] 
@@ -489,9 +514,9 @@ TUPLE: space name dimension solids ambient-color lights ;
     [ [ ] [ v+ ] map-reduce ] [ length ] bi v/n
 ;
 
-! --------------------------------------------------------------
+! -------------------------------------------------------------
 ! 3D rendering
-! --------------------------------------------------------------
+! -------------------------------------------------------------
 
 : face-reference ( face -- halfspace point vect )
        [ halfspace>> ] 
@@ -523,8 +548,10 @@ TUPLE: space name dimension solids ambient-color lights ;
 
 : face->GL ( face color -- )
    [ ordered-face-points ] dip
-   [ first3 1.0 glColor4d GL_POLYGON [ [ point->GL  ] each ] do-state ] curry
+   [ first3 1.0 glColor4d GL_POLYGON 
-   [  0 0 0 1 glColor4d GL_LINE_LOOP [ [ point->GL  ] each ] do-state ]
+        [ [ point->GL  ] each ] do-state ] curry
+   [  0 0 0 1 glColor4d GL_LINE_LOOP 
+        [ [ point->GL  ] each ] do-state ]
    bi
    ; inline
 

extra/adsoda/combinators/combinators-docs.factor

@@ -5,7 +5,7 @@ IN: adsoda.combinators
 
 HELP: among
 { $values
-     { "array" array } { "n" null }
+     { "array" array } { "n" "number of value to select" }
      { "array" array }
 }
 { $description "returns an array containings every possibilities of n choices among a given sequence" } ;
@@ -32,7 +32,7 @@ HELP: do-cycle
 { $description "Copy the first element at the end of the sequence in order to close the cycle." } ;
 
 
-ARTICLE: "adsoda.combinators" "adsoda.combinators"
+ARTICLE: "adsoda.combinators" "Combinators"
 { $vocab-link "adsoda.combinators" }
 ;
 

extra/adsoda/combinators/combinators.factor

@@ -34,7 +34,8 @@ IN: adsoda.combinators
     } cond
 ;
 
-: concat-nth ( seq1 seq2 -- seq )  [ nth append ] curry map-index ;
+: concat-nth ( seq1 seq2 -- seq )  
+    [ nth append ] curry map-index ;
 
 : do-cycle   ( array -- array )   dup first suffix ;
 

extra/adsoda/tools/tools-docs.factor

@@ -9,7 +9,7 @@ HELP: 3cube
     { "solid" "solid" } 
 }
 { $description "array : xmin xmax ymin ymax zmin zmax" 
-"\n returns a 3D solid with given limits"
+"returns a 3D solid with given limits"
 } ;
 
 HELP: 4cube
@@ -18,24 +18,10 @@ HELP: 4cube
     { "solid" "solid" } 
 }
 { $description "array : xmin xmax ymin ymax zmin zmax wmin wmax"  
-"\n returns a 4D solid with given limits"
+"returns a 4D solid with given limits"
 } ;
 
 
-HELP: coord-max
-{ $values
-     { "x" null } { "array" array }
-     { "array" array }
-}
-{ $description "" } ;
-
-HELP: coord-min
-{ $values
-     { "x" null } { "array" array }
-     { "array" array }
-}
-{ $description "" } ;
-
 HELP: equation-system-for-normal
 { $values
      { "points" "a list of n points" }
@@ -51,8 +37,8 @@ HELP: normal-vector
      { "v" "a vector" }
 }
 { $description "From a list of points, returns the vector normal to the plan defined by the points" 
-"\nWith n points, creates n-1 vectors and then find a vector orthogonal to every others"
+"With n points, creates n-1 vectors and then find a vector orthogonal to every others"
-"\n returns { f } if a normal vector can not be found" } 
+"returns { f } if a normal vector can not be found" } 
 ;
 
 HELP: points-to-hyperplane
@@ -61,14 +47,14 @@ HELP: points-to-hyperplane
      { "hyperplane" "an hyperplane equation" }
 }
 { $description "From a list of points, returns the equation of the hyperplan"
-"\n Finds a normal vector and then translate it so that it includes one of the points"
+"Finds a normal vector and then translate it so that it includes one of the points"
 
 } 
 ;
 
-ARTICLE: "adsoda.tools" "adsoda.tools"
+ARTICLE: "adsoda.tools" "Tools"
 { $vocab-link "adsoda.tools" }
-"\nTools to help in building an " { $vocab-link "adsoda" } "-space"
+"Tools to help in building an " { $vocab-link "adsoda" } "-space"
 ;
 
 ABOUT: "adsoda.tools"

extra/adsoda/tools/tools.factor

@@ -79,7 +79,8 @@ IN: adsoda.tools
     translate ;
 
 : refs-to-points ( points faces -- faces )
-   [ swap [ nth 10 v*n { 100 100 100 } v+ ] curry map    ] with map
+   [ swap [ nth 10 v*n { 100 100 100 } v+ ] curry map ] 
+   with map
 ;
 ! V{ { 0.1 0.2 } { 1.1 1.3 } } V{ { 1 0 } { 0 1 } }
 ! V{ { { 1.1 1.3 } { 0.1 0.2 } } { { 0.1 0.2 } { 1.1 1.3 } } }
@@ -102,13 +103,15 @@ refs-to-points
 ;
 : 2-faces-to-prism ( seq seq -- seq )
   2dup
-    [ do-cycle 2 clump ] bi@ concat-nth  !  3 faces rectangulaires
+    [ do-cycle 2 clump ] bi@ concat-nth  
+    !  3 faces rectangulaires
     swap prefix
     swap prefix
 ;    
 
 : Xpoints-to-prisme ( seq height -- cube )
-    ! from 3 points gives a list of faces representing a cube of height "height"
+    ! from 3 points gives a list of faces representing 
+    ! a cube of height "height"
     ! and of based on the three points
     ! a face is a group of 3 or mode points.   
     [ dup dup  3points-to-normal ] dip 
@@ -121,7 +124,8 @@ refs-to-points
 
 
 : Xpoints-to-plane4D ( seq x y -- 4Dplane )
-    ! from 3 points gives a list of faces representing a cube in 4th dim
+    ! from 3 points gives a list of faces representing 
+    ! a cube in 4th dim
     ! from x to y (height = y-x)
     ! and of based on the X points
     ! a face is a group of 3 or mode points.   
@@ -130,7 +134,8 @@ refs-to-points
 ;
 
 : 3pointsfaces-to-3Dsolidfaces ( seq -- seq )
-    [ 1 Xpoints-to-prisme [ 100 110 Xpoints-to-plane4D ] map concat ] map 
+    [ 1 Xpoints-to-prisme [ 100 
+        110 Xpoints-to-plane4D ] map concat ] map 
 
 ;
 

extra/ui/gadgets/slate/slate-docs.factor

@@ -0,0 +1,13 @@
+! Copyright (C) 2009 Eduardo Cavazos
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax multiline ;
+IN: ui.gadgets.slate
+
+ARTICLE: "ui.gadgets.slate" "Slate gadget"
+{ $description "A gadget with an 'action' slot which should be set to a callable."}
+{ $heading "Example" }
+{ $code <" USING: processing.shapes ui.gadgets.slate ui.gadgets.panes ;
+[ { { 10 10 } { 50 30 } { 10 50 } } polygon fill-mode ] <slate>
+gadget."> } ;
+
+ABOUT: "ui.gadgets.slate"

extra/ui/gadgets/slate/slate.factor

@@ -1,32 +1,11 @@
-
+! Copyright (C) 2009 Eduardo Cavazos
-USING: kernel namespaces opengl ui.render ui.gadgets accessors
+! See http://factorcode.org/license.txt for BSD license.
-       help.syntax
+USING: kernel namespaces opengl ui.render ui.gadgets accessors ;
-       easy-help ;
 
 IN: ui.gadgets.slate
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-ARTICLE: "slate" "Slate Gadget"
-
-Summary:
-
-    A gadget with an 'action' slot which should be set to a callable.  ..
-
-Example:
-
-    ! Load the right vocabs for the examples
-
-    USING: processing.shapes ui.gadgets.slate ;    ..
-
-Example:
-
-    [ { { 10 10 } { 50 30 } { 10 50 } } polygon fill-mode ] <slate>
-    gadget.  ..
-
-;
-
-ABOUT: "slate"
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

unmaintained/4DNav/4DNav-docs.factor

@@ -1,400 +0,0 @@
-! Copyright (C) 2008 Jean-François Bigot.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel quotations strings ;
-IN: 4DNav
-
-HELP: (mvt-4D)
-{ $values
-     { "quot" quotation }
-}
-{ $description "" } ;
-
-HELP: 4D-Rxw
-{ $values
-     { "angle" null }
-     { "Rz" null }
-}
-{ $description "" } ;
-
-HELP: 4D-Rxy
-{ $values
-     { "angle" null }
-     { "Rx" null }
-}
-{ $description "" } ;
-
-HELP: 4D-Rxz
-{ $values
-     { "angle" null }
-     { "Ry" null }
-}
-{ $description "" } ;
-
-HELP: 4D-Ryw
-{ $values
-     { "angle" null }
-     { "Ry" null }
-}
-{ $description "" } ;
-
-HELP: 4D-Ryz
-{ $values
-     { "angle" null }
-     { "Rx" null }
-}
-{ $description "" } ;
-
-HELP: 4D-Rzw
-{ $values
-     { "angle" null }
-     { "Rz" null }
-}
-{ $description "" } ;
-
-HELP: 4DNav
-{ $description "" } ;
-
-HELP: >observer3d
-{ $values
-     { "value" null }
-}
-{ $description "" } ;
-
-HELP: >present-space
-{ $values
-     { "value" null }
-}
-{ $description "" } ;
-
-
-HELP: >view1
-{ $values
-     { "value" null }
-}
-{ $description "" } ;
-
-HELP: >view2
-{ $values
-     { "value" null }
-}
-{ $description "" } ;
-
-HELP: >view3
-{ $values
-     { "value" null }
-}
-{ $description "" } ;
-
-HELP: >view4
-{ $values
-     { "value" null }
-}
-{ $description "" } ;
-
-HELP: add-keyboard-delegate
-{ $values
-     { "obj" object }
-     { "obj" object }
-}
-{ $description "" } ;
-
-HELP: button*
-{ $values
-     { "string" string } { "quot" quotation }
-     { "button" null }
-}
-{ $description "" } ;
-
-HELP: camera-action
-{ $values
-     { "quot" quotation }
-     { "quot" quotation }
-}
-{ $description "" } ;
-
-HELP: camera-button
-{ $values
-     { "string" string } { "quot" quotation }
-     { "button" null }
-}
-{ $description "" } ;
-
-HELP: controller-window*
-{ $values
-     { "gadget" "a gadget" } 
-}
-{ $description "" } ;
-
-
-HELP: init-models
-{ $description "" } ;
-
-HELP: init-variables
-{ $description "" } ;
-
-HELP: menu-3D
-{ $values
-     { "gadget" null }
-}
-{ $description "The menu dedicated to 3D movements of the camera" } ;
-
-HELP: menu-4D
-{ $values
-    
-     { "gadget" null }
-}
-{ $description "The menu dedicated to 4D movements of space" } ;
-
-HELP: menu-bar
-{ $values
-    
-     { "gadget" null }
-}
-{ $description "return gadget containing menu buttons" } ;
-
-HELP: model-projection
-{ $values
-     { "x" null }
-     { "space" null }
-}
-{ $description "Project space following coordinate x" } ;
-
-HELP: mvt-3D-1
-{ $values
-    
-     { "quot" quotation }
-}
-{ $description "return a quotation to orientate space to see it from first point of view" } ;
-
-HELP: mvt-3D-2
-{ $values
-    
-     { "quot" quotation }
-}
-{ $description "return a quotation to orientate space to see it from second point of view" } ;
-
-HELP: mvt-3D-3
-{ $values
-    
-     { "quot" quotation }
-}
-{ $description "return a quotation to orientate space to see it from third point of view" } ;
-
-HELP: mvt-3D-4
-{ $values
-    
-     { "quot" quotation }
-}
-{ $description "return a quotation to orientate space to see it from first point of view" } ;
-
-HELP: observer3d
-{ $description "" } ;
-
-HELP: observer3d>
-{ $values
-    
-     { "value" null }
-}
-{ $description "" } ;
-
-HELP: present-space
-{ $description "" } ;
-
-HELP: present-space>
-{ $values
-    
-     { "value" null }
-}
-{ $description "" } ;
-
-HELP: load-model-file
-{ $description "load space from file" } ;
-
-HELP: rotation-4D
-{ $values
-     { "m" "a rotation matrix" }
-}
-{ $description "Apply a 4D rotation matrix" } ;
-
-HELP: translation-4D
-{ $values
-     { "v" null }
-}
-{ $description "" } ;
-
-HELP: update-model-projections
-{ $description "" } ;
-
-HELP: update-observer-projections
-{ $description "" } ;
-
-HELP: view1
-{ $description "" } ;
-
-HELP: view1>
-{ $values
-    
-     { "value" null }
-}
-{ $description "" } ;
-
-HELP: view2
-{ $description "" } ;
-
-HELP: view2>
-{ $values
-    
-     { "value" null }
-}
-{ $description "" } ;
-
-HELP: view3
-{ $description "" } ;
-
-HELP: view3>
-{ $values
-    
-     { "value" null }
-}
-{ $description "" } ;
-
-HELP: view4
-{ $description "" } ;
-
-HELP: view4>
-{ $values
-    
-     { "value" null }
-}
-{ $description "" } ;
-
-HELP: viewer-windows*
-{ $description "" } ;
-
-HELP: win3D
-{ $values
-     { "text" null } { "gadget" null }
-}
-{ $description "" } ;
-
-HELP: windows
-{ $description "" } ;
-
-ARTICLE: "Space file" "Create a new space file"
-"\nTo build a new space, create an XML file using " { $vocab-link "adsoda" } " model description. \nAn example is:"
-$nl
-
-"\n<model>"
-"\n<space>"
-"\n <dimension>4</dimension>"
-"\n <solid>"
-"\n     <name>4cube1</name>"
-"\n     <dimension>4</dimension>"
-"\n     <face>1,0,0,0,100</face>"
-"\n     <face>-1,0,0,0,-150</face>"
-"\n     <face>0,1,0,0,100</face>"
-"\n     <face>0,-1,0,0,-150</face>"
-"\n     <face>0,0,1,0,100</face>"
-"\n     <face>0,0,-1,0,-150</face>"
-"\n     <face>0,0,0,1,100</face>"
-"\n     <face>0,0,0,-1,-150</face>"
-"\n     <color>1,0,0</color>"
-"\n </solid>"
-"\n <solid>"
-"\n     <name>4triancube</name>"
-"\n     <dimension>4</dimension>"
-"\n     <face>1,0,0,0,160</face>"
-"\n     <face>-0.4999999999999998,-0.8660254037844387,0,0,-130</face>"
-"\n     <face>-0.5000000000000004,0.8660254037844384,0,0,-130</face>"
-"\n     <face>0,0,1,0,140</face>"
-"\n     <face>0,0,-1,0,-180</face>"
-"\n     <face>0,0,0,1,110</face>"
-"\n     <face>0,0,0,-1,-180</face>"
-"\n     <color>0,1,0</color>"
-"\n </solid>"
-"\n <solid>"
-"\n     <name>triangone</name>"
-"\n     <dimension>4</dimension>"
-"\n     <face>1,0,0,0,60</face>"
-"\n     <face>0.5,0.8660254037844386,0,0,60</face>"
-"\n     <face>-0.5,0.8660254037844387,0,0,-20</face>"
-"\n     <face>-1.0,0,0,0,-100</face>"
-"\n     <face>-0.5,-0.8660254037844384,0,0,-100</face>"
-"\n     <face>0.5,-0.8660254037844387,0,0,-20</face>"
-"\n     <face>0,0,1,0,120</face>"
-"\n     <face>0,0,-0.4999999999999998,-0.8660254037844387,-120</face>"
-"\n     <face>0,0,-0.5000000000000004,0.8660254037844384,-120</face>"
-"\n     <color>0,1,1</color>"
-"\n </solid>"
-"\n <light>"
-"\n     <direction>1,1,1,1</direction>"
-"\n     <color>0.2,0.2,0.6</color>"
-"\n </light>"
-"\n <color>0.8,0.9,0.9</color>"
-"\n</space>"
-"\n</model>"
-
-
-;
-
-ARTICLE: "TODO" "Todo"
-{ $list 
-    "A file chooser"
-    "A vocab to initialize parameters"
-    "an editor mode" 
-        { $list "add a face to a solid"
-                "add a solid to the space"
-                "move a face"
-                "move a solid"
-                "select a solid in a list"
-                "select a face"
-                "display selected face"
-                "edit a solid color"
-                "add a light"
-                "edit a light color"
-                "move a light"
-                }
-    "add a tool wich give an hyperplane normal vector with enought points. Will use adsoda.intersect-hyperplanes with { { 0 } { 0 } { 1 } } "
-    "decorrelate 3D camera and activate them with select buttons"
-
-
-
-} ;
-
-
-ARTICLE: "4DNav" "4DNav"
-{ $vocab-link "4DNav" }
-$nl
-{ $heading "4D Navigator" }
-"4DNav is a simple tool to visualize 4 dimensionnal objects."
-"\n"
-"It uses " { $vocab-link "adsoda" } " library to display a 4D space and navigate thru it."
-
-"It will display:"
-{ $list
-    { "a menu window" }
-    {  "4 visualization windows" }
-}
-"Each window represents the projection of the 4D space on a particular 3D space."
-$nl
-
-{ $heading "Initialization" }
-"put the space file " { $strong "space-exemple.xml" } "  in temp directory"
-" and then type:" { $code "\"4DNav\" run" } 
-{ $heading "Navigation" }
-"4D submenu move the space in translations and rotation."
-"\n3D submenu move the camera in 3D space. Cameras in every 3D spaces are manipulated as a single one"
-$nl
-
-
-
-
-{ $heading "Links" }
-{ $subsection "Space file" }
-
-{ $subsection "TODO" }
-
-
-;
-
-ABOUT: "4DNav"

unmaintained/4DNav/camera/camera.factor

@@ -1,15 +0,0 @@
-USING: kernel namespaces math.vectors opengl 4DNav.turtle self ;
-
-IN: 4DNav.camera
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: camera-eye ( -- point ) turtle-pos> ;
-
-: camera-focus ( -- point ) [ 1 step-turtle turtle-pos> ] save-self ;
-
-: camera-up ( -- dirvec )
-[ 90 pitch-up turtle-pos> 1 step-turtle turtle-pos> swap v- ] save-self ;
-
-: do-look-at ( camera -- )
-[ >self camera-eye camera-focus camera-up gl-look-at ] with-scope ;

unmaintained/4DNav/deep/deep.factor

@@ -1,11 +0,0 @@
-USING: macros quotations math math.functions math.trig sequences.deep kernel make fry combinators grouping ;
-IN: 4DNav.deep
-
-! USING: bake ;
-! MACRO: deep-cleave-quots ( seq -- quot )
-!    [ [ quotation? ] deep-filter ]
-!    [ [ dup quotation? [ drop , ] when ] deep-map ]
-!    bi '[ _ cleave _ bake ] ;
-
-: make-matrix ( quot width -- matrix ) [ { } make ] dip group ; inline
-

unmaintained/4DNav/space-file-decoder/space-file-decoder.factor

@@ -1,55 +0,0 @@
-! Copyright (C) 2008 Jeff Bigot
-! See http://factorcode.org/license.txt for BSD license.
-USING: adsoda xml xml.utilities xml.dispatch accessors combinators
-sequences math.parser kernel splitting values continuations ;
-IN: 4DNav.space-file-decoder
-
-: decode-number-array ( x -- y )  "," split [ string>number ] map ;
-
-PROCESS: adsoda-read-model ( tag -- )
-
-TAG: dimension adsoda-read-model children>> first string>number ;
-TAG: direction adsoda-read-model children>> first decode-number-array ;
-TAG: color     adsoda-read-model children>> first decode-number-array ;
-TAG: name      adsoda-read-model children>> first ;
-TAG: face      adsoda-read-model children>> first decode-number-array ;
-
-TAG: solid adsoda-read-model 
-    <solid> swap  
-    { 
-        [ "dimension" tag-named adsoda-read-model >>dimension ] 
-        [ "name"      tag-named adsoda-read-model >>name ] 
-        [ "color"     tag-named adsoda-read-model >>color ] 
-        [ "face"      tags-named [ adsoda-read-model cut-solid ] each ] 
-    } cleave
-    ensure-adjacencies
-;
-
-TAG: light adsoda-read-model 
-   <light> swap  
-    { 
-        [ "direction" tag-named adsoda-read-model >>direction ] 
-        [ "color"     tag-named adsoda-read-model >>color ] 
-    } cleave
-;
-
-TAG: space adsoda-read-model 
-    <space> swap  
-    { 
-        [ "dimension" tag-named adsoda-read-model >>dimension ] 
-        [ "name"      tag-named adsoda-read-model >>name ] 
-        [ "color"     tag-named adsoda-read-model >>ambient-color ] 
-        [ "solid"     tags-named [ adsoda-read-model suffix-solids ] each ] 
-        [ "light"     tags-named [ adsoda-read-model suffix-lights ] each ]         
-    } cleave
-;
-
-: read-model-file ( path -- x )
-  dup
-  [
-    [ file>xml "space" tags-named first adsoda-read-model ] 
-    [ drop <space> ] recover 
-  ] [  drop <space> ] if 
-
-;
-

unmaintained/4DNav/turtle/turtle-docs.factor

@@ -1,229 +0,0 @@
-! Copyright (C) 2008 Jean-François Bigot.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays help.markup help.syntax kernel sequences ;
-IN: 4DNav.turtle
-
-HELP: <turtle>
-{ $values
-    
-     { "turtle" null }
-}
-{ $description "" } ;
-
-HELP: >turtle-ori
-{ $values
-     { "val" null }
-}
-{ $description "" } ;
-
-HELP: >turtle-pos
-{ $values
-     { "val" null }
-}
-{ $description "" } ;
-
-HELP: Rx
-{ $values
-     { "angle" null }
-     { "Rz" null }
-}
-{ $description "" } ;
-
-HELP: Ry
-{ $values
-     { "angle" null }
-     { "Ry" null }
-}
-{ $description "" } ;
-
-HELP: Rz
-{ $values
-     { "angle" null }
-     { "Rx" null }
-}
-{ $description "" } ;
-
-HELP: V
-{ $values
-    
-     { "V" null }
-}
-{ $description "" } ;
-
-HELP: X
-{ $values
-    
-     { "3array" null }
-}
-{ $description "" } ;
-
-HELP: Y
-{ $values
-    
-     { "3array" null }
-}
-{ $description "" } ;
-
-HELP: Z
-{ $values
-    
-     { "3array" null }
-}
-{ $description "" } ;
-
-HELP: apply-rotation
-{ $values
-     { "rotation" null }
-}
-{ $description "" } ;
-
-HELP: distance
-{ $values
-     { "turtle" null } { "turtle" null }
-     { "n" null }
-}
-{ $description "" } ;
-
-HELP: move-by
-{ $values
-     { "point" null }
-}
-{ $description "" } ;
-
-HELP: pitch-down
-{ $values
-     { "angle" null }
-}
-{ $description "" } ;
-
-HELP: pitch-up
-{ $values
-     { "angle" null }
-}
-{ $description "" } ;
-
-HELP: reset-turtle
-{ $description "" } ;
-
-HELP: roll-left
-{ $values
-     { "angle" null }
-}
-{ $description "" } ;
-
-HELP: roll-right
-{ $values
-     { "angle" null }
-}
-{ $description "" } ;
-
-HELP: roll-until-horizontal
-{ $description "" } ;
-
-HELP: rotate-x
-{ $values
-     { "angle" null }
-}
-{ $description "" } ;
-
-HELP: rotate-y
-{ $values
-     { "angle" null }
-}
-{ $description "" } ;
-
-HELP: rotate-z
-{ $values
-     { "angle" null }
-}
-{ $description "" } ;
-
-HELP: set-X
-{ $values
-     { "seq" sequence }
-}
-{ $description "" } ;
-
-HELP: set-Y
-{ $values
-     { "seq" sequence }
-}
-{ $description "" } ;
-
-HELP: set-Z
-{ $values
-     { "seq" sequence }
-}
-{ $description "" } ;
-
-HELP: step-turtle
-{ $values
-     { "length" null }
-}
-{ $description "" } ;
-
-HELP: step-vector
-{ $values
-     { "length" null }
-     { "array" array }
-}
-{ $description "" } ;
-
-HELP: strafe-down
-{ $values
-     { "length" null }
-}
-{ $description "" } ;
-
-HELP: strafe-left
-{ $values
-     { "length" null }
-}
-{ $description "" } ;
-
-HELP: strafe-right
-{ $values
-     { "length" null }
-}
-{ $description "" } ;
-
-HELP: strafe-up
-{ $values
-     { "length" null }
-}
-{ $description "" } ;
-
-HELP: turn-left
-{ $values
-     { "angle" null }
-}
-{ $description "" } ;
-
-HELP: turn-right
-{ $values
-     { "angle" null }
-}
-{ $description "" } ;
-
-HELP: turtle
-{ $description "" } ;
-
-HELP: turtle-ori>
-{ $values
-    
-     { "val" null }
-}
-{ $description "" } ;
-
-HELP: turtle-pos>
-{ $values
-    
-     { "val" null }
-}
-{ $description "" } ;
-
-ARTICLE: "4DNav.turtle" "4DNav.turtle"
-{ $vocab-link "4DNav.turtle" }
-;
-
-ABOUT: "4DNav.turtle"