Merge branch 'master' of git://repo.or.cz/factor/jcg
Slava Pestov
commit
c41f00b1e9
|
|
@ -1,4 +1,4 @@
|
||||||
USING: alien byte-arrays help.markup help.syntax math math.blas.vectors sequences strings ;
|
USING: alien byte-arrays help.markup help.syntax math math.blas.vectors sequences strings multiline ;
|
||||||
IN: math.blas.matrices
|
IN: math.blas.matrices
|
||||||
|
|
||||||
ARTICLE: "math.blas-summary" "Basic Linear Algebra Subroutines (BLAS) interface"
|
ARTICLE: "math.blas-summary" "Basic Linear Algebra Subroutines (BLAS) interface"
|
||||||
|
|
@ -21,8 +21,6 @@ ARTICLE: "math.blas-types" "BLAS interface types"
|
||||||
{ $subsection double-blas-matrix }
|
{ $subsection double-blas-matrix }
|
||||||
{ $subsection float-complex-blas-matrix }
|
{ $subsection float-complex-blas-matrix }
|
||||||
{ $subsection double-complex-blas-matrix }
|
{ $subsection double-complex-blas-matrix }
|
||||||
"Syntax words are provided for constructing literal vectors and matrices in the " { $vocab-link "math.blas.syntax" } " vocabulary:"
|
|
||||||
{ $subsection "math.blas.syntax" }
|
|
||||||
"There are BOA constructors for all vector and matrix types, which provide the most flexibility in specifying memory layout:"
|
"There are BOA constructors for all vector and matrix types, which provide the most flexibility in specifying memory layout:"
|
||||||
{ $subsection <float-blas-vector> }
|
{ $subsection <float-blas-vector> }
|
||||||
{ $subsection <double-blas-vector> }
|
{ $subsection <double-blas-vector> }
|
||||||
|
|
@ -74,7 +72,13 @@ ARTICLE: "math.blas.matrices" "BLAS interface matrix operations"
|
||||||
{ $subsection n*M! }
|
{ $subsection n*M! }
|
||||||
{ $subsection n*M }
|
{ $subsection n*M }
|
||||||
{ $subsection M*n }
|
{ $subsection M*n }
|
||||||
{ $subsection M/n } ;
|
{ $subsection M/n }
|
||||||
|
"Literal syntax:"
|
||||||
|
{ $subsection POSTPONE: smatrix{ }
|
||||||
|
{ $subsection POSTPONE: dmatrix{ }
|
||||||
|
{ $subsection POSTPONE: cmatrix{ }
|
||||||
|
{ $subsection POSTPONE: zmatrix{ } ;
|
||||||
|
|
||||||
|
|
||||||
ABOUT: "math.blas.matrices"
|
ABOUT: "math.blas.matrices"
|
||||||
|
|
||||||
|
|
@ -243,3 +247,43 @@ HELP: <empty-vector>
|
||||||
{ $values { "length" "The length of the new vector" } { "exemplar" blas-vector-base blas-matrix-base } { "vector" blas-vector-base } }
|
{ $values { "length" "The length of the new vector" } { "exemplar" blas-vector-base blas-matrix-base } { "vector" blas-vector-base } }
|
||||||
{ $description "Return a vector of zeros with the given " { $snippet "length" } " and the same element type as " { $snippet "v" } "." } ;
|
{ $description "Return a vector of zeros with the given " { $snippet "length" } " and the same element type as " { $snippet "v" } "." } ;
|
||||||
|
|
||||||
|
HELP: smatrix{
|
||||||
|
{ $syntax <" smatrix{
|
||||||
|
{ 1.0 0.0 0.0 1.0 }
|
||||||
|
{ 0.0 1.0 0.0 2.0 }
|
||||||
|
{ 0.0 0.0 1.0 3.0 }
|
||||||
|
{ 0.0 0.0 0.0 1.0 }
|
||||||
|
} "> }
|
||||||
|
{ $description "Construct a literal " { $link float-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
|
||||||
|
|
||||||
|
HELP: dmatrix{
|
||||||
|
{ $syntax <" dmatrix{
|
||||||
|
{ 1.0 0.0 0.0 1.0 }
|
||||||
|
{ 0.0 1.0 0.0 2.0 }
|
||||||
|
{ 0.0 0.0 1.0 3.0 }
|
||||||
|
{ 0.0 0.0 0.0 1.0 }
|
||||||
|
} "> }
|
||||||
|
{ $description "Construct a literal " { $link double-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
|
||||||
|
|
||||||
|
HELP: cmatrix{
|
||||||
|
{ $syntax <" cmatrix{
|
||||||
|
{ 1.0 0.0 0.0 1.0 }
|
||||||
|
{ 0.0 C{ 0.0 1.0 } 0.0 2.0 }
|
||||||
|
{ 0.0 0.0 -1.0 3.0 }
|
||||||
|
{ 0.0 0.0 0.0 C{ 0.0 -1.0 } }
|
||||||
|
} "> }
|
||||||
|
{ $description "Construct a literal " { $link float-complex-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
|
||||||
|
|
||||||
|
HELP: zmatrix{
|
||||||
|
{ $syntax <" zmatrix{
|
||||||
|
{ 1.0 0.0 0.0 1.0 }
|
||||||
|
{ 0.0 C{ 0.0 1.0 } 0.0 2.0 }
|
||||||
|
{ 0.0 0.0 -1.0 3.0 }
|
||||||
|
{ 0.0 0.0 0.0 C{ 0.0 -1.0 } }
|
||||||
|
} "> }
|
||||||
|
{ $description "Construct a literal " { $link double-complex-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
|
||||||
|
|
||||||
|
{
|
||||||
|
POSTPONE: smatrix{ POSTPONE: dmatrix{
|
||||||
|
POSTPONE: cmatrix{ POSTPONE: zmatrix{
|
||||||
|
} related-words
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
USING: kernel math.blas.matrices math.blas.vectors math.blas.syntax
|
USING: kernel math.blas.matrices math.blas.vectors
|
||||||
sequences tools.test ;
|
sequences tools.test ;
|
||||||
IN: math.blas.matrices.tests
|
IN: math.blas.matrices.tests
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,8 @@ math math.blas.cblas math.blas.vectors math.blas.vectors.private
|
||||||
math.complex math.functions math.order functors words
|
math.complex math.functions math.order functors words
|
||||||
sequences sequences.merged sequences.private shuffle
|
sequences sequences.merged sequences.private shuffle
|
||||||
specialized-arrays.direct.float specialized-arrays.direct.double
|
specialized-arrays.direct.float specialized-arrays.direct.double
|
||||||
specialized-arrays.float specialized-arrays.double ;
|
specialized-arrays.float specialized-arrays.double
|
||||||
|
parser prettyprint.backend prettyprint.custom ;
|
||||||
IN: math.blas.matrices
|
IN: math.blas.matrices
|
||||||
|
|
||||||
TUPLE: blas-matrix-base underlying ld rows cols transpose ;
|
TUPLE: blas-matrix-base underlying ld rows cols transpose ;
|
||||||
|
|
@ -258,6 +259,7 @@ XGERC IS cblas_${T}ger${C}
|
||||||
MATRIX DEFINES ${TYPE}-blas-matrix
|
MATRIX DEFINES ${TYPE}-blas-matrix
|
||||||
<MATRIX> DEFINES <${TYPE}-blas-matrix>
|
<MATRIX> DEFINES <${TYPE}-blas-matrix>
|
||||||
>MATRIX DEFINES >${TYPE}-blas-matrix
|
>MATRIX DEFINES >${TYPE}-blas-matrix
|
||||||
|
XMATRIX{ DEFINES ${T}matrix{
|
||||||
|
|
||||||
WHERE
|
WHERE
|
||||||
|
|
||||||
|
|
@ -291,6 +293,11 @@ M: MATRIX n*V(*)Vconj+M!
|
||||||
[ TYPE>ARG ] (prepare-ger)
|
[ TYPE>ARG ] (prepare-ger)
|
||||||
[ XGERC ] dip ;
|
[ XGERC ] dip ;
|
||||||
|
|
||||||
|
: XMATRIX{ \ } [ >MATRIX ] parse-literal ; parsing
|
||||||
|
|
||||||
|
M: MATRIX pprint-delims
|
||||||
|
drop \ XMATRIX{ \ } ;
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -305,3 +312,6 @@ M: MATRIX n*V(*)Vconj+M!
|
||||||
"double-complex" "z" define-complex-blas-matrix
|
"double-complex" "z" define-complex-blas-matrix
|
||||||
|
|
||||||
>>
|
>>
|
||||||
|
|
||||||
|
M: blas-matrix-base >pprint-sequence Mrows ;
|
||||||
|
M: blas-matrix-base pprint* pprint-object ;
|
||||||
|
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
Literal syntax for BLAS vectors and matrices
|
|
||||||
|
|
@ -1,78 +0,0 @@
|
||||||
USING: help.markup help.syntax math.blas.matrices math.blas.vectors multiline ;
|
|
||||||
IN: math.blas.syntax
|
|
||||||
|
|
||||||
ARTICLE: "math.blas.syntax" "BLAS interface literal syntax"
|
|
||||||
"Vectors:"
|
|
||||||
{ $subsection POSTPONE: svector{ }
|
|
||||||
{ $subsection POSTPONE: dvector{ }
|
|
||||||
{ $subsection POSTPONE: cvector{ }
|
|
||||||
{ $subsection POSTPONE: zvector{ }
|
|
||||||
"Matrices:"
|
|
||||||
{ $subsection POSTPONE: smatrix{ }
|
|
||||||
{ $subsection POSTPONE: dmatrix{ }
|
|
||||||
{ $subsection POSTPONE: cmatrix{ }
|
|
||||||
{ $subsection POSTPONE: zmatrix{ } ;
|
|
||||||
|
|
||||||
ABOUT: "math.blas.syntax"
|
|
||||||
|
|
||||||
HELP: svector{
|
|
||||||
{ $syntax "svector{ 1.0 -2.0 3.0 }" }
|
|
||||||
{ $description "Construct a literal " { $link float-blas-vector } "." } ;
|
|
||||||
|
|
||||||
HELP: dvector{
|
|
||||||
{ $syntax "dvector{ 1.0 -2.0 3.0 }" }
|
|
||||||
{ $description "Construct a literal " { $link double-blas-vector } "." } ;
|
|
||||||
|
|
||||||
HELP: cvector{
|
|
||||||
{ $syntax "cvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
|
|
||||||
{ $description "Construct a literal " { $link float-complex-blas-vector } "." } ;
|
|
||||||
|
|
||||||
HELP: zvector{
|
|
||||||
{ $syntax "dvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
|
|
||||||
{ $description "Construct a literal " { $link double-complex-blas-vector } "." } ;
|
|
||||||
|
|
||||||
{
|
|
||||||
POSTPONE: svector{ POSTPONE: dvector{
|
|
||||||
POSTPONE: cvector{ POSTPONE: zvector{
|
|
||||||
} related-words
|
|
||||||
|
|
||||||
HELP: smatrix{
|
|
||||||
{ $syntax <" smatrix{
|
|
||||||
{ 1.0 0.0 0.0 1.0 }
|
|
||||||
{ 0.0 1.0 0.0 2.0 }
|
|
||||||
{ 0.0 0.0 1.0 3.0 }
|
|
||||||
{ 0.0 0.0 0.0 1.0 }
|
|
||||||
} "> }
|
|
||||||
{ $description "Construct a literal " { $link float-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
|
|
||||||
|
|
||||||
HELP: dmatrix{
|
|
||||||
{ $syntax <" dmatrix{
|
|
||||||
{ 1.0 0.0 0.0 1.0 }
|
|
||||||
{ 0.0 1.0 0.0 2.0 }
|
|
||||||
{ 0.0 0.0 1.0 3.0 }
|
|
||||||
{ 0.0 0.0 0.0 1.0 }
|
|
||||||
} "> }
|
|
||||||
{ $description "Construct a literal " { $link double-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
|
|
||||||
|
|
||||||
HELP: cmatrix{
|
|
||||||
{ $syntax <" cmatrix{
|
|
||||||
{ 1.0 0.0 0.0 1.0 }
|
|
||||||
{ 0.0 C{ 0.0 1.0 } 0.0 2.0 }
|
|
||||||
{ 0.0 0.0 -1.0 3.0 }
|
|
||||||
{ 0.0 0.0 0.0 C{ 0.0 -1.0 } }
|
|
||||||
} "> }
|
|
||||||
{ $description "Construct a literal " { $link float-complex-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
|
|
||||||
|
|
||||||
HELP: zmatrix{
|
|
||||||
{ $syntax <" zmatrix{
|
|
||||||
{ 1.0 0.0 0.0 1.0 }
|
|
||||||
{ 0.0 C{ 0.0 1.0 } 0.0 2.0 }
|
|
||||||
{ 0.0 0.0 -1.0 3.0 }
|
|
||||||
{ 0.0 0.0 0.0 C{ 0.0 -1.0 } }
|
|
||||||
} "> }
|
|
||||||
{ $description "Construct a literal " { $link double-complex-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
|
|
||||||
|
|
||||||
{
|
|
||||||
POSTPONE: smatrix{ POSTPONE: dmatrix{
|
|
||||||
POSTPONE: cmatrix{ POSTPONE: zmatrix{
|
|
||||||
} related-words
|
|
||||||
|
|
@ -1,44 +0,0 @@
|
||||||
USING: kernel math.blas.vectors math.blas.matrices parser
|
|
||||||
arrays prettyprint.backend prettyprint.custom sequences ;
|
|
||||||
IN: math.blas.syntax
|
|
||||||
|
|
||||||
: svector{
|
|
||||||
\ } [ >float-blas-vector ] parse-literal ; parsing
|
|
||||||
: dvector{
|
|
||||||
\ } [ >double-blas-vector ] parse-literal ; parsing
|
|
||||||
: cvector{
|
|
||||||
\ } [ >float-complex-blas-vector ] parse-literal ; parsing
|
|
||||||
: zvector{
|
|
||||||
\ } [ >double-complex-blas-vector ] parse-literal ; parsing
|
|
||||||
|
|
||||||
: smatrix{
|
|
||||||
\ } [ >float-blas-matrix ] parse-literal ; parsing
|
|
||||||
: dmatrix{
|
|
||||||
\ } [ >double-blas-matrix ] parse-literal ; parsing
|
|
||||||
: cmatrix{
|
|
||||||
\ } [ >float-complex-blas-matrix ] parse-literal ; parsing
|
|
||||||
: zmatrix{
|
|
||||||
\ } [ >double-complex-blas-matrix ] parse-literal ; parsing
|
|
||||||
|
|
||||||
M: float-blas-vector pprint-delims
|
|
||||||
drop \ svector{ \ } ;
|
|
||||||
M: double-blas-vector pprint-delims
|
|
||||||
drop \ dvector{ \ } ;
|
|
||||||
M: float-complex-blas-vector pprint-delims
|
|
||||||
drop \ cvector{ \ } ;
|
|
||||||
M: double-complex-blas-vector pprint-delims
|
|
||||||
drop \ zvector{ \ } ;
|
|
||||||
|
|
||||||
M: float-blas-matrix pprint-delims
|
|
||||||
drop \ smatrix{ \ } ;
|
|
||||||
M: double-blas-matrix pprint-delims
|
|
||||||
drop \ dmatrix{ \ } ;
|
|
||||||
M: float-complex-blas-matrix pprint-delims
|
|
||||||
drop \ cmatrix{ \ } ;
|
|
||||||
M: double-complex-blas-matrix pprint-delims
|
|
||||||
drop \ zmatrix{ \ } ;
|
|
||||||
|
|
||||||
M: blas-vector-base >pprint-sequence ;
|
|
||||||
M: blas-vector-base pprint* pprint-object ;
|
|
||||||
M: blas-matrix-base >pprint-sequence Mrows ;
|
|
||||||
M: blas-matrix-base pprint* pprint-object ;
|
|
||||||
|
|
@ -23,7 +23,12 @@ ARTICLE: "math.blas.vectors" "BLAS interface vector operations"
|
||||||
{ $subsection V- }
|
{ $subsection V- }
|
||||||
"Vector inner products:"
|
"Vector inner products:"
|
||||||
{ $subsection V. }
|
{ $subsection V. }
|
||||||
{ $subsection V.conj } ;
|
{ $subsection V.conj }
|
||||||
|
"Literal syntax:"
|
||||||
|
{ $subsection POSTPONE: svector{ }
|
||||||
|
{ $subsection POSTPONE: dvector{ }
|
||||||
|
{ $subsection POSTPONE: cvector{ }
|
||||||
|
{ $subsection POSTPONE: zvector{ } ;
|
||||||
|
|
||||||
ABOUT: "math.blas.vectors"
|
ABOUT: "math.blas.vectors"
|
||||||
|
|
||||||
|
|
@ -129,3 +134,25 @@ HELP: V/n
|
||||||
HELP: Vsub
|
HELP: Vsub
|
||||||
{ $values { "v" blas-vector-base } { "start" integer } { "length" integer } { "sub" blas-vector-base } }
|
{ $values { "v" blas-vector-base } { "start" integer } { "length" integer } { "sub" blas-vector-base } }
|
||||||
{ $description "Slice a subvector out of " { $snippet "v" } " starting at " { $snippet "start" } " with the given " { $snippet "length" } ". The subvector will share storage with the parent vector." } ;
|
{ $description "Slice a subvector out of " { $snippet "v" } " starting at " { $snippet "start" } " with the given " { $snippet "length" } ". The subvector will share storage with the parent vector." } ;
|
||||||
|
|
||||||
|
HELP: svector{
|
||||||
|
{ $syntax "svector{ 1.0 -2.0 3.0 }" }
|
||||||
|
{ $description "Construct a literal " { $link float-blas-vector } "." } ;
|
||||||
|
|
||||||
|
HELP: dvector{
|
||||||
|
{ $syntax "dvector{ 1.0 -2.0 3.0 }" }
|
||||||
|
{ $description "Construct a literal " { $link double-blas-vector } "." } ;
|
||||||
|
|
||||||
|
HELP: cvector{
|
||||||
|
{ $syntax "cvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
|
||||||
|
{ $description "Construct a literal " { $link float-complex-blas-vector } "." } ;
|
||||||
|
|
||||||
|
HELP: zvector{
|
||||||
|
{ $syntax "dvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
|
||||||
|
{ $description "Construct a literal " { $link double-complex-blas-vector } "." } ;
|
||||||
|
|
||||||
|
{
|
||||||
|
POSTPONE: svector{ POSTPONE: dvector{
|
||||||
|
POSTPONE: cvector{ POSTPONE: zvector{
|
||||||
|
} related-words
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
USING: kernel math.blas.vectors math.blas.syntax sequences tools.test ;
|
USING: kernel math.blas.vectors sequences tools.test ;
|
||||||
IN: math.blas.vectors.tests
|
IN: math.blas.vectors.tests
|
||||||
|
|
||||||
! clone
|
! clone
|
||||||
|
|
|
||||||
|
|
@ -2,7 +2,7 @@ USING: accessors alien alien.c-types arrays byte-arrays combinators
|
||||||
combinators.short-circuit fry kernel math math.blas.cblas
|
combinators.short-circuit fry kernel math math.blas.cblas
|
||||||
math.complex math.functions math.order sequences.complex
|
math.complex math.functions math.order sequences.complex
|
||||||
sequences.complex-components sequences sequences.private
|
sequences.complex-components sequences sequences.private
|
||||||
functors words locals
|
functors words locals parser prettyprint.backend prettyprint.custom
|
||||||
specialized-arrays.float specialized-arrays.double
|
specialized-arrays.float specialized-arrays.double
|
||||||
specialized-arrays.direct.float specialized-arrays.direct.double ;
|
specialized-arrays.direct.float specialized-arrays.direct.double ;
|
||||||
IN: math.blas.vectors
|
IN: math.blas.vectors
|
||||||
|
|
@ -138,6 +138,8 @@ VECTOR DEFINES ${TYPE}-blas-vector
|
||||||
<VECTOR> DEFINES <${TYPE}-blas-vector>
|
<VECTOR> DEFINES <${TYPE}-blas-vector>
|
||||||
>VECTOR DEFINES >${TYPE}-blas-vector
|
>VECTOR DEFINES >${TYPE}-blas-vector
|
||||||
|
|
||||||
|
XVECTOR{ DEFINES ${T}vector{
|
||||||
|
|
||||||
WHERE
|
WHERE
|
||||||
|
|
||||||
TUPLE: VECTOR < blas-vector-base ;
|
TUPLE: VECTOR < blas-vector-base ;
|
||||||
|
|
@ -165,6 +167,11 @@ M: VECTOR (blas-direct-array)
|
||||||
[ [ length>> ] [ inc>> ] bi * ] bi
|
[ [ length>> ] [ inc>> ] bi * ] bi
|
||||||
<DIRECT-ARRAY> ;
|
<DIRECT-ARRAY> ;
|
||||||
|
|
||||||
|
: XVECTOR{ \ } [ >VECTOR ] parse-literal ; parsing
|
||||||
|
|
||||||
|
M: VECTOR pprint-delims
|
||||||
|
drop \ XVECTOR{ \ } ;
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -270,3 +277,5 @@ M: VECTOR n*V!
|
||||||
|
|
||||||
>>
|
>>
|
||||||
|
|
||||||
|
M: blas-vector-base >pprint-sequence ;
|
||||||
|
M: blas-vector-base pprint* pprint-object ;
|
||||||
|
|
|
||||||
|
|
@ -11,4 +11,10 @@ IN: literals.tests
|
||||||
[ { 7 11 } ] [ { $ seven-eleven } ] unit-test
|
[ { 7 11 } ] [ { $ seven-eleven } ] unit-test
|
||||||
[ { 6 6 6 } ] [ { $ six-six-six } ] unit-test
|
[ { 6 6 6 } ] [ { $ six-six-six } ] unit-test
|
||||||
|
|
||||||
|
[ { 6 6 6 7 } ] [ { $ six-six-six 7 } ] unit-test
|
||||||
|
|
||||||
[ { 8 8 8 } ] [ { $[ six-six-six [ 2 + ] tri@ ] } ] unit-test
|
[ { 8 8 8 } ] [ { $[ six-six-six [ 2 + ] tri@ ] } ] unit-test
|
||||||
|
|
||||||
|
[ { 0.5 2.0 } ] [ { $[ 1.0 2.0 / ] 2.0 } ] unit-test
|
||||||
|
|
||||||
|
[ { 1.0 { 0.5 1.5 } 4.0 } ] [ { 1.0 { $[ 1.0 2.0 / ] 1.5 } $[ 2.0 2.0 * ] } ] unit-test
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
! (c) Joe Groff, see license for details
|
! (c) Joe Groff, see license for details
|
||||||
USING: continuations kernel parser words quotations ;
|
USING: continuations kernel parser words quotations vectors ;
|
||||||
IN: literals
|
IN: literals
|
||||||
|
|
||||||
: $ scan-word [ execute ] curry with-datastack ; parsing
|
: $ scan-word [ execute ] curry with-datastack >vector ; parsing
|
||||||
: $[ \ ] parse-until >quotation with-datastack ; parsing
|
: $[ \ ] parse-until >quotation with-datastack >vector ; parsing
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,49 @@
|
||||||
|
! (c)2009 Joe Groff, see BSD license
|
||||||
|
USING: arrays kernel literals tools.test math math.affine-transforms
|
||||||
|
math.constants math.functions ;
|
||||||
|
IN: math.affine-transforms.tests
|
||||||
|
|
||||||
|
[ { 7.25 4.25 } ] [
|
||||||
|
{ 0.75 0.75 } { 0.75 -0.75 } { 5.0 5.0 } <affine-transform>
|
||||||
|
{ 1.0 2.0 } a.v
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ -1.125 ] [
|
||||||
|
{ 0.75 0.75 } { 0.75 -0.75 } { 5.0 5.0 } <affine-transform>
|
||||||
|
|a|
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 1.0 3.0 } { 2.0 4.0 } { 5.0 6.0 } <affine-transform> 1array [
|
||||||
|
{ 1.0 2.0 } { 3.0 4.0 } { 5.0 6.0 } <affine-transform>
|
||||||
|
transpose-axes
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 1.0 -1.0 } { 1.0 1.0 } { 0.0 0.0 } <affine-transform> 1array [
|
||||||
|
{ 0.5 0.5 } { -0.5 0.5 } { 5.0 5.0 } <affine-transform>
|
||||||
|
inverse-axes
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 1.0 -1.0 } { 1.0 1.0 } { -10.0 0.0 } <affine-transform> 1array [
|
||||||
|
{ 0.5 0.5 } { -0.5 0.5 } { 5.0 5.0 } <affine-transform>
|
||||||
|
inverse-transform
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 1.0 0.0 } { 0.0 1.0 } { 0.0 0.0 } <affine-transform> 1array [
|
||||||
|
{ 0.5 0.5 } { -0.5 0.5 } { 5.0 5.0 } <affine-transform>
|
||||||
|
dup inverse-transform a.
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ t ] [
|
||||||
|
{ 0.01 0.02 } { 0.03 0.04 } { 0.05 0.06 } <affine-transform>
|
||||||
|
{ 0.011 0.021 } { 0.031 0.041 } { 0.051 0.061 } <affine-transform> 0.01 a~
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 1.0 0.0 } { 0.0 1.0 } { 5.0 10.0 } <affine-transform> 1array [
|
||||||
|
{ 5.0 10.0 } <translation>
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ $[ pi 0.25 * cos ] $[ pi 0.25 * sin ] }
|
||||||
|
{ $[ pi -0.25 * sin ] $[ pi 0.25 * cos ] }
|
||||||
|
{ 0.0 0.0 } <affine-transform> 1array [
|
||||||
|
pi 0.25 * <rotation>
|
||||||
|
] unit-test
|
||||||
|
|
@ -0,0 +1,71 @@
|
||||||
|
! (c)2009 Joe Groff, see BSD license
|
||||||
|
USING: accessors arrays combinators combinators.short-circuit kernel math math.vectors
|
||||||
|
math.functions sequences ;
|
||||||
|
IN: math.affine-transforms
|
||||||
|
|
||||||
|
TUPLE: affine-transform x y origin ;
|
||||||
|
C: <affine-transform> affine-transform
|
||||||
|
|
||||||
|
CONSTANT: identity-transform T{ affine-transform f { 1.0 0.0 } { 0.0 1.0 } { 0.0 0.0 } }
|
||||||
|
|
||||||
|
: a.v ( a v -- v )
|
||||||
|
[ [ x>> ] [ first ] bi* v*n ]
|
||||||
|
[ [ y>> ] [ second ] bi* v*n ]
|
||||||
|
[ drop origin>> ] 2tri
|
||||||
|
v+ v+ ;
|
||||||
|
|
||||||
|
: <translation> ( origin -- a )
|
||||||
|
[ { 1.0 0.0 } { 0.0 1.0 } ] dip <affine-transform> ;
|
||||||
|
: <rotation> ( theta -- transform )
|
||||||
|
[ cos ] [ sin ] bi
|
||||||
|
[ 2array ] [ neg swap 2array ] 2bi { 0.0 0.0 } <affine-transform> ;
|
||||||
|
: <scale> ( x y -- transform )
|
||||||
|
[ 0.0 2array ] [ 0.0 swap 2array ] bi* { 0.0 0.0 } <affine-transform> ;
|
||||||
|
|
||||||
|
: center-rotation ( transform center -- transform )
|
||||||
|
[ clone dup ] dip [ vneg a.v ] [ v+ ] bi >>origin ;
|
||||||
|
|
||||||
|
: flatten-transform ( transform -- array )
|
||||||
|
[ x>> ] [ y>> ] [ origin>> ] tri 3append ;
|
||||||
|
|
||||||
|
: |a| ( a -- det )
|
||||||
|
[ [ x>> first ] [ y>> second ] bi * ]
|
||||||
|
[ [ x>> second ] [ y>> first ] bi * ] bi - ;
|
||||||
|
|
||||||
|
: (inverted-axes) ( a -- x y )
|
||||||
|
[ [ y>> second ] [ x>> second neg ] bi 2array ]
|
||||||
|
[ [ y>> first neg ] [ x>> first ] bi 2array ]
|
||||||
|
[ |a| ] tri
|
||||||
|
tuck [ v/n ] 2bi@ ;
|
||||||
|
|
||||||
|
: inverse-axes ( a -- a^-1 )
|
||||||
|
(inverted-axes) { 0.0 0.0 } <affine-transform> ;
|
||||||
|
|
||||||
|
: inverse-transform ( a -- a^-1 )
|
||||||
|
[ inverse-axes dup ] [ origin>> ] bi
|
||||||
|
a.v vneg >>origin ;
|
||||||
|
|
||||||
|
: transpose-axes ( a -- a^T )
|
||||||
|
[ [ x>> first ] [ y>> first ] bi 2array ]
|
||||||
|
[ [ x>> second ] [ y>> second ] bi 2array ]
|
||||||
|
[ origin>> ] tri <affine-transform> ;
|
||||||
|
|
||||||
|
: a. ( a a -- a )
|
||||||
|
transpose-axes {
|
||||||
|
[ [ x>> ] [ x>> ] bi* v. ]
|
||||||
|
[ [ x>> ] [ y>> ] bi* v. ]
|
||||||
|
[ [ y>> ] [ x>> ] bi* v. ]
|
||||||
|
[ [ y>> ] [ y>> ] bi* v. ]
|
||||||
|
[ origin>> a.v ]
|
||||||
|
} 2cleave
|
||||||
|
[ [ 2array ] 2bi@ ] dip <affine-transform> ;
|
||||||
|
|
||||||
|
: v~ ( a b epsilon -- ? )
|
||||||
|
[ ~ ] curry 2all? ;
|
||||||
|
|
||||||
|
: a~ ( a b epsilon -- ? )
|
||||||
|
{
|
||||||
|
[ [ [ x>> ] bi@ ] dip v~ ]
|
||||||
|
[ [ [ y>> ] bi@ ] dip v~ ]
|
||||||
|
[ [ [ origin>> ] bi@ ] dip v~ ]
|
||||||
|
} 3&& ;
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Affine transforms for two-dimensional vectors
|
||||||
|
|
@ -0,0 +1,19 @@
|
||||||
|
USING: arrays kernel sequences sequences.cartesian-product tools.test ;
|
||||||
|
IN: sequences.product.tests
|
||||||
|
|
||||||
|
[
|
||||||
|
{ { 0 "a" } { 1 "a" } { 2 "a" } { 0 "b" } { 1 "b" } { 2 "b" } }
|
||||||
|
] [ { { 0 1 2 } { "a" "b" } } [ ] cartesian-product-map ] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
{
|
||||||
|
{ 0 "a" t } { 1 "a" t } { 2 "a" t } { 0 "b" t } { 1 "b" t } { 2 "b" t }
|
||||||
|
{ 0 "a" f } { 1 "a" f } { 2 "a" f } { 0 "b" f } { 1 "b" f } { 2 "b" f }
|
||||||
|
}
|
||||||
|
] [ { { 0 1 2 } { "a" "b" } { t f } } [ ] cartesian-product-map ] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
{ "012012" "aaabbb" }
|
||||||
|
] [ { { "0" "1" "2" } { "a" "b" } } [ [ first2 ] bi* [ append ] bi@ 2array ] cartesian-product-each ] unit-test
|
||||||
|
|
||||||
|
|
||||||
Binary file not shown.
|
|
@ -0,0 +1,2 @@
|
||||||
|
Slava Pestov
|
||||||
|
Joe Groff
|
||||||
|
|
@ -0,0 +1,8 @@
|
||||||
|
! (c)2009 Slava Pestov & Joe Groff, see BSD license
|
||||||
|
USING: kernel sequences sequences.squish tools.test vectors ;
|
||||||
|
IN: sequences.squish.tests
|
||||||
|
|
||||||
|
[ { { 1 2 3 } { 4 } { 5 6 } } ] [
|
||||||
|
V{ { 1 2 3 } V{ { 4 } { 5 6 } } }
|
||||||
|
[ vector? ] { } squish
|
||||||
|
] unit-test
|
||||||
|
|
@ -0,0 +1,12 @@
|
||||||
|
! (c)2009 Slava Pestov & Joe Groff, see BSD license
|
||||||
|
USING: combinators.short-circuit fry make math kernel sequences ;
|
||||||
|
IN: sequences.squish
|
||||||
|
|
||||||
|
: (squish) ( seq quot: ( obj -- ? ) -- )
|
||||||
|
2dup call [ '[ _ (squish) ] each ] [ drop , ] if ; inline recursive
|
||||||
|
|
||||||
|
: squish ( seq quot exemplar -- seq' )
|
||||||
|
[ [ (squish) ] ] dip make ; inline
|
||||||
|
|
||||||
|
: squish-strings ( seq -- seq' )
|
||||||
|
[ { [ sequence? ] [ integer? not ] } 1&& ] "" squish ;
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Sequence flattening with parameterized descent predicate
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
sequences
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Joe Groff
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Parsers for SVG data
|
||||||
|
|
@ -0,0 +1,96 @@
|
||||||
|
! (c)2009 Joe Groff, see BSD license
|
||||||
|
USING: arrays literals math math.affine-transforms math.functions multiline
|
||||||
|
svg tools.test ;
|
||||||
|
IN: svg.tests
|
||||||
|
|
||||||
|
{ 1.0 2.25 } { -3.0 4.0 } { 5.5 0.000001 } <affine-transform> 1array [
|
||||||
|
"matrix ( 1 +2.25 -3 , 0.4e+1 ,5.5, 1e-6 )" svg-transform>affine-transform
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 1.0 0.0 } { 0.0 1.0 } { 5.0 10.0 } <affine-transform> 1array [
|
||||||
|
"translate(5.0, 1e1 )" svg-transform>affine-transform
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 1.0 0.0 } { 0.0 1.0 } { 5.0 10.0 } <affine-transform> 1array [
|
||||||
|
"translate( 5.0 1e+1)" svg-transform>affine-transform
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 2.0 0.0 } { 0.0 2.0 } { 0.0 0.0 } <affine-transform> 1array [
|
||||||
|
"scale(2.0)" svg-transform>affine-transform
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 2.0 0.0 } { 0.0 4.0 } { 0.0 0.0 } <affine-transform> 1array [
|
||||||
|
"scale(2.0 4.0)" svg-transform>affine-transform
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 2.0 0.0 } { 0.0 4.0 } { 0.0 0.0 } <affine-transform> 1array [
|
||||||
|
"scale(2.0 4.0)" svg-transform>affine-transform
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 1.0 0.0 } { $[ 45 degrees tan ] 1.0 } { 0.0 0.0 } <affine-transform> 1array [
|
||||||
|
"skewX(45)" svg-transform>affine-transform
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 1.0 $[ -45 degrees tan ] } { 0.0 1.0 } { 0.0 0.0 } <affine-transform> 1array [
|
||||||
|
"skewY(-4.5e1)" svg-transform>affine-transform
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ $[ 30 degrees cos ] $[ 30 degrees sin ] }
|
||||||
|
{ $[ -30 degrees sin ] $[ 30 degrees cos ] } { 0.0 0.0 } <affine-transform> 1array [
|
||||||
|
"rotate(30)" svg-transform>affine-transform
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ t ] [
|
||||||
|
"rotate(30 1.0,2.0)" svg-transform>affine-transform
|
||||||
|
{ $[ 30 degrees cos ] $[ 30 degrees sin ] }
|
||||||
|
{ $[ -30 degrees sin ] $[ 30 degrees cos ] } {
|
||||||
|
$[ 1.0 30 degrees cos 1.0 * - 30 degrees sin 2.0 * + ]
|
||||||
|
$[ 2.0 30 degrees cos 2.0 * - 30 degrees sin 1.0 * - ]
|
||||||
|
} <affine-transform> 0.001 a~
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ $[ 30 degrees cos ] $[ 30 degrees sin ] }
|
||||||
|
{ $[ -30 degrees sin ] $[ 30 degrees cos ] }
|
||||||
|
{ 1.0 2.0 } <affine-transform> 1array [
|
||||||
|
"translate(1 2) rotate(30)" svg-transform>affine-transform
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ {
|
||||||
|
T{ moveto f { 1.0 1.0 } f }
|
||||||
|
T{ lineto f { 3.0 -1.0 } f }
|
||||||
|
|
||||||
|
T{ lineto f { 2.0 2.0 } t }
|
||||||
|
T{ lineto f { 2.0 -2.0 } t }
|
||||||
|
T{ lineto f { 2.0 2.0 } t }
|
||||||
|
|
||||||
|
T{ vertical-lineto f -9.0 t }
|
||||||
|
T{ vertical-lineto f 1.0 t }
|
||||||
|
T{ horizontal-lineto f 9.0 f }
|
||||||
|
T{ horizontal-lineto f 8.0 f }
|
||||||
|
|
||||||
|
T{ closepath }
|
||||||
|
|
||||||
|
T{ moveto f { 0.0 0.0 } f }
|
||||||
|
|
||||||
|
T{ curveto f { -4.0 0.0 } { -8.0 4.0 } { -8.0 8.0 } f }
|
||||||
|
T{ curveto f { -8.0 4.0 } { -12.0 8.0 } { -16.0 8.0 } f }
|
||||||
|
|
||||||
|
T{ smooth-curveto f { 0.0 2.0 } { 2.0 0.0 } t }
|
||||||
|
|
||||||
|
T{ quadratic-bezier-curveto f { -2.0 0.0 } { 0.0 -2.0 } f }
|
||||||
|
T{ quadratic-bezier-curveto f { -3.0 0.0 } { 0.0 3.0 } f }
|
||||||
|
|
||||||
|
T{ smooth-quadratic-bezier-curveto f { 1.0 2.0 } t }
|
||||||
|
T{ smooth-quadratic-bezier-curveto f { 3.0 4.0 } t }
|
||||||
|
|
||||||
|
T{ elliptical-arc f { 5.0 6.0 } 7.0 t f { 8.0 9.0 } f }
|
||||||
|
} ] [
|
||||||
|
<"
|
||||||
|
M 1.0,+1 3,-10e-1 l 2 2, 2 -2, 2 2 v -9 1 H 9 8 z
|
||||||
|
M 0 0 C -4.0 0.0 -8.0 4.0 -8.0 8.0 -8.0 4.0 -12.0 8.0 -16.0 8.0
|
||||||
|
s 0.0,2.0 2.0,0.0
|
||||||
|
Q -2 0 0 -2 -3. 0 0 3
|
||||||
|
t 1 2 3 4
|
||||||
|
A 5 6 7 1 0 8 9
|
||||||
|
"> svg-path>array
|
||||||
|
] unit-test
|
||||||
|
|
@ -0,0 +1,223 @@
|
||||||
|
USING: accessors arrays assocs fry kernel math math.affine-transforms math.constants
|
||||||
|
math.functions math.parser math.vectors memoize peg.ebnf sequences sequences.squish
|
||||||
|
splitting strings xml.data xml.utilities ;
|
||||||
|
IN: svg
|
||||||
|
|
||||||
|
XML-NS: svg-name http://www.w3.org/2000/svg
|
||||||
|
XML-NS: xlink-name http://www.w3.org/1999/xlink
|
||||||
|
XML-NS: sodipodi-name http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd
|
||||||
|
XML-NS: inkscape-name http://www.inkscape.org/namespaces/inkscape
|
||||||
|
|
||||||
|
: svg-string>number ( string -- number )
|
||||||
|
{ { CHAR: E CHAR: e } } substitute "e" split1
|
||||||
|
[ string>number ] [ [ string>number 10 swap ^ ] [ 1 ] if* ] bi* *
|
||||||
|
>float ;
|
||||||
|
|
||||||
|
: degrees ( deg -- rad ) pi * 180.0 / ;
|
||||||
|
|
||||||
|
EBNF: svg-transform>affine-transform
|
||||||
|
|
||||||
|
transforms =
|
||||||
|
transform:m comma-wsp+ transforms:n => [[ m n a. ]]
|
||||||
|
| transform
|
||||||
|
transform =
|
||||||
|
matrix
|
||||||
|
| translate
|
||||||
|
| scale
|
||||||
|
| rotate
|
||||||
|
| skewX
|
||||||
|
| skewY
|
||||||
|
matrix =
|
||||||
|
"matrix" wsp* "(" wsp*
|
||||||
|
number:xx comma-wsp
|
||||||
|
number:xy comma-wsp
|
||||||
|
number:yx comma-wsp
|
||||||
|
number:yy comma-wsp
|
||||||
|
number:ox comma-wsp
|
||||||
|
number:oy wsp* ")"
|
||||||
|
=> [[ { xx xy } { yx yy } { ox oy } <affine-transform> ]]
|
||||||
|
translate =
|
||||||
|
"translate" wsp* "(" wsp* number:tx ( comma-wsp number:ty => [[ ty ]] )?:ty wsp* ")"
|
||||||
|
=> [[ tx ty 0.0 or 2array <translation> ]]
|
||||||
|
scale =
|
||||||
|
"scale" wsp* "(" wsp* number:sx ( comma-wsp number:sy => [[ sy ]] )?:sy wsp* ")"
|
||||||
|
=> [[ sx sy sx or <scale> ]]
|
||||||
|
rotate =
|
||||||
|
"rotate" wsp* "(" wsp* number:a ( comma-wsp number:cx comma-wsp number:cy => [[ cx cy 2array ]])?:c wsp* ")"
|
||||||
|
=> [[ a degrees <rotation> c [ center-rotation ] when* ]]
|
||||||
|
skewX =
|
||||||
|
"skewX" wsp* "(" wsp* number:a wsp* ")"
|
||||||
|
=> [[ { 1.0 0.0 } a degrees tan 1.0 2array { 0.0 0.0 } <affine-transform> ]]
|
||||||
|
skewY =
|
||||||
|
"skewY" wsp* "(" wsp* number:a wsp* ")"
|
||||||
|
=> [[ 1.0 a degrees tan 2array { 0.0 1.0 } { 0.0 0.0 } <affine-transform> ]]
|
||||||
|
number =
|
||||||
|
sign? (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
|
||||||
|
comma-wsp =
|
||||||
|
(wsp+ comma? wsp*) | (comma wsp*)
|
||||||
|
comma =
|
||||||
|
","
|
||||||
|
integer-constant =
|
||||||
|
digit-sequence
|
||||||
|
floating-point-constant =
|
||||||
|
fractional-constant exponent?
|
||||||
|
| digit-sequence exponent
|
||||||
|
fractional-constant =
|
||||||
|
digit-sequence? "." digit-sequence
|
||||||
|
| digit-sequence "."
|
||||||
|
exponent =
|
||||||
|
( "e" | "E" ) sign? digit-sequence
|
||||||
|
sign =
|
||||||
|
"+" => [[ f ]] | "-"
|
||||||
|
digit-sequence = [0-9]+ => [[ >string ]]
|
||||||
|
wsp = (" " | "\t" | "\r" | "\n")
|
||||||
|
|
||||||
|
transform-list = wsp* transforms?:t wsp*
|
||||||
|
=> [[ t [ identity-transform ] unless* ]]
|
||||||
|
|
||||||
|
;EBNF
|
||||||
|
|
||||||
|
: tag-transform ( tag -- transform )
|
||||||
|
"transform" svg-name swap at svg-transform>affine-transform ;
|
||||||
|
|
||||||
|
TUPLE: moveto p relative? ;
|
||||||
|
TUPLE: closepath ;
|
||||||
|
TUPLE: lineto p relative? ;
|
||||||
|
TUPLE: horizontal-lineto x relative? ;
|
||||||
|
TUPLE: vertical-lineto y relative? ;
|
||||||
|
TUPLE: curveto p1 p2 p relative? ;
|
||||||
|
TUPLE: smooth-curveto p2 p relative? ;
|
||||||
|
TUPLE: quadratic-bezier-curveto p1 p relative? ;
|
||||||
|
TUPLE: smooth-quadratic-bezier-curveto p relative? ;
|
||||||
|
TUPLE: elliptical-arc radii x-axis-rotation large-arc? sweep? p relative? ;
|
||||||
|
|
||||||
|
: (set-relative) ( args rel -- args )
|
||||||
|
'[ [ _ >>relative? drop ] each ] keep ;
|
||||||
|
|
||||||
|
EBNF: svg-path>array
|
||||||
|
|
||||||
|
moveto-drawto-command-groups =
|
||||||
|
moveto-drawto-command-group:first wsp* moveto-drawto-command-groups:rest
|
||||||
|
=> [[ first rest append ]]
|
||||||
|
| moveto-drawto-command-group
|
||||||
|
moveto-drawto-command-group =
|
||||||
|
moveto:m wsp* drawto-commands?:d => [[ m d append ]]
|
||||||
|
drawto-commands =
|
||||||
|
drawto-command:first wsp* drawto-commands:rest => [[ first rest append ]]
|
||||||
|
| drawto-command
|
||||||
|
drawto-command =
|
||||||
|
closepath
|
||||||
|
| lineto
|
||||||
|
| horizontal-lineto
|
||||||
|
| vertical-lineto
|
||||||
|
| curveto
|
||||||
|
| smooth-curveto
|
||||||
|
| quadratic-bezier-curveto
|
||||||
|
| smooth-quadratic-bezier-curveto
|
||||||
|
| elliptical-arc
|
||||||
|
moveto =
|
||||||
|
("M" => [[ f ]] | "m" => [[ t ]]):rel wsp* moveto-argument-sequence:args
|
||||||
|
=> [[ args rel (set-relative) ]]
|
||||||
|
moveto-argument = coordinate-pair => [[ f moveto boa ]]
|
||||||
|
moveto-argument-sequence =
|
||||||
|
moveto-argument:first comma-wsp? lineto-argument-sequence:rest
|
||||||
|
=> [[ rest first prefix ]]
|
||||||
|
| moveto-argument => [[ 1array ]]
|
||||||
|
closepath =
|
||||||
|
("Z" | "z") => [[ drop closepath boa 1array ]]
|
||||||
|
lineto =
|
||||||
|
("L" => [[ f ]] | "l" => [[ t ]]):rel wsp* lineto-argument-sequence:args
|
||||||
|
=> [[ args rel (set-relative) ]]
|
||||||
|
lineto-argument = coordinate-pair => [[ f lineto boa ]]
|
||||||
|
lineto-argument-sequence =
|
||||||
|
lineto-argument:first comma-wsp? lineto-argument-sequence:rest
|
||||||
|
=> [[ rest first prefix ]]
|
||||||
|
| lineto-argument => [[ 1array ]]
|
||||||
|
horizontal-lineto =
|
||||||
|
( "H" => [[ f ]] | "h" => [[ t ]]):rel wsp* horizontal-lineto-argument-sequence:args
|
||||||
|
=> [[ args rel (set-relative) ]]
|
||||||
|
horizontal-lineto-argument = coordinate => [[ f horizontal-lineto boa ]]
|
||||||
|
horizontal-lineto-argument-sequence =
|
||||||
|
horizontal-lineto-argument:first comma-wsp? horizontal-lineto-argument-sequence:rest
|
||||||
|
=> [[ rest first prefix ]]
|
||||||
|
| horizontal-lineto-argument => [[ 1array ]]
|
||||||
|
vertical-lineto =
|
||||||
|
( "V" => [[ f ]] | "v" => [[ t ]]):rel wsp* vertical-lineto-argument-sequence:args
|
||||||
|
=> [[ args rel (set-relative) ]]
|
||||||
|
vertical-lineto-argument = coordinate => [[ f vertical-lineto boa ]]
|
||||||
|
vertical-lineto-argument-sequence =
|
||||||
|
vertical-lineto-argument:first comma-wsp? vertical-lineto-argument-sequence:rest
|
||||||
|
=> [[ rest first prefix ]]
|
||||||
|
| vertical-lineto-argument => [[ 1array ]]
|
||||||
|
curveto =
|
||||||
|
( "C" => [[ f ]] | "c" => [[ t ]]):rel wsp* curveto-argument-sequence:args
|
||||||
|
=> [[ args rel (set-relative) ]]
|
||||||
|
curveto-argument-sequence =
|
||||||
|
curveto-argument:first comma-wsp? curveto-argument-sequence:rest
|
||||||
|
=> [[ rest first prefix ]]
|
||||||
|
| curveto-argument => [[ 1array ]]
|
||||||
|
curveto-argument =
|
||||||
|
coordinate-pair:pone comma-wsp? coordinate-pair:ptwo comma-wsp? coordinate-pair:p
|
||||||
|
=> [[ pone ptwo p f curveto boa ]]
|
||||||
|
smooth-curveto =
|
||||||
|
( "S" => [[ f ]] | "s" => [[ t ]] ):rel wsp* smooth-curveto-argument-sequence:args
|
||||||
|
=> [[ args rel (set-relative) ]]
|
||||||
|
smooth-curveto-argument-sequence =
|
||||||
|
smooth-curveto-argument:first comma-wsp? smooth-curveto-argument-sequence:rest
|
||||||
|
=> [[ rest first prefix ]]
|
||||||
|
| smooth-curveto-argument => [[ 1array ]]
|
||||||
|
smooth-curveto-argument =
|
||||||
|
coordinate-pair:ptwo comma-wsp? coordinate-pair:p
|
||||||
|
=> [[ ptwo p f smooth-curveto boa ]]
|
||||||
|
quadratic-bezier-curveto =
|
||||||
|
( "Q" => [[ f ]] | "q" => [[ t ]] ):rel wsp* quadratic-bezier-curveto-argument-sequence:args
|
||||||
|
=> [[ args rel (set-relative) ]]
|
||||||
|
quadratic-bezier-curveto-argument-sequence =
|
||||||
|
quadratic-bezier-curveto-argument:first comma-wsp?
|
||||||
|
quadratic-bezier-curveto-argument-sequence:rest
|
||||||
|
=> [[ rest first prefix ]]
|
||||||
|
| quadratic-bezier-curveto-argument => [[ 1array ]]
|
||||||
|
quadratic-bezier-curveto-argument =
|
||||||
|
coordinate-pair:pone comma-wsp? coordinate-pair:p
|
||||||
|
=> [[ pone p f quadratic-bezier-curveto boa ]]
|
||||||
|
smooth-quadratic-bezier-curveto =
|
||||||
|
( "T" => [[ f ]] | "t" => [[ t ]] ):rel wsp* smooth-quadratic-bezier-curveto-argument-sequence:args
|
||||||
|
=> [[ args rel (set-relative) ]]
|
||||||
|
smooth-quadratic-bezier-curveto-argument-sequence =
|
||||||
|
smooth-quadratic-bezier-curveto-argument:first comma-wsp? smooth-quadratic-bezier-curveto-argument-sequence:rest
|
||||||
|
=> [[ rest first prefix ]]
|
||||||
|
| smooth-quadratic-bezier-curveto-argument => [[ 1array ]]
|
||||||
|
smooth-quadratic-bezier-curveto-argument = coordinate-pair => [[ f smooth-quadratic-bezier-curveto boa ]]
|
||||||
|
elliptical-arc =
|
||||||
|
( "A" => [[ f ]] | "a" => [[ t ]] ):rel wsp* elliptical-arc-argument-sequence:args
|
||||||
|
=> [[ args rel (set-relative) ]]
|
||||||
|
elliptical-arc-argument-sequence =
|
||||||
|
elliptical-arc-argument:first comma-wsp? elliptical-arc-argument-sequence:rest
|
||||||
|
=> [[ rest first prefix ]]
|
||||||
|
| elliptical-arc-argument => [[ 1array ]]
|
||||||
|
elliptical-arc-argument =
|
||||||
|
nonnegative-number:radiix comma-wsp? nonnegative-number:radiiy comma-wsp?
|
||||||
|
number:xrot comma-wsp flag:large comma-wsp flag:sweep
|
||||||
|
comma-wsp coordinate-pair:p
|
||||||
|
=> [[ radiix radiiy 2array xrot large sweep p f elliptical-arc boa ]]
|
||||||
|
coordinate-pair = coordinate:x comma-wsp? coordinate:y => [[ x y 2array ]]
|
||||||
|
coordinate = number
|
||||||
|
nonnegative-number = (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
|
||||||
|
number = sign? (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
|
||||||
|
flag = "0" => [[ f ]] | "1" => [[ t ]]
|
||||||
|
comma-wsp = (wsp+ comma? wsp*) | (comma wsp*)
|
||||||
|
comma = ","
|
||||||
|
integer-constant = digit-sequence
|
||||||
|
floating-point-constant = fractional-constant exponent? | digit-sequence exponent
|
||||||
|
fractional-constant = digit-sequence? "." digit-sequence | digit-sequence "."
|
||||||
|
exponent = ( "e" | "E" ) sign? digit-sequence
|
||||||
|
sign = "+" => [[ drop f ]] | "-"
|
||||||
|
digit-sequence = [0-9]+ => [[ >string ]]
|
||||||
|
wsp = (" " | "\t" | "\r" | "\n")
|
||||||
|
|
||||||
|
svg-path = wsp* moveto-drawto-command-groups?:x wsp* => [[ x ]]
|
||||||
|
|
||||||
|
;EBNF
|
||||||
|
|
||||||
|
: tag-d ( tag -- d )
|
||||||
|
"d" svg-name swap at svg-path>array ;
|
||||||
|
|
@ -0,0 +1,3 @@
|
||||||
|
xml
|
||||||
|
graphics
|
||||||
|
svg
|
||||||
Loading…
Reference in New Issue